-
Notifications
You must be signed in to change notification settings - Fork 6
/
getCHIRPS.R
125 lines (111 loc) · 4.14 KB
/
getCHIRPS.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
#' Download CHIRPS data
#'
#' @description
#' Download Climate Hazards Group InfraRed Precipitation with Station (CHIRPS)
#' data for a given time span from Climate Hazards Group's (CHG) FTP server
#' (\url{ftp://chg-ftpout.geog.ucsb.edu/pub/org/chg/products/CHIRPS-2.0/}).
#'
#' @param region 'character'. Region of interest; one of 'global', 'whem'
#' (western hemisphere), 'africa' or 'camer-carib' (Central America and the
#' Caribbean). See the official CHIRPS README (available online at
#' \url{ftp://chg-ftpout.geog.ucsb.edu/pub/org/chg/products/CHIRPS-2.0/README-CHIRPS.txt})
#' for further information.
#' @param format 'character'. Desired file format; one of 'tifs' (default),
#' 'netcdf', 'bils' or 'pngs'.
#' @param tres 'character'. Desired temporal resolution; one of '6-hourly'
#' (default), 'daily', 'pentad', 'dekad' or 'monthly'.
#' @param sres 'numeric'. Desired spatial resolution; one of
#' \code{c(0.05, 0.25)}.
#' @param begin,end 'date'. If not supplied, data download starts (stops) with
#' the first (last) record available.
#' @param dsn 'character'. Destination folder for file download, defaults to the
#' current working directory.
#' @param overwrite Logical. If \code{TRUE}, already downloaded files in 'dsn'
#' will be overwritten.
#' @param cores 'integer'. The number of cores used for parallel downloads.
#' @param ... Further arguments passed to \code{\link{download.file}}.
#'
#' @return
#' A \code{character} vector of file paths.
#'
#' @author
#' Florian Detsch
#'
#' @seealso
#' \code{\link{download.file}}
#'
#' @examples
#' \dontrun{
#' ## Download CHIRPS monthly data over Africa from 1982-1983
#' gzs <- getCHIRPS("africa", tres = "monthly"
#' , begin = as.Date("1982-01-01"), end = as.Date("1983-12-31")
#' , dsn = file.path(getwd(), "data"))
#' gzs[1:10]
#' }
#'
#' @export getCHIRPS
#' @name getCHIRPS
getCHIRPS <- function(region = c("global", "whem", "africa", "camer-carib"),
format = c("tifs", "netcdf", "bils", "pngs"),
tres = c("6-hourly", "daily", "pentad", "dekad", "monthly"),
sres = c(0.05, 0.25),
begin = NULL, end = NULL,
dsn = getwd(), overwrite = FALSE,
cores = 1L, ...) {
region = region[1]; format = format[1]; tres = tres[1]; sres = sres[1]
## time frame
if (is.null(begin)) begin <- as.Date("1981-01-01")
if (is.null(end)) end <- Sys.Date()
## destination folder
if (!dir.exists(dsn)) dir.create(dsn, recursive = TRUE)
## dataset
ch_ext <- paste(region, tres, sep = "_")
## format (not required for 6-hourly files)
ch_ext <- if (tres == "6-hourly") {
paste0(ch_ext, "/p1_bin")
} else {
paste0(ch_ext, "/", format)
}
## spatial resolution (only required for daily files)
if (tres == "daily") {
sres <- formatC(sres * 100, width = 2, flag = 0)
sres <- paste0("p", sres)
ch_ext <- paste0(ch_ext, "/", sres)
}
## retrieve file list
ch_url <- paste0(serverPath(), "/", ch_ext, "/")
onl <- if (tres %in% c("pentad", "dekad", "monthly")) {
lsCat1(ch_url, begin, end)
} else if (tres == "6-hourly") {
lsCat2(ch_url, begin, end)
} else if (tres == "daily") {
if (format == "netcdf") {
lsCat4(ch_url, begin, end)
} else {
lsCat3(ch_url, begin, end)
}
} else {
stop("Specified temporal resolution (currently) not available.\n")
}
## download files
cl <- parallel::makePSOCKcluster(cores)
on.exit(parallel::stopCluster(cl))
dots <- list(...)
parallel::clusterExport(cl, c("dsn", "overwrite", "dots"),
envir = environment())
do.call("c", parallel::parLapply(cl, onl, function(j) {
# download current file
destfile <- file.path(dsn, basename(j))
jnk <- if (!file.exists(destfile) | overwrite) {
dots_sub <- list(url = j, destfile = destfile)
dots_sub <- append(dots_sub, dots)
try(do.call(utils::download.file, args = dots_sub), silent = TRUE)
}
# if file download failed, return nothing, else return local file
if (inherits(jnk, "try-error")) {
return(invisible())
} else {
return(destfile)
}
}))
}