From a49fd80b623612782016cd4bfc7c77b7bc7d48d0 Mon Sep 17 00:00:00 2001 From: "Adam H. Sparks" Date: Fri, 12 May 2017 12:08:25 +1000 Subject: [PATCH] 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() --- DESCRIPTION | 9 +- LICENSE | 2 +- R/data.R | 2 +- R/get_BOM_forecast.R | 239 +++++++++++++++++---------- R/update_locations.R | 6 + README.Rmd | 1 + README.md | 2 +- man/get_forecast.Rd | 28 +++- man/update_locations.Rd | 4 + tests/testthat.R | 4 + tests/testthat/test-validate_state.R | 13 ++ 11 files changed, 212 insertions(+), 98 deletions(-) create mode 100644 tests/testthat.R create mode 100644 tests/testthat/test-validate_state.R diff --git a/DESCRIPTION b/DESCRIPTION index bf0c2b2c..3dd44dd3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,8 +7,7 @@ Authors@R: c(person("Adam", "Sparks", role = c("aut", "cre"), person("Keith", "Pembleton", role = "aut", email = "keith.pembleton@usq.edu.au")) 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 diff --git a/LICENSE b/LICENSE index 9ab6c360..f2b50e12 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ YEAR: 2017 -COPYRIGHT HOLDER: Your name goes here +COPYRIGHT HOLDER: Toowoomba Trio diff --git a/R/data.R b/R/data.R index e6ab6477..9412559c 100644 --- a/R/data.R +++ b/R/data.R @@ -16,4 +16,4 @@ #' #' @source \url{ftp://ftp.bom.gov.au/anon/home/adfd/spatial/IDM00013.dbf} #' -"AAC_codes" \ No newline at end of file +"AAC_codes" diff --git a/R/get_BOM_forecast.R b/R/get_BOM_forecast.R index 8db7e7a4..730eb29f 100644 --- a/R/get_BOM_forecast.R +++ b/R/get_BOM_forecast.R @@ -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{adamhsparks@gmail.com} and Keith Pembleton \email{keith.pembleton@usq.edu.au} +#' +#' @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 and 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 and 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 diff --git a/R/update_locations.R b/R/update_locations.R index 2cd9834a..d9c0ccf8 100644 --- a/R/update_locations.R +++ b/R/update_locations.R @@ -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{adamhsparks@gmail.com} #' @export #' diff --git a/README.Rmd b/README.Rmd index e67ffc28..efff5694 100644 --- a/README.Rmd +++ b/README.Rmd @@ -8,6 +8,7 @@ output: github_document [![Travis-CI Build Status](https://travis-ci.org/ToowoombaTrio/BOMRang.svg?branch=master)](https://travis-ci.org/ToowoombaTrio/BOMRang) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/ToowoombaTrio/BOMRang?branch=master&svg=true)](https://ci.appveyor.com/project/ToowoombaTrio/BOMRang) +[![Coverage Status](https://img.shields.io/codecov/c/github/ToowoombaTrio/BOMRang/master.svg)](https://codecov.io/github/ToowoombaTrio/BOMRang?branch=master) [![Last-changedate](https://img.shields.io/badge/last%20change-`r gsub('-', '--', Sys.Date())`-brightgreen.svg)](https://github.com/toowoombatrio/BOMRang/commits/master) [![minimal R version](https://img.shields.io/badge/R%3E%3D-`r as.character(getRversion())`-brightgreen.svg)](https://cran.r-project.org/) diff --git a/README.md b/README.md index 80ef36dd..bcef5618 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ *BOMRang*: Fetch Australian Government Bureau of Meteorology Data ================================================================= -[![Travis-CI Build Status](https://travis-ci.org/ToowoombaTrio/BOMRang.svg?branch=master)](https://travis-ci.org/ToowoombaTrio/BOMRang) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/ToowoombaTrio/BOMRang?branch=master&svg=true)](https://ci.appveyor.com/project/ToowoombaTrio/BOMRang) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--05--11-brightgreen.svg)](https://github.com/toowoombatrio/BOMRang/commits/master) [![minimal R version](https://img.shields.io/badge/R%3E%3D-3.4.0-brightgreen.svg)](https://cran.r-project.org/) +[![Travis-CI Build Status](https://travis-ci.org/ToowoombaTrio/BOMRang.svg?branch=master)](https://travis-ci.org/ToowoombaTrio/BOMRang) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/ToowoombaTrio/BOMRang?branch=master&svg=true)](https://ci.appveyor.com/project/ToowoombaTrio/BOMRang) [![Coverage Status](https://img.shields.io/codecov/c/github/ToowoombaTrio/BOMRang/master.svg)](https://codecov.io/github/ToowoombaTrio/BOMRang?branch=master) [![Last-changedate](https://img.shields.io/badge/last%20change-2017--05--12-brightgreen.svg)](https://github.com/toowoombatrio/BOMRang/commits/master) [![minimal R version](https://img.shields.io/badge/R%3E%3D-3.4.0-brightgreen.svg)](https://cran.r-project.org/) Fetches Fetch Australian Government Bureau of Meteorology Weather forecasts and returns a tidy data frame in a [*Tibble*](http://tibble.tidyverse.org) of the current and next six days weather. diff --git a/man/get_forecast.Rd b/man/get_forecast.Rd index 5c72a39d..3e14fe70 100644 --- a/man/get_forecast.Rd +++ b/man/get_forecast.Rd @@ -4,15 +4,30 @@ \alias{get_forecast} \title{Get BOM Forecast} \usage{ -get_forecast(state) +get_forecast(state = NULL) } \arguments{ \item{state}{Australian state or territory as postal code, see details for instruction.} } \value{ -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)} +} } \description{ Fetch the BOM forecast and create a tidy data frame of the six day forecast @@ -38,3 +53,10 @@ BOM_forecast <- get_forecast(state = "QLD") } } +\references{ +Australian Bureau of Meteorology (BOM) Weather Data Services +\url{http://www.bom.gov.au/catalogue/data-feeds.shtml} +} +\author{ +Adam H Sparks, \email{adamhsparks@gmail.com} and Keith Pembleton \email{keith.pembleton@usq.edu.au} +} diff --git a/man/update_locations.Rd b/man/update_locations.Rd index 5bd7e6cb..454d7f03 100644 --- a/man/update_locations.Rd +++ b/man/update_locations.Rd @@ -21,6 +21,10 @@ with \code{\link{BOMRang}}. update_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{adamhsparks@gmail.com} } diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 00000000..ea9f8e62 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +library(testthat) +library(BOMRang) + +test_check("BOMRang") diff --git a/tests/testthat/test-validate_state.R b/tests/testthat/test-validate_state.R new file mode 100644 index 00000000..71aca196 --- /dev/null +++ b/tests/testthat/test-validate_state.R @@ -0,0 +1,13 @@ +context(".validate_state") + +# Test that .validate_dsn stops if the dsn is not provided --------------------- + +test_that(".validate_state stops if the state is not provided", { + state <- NULL + expect_error(.validate_dsn(dsn)) +}) + +test_that(".validate_state stops if the state is properly formatted/recognised", { + state <- "Australia" + expect_error(.validate_dsn(dsn)) +})