#r #regex #tidyverse #tidyr #opendata
#r #регулярное выражение #tidyverse #tidyr #opendata
Вопрос:
Национальное управление океанических и атмосферных исследований США (NOAA) располагает большим объемом данных в стандартном формате гидрологического обмена (SHEF) (например, по ссылкам ниже). Связанные данные содержат четыре основных элемента информации: название местоположения, идентификатор местоположения, сообщаемое значение (либо числовое, либо «NE» — не оцененное) и зону высот. Я надеюсь преобразовать данные SHEF в четыре столбца data.frame . Формат SHEF, хотя в его названии есть «exchange», не кажется простым в работе, но я, возможно, чего-то не хватает.
Обе страницы со связанными данными ниже содержат 1137 строк текстовых данных о снеге для идентичных местоположений и времени, но для разных параметров снега.
Есть два фрагмента кода, по одному для каждой веб-страницы. Они идентичны, за исключением их URL-адресов, которые указывают на соответствующие параметры.
Приведенный ниже код выводит значение, почти предназначенное data.frame для одного из параметров, swe но для другого, sub результирующий data.frame результат получается явно неполным по отношению к исходным данным и с неправильными значениями (см. tibbles внизу). Я думаю, что, поскольку формат SHEF, по крайней мере, согласован, и поскольку могут существовать функции / библиотеки только для такого рода вещей, для преобразования может потребоваться совершенно другой угол / значительно меньшее количество шагов?
параметр снега 1 («swe») (эквивалент снежной воды): https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sweamp;year=2019amp;month=3amp;day=27amp;hour=12 (данные в сером поле)
параметр снега 2 («sub») (сублимация): https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sbamp;year=2019amp;month=3amp;day=27amp;hour=12 (данные в сером поле)
Я надеюсь на два data.frames , swe и sub , по 4 столбца в каждом. Ниже приведен рабочий пример.
library(tidyverse)
library(rvest)
library(lubridate)
# webpage to scrape data from, March27's parameter "swe"
march27_param_swe <-
"https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sweamp;year=2019amp;month=3amp;day=27amp;hour=12"
####### snow water equivalent (swe) [inches] ##########
# scrape
scrapedtext <- read_html(march27_param_swe) %>% html_node(".notes") %>%
html_text()
swe <- tibble(txt = read_lines(scrapedtext)) %>%
mutate(
row = row_number(),
with_code = str_extract(txt, "^[A-z0-9]{5}\s \d (\.)?\d"),
wo_code = str_extract(txt, "^:?\s \d (\.)?\d") %>%
str_extract("[:digit:] \.?[:digit:]"),
basin_desc = if_else(!is.na(with_code), lag(txt, 1), NA_character_) %>%
str_sub(start = 2)
)
swe <- swe %>% separate(with_code, c("code", "val"), sep = "\s ") %>%
mutate(value = case_when(
!is.na(val) ~ val,
!is.na(wo_code) ~ wo_code,
TRUE ~ NA_character_) %>%
as.numeric) %>% filter(!is.na(value))
swe <- swe %>% mutate(code = zoo::na.locf(code), basin_desc = zoo::na.locf(basin_desc) ,
elevz = gsub(".*(inches))","",txt)) %>%
select(code, value, basin_desc, elevz) %>%
mutate(elevz = trimws(elevz))
dim(swe)
#[1] 643 4
head(swe)
# # A tibble: 6 x 4
# code value basin_desc elevz
# <chr> <dbl> <chr> <chr>
# 1 ACSC1 0 San Antonio Ck - Sunol "Entire Basin"
# 2 ADLC1 0 Arroyo De La Laguna "Entire Basin"
# 3 ADOC1 0 Santa Ana R - Prado Dam "Entire Basin"
# 4 AHOC1 0 Arroyo Honda nr San Jose "Entire Basin"
# 5 AKYC1 41.8 SF American nr Kyburz "Entire Basin"
# 6 AKYC1 3.9 SF American nr Kyburz "Base to 5000'"
#which is what I'm hoping for, except that I'd like the `value` to be
#<chr> to be able to accommodate the numbers and "NE" values reported, like this:
# # A tibble: 6 x 4
# code value basin_desc elevz
# <chr> <chr> <chr> <chr>
####### surface sublimation (sub) ##########
# same locations and day, different parameter, "sb", blowing snow
# sublimation [inches]
march27_param_temp <- "https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sbamp;year=2019amp;month=3amp;day=27amp;hour=12"
scrapedtext <- read_html(march27_param_temp) %>%
html_node(".notes") %>% html_text()
sub <- tibble(txt = read_lines(scrapedtext)) %>%
mutate(
row = row_number(),
with_code = str_extract(txt, "^[A-z0-9]{5}\s \d (\.)?\d"),
wo_code = str_extract(txt, "^:?\s \d (\.)?\d") %>%
str_extract("[:digit:] \.?[:digit:]"),
basin_desc = if_else(!is.na(with_code), lag(txt, 1), NA_character_) %>%
str_sub(start = 2)
)
sub <- sub %>% separate(with_code, c("code", "val"), sep = "\s ") %>%
mutate(value = case_when(
!is.na(val) ~ val,
!is.na(wo_code) ~ wo_code,
TRUE ~ NA_character_) %>%
as.numeric) %>% filter(!is.na(value))
sub <- sub %>% mutate(code = zoo::na.locf(code), basin_desc = zoo::na.locf(basin_desc) ,
elevz = gsub(".*(inches))","",txt)) %>%
select(code, value, basin_desc, elevz) %>%
mutate(elevz = trimws(elevz))
dim(sub)
#[1] 263 4 #dim[swe] was 643x4
head(sub)
# A tibble: 6 x 4
#code value basin_desc elevz
#<chr> <dbl> <chr> <chr>
#1 ADOC1 0 Santa Ana R - Prado Dam "Entire Basin"
#2 ADOC1 0 Santa Ana R - Prado Dam "Base to 5000'"
#3 ARCC1 0 Mad River - Arcata "Entire Basin"
#4 ARCC1 0 Mad River - Arcata "Base to 5000'"
#5 BCAC1 0 Little Truckee - Boca Dam "Entire Basin"
#So `sub` should be the same size `data.frame` as swe, and
#sub$value's are supposed to be (as per the source page above:
# https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sbamp;year=2019amp;month=3amp;day=27amp;hour=12 ):
#head(desired_sub)
# A tibble: 6 x 4
#code value basin_desc elevz
#<chr> <chr> <chr> <chr>
#1 ADOC1 NE Santa Ana R - Prado Dam "Entire Basin"
#2 ADOC1 NE Santa Ana R - Prado Dam "Base to 5000'"
#3 ARCC1 0.000 Mad River - Arcata "Entire Basin"
#4 ARCC1 NE Mad River - Arcata "Base to 5000'"
#5 BCAC1 -0.016 Little Truckee - Boca Dam "Entire Basin"
Комментарии:
1. Мне кажется, что это текстовый файл фиксированного формата. Можете ли вы попробовать проанализировать их на основе фиксированной ширины?
2. Отличная мысль @Tung. Да, я попытаюсь.
3. пожалуйста, опубликуйте решение в качестве ответа, чтобы помочь будущим читателям, если оно у вас получилось
4. У меня еще не было возможности изучить / попробовать функции с фиксированной шириной, но, безусловно, я опубликую решение, если получу его.
Ответ №1:
Я думаю, что ваша проблема может быть связана с непоследовательным выводом данных: строки с кодом могут начинаться с двоеточия или без него.
Я создал новый код, который идентифицирует блок данных путем поиска в строках, начинающихся с кода (или: код), а затем считывает каждый блок во фрейм данных.
Попробуйте это:
library(rvest)
library(stringr)
# Read an individual block
readBlock = function(text){
basin = str_replace(string = text[1], pattern = "^:", replacement = "")
block = text[-1]
code = str_match(block[1], "[A-Z0-9]{5}")[1]
block = str_replace(block, "^(:?[^ ] |:)", "")
block = str_replace(block, "%", "(%)")
block = str_replace_all(block, "[;():]", "|")
block = trimws(block)
block = str_split(block,"\|")
block = as.data.frame(do.call(rbind, block))
colnames(block) = c("Value","Calc", "Units", "Location")
block$Code = code
block$Basin = basin
return(block)
}
# Find blocks starting index
findBlocks = function(text){
index = which(str_detect(text,"^:?[A-Z0-9]{5}"))
index = index[index > 10]
index = index - 1
index = c(index, 1 which(str_detect(text,"\.END")))
return(index)
}
# return a data frame with all blocks
readAllBlocks = function(index, text){
blocks = lapply(1:(length(index)-1), function(x){
blockText = text[index[x]:(index[x 1]-2)]
readBlock(blockText)
})
blocks = do.call(rbind, blocks)
return(blocks)
}
####### snow water equivalent (swe) [inches] ##########
march27_param_swe = "https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sweamp;year=2019amp;month=3amp;day=27amp;hour=12"
# scrape
scrapedtext = html_text(html_node(read_html(march27_param_swe),".notes"))
scrapedtext = unlist(str_split(scrapedtext,"n"))
block_index = findBlocks(scrapedtext)
swe = readAllBlocks(block_index, scrapedtext)
####### surface sublimation (sub) ##########
march27_param_temp = "https://www.nohrsc.noaa.gov/shef_archive/index.html?rfc=cnrfcamp;product=sbamp;year=2019amp;month=3amp;day=27amp;hour=12"
scrapedtext = html_text(html_node(read_html(march27_param_temp),".notes"))
scrapedtext = unlist(str_split(scrapedtext,"n"))
block_index = findBlocks(scrapedtext)
sub = readAllBlocks(block_index, scrapedtext)
Редактировать:
Если единица % не имеет круглых скобок, заключите их перед их заменой. Эта строка должна сделать свое дело:
block = str_replace(block, "%", "(%)")
Я отредактировал приведенный выше код, чтобы включить его там, где это необходимо.
Комментарии:
1. Я многому научусь из этого. Блестящая работа! Спасибо. Это сработало для 5 из 6 параметров — параметр
SCA( url nohrsc.noaa.gov/shef_archive/… ) выдал ошибку, и я думаю, это потому, что у устройства%нет параграфов, как у других, например(inches). Будет ли сложно обновить функцию (ы) для соответствия%?