Skip to content

Commit

Permalink
Added native pipe where compatible
Browse files Browse the repository at this point in the history
  • Loading branch information
@SimonAytes
SimonAytes committed Apr 26, 2022
1 parent cb94a91 commit b29a299
Show file tree
Hide file tree
Showing 24 changed files with 266 additions and 266 deletions.
104 changes: 52 additions & 52 deletions R/fstadv.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -128,7 +128,7 @@ fstadv <- function(contents) {
Seas = seas,
WindRadius = wind_radius,
Forecast = forecasts
) %>%
) |>

tidyr::unnest(cols = c(.data$Seas,
.data$WindRadius,
Expand Down Expand Up @@ -166,8 +166,8 @@ fstadv_forecasts <- function(content, key, adv, adv_date) {
rebuild_forecasts <- function(hr, df) {

df <-
df %>%
dplyr::filter(.data$FcstPeriod == hr) %>%
df |>
dplyr::filter(.data$FcstPeriod == hr) |>
dplyr::select(
.data$Key,
.data$Adv,
Expand All @@ -179,7 +179,7 @@ fstadv_forecasts <- function(content, key, adv, adv_date) {
tidyselect::ends_with("64"),
tidyselect::ends_with("50"),
tidyselect::ends_with("34")
) %>%
) |>
rlang::set_names(
# Prepend forecast variables with "Hr", the value of `hr`, and the
# variable name.
Expand Down Expand Up @@ -237,17 +237,17 @@ fstadv_forecasts <- function(content, key, adv, adv_date) {
# 96 and 120 hours). Some text products may have no forecasts at all (if the
# storm is expected to degenerate or already has).
forecasts <-
content %>%
stringr::str_match_all(pattern = ptn) %>%
content |>
stringr::str_match_all(pattern = ptn) |>
# # Get only the columns needed excluding the matched string
# purrr::map(`[`, , 2:22) %>%
# purrr::map(`[`, , 2:22) |>
# If any storm has 0 forecasts (i.e., the list element is empty), populate
# all columns with NA
purrr::modify_if(.p = purrr::is_empty,
.f = ~matrix(data = NA_character_, ncol = 22)) %>%
.f = ~matrix(data = NA_character_, ncol = 22)) |>
# Convert to tibble cause God I hate working with lists like this though I
# know I need the practice...
purrr::map(tibble::as_tibble, .name_repair = "minimal") %>%
purrr::map(tibble::as_tibble, .name_repair = "minimal") |>
purrr::map(rlang::set_names,
nm = c("String", "Date", "Hour", "Minute",
"Lat", "LatHemi", "Lon", "LonHemi",
Expand All @@ -268,10 +268,10 @@ fstadv_forecasts <- function(content, key, adv, adv_date) {
Adv = as.numeric(adv),
AdvDate = adv_date,
Forecasts = forecasts
) %>%
) |>

tidyr::unnest(cols = c(.data$Forecasts)) %>%
dplyr::group_by(.data$Key, .data$Adv) %>%
tidyr::unnest(cols = c(.data$Forecasts)) |>
dplyr::group_by(.data$Key, .data$Adv) |>
# If the date of the forecast is less than that of the advisory, the forecast
# period runs into the next month; so need to account for that. Otherwise,
# the month should be the same.
Expand Down Expand Up @@ -310,23 +310,23 @@ fstadv_forecasts <- function(content, key, adv, adv_date) {
LonHemi == "W" ~ as.numeric(.data$Lon) * -1,
TRUE ~ as.numeric(.data$Lon)
)
) %>%
) |>
# Make Wind, Gust, relative wind/gust vars and sea vars all numeric
dplyr::mutate_at(dplyr::vars(.data$Wind:.data$NW34), .funs = as.numeric)

df <- rebuild_forecasts(12, df = df_forecasts)

for (hr in forecast_periods[2:7]) {
df <-
df %>%
df |>
dplyr::left_join(
rebuild_forecasts(hr, df = df_forecasts), by = c("Key", "Adv")
)
}

df %>%
dplyr::ungroup() %>%
dplyr::select(-c(.data$Key, .data$Adv)) %>%
df |>
dplyr::ungroup() |>
dplyr::select(-c(.data$Key, .data$Adv)) |>
split(seq(nrow(.)))

}
Expand Down Expand Up @@ -393,7 +393,7 @@ fstadv_prev_pos <- function(contents, adv_date) {
tibble::tibble(
PrevPosDate = prev_pos_date,
PrevPosLat = prev_pos_lat,
PrevPosLon = prev_pos_lon) %>%
PrevPosLon = prev_pos_lon) |>
split(seq(nrow(.)))
}

Expand Down Expand Up @@ -443,10 +443,10 @@ fstadv_seas <- function(content) {
"[:blank:]+([0-9]{1,3})SW",
"[:blank:]+([0-9]{1,3})NW")

stringr::str_match(content, ptn)[,2:5] %>%
apply(MARGIN = 2L, FUN = as.numeric) %>%
tibble::as_tibble(.name_repair = "minimal") %>%
rlang::set_names(nm = stringr::str_c("Seas", c("NE", "SE", "SW", "NW"))) %>%
stringr::str_match(content, ptn)[,2:5] |>
apply(MARGIN = 2L, FUN = as.numeric) |>
tibble::as_tibble(.name_repair = "minimal") |>
rlang::set_names(nm = stringr::str_c("Seas", c("NE", "SE", "SW", "NW"))) |>
split(seq(nrow(.)))
}

Expand Down Expand Up @@ -484,13 +484,13 @@ fstadv_wind_radius <- function(content) {
"SW[:blank:]+([:digit:]{1,3})",
"NW[[:punct:][:space:]]+)?")

stringr::str_match(content, ptn)[,2:16] %>%
apply(MARGIN = 2L, FUN = as.numeric) %>%
tibble::as_tibble(.name_repair = "minimal") %>%
stringr::str_match(content, ptn)[,2:16] |>
apply(MARGIN = 2L, FUN = as.numeric) |>
tibble::as_tibble(.name_repair = "minimal") |>
rlang::set_names(nm = c("WindField64", "NE64", "SE64", "SW64", "NW64",
"WindField50", "NE50", "SE50", "SW50", "NW50",
"WindField34", "NE34", "SE34", "SW34", "NW34")) %>%
dplyr::select(-tidyselect::starts_with("WindField")) %>%
"WindField34", "NE34", "SE34", "SW34", "NW34")) |>
dplyr::select(-tidyselect::starts_with("WindField")) |>
split(seq(nrow(.)))
}

