enable-return-matrix-in-get_timeseries

AgrDataSci · Jan 5, 2023 · cfe75c3 · cfe75c3
1 parent 79b7c9f
commit cfe75c3
Show file tree

Hide file tree

Showing 6 changed files with 90 additions and 115 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -15,7 +15,6 @@ S3method(crop_sensitive,sf)
 S3method(get_timeseries,array)
 S3method(get_timeseries,default)
 S3method(get_timeseries,matrix)
-S3method(get_timeseries,sf)
 S3method(late_frost,array)
 S3method(late_frost,data.frame)
 S3method(late_frost,default)

diff --git a/R/get_timeseries.R b/R/get_timeseries.R
@@ -16,6 +16,7 @@
 #'  any other object that can be coerced to \code{Date} (e.g. integer, character 
 #'  YYYY-MM-DD)  for the last day of the time series
 #' @param data.from character, for the source of climate data. See details.
+#' @param as.matrix logical, optional, to return a matrix or array instead of a data.frame 
 #' @param ... additional arguments passed to methods. See details.
 #' @details 
 #' The \code{default} method and the \code{sf} method assumes that the climate 
@@ -38,7 +39,7 @@
 #' @return A list with class \code{clima_ls} with data.frame(s) with 
 #'  the class \code{clima_df} 
 #' @family GET functions
-#' @examples 
+#' @examplesIf interactive()
 #' # Using local sources
 #' # an array with temperature data
 #' data("temp_dat", package = "climatrends")
@@ -53,19 +54,18 @@
 #' 
 #' get_timeseries(rain_dat, "2013-10-28", span = span)
 #' 
-#' # library("nasapower")
-#' # library("sf")
-#' # # Fetch data from NASA POWER using 'sf' method
-#' # data("lonlatsf", package = "climatrends")
-#' # 
-#' # g <- get_timeseries(lonlatsf, 
-#' #                     day.one = "2018-05-16", 
-#' #                     last.day = "2018-05-30",
-#' #                     pars = c("PRECTOT", "T2M", "T10M"))
-#' # 
-#' # 
-#' # g
+#' \donttest{
+#' # data can be returned as matrix
+#' library("sf")
+#' # Fetch data from NASA POWER using 'sf' method
+#' data("lonlatsf", package = "climatrends")
 #' 
