R/daily.R

In rwright88/normals: Climate Normals Data

#' Get daily normals data
#'
#' @return Data frame
#' @export
get_dly <- function() {
  tavg <- get_dly_tavg()
  prcp_001 <- get_dly_prcp_001()
  snow_001 <- get_dly_snow_001()
  data <- dplyr::full_join(tavg, prcp_001, by = c("id", "date"))
  data <- dplyr::full_join(data, snow_001, by = c("id", "date"))
  data$name <- rec_station(data$id)
  data[, c("id", "name", "date", "tavg", "prcp_001", "snow_001")]
}

#' Get daily mean temperature normals data
#'
#' Long-term averages of daily average temperature
#'
#' @return Data frame
#' @export
get_dly_tavg <- function() {
  file <- "ftp://ftp.ncdc.noaa.gov/pub/data/normals/1981-2010/products/temperature/dly-tavg-normal.txt"
  data <- read_dly(file)
  data <- tidyr::gather(data, "day", "tavg", paste0("day", 1:31))
  day <- as.numeric(gsub("day", "", data$day))
  data$date <- lubridate::make_date(2010L, data$month, day)
  data$tavg <- data$tavg / 10
  data[!is.na(data$date), c("id", "date", "tavg")]
}

#' Get daily probability of precipitation normals data
#'
#' Probability of precipitation >= 0.01 inches for 29-day windows centered
#' on each day of the year.
#'
#' @return Data frame
#' @export
get_dly_prcp_001 <- function() {
  file <- "ftp://ftp.ncdc.noaa.gov/pub/data/normals/1981-2010/products/precipitation/dly-prcp-pctall-ge001hi.txt"
  data <- read_dly(file)
  data <- tidyr::gather(data, "day", "prcp_001", paste0("day", 1:31))
  day <- as.numeric(gsub("day", "", data$day))
  data$date <- lubridate::make_date(2010L, data$month, day)
  data$prcp_001 <- data$prcp_001 / 10
  data[!is.na(data$date), c("id", "date", "prcp_001")]
}

#' Get daily probability of snowfall normals data
#'
#' Probability of snowfall >= 0.1 inches for 29-day windows centered
#' on each day of the year.
#'
#' @return Data frame
#' @export
get_dly_snow_001 <- function() {
  file <- "ftp://ftp.ncdc.noaa.gov/pub/data/normals/1981-2010/products/precipitation/dly-snow-pctall-ge001ti.txt"
  data <- read_dly(file)
  data <- tidyr::gather(data, "day", "snow_001", paste0("day", 1:31))
  day <- as.numeric(gsub("day", "", data$day))
  data$date <- lubridate::make_date(2010L, data$month, day)
  data$snow_001 <- data$snow_001 / 10
  data[!is.na(data$date), c("id", "date", "snow_001")]
}

read_dly <- function(file) {
  pos <- readr::fwf_positions(
    start = c(1, 13, seq(19, 229, 7)),
    end = c(11, 14, seq(23, 233, 7)),
    col_names = c("id", "month", paste0("day", 1:31))
  )
  types <- paste0("c", strrep("i", 32))
  na <- c("-5555", "-6666", "-7777", "-8888", "-9999")
  readr::read_fwf(file, col_positions = pos, col_types = types, na = na)
}