Meteo_pull_monitors для средних климатических данных по широте / долготе - PullRequest
Новая
       49

Meteo_pull_monitors для средних климатических данных по широте / долготе

0 голосов
/ 11 сентября 2018

У меня есть данные о широтах, долготах, начальных и конечных годах.Я хочу среднее количество осадков для каждого места за этот период.

Сейчас я могу получить это для одного местоположения за раз, но я хочу автоматизировать следующее для нескольких местоположений:

Вот некоторые предварительные условия: 

#library(xts)
#library(rnoaa)
#options(noaakey = "...") # https://ropensci.org/blog/2014/03/13/rnoaa/ says how to get a API key
#station_data <- ghcnd_stations() # Takes a while to run
statenv <- new.env()
lat_lon_df<-structure(list(lat = c(41.1620277777778, 44.483333, 44.066667
), long = c(-96.4115, -92.533333, -93.5), yrmin = c(2001L, 1983L, 
                                                    1982L), yrmax = c(2010L, 1990L, 1992L), id = c("ithaca", "haycreek", 
                                                                                                   "waseca")), class = "data.frame", row.names = c(1389L, 1395L, 
                                                                                                                                                   1403L))

А вот и мясо.

ll_df<-lat_lon_df[1,]
nearby_station<-meteo_nearby_stations(lat_lon_df = ll_df,
    lat_colname = "lat", lon_colname = "long",
    station_data = station_data, radius = 50, year_min=ll_df[1,"yrmin"],
    year_max=ll_df[1,"yrmax"],limit=1, var="PRCP")


nearby_station<-meteo_nearby_stations(lat_lon_df = ll_df,lat_colname = "lat", lon_colname = "long",
                                          station_data = station_data, radius = 50, year_min=ll_df[1,"yrmin"],
                                          year_max=ll_df[1,"yrmin"],limit=1, var="PRCP")
e <- lapply(nearby_station,function(x)  meteo_pull_monitors(x$id[1])) #get actual data based on monitor id's

ll<-xts(e[[1]]$prcp,order.by=e[[1]]$date)
x<-paste0(ll_df[1,"yrmin"],"/",ll_df[1,"yrmax"]) 
 mean(xts::apply.yearly(na.omit(ll[x]),sum))/10 #divide by 10, put in mm

Возвращает 776,23.Конечным результатом должен быть фрейм данных, в котором теперь есть новый столбец «осадков», такой как: 

     lat      long yrmin yrmax       id    precip
41.16203 -96.41150  2001  2010   ithaca    776.23
44.48333 -92.53333  1983  1990 haycreek    829.65
44.06667 -93.50000  1982  1992   waseca    894.62

Должен быть способ заставить это просто повторить строку lat_long_df, то есть для lat_lon_df[1,], затем lat_lon_df[2,] и, наконец, lat_lon_df[3,].

1 Ответ

0 голосов
/ 11 сентября 2018

Один из подходов заключается в apply пользовательской функции над строками lat_lon_df.

. Вот пример: 

library(xts)
library(rnoaa)

Установка ключа API 

#options(noaakey = "...") # https://ropensci.org/blog/2014/03/13/rnoaa/ says how to get a API key

station_data <- ghcnd_stations() #meta-information about all available GHCND weather stations

Теперь примените все шаги, которые вы описали в apply вызове 

out <- apply(lat_lon_df, 1, function(x){
  min_year <- x[3] #extract the needed values min_year, max_year and ll_df
  max_year <- x[4] 
  ll_df <- data.frame(lat = as.numeric(x[1]),
                      long = as.numeric(x[2]),
                      id = x[5])
  nearby_station <- meteo_nearby_stations(lat_lon_df = ll_df,
                                          lat_colname = "lat",
                                          lon_colname = "long",
                                          station_data = station_data,
                                          radius = 50,
                                          year_min = min_year,
                                          year_max = max_year,
                                          limit=1,
                                          var="PRCP")
  res <- lapply(nearby_station, function(y) {
    res <- meteo_pull_monitors(y[1]$id)
    }
    )
  ll <- xts(res[[1]]$prcp, order.by=res[[1]]$date)
  x <- paste0(min_year <- x[3],"/",max_year) 
  mean(xts::apply.yearly(na.omit(ll[x]),sum))/10
}
)

data.frame(lat_lon_df, precip = out)
#output
          lat      long yrmin yrmax       id   precip
1389 41.16203 -96.41150  2001  2010   ithaca 776.2300
1395 44.48333 -92.53333  1983  1990 haycreek 829.6500
1403 44.06667 -93.50000  1982  1992   waseca 894.6273

. Обратите внимание, что когда yrmin и yrmax не изменяются, можно просто получить необходимую информацию, используяmeteo_nearby_stations on lat_lon_df.

Вы также можете определить это как именованную функцию 

get_mean_precip <- function(x){
  min_year <- x[3]
  max_year <- x[4]
  ll_df <- data.frame(lat = as.numeric(x[1]),
                      long = as.numeric(x[2]),
                      id = x[5])
  nearby_station <- rnoaa::meteo_nearby_stations(lat_lon_df = ll_df,
                                                 lat_colname = "lat",
                                                 lon_colname = "long",
                                                 station_data = station_data,
                                                 radius = 50,
                                                 year_min = min_year,
                                                 year_max = max_year,
                                                 limit=1,
                                                 var = "PRCP")
  res <- lapply(nearby_station, function(y) {
    res <- rnoaa::meteo_pull_monitors(y[1]$id)
  }
  )
  ll <- xts::xts(res[[1]]$prcp, order.by=res[[1]]$date)
  x <- paste0(min_year <- x[3],"/",max_year) 
  mean(xts::apply.yearly(na.omit(ll[x]),sum))/10
}

и использовать ее как: 

out <- apply(lat_lon_df, 1, get_mean_precip)
...