Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 25 additions & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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'
2 changes: 1 addition & 1 deletion R/base.R
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
21 changes: 12 additions & 9 deletions R/get_storm_data.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"))
#' }
Expand All @@ -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
Expand Down
13 changes: 4 additions & 9 deletions R/get_url_contents.R
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand All @@ -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
}
2 changes: 1 addition & 1 deletion R/prblty.R
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ prblty <- function(contents) {
.,
"X",
"O")))
print(prblty())

# Convert date
prblty <- prblty |> dplyr::mutate(
Date =
Expand Down