From b018c26a5f11305702a862c9196a7fffca1fc720 Mon Sep 17 00:00:00 2001 From: Alejandro Ruete Date: Fri, 13 Nov 2020 11:15:06 +0100 Subject: [PATCH] build ok --- DESCRIPTION | 5 ++-- NAMESPACE | 3 +++ R/exportBirds.R | 62 ++++++++++++++++--------------------------------- 3 files changed, 26 insertions(+), 44 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d001d10..10bf1d1 100644 --- 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 index 5695a9d..b62881a 100644 --- 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 index 7161c5d..c25f668 100644 --- 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"))