From c9620dc04097a6575fd05fc1cd7873f7ae6f93fc Mon Sep 17 00:00:00 2001 From: hrbrmstr Date: Sat, 3 Oct 2020 06:38:01 -0400 Subject: [PATCH] initial commit --- DESCRIPTION | 17 +++- NAMESPACE | 22 +++++- R/f5wx-package.R | 14 +++- R/main.R | 215 +++++++++++++++++++++++++++++++++++++++++++++++++++ R/utils-pipe.R | 11 +++ man/f5wx.Rd | 5 +- man/f5wx_chart.Rd | 25 ++++++ man/f5wx_forecast.Rd | 25 ++++++ man/f5wx_login.Rd | 26 +++++++ man/pipe.Rd | 12 +++ 10 files changed, 362 insertions(+), 10 deletions(-) create mode 100644 R/main.R create mode 100644 R/utils-pipe.R create mode 100644 man/f5wx_chart.Rd create mode 100644 man/f5wx_forecast.Rd create mode 100644 man/f5wx_login.Rd create mode 100644 man/pipe.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 18a12df..31caef7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: f5wx Type: Package -Title: f5wx title goes here otherwise CRAN checks fail +Title: Orchestrate the Hidden API at F5 Weather Version: 0.1.0 Date: 2020-10-03 Authors@R: c( @@ -8,7 +8,8 @@ Authors@R: c( comment = c(ORCID = "0000-0001-5670-2640")) ) Maintainer: Bob Rudis -Description: A good description goes here otherwise CRAN checks fail. +Description: F5 Weather has great data but terrible forecast table aesthetics. + Tools are provided to orchestrate and chart F5 Weather data. URL: https://git.rud.is/hrbrmstr/f5wx BugReports: https://git.rud.is/hrbrmstr/f5wx/issues Encoding: UTF-8 @@ -18,7 +19,17 @@ Suggests: Depends: R (>= 3.5.0) Imports: + dplyr, + forcats, + ggplot2, + hrbrthemes, + htmltools, httr, - jsonlite + magrittr, + rvest, + stringi, + tibble, + tidyr, + xml2 Roxygen: list(markdown = TRUE) RoxygenNote: 7.1.1 diff --git a/NAMESPACE b/NAMESPACE index 5b4b9ae..e3890c5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,4 +1,24 @@ # Generated by roxygen2: do not edit by hand +export("%>%") +export(f5wx_chart) +export(f5wx_forecast) +export(f5wx_login) +import(ggplot2) +import(hrbrthemes) +import(htmltools) import(httr) -importFrom(jsonlite,fromJSON) +import(rvest) +import(stringi) +import(xml2) +importFrom(dplyr,bind_rows) +importFrom(dplyr,count) +importFrom(dplyr,filter) +importFrom(dplyr,left_join) +importFrom(dplyr,mutate) +importFrom(dplyr,rename) +importFrom(forcats,fct_inorder) +importFrom(forcats,fct_rev) +importFrom(magrittr,"%>%") +importFrom(tibble,as_tibble) +importFrom(tidyr,replace_na) diff --git a/R/f5wx-package.R b/R/f5wx-package.R index 357f28c..8859c29 100644 --- a/R/f5wx-package.R +++ b/R/f5wx-package.R @@ -1,9 +1,15 @@ -#' ... -#' +#' Orchestrate the Hidden API at F5 Weather +#' +#' F5 Weather has great data but terrible forecast table aesthetics. +#' Tools are provided to orchestrate and chart F5 Weather data. +#' #' @md #' @name f5wx #' @keywords internal #' @author Bob Rudis (bob@@rud.is) -#' @import httr -#' @importFrom jsonlite fromJSON +#' @import httr rvest stringi htmltools hrbrthemes ggplot2 xml2 +#' @importFrom tibble as_tibble +#' @importFrom dplyr bind_rows mutate filter count rename left_join +#' @importFrom forcats fct_rev fct_inorder +#' @importFrom tidyr replace_na "_PACKAGE" diff --git a/R/main.R b/R/main.R new file mode 100644 index 0000000..7220445 --- /dev/null +++ b/R/main.R @@ -0,0 +1,215 @@ +#' Start a session to F5 Weather +#' +#' @param user,pass F5 Weather creds; use `F5WX_USER` & `F5WX_PASS` environment +#' variables. +#' @return httr `response` object +#' @export +#' @examples \dontrun{ +#' library(ggplot2) +#' f5wx_login() +#' res <- f5wx_forecast() +#' f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +#' } +f5wx_login <- function(user = Sys.getenv("F5WX_USER"), + pass = Sys.getenv("F5WX_PASS")) { + + httr::POST( + url = "https://www.f5wx.com/loginnew.php", + httr::add_headers( + Connection = "keep-alive", + `Cache-Control` = "max-age=0", + `sec-ch-ua` = "\"Chromium\";v=86\", \"\"NotA;Brand\";v=\"99\", \"Google Chrome\";v=\"86", + `sec-ch-ua-mobile` = "?0", + Origin = "https://www.f5wx.com", + `User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 11_0_0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.22 Safari/537.36", + Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9", + Referer = "https://www.f5wx.com/maps.php", + `Accept-Language` = "en-US,en;q=0.9,la;q=0.8" + ), + httr::set_cookies( + firsttime_f5wx = "1", + cookieconsent_status = "dismiss", + trial_f5wx = "1", + TXTfnt_f5wx = "1", + TXTmodel_f5wx = "ecmwf", + TXTtz_f5wx = "E", + model_f5wx = "nam", + archive_f5wx = "0", + zoom_f5wx = "", + TXTmode_f5wx = "detailed", + TXText_f5wx = "0", + hr_f5wx = "72", + map_f5wx = "mslp" + ), + body = list( + user = user, + pass = pass, + lastpage = "/maps.php", + coupon = "" + ), + encode = "form" + ) -> res + + httr::stop_for_status(res) + + invisible(res) + +} + +#' Retrieve a forecast table from F5 Weather +#' +#' @param search for this location +#' @return httr `response` object +#' @export +#' @examples \dontrun{ +#' library(ggplot2) +#' f5wx_login() +#' res <- f5wx_forecast() +#' f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +#' } +f5wx_forecast <- function(search = "Dover, NH") { + + httr::GET( + url = "https://www.f5wx.com/text.php", + httr::add_headers( + Connection = "keep-alive", + Pragma = "no-cache", + `Cache-Control` = "no-cache", + `sec-ch-ua` = "\"Chromium\";v=86\", \"\"NotA;Brand\";v=\"99\", \"Google Chrome\";v=\"86", + `sec-ch-ua-mobile` = "?0", + `User-Agent` = "Mozilla/5.0 (Macintosh; Intel Mac OS X 11_0_0) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/86.0.4240.22 Safari/537.36", + Accept = "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.9", + Referer = "https://www.f5wx.com/text_redirect.php", + `Accept-Language` = "en-US,en;q=0.9,la;q=0.8" + ), + httr::set_cookies( + firsttime_f5wx = "1", + cookieconsent_status = "dismiss", + TXTfnt_f5wx = "1", + TXTmodel_f5wx = "ecmwf", + TXTtz_f5wx = "E", + model_f5wx = "nam", + archive_f5wx = "0", + zoom_f5wx = "", + TXTmode_f5wx = "detailed", + TXText_f5wx = "0", + hr_f5wx = "72", + map_f5wx = "mslp" + ), + query = list(search = search) + ) -> res + + httr::stop_for_status(res) + + invisible(res) + +} + +#' Make a temperature & precipitation chart from the object returned by [f5wx_forecast()] +#' +#' @param res object returned by [f5wx_forecast()] +#' @return ggplot2 object +#' @export +#' @examples \dontrun{ +#' library(ggplot2) +#' f5wx_login() +#' res <- f5wx_forecast() +#' f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +#' } +f5wx_chart <- function(res) { + + pg <- httr::content(res, as = "parsed") + + # model date location elevation in the + html_nodes(pg, xpath = ".//td[contains(., 'Elevation') and not(descendant::*[contains(.,'Elevation')])]/b/font") %>% + html_text() + + forecast_table <- html_node(pg, xpath = ".//font[contains(., 'Valid Time')]/ancestor::table[1]") + + times <- html_nodes(forecast_table, xpath = ".//tr[contains(., 'Valid Time')]") + + html_nodes(times, xpath = ".//td/center/br") %>% + xml_replace("p", "|") + + r1 <- html_table(forecast_table) + + bind_rows( + r1[grepl("Valid Time", r1$X1),] , + r1[grepl("Low Temperature Est", r1$X1),] , + r1[grepl("High Temperature Est", r1$X1),] + ) %>% + as_tibble() -> lh_tmp + + t(lh_tmp[,which(lh_tmp[2, -1] != "")+1]) %>% + as.data.frame() %>% + as_tibble() %>% + mutate( + V1 = gsub("\\|.*$", "", V1), + V2 = as.integer(gsub("[^[:digit:]]*", "", V2)), + V3 = as.integer(gsub("[^[:digit:]]*", "", V3)) + ) %>% + mutate(V1 = fct_inorder(V1) %>% fct_rev()) -> f_temps + + z <- html_table(forecast_table) + + bind_rows( + r1[grepl("Valid Time", r1$X1),], + z[grepl("Type", z$X1), -1] + ) -> pr_tmp + + t(pr_tmp[,-1]) %>% + as.data.frame() %>% + as_tibble() %>% + mutate( + V1 = gsub("\\|.*$", "", V1), + V2 = stri_trans_totitle(V2) + ) %>% + mutate( + V1 = fct_inorder(V1) %>% fct_rev() + ) %>% + filter(V2 != "") %>% + count(V1, V2, name="c_alpha") %>% + mutate(c_alpha = c_alpha/4) %>% + rename(conditions = V2) -> f_cond + + f_temps %>% + left_join(f_cond, by = "V1") %>% + mutate( + conditions = replace_na(conditions, "Clear"), + c_alpha = replace_na(c_alpha, 1) + ) -> f_cast + + ggplot() + + geom_segment( + data = f_cast, + aes(V2, V1, xend=V3, yend=V1, color = conditions, alpha = I(c_alpha)), + size = 5, lineend = "round" + ) + + geom_text( + data = f_cast, aes(V2, V1, label = sprintf("%s°", V2)), + hjust = 1, nudge_x = -0.75, size = 4, family = font_gs + ) + + geom_text( + data = f_cast, aes(V3, V1, label = sprintf("%s°", V3)), + hjust = 0, nudge_x = 0.75, size = 4, family = font_gs + ) + + scale_x_continuous( + expand = c(0, 2) + ) + + scale_color_manual( + name = NULL, + values = c( + "Clear" = "#fec44f", + "Rain" = "black" + ) + ) + + labs( + x = NULL, y = NULL + ) + + theme_ipsum_gs(grid="", axis_text_size = 13) + + theme(axis.text.x = element_blank()) + + theme(legend.position = c(1, 1.1)) + + theme(legend.direction = "horizontal") + + theme(legend.justification = "right") + +} diff --git a/R/utils-pipe.R b/R/utils-pipe.R new file mode 100644 index 0000000..e79f3d8 --- /dev/null +++ b/R/utils-pipe.R @@ -0,0 +1,11 @@ +#' Pipe operator +#' +#' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +#' +#' @name %>% +#' @rdname pipe +#' @keywords internal +#' @export +#' @importFrom magrittr %>% +#' @usage lhs \%>\% rhs +NULL diff --git a/man/f5wx.Rd b/man/f5wx.Rd index 0883933..e3a3de9 100644 --- a/man/f5wx.Rd +++ b/man/f5wx.Rd @@ -4,9 +4,10 @@ \name{f5wx} \alias{f5wx} \alias{f5wx-package} -\title{...} +\title{Orchestrate the Hidden API at F5 Weather} \description{ -A good description goes here otherwise CRAN checks fail. +F5 Weather has great data but terrible forecast table aesthetics. +Tools are provided to orchestrate and chart F5 Weather data. } \seealso{ Useful links: diff --git a/man/f5wx_chart.Rd b/man/f5wx_chart.Rd new file mode 100644 index 0000000..ddf4c1c --- /dev/null +++ b/man/f5wx_chart.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/main.R +\name{f5wx_chart} +\alias{f5wx_chart} +\title{Make a temperature & precipitation chart from the object returned by \code{\link[=f5wx_forecast]{f5wx_forecast()}}} +\usage{ +f5wx_chart(res) +} +\arguments{ +\item{res}{object returned by \code{\link[=f5wx_forecast]{f5wx_forecast()}}} +} +\value{ +ggplot2 object +} +\description{ +Make a temperature & precipitation chart from the object returned by \code{\link[=f5wx_forecast]{f5wx_forecast()}} +} +\examples{ +\dontrun{ +library(ggplot2) +f5wx_login() +res <- f5wx_forecast() +f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +} +} diff --git a/man/f5wx_forecast.Rd b/man/f5wx_forecast.Rd new file mode 100644 index 0000000..d0d3381 --- /dev/null +++ b/man/f5wx_forecast.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/main.R +\name{f5wx_forecast} +\alias{f5wx_forecast} +\title{Retrieve a forecast table from F5 Weather} +\usage{ +f5wx_forecast(search = "Dover, NH") +} +\arguments{ +\item{search}{for this location} +} +\value{ +httr \code{response} object +} +\description{ +Retrieve a forecast table from F5 Weather +} +\examples{ +\dontrun{ +library(ggplot2) +f5wx_login() +res <- f5wx_forecast() +f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +} +} diff --git a/man/f5wx_login.Rd b/man/f5wx_login.Rd new file mode 100644 index 0000000..8f1a1f8 --- /dev/null +++ b/man/f5wx_login.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/main.R +\name{f5wx_login} +\alias{f5wx_login} +\title{Start a session to F5 Weather} +\usage{ +f5wx_login(user = Sys.getenv("F5WX_USER"), pass = Sys.getenv("F5WX_PASS")) +} +\arguments{ +\item{user, pass}{F5 Weather creds; use \code{F5WX_USER} & \code{F5WX_PASS} environment +variables.} +} +\value{ +httr \code{response} object +} +\description{ +Start a session to F5 Weather +} +\examples{ +\dontrun{ +library(ggplot2) +f5wx_login() +res <- f5wx_forecast() +f5wx_chart(res) + labs(title = "ECMWF Forecast for Berwick, Maine") +} +} diff --git a/man/pipe.Rd b/man/pipe.Rd new file mode 100644 index 0000000..0eec752 --- /dev/null +++ b/man/pipe.Rd @@ -0,0 +1,12 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils-pipe.R +\name{\%>\%} +\alias{\%>\%} +\title{Pipe operator} +\usage{ +lhs \%>\% rhs +} +\description{ +See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. +} +\keyword{internal}