#' @title get_prblty
#' @description Strike probabilities; the chances of the center of a cyclone
#' passing within 65 nautical miles of a location.
#' \describe{
#' \item{Status}{Classification of storm, e.g., Tropical Storm, Hurricane,
#' etc.}
#' \item{Name}{Name of storm}
#' \item{Adv}{Advisory Number}
#' \item{Date}{Date of advisory issuance}
#' \item{Location}{Location for which the probability statistics rely}
#' \item{A}{Probability of a strike within the next 12 hours}
#' \item{B}{Probability of a strike between 12 and 24 hours}
#' \item{C}{Probability of a strike between 24 and 36 hours}
#' \item{D}{Probability of a strike between 36 and 48 hours}
#' \item{E}{Probability of a strike between 48 and 72 hours}
#' }
#' @param links URL to storm's archive page.
#' @export
get_prblty <- function(links) {
get_product(links = links, products = "prblty")
}
#' @title prblty
#' @description Parse strike probability products
#' @details Given a direct link to a strike probability advisory product, parse
#' and return dataframe of values.
#' @param contents Link to a storm's specific strike probability
#' advisory product.
#' @return Dataframe
#' @seealso \code{\link{get_prblty}}
#' @keywords internal
prblty <- function(contents) {
status <- scrape_header(
contents = contents,
# The "SPECIAL" pattern has to be left here; moving it under
# `scrape_header` will break posest and update products.
ptn_product_title = "(?:\n?SPECIAL\\s+)?(?:PROBABILITIES)?"
)
issue_date <- scrape_date(contents)
# 15.0N 43.4W 43 1 X X 44 16.8N 48.2W X 4 16 2 22
# 15.8N 45.9W 1 26 1 X 28
ptn <- stringr::str_c("(?<=[:blank:]{3}|\n)",
"([[:alpha:][:digit:][:punct:][:blank:]]{17})",
# Location
"[:blank:]+", # Delimiter
"([:digit:]{1,2}|X)", # A
"[:blank:]+", # Delimiter
"([:digit:]{1,2}|X)", # B
"[:blank:]+", # Delimiter
"([:digit:]{1,2}|X)", # C
"[:blank:]+", # Delimiter
"([:digit:]{1,2}|X)", # D
"[:blank:]+", # Delimiter
"([:digit:]{1,2}|X)") # E
prblty <-
contents |>
stringr::str_match_all(ptn) |>
purrr::map(tibble::as_tibble, .name_repair =
~c("X1", "Location", "A", "B", "C", "D", "E")) |>
purrr::map2(status[1], ~tibble::add_column(.x, Status = .y, .before = 1)) |>
purrr::map2(status[2], ~tibble::add_column(.x, Name = .y, .after = 1)) |>
purrr::map2(status[3], ~tibble::add_column(.x, Adv = .y, .after = 2)) |>
purrr::map2(issue_date, ~tibble::add_column(.x, Date = .y, .after = 3)) # |>
prblty <- prblty |> purrr::map_df(tibble::as_tibble, .name_repair = "minimal") |>
dplyr::select(-c("X1")) |>
# Trim whitespace
dplyr::mutate(dplyr::across(.cols = everything(), .fns = ~stringr::str_trim(.))) |>
dplyr::mutate(dplyr::across(.cols = everything(), .fns = ~stringr::str_replace(
.,
"X",
"O")))
print(prblty())
# Convert date
prblty <- prblty |> dplyr::mutate(
Date =
lubridate::ymd_hms(Date)
)
# prblty <- prblty |> dplyr::mutate(
# across(c(6:10),
# ~as.numeric(.))
#)
prblty
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.