You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
234 lines
6.6 KiB
234 lines
6.6 KiB
utils::globalVariables(
|
|
c("V1", "V2", "V3", "c_alpha", "conditions")
|
|
)
|
|
|
|
#' 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 `f5wx_cast` object which is a `list` that contains a data frame of
|
|
#' forecast information and an httr `response` object in the event
|
|
#' you want to do more processing of the HTML table
|
|
#' @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)
|
|
|
|
pg <- httr::content(res, as = "parsed")
|
|
|
|
# model date location elevation in the <td>
|
|
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
|
|
|
|
list(
|
|
f_cast = f_cast,
|
|
response = res
|
|
) -> out
|
|
|
|
class(out) <- c("f5wx_cast", "list")
|
|
|
|
invisible(out)
|
|
|
|
}
|
|
|
|
#' 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) {
|
|
|
|
stopifnot(inherits(res, "f5wx_cast"))
|
|
|
|
f_cast <- res$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\u00B0", V2)),
|
|
hjust = 1, nudge_x = -0.75, size = 4, family = font_gs
|
|
) +
|
|
geom_text(
|
|
data = f_cast, aes(V3, V1, label = sprintf("%s\u00B0", 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", # orange-yellow
|
|
"Rain" = "black",
|
|
"Ip/Sn" = "#313695", # blue
|
|
"Snow" = "#762a83" # purple
|
|
)
|
|
) +
|
|
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")
|
|
|
|
}
|
|
|