Expand Down Expand Up @@ -540,14 +540,14 @@ fstadv_winds_gusts <- function(contents) {
#' }
#' @examples
#' \dontrun{
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") %>%
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") |>
#' tidy_adv()
#' }
#' @export
tidy_adv <- function(df) {
if (!is.data.frame(df))
stop("Expecting a dataframe.")
df <- df %>%
df <- df |>
dplyr::select(
"Key",
.data$Adv:.data$Date,
Expand Down Expand Up @@ -584,7 +584,7 @@ tidy_fstadv <- function(df) {
#' }
#' @examples
#' \dontrun{
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") %>%
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") |>
#' tidy_wr()
#' }
#' @export
Expand All @@ -599,21 +599,21 @@ tidy_wr <- function(df) {
wr <- purrr::map_df(
.x = c(34, 50, 64),
.f = function(y) {
df %>%
dplyr::select(c("Key", "Adv", "Date", paste0(v, y))) %>%
df |>
dplyr::select(c("Key", "Adv", "Date", paste0(v, y))) |>
dplyr::rename(
"Key" = "Key",
"Adv" = "Adv",
"Date" = "Date",
"NE" = paste0("NE", y),
"SE" = paste0("SE", y),
"SW" = paste0("SW", y),
"NW" = paste0("NW", y)) %>%
"NW" = paste0("NW", y)) |>
dplyr::mutate("WindField" = y)
}) %>%
}) |>
dplyr::select(c(
"Key", "Adv", "Date", "WindField", .data$NE:.data$NW
)) %>%
)) |>
# Order by Date then Adv since Adv is character. Results as expected.
dplyr::arrange(.data$Key, .data$Date, .data$Adv, .data$WindField)

Expand Down Expand Up @@ -642,7 +642,7 @@ tidy_wr <- function(df) {
#' }
#' @examples
#' \dontrun{
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") %>%
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") |>
#' tidy_fcst()
#' }
#' @export
Expand All @@ -660,23 +660,23 @@ tidy_fcst <- function(df) {

# What forecast periods are in the current dataset?
# #107 Modified regex pattern to look for Hr120, as well.
fcst_periods <- as.list(names(df)) %>%
stringr::str_match(pattern = "Hr([:digit:]{2,3})FcstDate") %>%
.[,2] %>%
.[!rlang::are_na(.)] %>%
fcst_periods <- as.list(names(df)) |>
stringr::str_match(pattern = "Hr([:digit:]{2,3})FcstDate") |>
.[,2] |>
.[!rlang::are_na(.)] |>
as.numeric()

forecasts <- purrr::map_df(
.x = fcst_periods,
.f = function(y) {
df %>%
dplyr::select(c("Key", "Adv", "Date", paste0("Hr", y, v))) %>%
df |>
dplyr::select(c("Key", "Adv", "Date", paste0("Hr", y, v))) |>
dplyr::rename("Key" = "Key", "Adv" = "Adv", "Date" = "Date",
"FcstDate" = paste0("Hr", y, "FcstDate"),
"Lat" = paste0("Hr", y, "Lat"),
"Lon" = paste0("Hr", y, "Lon"),
"Wind" = paste0("Hr", y, "Wind"),
"Gust" = paste0("Hr", y, "Gust"))}) %>%
"Gust" = paste0("Hr", y, "Gust"))}) |>
dplyr::arrange(.data$Key, .data$Date, .data$Adv, .data$FcstDate)

