-
Notifications
You must be signed in to change notification settings - Fork 84
/
arc2.R
134 lines (123 loc) · 4.22 KB
/
arc2.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#' Arc2 - Africa Rainfall Climatology version 2
#'
#' @export
#' @param date (character/date) one or more dates of the form YYYY-MM-DD
#' @param box (numeric) vector of length 4, of the form
#' `xmin, ymin, xmax, ymax`. optional. If not given, no spatial filtering
#' is done. If given, we use `dplyr::filter()` on a combined set of all dates,
#' then split the output into tibbles by date
#' @param ... curl options passed on to [crul::verb-GET]
#' @references docs:
#' https://ftp.cpc.ncep.noaa.gov/fews/fewsdata/africa/arc2/ARC2_readme.txt
#' @note See [arc2_cache] for managing cached files
#' @section box parameter:
#' The `box` parameter filters the arc2 data to a bounding box you supply.
#' The function that does the cropping to the bounding box is `dplyr::filter`.
#' You can do any filtering you want on your own if you do not supply
#' `box` and then use whatever tools you want to filter the data by
#' lat/lon, date, precip values.
#' @return a list of tibbles with columns:
#'
#' - date: date (YYYY-MM-DD)
#' - lon: longitude
#' - lat: latitude
#' - precip: precipitation (mm)
#'
#' @examples \dontrun{
#' x = arc2(date = "1983-01-01")
#' arc2(date = "2017-02-14")
#'
#' # many dates
#' arc2(date = c("2019-05-27", "2019-05-28"))
#' arc2(seq(as.Date("2019-04-21"), by = "day", length.out = 5))
#' ## combine outputs
#' x <- arc2(seq(as.Date("2019-05-20"), as.Date("2019-05-25"), "days"))
#' dplyr::bind_rows(x)
#'
#' # bounding box filter
#' box <- c(xmin = 9, ymin = 4, xmax = 10, ymax = 5)
#' arc2(date = "2017-02-14", box = box)
#' arc2(date = c("2019-05-27", "2019-05-28"), box = box)
#' arc2(seq(as.Date("2019-05-20"), as.Date("2019-05-25"), "days"), box = box)
#' }
arc2 <- function(date, box = NULL, ...) {
assert(date, c("character", "Date"))
dates <- str_extract_all_(date, "[0-9]+")
invisible(lapply(dates, arc2_lint_date))
res <- lapply(dates, function(w) {
path <- arc2_get(year = w[1], month = w[2], day = w[3], ...)
arc2_read(path, w)
})
if (is.null(box)) {
res <- stats::setNames(res, vapply(dates, asdate, ""))
return(res)
}
assert(box, "numeric")
tmpdf <- dplyr::bind_rows(res)
filter_split(tmpdf, box)
}
filter_split <- function(x, box) {
df <- dplyr::filter(x, dplyr::between(lon, box[1], box[3]),
dplyr::between(lat, box[2], box[4]))
split(df, df$date)
}
arc2_lint_date <- function(x) {
assert_range(x[1], 1979:format(Sys.Date(), "%Y"))
assert_range(as.numeric(x[2]), 1:12)
assert_range(as.numeric(x[3]), 1:31)
}
todate <- function(year, month, day) paste(year, month, day, sep = "-")
asdate <- function(z) todate(z[1], z[2], z[3])
arc2_get <- function(year, month, day, cache = TRUE, overwrite = FALSE, ...) {
arc2_cache$mkdir()
date <- paste(year, month, day, sep = "-")
key <- file.path(arc2_base_ftp(arc2_base(), date))
file <- file.path(arc2_cache$cache_path_get(), basename(key))
date <- todate(year, month, day)
if (!file.exists(file)) {
res <- suppressMessages(
arc2_GET_write(sub("/$", "", key), file, date, overwrite, ...))
file <- res$content
} else {
cache_mssg(file)
}
return(file)
}
arc2_GET_write <- function(url, path, date, overwrite = TRUE, ...) {
cli <- crul::HttpClient$new(url = url)
if (!overwrite) {
if (file.exists(path)) {
stop("file exists and ovewrite != TRUE", call. = FALSE)
}
}
res <- tryCatch(cli$get(disk = path, ...), error = function(e) e)
if (inherits(res, "error")) {
unlink(path)
warning(res$message, ": ", date, call. = FALSE)
}
return(res)
}
arc2_base <- function() {
"https://ftp.cpc.ncep.noaa.gov/fews/fewsdata/africa/arc2/bin"
}
arc2_base_ftp <- function(x, y) sprintf("%s/daily_clim.bin.%s.gz", x,
gsub("-", "", y))
arc2_read <- function(x, w) {
if (is.null(x)) return(tibble::tibble())
date <- todate(w[1], w[2], w[3])
conn <- gzcon(file(x, open = "rb"))
on.exit(close(conn))
# lats/longs
lats <- seq(from = -40, to = 40, by = 0.1)
longs <- seq(from = -20, to = 55, by = 0.1)
# read data
res <- readBin(conn, numeric(), n = 751*801, size = 4, endian = "big")
# make data.frame
df <- tibble::as_tibble(
stats::setNames(
cbind(expand.grid(longs, lats), res),
c('lon', 'lat', 'precip')
)
)
tibble::tibble(date = date, df)
}