From f73a36a8a9376f16672a15d1cfa2970a7fa03d96 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 24 Oct 2023 10:11:13 +0200 Subject: [PATCH 1/2] Add ClimProjDiags::Subset and remove auxiliary function .insertdim --- R/QThreshold.R | 3 ++- R/SelectPeriodOnData.R | 20 ++++++++++---------- R/zzz.R | 29 ----------------------------- man/CST_SelectPeriodOnData.Rd | 6 +++--- man/SelectPeriodOnData.Rd | 6 +++--- 5 files changed, 18 insertions(+), 46 deletions(-) diff --git a/R/QThreshold.R b/R/QThreshold.R index 0f20858..19cda3c 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -177,6 +177,7 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #' start = list(21, 4), end = list(21, 6)) #' #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, time_dim = 'time', memb_dim = 'member', @@ -231,7 +232,7 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, if (time_dim %in% names(dim(threshold))) { if (dim(threshold)[time_dim] == dim(data)[time_dim]) { if (!is.null(dim(dates)) && sdate_dim %in% names(dim(dates))) { - dates_thres <- .arraysubset(dates, dim = sdate_dim, value = 1) + dates_thres <- Subset(dates, along = sdate_dim, indices = 1) threshold <- SelectPeriodOnData(data = threshold, dates = dates_thres, start, end, time_dim = time_dim, ncores = ncores) } else { diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index 016133b..aedf0b0 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -11,7 +11,7 @@ #' the data by providing a list of two elements: the final day of the period #' and the final month of the period. #'@param time_dim A character string indicating the name of the dimension to -#' compute select the dates. By default, it is set to 'time'. More than one +#' compute select the dates. By default, it is set to 'ftime'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param ncores An integer indicating the number of cores to use in parallel @@ -23,14 +23,14 @@ #'@examples #'exp <- NULL #'exp$data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) #'exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2001", format = "%d-%m-%Y"), #' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) -#'dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) +#'dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) #'class(exp) <- 's2dv_cube' #'Period <- CST_SelectPeriodOnData(exp, start = list(21, 6), end = list(21, 9)) #'@import multiApply @@ -79,7 +79,7 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #' to select from the data. The first element is the final day of the period #' and the second element is the final month of the period. #'@param time_dim A character string indicating the name of the dimension to -#' compute select the dates. By default, it is set to 'time'. Parameters +#' compute select the dates. By default, it is set to 'ftime'. Parameters #' 'data' and 'dates' #'@param ncores An integer indicating the number of cores to use in parallel #' computation. @@ -90,16 +90,17 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #' #'@examples #'data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, time = 214, lon = 2)) +#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2001", format = "%d-%m-%Y"), #' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) -#'dim(Dates) <- c(time = 214, sdate = 3) +#'dim(Dates) <- c(ftime = 214, sdate = 3) #'Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) #'@import multiApply +#'@importFrom ClimProjDiags Subset #'@export SelectPeriodOnData <- function(data, dates, start, end, time_dim = 'time', ncores = NULL) { @@ -149,11 +150,10 @@ SelectPeriodOnData <- function(data, dates, start, end, names_data <- sort(names(dim(data))) if (!all(names_res %in% names_data)) { dim_remove <- names_res[-which(names_res %in% names_data)] - res <- .arraysubset(res, dim = dim_remove, value = 1) - dim(res) <- dim(res)[-which(names(dim(res)) %in% dim_remove)] + indices <- as.list(rep(1, length(dim_remove))) + res <- Subset(res, along = dim_remove, indices, drop = 'selected') } - pos <- match(names(dim(data)), names(dim(res))) res <- aperm(res, pos) return(res) -} \ No newline at end of file +} diff --git a/R/zzz.R b/R/zzz.R index cf91639..0724f06 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -24,35 +24,6 @@ return(position) } -# Function to subset dimension indices of an array -.arraysubset <- function(x, dim, value, drop = FALSE) { - indices <- rep(list(bquote()), length(dim(x))) - if (is.character(dim)) { - dim <- which(names(dim(x)) %in% dim) - } - indices[dim] <- value - call <- as.call(c(list(as.name("["), quote(x)), indices, drop = drop)) - eval(call) -} - -# Function to insert a dimension in an array -.insertdim <- function(data, posdim, lendim, name = NULL) { - names(lendim) <- name - data <- array(data, dim = c(dim(data), lendim)) - ## Reorder dimension - if (posdim == 1) { - order <- c(length(dim(data)), 1:(length(dim(data)) - 1)) - data <- aperm(data, order) - } else if (posdim == length(dim(data))) { # last dim - - } else { # middle dim - order <- c(1:(posdim - 1), length(dim(data)), posdim:(length(dim(data)) - 1)) - data <- aperm(data, order) - } - return(data) -} - - #======================= # Read a powercurve file # Create the approximation function diff --git a/man/CST_SelectPeriodOnData.Rd b/man/CST_SelectPeriodOnData.Rd index 5f12633..c3bda0c 100644 --- a/man/CST_SelectPeriodOnData.Rd +++ b/man/CST_SelectPeriodOnData.Rd @@ -19,7 +19,7 @@ the data by providing a list of two elements: the final day of the period and the final month of the period.} \item{time_dim}{A character string indicating the name of the dimension to -compute select the dates. By default, it is set to 'time'. More than one +compute select the dates. By default, it is set to 'ftime'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} @@ -36,14 +36,14 @@ Auxiliary function to subset data for a specific period. \examples{ exp <- NULL exp$data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, time = 214, lon = 2)) + c(memb = 5, sdate = 3, ftime = 214, lon = 2)) exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day')) -dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) +dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) class(exp) <- 's2dv_cube' Period <- CST_SelectPeriodOnData(exp, start = list(21, 6), end = list(21, 9)) } diff --git a/man/SelectPeriodOnData.Rd b/man/SelectPeriodOnData.Rd index 2c6181f..18aa296 100644 --- a/man/SelectPeriodOnData.Rd +++ b/man/SelectPeriodOnData.Rd @@ -24,7 +24,7 @@ to select from the data. The first element is the final day of the period and the second element is the final month of the period.} \item{time_dim}{A character string indicating the name of the dimension to -compute select the dates. By default, it is set to 'time'. Parameters +compute select the dates. By default, it is set to 'ftime'. Parameters 'data' and 'dates'} \item{ncores}{An integer indicating the number of cores to use in parallel @@ -40,13 +40,13 @@ Auxiliary function to subset data for a specific period. } \examples{ data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, time = 214, lon = 2)) + c(memb = 5, sdate = 3, ftime = 214, lon = 2)) Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day')) -dim(Dates) <- c(time = 214, sdate = 3) +dim(Dates) <- c(ftime = 214, sdate = 3) Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) } -- GitLab From 1a35651abd1e03e5409300ad8c2b497a7a99e2bf Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Tue, 24 Oct 2023 10:17:09 +0200 Subject: [PATCH 2/2] Correct example; fix pipeline --- R/SelectPeriodOnData.R | 12 ++++++------ man/CST_SelectPeriodOnData.Rd | 6 +++--- man/SelectPeriodOnData.Rd | 6 +++--- 3 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index aedf0b0..bef70be 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -11,7 +11,7 @@ #' the data by providing a list of two elements: the final day of the period #' and the final month of the period. #'@param time_dim A character string indicating the name of the dimension to -#' compute select the dates. By default, it is set to 'ftime'. More than one +#' compute select the dates. By default, it is set to 'time'. More than one #' dimension name matching the dimensions provided in the object #' \code{data$data} can be specified. #'@param ncores An integer indicating the number of cores to use in parallel @@ -23,14 +23,14 @@ #'@examples #'exp <- NULL #'exp$data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +#' c(memb = 5, sdate = 3, time = 214, lon = 2)) #'exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2001", format = "%d-%m-%Y"), #' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) -#'dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) +#'dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) #'class(exp) <- 's2dv_cube' #'Period <- CST_SelectPeriodOnData(exp, start = list(21, 6), end = list(21, 9)) #'@import multiApply @@ -79,7 +79,7 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #' to select from the data. The first element is the final day of the period #' and the second element is the final month of the period. #'@param time_dim A character string indicating the name of the dimension to -#' compute select the dates. By default, it is set to 'ftime'. Parameters +#' compute select the dates. By default, it is set to 'time'. Parameters #' 'data' and 'dates' #'@param ncores An integer indicating the number of cores to use in parallel #' computation. @@ -90,14 +90,14 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #' #'@examples #'data <- array(rnorm(5 * 3 * 214 * 2), -#' c(memb = 5, sdate = 3, ftime = 214, lon = 2)) +#' c(memb = 5, sdate = 3, time = 214, lon = 2)) #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2001", format = "%d-%m-%Y"), #' as.Date("30-11-2001", format = "%d-%m-%Y"), by = 'day'), #' seq(as.Date("01-05-2002", format = "%d-%m-%Y"), #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) -#'dim(Dates) <- c(ftime = 214, sdate = 3) +#'dim(Dates) <- c(time = 214, sdate = 3) #'Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) #'@import multiApply #'@importFrom ClimProjDiags Subset diff --git a/man/CST_SelectPeriodOnData.Rd b/man/CST_SelectPeriodOnData.Rd index c3bda0c..5f12633 100644 --- a/man/CST_SelectPeriodOnData.Rd +++ b/man/CST_SelectPeriodOnData.Rd @@ -19,7 +19,7 @@ the data by providing a list of two elements: the final day of the period and the final month of the period.} \item{time_dim}{A character string indicating the name of the dimension to -compute select the dates. By default, it is set to 'ftime'. More than one +compute select the dates. By default, it is set to 'time'. More than one dimension name matching the dimensions provided in the object \code{data$data} can be specified.} @@ -36,14 +36,14 @@ Auxiliary function to subset data for a specific period. \examples{ exp <- NULL exp$data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, ftime = 214, lon = 2)) + c(memb = 5, sdate = 3, time = 214, lon = 2)) exp$attrs$Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day')) -dim(exp$attrs$Dates) <- c(ftime = 214, sdate = 3) +dim(exp$attrs$Dates) <- c(time = 214, sdate = 3) class(exp) <- 's2dv_cube' Period <- CST_SelectPeriodOnData(exp, start = list(21, 6), end = list(21, 9)) } diff --git a/man/SelectPeriodOnData.Rd b/man/SelectPeriodOnData.Rd index 18aa296..2c6181f 100644 --- a/man/SelectPeriodOnData.Rd +++ b/man/SelectPeriodOnData.Rd @@ -24,7 +24,7 @@ to select from the data. The first element is the final day of the period and the second element is the final month of the period.} \item{time_dim}{A character string indicating the name of the dimension to -compute select the dates. By default, it is set to 'ftime'. Parameters +compute select the dates. By default, it is set to 'time'. Parameters 'data' and 'dates'} \item{ncores}{An integer indicating the number of cores to use in parallel @@ -40,13 +40,13 @@ Auxiliary function to subset data for a specific period. } \examples{ data <- array(rnorm(5 * 3 * 214 * 2), - c(memb = 5, sdate = 3, ftime = 214, lon = 2)) + c(memb = 5, sdate = 3, time = 214, lon = 2)) Dates <- c(seq(as.Date("01-05-2000", format = "\%d-\%m-\%Y"), as.Date("30-11-2000", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2001", format = "\%d-\%m-\%Y"), as.Date("30-11-2001", format = "\%d-\%m-\%Y"), by = 'day'), seq(as.Date("01-05-2002", format = "\%d-\%m-\%Y"), as.Date("30-11-2002", format = "\%d-\%m-\%Y"), by = 'day')) -dim(Dates) <- c(ftime = 214, sdate = 3) +dim(Dates) <- c(time = 214, sdate = 3) Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) } -- GitLab