R/read.rain.r

In jasonelaw/BESdata: Retrieve BES data from internal databases.

#'Retrieve rain data from City of Portland Hydra network.
#'
#'The City of Portland operates a rain gauge network.  This function retrieves
#'rain data from the SQL server database using the USP_MODEL_RAIN stored procedure.
#'The stored procedure summarizes the data within a prespecified period of time
#'(e.g., hourly) and returns the summarized data rather than raw tips.
#'@param station a vector of hydra station codes; the default is the WPCL gauge
#'@param start the start date as a \code{Date} object
#'@param end the end date as a \code{Date} object
#'@param daypart the unit in which the interval is specified
#'@param interval the interval over which the data should be summarized
#'@param dsn Alternate dsn for the NEPTUNE database - for access to production or test instances.
#'@param format logical, TRUE will perform some data formatting, FALSE will return the data.frame exactly
#'as it was returned by the database
#'@return a data.frame of rain data
#'@export
read.rain <- function(station = 160, start = end - 7, end = Sys.Date(),
                      daypart = c('day','hour', 'minute', 'month', 'year'),
                      interval = 1, server = NULL, format = T){
  con <- dbConnect(database = 'NEPTUNE', server = server)
  on.exit(dbDisconnect(con))
  stopifnot(lubridate::is.Date(start), lubridate::is.Date(end))
  make.queries <- function(start, end, interval, daypart, station){
    qry <- sprintf("{call USP_MODEL_RAIN('%s', '%s', %s, '%s', %s)}",
                   format(start), format(end), interval, daypart, station)
    ans <- dbGetQuery(con, qry)
    return(if (is.data.frame(ans)) ans else NULL)
  }

  # Format args and get data
  daypart <- match.arg(daypart)
  args <- data.frame(station, start, end, daypart, interval)
  rain <- purrr::pmap_dfr(args, make.queries)
  if (format){
    formatRain(rain, interval, daypart)
  } else {
    rain
  }
}


#'@importMethodsFrom lubridate +
calculateEndTime <- function(x, interval, daypart){
  x$start.utc + lubridate::period(interval, daypart)
}

#'@importMethodsFrom lubridate +
formatRain <- function(x, interval, daypart, local.tz = Sys.tzone()){
  kFields <- c(
    "location_id", "location_name",
    "start_local", "end_local",
    "rainfall_amount_inches",
    "sensor_present", "downtime",
    "h2_number"
  )
  l <- read.rain.locations()
  i <- match(x$h2_number, l$h2_number)
  x$location_name <- l$location_name[i]
  x$location_id   <- l$location_id[i]
  x$rainfall_amount_inches <- as.numeric(x$rainfall_amount_inches)
  x$downtime       <- x$downtime == "Y"
  x$sensor_present <- x$sensor_present == "Y"
  x$start_local    <- parseUTCm8Time(x$date_time)
  x$end_local      <- x$start_local + lubridate::duration(interval, daypart)
  x[, kFields]
}

#'@rdname read.rain
#'@export
read.rain.locations <- function(server = NULL)
{
  con <- dbConnect(database = 'NEPTUNE', server = server)
  on.exit(dbDisconnect(con))
  qry <- c("
    SELECT
      STATION.station_id AS location_id,
      STATION.h2_number as h2_number,
      station_name AS location_name,
      state_plane_x_ft AS x,
      state_plane_y_ft AS y,
      RHS.start_date AS start_date,
      RHS.end_date AS end_date
    FROM STATION
    INNER JOIN (
      SELECT
        station_id,
        MIN(start_date) AS start_date,
        MAX(end_date) AS end_date
      FROM RAIN_SENSOR
      GROUP BY station_id
    ) RHS
      ON (STATION.station_id = RHS.station_id)
    ")
  res <- dbGetQuery(con, qry)

  res$start_date <- parseUTCm8Time(res$start_date)
  res$end_date   <- parseUTCm8Time(res$end_date)
  res <- sf::st_as_sf(tibble::as_tibble(res), coords = c("x", "y"), crs = 2913)
  res
}