R/update_station_locations.R

Defines functions update_station_locations

Documented in update_station_locations

#' Update bomrang Internal Databases with Latest BOM Station Metadata
#'
#' Download the latest station locations and metadata and update bomrang's
#' internal databases that support the use of \code{\link{get_current_weather}}
#' and \code{\link{get_ag_bulletin}}.  There is no need to use this unless you
#' know that a station exists in BOM's database that is not available in the
#' databases distributed with \pkg{bomrang}.
#'
#' If \pkg{ASGS.foyer} is installed locally, this function will automatically
#' check and correct any invalid state values for stations located in Australia.
#' If \pkg{ASGS.foyer} is not installed, the function will update the internal
#' database without validating the state values for stations by reported lon/lat
#' location.
#'
#' @examples
#' \dontrun{
#' update_station_locations()
#' }
#' @return Updated internal databases of BOM station locations and JSON URLs
#'
#' @references
#' Station location and other metadata are sourced from the Australian Bureau of
#' Meteorology (BOM) webpage, Bureau of Meteorology Site Numbers:\cr
#' \url{http://www.bom.gov.au/climate/cdo/about/site-num.shtml}
#'
#' @author Adam H Sparks, \email{[email protected]@gmail.com}
#' @export
#'
update_station_locations <- function() {
  # CRAN NOTE avoidance
  name <- site <- state_code <- wmo <- state <- lon <- lat <- # nocov start
    actual_state <- state_from_latlon <- NULL # nocov end
  tryCatch({
    curl::curl_download(url =
          "ftp://ftp.bom.gov.au/anon2/home/ncc/metadata/sitelists/stations.zip",
                        destfile = file.path(tempdir(), "stations.zip"))
  },
  error = function(x)
    stop(
      "\nThe server with the location information is not responding.",
      "Please retry again later.\n"
    ))

  bom_stations_raw <-
    readr::read_table(
      file.path(tempdir(), "stations.zip"),
      skip = 4,
      na = c("..", ".....", " "),
      col_names = c(
        "site",
        "dist",
        "name",
        "start",
        "end",
        "lat",
        "lon",
        "NULL1",
        "NULL2",
        "state",
        "elev",
        "bar_ht",
        "wmo"
      ),
      col_types = c(
        site = readr::col_character(),
        dist = readr::col_character(),
        name = readr::col_character(),
        start = readr::col_integer(),
        end = readr::col_integer(),
        lat = readr::col_double(),
        lon = readr::col_double(),
        NULL1 = readr::col_character(),
        NULL2 = readr::col_character(),
        state = readr::col_character(),
        elev = readr::col_double(),
        bar_ht = readr::col_double(),
        wmo = readr::col_integer()
      )
    )

  # remove extra columns for source of location
  bom_stations_raw <- bom_stations_raw[, -c(8:9)]

  # trim the end of the rows off that have extra info that's not in columns
  nrows <- nrow(bom_stations_raw) - 6
  bom_stations_raw <- bom_stations_raw[1:nrows,]

  # return only current stations listing
  bom_stations_raw <-
    bom_stations_raw[is.na(bom_stations_raw$end),]
  bom_stations_raw$end <- format(Sys.Date(), "%Y")

  # if sf is installed, correct the state column, otherwise skip

  if (requireNamespace("ASGS.foyer", quietly = TRUE)) {
    message(
      "The package 'ASGS.foyer' is installed. Station locations will\n",
      "be checked against lat/lon location values and corrected in the\n",
      "updated internal database lists of stations."
    )
    data.table::setDT(bom_stations_raw)
    latlon2state <- function(lat, lon) {
      ASGS.foyer::latlon2SA(lat,
                            lon,
                            to = "STE",
                            yr = "2016",
                            return = "v")
    }

    bom_stations_raw %>%
      .[lon > -50, state_from_latlon := latlon2state(lat, lon)] %>%
      .[state_from_latlon == "New South Wales", actual_state := "NSW"] %>%
      .[state_from_latlon == "Victoria", actual_state := "VIC"] %>%
      .[state_from_latlon == "Queensland", actual_state := "QLD"] %>%
      .[state_from_latlon == "South Australia", actual_state := "SA"] %>%
      .[state_from_latlon == "Western Australia", actual_state := "WA"] %>%
      .[state_from_latlon == "Tasmania", actual_state := "TAS"] %>%
      .[state_from_latlon == "Australian Capital Territory",
        actual_state := "ACT"] %>%
      .[state_from_latlon == "Northern Territory", actual_state := "NT"] %>%
      .[actual_state != state &
          state %notin% c("ANT", "ISL"), state := actual_state] %>%
      .[, actual_state := NULL]

    data.table::setDF(bom_stations_raw)
  }

  # recode the states to match product codes
  # IDD - NT,
  # IDN - NSW/ACT,
  # IDQ - Qld,
  # IDS - SA,
  # IDT - Tas/Antarctica,
  # IDV - Vic, IDW - WA

  bom_stations_raw$state_code <- NA
  bom_stations_raw$state_code[bom_stations_raw$state == "WA"] <- "W"
  bom_stations_raw$state_code[bom_stations_raw$state == "QLD"] <-
    "Q"
  bom_stations_raw$state_code[bom_stations_raw$state == "VIC"] <-
    "V"
  bom_stations_raw$state_code[bom_stations_raw$state == "NT"] <- "D"
  bom_stations_raw$state_code[bom_stations_raw$state == "TAS" |
                                bom_stations_raw$state == "ANT"] <-
    "T"
  bom_stations_raw$state_code[bom_stations_raw$state == "NSW"] <-
    "N"
  bom_stations_raw$state_code[bom_stations_raw$state == "SA"] <- "S"

  stations_site_list <-
    bom_stations_raw %>%
    dplyr::select(site:wmo, state, state_code) %>%
    dplyr::mutate(
      url = dplyr::case_when(
        .$state != "ANT" & !is.na(.$wmo) ~
          paste0(
            "http://www.bom.gov.au/fwo/ID",
            .$state_code,
            "60801",
            "/",
            "ID",
            .$state_code,
            "60801",
            ".",
            .$wmo,
            ".json"
          ),
        .$state == "ANT" & !is.na(.$wmo) ~
          paste0(
            "http://www.bom.gov.au/fwo/ID",
            .$state_code,
            "60803",
            "/",
            "ID",
            .$state_code,
            "60803",
            ".",
            .$wmo,
            ".json"
          )
      )
    )

  # There are weather stations that do have a wmo but don't report online,
  # most of these don't have a "state" value, e.g., KIRIBATI NTC AWS or
  # MARSHALL ISLANDS NTC AWS, remove these from the list

  JSONurl_site_list <-
    stations_site_list[!is.na(stations_site_list$url),]

  JSONurl_site_list <-
    JSONurl_site_list %>%
    dplyr::rowwise() %>%
    dplyr::mutate(url = dplyr::if_else(httr::http_error(url),
                                       NA_character_,
                                       url))

  # Remove new NA values from invalid URLs and convert to data.table
  JSONurl_site_list <-
    data.table::data.table(JSONurl_site_list[!is.na(JSONurl_site_list$url),])

  message("Overwriting existing databases")

  fname <- system.file("extdata", "JSONurl_site_list.rda",
                       package = "bomrang")
  save(JSONurl_site_list, file = fname, compress = "bzip2")

  stations_site_list <-
    stations_site_list %>%
    dplyr::select(-state_code, -url)
  stations_site_list$site <-
    gsub("^0{1,2}", "", stations_site_list$site)

  fname <-
    system.file("extdata", "stations_site_list.rda", package = "bomrang")
  save(stations_site_list, file = fname, compress = "bzip2")
}

Try the bomrang package in your browser

Any scripts or data that you put into this service are public.

bomrang documentation built on July 19, 2018, 9:01 a.m.