#' Get a listing of available BOM radar imagery
#'
#' Fetch a listing of available \acronym{BOM} \acronym{radar} imagery from
#' \url{ftp://ftp.bom.gov.au/anon/gen/radar/} to determine which files are
#' currently available for download. The files available are the most recent
#' \acronym{radar} imagery for each location, which are updated approximately
#' every 6 to 10 minutes by the \acronym{BOM}.
#'
#' @param radar_id Numeric. \acronym{BOM} radar \acronym{ID} of interest for
#' which a list of available images will be returned. Defaults to all images
#' currently available.
#'
#' @details Valid \acronym{BOM} \acronym{radar} ID for each location required.
#'
#' @return
#' A data frame of all selected \acronym{radar} locations with location
#' information and \var{product_ids}.
#'
#' @references
#' Australian Bureau of Meteorology (BOM) radar image
#' \url{http://www.bom.gov.au/australia/radar/}
#'
#' @examples
#' \donttest{
#' # Check availability radar imagery for Wollongong (radar_id = 3)
#' imagery <- get_available_radar(radar_id = 3)
#' }
#'
#' @author Dean Marchiori, \email{deanmarchiori@@gmail.com}
#'
#' @export get_available_radar
get_available_radar <- function(radar_id = "all") {
ftp_base <- "ftp://ftp.bom.gov.au/anon/gen/radar/"
radar_locations <- NULL #nocov
load(system.file("extdata", "radar_locations.rda", package = "bomrang"))
list_files <- curl::new_handle()
curl::handle_setopt(
handle = list_files,
FTP_RESPONSE_TIMEOUT = 200000,
CONNECTTIMEOUT = 90,
ftp_use_epsv = TRUE,
dirlistonly = TRUE
)
con <- curl::curl(url = ftp_base, "r", handle = list_files)
files <- readLines(con)
close(con)
gif_files <- files[grepl("^.*\\.gif", files)]
product_id <- substr(gif_files, 1, nchar(gif_files) - 4)
LocationID <- substr(product_id, 4, 5)
range <- substr(product_id, 6, 6)
dat <- cbind.data.frame(product_id,
LocationID,
range,
stringsAsFactors = FALSE) %>%
dplyr::left_join(radar_locations, by = "LocationID") %>%
dplyr::mutate(
range = dplyr::case_when(
range == 1 ~ "512km",
range == 2 ~ "256km",
range == 3 ~ "128km",
range == 4 ~ "64km"
)
)
if (radar_id[1] == "all") {
dat <- dat
} else if (is.numeric(radar_id) && radar_id %in% dat$Radar_id) {
dat <- dat[dat$Radar_id %in% radar_id,]
} else{
stop("radar_id not found")
}
return(dat)
}
#' Get \acronym{BOM} radar imagery
#'
#' Fetch \acronym{BOM} radar imagery from
#' \url{ftp://ftp.bom.gov.au/anon/gen/radar/} and return a
#' \code{\link[terra]{SpatRaster}} layer object. Files available are the most
#' recent radar snapshot which are updated approximately every 6 to 10 minutes.
#' Suggested to check file availability first by using
#' \code{\link{get_available_radar}}.
#'
#' @param product_id Character. \acronym{BOM} product ID to download and import
#' as a \CRANpkg{magick} object. Value is required.
#'
#' @param path Character. A character string with the name where the downloaded
#' file is saved. If not provided, the default value \code{NULL} is used which
#' saves the file in an \R session temp directory.
#'
#' @param download_only Logical. Whether the radar image is loaded into the
#' environment as a \CRANpkg{magick} object or just downloaded.
#'
#' @details Valid \acronym{BOM} \acronym{Radar} Product IDs for radar imagery
#' can be obtained from \code{\link{get_available_radar}}.
#'
#'@seealso
#'\code{\link{get_available_radar}}
#'
#' @return
#' A \CRANpkg{magick} object of the most recent \acronym{radar} image snapshot
#' published by the \acronym{BOM}. If \code{download_only = TRUE} there will be
#' a `NULL` return value with the download path printed in the console as a
#' message.
#'
#' @references
#' Australian Bureau of Meteorology (\acronym{BOM}) radar images\cr
#' \url{http://www.bom.gov.au/australia/radar/}
#'
#' @examples
#' \donttest{
#' # Fetch most recent radar image for Wollongong 256km radar
#' imagery <- get_radar_imagery(product_id = "IDR032")
#' imagery
#' }
#'
#' @author Dean Marchiori, \email{deanmarchiori@@gmail.com}
#' @rdname get_radar_imagery
#' @export get_radar_imagery
get_radar_imagery <- get_radar <-
function(product_id,
path = NULL,
download_only = FALSE) {
if (length(product_id) != 1) {
stop(
"\nbomrang only supports working with one Product ID at a time",
"for radar images\n",
call. = FALSE
)
}
ftp_base <- "ftp://ftp.bom.gov.au/anon/gen/radar"
fp <- file.path(ftp_base, paste0(product_id, ".gif"))
if (is.null(path)) {
path <- tempfile(fileext = ".gif", tmpdir = tempdir())
}
h <- curl::new_handle()
curl::handle_setopt(
handle = h,
FTP_RESPONSE_TIMEOUT = 200000,
CONNECTTIMEOUT = 90
)
tryCatch({
if (download_only == TRUE) {
curl::curl_download(
url = fp,
destfile = path,
mode = "wb",
quiet = TRUE,
handle = h
)
message("file downloaded to:", path)
} else {
curl::curl_download(
url = fp,
destfile = path,
mode = "wb",
quiet = TRUE,
handle = h
)
message("file downloaded to:", path)
y <- magick::image_read(path = path)
return(y)
}
},
error = function() {
return(magick::image_read(
path = system.file("error_images",
"image_error_message.png",
package = "bomrang")
))
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.