build ok

GreenswayAB · Nov 13, 2020 · b018c26 · b018c26
1 parent b1d0a3c
commit b018c26
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 44 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: BIRDS
 Type: Package
 Title: Biodiversity Information Review and Decision Support 
-Version: 0.1.21
+Version: 0.1.22
 URL: https://github.com/greensway/BIRDS
 BugReports: https://github.com/Greensway/BIRDS/issues
 Authors@R: c(
@@ -60,7 +60,8 @@ Imports:
     shotGroups,
     taxize,
     tidyr,
-    xts
+    xts,
+    zoo
 Suggests: 
     covr, 
     dggridR, 

diff --git a/NAMESPACE b/NAMESPACE
@@ -57,6 +57,7 @@ importFrom(lubridate,date)
 importFrom(lubridate,day)
 importFrom(lubridate,month)
 importFrom(lubridate,year)
+importFrom(lubridate,ymd)
 importFrom(magrittr,"%>%")
 importFrom(methods,"slot<-")
 importFrom(methods,as)
@@ -84,3 +85,5 @@ importFrom(stats,quantile)
 importFrom(stats,var)
 importFrom(taxize,gbif_parse)
 importFrom(tidyr,pivot_wider)
+importFrom(xts,as.xts)
+importFrom(zoo,zoo)
diff --git a/R/exportBirds.R b/R/exportBirds.R
@@ -235,6 +235,9 @@ countIfHigher <- function(x, thr, na.rm = TRUE) {
 #' @keywords internal
 #' @importFrom rlang .data
 #' @importFrom dplyr pull
+#' @importFrom zoo zoo
+#' @importFrom xts as.xts
+#' @importFrom lubridate ymd
 exportTemporal <- function(sb, timeRes, variable, method){
   if (variable == "nYears" && timeRes != "month")  stop("This combination of variable and time resolution is not defined because it has no meaning")
   if (is.null(timeRes)) stop("Time resolution ('timeRes') needs to be defined for dimension 'Temporal'")
@@ -270,20 +273,13 @@ exportTemporal <- function(sb, timeRes, variable, method){
     if (timeRes %in% c("yearly", "monthly", "daily")){
       if (method != "sum") stop("This combination of variable and time resolution only accepts 'sum' as summary method")
       resVar <- pull(res, !!sym(variable))
-      # names(resVar) <- lubridate::ymd(switch(timeRes,
-      #                         "yearly" = paste0(yearsAll, "-01-01"),
-      #                         "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
-      #                         "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
-      #                         )
-      dates <- lubridate::ymd(switch(timeRes,
-                                     "yearly" = paste0(yearsAll, "-01-01"),
-                                     "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
-                                     "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
-                              )
-      # MAKE RESVAR to xts::as.xts()
-
-      str(zoo::zoo(resVar, dates))
-      resVar <- xts::as.xts(zoo::zoo(resVar, dates))
+      dates <- ymd(switch(timeRes,
+                          "yearly" = paste0(yearsAll, "-01-01"),
+                          "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
+                          "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
+                   )
+      # MAKE RESVAR
+      resVar <- as.xts(zoo(resVar, dates))
 
     } else { #month
       if (!(method %in% c("sum", "median", "mean"))) stop("This combination of variable and time resolution only accepts 'sum', 'median' or 'mean' as summary method")
@@ -309,21 +305,14 @@ exportTemporal <- function(sb, timeRes, variable, method){
       if (method != "median") stop("This combination of variable and time resolution only accepts 'median' as summary method")
       res <- getTemporalAvgSll(obsData, timeRes, visitCol, yearsAll)
       resVar <- pull(res, .data$avgSll)
-      # names(resVar) <- lubridate::ymd(switch(timeRes,
-      #                         "yearly" = paste0(yearsAll, "-01-01"),
-      #                         "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
-      #                         "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day))))
-
-      dates <- lubridate::ymd(switch(timeRes,
-                                     "yearly" = paste0(yearsAll, "-01-01"),
-                                     "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
-                                     "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
-      )
-      # MAKE RESVAR to xts::as.xts()
 
-      # str(zoo::zoo(resVar, dates))
-      resVar <- xts::as.xts(zoo::zoo(resVar, dates))
-      # resVar <- xts::as.xts(zoo::zoo(resVar, names(resVar)))
+      dates <- ymd(switch(timeRes,
+                          "yearly" = paste0(yearsAll, "-01-01"),
+                          "monthly"= paste0(res$year, "-", sprintf("%02d", res$month), "-01"),
+                          "daily"  = paste0(res$year, "-", sprintf("%02d", res$month), "-", sprintf("%02d", res$day)))
+                   )
+      # MAKE RESVAR
+      resVar <- as.xts(zoo(resVar, dates))
 
     } else { #month
       if (!(method %in% c("median", "mean"))) stop("This combination of variable and time resolution only accepts 'median' or 'mean' as summary method")
@@ -349,9 +338,6 @@ exportTemporal <- function(sb, timeRes, variable, method){
         resVar <- apply(sb$spatioTemporal[,,13,1], 2, countIfHigher, thr=1)
       }
       names(resVar) <- paste0(yearsAll, "-01-01")
-      # resVar <- zoo::zoo(unname(resVar),
-      #                    lubridate::ymd(names(resVar)))
-      # resVar <- xts::as.xts(resVar)
     }
 
     if (timeRes %in% c("monthly", "month")){
@@ -363,9 +349,6 @@ exportTemporal <- function(sb, timeRes, variable, method){
       if (timeRes == "monthly"){
         resVar <- as.vector(t(ncellsM))
         names(resVar) <- paste0(rep(yearsAll, each=12), "-", 1:12, "-01")
-        # resVar <- zoo::zoo(unname(resVar),
-        #                    lubridate::ymd(names(resVar)))
-        # resVar <- xts::as.xts(resVar)
 
       } else {
         resVar <- apply(ncellsM, 2, method)
@@ -387,17 +370,12 @@ exportTemporal <- function(sb, timeRes, variable, method){
         })
       )
       names(resVar) <- all.Days
-      # resVar <- zoo::zoo(unname(resVar),
-      #                    lubridate::ymd(all.Days))
-      # resVar <- xts::as.xts(resVar)
     }
 
     if (timeRes != "month") {
-      # str(zoo::zoo(unname(resVar), lubridate::ymd(names(resVar))))
-      resVar <- zoo::zoo(unname(resVar),
-                         lubridate::ymd(names(resVar)))
-      # resVar <- xts::as.xts(zoo::zoo(resVar, dates))
-      resVar <- xts::as.xts(resVar)
+      resVar <- zoo(unname(resVar),
+                    ymd(names(resVar)))
+      resVar <- as.xts(resVar)
     }
   } else {
     stop(paste0("variable = ", variable, " is not a valid input"))