Enabled retrieval of 3-hourly TRMM data.

DESCRIPTION

@@ -24,6 +24,8 @@ Imports:
     foreach,
     gdalUtils,
     ggplot2,
+    graphics, 
+    grDevices,
     grid, 
     gridBase,
     gridExtra,
@@ -45,6 +47,7 @@ Imports:
     SDMTools, 
     tagcloud,
     TSA,
+    utils,
     leaflet, 
     Rcpp (>= 0.11.3)
 LinkingTo: Rcpp

NAMESPACE

@@ -42,6 +42,7 @@ export(panel.map)
 export(pdfCloud)
 export(plotModelCV)
 export(pos2just)
+export(pwGen)
 export(rainbowPalette)
 export(rasterizeIMERG)
 export(rasterizeRegCM)
@@ -93,12 +94,36 @@ importFrom(dplyr,count_)
 importFrom(gdalUtils,gdal_translate)
 importFrom(ggplot2,ggplot_build)
 importFrom(ggplot2,ggplot_gtable)
+importFrom(grDevices,cm.colors)
+importFrom(grDevices,colorRampPalette)
+importFrom(grDevices,hcl)
+importFrom(graphics,.filled.contour)
+importFrom(graphics,legend)
+importFrom(graphics,par)
+importFrom(graphics,plot.window)
 importFrom(landsat,histmatch)
 importFrom(maps,map)
 importFrom(plotrix,thigmophobe)
 importFrom(plyr,round_any)
 importFrom(reshape2,melt)
 importFrom(rgeos,gCentroid)
 importFrom(roxygen2,roxygenize)
+importFrom(stats,as.formula)
+importFrom(stats,fitted)
+importFrom(stats,integrate)
+importFrom(stats,lm)
+importFrom(stats,median)
+importFrom(stats,na.exclude)
+importFrom(stats,sd)
+importFrom(stats,splinefun)
+importFrom(stats,ts)
 importFrom(tagcloud,tagcloud)
+importFrom(utils,combn)
+importFrom(utils,download.file)
+importFrom(utils,glob2rx)
+importFrom(utils,install.packages)
+importFrom(utils,installed.packages)
+importFrom(utils,modifyList)
+importFrom(utils,read.csv)
+importFrom(utils,update.packages)
 useDynLib(Rsenal)

R/Rsenal-package.R

@@ -29,6 +29,8 @@
 #' @importFrom dplyr count_
 #' @importFrom gdalUtils gdal_translate
 #' @importFrom ggplot2 ggplot_gtable ggplot_build
+#' @importFrom graphics .filled.contour legend par plot.window
+#' @importFrom grDevices cm.colors colorRampPalette hcl
 #' @importFrom landsat histmatch
 #' @importFrom maps map
 #' @importFrom plotrix thigmophobe
@@ -38,8 +40,11 @@
 #' @importFrom rgeos gCentroid
 #' @importFrom roxygen2 roxygenize
 #' @importFrom SDMTools PatchStat
+#' @importFrom stats as.formula fitted integrate lm median na.exclude sd splinefun ts
 #' @importFrom tagcloud tagcloud
 #' @importFrom TSA harmonic
+#' @importFrom utils combn download.file glob2rx install.packages installed.packages modifyList read.csv update.packages
+#'
 #' @useDynLib Rsenal
 NULL
 #' 

R/downloadTRMM.R

@@ -1,78 +1,183 @@
-#' Download TRMM 3B42 daily data
+if ( !isGeneric("downloadTRMM") ) {
+  setGeneric("downloadTRMM", function(begin, ...)
+    standardGeneric("downloadTRMM"))
+}
+
+#' Download TRMM 3B42 data
 #' 
 #' @description
-#' Download TRMM 3B42 daily binary data for a given time span from the NASA FTP servers 
-#' (\url{ftp://disc3.nascom.nasa.gov/data/s4pa/TRMM_L3/TRMM_3B42_daily/}).
+#' Download TRMM 3B42 daily or 3-hourly data for a given time span from the NASA 
+#' FTP servers (\url{ftp://disc3.nascom.nasa.gov/data/s4pa/TRMM_L3/}).
 #' 
-#' @param begin Date or character. Desired start date.
-#' @param end Date or character. Desired end date.
-#' @param dsn Character. Target directory for file download. If not supplied, 
-#' this defaults to the current working directory. 
-#' @param format Character. See \code{\link{as.Date}}.
-#' @param ... Further arguments. Currently not used. 
+#' @param begin \code{POSIXlt} or \code{character}, starting time.
+#' @param end Same as \code{begin}, end time.
+#' @param type \code{character}, data repetition cycle. Currently available 
+#' options are "daily" (default) and "3-hourly".
+#' @param dsn \code{character}, target folder for file download. Defaults to the 
+#' current working directory if not specified otherwise. 
+#' @param format \code{character}, see \code{\link{strptime}}.
 #' 
 #' @return
