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)) +})