Skip to content

Commit

Permalink
Modify, clean up return dataframes
Browse files Browse the repository at this point in the history
* `Key` variable added to `discus` dataframes. `Key` will be NA for all cyclones >= 2005. Should not be <= 2006. (#80)

* Removed `Adv` variable from `posest` dataframes. Position estimates do not have advisory numbers. (#81)

* Removed `Adv` variable from `update`. Updates do not have advisory numbers. (#84)

* Added variable `Key` to `get_public` dataframes. (#85)

* Added variable `Key` to `get_update` dataframes. (#86)

* Removed non-existent wind radii variables in `get_fstadv`. Hrs 48 and 72 hours only have 34 and 50kt wind fields. Hrs 96 and 120 have none. (#89)
  • Loading branch information
timtrice committed Jun 26, 2017
2 parents 7a5c2ae + 83924db commit 2d539ca
Show file tree
Hide file tree
Showing 25 changed files with 519 additions and 32 deletions.
26 changes: 26 additions & 0 deletions CHANGELOG.md
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,32 @@ All notable changes to this project will be documented in this file.

The format is based on [Keep a Changelog](http://keepachangelog.com/) and this project adheres to [Semantic Versioning](http://semver.org/).

## [0.2.0-4] 2017-06-25

### Added
- NA

### Changed
- Added variable `Key` to `discus` dataframes. (#80)
- Removed variable `Adv` from `posest`. Position estimates do not have advisory numbers. (#81)
- Fix `scrape_adv_num` to accomodate possible "INTERMEDIATE" text in Public Advisory headers. (#83)
- Remove variable `Adv` from `update`. Updates do not have advisory numbers. (#84)
- Added variable `Key` to `get_public` dataframes. (#85)
- Added variable `Key` to `get_update` dataframes. (#86)
- Removed non-existent wind radii variables in `get_fstadv`. Hrs 48 and 72 hours only have 34 and 50kt wind fields. Hrs 96 and 120 have none. (#89)

### Removed
- NA

### Deprecated
- NA

### Fixed
- NA

### Security
- NA

## [0.2.0-3] 2017-06-22

### Added
Expand Down
3 changes: 1 addition & 2 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ Title: Web scraper for Atlantic and east Pacific hurricanes and tropical storms
Description: Get archived data of past and current hurricanes and tropical
storms for the Atlantic and eastern Pacific oceans. Data is available for
storms since 1998.
Version: 0.2.0-3
Version: 0.2.0-4
Authors@R: c(person("Tim", "Trice", email = "[email protected]", role = c("aut", "cre")))
Maintainer: Tim Trice <[email protected]>
Depends:
Expand Down Expand Up @@ -35,7 +35,6 @@ Imports:
Suggests:
devtools,
dwapi,
geosphere,
knitr,
rmarkdown,
testthat,
Expand Down
24 changes: 24 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,27 @@
rrricanes 0.2.0-4 (2017-06-25)
==================================

### NEW FEATURES

* NA

### MINOR IMPROVEMENTS

* `Key` variable added to `discus` dataframes. `Key` will be NA for all cyclones >= 2005. Should not be <= 2006. (#80)
* Removed `Adv` variable from `posest` dataframes. Position estimates do not have advisory numbers. (#81)
* Removed `Adv` variable from `update`. Updates do not have advisory numbers. (#84)
* Added variable `Key` to `get_public` dataframes. (#85)
* Added variable `Key` to `get_update` dataframes. (#86)
* Removed non-existent wind radii variables in `get_fstadv`. Hrs 48 and 72 hours only have 34 and 50kt wind fields. Hrs 96 and 120 have none. (#89)

### BUG FIXES

* NA

### DEPRECATED AND DEFUNCT

* NA

rrricanes 0.2.0-3 (2017-06-22)
==================================

Expand Down
14 changes: 14 additions & 0 deletions R/discus.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ create_df_discus <- function() {
# i.e., "1A", "2", "2A"...
"Adv" = character(),
"Date" = as.POSIXct(character(), tz = "UTC"),
"Key" = character(),
"Contents" = character())

return(df)
Expand All @@ -23,6 +24,7 @@ create_df_discus <- function() {
#' \item{Name}{Name of storm}
#' \item{Adv}{Advisory Number}
#' \item{Date}{Date of advisory issuance}
#' \item{Key}{ID of cyclone}
#' \item{Contents}{Text content of product}
#' }
#' @param link URL to storm's archive page.
Expand Down Expand Up @@ -84,6 +86,17 @@ discus <- function(link, p = dplyr::progress_estimated(n = 1)) {
adv <- scrape_header(contents, ret = "adv")
date <- scrape_header(contents, ret = "date")

# Keys were added to discus products beginning 2006. Prior, it doesn't
# exist. safely run scrape_header for key. If error, then use NA. Otherwise,
# add it.
safely_scrape_header <- purrr::safely(scrape_header)
key <- safely_scrape_header(contents, ret = "key")
if (is.null(key$error)) {
key <- key$result
} else {
key <- NA
}

if (getOption("rrricanes.working_msg"))
message(sprintf("Working %s %s Storm Discussion #%s (%s)",
status, name, adv, date))
Expand All @@ -93,6 +106,7 @@ discus <- function(link, p = dplyr::progress_estimated(n = 1)) {
"Name" = name,
"Adv" = adv,
"Date" = date,
"Key" = key,
"Contents" = contents)

return(df)
Expand Down
159 changes: 148 additions & 11 deletions R/fstadv.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,129 @@
#' @title create_df_fstadv
#' @description Template for forecast/advisories dataframe
#' @return empty dataframe
#' @seealso \code{\link{get_fstadv}}
#' @keywords internal
create_df_fstadv <- function() {
df <- tibble::data_frame(Status = character(),
Name = character(),
Adv = integer(),
Date = as.POSIXct(character(), tz = "UTC"),
Key = character(),
Lat = numeric(),
Lon = numeric(),
Wind = integer(),
Gust = integer(),
Pressure = integer(),
PosAcc = integer(),
FwdDir = integer(),
FwdSpeed = integer(),
Eye = integer(),
SeasNE = integer(),
SeasSE = integer(),
SeasSW = integer(),
SeasNW = integer(),
NE64 = integer(),
SE64 = integer(),
SW64 = integer(),
NW64 = integer(),
NE50 = integer(),
SE50 = integer(),
SW50 = integer(),
NW50 = integer(),
NE34 = integer(),
SE34 = integer(),
SW34 = integer(),
NW34 = integer(),
Hr12FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr12Lat = numeric(),
Hr12Lon = numeric(),
Hr12Wind = integer(),
Hr12Gust = integer(),
Hr12NE64 = integer(),
Hr12SE64 = integer(),
Hr12SW64 = integer(),
Hr12NW64 = integer(),
Hr12NE50 = integer(),
Hr12SE50 = integer(),
Hr12SW50 = integer(),
Hr12NW50 = integer(),
Hr12NE34 = integer(),
Hr12SE34 = integer(),
Hr12SW34 = integer(),
Hr12NW34 = integer(),
Hr24FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr24Lat = numeric(),
Hr24Lon = numeric(),
Hr24Wind = integer(),
Hr24Gust = integer(),
Hr24NE64 = integer(),
Hr24SE64 = integer(),
Hr24SW64 = integer(),
Hr24NW64 = integer(),
Hr24NE50 = integer(),
Hr24SE50 = integer(),
Hr24SW50 = integer(),
Hr24NW50 = integer(),
Hr24NE34 = integer(),
Hr24SE34 = integer(),
Hr24SW34 = integer(),
Hr24NW34 = integer(),
Hr36FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr36Lat = numeric(),
Hr36Lon = numeric(),
Hr36Wind = integer(),
Hr36Gust = integer(),
Hr36NE64 = integer(),
Hr36SE64 = integer(),
Hr36SW64 = integer(),
Hr36NW64 = integer(),
Hr36NE50 = integer(),
Hr36SE50 = integer(),
Hr36SW50 = integer(),
Hr36NW50 = integer(),
Hr36NE34 = integer(),
Hr36SE34 = integer(),
Hr36SW34 = integer(),
Hr36NW34 = integer(),
Hr48FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr48Lat = numeric(),
Hr48Lon = numeric(),
Hr48Wind = integer(),
Hr48Gust = integer(),
Hr48NE50 = integer(),
Hr48SE50 = integer(),
Hr48SW50 = integer(),
Hr48NW50 = integer(),
Hr48NE34 = integer(),
Hr48SE34 = integer(),
Hr48SW34 = integer(),
Hr48NW34 = integer(),
Hr72FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr72Lat = numeric(),
Hr72Lon = numeric(),
Hr72Wind = integer(),
Hr72Gust = integer(),
Hr72NE50 = integer(),
Hr72SE50 = integer(),
Hr72SW50 = integer(),
Hr72NW50 = integer(),
Hr72NE34 = integer(),
Hr72SE34 = integer(),
Hr72SW34 = integer(),
Hr72NW34 = integer(),
Hr96FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr96Lat = numeric(),
Hr96Lon = numeric(),
Hr96Wind = integer(),
Hr96Gust = integer(),
Hr120FcstDate = as.POSIXct(character(), tz = "UTC"),
Hr120Lat = numeric(),
Hr120Lon = numeric(),
Hr120Wind = integer(),
Hr120Gust = integer())
return(df)
}

#' @title get_fstadv
#' @description Return dataframe of forecast/advisory data.
#' @param link URL to storms' archive page.
Expand Down Expand Up @@ -121,6 +247,8 @@ fstadv <- function(link, p = dplyr::progress_estimated(n = 1)) {
"HFOTCMEP", "HFOTCMCP"))))
stop(sprintf("Invalid Forecast/Advisory link. %s", link))

df <- create_df_fstadv()

status <- scrape_header(contents, ret = "status")
name <- scrape_header(contents, ret = "name")
adv <- scrape_header(contents, ret = "adv")
Expand All @@ -141,12 +269,13 @@ fstadv <- function(link, p = dplyr::progress_estimated(n = 1)) {
wind <- fstadv_winds(contents)
gust <- fstadv_gusts(contents)

df <- tibble::data_frame("Status" = status, "Name" = name, "Adv" = adv,
"Date" = date, "Key" = key, "Lat" = lat,
"Lon" = lon, "Wind" = wind, "Gust" = gust,
"Pressure" = pressure, "PosAcc" = posacc,
"FwdDir" = fwd_dir, "FwdSpeed" = fwd_speed,
"Eye" = eye)
df <- df %>%
tibble::add_row("Status" = status, "Name" = name, "Adv" = adv,
"Date" = date, "Key" = key, "Lat" = lat,
"Lon" = lon, "Wind" = wind, "Gust" = gust,
"Pressure" = pressure, "PosAcc" = posacc,
"FwdDir" = fwd_dir, "FwdSpeed" = fwd_speed,
"Eye" = eye)

# Add current wind radius
wind_radius <- fstadv_wind_radius(contents, wind)
Expand All @@ -161,7 +290,7 @@ fstadv <- function(link, p = dplyr::progress_estimated(n = 1)) {
if (all(!is.null(seas), nrow(seas) > 1)) {
warning(sprintf("Too many rows of sea data for %s %s #%s.\n%s",
status, name, adv, seas[2:nrow(seas),]),
call.= FALSE)
call. = FALSE)
seas <- seas[1,]
}

Expand Down Expand Up @@ -309,10 +438,13 @@ fstadv_forecasts <- function(content, date) {
fcst_periods,
function(a, b) {
stats::setNames(df[[a]], paste0(b, names(df[[a]])))
})
})

df <- dplyr::bind_cols(df)

# Filter out all NA columns
df <- df[,colSums(is.na(df)) != nrow(df)]

return(df)
}

Expand Down Expand Up @@ -764,6 +896,7 @@ tidy_fcst <- function(df) {
#' }
#' @export
tidy_fcst_wr <- function(df) {

if (!is.data.frame(df))
stop("Expecting a dataframe.")

Expand All @@ -783,7 +916,10 @@ tidy_fcst_wr <- function(df) {
df <- purrr::map_df(
.x = fcst_periods,
.f = function(x) {
y <- purrr::map_df(.x = c(34, 50, 64), .f = function(z) {
if (x %in% c(12, 24, 36)) fcst_wind_radii <- c(34, 50, 64)
if (x %in% c(48, 72)) fcst_wind_radii <- c(34, 50)
if (x %in% c(96, 120)) return(NULL)
y <- purrr::map_df(.x = fcst_wind_radii, .f = function(z) {
dplyr::select_(df, .dots = c("Key", "Adv", "Date",
paste0("Hr", x, "FcstDate"),
paste0("Hr", x, v, z))) %>%
Expand All @@ -803,9 +939,10 @@ tidy_fcst_wr <- function(df) {
return(y)
})

df <- df %>% dplyr::arrange_("Key", "Date", "Adv",
"FcstDate", "WindField")
df <- df %>% dplyr::arrange_("Key", "Date", "Adv", "FcstDate", "WindField")

df <- df[stats::complete.cases(df$NE, df$SE, df$SW, df$NW),]

return(df)

}
8 changes: 1 addition & 7 deletions R/posest.R
Original file line number Diff line number Diff line change
Expand Up @@ -6,9 +6,6 @@
create_df_posest <- function() {
df <- tibble::data_frame("Status" = character(),
"Name" = character(),
# Allow for intermediate advisories,
# i.e., "1A", "2", "2A"...
"Adv" = character(),
"Date" = as.POSIXct(character(), tz = "UTC"),
"Contents" = character())

Expand All @@ -23,7 +20,6 @@ create_df_posest <- function() {
#' \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{Contents}{Text content of product}
#' }
Expand Down Expand Up @@ -74,17 +70,15 @@ posest <- function(link, p = dplyr::progress_estimated(n = 1)) {

status <- scrape_header(contents, ret = "status")
name <- scrape_header(contents, ret = "name")
adv <- scrape_header(contents, ret = "adv")
date <- scrape_header(contents, ret = "date")

if (getOption("rrricanes.working_msg"))
message(sprintf("Working %s %s Position Estimate #%s (%s)",
status, name, adv, date))
status, name, date))

df <- df %>%
tibble::add_row("Status" = status,
"Name" = name,
"Adv" = adv,
"Date" = date,
"Contents" = contents)

Expand Down
Loading

0 comments on commit 2d539ca

Please sign in to comment.