### List inventory of CHIRPS pentad, dekad, and monthly data -----
lsCat1 <- function(url, begin, end) {
onl <- getSplitURL(url)
onl <- onl[onl != "sub"]
tmp = strsplit(onl, "\\.")
yrs = sapply(tmp, "[[", 3)
mts = paste0(yrs, sapply(tmp, "[[", 4))
## subset with months of interest
ids <- match(sapply(c(begin, end), function(i) format(i, "%Y%m")), mts)
if (any(is.na(ids))) {
if (is.na(ids[1])) ids[1] <- 1
if (is.na(ids[2])) ids[2] <- length(mts)
}
paste0(url, onl[ids[1]:ids[2]])
}
### List inventory of CHIRPS 6-hourly data -----
lsCat2 <- function(url, begin, end) {
## available months
mts <- getSplitURL(url)
mts <- mts[nchar(mts) == 6]
## subset with months of interest
ids <- match(sapply(c(begin, end), function(i) format(i, "%Y%m")), mts)
if (any(is.na(ids))) {
if (is.na(ids[1])) ids[1] <- 1
if (is.na(ids[2])) ids[2] <- length(mts)
}
mts <- mts[ids[1]:ids[2]]
drs <- paste0(url, mts, "/")
## available time steps
do.call("c", lapply(drs, function(i) {
fls <- getSplitURL(i)
paste0(i, fls)
}))
}
### List inventory of CHIRPS daily data -----
lsCat3 <- function(url, begin, end) {
## available years
yrs <- getSplitURL(url)
yrs <- yrs[nchar(yrs) == 4]
## subset with years of interest
ids <- match(sapply(c(begin, end), function(i) format(i, "%Y")), yrs)
if (any(is.na(ids))) {
if (is.na(ids[1])) ids[1] <- 1
if (is.na(ids[2])) ids[2] <- length(yrs)
}
yrs <- yrs[ids[1]:ids[2]]
drs <- paste0(url, yrs, "/")
## available days
do.call("c", lapply(drs, function(i) {
fls <- getSplitURL(i)
paste0(i, fls)
}))
}
### List inventory of CHIRPS daily data in NetCDF format -----
lsCat4 <- function(url, begin, end) {
## available years
yrs <- getSplitURL(url)
yrs <- grep(".nc$", yrs, value = TRUE)
## subset with years of interest
ids <- sapply(
sapply(c(begin, end), function(i) format(i, "%Y"))
, function(i) grep(i, yrs)
)
if (any(is.na(ids))) {
if (is.na(ids[1])) ids[1] <- 1
if (is.na(ids[2])) ids[2] <- length(yrs)
}
paste0(url, yrs[ids[1]:ids[2]])
}
### Server paths for CHIRPS or TRMM data download -----
serverPath <- function(server = c("chirps", "trmm"), version = "2.0") {
## server not implemented
if (!(server[1] %in% c("chirps", "trmm")))
stop("Specified product not available or (currently) not supported.\n")
## chirps
if (server[1] == "chirps") {
if (!(version %in% c("2.0", "1.8")))
stop("Specified version not available or (currently) not supported.\n")
paste0("ftp://chg-ftpout.geog.ucsb.edu/pub/org/chg/products/CHIRPS-", version)
## trmm
} else if (server[1] == "trmm") {
"https://disc3.nascom.nasa.gov/data/TRMM_L3/"
}
}
getSplitURL <- function(url) {
onl <- RCurl::getURL(url, dirlistonly = TRUE)
unlist(strsplit(onl, "\r{0,1}\n{1}"))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.