+#' g <- get_timeseries(object = lonlatsf,
+#'                     day.one = "2018-05-16",
+#'                     last.day = "2018-05-30",
+#'                     pars = c("PRECTOTCORR", "T2M"),
+#'                     as.matrix = TRUE)
+#' }
 #' @importFrom stats dist hclust cutree
 #' @export
 get_timeseries <- function(object, day.one, ...) {
@@ -76,7 +76,10 @@ get_timeseries <- function(object, day.one, ...) {
 
 #' @rdname get_timeseries
 #' @export
-get_timeseries.default <- function(object, day.one, span = NULL, last.day = NULL,
+get_timeseries.default <- function(object, day.one, 
+                                   span = NULL, 
+                                   last.day = NULL, 
+                                   as.matrix = FALSE,
                                    data.from = "nasapower", ...){
 
   dots <- list(...)
@@ -86,47 +89,12 @@ get_timeseries.default <- function(object, day.one, span = NULL, last.day = NULL
     days.before <- 0
   }
 
-  sts <- .st_span(day.one, span, last.day, days.before)
-
-  object <- as.data.frame(object)
-
-  makecall <- paste0(".", data.from)
-
-  args <- list(dates = sts$dates,
-               lonlat = object,
-               pars = pars)
-
-  object <- do.call(makecall, args)
-
-  r <- lapply(object, function(x){
-    .st_ts(x,
-           days = sts$begin,
-           span = sts$span,
-           maxspan = sts$maxspan)
-  })
-
-  class(r) <- union("clima_ls", class(r))
-
-  return(r)
-
-}
-
-#' @rdname get_timeseries
-#' @method get_timeseries sf
-#' @export
-get_timeseries.sf <- function(object, day.one, span = NULL, last.day = NULL, 
-                              data.from = "nasapower",
-                              ...){
-
-  dots <- list(...)
-  pars <- dots[["pars"]]
-  days.before <- dots[["days.before"]]
-  if (is.null(days.before)) {
-    days.before <- 0
+  if (isTRUE("sf" %in% class(object))) {
+
+    object <- .lonlat_from_sf(object)
+
   }
 
-  object <- .lonlat_from_sf(object)
-
   object <- as.data.frame(object)
 
   sts <- .st_span(day.one, span, last.day, days.before)
@@ -137,9 +105,16 @@ get_timeseries.sf <- function(object, day.one, span = NULL, last.day = NULL,
                lonlat = object,
                pars = pars)
 
-
   object <- do.call(makecall, args)
 
+  if (isTRUE(as.matrix)) {
+
+    object <- lapply(object, as.matrix)
+
+    return(object)
+
+  }
+
   r <- lapply(object, function(x){
     .st_ts(x,
            days = sts$begin,
@@ -153,7 +128,6 @@ get_timeseries.sf <- function(object, day.one, span = NULL, last.day = NULL,
 
 }
 
-
 #' @rdname get_timeseries
 #' @method get_timeseries matrix
 #' @export

diff --git a/codemeta.json b/codemeta.json
@@ -7,7 +7,7 @@
   "codeRepository": "https://agrdatasci.github.io/climatrends/",
   "issueTracker": "https://github.com/agrdatasci/climatrends/issues",
   "license": "https://spdx.org/licenses/MIT",
-  "version": "0.4",
+  "version": "0.5",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -67,39 +67,39 @@
   "softwareSuggestions": [
     {
       "@type": "SoftwareApplication",
-      "identifier": "chirps",
-      "name": "chirps",
+      "identifier": "ag5Tools",
+      "name": "ag5Tools",
       "provider": {
         "@id": "https://cran.r-project.org",
         "@type": "Organization",
         "name": "Comprehensive R Archive Network (CRAN)",
         "url": "https://cran.r-project.org"
       },
-      "sameAs": "https://CRAN.R-project.org/package=chirps"
+      "sameAs": "https://CRAN.R-project.org/package=ag5Tools"
     },
     {
       "@type": "SoftwareApplication",
-      "identifier": "knitr",
-      "name": "knitr",
+      "identifier": "chirps",
+      "name": "chirps",
       "provider": {
         "@id": "https://cran.r-project.org",
         "@type": "Organization",
         "name": "Comprehensive R Archive Network (CRAN)",
         "url": "https://cran.r-project.org"
       },
-      "sameAs": "https://CRAN.R-project.org/package=knitr"
+      "sameAs": "https://CRAN.R-project.org/package=chirps"
     },
     {
       "@type": "SoftwareApplication",
-      "identifier": "nasapower",
-      "name": "nasapower",
+      "identifier": "knitr",
+      "name": "knitr",
       "provider": {
         "@id": "https://cran.r-project.org",
         "@type": "Organization",
         "name": "Comprehensive R Archive Network (CRAN)",
         "url": "https://cran.r-project.org"
       },
-      "sameAs": "https://CRAN.R-project.org/package=nasapower"
+      "sameAs": "https://CRAN.R-project.org/package=knitr"
     },
     {
       "@type": "SoftwareApplication",
@@ -155,9 +155,21 @@
       "identifier": "stats",
       "name": "stats"
     },
+    "4": {
+      "@type": "SoftwareApplication",
+      "identifier": "nasapower",
+      "name": "nasapower",
+      "provider": {
+        "@id": "https://cran.r-project.org",
+        "@type": "Organization",
+        "name": "Comprehensive R Archive Network (CRAN)",
+        "url": "https://cran.r-project.org"
+      },
+      "sameAs": "https://CRAN.R-project.org/package=nasapower"
+    },
     "SystemRequirements": null
   },
-  "fileSize": "937.747KB",
+  "fileSize": "4498.756KB",
   "citation": [
     {
       "@type": "SoftwareSourceCode",

diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -5,5 +5,5 @@ articles:
   Climatology: Climatology.html
   Equations: Equations.html
   Overview: Overview.html
-last_built: 2023-01-05T13:15Z
+last_built: 2023-01-05T14:18Z
 
diff --git a/docs/reference/get_timeseries.html b/docs/reference/get_timeseries.html
diff --git a/man/get_timeseries.Rd b/man/get_timeseries.Rd