diff --git a/DESCRIPTION b/DESCRIPTION index 5be90fd..37a91b4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -49,9 +49,32 @@ Suggests: rmarkdown, rnaturalearthdata (>= 0.1), sf (>= 1.0), - sp, + terra, testthat Config/Needs/website: rrricanesdata, gganimate, magick VignetteBuilder: knitr Encoding: UTF-8 -RoxygenNote: 7.1.2 +RoxygenNote: 7.3.2 +Collate: + 'base.R' + 'data.R' + 'discus.R' + 'filters.R' + 'fstadv.R' + 'get_storm_data.R' + 'get_storm_list.R' + 'get_storms.R' + 'get_track.R' + 'get_url_contents.R' + 'gis.R' + 'Movement_fstadv.R' + 'posest.R' + 'prblty.R' + 'products.R' + 'public.R' + 'scrapers.R' + 'tidy_fstadv.R' + 'tracking_chart.R' + 'update.R' + 'utils.R' + 'wndprb.R' diff --git a/R/base.R b/R/base.R index 98e4b69..9cc176f 100644 --- a/R/base.R +++ b/R/base.R @@ -111,7 +111,7 @@ #' \code{rrricanes.working_msg} is set to FALSE by default. When TRUE, it will #' list the current storm, advisory and date being worked. #' -#' @docType package +#' @docType _PACKAGE #' @name rrricanes NULL diff --git a/R/get_storm_data.R b/R/get_storm_data.R index fd3533b..5fe9e1e 100644 --- a/R/get_storm_data.R +++ b/R/get_storm_data.R @@ -21,25 +21,28 @@ extract_product_contents <- function(links, products) { # Otherwise, extract the node from within the HTML and return the text of # that node. contents <- contents |> purrr::map_chr(.f = function(x) { + txt <- safely_read_html(x) if (is.null(txt$result)) { x } else if (is.null(txt$error)) { + xpath_to_use <- ifelse(is.na(rvest::html_node(txt$result, xpath = "//pre")), + "//table", "//pre") + .progress <- FALSE txt$result |> - rvest::html_node(xpath = "//pre") |> + rvest::html_element(xpath = xpath_to_use) |> rvest::html_text() |> stringr::str_replace_all("\r", "") |> stringr::str_to_upper() } }) + contents } #' concept for isolating this step #' @keywords internal parse_product_contents <- function(contents, products){ - f <- match.fun(products) - f(contents) - #purrr::map(.x= contents, .f = match.fun(products)) + purrr::map(.x= contents, .f = match.fun(products)) } #' @title extract_storm_links @@ -130,13 +133,13 @@ get_product <- function(links, products) { #' \dontrun{ #' ## Get public advisories for first storm of 2016 Atlantic season. #' #get_storms(year = 2016, basin = "AL") |> -#' # dplyr::slice(1) |> +#' # dplyr::slice_head(n=1) |> #' # pull(Link) |> #' # get_storm_data( products = "public") -#' ## Get public advisories and storm discussions for first storm of 2017 +#' ## Get public advisories and storm discussions for first storm of 2017 #' Atlantic season. #'# get_storms(year = 2017, basin = "AL") |> -#' # slice(1) |> +#' # slice_head(n=1) |> #' # pull(Link) |> #' # get_storm_data(products = c("discus", "public")) #' } @@ -147,8 +150,8 @@ get_storm_data <- function(links, "wndprb")) { products <- match.arg(products, several.ok = TRUE) - # extract_product_contents(links, products) - purrr::map2(links, products, extract_product_contents) + + purrr::map2(links, products, extract_product_contents, .progress = FALSE) } #' @title get_product_links diff --git a/R/get_url_contents.R b/R/get_url_contents.R index c7fb1df..bfde44e 100644 --- a/R/get_url_contents.R +++ b/R/get_url_contents.R @@ -37,9 +37,6 @@ get_url_contents <- function(links) { groups <- ceiling(seq_along(1:length(links))/80) grouped_links <- split(links, groups) - # Set progress bar - p <- dplyr::progress_estimated(n = length(links)) - contents <- grouped_links |> purrr::imap(.f = function(x, y) { @@ -48,18 +45,16 @@ get_url_contents <- function(links) { # Send group of links to `download_txt` txt <- download_text(x) # We are not in the last group; apply a delay - p$tick()$print() if (getOption("rrricanes.working_msg")) message("Waiting 10 seconds to retrieve large numbers of links.") - p$pause(10) txt } else { # Send group of links to `download_txt` - p$tick()$print() download_text(x) } }) - contents <- unsplit(contents, groups) -contents - #purrr::flatten_chr(contents) + + contents <- unsplit(contents, groups) + #purrr::list_c(contents) + contents } diff --git a/R/prblty.R b/R/prblty.R index dccc80c..25343f7 100644 --- a/R/prblty.R +++ b/R/prblty.R @@ -75,7 +75,7 @@ prblty <- function(contents) { ., "X", "O"))) -print(prblty()) + # Convert date prblty <- prblty |> dplyr::mutate( Date =