-#' A vector of filepaths.
+#' A \code{data.frame} with downloaded .bin (or .Z for 3-hourly data) and .xml 
+#' filepaths.
 #' 
 #' @author
 #' Florian Detsch
 #' 
 #' @seealso
-#' \code{\link{download.file}}
+#' \code{\link{strptime}}, \code{\link{download.file}}.
 #' 
 #' @examples  
 #' \dontrun{
-#' ## download TRMM 3B42 data from Jan 1 to Jan 5, 2015
-#' downloadTRMM(begin = "2015-01-01", end = "2015-01-05")
+#' ## download TRMM 3B42 daily data from Jan 1 to Jan 3, 2015
+#' downloadTRMM(begin = "2015-01-01", end = "2015-01-03")
+#' 
+#' ## same for 3-hourly data, from noon to noon
+#' downloadTRMM(begin = "2015-01-01 12:00", end = "2015-01-03 12:00", 
+#'              type = "3-hourly", format = "%Y-%m-%d %H:%M")
+
 #' }
 #'               
 #' @export downloadTRMM
-#' @aliases downloadTRMM
-downloadTRMM <- function(begin, end, dsn = ".", format = "%Y-%m-%d") {
+#' @name downloadTRMM
+NULL
+
+################################################################################
+### function using 'character' input -----
+#' @aliases downloadTRMM,character-method
+#' @rdname downloadTRMM
+setMethod("downloadTRMM",
+          signature(begin = "character"),
+          function(begin, end, type = c("daily", "3-hourly"), 
+                   dsn = getwd(), format = "%Y-%m-%d") {
 
   ## transform 'begin' and 'end' to 'Date' object if necessary
-  if (!class(begin) == "Date")
-    begin <- as.Date(begin, format = format)
+  begin <- strptime(begin, format = format)
+  end <- strptime(end, format = format)
+
+  downloadTRMM(begin = begin, end = end, type = type[1], dsn = dsn)
+})
 
-  if (!class(end) == "Date")
-    end <- as.Date(end, format = format)
 
-  ## trmm ftp server
-  ch_url <-"ftp://disc3.nascom.nasa.gov/data/s4pa/TRMM_L3/TRMM_3B42_daily/"
+################################################################################
+### function using 'POSIXlt' input -----
+#' @aliases downloadTRMM,POSIXlt-method
+#' @rdname downloadTRMM
+setMethod("downloadTRMM",
+          signature(begin = "POSIXlt"),
+          function(begin, end, type = c("daily", "3-hourly"), dsn = getwd()) {
+
+  ## tile server
+  ftp <- trmmServer(type = type[1])
 
-  ## loop over daily sequence
-  ls_fls_out <- lapply(seq(begin, end, 1), function(i) {
-
-    # year and julian day
-    tmp_ch_yr <- strftime(i, format = "%Y")
-    tmp_ch_dy <- strftime(i, format = "%j")
+  ## download daily data
+  if (type[1] == "daily") {
+    do.call("rbind", lapply(seq(as.Date(begin), as.Date(end), 1), function(i) {
+
+      # trmm date naming convention
+      drs <- paste0(ftp, strftime(i, format = "%Y/%j/"))
+      nms <- strftime(i + 1, format = "%Y.%m.%d")
+
+      # list files available on server
+      fls <- fls_out <- character(2L)
+
+      for (j in 1:2) {
+        fls[j] <- paste0(drs, "3B42_daily.", nms, ".7", 
+                         ifelse(j == 1, ".bin", ".bin.xml"))
+        fls_out[j] <- paste0(dsn, "/", basename(fls[j]))
+
+        # if required, download current file  
+        if (!file.exists(fls_out[j]))
+          download.file(fls[j], fls_out[j], mode = "wb")
+      }
+
+      # return data frame with *.bin and *.xml filenames
+      xml <- grep("xml", fls_out)
+      data.frame(bin = fls_out[-xml], xml = fls_out[xml], 
+                 stringsAsFactors = FALSE)
+    }))
 
-    # trmm date format
-    tmp_dt <- strftime(i+1, format = "%Y.%m.%d")
+  ## download 3-hourly data  
+  } else if (type[1] == "3-hourly") {
+
+    # 3-hourly sequence
+    hrs <- c(seq(3, 21, 3), 0)
 
-    # list files available on server
-    tmp_ch_url <- paste(ch_url, tmp_ch_yr, tmp_ch_dy, "", sep = "/")
+    # loop over single days
+    dys <- if (strftime(end, "%H") != "00") { 
+      seq(as.Date(begin), as.Date(end), 1)
+    } else {
+      seq(as.Date(begin), as.Date(end) - 1, 1)
+    }
 
-    tmp_ch_fls <- tmp_ch_fls_out <- character(2L)
-    for (j in 1:2) {
-      tmp_ch_fls[j] <- paste0("3B42_daily.", tmp_dt, ".7", 
-                              ifelse(j == 1, ".bin", ".bin.xml"))
+    do.call("rbind", lapply(dys, function(i) {
+      drs <- paste0(ftp, strftime(i, format = "%Y/%j/"))
+
+      ## start day
+      if (i == as.Date(begin)) {
+
+        nxt <- hrs - as.integer(strftime(begin, "%H"))
+
+        # before midnight
+        if (any(nxt < 0)) {
+          nxt <- which(nxt >= 0)[1]
+          hr3 <- seq(strptime(paste(i, hrs[nxt]), format = "%Y-%m-%d %H"), 
+                     strptime(paste(i + 1, hrs[length(hrs)]), format = "%Y-%m-%d %H"), 
+                     "3 hours")
+
+        # midnight    
+        } else {
+          nxt <- length(hrs)
+          hr3 <- strptime(paste(i + 1, hrs[length(hrs)]), format = "%Y-%m-%d %H")
+        }
 
-      tmp_ch_fls[j] <- paste(tmp_ch_url, tmp_ch_fls[j], sep = "/")
-      tmp_ch_fls_out[j] <- paste(dsn, basename(tmp_ch_fls[j]), sep = "/")
+      ## end day    
+      } else if (i == as.Date(end) | 
+                 (i == as.Date(end) - 1 & strftime(end, "%H") == "00")) {
+
+        lst <- hrs - as.integer(strftime(end, "%H"))
+
+        # before midnight
+        if (any(lst < 0)) {
+          lst <- which(lst > 0)[1] - 1
+          hr3 <- seq(strptime(paste(i, hrs[1]), format = "%Y-%m-%d %H"), 
+                     strptime(paste(i, hrs[lst]), format = "%Y-%m-%d %H"), 
+                     "3 hours")
+
+        # midnight  
+        } else {
+          hr3 <- seq(strptime(paste(i, hrs[1]), format = "%Y-%m-%d %H"), 
+                     strptime(paste(i + 1, hrs[length(lst)]), format = "%Y-%m-%d %H"), 
+                     "3 hours")
+        }
+
+      ## intermediary day  
+      } else {
+        hr3 <- seq(strptime(paste(i, "03"), format = "%Y-%m-%d %H"), 
+                   strptime(paste(i + 1, hrs[length(hrs)]), format = "%Y-%m-%d %H"), 
+                   "3 hours")
+      }
+
+      fls <- paste0("3B42.", strftime(hr3, format = "%Y%m%d.%H.7.HDF"))
+      fls_Z <- paste0(drs, fls, ".Z")
+      fls_xml <- paste0(drs, fls, ".xml")
+
+      fls_out_Z <- paste0(dsn, "/", basename(fls_Z))
+      fls_out_xml <- paste0(dsn, "/", basename(fls_xml))
+
+      for (j in seq(fls)) {
+        if (!file.exists(fls_out_Z[j]))
+          download.file(fls_Z[j], fls_out_Z[j], mode = "wb")
+
+        if (!file.exists(fls_out_xml[j]))
+        download.file(fls_xml[j], fls_out_xml[j], mode = "wb")
+      }
+
+      # return data frame with *.Z and *.xml filenames
+      data.frame(Z = fls_out_Z, xml = fls_out_xml, 
+                 stringsAsFactors = FALSE)
 
-      download.file(tmp_ch_fls[j], tmp_ch_fls_out[j], mode = "wb")
-    }
 
-    # return data frame with *.bin and *.xml filenames
-    tmp_id_xml <- grep("xml", tmp_ch_fls_out)
-    data.frame(bin = tmp_ch_fls_out[-tmp_id_xml], 
-               xml = tmp_ch_fls_out[tmp_id_xml], 
-               stringsAsFactors = FALSE)
-
-  })
-
-  ## join and return names of processed files
-  ch_fls_out <- do.call("rbind",ls_fls_out)
-  return(ch_fls_out)
-}
+    }))
+  }
+})

R/pwGen.R

@@ -12,7 +12,9 @@
 #' 
 #' @examples 
 #' pwGen(4, seed = as.numeric(Sys.Date()))
-
+#' 
+#' @export pwGen
+#' @name pwGen
 pwGen <- function(ndigits, seed = 123, master = NULL) {
 
   specials <- c("!", "_", "?", "+", "-", "=", "@", "&", "$", "%", "#")

R/trmmControls.R

@@ -0,0 +1,12 @@
+trmmServer <- function(type = c("daily", "3-hourly")) {
+  ## daily
+  if (type[1] == "daily") {
+    "ftp://disc3.nascom.nasa.gov/data/s4pa/TRMM_L3/TRMM_3B42_daily/"
+  ## 3-hourly  
+  } else if (type[1] == "3-hourly") {
+    "ftp://disc3.nascom.nasa.gov/data/s4pa/TRMM_L3/TRMM_3B42/"
+  ## invalid  
+  } else {
+    stop("'type = ", type[1], "' not supported. See ?downloadTRMM for available options.\n")
+  }
+}