This repository has been archived by the owner on May 14, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 26
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Now fetches complete forecast for all states
Now returns precipitation and precis as well as temperature Updated documentation for clarity and description of what data is returned Fill in licence details lint package and follow suggestions from "goodpractices" package Add two tests for .validate_state()
- Loading branch information
1 parent
25bc99d
commit a49fd80
Showing
11 changed files
with
212 additions
and
98 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -7,8 +7,7 @@ Authors@R: c(person("Adam", "Sparks", role = c("aut", "cre"), | |
| person("Keith", "Pembleton", role = "aut", | ||
| email = "[email protected]")) | ||
| Description: Fetches Fetch Australian Government Bureau of Meteorology Weather | ||
| data, currently Queensland only forecast and returns a tidy data frame of | ||
| next seven days weather forecast. | ||
| data and returns a tidy data frame of next six days weather forecast. | ||
| URL: https://github.com/ToowoombaTrio/BOMRang | ||
| BugReports: https://github.com/ToowoombaTrio/BOMRang/issues | ||
| License: MIT + file LICENSE | ||
|
|
@@ -20,12 +19,14 @@ Imports: | |
| foreign, | ||
| lubridate, | ||
| plyr, | ||
| stringr, | ||
| reshape2, | ||
| tibble, | ||
| tidyr, | ||
| xml2 | ||
| Encoding: UTF-8 | ||
| LazyData: true | ||
| Suggests: covr | ||
| Suggests: covr, | ||
| testthat | ||
| RoxygenNote: 6.0.1 | ||
| NeedsCompilation: no | ||
| ByteCompile: TRUE | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,2 +1,2 @@ | ||
| YEAR: 2017 | ||
| COPYRIGHT HOLDER: Your name goes here | ||
| COPYRIGHT HOLDER: Toowoomba Trio |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -16,4 +16,4 @@ | |
| #' | ||
| #' @source \url{ftp://ftp.bom.gov.au/anon/home/adfd/spatial/IDM00013.dbf} | ||
| #' | ||
| "AAC_codes" | ||
| "AAC_codes" | ||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -21,19 +21,40 @@ | |
| #' } | ||
| #' | ||
| #' @return | ||
| #' Data frame of a Australia BOM forecast for max temperature, min temperature | ||
| #' and corresponding locations with lat/lon values for the next six days. | ||
| #' Data frame of a Australia BOM forecast for the next six days in a data frame | ||
| #' with the following fields. | ||
| #' | ||
| #'\describe{ | ||
| #' \item{aac}{AMOC Area Code, e.g. WA_MW008, a unique identifier for each location} | ||
| #' \item{date}{Date in YYYY-MM-DD format} | ||
| #' \item{max_temp}{Maximum forecasted temperature (degrees Celsius)} | ||
| #' \item{min_temp}{Minimum forecasted temperature (degrees Celsius)} | ||
| #' \item{lower_prcp_limit}{Lower forecasted precipitation limit (millimetres)} | ||
| #' \item{upper_prcp_limit}{Upper forecasted precipitation limit (millimetres)} | ||
| #' \item{precis}{Précis forecast (a short summary, less than 30 characters)} | ||
| #' \item{prob_prcp}{Probability of precipitation (percent)} | ||
| #' \item{location}{Named location for forecast} | ||
| #' \item{lon}{Longitude of named location (Decimal Degrees)} | ||
| #' \item{lat}{Latitude of named location (Decimal Degrees)} | ||
| #' \item{elev}{Elevation of named location (Metres)} | ||
| #' } | ||
| #' | ||
| #' @examples | ||
| #' \dontrun{ | ||
| #' BOM_forecast <- get_forecast(state = "QLD") | ||
| #' } | ||
| #' | ||
| #' @author Adam H Sparks, \email{[email protected]} and Keith Pembleton \email{[email protected]} | ||
| #' | ||
| #' @references | ||
| #' Australian Bureau of Meteorology (BOM) Weather Data Services | ||
| #' \url{http://www.bom.gov.au/catalogue/data-feeds.shtml} | ||
| #' | ||
| #' @importFrom dplyr %>% | ||
| #' | ||
| #' | ||
| #' @export | ||
| get_forecast <- function(state) { | ||
| get_forecast <- function(state = NULL) { | ||
| .validate_state(state) | ||
|
|
||
| # ftp server | ||
|
|
@@ -42,7 +63,7 @@ get_forecast <- function(state) { | |
| # State/territory forecast files | ||
| NT <- "IDD10207.xml" | ||
| NSW <- "IDN11060.xml" | ||
| QLD <- "IDN11060.xml" | ||
| QLD <- "IDQ11295.xml" | ||
| SA <- "IDS10044.xml" | ||
| TAS <- "IDT16710.xml" | ||
| VIC <- "IDV10753.xml" | ||
|
|
@@ -64,8 +85,7 @@ get_forecast <- function(state) { | |
| xmlforecast <- | ||
| paste0(ftp_base, SA) # sa | ||
| } | ||
| else if (state == "TAS") | ||
| { | ||
| else if (state == "TAS") { | ||
| xmlforecast <- | ||
| paste0(ftp_base, TAS) # tas | ||
| } | ||
|
|
@@ -96,94 +116,137 @@ get_forecast <- function(state) { | |
| else if (state == "AUS") { | ||
| xml_list <- | ||
| list.files(tempdir(), pattern = ".xml$", full.names = TRUE) | ||
| tibble::as_tibble(plyr::ldply(.data = xml_list, | ||
| .fun = .parse_forecast, | ||
| .progress = "text")) | ||
| tibble::as_tibble(plyr::ldply( | ||
| .data = xml_list, | ||
| .fun = .parse_forecast, | ||
| .progress = "text" | ||
| )) | ||
| } | ||
| } | ||
|
|
||
| .parse_forecast <- function(xmlforecast) { | ||
| type <- | ||
| precipitation_range <- | ||
| `parent-aac` <- LON <- LAT <- ELEVATION <- NULL | ||
|
|
||
| # Load BOM location data | ||
| utils::data("AAC_codes", package = "BOMRang") | ||
| AAC_codes <- AAC_codes | ||
|
|
||
| xmlforecast <- xml2::read_xml(xmlforecast) | ||
|
|
||
| # remove index=0 (today's "forecast"), it varies and we're not interested anyway | ||
| xml2::xml_find_all(xmlforecast, ".//*[@index='0']") %>% | ||
| xml2::xml_remove() | ||
|
|
||
| # extract locations from forecast | ||
| areas <- xml2::xml_find_all(xmlforecast, ".//*[@type='location']") | ||
| forecast_locations <- | ||
| dplyr::bind_rows(lapply(xml2::xml_attrs(areas), as.list)) | ||
|
|
||
| # join locations with lat/lon values for mapping and interpolation | ||
| forecast_locations <- dplyr::left_join(forecast_locations, | ||
| AAC_codes, | ||
| by = c("aac" = "AAC", | ||
| "description" = "PT_NAME")) | ||
|
|
||
| # unlist and add the locations aac code | ||
| forecasts <- | ||
| lapply(xml2::xml_find_all(xmlforecast, ".//*[@type='location']"), | ||
| xml2::as_list) | ||
|
|
||
| forecasts <- plyr::llply(forecasts, unlist) | ||
| names(forecasts) <- forecast_locations$aac | ||
|
|
||
| # get all the <element> and <text> tags (the forecast) | ||
| eltext <- xml2::xml_find_all(xmlforecast, "//element | //text") | ||
|
|
||
| # extract and clean (if needed) (the labels for the forecast) | ||
| labs <- trimws(xml2::xml_attrs(eltext, "type")) | ||
|
|
||
| # use a loop to turn list of named character elements into a list of dataframes | ||
| # with the location aac code for each line of the data frame | ||
| y <- vector("list") | ||
| for (i in unique(names(forecasts))) { | ||
| x <- data.frame( | ||
| keyName = names(forecasts[[i]]), | ||
| value = forecasts[[i]], | ||
| row.names = NULL | ||
| ) | ||
| z <- names(forecasts[i]) | ||
| x <- data.frame(rep(as.character(z), nrow(x)), x) | ||
| y[[i]] <- x | ||
| } | ||
| # load BOM location data --------------------------------------------------- | ||
| utils::data("AAC_codes", package = "BOMRang") | ||
| AAC_codes <- AAC_codes | ||
|
|
||
| # load the XML forecast ---------------------------------------------------- | ||
| xmlforecast <- xml2::read_xml(xmlforecast) | ||
|
|
||
| # remove today's "forecast" ------------------------------------------------ | ||
| xml2::xml_find_all(xmlforecast, ".//*[@index='0']") %>% | ||
| xml2::xml_remove() | ||
|
|
||
| # extract locations from forecast ------------------------------------------ | ||
| areas <- xml2::xml_find_all(xmlforecast, ".//*[@type='location']") | ||
| forecast_locations <- | ||
| dplyr::bind_rows(lapply(xml2::xml_attrs(areas), as.list)) %>% | ||
| dplyr::select(-type) | ||
|
|
||
| # join locations with lat/lon values --------------------------------------- | ||
| forecast_locations <- dplyr::left_join(forecast_locations, | ||
| AAC_codes, | ||
| by = c("aac" = "AAC", | ||
| "description" = "PT_NAME")) | ||
|
|
||
| # unlist and add the locations aac code ------------------------------------ | ||
| forecasts <- | ||
| lapply(xml2::xml_find_all(xmlforecast, ".//*[@type='location']"), | ||
| xml2::as_list) | ||
|
|
||
| forecasts <- plyr::llply(forecasts, unlist) | ||
| names(forecasts) <- forecast_locations$aac | ||
|
|
||
| # get all the <element> and <text> tags (the forecast) --------------------- | ||
| eltext <- xml2::xml_find_all(xmlforecast, "//element | //text") | ||
|
|
||
| # extract and clean (if needed) (the labels for the forecast) -------------- | ||
| labs <- trimws(xml2::xml_attrs(eltext, "type")) | ||
|
|
||
| # use a loop to turn list of named character elements into a list ---------- | ||
| # of dataframes with the location aac code for each line of the data frame | ||
| y <- vector("list") | ||
| for (i in unique(names(forecasts))) { | ||
| x <- data.frame( | ||
| keyName = names(forecasts[[i]]), | ||
| value = forecasts[[i]], | ||
| row.names = NULL | ||
| ) | ||
| z <- names(forecasts[i]) | ||
| x <- data.frame(rep(as.character(z), nrow(x)), x) | ||
| y[[i]] <- x | ||
| } | ||
|
|
||
| # combine list into a single dataframe - | ||
| y <- data.table::rbindlist(y, fill = TRUE) | ||
|
|
||
| # add the forecast description to the dataframe ---------------------------- | ||
| forecast <- | ||
| data.frame(y[, -2], labs) # drop keyName colum from "y" | ||
| names(forecast) <- c("aac", "value", "labs") | ||
|
|
||
| # add dates to forecast ---------------------------------------------------- | ||
| forecast$date <- c(rep(seq( | ||
| lubridate::ymd(Sys.Date() + 1), | ||
| lubridate::ymd(Sys.Date() + 6), | ||
| by = "1 day" | ||
| ), | ||
| each = 6)) | ||
|
|
||
| # spread columns ----------------------------------------------------------- | ||
| forecast <- | ||
| forecast %>% | ||
| reshape2::dcast(aac + date ~ labs, value.var = "value") | ||
|
|
||
| # split precipitation forecast values into lower/upper limits -------------- | ||
|
|
||
| # format any values that are only zero to make next step easier | ||
| forecast$precipitation_range[which(forecast$precipitation_range == "0 mm")] <- | ||
| "0 mm to 0 mm" | ||
|
|
||
| # separate the precipitation column into two, upper/lower limit ------------ | ||
| forecast <- | ||
| forecast %>% | ||
| tidyr::separate( | ||
| precipitation_range, | ||
| into = c("lower_prec_limit", "upper_prec_limit"), | ||
| sep = "to" | ||
| ) | ||
|
|
||
| # remove unnecessary text (mm in prcp cols) -------------------------------- | ||
| forecast <- lapply(forecast, function(x) { | ||
| gsub(" mm", "", x) | ||
| }) | ||
|
|
||
| # rename columns ----------------------------------------------------------- | ||
| forecast <- forecast[-5] # drop forecast_icon_code column | ||
|
|
||
| names(forecast) <- | ||
| c( | ||
| "aac", | ||
| "date", | ||
| "max_temp", | ||
| "min_temp", | ||
| "lower_prcp_limit", | ||
| "upper_prcp_limit", | ||
| "precis", | ||
| "prob_prcp" | ||
| ) | ||
|
|
||
| # merge the forecast with the locations ------------------------------------ | ||
|
|
||
| # convert forecast_locations$aac to factor for merging | ||
| forecast$aac <- as.character(forecast$aac) | ||
|
|
||
| # combind list into a single dataframe | ||
| y <- data.table::rbindlist(y, fill = TRUE) | ||
|
|
||
| # add the forecast description to the dataframe | ||
| forecast <- data.frame(y, labs, rep(NA, length(labs))) | ||
| names(forecast) <- c("aac", "keyName", "value", "labs", "element") | ||
|
|
||
| # add dates to the new object | ||
| forecast$date <- c(rep(seq( | ||
| lubridate::ymd(Sys.Date() + 1), | ||
| lubridate::ymd(Sys.Date() + 7), | ||
| by = "1 day" | ||
| ), | ||
| each = 2)) | ||
|
|
||
| # label for min/max temperature in a new col to use for sorting in next step | ||
| forecast$element <- | ||
| as.character(stringr::str_match(forecast$labs, | ||
| "air_temperature_[[:graph:]]{7}")) | ||
|
|
||
| # convert object to tibble and remove rows we don't need, e.g., precip | ||
| # keep only max and min temp | ||
| forecast <- | ||
| tibble::as_tibble(stats::na.omit(forecast[, c(1, 3, 5:6)])) | ||
|
|
||
| # convert forecast_locations$aac to factor for merging | ||
| forecast$aac <- as.character(forecast$aac) | ||
|
|
||
| # merge the forecast with the locations | ||
| forecast <- | ||
| dplyr::left_join(forecast, forecast_locations, by = "aac") | ||
| # return final forecast object --------------------------------------------- | ||
| forecast <- | ||
| dplyr::left_join(tibble::as_tibble(forecast), | ||
| forecast_locations, by = "aac") %>% | ||
| dplyr::select(-`parent-aac`) %>% | ||
| dplyr::rename(lon = LON, lat = LAT, elev = ELEVATION) | ||
| } | ||
|
|
||
| #' @noRd | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -11,6 +11,12 @@ | |
| #' update_locations() | ||
| #' } | ||
| #' @return Updated internal database of BOM forecast locations | ||
| #' | ||
| #' @references | ||
| #' Australian Bureau of Meteorology (BOM) Weather Data Services | ||
| #' \url{http://www.bom.gov.au/catalogue/data-feeds.shtml} | ||
| #' | ||
| #' | ||
| #' @author Adam H Sparks, \email{[email protected]} | ||
| #' @export | ||
| #' | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.
Oops, something went wrong.
Oops, something went wrong.