# Remove NA rows
Expand Down Expand Up @@ -706,7 +706,7 @@ tidy_fcst <- function(df) {
#' }
#' @examples
#' \dontrun{
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") %>%
#' get_fstadv("http://www.nhc.noaa.gov/archive/1998/1998ALEXadv.html") |>
#' tidy_fcst_wr()
#' }
#' @export
Expand All @@ -722,10 +722,10 @@ tidy_fcst_wr <- function(df) {
v <- c("NE", "SE", "SW", "NW")

# What forecast periods are in the current dataset?
fcst_periods <- as.list(names(df)) %>%
stringr::str_match(pattern = "Hr([:digit:]{2})FcstDate") %>%
.[,2] %>%
.[!rlang::are_na(.)] %>%
fcst_periods <- as.list(names(df)) |>
stringr::str_match(pattern = "Hr([:digit:]{2})FcstDate") |>
.[,2] |>
.[!rlang::are_na(.)] |>
as.numeric()

fcst_wr <- purrr::map_df(
Expand All @@ -736,11 +736,11 @@ tidy_fcst_wr <- function(df) {
if (x %in% c(96, 120)) return(NULL)
y <- purrr::map_df(.x = fcst_wind_radii, .f = function(z) {

df %>%
df |>
dplyr::select(c(
"Key", "Adv", "Date", paste0("Hr", x, "FcstDate"),
paste0("Hr", x, v, z)
)) %>%
)) |>
dplyr::rename(
"Key" = "Key",
"Adv" = "Adv",
Expand All @@ -749,8 +749,8 @@ tidy_fcst_wr <- function(df) {
"NE" = paste0("Hr", x, "NE", z),
"SE" = paste0("Hr", x, "SE", z),
"SW" = paste0("Hr", x, "SW", z),
"NW" = paste0("Hr", x, "NW", z)) %>%
dplyr::mutate("WindField" = z) %>%
"NW" = paste0("Hr", x, "NW", z)) |>
dplyr::mutate("WindField" = z) |>
dplyr::select(c(
.data$Key:.data$FcstDate,
"WindField",
Expand Down
42 changes: 21 additions & 21 deletions R/get_storm_data.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -12,8 +12,8 @@ extract_product_contents <- function(links, product) {
contents <- purrr::imap(contents, safely_read_html)

contents <-
links %>%
get_url_contents() %>% # Read in contents as html
links |>
get_url_contents() |> # Read in contents as html
# If text is not within html, then we simply need to return the text.
# Otherwise, extract the node from within the HTML and return the text of
# that node.
Expand All @@ -22,10 +22,10 @@ extract_product_contents <- function(links, product) {
if (is.null(txt$result)) {
x
} else if (is.null(txt$error)) {
txt$result %>%
rvest::html_node(xpath = "//pre") %>%
rvest::html_text() %>%
stringr::str_replace_all("\r", "") %>%
txt$result |>
rvest::html_node(xpath = "//pre") |>
rvest::html_text() |>
stringr::str_replace_all("\r", "") |>
stringr::str_to_upper()
}
})
Expand All @@ -45,16 +45,16 @@ extract_storm_links <- function(links) {

# Get links of text products from each `links`
product_links <-
links %>%
get_url_contents() %>%
purrr::imap(.f = xml2::read_html) %>%
links |>
get_url_contents() |>
purrr::imap(.f = xml2::read_html) |>
# Extract the html tables from each link to get the storm's text products
purrr::imap(.f = ~rvest::html_nodes(.x, xpath = "//td//a")) %>%
purrr::imap(.f = ~rvest::html_nodes(.x, xpath = "//td//a")) |>
# Extract the text product URLs from `nodes`
purrr::imap(.f = ~rvest::html_attr(.x, name = "href")) %>%
purrr::flatten_chr() %>%
purrr::imap(.f = ~rvest::html_attr(.x, name = "href")) |>
purrr::flatten_chr() |>
# Ensure we're only capturing archive pages
stringr::str_match( "archive.+") %>%
stringr::str_match( "archive.+") |>
.[stats::complete.cases(.)]

# Extract years from `links`
Expand All @@ -75,8 +75,8 @@ extract_storm_links <- function(links) {
#' process and return a dataset for that product.
#' @keywords internal
get_product <- function(links, product) {
links %>%
purrr::map2(.y = product, .f = get_storm_data) %>%
links |>
purrr::map2(.y = product, .f = get_storm_data) |>
purrr::flatten_df()
}

Expand Down Expand Up @@ -117,14 +117,14 @@ get_product <- function(links, product) {
#' @examples
#' \dontrun{
#' ## Get public advisories for first storm of 2016 Atlantic season.
#' get_storms(year = 2016, basin = "AL") %>%
#' slice(1) %>%
#' .$Link %>%
#' get_storms(year = 2016, basin = "AL") |>
#' slice(1) |>
#' .$Link |>
#' get_storm_data(products = "public")
#' ## Get public advisories and storm discussions for first storm of 2017 Atlantic season.
#' get_storms(year = 2017, basin = "AL") %>%
#' slice(1) %>%
#' .$Link %>%
#' get_storms(year = 2017, basin = "AL") |>
#' slice(1) |>
#' .$Link |>
#' get_storm_data(products = c("discus", "public"))
#' }
#' @export
Expand Down
Loading

0 comments on commit b29a299

Please sign in to comment.