R/getWeatherStationData.R

In jtlovell/jtlTools: John's package with some utilities and required pacakges

#' @title Get weather data from NOAA.
#' @description
#' \code{getWeatherStationData} Get weather data from NOAA stations by
#' proximity to specified georeference coordinates.
#'
#' @param lat_lon_df A data.frame with the following columns (names must match):
#' "latitude","longitude","id". The id column specifies the name of the area to search for and
#' is just used for object naming purposes. See rnoaa::meteo_nearby_stations.
#' @param station_data This is an object containing the station names and locations to search
#' though and must be generated by the rnoaa function ghcnd_stations.
#' It is expected to keep this as NULL. When this is the case, the internally stored
#' ghcnd_stations database is used.
#' @param hasCols A character vector specifying the names of weather variables that must
#' be present for the weather station to be used.
#' @param date_min The earliest data that must have data from the station.
#' See rnoaa::meteo_nearby_stations.
#' @param date_max The latest data that must have data from the station.
#' See rnoaa::meteo_nearby_stations.
#' @param limit The maximum number of stations to search. If none of these stations have sufficient
#' data, an error is returned. See rnoaa::meteo_nearby_stations.
#' @param verbose Logical, should status updates be printed?
#' @param ... Not currently in use.
#' @details This function iterates through NOAA weather collection sites, deterimining
#' whether the data collected satisfies the time and datatype constraints specified.
#' @return A data.frame of daily weather data for each location id. If more than one id
#' are included, the data.frames are placed in a named list.
#'
#' @examples
#' \dontrun{
#' ll = data.frame(latitude = c(27.54986,30.38398),
#'   longitude = c(-97.88101,-97.72938),
#'   id = c("KING","PKLE"),
#'   stringsAsFactors = F)
#' data(station_data)
#' histWeather<-getWeatherStationData(lat_lon_df = ll,
#'   station_data = station_data,
#'   date_min = "2000-01-01",
#'   hasCols = c("prcp","tmax","tmin"),
#'   date_max = "2016-12-31")
#' lapply(histWeather, head)
#' }
#'
#' @import rnoaa
#' @import lubridate
#' @export
getWeatherStationData<-function(lat_lon_df,
                                station_data = NULL,
                                hasCols = c("prcp","tmax","tmin"),
                                verbose = T,
                                date_min = "2000-01-01",
                                date_max = "2017-01-01",
                                limit = 100,
                                ...){
  if(is.null(station_data)){
    if(verbose) cat("loading weather station list\n")
    data(station_data)
  }

  if(verbose) cat("finding closest weather stations\n")
  stationData <- meteo_nearby_stations(lat_lon_df = lat_lon_df,
                                       station_data = station_data,
                                       limit = limit,
                                       year_min = as.numeric(substr(date_min,1,4)),
                                       year_max = as.numeric(substr(date_max,1,4)),
                                       var = toupper(hasCols))

  wss<-lapply(1:length(stationData),function(x){
    yrs<-as.numeric(substr(date_min,1,4)):as.numeric(substr(date_max,1,4))
    nvars = 0
    int = 0
    yr = 0
    if(verbose) cat(names(stationData)[x],"... trying","\n")
    while(nvars != length(hasCols) | !all(yrs %in% yr)){
      if(int>nrow(stationData[[x]]))
        stop("no weather stations found. Try increasing limit\n")
      int<-int+1

      sta<-stationData[[x]][int,]
      monitors <- sta$id
      if(verbose) cat(monitors,"")
      tmp <- data.frame(meteo_pull_monitors(monitors,
                                            date_min = date_min,
                                            date_max = date_max,
                                            var = toupper(hasCols)))
      cmpl<-tmp[complete.cases(tmp),]
      nvars <- sum(hasCols %in% colnames(tmp))
      yr<-unique(as.numeric(substr(cmpl$date,1,4)))
    }
    if(verbose) cat("\n")

    date = as.Date(tmp$date)
    return(data.frame(site = names(stationData)[x],
                      jd = yday(date),
                      month = month(date),
                      day = mday(date),
                      year = year(date),
                      tmin = tmp$tmin/10,
                      tmax = tmp$tmax/10,
                      rain = tmp$prcp/10,
                      stringsAsFactors = F))
  })
  names(wss)<-names(stationData)
  return(wss)
}