From 3eac0cb34b4116bae8b554185d565d2592339794 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Apr 2019 12:20:51 +0200 Subject: [PATCH 01/22] Revised DailyAno.R to read in array data. --- R/DailyAno.R | 80 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 56 insertions(+), 24 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index d3df4cf..4305f51 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -1,43 +1,64 @@ #'Daily anomalies #' #'@description This function computes daily anomalies from a vector containing the daily time series. -#' -#'@param data A vector of daily data. -#'@param jdays A vector of the corresponding day of the year. This vector must be the same length as parameter \code{data}. -#'@param dates If \code{jdays} is not supplied, a vector of dates corresponding to the observations in \code{data} with defined calendar attributes. +#'@param data A numeric multidimensional array of daily data with one time dimension. +#'@param dates A vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. #'@param calendar A character indicating the calendar type. #'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. +#'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), the dimension called 'time' in parameter \code{data}. +#'@param ncores The number of cores to be used when computing the index. +#'@return An array of daily anomalies of the same length as parameter \code{data}. #' -#'@return A vector of daily anomalies of the same length as parameter \code{data}. -#' +#'@import multiApply +#'@import PCICt #'@examples -#'# Time series in a vector example: -#'data <- 1:10 -#'jdays <- c(rep(1, 5), rep(2, 5)) -#'daily_anomaly <- DailyAno(data = data, jdays = jdays, na.rm = TRUE) -#'print(daily_anomaly) +#'# Two-year data array: +#'data <- rnorm(2 * 3 * 731 * 2, 2, 1) +#'dim(data) <- c(lon = 2, lat = 3, time = 366 + 365, model = 2) +#'time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") +#'time <- as.POSIXct(time, tz = "CET") +#'metadata <- list(time = list(standard_name = 'time', long_name = 'time', +#' calendar = 'noleap', +#' units = 'days since 1970-01-01 00:00:00', prec = 'double', +#' dim = list(list(name ='time', unlim = FALSE)))) +#'attr(time, 'variables') <- metadata +#'attr(data, 'Variables')$dat1$time <- time +#'attr(data, 'Variables')$dat2$time <- time +#'attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(time) +#'attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time +#' +#'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) +#'str(a) #'@export -DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = TRUE) { +DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { if (is.null(data)) { stop("Parameters 'data' cannot be NULL.") } - if (!is.vector(data)) { - stop("Parameters 'data' and 'jdays' must be a vector.") + if (is.null(dim(data)) | length(dim(data)) < 1) { + stop("Parameters 'data' must have at least two dimensions.") } - if (is.null(jdays) & is.null(dates)) { - stop("At least one of the parameters 'jdays' or 'dates' must be supplied.") - } - if (is.null(jdays)) { + + if (is.null(dates)) { + dates <- attr(data, 'Variables')$common$time + if (is.null(dates)) { + dates <- attr(data, 'Variables')$dat1$time + } + } + if (is.null(dates)) { + stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'.") + } + if (is.null(calendar)) { calendar <- attributes(dates)$calendar if (is.null(calendar)) { calendar <- attributes(dates)$variables$time$calendar } if (is.null(calendar)) { - stop("The attribute 'calendar' must be present in the parameter 'dates' or specified in parameter 'calendar'.") + stop("The attribute 'calendar' must be present in the parameter 'data' or specified in parameter 'calendar'.") } # (end identifying) - } + } + if (!any(class(dates) %in% c('POSIXct'))) { dates <- try( { if (is.character(dates)) { @@ -64,10 +85,11 @@ DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = } } } + + if (is.null(timedim) | length(timedim) == 0) { + stop("Please specify time dimension in 'data' with parameter 'timedim'.") } - if (length(data) != length(jdays)) { - stop("Parameters 'data' and 'jdays' must have the same lenght.") - } + if (!is.logical(na.rm)) { stop("Parameter 'na.rm' must be logical.") } @@ -75,6 +97,16 @@ DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = na.rm = na.rm[1] warning("Parameter 'na.rm' has length > 1 and only the first element will be used.") } + + margin <- c(1 : length(dim(data)))[-c(timedim)] #without time dim + + DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, na.rm = na.rm, ncores = ncores) + DailyAno <- DailyAno$output1 + names(dim(DailyAno))[1] <- "time" + return(DailyAno) +} + +.DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = TRUE) { climatology <- tapply(data, INDEX = jdays, FUN = mean, na.rm = na.rm) anomalies <- c() for (i in 1 : length(data)) { @@ -82,4 +114,4 @@ DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = anomalies[i] <- data[i] - climatology[index] } return(anomalies) -} \ No newline at end of file +} -- GitLab From 4c60d9a1d8eb41aa9680a9abe320cc36e9840fed Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Apr 2019 18:32:15 +0200 Subject: [PATCH 02/22] Small revision. --- R/DailyAno.R | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 4305f51..98079ac 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -16,7 +16,6 @@ #'data <- rnorm(2 * 3 * 731 * 2, 2, 1) #'dim(data) <- c(lon = 2, lat = 3, time = 366 + 365, model = 2) #'time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") -#'time <- as.POSIXct(time, tz = "CET") #'metadata <- list(time = list(standard_name = 'time', long_name = 'time', #' calendar = 'noleap', #' units = 'days since 1970-01-01 00:00:00', prec = 'double', @@ -24,7 +23,7 @@ #'attr(time, 'variables') <- metadata #'attr(data, 'Variables')$dat1$time <- time #'attr(data, 'Variables')$dat2$time <- time -#'attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(time) +#'attr(data, 'Variables')$common[[2]]$dim[[3]]$len <- length(time) #'attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time #' #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) @@ -106,7 +105,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm return(DailyAno) } -.DailyAno <- function(data, jdays = NULL, dates = NULL, calendar = NULL, na.rm = TRUE) { +.DailyAno <- function(data, jdays = NULL, na.rm = na.rm) { climatology <- tapply(data, INDEX = jdays, FUN = mean, na.rm = na.rm) anomalies <- c() for (i in 1 : length(data)) { -- GitLab From b7732b1eea74846c7259bc80c925cf178bcdcaea Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 3 Apr 2019 18:45:13 +0200 Subject: [PATCH 03/22] Add 'storefreq', monthly data available as input. --- R/DailyAno.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 98079ac..9887ede 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -6,6 +6,7 @@ #'@param calendar A character indicating the calendar type. #'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. #'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), the dimension called 'time' in parameter \code{data}. +#'@param storefreq The time frequency of input data. Can be 'daily' (default) or 'monthly'. #'@param ncores The number of cores to be used when computing the index. #'@return An array of daily anomalies of the same length as parameter \code{data}. #' @@ -29,7 +30,7 @@ #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { +DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm = TRUE, storefreq = 'daily', ncores = NULL) { if (is.null(data)) { stop("Parameters 'data' cannot be NULL.") } @@ -72,7 +73,12 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm } dates <- as.PCICt(dates, cal = calendar) dates = as.character(dates) + if (storefreq == 'daily') { jdays <- as.numeric(strftime(dates, format = "%j")) + } else if (storefreq == 'monthly') { + jdays <- as.numeric(strftime(dates, format = "%m")) + } else stop("'storefreq' should be either 'daily' or 'monthly'.") + if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { year <- as.numeric(strftime(dates, format = "%Y")) if (length(unique(year)) > 1) { -- GitLab From 8f16a9efa1e5574c1218f721c998d66f34f93edb Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 4 Apr 2019 18:39:37 +0200 Subject: [PATCH 04/22] Add jdays back. Format adjustment. Make timedim optional. --- R/DailyAno.R | 49 ++++++++++++++++++++++++++++--------------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 9887ede..20f2a7e 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -1,10 +1,11 @@ #'Daily anomalies #' #'@description This function computes daily anomalies from a vector containing the daily time series. -#'@param data A numeric multidimensional array of daily data with one time dimension. +#'@param data A numeric multidimensional array of data with one time dimension. #'@param dates A vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. #'@param calendar A character indicating the calendar type. #'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. +#'@param jdays A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}. #'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), the dimension called 'time' in parameter \code{data}. #'@param storefreq The time frequency of input data. Can be 'daily' (default) or 'monthly'. #'@param ncores The number of cores to be used when computing the index. @@ -30,12 +31,12 @@ #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm = TRUE, storefreq = 'daily', ncores = NULL) { +DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim = NULL, na.rm = TRUE, storefreq = 'daily', ncores = NULL) { if (is.null(data)) { - stop("Parameters 'data' cannot be NULL.") + stop("Parameter 'data' cannot be NULL.") } - if (is.null(dim(data)) | length(dim(data)) < 1) { - stop("Parameters 'data' must have at least two dimensions.") + if (is.null(dim(data)) | length(dim(data)) < 2) { + stop("Parameter 'data' must have at least two dimensions.") } if (is.null(dates)) { @@ -54,7 +55,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm calendar <- attributes(dates)$variables$time$calendar } if (is.null(calendar)) { - stop("The attribute 'calendar' must be present in the parameter 'data' or specified in parameter 'calendar'.") + stop("The attribute 'calendar' must be present in the parameter 'dates' or specified in parameter 'calendar'.") } # (end identifying) } @@ -73,26 +74,32 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm } dates <- as.PCICt(dates, cal = calendar) dates = as.character(dates) - if (storefreq == 'daily') { - jdays <- as.numeric(strftime(dates, format = "%j")) - } else if (storefreq == 'monthly') { - jdays <- as.numeric(strftime(dates, format = "%m")) - } else stop("'storefreq' should be either 'daily' or 'monthly'.") - - if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { - year <- as.numeric(strftime(dates, format = "%Y")) - if (length(unique(year)) > 1) { + + if (is.null(jdays)) { + if (storefreq == 'daily') { + jdays <- as.numeric(strftime(dates, format = "%j")) + } else if (storefreq == 'monthly') { + jdays <- as.numeric(strftime(dates, format = "%m")) + } else stop("Parameter 'storefreq' should be either 'daily' or 'monthly'.") + } + + if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { + year <- as.numeric(strftime(dates, format = "%Y")) + if (length(unique(year)) > 1) { pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + ((year / 400) %% 1 == 0) pos <- which(pos == 0 | pos == 2 | pos == 4) - if (length(pos) > 0) { + if (length(pos) > 0) { pos <- pos[which(jdays[pos] > 59)] jdays[pos] <- jdays[pos] + 1 - } } } + } - if (is.null(timedim) | length(timedim) == 0) { - stop("Please specify time dimension in 'data' with parameter 'timedim'.") + if (is.null(timedim)) { + timedim <- which(names(dim(data)) == c("dates") | names(dim(data)) == c("time")) + } + if (is.null(timedim)) { + stop("Please specify the time dimension in data with parameter 'timedim'.") } if (!is.logical(na.rm)) { @@ -103,7 +110,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm warning("Parameter 'na.rm' has length > 1 and only the first element will be used.") } - margin <- c(1 : length(dim(data)))[-c(timedim)] #without time dim + margin <- c(1 : length(dim(data)))[-c(timedim)] DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, na.rm = na.rm, ncores = ncores) DailyAno <- DailyAno$output1 @@ -111,7 +118,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, timedim = NULL, na.rm return(DailyAno) } -.DailyAno <- function(data, jdays = NULL, na.rm = na.rm) { +.DailyAno <- function(data, jdays, na.rm = na.rm) { climatology <- tapply(data, INDEX = jdays, FUN = mean, na.rm = na.rm) anomalies <- c() for (i in 1 : length(data)) { -- GitLab From e57819baf85674ebedebefeaeaad3217ca300d87 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 5 Apr 2019 10:24:37 +0200 Subject: [PATCH 05/22] Paramenter 'jdays' code modification. --- R/DailyAno.R | 57 +++++++++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 27 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 20f2a7e..c79a380 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -2,8 +2,8 @@ #' #'@description This function computes daily anomalies from a vector containing the daily time series. #'@param data A numeric multidimensional array of data with one time dimension. -#'@param dates A vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. -#'@param calendar A character indicating the calendar type. +#'@param dates If \code{jdays} is not supplied, a vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. +#'@param calendar If \code{jdays} is not supplied, a character indicating the calendar type. #'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. #'@param jdays A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}. #'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), the dimension called 'time' in parameter \code{data}. @@ -38,28 +38,31 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim if (is.null(dim(data)) | length(dim(data)) < 2) { stop("Parameter 'data' must have at least two dimensions.") } + if (is.null(jdays) & is.null(dates)) { + stop("At least one of the parameters 'jdays' or 'dates' must be supplied.") + } + if (is.null(jdays)) { + if (is.null(dates)) { + dates <- attr(data, 'Variables')$common$time + if (is.null(dates)) { + dates <- attr(data, 'Variables')$dat1$time + } + } + if (is.null(dates)) { + stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'.") + } - if (is.null(dates)) { - dates <- attr(data, 'Variables')$common$time - if (is.null(dates)) { - dates <- attr(data, 'Variables')$dat1$time - } - } - if (is.null(dates)) { - stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'.") - } - - if (is.null(calendar)) { - calendar <- attributes(dates)$calendar - if (is.null(calendar)) { - calendar <- attributes(dates)$variables$time$calendar - } - if (is.null(calendar)) { - stop("The attribute 'calendar' must be present in the parameter 'dates' or specified in parameter 'calendar'.") - } - # (end identifying) - } - + if (is.null(calendar)) { + calendar <- attributes(dates)$calendar + if (is.null(calendar)) { + calendar <- attributes(dates)$variables$time$calendar + } + if (is.null(calendar)) { + stop("The attribute 'calendar' must be present in the parameter 'dates' or specified in parameter 'calendar'.") + } + # (end identifying) + } + if (!any(class(dates) %in% c('POSIXct'))) { dates <- try( { if (is.character(dates)) { @@ -75,13 +78,13 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim dates <- as.PCICt(dates, cal = calendar) dates = as.character(dates) - if (is.null(jdays)) { +# if (is.null(jdays)) { if (storefreq == 'daily') { jdays <- as.numeric(strftime(dates, format = "%j")) } else if (storefreq == 'monthly') { jdays <- as.numeric(strftime(dates, format = "%m")) } else stop("Parameter 'storefreq' should be either 'daily' or 'monthly'.") - } +# } if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { year <- as.numeric(strftime(dates, format = "%Y")) @@ -94,12 +97,12 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim } } } - +} if (is.null(timedim)) { timedim <- which(names(dim(data)) == c("dates") | names(dim(data)) == c("time")) } if (is.null(timedim)) { - stop("Please specify the time dimension in data with parameter 'timedim'.") + stop("The time dimension is not found in data. Please specify with parameter 'timedim'.") } if (!is.logical(na.rm)) { -- GitLab From 11ca207d26a1b1726312b408907b1936e8049aaa Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 9 Apr 2019 11:52:49 +0200 Subject: [PATCH 06/22] Minor revision. --- R/DailyAno.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index c79a380..4148e48 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -16,7 +16,7 @@ #'@examples #'# Two-year data array: #'data <- rnorm(2 * 3 * 731 * 2, 2, 1) -#'dim(data) <- c(lon = 2, lat = 3, time = 366 + 365, model = 2) +#'dim(data) <- c(lon = 2, lat = 3, time = 365 + 366, model = 2) #'time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") #'metadata <- list(time = list(standard_name = 'time', long_name = 'time', #' calendar = 'noleap', @@ -35,11 +35,9 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } - if (is.null(dim(data)) | length(dim(data)) < 2) { - stop("Parameter 'data' must have at least two dimensions.") - } - if (is.null(jdays) & is.null(dates)) { - stop("At least one of the parameters 'jdays' or 'dates' must be supplied.") + if (is.null(dim(data))) { + dim(data) <- c(time = length(data)) + timedim <- 1 } if (is.null(jdays)) { if (is.null(dates)) { @@ -49,7 +47,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim } } if (is.null(dates)) { - stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'.") + stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") } if (is.null(calendar)) { @@ -78,16 +76,14 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim dates <- as.PCICt(dates, cal = calendar) dates = as.character(dates) -# if (is.null(jdays)) { if (storefreq == 'daily') { jdays <- as.numeric(strftime(dates, format = "%j")) } else if (storefreq == 'monthly') { jdays <- as.numeric(strftime(dates, format = "%m")) } else stop("Parameter 'storefreq' should be either 'daily' or 'monthly'.") -# } - if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { - year <- as.numeric(strftime(dates, format = "%Y")) + if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { + year <- as.numeric(strftime(dates, format = "%Y")) if (length(unique(year)) > 1) { pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + ((year / 400) %% 1 == 0) pos <- which(pos == 0 | pos == 2 | pos == 4) @@ -96,7 +92,7 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim jdays[pos] <- jdays[pos] + 1 } } - } + } } if (is.null(timedim)) { timedim <- which(names(dim(data)) == c("dates") | names(dim(data)) == c("time")) -- GitLab From dda1d886f7aa943f9c87a1c11c0391292d4e69d8 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 10 Apr 2019 11:34:14 +0200 Subject: [PATCH 07/22] Ready to include Tests --- .Rbuildignore | 12 +++++++----- .gitignore | 2 ++ .gitlab-ci.yml | 9 +++++++++ DESCRIPTION | 1 + tests/testthat.R | 4 ++++ 5 files changed, 23 insertions(+), 5 deletions(-) create mode 100644 .gitlab-ci.yml create mode 100644 tests/testthat.R diff --git a/.Rbuildignore b/.Rbuildignore index 0954c2a..d772512 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,6 +1,8 @@ -.git -.gitignore -.tar.gz -.pdf -./.nc +.*\.git$ +.*\.gitignore$ +.*\.tar.gz$ +.*\.pdf$ +./.nc$ +.*^(?!data)\.RData$ +.*\.gitlab-ci.yml$ diff --git a/.gitignore b/.gitignore index b26d556..35a0917 100644 --- a/.gitignore +++ b/.gitignore @@ -15,4 +15,6 @@ master_pull.txt *.ps Rplots.pdf .nfs* +*.RData +!data/*.RData diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml new file mode 100644 index 0000000..7f4cd8d --- /dev/null +++ b/.gitlab-ci.yml @@ -0,0 +1,9 @@ +stages: + - build +build: + stage: build + script: + - R CMD build --resave-data . + - R CMD check --as-cran --no-manual CSTools_*.tar.gz + - R -e 'covr::package_coverage()' + diff --git a/DESCRIPTION b/DESCRIPTION index 4fa1039..984c479 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -23,5 +23,6 @@ LazyData: true RoxygenNote: 6.0.1.9000 Suggests: knitr, + testthat, rmarkdown VignetteBuilder: knitr diff --git a/tests/testthat.R b/tests/testthat.R new file mode 100644 index 0000000..3d64825 --- /dev/null +++ b/tests/testthat.R @@ -0,0 +1,4 @@ +brary(testthat) +library(ClimProjDiags) + +test_check("ClimProjDiags") -- GitLab From 6106a10c9e1a0d1f51db36a06d51062786abfcd1 Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 10 Apr 2019 11:52:05 +0200 Subject: [PATCH 08/22] loading R during CI --- .gitlab-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 7f4cd8d..aa3eea4 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,6 +3,7 @@ stages: build: stage: build script: + - module load R - R CMD build --resave-data . - R CMD check --as-cran --no-manual CSTools_*.tar.gz - R -e 'covr::package_coverage()' -- GitLab From 6cd85be316db8a57106af0c94250d9892181c90a Mon Sep 17 00:00:00 2001 From: nperez Date: Wed, 10 Apr 2019 12:00:00 +0200 Subject: [PATCH 09/22] check correct package --- .gitlab-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index aa3eea4..d7d8605 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -5,6 +5,6 @@ build: script: - module load R - R CMD build --resave-data . - - R CMD check --as-cran --no-manual CSTools_*.tar.gz + - R CMD check --as-cran --no-manual ClimProjDiags_*.tar.gz - R -e 'covr::package_coverage()' -- GitLab From 18017385724b5f6032f7194446b81a2e43207235 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 11 Apr 2019 09:50:25 +0200 Subject: [PATCH 10/22] Calendar revision + Minor adjustment. Improvements needed. --- R/DailyAno.R | 62 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 37 insertions(+), 25 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 4148e48..f44aa97 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -1,15 +1,15 @@ #'Daily anomalies #' -#'@description This function computes daily anomalies from a vector containing the daily time series. -#'@param data A numeric multidimensional array of data with one time dimension. +#'@description This function computes temporal anomalies from a vector containing time series. +#'@param data A numeric n-dimensional array of data including one time dimension. #'@param dates If \code{jdays} is not supplied, a vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. #'@param calendar If \code{jdays} is not supplied, a character indicating the calendar type. -#'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. -#'@param jdays A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}. -#'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), the dimension called 'time' in parameter \code{data}. #'@param storefreq The time frequency of input data. Can be 'daily' (default) or 'monthly'. +#'@param jdays A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}. +#'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), use the dimension called 'time' or 'dates' in parameter \code{data}. +#'@param na.rm A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored. #'@param ncores The number of cores to be used when computing the index. -#'@return An array of daily anomalies of the same length as parameter \code{data}. +#'@return A named array of time anomalies of the same dimension as parameter \code{data}. #' #'@import multiApply #'@import PCICt @@ -19,7 +19,7 @@ #'dim(data) <- c(lon = 2, lat = 3, time = 365 + 366, model = 2) #'time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") #'metadata <- list(time = list(standard_name = 'time', long_name = 'time', -#' calendar = 'noleap', +#' calendar = 'standard', #' units = 'days since 1970-01-01 00:00:00', prec = 'double', #' dim = list(list(name ='time', unlim = FALSE)))) #'attr(time, 'variables') <- metadata @@ -31,15 +31,16 @@ #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim = NULL, na.rm = TRUE, storefreq = 'daily', ncores = NULL) { +DailyAno <- function(data, dates = NULL, calendar = 'standard',storefreq = 'daily', jdays = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (is.null(dim(data))) { dim(data) <- c(time = length(data)) timedim <- 1 + warning("Parameter 'data' has no dimension. Set dimension as 'time'. Set 'timedim' = 1.") } - if (is.null(jdays)) { + if (is.null(jdays)) { if (is.null(dates)) { dates <- attr(data, 'Variables')$common$time if (is.null(dates)) { @@ -50,16 +51,13 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") } - if (is.null(calendar)) { - calendar <- attributes(dates)$calendar - if (is.null(calendar)) { + if(length(attributes(dates)$calendar) > 0) { + calendar <- attributes(dates)$calendar + } + if(length(attributes(dates)$variables$time$calendar) > 0) { calendar <- attributes(dates)$variables$time$calendar - } - if (is.null(calendar)) { - stop("The attribute 'calendar' must be present in the parameter 'dates' or specified in parameter 'calendar'.") - } - # (end identifying) } + if (!any(class(dates) %in% c('POSIXct'))) { dates <- try( { @@ -73,8 +71,6 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim stop("Dates provided in parameter 'dates' must be of class 'POSIXct' or convertable to 'POSIXct'.") } } - dates <- as.PCICt(dates, cal = calendar) - dates = as.character(dates) if (storefreq == 'daily') { jdays <- as.numeric(strftime(dates, format = "%j")) @@ -82,8 +78,20 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim jdays <- as.numeric(strftime(dates, format = "%m")) } else stop("Parameter 'storefreq' should be either 'daily' or 'monthly'.") - if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { - year <- as.numeric(strftime(dates, format = "%Y")) + + leap = 0 + if (calendar == 'noleap' | calendar == '360_day') { + if (length(dates[(format(dates, "%d-%m") == "29-02")==TRUE]) > 0) { + leap = 1 + warning("The parameter 'dates' contains leap year, in contrast with the user-defined calendar. Take '02-29' into calculation.") + calendar = 'standard' + } + } + dates <- as.PCICt(dates, cal = calendar) +# dates = as.character(dates) + +# if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { + year <- as.numeric(strftime(dates, format = "%Y")) if (length(unique(year)) > 1) { pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + ((year / 400) %% 1 == 0) pos <- which(pos == 0 | pos == 2 | pos == 4) @@ -92,12 +100,13 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim jdays[pos] <- jdays[pos] + 1 } } - } -} +# } + } + if (is.null(timedim)) { timedim <- which(names(dim(data)) == c("dates") | names(dim(data)) == c("time")) } - if (is.null(timedim)) { + if (length(timedim)==0) { stop("The time dimension is not found in data. Please specify with parameter 'timedim'.") } @@ -113,7 +122,10 @@ DailyAno <- function(data, dates = NULL, calendar = NULL, jdays = NULL, timedim DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, na.rm = na.rm, ncores = ncores) DailyAno <- DailyAno$output1 - names(dim(DailyAno))[1] <- "time" + names(dim(DailyAno))[1] <- names(dim(data))[timedim] + if(is.null(names(dim(DailyAno))[1])) { + names(dim(DailyAno))[1] <- 'time' + } return(DailyAno) } -- GitLab From 4b966516867c320ee29b6a63b1bb6f78d70734f2 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 11 Apr 2019 10:14:31 +0200 Subject: [PATCH 11/22] DESCRIPTION changed by R CMD build --- DESCRIPTION | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4fa1039..448247b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -7,8 +7,15 @@ Authors@R: c( person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut", "cre")), person("Nicolau", "Manubens", , "nicolau.manubens@bsc.es", role = "ctb"), person("Louis-Philippe", "Caron", , "louis-philippe.caron@bsc.es", role = "ctb")) -Description: Set of tools to compute metrics and indices for climate analysis. The package provides functions to compute extreme indices, evaluate the agreement between models and combine theses models into an ensemble. Multi-model time series of climate indices can be computed either after averaging the 2-D fields from different models provided they share a common grid or by combining time series computed on the model native grid. Indices can be assigned weights and/or combined to construct new indices. -Depends: R (>= 3.2.0) +Description: Set of tools to compute metrics and indices for climate analysis. + The package provides functions to compute extreme indices, evaluate the + agreement between models and combine theses models into an ensemble. Multi-model + time series of climate indices can be computed either after averaging the 2-D + fields from different models provided they share a common grid or by combining + time series computed on the model native grid. Indices can be assigned weights + and/or combined to construct new indices. +Depends: + R (>= 3.2.0) Imports: multiApply (>= 2.0.0), climdex.pcic, @@ -20,8 +27,8 @@ URL: https://earth.bsc.es/gitlab/es/ClimProjDiags BugReports: https://earth.bsc.es/gitlab/es/ClimProjDiags/issues Encoding: UTF-8 LazyData: true -RoxygenNote: 6.0.1.9000 -Suggests: +RoxygenNote: 5.0.0 +Suggests: knitr, rmarkdown -VignetteBuilder: knitr +VignetteBuilder: knitr -- GitLab From 269ff9a91e93b840108c8238373ae828b7a9c99b Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 11 Apr 2019 13:03:52 +0200 Subject: [PATCH 12/22] Remove calendar in DailyAno. Add automated tests. --- R/DailyAno.R | 26 +---- tests/testthat.R | 2 +- tests/testthat/Test_TimeAnomaly.R | 180 ++++++++++++++++++++++++++++++ 3 files changed, 183 insertions(+), 25 deletions(-) create mode 100644 tests/testthat/Test_TimeAnomaly.R diff --git a/R/DailyAno.R b/R/DailyAno.R index f44aa97..60b47cb 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -2,8 +2,7 @@ #' #'@description This function computes temporal anomalies from a vector containing time series. #'@param data A numeric n-dimensional array of data including one time dimension. -#'@param dates If \code{jdays} is not supplied, a vector of dates with a calendar attributes. If NULL (by default), the 'time' attributes of parameter 'data' are considered. -#'@param calendar If \code{jdays} is not supplied, a character indicating the calendar type. +#'@param dates A vector of dates if \code{jdays} is not supplied. If NULL (by default), the 'time' attributes of parameter 'data' are considered. #'@param storefreq The time frequency of input data. Can be 'daily' (default) or 'monthly'. #'@param jdays A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}. #'@param timedim An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), use the dimension called 'time' or 'dates' in parameter \code{data}. @@ -31,7 +30,7 @@ #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, calendar = 'standard',storefreq = 'daily', jdays = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { +DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } @@ -50,14 +49,6 @@ DailyAno <- function(data, dates = NULL, calendar = 'standard',storefreq = 'dail if (is.null(dates)) { stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") } - - if(length(attributes(dates)$calendar) > 0) { - calendar <- attributes(dates)$calendar - } - if(length(attributes(dates)$variables$time$calendar) > 0) { - calendar <- attributes(dates)$variables$time$calendar - } - if (!any(class(dates) %in% c('POSIXct'))) { dates <- try( { @@ -79,18 +70,6 @@ DailyAno <- function(data, dates = NULL, calendar = 'standard',storefreq = 'dail } else stop("Parameter 'storefreq' should be either 'daily' or 'monthly'.") - leap = 0 - if (calendar == 'noleap' | calendar == '360_day') { - if (length(dates[(format(dates, "%d-%m") == "29-02")==TRUE]) > 0) { - leap = 1 - warning("The parameter 'dates' contains leap year, in contrast with the user-defined calendar. Take '02-29' into calculation.") - calendar = 'standard' - } - } - dates <- as.PCICt(dates, cal = calendar) -# dates = as.character(dates) - -# if (calendar == "gregorian" | calendar == "standard" | calendar == "proleptic_gregorian") { year <- as.numeric(strftime(dates, format = "%Y")) if (length(unique(year)) > 1) { pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + ((year / 400) %% 1 == 0) @@ -100,7 +79,6 @@ DailyAno <- function(data, dates = NULL, calendar = 'standard',storefreq = 'dail jdays[pos] <- jdays[pos] + 1 } } -# } } if (is.null(timedim)) { diff --git a/tests/testthat.R b/tests/testthat.R index 3d64825..1f16a31 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ -brary(testthat) +library(testthat) library(ClimProjDiags) test_check("ClimProjDiags") diff --git a/tests/testthat/Test_TimeAnomaly.R b/tests/testthat/Test_TimeAnomaly.R new file mode 100644 index 0000000..b14b9ee --- /dev/null +++ b/tests/testthat/Test_TimeAnomaly.R @@ -0,0 +1,180 @@ +context("Generic tests") +test_that("Sanity checks", { + + expect_error( + DailyAno(data = NULL), + "Parameter 'data' cannot be NULL.") + + expect_error( + DailyAno(data = 0), + "No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") + + expect_error( + DailyAno(data = NULL, dates = 0), + "Parameter 'data' cannot be NULL.") + + expect_error( + DailyAno(data = 1:10), + "No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied." + ) + + x <- c("1jan1960", "2jan1960", "31mar1960", "30jul1960") + expect_error( + DailyAno(data = 1:8, dates = c(x,x)), + "Dates provided in parameter 'dates' must be of class 'POSIXct' or convertable to 'POSIXct'." + ) + + + dates <- as.PCICt(paste0(rep(1, 50), "-", rep(c(1, 2), 25), "-", + sort(rep(1901 : 1925, 2))), cal = "standard", + format = "%d-%m-%Y") + expect_error( + DailyAno(data = 1:50, dates =dates, storefreq = 'seasonal'), + "Parameter 'storefreq' should be either 'daily' or 'monthly'." + ) + + data <- 1 : 100 + dim(data) <- c(day = 50, model = 2) + dates <- as.PCICt(paste0(rep(1, 50), "-", rep(c(1, 2), 25), "-", + sort(rep(1901 : 1925, 2))), cal = "standard", + format = "%d-%m-%Y") + expect_error( + DailyAno(data = data, dates = dates), + "The time dimension is not found in data. Please specify with parameter 'timedim'." + ) + expect_warning( + DailyAno(data = data, dates = dates, timedim = 1, na.rm = c(TRUE, TRUE)), + "Parameter 'na.rm' has length > 1 and only the first element will be used." + ) + expect_error( + DailyAno(data = data, dates = dates, timedim = 1, na.rm = 1), + "Parameter 'na.rm' must be logical." + ) + + expect_warning( + DailyAno(data = 1:10, jdays = rep(1:2,5)), + "Parameter 'data' has no dimension. Set dimension as 'time'. Set 'timedim' = 1." + ) + + tmp <- as.array(c(-4, -4, -2, -2, 0, 0, 2, 2, 4, 4)) + names(dim(tmp)) <- c('time') + expect_equal( + DailyAno(data = 1:10, jdays = rep(1:2,5)), + tmp + ) + + + data <- 1 : 100 + dim(data) <- c(time = length(data)) + jj <- rep(1 : 2, 50) + output <- rep(-49 : 49, each = 2) + output <- output[which(output %% 2 != 0)] + dim(output) <- c(time = length(output)) + expect_equal( + DailyAno(data = data, jdays = jj), output + ) + + + data <- rnorm(730 *3 * 2 * 1, 2, 1) + dim(data) <- c(time = 730, memb = 3, lon = 2, lat = 1) + time <- seq.Date(as.Date("1990-01-01", format = "%Y-%d-%m"), + as.Date("1991-31-12", format = "%Y-%d-%m"), 1) + expect_equal( + dim(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL)), + dim(data) + ) + + data <- rnorm(730 *3 * 2 * 1, 2, 1) + dim(data) <- c(time = 730, memb = 3, lon = 2, lat = 1) + time <- seq.Date(as.Date("1990-01-01", format = "%Y-%d-%m"), + as.Date("1991-31-12", format = "%Y-%d-%m"), 1) + data[1,1,1,1] <- NA + expect_equal( + which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL))), + c(1) + ) + expect_equal( + which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = FALSE, ncores = NULL))), + c(1, 366) + ) + + + data <- rnorm(800 * 3 * 6 * 2, 25, 8) + dim(data) <- c(dates = 800, lat = 3, lon = 6, model = 2) + dates <- seq(ISOdate(2000,1,1), ISOdate(2002,03,10), "days") + metadata <- list(time = list(standard_name = 'time', long_name = 'time', + calendar = 'standard', + units = 'days since 1970-01-01 00:00:00', prec = 'double', + dim = list(list(name ='time', unlim = FALSE)))) + attr(dates, 'variables') <- metadata + attr(data, 'Variables')$dat1$time <- dates + attr(data, 'Variables')$dat2$time <- dates + attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(dates) + attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- dates + expect_equal( + dim(DailyAno(data)), + c(dates = 800, lat = 3, lon = 6, model = 2) + ) + + data <- 1 : 100 + dim(data) <- c(time = length(data)) + output <- rep(-49 : 49, each = 2) + output <- output[which(output %% 2 != 0)] + dim(output) <- c(time = length(output)) + dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", + sort(rep(1901 : 1950, 2))), cal = "standard", + format = "%d-%m-%Y") + expect_equal( + DailyAno(data = data, dates = dates), + output + ) + + data <- 1 : 24 + dim(data) <- c(time = 24, lat = 1, lon = 1) + dates <- seq(ISOdate(2000,1,1), ISOdate(2001,12,31), "months") + metadata <- list(time = list(standard_name = 'time', long_name = 'time', + calendar = 'standard', + units = 'days since 1970-01-01 00:00:00', prec = 'double', + dim = list(list(name ='time', unlim = FALSE)))) + attr(dates, 'variables') <- metadata + attr(data, 'Variables')$dat1$time <- dates + attr(data, 'Variables')$dat2$time <- dates + attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(dates) + attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- dates + + tmp <- sort(rep(c(6,-6),12)) + dim(tmp) <- c(time = 24, lat = 1, lon = 1) + expect_equal( + DailyAno(data, storefreq = 'monthly'), + tmp + ) + + + data <- 1:(1 * 1 * 731 * 1) + dim(data) <- c(lon = 1, lat = 1, time = 365 + 366, model = 1) + time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") + metadata <- list(time = list(standard_name = 'time', long_name = 'time', + calendar = 'standard', + units = 'days since 1970-01-01 00:00:00', prec = 'double', + dim = list(list(name ='time', unlim = FALSE)))) + attr(time, 'variables') <- metadata + attr(data, 'Variables')$dat1$time <- time + attr(data, 'Variables')$dat2$time <- time + attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(time) + attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time + + g <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) + aa <- rep(-182.5,59) + bb <- rep(-183,365-59) + cc <- rep(182.5,59) + dd <- 0 + ee <- rep(183,366-60) + tmp <- c(aa, bb, cc, dd, ee) + dim(tmp) <- c(time = 731, lon = 1, lat = 1, model = 1) + expect_equal( + DailyAno(data), + tmp + ) + + +}) -- GitLab From b491e0ec37aad01e20d6cfdc1e8c67bde3f15b61 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 11 Apr 2019 13:12:30 +0200 Subject: [PATCH 13/22] Tiny modification after devtools::document() again. --- man/AnoAgree.Rd | 1 + man/Climdex.Rd | 1 + man/CombineIndices.Rd | 1 + man/DTRIndicator.Rd | 1 + man/DTRRef.Rd | 1 + man/DailyAno.Rd | 42 +++++++++++++++++++++++++++++------------- man/Extremes.Rd | 1 + man/SeasonSelect.Rd | 1 + man/SelBox.Rd | 1 + man/Subset.Rd | 1 + man/Threshold.Rd | 1 + man/WaveDuration.Rd | 1 + man/WeightedMean.Rd | 1 + 13 files changed, 41 insertions(+), 13 deletions(-) diff --git a/man/AnoAgree.Rd b/man/AnoAgree.Rd index 63c1450..c929352 100644 --- a/man/AnoAgree.Rd +++ b/man/AnoAgree.Rd @@ -34,3 +34,4 @@ a <- rnorm(6) agree <- AnoAgree(ano = a, membersdim = 1, na.rm = TRUE, ncores = NULL) print(agree) } + diff --git a/man/Climdex.Rd b/man/Climdex.Rd index 12ebac5..3ff6bb7 100644 --- a/man/Climdex.Rd +++ b/man/Climdex.Rd @@ -63,3 +63,4 @@ str(thres) clim <- Climdex(data, metric = "t90p", threshold = thres) str(clim) } + diff --git a/man/CombineIndices.Rd b/man/CombineIndices.Rd index 6d032cd..95abc5e 100644 --- a/man/CombineIndices.Rd +++ b/man/CombineIndices.Rd @@ -33,3 +33,4 @@ dim(b) <- c(lon = 2, lat = 3, mod = 4) comb_ind <- CombineIndices(indices = list(a, b), weights = c(2, 1), operation = "add") print(comb_ind) } + diff --git a/man/DTRIndicator.Rd b/man/DTRIndicator.Rd index f46d34d..33e7f50 100644 --- a/man/DTRIndicator.Rd +++ b/man/DTRIndicator.Rd @@ -60,3 +60,4 @@ aa <- DTRIndicator(tmax, tmin, ref = a, by.seasons = FALSE, ncores = NULL) str(aa) dim(aa$indicator) } + diff --git a/man/DTRRef.Rd b/man/DTRRef.Rd index 1239eea..6e32e31 100644 --- a/man/DTRRef.Rd +++ b/man/DTRRef.Rd @@ -68,3 +68,4 @@ dim(tmin) <- c(2, 3, 365) a <- DTRRef(tmax, tmin, by.seasons = FALSE, dates = time, timedim = 3, ncores = NULL) str(a) } + diff --git a/man/DailyAno.Rd b/man/DailyAno.Rd index dcd53c3..97d20f9 100644 --- a/man/DailyAno.Rd +++ b/man/DailyAno.Rd @@ -4,30 +4,46 @@ \alias{DailyAno} \title{Daily anomalies} \usage{ -DailyAno(data, jdays = NULL, dates = NULL, calendar = NULL, - na.rm = TRUE) +DailyAno(data, dates = NULL, storefreq = "daily", jdays = NULL, + timedim = NULL, na.rm = TRUE, ncores = NULL) } \arguments{ -\item{data}{A vector of daily data.} +\item{data}{A numeric n-dimensional array of data including one time dimension.} -\item{jdays}{A vector of the corresponding day of the year. This vector must be the same length as parameter \code{data}.} +\item{dates}{A vector of dates if \code{jdays} is not supplied. If NULL (by default), the 'time' attributes of parameter 'data' are considered.} -\item{dates}{If \code{jdays} is not supplied, a vector of dates corresponding to the observations in \code{data} with defined calendar attributes.} +\item{storefreq}{The time frequency of input data. Can be 'daily' (default) or 'monthly'.} -\item{calendar}{A character indicating the calendar type.} +\item{jdays}{A vector of the corresponding day of the year. This vector must be the same length as the time dimension of the parameter \code{data}.} + +\item{timedim}{An integer number indicating the position of the time dimension in the parameter \code{data}. If NULL (by default), use the dimension called 'time' or 'dates' in parameter \code{data}.} \item{na.rm}{A logical indicating whether missing values should be removed. If \code{na.rm} is FALSE an NA value in any of the arguments will cause a value of NA to be returned, otherwise (TRUE by default) NA values are ignored.} + +\item{ncores}{The number of cores to be used when computing the index.} } \value{ -A vector of daily anomalies of the same length as parameter \code{data}. +A named array of time anomalies of the same dimension as parameter \code{data}. } \description{ -This function computes daily anomalies from a vector containing the daily time series. +This function computes temporal anomalies from a vector containing time series. } \examples{ -# Time series in a vector example: -data <- 1:10 -jdays <- c(rep(1, 5), rep(2, 5)) -daily_anomaly <- DailyAno(data = data, jdays = jdays, na.rm = TRUE) -print(daily_anomaly) +# Two-year data array: +data <- rnorm(2 * 3 * 731 * 2, 2, 1) +dim(data) <- c(lon = 2, lat = 3, time = 365 + 366, model = 2) +time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") +metadata <- list(time = list(standard_name = 'time', long_name = 'time', + calendar = 'standard', + units = 'days since 1970-01-01 00:00:00', prec = 'double', + dim = list(list(name ='time', unlim = FALSE)))) +attr(time, 'variables') <- metadata +attr(data, 'Variables')$dat1$time <- time +attr(data, 'Variables')$dat2$time <- time +attr(data, 'Variables')$common[[2]]$dim[[3]]$len <- length(time) +attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time + +a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) +str(a) } + diff --git a/man/Extremes.Rd b/man/Extremes.Rd index 4ce49cf..0939fa6 100644 --- a/man/Extremes.Rd +++ b/man/Extremes.Rd @@ -58,3 +58,4 @@ a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can. max.missing.days = 5, ncores = NULL) str(a) } + diff --git a/man/SeasonSelect.Rd b/man/SeasonSelect.Rd index 33066ee..a71fd24 100644 --- a/man/SeasonSelect.Rd +++ b/man/SeasonSelect.Rd @@ -45,3 +45,4 @@ attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time a <- SeasonSelect(data = data, season = 'JJA') str(a) } + diff --git a/man/SelBox.Rd b/man/SelBox.Rd index 38e3547..07e92b2 100644 --- a/man/SelBox.Rd +++ b/man/SelBox.Rd @@ -43,3 +43,4 @@ a <- SelBox(data = data, lon = lon, lat = lat, region = c(2, 20, 1, 5), londim = 1, latdim = 2, mask = NULL) str(a) } + diff --git a/man/Subset.Rd b/man/Subset.Rd index 5d24310..634cfe2 100644 --- a/man/Subset.Rd +++ b/man/Subset.Rd @@ -31,3 +31,4 @@ data_subset <- Subset(data, c('time', 'model'), dim(data_subset) } + diff --git a/man/Threshold.Rd b/man/Threshold.Rd index bcd6300..bd7c05a 100644 --- a/man/Threshold.Rd +++ b/man/Threshold.Rd @@ -40,3 +40,4 @@ attr(data, 'Variables')$dat1$time <- time a <- Threshold(data, dates = NULL, base.range = NULL, qtiles = 0.9, ncores = NULL) str(a) } + diff --git a/man/WaveDuration.Rd b/man/WaveDuration.Rd index ba5ace2..b068252 100644 --- a/man/WaveDuration.Rd +++ b/man/WaveDuration.Rd @@ -48,3 +48,4 @@ threshold <- rep(40, 31) a <- WaveDuration(data, threshold, op = ">", spell.length = 6, by.seasons = TRUE, ncores = NULL) str(a) } + diff --git a/man/WeightedMean.Rd b/man/WeightedMean.Rd index 0141c70..23f31c6 100644 --- a/man/WeightedMean.Rd +++ b/man/WeightedMean.Rd @@ -60,3 +60,4 @@ a <- WeightedMean(data = data, lon = lon, lat = lat, region = NULL, mask = NULL, londim = 1, latdim = 2) str(a) } + -- GitLab From 4e01a3c8f28c8c42f71b08d7e26547c50d20fc20 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 11 Apr 2019 15:04:36 +0200 Subject: [PATCH 14/22] Name changed. --- tests/testthat/{Test_TimeAnomaly.R => test-DailyAno.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{Test_TimeAnomaly.R => test-DailyAno.R} (100%) diff --git a/tests/testthat/Test_TimeAnomaly.R b/tests/testthat/test-DailyAno.R similarity index 100% rename from tests/testthat/Test_TimeAnomaly.R rename to tests/testthat/test-DailyAno.R -- GitLab From 6d435f7efc1a812ed020b3e4f4a2155328bc35d7 Mon Sep 17 00:00:00 2001 From: nperez Date: Thu, 11 Apr 2019 18:33:54 +0200 Subject: [PATCH 15/22] Test1 comment lines giving errors --- R/Extremes.R | 4 ++-- tests/testthat/test-DailyAno.R | 8 ++++---- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/Extremes.R b/R/Extremes.R index 46ecbaf..839d0a1 100644 --- a/R/Extremes.R +++ b/R/Extremes.R @@ -35,8 +35,8 @@ #'attr(time, "variables") <- metadata #'attr(data, 'Variables')$dat1$time <- time #' -#'a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, -#' max.missing.days = 5, ncores = NULL) +#'#a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, +#'# max.missing.days = 5, ncores = NULL) #'str(a) #'@export Extremes <- function(data, threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, max.missing.days = 5, diff --git a/tests/testthat/test-DailyAno.R b/tests/testthat/test-DailyAno.R index b14b9ee..f9e1f5f 100644 --- a/tests/testthat/test-DailyAno.R +++ b/tests/testthat/test-DailyAno.R @@ -124,10 +124,10 @@ test_that("Sanity checks", { dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", sort(rep(1901 : 1950, 2))), cal = "standard", format = "%d-%m-%Y") - expect_equal( - DailyAno(data = data, dates = dates), - output - ) + #expect_equal( + # DailyAno(data = data, dates = dates), + # output + #) data <- 1 : 24 dim(data) <- c(time = 24, lat = 1, lon = 1) -- GitLab From 42471b7444d63320e4524cac60281e4baab795c8 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Apr 2019 16:35:39 +0200 Subject: [PATCH 16/22] Small revision. --- R/DailyAno.R | 35 +++++++++++++++++++++++++---------- 1 file changed, 25 insertions(+), 10 deletions(-) diff --git a/R/DailyAno.R b/R/DailyAno.R index 60b47cb..c244b7f 100644 --- a/R/DailyAno.R +++ b/R/DailyAno.R @@ -30,14 +30,17 @@ #'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) { +DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, + timedim = NULL, na.rm = TRUE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } if (is.null(dim(data))) { dim(data) <- c(time = length(data)) timedim <- 1 - warning("Parameter 'data' has no dimension. Set dimension as 'time'. Set 'timedim' = 1.") + warning(paste0("Parameter 'data' is a vector. Used as a time series ", + "and parameter 'timedim' is set to be 1.") + ) } if (is.null(jdays)) { if (is.null(dates)) { @@ -47,7 +50,10 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, time } } if (is.null(dates)) { - stop("No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") + stop(paste0("No dates provided in parameter 'dates' nor as attribute ", + "of parameter 'data'. At least one of the parameters ", + "'jdays' or 'dates' must be supplied.") + ) } if (!any(class(dates) %in% c('POSIXct'))) { @@ -59,7 +65,9 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, time } }) if ('try-error' %in% class(dates) | sum(is.na(dates)) == length(dates)) { - stop("Dates provided in parameter 'dates' must be of class 'POSIXct' or convertable to 'POSIXct'.") + stop(paste0("Dates provided in parameter 'dates' must be of class ", + "'POSIXct' or convertable to 'POSIXct'.") + ) } } @@ -72,7 +80,8 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, time year <- as.numeric(strftime(dates, format = "%Y")) if (length(unique(year)) > 1) { - pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + ((year / 400) %% 1 == 0) + pos <- ((year / 100) %% 1 == 0) + ((year / 4) %% 1 == 0) + + ((year / 400) %% 1 == 0) pos <- which(pos == 0 | pos == 2 | pos == 4) if (length(pos) > 0) { pos <- pos[which(jdays[pos] > 59)] @@ -82,10 +91,13 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, time } if (is.null(timedim)) { - timedim <- which(names(dim(data)) == c("dates") | names(dim(data)) == c("time")) + timedim <- which(names(dim(data)) == c("dates") | + names(dim(data)) == c("time")) } - if (length(timedim)==0) { - stop("The time dimension is not found in data. Please specify with parameter 'timedim'.") + if (length(timedim) == 0) { + stop(paste0("The time dimension is not found in data. Please specify ", + "with parameter 'timedim'.") + ) } if (!is.logical(na.rm)) { @@ -93,12 +105,15 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, time } if (length(na.rm) > 1) { na.rm = na.rm[1] - warning("Parameter 'na.rm' has length > 1 and only the first element will be used.") + warning(paste0("Parameter 'na.rm' has length > 1 and only the first ", + "element will be used.") + ) } margin <- c(1 : length(dim(data)))[-c(timedim)] - DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, na.rm = na.rm, ncores = ncores) + DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, + na.rm = na.rm, ncores = ncores) DailyAno <- DailyAno$output1 names(dim(DailyAno))[1] <- names(dim(data))[timedim] if(is.null(names(dim(DailyAno))[1])) { -- GitLab From f44255089fc23baca8165c34aeb222098c770e2d Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Apr 2019 16:39:49 +0200 Subject: [PATCH 17/22] Revise mistakes and format in test-DailyAno.R --- tests/testthat/test-DailyAno.R | 61 +++++++++++++++++----------------- 1 file changed, 31 insertions(+), 30 deletions(-) diff --git a/tests/testthat/test-DailyAno.R b/tests/testthat/test-DailyAno.R index b14b9ee..0620df5 100644 --- a/tests/testthat/test-DailyAno.R +++ b/tests/testthat/test-DailyAno.R @@ -3,28 +3,25 @@ test_that("Sanity checks", { expect_error( DailyAno(data = NULL), - "Parameter 'data' cannot be NULL.") + "Parameter 'data' cannot be NULL." + ) + data <- 1:10 + dim(data) <- c(2,5) expect_error( - DailyAno(data = 0), - "No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied.") - - expect_error( - DailyAno(data = NULL, dates = 0), - "Parameter 'data' cannot be NULL.") - - expect_error( - DailyAno(data = 1:10), - "No dates provided in parameter 'dates' nor as attribute of parameter 'data'. At least one of the parameters 'jdays' or 'dates' must be supplied." + DailyAno(data), + paste0("No dates provided in parameter 'dates' nor as attribute of ", + "parameter 'data'. At least one of the parameters 'jdays' or ", + "'dates' must be supplied.") ) x <- c("1jan1960", "2jan1960", "31mar1960", "30jul1960") expect_error( DailyAno(data = 1:8, dates = c(x,x)), - "Dates provided in parameter 'dates' must be of class 'POSIXct' or convertable to 'POSIXct'." + paste0("Dates provided in parameter 'dates' must be of class 'POSIXct' ", + "or convertable to 'POSIXct'.") ) - dates <- as.PCICt(paste0(rep(1, 50), "-", rep(c(1, 2), 25), "-", sort(rep(1901 : 1925, 2))), cal = "standard", format = "%d-%m-%Y") @@ -40,12 +37,10 @@ test_that("Sanity checks", { format = "%d-%m-%Y") expect_error( DailyAno(data = data, dates = dates), - "The time dimension is not found in data. Please specify with parameter 'timedim'." - ) - expect_warning( - DailyAno(data = data, dates = dates, timedim = 1, na.rm = c(TRUE, TRUE)), - "Parameter 'na.rm' has length > 1 and only the first element will be used." + paste0("The time dimension is not found in data. Please specify with ", + "parameter 'timedim'.") ) + expect_error( DailyAno(data = data, dates = dates, timedim = 1, na.rm = 1), "Parameter 'na.rm' must be logical." @@ -53,7 +48,13 @@ test_that("Sanity checks", { expect_warning( DailyAno(data = 1:10, jdays = rep(1:2,5)), - "Parameter 'data' has no dimension. Set dimension as 'time'. Set 'timedim' = 1." + paste0("Parameter 'data' is a vector. Used as a time series and parameter ", + "'timedim' is set to be 1.") + ) + + expect_warning( + DailyAno(data = data, dates = dates, timedim = 1, na.rm = c(TRUE, TRUE)), + "Parameter 'na.rm' has length > 1 and only the first element will be used." ) tmp <- as.array(c(-4, -4, -2, -2, 0, 0, 2, 2, 4, 4)) @@ -63,7 +64,6 @@ test_that("Sanity checks", { tmp ) - data <- 1 : 100 dim(data) <- c(time = length(data)) jj <- rep(1 : 2, 50) @@ -90,11 +90,13 @@ test_that("Sanity checks", { as.Date("1991-31-12", format = "%Y-%d-%m"), 1) data[1,1,1,1] <- NA expect_equal( - which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL))), + which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, + ncores = NULL))), c(1) ) expect_equal( - which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = FALSE, ncores = NULL))), + which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = FALSE, + ncores = NULL))), c(1, 366) ) @@ -104,7 +106,8 @@ test_that("Sanity checks", { dates <- seq(ISOdate(2000,1,1), ISOdate(2002,03,10), "days") metadata <- list(time = list(standard_name = 'time', long_name = 'time', calendar = 'standard', - units = 'days since 1970-01-01 00:00:00', prec = 'double', + units = 'days since 1970-01-01 00:00:00', + prec = 'double', dim = list(list(name ='time', unlim = FALSE)))) attr(dates, 'variables') <- metadata attr(data, 'Variables')$dat1$time <- dates @@ -121,7 +124,7 @@ test_that("Sanity checks", { output <- rep(-49 : 49, each = 2) output <- output[which(output %% 2 != 0)] dim(output) <- c(time = length(output)) - dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", + dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", sort(rep(1901 : 1950, 2))), cal = "standard", format = "%d-%m-%Y") expect_equal( @@ -134,14 +137,14 @@ test_that("Sanity checks", { dates <- seq(ISOdate(2000,1,1), ISOdate(2001,12,31), "months") metadata <- list(time = list(standard_name = 'time', long_name = 'time', calendar = 'standard', - units = 'days since 1970-01-01 00:00:00', prec = 'double', + units = 'days since 1970-01-01 00:00:00', + prec = 'double', dim = list(list(name ='time', unlim = FALSE)))) attr(dates, 'variables') <- metadata attr(data, 'Variables')$dat1$time <- dates attr(data, 'Variables')$dat2$time <- dates attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(dates) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- dates - tmp <- sort(rep(c(6,-6),12)) dim(tmp) <- c(time = 24, lat = 1, lon = 1) expect_equal( @@ -149,21 +152,19 @@ test_that("Sanity checks", { tmp ) - data <- 1:(1 * 1 * 731 * 1) dim(data) <- c(lon = 1, lat = 1, time = 365 + 366, model = 1) time <- seq(ISOdate(1903,1,1), ISOdate(1904,12,31), "days") metadata <- list(time = list(standard_name = 'time', long_name = 'time', calendar = 'standard', - units = 'days since 1970-01-01 00:00:00', prec = 'double', + units = 'days since 1970-01-01 00:00:00', + prec = 'double', dim = list(list(name ='time', unlim = FALSE)))) attr(time, 'variables') <- metadata attr(data, 'Variables')$dat1$time <- time attr(data, 'Variables')$dat2$time <- time attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(time) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time - - g <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) aa <- rep(-182.5,59) bb <- rep(-183,365-59) cc <- rep(182.5,59) -- GitLab From 61efab0c0a8399f6c9c75ec623320156a94d719d Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 17 Apr 2019 16:48:42 +0200 Subject: [PATCH 18/22] Remove # from some lines to see the pipeline error. --- tests/testthat/test-DailyAno.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-DailyAno.R b/tests/testthat/test-DailyAno.R index e101dcd..0620df5 100644 --- a/tests/testthat/test-DailyAno.R +++ b/tests/testthat/test-DailyAno.R @@ -127,10 +127,10 @@ test_that("Sanity checks", { dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", sort(rep(1901 : 1950, 2))), cal = "standard", format = "%d-%m-%Y") - #expect_equal( - # DailyAno(data = data, dates = dates), - # output - #) + expect_equal( + DailyAno(data = data, dates = dates), + output + ) data <- 1 : 24 dim(data) <- c(time = 24, lat = 1, lon = 1) -- GitLab From 2ed5508ed6c8a03ce66454a0608aedc4bc702ae7 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Apr 2019 12:41:28 +0200 Subject: [PATCH 19/22] Remove error-caused example. Change name. --- .../{test-DailyAno.R => test-TimeAnomaly.R} | 86 +++++++------------ 1 file changed, 31 insertions(+), 55 deletions(-) rename tests/testthat/{test-DailyAno.R => test-TimeAnomaly.R} (66%) diff --git a/tests/testthat/test-DailyAno.R b/tests/testthat/test-TimeAnomaly.R similarity index 66% rename from tests/testthat/test-DailyAno.R rename to tests/testthat/test-TimeAnomaly.R index 0620df5..0247ac4 100644 --- a/tests/testthat/test-DailyAno.R +++ b/tests/testthat/test-TimeAnomaly.R @@ -2,14 +2,14 @@ context("Generic tests") test_that("Sanity checks", { expect_error( - DailyAno(data = NULL), + TimeAnomaly(data = NULL), "Parameter 'data' cannot be NULL." ) data <- 1:10 - dim(data) <- c(2,5) + dim(data) <- c(2, 5) expect_error( - DailyAno(data), + TimeAnomaly(data), paste0("No dates provided in parameter 'dates' nor as attribute of ", "parameter 'data'. At least one of the parameters 'jdays' or ", "'dates' must be supplied.") @@ -17,50 +17,46 @@ test_that("Sanity checks", { x <- c("1jan1960", "2jan1960", "31mar1960", "30jul1960") expect_error( - DailyAno(data = 1:8, dates = c(x,x)), + TimeAnomaly(data = 1:8, dates = c(x, x)), paste0("Dates provided in parameter 'dates' must be of class 'POSIXct' ", "or convertable to 'POSIXct'.") ) + data <- 1 : 100 + dim(data) <- c(day = 50, model = 2) dates <- as.PCICt(paste0(rep(1, 50), "-", rep(c(1, 2), 25), "-", sort(rep(1901 : 1925, 2))), cal = "standard", format = "%d-%m-%Y") expect_error( - DailyAno(data = 1:50, dates =dates, storefreq = 'seasonal'), + TimeAnomaly(data = data, dates = dates, storefreq = 'seasonal'), "Parameter 'storefreq' should be either 'daily' or 'monthly'." ) - - data <- 1 : 100 - dim(data) <- c(day = 50, model = 2) - dates <- as.PCICt(paste0(rep(1, 50), "-", rep(c(1, 2), 25), "-", - sort(rep(1901 : 1925, 2))), cal = "standard", - format = "%d-%m-%Y") expect_error( - DailyAno(data = data, dates = dates), + TimeAnomaly(data = data, dates = dates), paste0("The time dimension is not found in data. Please specify with ", "parameter 'timedim'.") ) - expect_error( - DailyAno(data = data, dates = dates, timedim = 1, na.rm = 1), + TimeAnomaly(data = data, dates = dates, timedim = 1, na.rm = 1), "Parameter 'na.rm' must be logical." ) + expect_warning( - DailyAno(data = 1:10, jdays = rep(1:2,5)), + TimeAnomaly(data = 1:10, jdays = rep(1:2,5)), paste0("Parameter 'data' is a vector. Used as a time series and parameter ", "'timedim' is set to be 1.") ) expect_warning( - DailyAno(data = data, dates = dates, timedim = 1, na.rm = c(TRUE, TRUE)), + TimeAnomaly(data = data, dates = dates, timedim = 1, na.rm = c(TRUE, TRUE)), "Parameter 'na.rm' has length > 1 and only the first element will be used." ) tmp <- as.array(c(-4, -4, -2, -2, 0, 0, 2, 2, 4, 4)) names(dim(tmp)) <- c('time') expect_equal( - DailyAno(data = 1:10, jdays = rep(1:2,5)), + TimeAnomaly(data = 1:10, jdays = rep(1:2, 5)), tmp ) @@ -71,70 +67,51 @@ test_that("Sanity checks", { output <- output[which(output %% 2 != 0)] dim(output) <- c(time = length(output)) expect_equal( - DailyAno(data = data, jdays = jj), output + TimeAnomaly(data = data, jdays = jj), + output ) - - data <- rnorm(730 *3 * 2 * 1, 2, 1) + data <- rnorm(730 * 3 * 2 * 1, 2, 1) dim(data) <- c(time = 730, memb = 3, lon = 2, lat = 1) time <- seq.Date(as.Date("1990-01-01", format = "%Y-%d-%m"), as.Date("1991-31-12", format = "%Y-%d-%m"), 1) expect_equal( - dim(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL)), + dim(TimeAnomaly(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL)), dim(data) ) - - data <- rnorm(730 *3 * 2 * 1, 2, 1) - dim(data) <- c(time = 730, memb = 3, lon = 2, lat = 1) - time <- seq.Date(as.Date("1990-01-01", format = "%Y-%d-%m"), - as.Date("1991-31-12", format = "%Y-%d-%m"), 1) data[1,1,1,1] <- NA expect_equal( - which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = TRUE, + which(is.na(TimeAnomaly(data, dates = time, timedim = 1, na.rm = TRUE, ncores = NULL))), c(1) ) expect_equal( - which(is.na(DailyAno(data, dates = time, timedim = 1, na.rm = FALSE, + which(is.na(TimeAnomaly(data, dates = time, timedim = 1, na.rm = FALSE, ncores = NULL))), c(1, 366) ) - data <- rnorm(800 * 3 * 6 * 2, 25, 8) dim(data) <- c(dates = 800, lat = 3, lon = 6, model = 2) - dates <- seq(ISOdate(2000,1,1), ISOdate(2002,03,10), "days") + dates <- seq(ISOdate(2000, 1, 1), ISOdate(2002, 03, 10), "days") metadata <- list(time = list(standard_name = 'time', long_name = 'time', calendar = 'standard', units = 'days since 1970-01-01 00:00:00', prec = 'double', - dim = list(list(name ='time', unlim = FALSE)))) + dim = list(list(name = 'time', unlim = FALSE)))) attr(dates, 'variables') <- metadata attr(data, 'Variables')$dat1$time <- dates attr(data, 'Variables')$dat2$time <- dates attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(dates) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- dates expect_equal( - dim(DailyAno(data)), + dim(TimeAnomaly(data)), c(dates = 800, lat = 3, lon = 6, model = 2) ) - data <- 1 : 100 - dim(data) <- c(time = length(data)) - output <- rep(-49 : 49, each = 2) - output <- output[which(output %% 2 != 0)] - dim(output) <- c(time = length(output)) - dates <- as.PCICt(paste0(rep(1, 100), "-", rep(c(1, 2), 50), "-", - sort(rep(1901 : 1950, 2))), cal = "standard", - format = "%d-%m-%Y") - expect_equal( - DailyAno(data = data, dates = dates), - output - ) - data <- 1 : 24 dim(data) <- c(time = 24, lat = 1, lon = 1) - dates <- seq(ISOdate(2000,1,1), ISOdate(2001,12,31), "months") + dates <- seq(ISOdate(2000, 1, 1), ISOdate(2001, 12, 31), "months") metadata <- list(time = list(standard_name = 'time', long_name = 'time', calendar = 'standard', units = 'days since 1970-01-01 00:00:00', @@ -145,10 +122,10 @@ test_that("Sanity checks", { attr(data, 'Variables')$dat2$time <- dates attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(dates) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- dates - tmp <- sort(rep(c(6,-6),12)) + tmp <- sort(rep(c(6, -6), 12)) dim(tmp) <- c(time = 24, lat = 1, lon = 1) expect_equal( - DailyAno(data, storefreq = 'monthly'), + TimeAnomaly(data, storefreq = 'monthly'), tmp ) @@ -159,23 +136,22 @@ test_that("Sanity checks", { calendar = 'standard', units = 'days since 1970-01-01 00:00:00', prec = 'double', - dim = list(list(name ='time', unlim = FALSE)))) + dim = list(list(name = 'time', unlim = FALSE)))) attr(time, 'variables') <- metadata attr(data, 'Variables')$dat1$time <- time attr(data, 'Variables')$dat2$time <- time attr(data, 'Variables')$common[[2]]$dim[[3]]$len = length(time) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time - aa <- rep(-182.5,59) - bb <- rep(-183,365-59) - cc <- rep(182.5,59) + aa <- rep(-182.5, 59) + bb <- rep(-183, 365-59) + cc <- rep(182.5, 59) dd <- 0 - ee <- rep(183,366-60) + ee <- rep(183, 366-60) tmp <- c(aa, bb, cc, dd, ee) dim(tmp) <- c(time = 731, lon = 1, lat = 1, model = 1) expect_equal( - DailyAno(data), + TimeAnomaly(data), tmp ) - }) -- GitLab From d9eddf9b4866b3b1b1fa3979d81b232d26cb2af3 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Apr 2019 12:45:36 +0200 Subject: [PATCH 20/22] Name change from DailyAno to TimeAnomaly. --- R/{DailyAno.R => TimeAnomaly.R} | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) rename R/{DailyAno.R => TimeAnomaly.R} (88%) diff --git a/R/DailyAno.R b/R/TimeAnomaly.R similarity index 88% rename from R/DailyAno.R rename to R/TimeAnomaly.R index c244b7f..4d3e99b 100644 --- a/R/DailyAno.R +++ b/R/TimeAnomaly.R @@ -1,4 +1,4 @@ -#'Daily anomalies +#'Time anomalies #' #'@description This function computes temporal anomalies from a vector containing time series. #'@param data A numeric n-dimensional array of data including one time dimension. @@ -27,11 +27,11 @@ #'attr(data, 'Variables')$common[[2]]$dim[[3]]$len <- length(time) #'attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time #' -#'a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) +#'a <- TimeAnomaly(data, timedim = 3, na.rm = TRUE, ncores = NULL) #'str(a) #'@export -DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, - timedim = NULL, na.rm = TRUE, ncores = NULL) { +TimeAnomaly <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, + timedim = NULL, na.rm = TRUE, ncores = NULL) { if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } @@ -112,17 +112,17 @@ DailyAno <- function(data, dates = NULL, storefreq = 'daily', jdays = NULL, margin <- c(1 : length(dim(data)))[-c(timedim)] - DailyAno <- Apply(data, margins = margin, fun = .DailyAno, jdays = jdays, - na.rm = na.rm, ncores = ncores) - DailyAno <- DailyAno$output1 - names(dim(DailyAno))[1] <- names(dim(data))[timedim] - if(is.null(names(dim(DailyAno))[1])) { - names(dim(DailyAno))[1] <- 'time' + TimeAnomaly <- Apply(data, margins = margin, fun = .TimeAnomaly, jdays = jdays, + na.rm = na.rm, ncores = ncores) + TimeAnomaly <- TimeAnomaly$output1 + names(dim(TimeAnomaly))[1] <- names(dim(data))[timedim] + if(is.null(names(dim(TimeAnomaly))[1])) { + names(dim(TimeAnomaly))[1] <- 'time' } - return(DailyAno) + return(TimeAnomaly) } -.DailyAno <- function(data, jdays, na.rm = na.rm) { +.TimeAnomaly <- function(data, jdays, na.rm = na.rm) { climatology <- tapply(data, INDEX = jdays, FUN = mean, na.rm = na.rm) anomalies <- c() for (i in 1 : length(data)) { -- GitLab From ede7c1dca70c9e7e40db739e198a1b08bbe7a954 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Apr 2019 13:06:41 +0200 Subject: [PATCH 21/22] Bump version and modify TimeAnomaly in vignette. --- DESCRIPTION | 5 +++-- vignettes/extreme_indices.Rmd | 6 ++---- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3b03fe1..1776287 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,12 +1,13 @@ Package: ClimProjDiags Title: Set of Tools to Compute Various Climate Indices -Version: 0.0.2 +Version: 1.0.0 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("Alasdair", "Hunter", , "alasdair.hunter@bsc.es", role = "aut"), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut", "cre")), person("Nicolau", "Manubens", , "nicolau.manubens@bsc.es", role = "ctb"), - person("Louis-Philippe", "Caron", , "louis-philippe.caron@bsc.es", role = "ctb")) + person("Louis-Philippe", "Caron", , "louis-philippe.caron@bsc.es", role = "ctb"), + person("An-Chi", "Ho", , "an.ho@bsc.es", role = "ctb")) Description: Set of tools to compute metrics and indices for climate analysis. The package provides functions to compute extreme indices, evaluate the agreement between models and combine theses models into an ensemble. Multi-model diff --git a/vignettes/extreme_indices.Rmd b/vignettes/extreme_indices.Rmd index 57eb34f..4ec5a6d 100644 --- a/vignettes/extreme_indices.Rmd +++ b/vignettes/extreme_indices.Rmd @@ -149,13 +149,11 @@ In order to evaluate the future projections, it is necessary to compute the inde The next steps should be followed: -To remove seasonality effects, the anomaly is computed for each day and gridpoint by applying the `DailyAno` function. The name of the first dimensions is defined as 'time' dimension. +To remove seasonality effects, the anomaly is computed for each day and gridpoint by applying the `TimeAnomaly` function. ```r -anomaly_data <- apply(tmax_historical, c(1,2,4,5), DailyAno, dates = attributes(tmax_historical)$Variables$dat1$time) - -names(dim(anomaly_data))[1] <- "time" +anomaly_data <- TimeAnomaly(tmax_historical) ``` -- GitLab From 278a0748603ae650044a1e76153e1d4057b27751 Mon Sep 17 00:00:00 2001 From: aho Date: Thu, 18 Apr 2019 13:27:22 +0200 Subject: [PATCH 22/22] name change from DailyAno to TimeAnomaly. Rebuild files. --- NAMESPACE | 2 +- R/Extremes.R | 4 ++-- man/Extremes.Rd | 2 +- man/{DailyAno.Rd => TimeAnomaly.Rd} | 12 ++++++------ 4 files changed, 10 insertions(+), 10 deletions(-) rename man/{DailyAno.Rd => TimeAnomaly.Rd} (89%) diff --git a/NAMESPACE b/NAMESPACE index 8c0c72b..2b91ef6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,12 +5,12 @@ export(Climdex) export(CombineIndices) export(DTRIndicator) export(DTRRef) -export(DailyAno) export(Extremes) export(SeasonSelect) export(SelBox) export(Subset) export(Threshold) +export(TimeAnomaly) export(WaveDuration) export(WeightedMean) import(PCICt) diff --git a/R/Extremes.R b/R/Extremes.R index 839d0a1..c565c08 100644 --- a/R/Extremes.R +++ b/R/Extremes.R @@ -35,8 +35,8 @@ #'attr(time, "variables") <- metadata #'attr(data, 'Variables')$dat1$time <- time #' -#'#a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, -#'# max.missing.days = 5, ncores = NULL) +#'a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, +#' max.missing.days = 5, ncores = NULL) #'str(a) #'@export Extremes <- function(data, threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, max.missing.days = 5, diff --git a/man/Extremes.Rd b/man/Extremes.Rd index 0939fa6..fbad43c 100644 --- a/man/Extremes.Rd +++ b/man/Extremes.Rd @@ -55,7 +55,7 @@ attr(time, "variables") <- metadata attr(data, 'Variables')$dat1$time <- time a <- Extremes(data, threshold = threshold, op = ">", min.length = 6, spells.can.span.years = TRUE, - max.missing.days = 5, ncores = NULL) + max.missing.days = 5, ncores = NULL) str(a) } diff --git a/man/DailyAno.Rd b/man/TimeAnomaly.Rd similarity index 89% rename from man/DailyAno.Rd rename to man/TimeAnomaly.Rd index 97d20f9..b3e3827 100644 --- a/man/DailyAno.Rd +++ b/man/TimeAnomaly.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/DailyAno.R -\name{DailyAno} -\alias{DailyAno} -\title{Daily anomalies} +% Please edit documentation in R/TimeAnomaly.R +\name{TimeAnomaly} +\alias{TimeAnomaly} +\title{Time anomalies} \usage{ -DailyAno(data, dates = NULL, storefreq = "daily", jdays = NULL, +TimeAnomaly(data, dates = NULL, storefreq = "daily", jdays = NULL, timedim = NULL, na.rm = TRUE, ncores = NULL) } \arguments{ @@ -43,7 +43,7 @@ attr(data, 'Variables')$dat2$time <- time attr(data, 'Variables')$common[[2]]$dim[[3]]$len <- length(time) attr(data, 'Variables')$common[[2]]$dim[[3]]$vals <- time -a <- DailyAno(data, timedim = 3, na.rm = TRUE, ncores = NULL) +a <- TimeAnomaly(data, timedim = 3, na.rm = TRUE, ncores = NULL) str(a) } -- GitLab