Nothing
#' Get weather data from one station
#'
#'
#' @param station station ID, see riem_stations()
#' @param date_start date of start of the desired data, e.g. "2016-01-01"
#' @inheritParams rlang::args_dots_empty
#' @param date_end date of end of the desired data, e.g. "2016-04-22". Default value is today. # nolint: line_length_linter
#' @param data A vector of strings, representing the data columns to return.
#' The available options are: all, tmpf, dwpf, relh, drct, sknt, p01i, alti, mslp, vsby, gust, skyc1, skyc2, skyc3, skyc4, skyl1, skyl2, skyl3, skyl4, wxcodes, ice_accretion_1hr, ice_accretion_3hr, ice_accretion_6hr, peak_wind_gust, peak_wind_drct, peak_wind_time, feel, metar, snowdepth # nolint: line_length_linter
#' Default value is `all`.
#' @param elev If TRUE, the elevation (m) of the station will be included in the output, in an `elevation` column. # nolint: line_length_linter
#' Default value is `FALSE`.
#' @param latlon Default to `FALSE` since riem 1.0.0. If `TRUE`,
#' the latitude and longitude of the station will be included in the output,
#' in `lat` and `lon` columns. # nolint: line_length_linter
#' Default value is `FALSE`.
#' @param report_type A vector of strings, representing report types to query.
#' The available options are `"hfmetar"`, `"routine"`, `"specials"`.
#' Default value is `c("routine", "specials")`.
#'
#' @return a data.frame (tibble tibble) with measures,
#' the number of columns can vary from station to station,
#' but possible variables are
#' \itemize{
#' \item station: three or four character site identifier
#' \item valid: timestamp of the observation (UTC)
#' \item tmpf: Air Temperature in Fahrenheit, typically @ 2 meters
#' \item dwpf: Dew Point Temperature in Fahrenheit, typically @ 2 meters
#' \item relh: Relative Humidity in %
#' \item drct: Wind Direction in degrees from north
#' \item sknt: Wind Speed in knots
#' \item p01i: One hour precipitation for the period from the observation time
#' to the time of the previous hourly precipitation reset.
#' This varies slightly by site. Values are in inches.
#' This value may or may not contain frozen precipitation melted by some device
#' on the sensor or estimated by some other means. Unfortunately, we do not know
#' of an authoritative database denoting which station has which sensor.
#' \item alti: Pressure altimeter in inches
#' \item mslp: Sea Level Pressure in millibar
#' \item vsby: Visibility in miles
#' \item gust: Wind Gust in knots
#' \item skyc1: Sky Level 1 Coverage
#' \item skyc2: Sky Level 2 Coverage
#' \item skyc3: Sky Level 3 Coverage
#' \item skyc4: Sky Level 4 Coverage
#' \item skyl1: Sky Level 1 Altitude in feet
#' \item skyl2: Sky Level 2 Altitude in feet
#' \item skyl3: Sky Level 3 Altitude in feet
#' \item skyl4: Sky Level 4 Altitude in feet
#' \item presentwx: Present Weather Codes (space seperated),
#' see e.g. Chapter 8 of [this manual](https://www.ofcm.gov/publications/fmh/FMH1/FMH1.pdf) for further explanations.# nolint: line_length_linter
#' \item feel: Apparent Temperature (Wind Chill or Heat Index) in degF
#' \item ice_accretion_1hr: Ice Accretion over 1 Hour in inch
#' \item ice_accretion_3hr: Ice Accretion over 3 Hour in inch
#' \item ice_accretion_6hr: Ice Accretion over 6 Hour in inch
#' \item relh: Relative Humidity in %
#' \item metar: unprocessed reported observation in METAR format
#' \item peak_wind_gust: Wind gust in knots from the METAR PK WND remark,
#' this value may be different than the value found in the gust field.
#' The gust field is derived from the standard METAR wind report.
#' \item peak_wind_drct: The wind direction in degrees North denoted
#' in the METAR PK WND remark.
#' \item peak_wind_time: The timestamp of the PK WND value in the same timezone
#' as the valid field and controlled by the tz parameter.
#' }
#' @details The data is queried through \url{https://mesonet.agron.iastate.edu/request/download.phtml}.# nolint: line_length_linter
#' @export
#'
#' @examples
#' \dontrun{
#' riem_measures(
#' station = "VOHY",
#' date_start = "2016-01-01",
#' date_end = "2016-04-22"
#' )
#' }
riem_measures <- function(
station,
date_start,
...,
date_end = as.character(Sys.Date()),
data = "all",
elev = FALSE,
latlon = FALSE,
report_type = NULL) {
# validate 'station' arg
if (!rlang::is_character(station, n = 1L)) {
cli::cli_abort("{.arg station} must be a string.")
}
# validate 'date_start' arg
date_start <- format_and_check_date(date_start, "date_start")
# validate dots
rlang::check_dots_empty()
# validate 'date_end' arg
date_end <- format_and_check_date(date_end, "date_end")
if (date_end < date_start) {
cli::cli_abort("{.arg date_end} must be bigger than {.arg date_start}.")
}
# validate 'data' arg
data <- tolower(data) # not case-sensitive
data <- rlang::arg_match(
data,
values = c(
"all", "tmpf", "dwpf", "relh", "drct", "sknt", "p01i", "alti", "mslp",
"vsby", "gust", "skyc1", "skyc2", "skyc3", "skyc4", "skyl1", "skyl2",
"skyl3", "skyl4", "wxcodes", "ice_accretion_1hr", "ice_accretion_3hr",
"ice_accretion_6hr", "peak_wind_gust", "peak_wind_drct", "peak_wind_time",
"feel", "metar", "snowdepth"
),
multiple = TRUE
)
data <- paste(data, collapse = ",")
# validate 'elev' arg
if (!is.logical(elev)) {
cli::cli_abort("{.arg elev} must be a logical (TRUE/FALSE)") # nolint: nonportable_path_linter
}
# validate 'latlon' arg
if (!is.logical(latlon)) {
cli::cli_abort("{.arg latlon} must be a logical (TRUE/FALSE)") # nolint: nonportable_path_linter
}
# validate 'report_type' arg
report_type <- report_type %||% c("routine", "specials")
report_type <- tolower(report_type) # not case-sensitive
report_type <- rlang::arg_match(
report_type,
values = c("hfmetar", "routine", "specials"),
multiple = TRUE
)
report_type <- purrr::map_int(
report_type,
switch,
hfmetar = 1L,
routine = 3L,
specials = 4L
)
report_type <- paste(report_type, collapse = ",")
# args have been validated.
resp <- perform_riem_request(
path = "cgi-bin/request/asos.py/", # nolint: nonportable_path_linter
# query fields per https://mesonet.agron.iastate.edu/cgi-bin/request/asos.py?help # nolint: line_length_linter
query = list(
station = station,
data = data,
elev = ifelse(elev, "yes", "no"),
latlon = ifelse(latlon, "yes", "no"),
year1 = lubridate::year(date_start),
month1 = lubridate::month(date_start),
day1 = lubridate::day(date_start),
year2 = lubridate::year(date_end),
month2 = lubridate::month(date_end),
day2 = lubridate::day(date_end),
report_type = report_type,
format = "tdf",
nometa = "no",
tz = "UTC"
)
)
httr2::resp_check_status(resp)
content <- httr2::resp_body_string(resp)
col_names <- read.table(
text = content,
skip = 5L,
nrows = 1L,
na.strings = c("", "NA", "M"),
sep = "\t",
stringsAsFactors = FALSE
) %>%
t() %>%
as.character()
col_names <- gsub(" ", "", col_names, fixed = TRUE)
result <- read.table(
text = content,
skip = 6L,
col.names = col_names,
na.strings = c("", "NA", "M"),
sep = "\t",
stringsAsFactors = FALSE,
fill = TRUE
)
if (nrow(result) == 0L) {
cli::cli_warn("No results for this query.")
return(NULL)
}
result$valid <- lubridate::ymd_hm(result$valid) # nolint: extraction_operator_linter
tibble::as_tibble(result)
}
format_and_check_date <- function(date, name) {
converted_date <- suppressWarnings(lubridate::ymd(date))
if (is.na(converted_date)) {
cli::cli_abort(
message = c(
x = "Invalid {.arg {name}}: {.value {date}}.",
i = "Correct format is YYYY-MM-DD."
)
)
}
converted_date
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.