From c41fab5d6b5a71cff64ddf937575e2658bd80934 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 26 Apr 2023 12:06:44 +0200 Subject: [PATCH 1/8] Update figures in GitLab repo of EnergyIndicators --- vignettes/EnergyIndicators.Rmd | 24 +++++++++++++++++++----- 1 file changed, 19 insertions(+), 5 deletions(-) diff --git a/vignettes/EnergyIndicators.Rmd b/vignettes/EnergyIndicators.Rmd index f4a1a04..5a65c47 100644 --- a/vignettes/EnergyIndicators.Rmd +++ b/vignettes/EnergyIndicators.Rmd @@ -30,24 +30,38 @@ Although wind turbines cannot extract all of the kinetic energy in the wind, and As an example, we simulate a time series of 1000 wind speed values from a Weibull distribution with scale factor of 6 and a shape factor of 2, which represent a sample of wind speed values obtained at a single location. The Weibull distribution is often assumed to fit observed wind speed values to a probability distribution function. Then, each instantaneous wind speed value is converted to its equivalent WPD. The `mean` and `sd` of the WPD can be employed to summarize the wind resource in that location. Otherwise, we can plot the histograms to see the full distribution of values: -```{r, fig.width=7} +``` library(CSIndicators) set.seed(1) -oldpar <- par(no.readonly = TRUE) wind <- rweibull(n = 1000, shape = 2, scale = 6) WPD <- WindPowerDensity(wind) mean(WPD) +``` + +``` +## [1] 170.6205 +``` + +``` sd(WPD) +``` + +``` +## [1] 251.1349 +``` + +``` par(mfrow = c(1, 2)) hist(wind, breaks = seq(0, 20)) hist(WPD, breaks = seq(0, 4000, 200)) ``` +![WPD](./Figures/WPD_histogram.png) As you can see the histogram of the WPD is highly skewed, even if the wind speed was only a little skewed! If not specified, an air density of 1.225 kg/m^3 is assumed. Otherwise, the parameter `ro` can be set to a fixed value (for instance the mean air density at the site elevation could be used), or a timeseries of density values measured at each time stamp can be used to obtain more accurate results. -```{r} +``` WPD <- WindPowerDensity(wind, ro = 1.15) ``` @@ -61,16 +75,16 @@ Notice that power curves are intended to be used with 10-minutal steady wind spe Following on the previous example, we will compute now the CF that would be obtained from our sample of 1000 wind speed values when using a turbine of class IEC I, and compare it to the CF values for a class III: -```{r, fig.width=7} +``` WCFI <- WindCapacityFactor(wind, IEC_class = "I") WCFIII <- WindCapacityFactor(wind, IEC_class = "III") par(mfrow = c(1, 3)) hist(wind, breaks = seq(0, 20)) hist(WCFI, breaks = seq(0, 1, 0.05), ylim = c(0, 500)) hist(WCFIII, breaks = seq(0, 1, 0.05), ylim = c(0, 500)) -par(oldpar) ``` +![WCF](./Figures/WCF_histogram.png) From the CF histograms we can see that, for this particular wind speed distribution, the IEC I turbine (designed for high winds) producess less energy than the IEC III turbine, which is more suitable for this range of wind speed values. -- GitLab From 7632b80ac0f98d3b6b946b2a01b946c0654a00e1 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Wed, 17 May 2023 19:06:03 +0200 Subject: [PATCH 2/8] Remove subset from the package --- NAMESPACE | 1 - R/MergeRefToExp.R | 2 -- R/QThreshold.R | 22 ++++++++++++---------- R/SelectPeriodOnData.R | 8 +++----- R/zzz.R | 8 ++++++++ 5 files changed, 23 insertions(+), 18 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 133942a..0fa3f24 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,7 +26,6 @@ export(TotalTimeExceedingThreshold) export(WindCapacityFactor) export(WindPowerDensity) import(multiApply) -importFrom(ClimProjDiags,Subset) importFrom(s2dv,InsertDim) importFrom(s2dv,Reorder) importFrom(stats,approxfun) diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index fa3dcaf..1786826 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -60,7 +60,6 @@ #' start2 = list(1, 7), end2 = list(21, 9)) #' #'@import multiApply -#'@importFrom ClimProjDiags Subset #'@importFrom s2dv InsertDim #'@export CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, @@ -201,7 +200,6 @@ CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, #' time_dim = 'time') #' #'@import multiApply -#'@importFrom ClimProjDiags Subset #'@importFrom s2dv InsertDim #'@export MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, diff --git a/R/QThreshold.R b/R/QThreshold.R index e86b95a..3be5d71 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -68,7 +68,6 @@ #'exp_probs <- CST_QThreshold(exp, threshold) #' #'@import multiApply -#'@importFrom ClimProjDiags Subset #'@export CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, time_dim = 'ftime', memb_dim = 'member', @@ -162,11 +161,12 @@ CST_QThreshold <- function(data, threshold, start = NULL, end = NULL, #'thres_q <- QThreshold(data, threshold) #' #'@import multiApply -#'@importFrom ClimProjDiags Subset #'@export QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, time_dim = 'time', memb_dim = 'member', sdate_dim = 'sdate', ncores = NULL) { + # Initial checks + ## data if (is.null(data)) { stop("Parameter 'data' cannot be NULL.") } @@ -177,6 +177,10 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, dim(data) <- c(length(data), 1) names(dim(data)) <- c(memb_dim, sdate_dim) } + if (is.null(names(dim(data)))) { + stop("Parameter 'data' must have named dimensions.") + } + ## threshold if (is.null(threshold)) { stop("Parameter 'threshold' cannot be NULL.") } @@ -189,8 +193,8 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, } else if (length(threshold) == 1) { dim(threshold) <- NULL } - if (is.null(names(dim(data)))) { - stop("Parameter 'data' must have named dimensions.") + if (sdate_dim %in% names(dim(threshold))) { + stop("Parameter threshold cannot have dimension 'sdate_dim'.") } if (is.null(names(dim(threshold))) && length(threshold) > 1) { stop("Parameter 'threshold' must have named dimensions.") @@ -206,9 +210,9 @@ 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% dim(dates)) { - dates_thres <- Subset(dates, along = sdate_dim, indices = 1) - threshold <- SelectPeriodOnData(threshold, dates_thres, start, end, + if (!is.null(dim(dates)) && sdate_dim %in% names(dim(dates))) { + dates_thres <- index_array(dates, dim = sdate_dim, value = 1) + threshold <- SelectPeriodOnData(data = threshold, dates = dates_thres, start, end, time_dim = time_dim, ncores = ncores) } else { threshold <- SelectPeriodOnData(threshold, dates, start, end, @@ -231,9 +235,7 @@ QThreshold <- function(data, threshold, dates = NULL, start = NULL, end = NULL, } } else { target_thres <- NULL - if (sdate_dim %in% names(dim(threshold))) { - stop("Parameter threshold cannot have dimension 'sdate_dim'.") - } + if (memb_dim %in% names(dim(data))) { if (memb_dim %in% names(dim(threshold))) { # comparison member by member diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index b9cf8ac..b9b58f2 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -100,7 +100,6 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'ftime', #'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 = 'ftime', ncores = NULL) { @@ -150,12 +149,11 @@ 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)] - indices <- as.list(rep(1, length(dim_remove))) - res <- Subset(res, along = dim_remove, indices, drop = 'selected') + res <- index_array(res, dim = dim_remove, value = 1) + dim(res) <- dim(res)[-which(names(dim(res)) %in% dim_remove)] } 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 9b0c648..4dd137b 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -61,3 +61,11 @@ wind2CF <- function(wind, pc) { CF <- power / pc$attr$RatedPower return(CF) } + +index_array <- function(x, dim, value, drop = FALSE) { + indices <- rep(list(bquote()), length(dim(x))) + dims <- which(names(dim(x)) %in% dim) + indices[dims] <- value + call <- as.call(c(list(as.name("["), quote(x)), indices, list(drop = drop))) + eval(call) +} \ No newline at end of file -- GitLab From db0ba1db2501d17f5e2db5b8cae87a78b6401962 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 15:19:43 +0200 Subject: [PATCH 3/8] Improve .arraysubset and add tests --- R/QThreshold.R | 2 +- R/SelectPeriodOnData.R | 2 +- R/zzz.R | 19 +++++++++++-------- tests/testthat/test-QThreshold.R | 19 +++++++++++++++++++ 4 files changed, 32 insertions(+), 10 deletions(-) diff --git a/R/QThreshold.R b/R/QThreshold.R index 3be5d71..49217dd 100644 --- a/R/QThreshold.R +++ b/R/QThreshold.R @@ -211,7 +211,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 <- index_array(dates, dim = sdate_dim, value = 1) + dates_thres <- .arraysubset(dates, dim = sdate_dim, value = 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 b9b58f2..94bcfe9 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -149,7 +149,7 @@ 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 <- index_array(res, dim = dim_remove, value = 1) + res <- .arraysubset(res, dim = dim_remove, value = 1) dim(res) <- dim(res)[-which(names(dim(res)) %in% dim_remove)] } diff --git a/R/zzz.R b/R/zzz.R index 4dd137b..5e20873 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -24,6 +24,17 @@ 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) +} + #======================= # Read a powercurve file @@ -60,12 +71,4 @@ wind2CF <- function(wind, pc) { power <- wind2power(wind, pc) CF <- power / pc$attr$RatedPower return(CF) -} - -index_array <- function(x, dim, value, drop = FALSE) { - indices <- rep(list(bquote()), length(dim(x))) - dims <- which(names(dim(x)) %in% dim) - indices[dims] <- value - call <- as.call(c(list(as.name("["), quote(x)), indices, list(drop = drop))) - eval(call) } \ No newline at end of file diff --git a/tests/testthat/test-QThreshold.R b/tests/testthat/test-QThreshold.R index 7572bd0..41cc3e5 100644 --- a/tests/testthat/test-QThreshold.R +++ b/tests/testthat/test-QThreshold.R @@ -87,6 +87,25 @@ test_that("Sanity checks", { c(sdate = 2, time = 5, member = 3, lat = 2) ) + # test different common dimensions + + exp <- array(1:61, dim = c(ftime = 61, sdate = 3)) + threshold <- array(1:61, dim = c(ftime = 61)) + Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), + as.Date("30-06-2000", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-05-2001", format = "%d-%m-%Y"), + as.Date("30-06-2001", format = "%d-%m-%Y"), by = 'day'), + seq(as.Date("01-05-2002", format = "%d-%m-%Y"), + as.Date("30-06-2002", format = "%d-%m-%Y"), by = 'day')) + dim(Dates) <- c(ftime = 61, sdate = 3, syear = 1) + res <- QThreshold(data = exp, dates = Dates, + start = list(21, 4), end = list(21, 6), threshold = threshold, + time_dim = 'ftime', sdate_dim = 'sdate') + expect_equal( + dim(res), + c(sdate = 3, ftime = 52) + ) + }) ############################################## -- GitLab From f440e52d0f52152ec5d237c4527f017998b90d8a Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 15:26:29 +0200 Subject: [PATCH 4/8] Remove ClimProjDiags from packages imports --- DESCRIPTION | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7fcf115..9d6c9bd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -28,8 +28,7 @@ Depends: Imports: multiApply (>= 2.1.1), s2dv, - stats, - ClimProjDiags + stats Suggests: testthat, CSTools, -- GitLab From 2ce5bb9ca9c97f0ff0fceca24dc0e4a89f46d8d9 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 15:40:03 +0200 Subject: [PATCH 5/8] Version bump 1.0.1 --- DESCRIPTION | 2 +- NEWS.md | 25 +++++++++++++++---------- 2 files changed, 16 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7fcf115..0f2ab45 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: CSIndicators Title: Climate Services' Indicators Based on Sub-Seasonal to Decadal Predictions -Version: 1.0.0 +Version: 1.0.1 Authors@R: c( person("Eva", "Rifà", , "eva.rifarovira@bsc.es", role = c("cre")), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut"), comment = c(ORCID = "0000-0001-8568-3071")), diff --git a/NEWS.md b/NEWS.md index e28aab8..2b86867 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,16 +1,21 @@ -# CSIndicators 1.0.0 (Release date: 2023-04-05) +# CSIndicators 1.0.1 (Release date: 2023-05-18) **Fixes** -- Correct vignettes figures links. +- Add EnergyIndicators vignette figures +- Remove ClimProjDiags dependency + +# CSIndicators 1.0.0 (Release date: 2023-04-05) +**Fixes** +- Correct vignettes figures links. **New features** -- Exceeding Threshold functions to allow between thresholds or equal threshold options. -- New s2dv_cube object development for all the functions, unit tests, examples and vignettes. +- Exceeding Threshold functions to allow between thresholds or equal threshold options. +- New s2dv_cube object development for all the functions, unit tests, examples and vignettes. -# CSIndicators 0.0.2 (Release date: 2022-10-21) +# CSIndicators 0.0.2 (Release date: 2022-10-21) **Fixes** -- Correct figures of EnergyIndicators vignette. -- Sanity check correction in functions CST_PeriodAccumulation, CST_AbsToProbs, CST_AccumulationExceedingThreshold, CST_MergeRefToExp, CST_PeriodMean, CST_QThreshold, CST_SelectPeriodOnData, CST_Threshold, TotalSpellTimeExceedingThreshold, CST_TotalTimeExceedingThreshold, CST_WindCapacityFactor and CST_WindPowerDensity. -- Revise examples using s2dv::InsertDim in MergeRefToExp(). +- Correct figures of EnergyIndicators vignette. +- Sanity check correction in functions CST_PeriodAccumulation, CST_AbsToProbs, CST_AccumulationExceedingThreshold, CST_MergeRefToExp, CST_PeriodMean, CST_QThreshold, CST_SelectPeriodOnData, CST_Threshold, TotalSpellTimeExceedingThreshold, CST_TotalTimeExceedingThreshold, CST_WindCapacityFactor and CST_WindPowerDensity. +- Revise examples using s2dv::InsertDim in MergeRefToExp(). -# CSIndicators 0.0.1 (Release date: 2021-05-07) -- This package is intended for sub-seasonal, seasonal and decadal climate predictions, but its methods are also applicable to other time-scales. Additionally, the outputs of the functions in this package are compatible with 'CSTools'. This package was developed in the context of H2020 MED-GOLD (776467) and S2S4E (776787) projects. Lledó et al. (2019) . +# CSIndicators 0.0.1 (Release date: 2021-05-07) +- This package is intended for sub-seasonal, seasonal and decadal climate predictions, but its methods are also applicable to other time-scales. Additionally, the outputs of the functions in this package are compatible with 'CSTools'. This package was developed in the context of H2020 MED-GOLD (776467) and S2S4E (776787) projects. Lledó et al. (2019) . -- GitLab From 31178d351f7f9e78e99206b5220fce8adccf9c53 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 16:44:04 +0200 Subject: [PATCH 6/8] Small fix to units attributes for new s2dv_cube --- inst/doc/paper-figure-PlotForecastPDF.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/doc/paper-figure-PlotForecastPDF.R b/inst/doc/paper-figure-PlotForecastPDF.R index b8867a6..bebc497 100644 --- a/inst/doc/paper-figure-PlotForecastPDF.R +++ b/inst/doc/paper-figure-PlotForecastPDF.R @@ -34,9 +34,9 @@ c(hcst, hcst_ref) %<-% CST_Load(var = 'prlr', leadtimemin = 1, leadtimemax = 214, nmember = 25, output = "lonlat") hcst$data <- hcst$data * 3600 * 24 * 1000 -attributes(hcst$attrs$Variable)$units <- 'mm' +hcst$attrs$Variable$metadata$prlr$units <- 'mm' hcst_ref$data <- hcst_ref$data * 3600 * 24 * 1000 -attributes(hcst_ref$attrs$Variable)$units <- 'mm' +hcst_ref$attrs$Variable$metadata$prlr$units <- 'mm' c(fcst, obs) %<-% CST_Load(var = 'prlr', @@ -49,9 +49,9 @@ c(fcst, obs) %<-% CST_Load(var = 'prlr', leadtimemin = 1, leadtimemax = 214, nmember = 50, output = "lonlat") fcst$data <- fcst$data * 1000 * 3600 * 24 -attributes(fcst$attrs$Variable)$units <- 'mm' +fcst$attrs$Variable$metadata$prlr$units <- 'mm' obs$data <- obs$data * 1000 * 3600 * 24 -attributes(obs$attrs$Variable)$units <- 'mm' +obs$attrs$Variable$metadata$prlr$units <- 'mm' fcst_QM <- CST_QuantileMapping(exp = hcst, -- GitLab From cd219842e704b80240be0e0c665da2c010d45042 Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 19:47:23 +0200 Subject: [PATCH 7/8] Remove s2dv dependency by substituting Reorder and adding auxiliary function .insertdim --- DESCRIPTION | 1 - NAMESPACE | 2 -- NEWS.md | 3 ++- R/AccumulationExceedingThreshold.R | 1 - R/MergeRefToExp.R | 10 ++++------ R/SelectPeriodOnDates.R | 4 ++-- R/zzz.R | 17 +++++++++++++++++ 7 files changed, 25 insertions(+), 13 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9865bda..90e0e83 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,7 +27,6 @@ Depends: R (>= 3.6.0) Imports: multiApply (>= 2.1.1), - s2dv, stats Suggests: testthat, diff --git a/NAMESPACE b/NAMESPACE index 0fa3f24..d80accb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,8 +26,6 @@ export(TotalTimeExceedingThreshold) export(WindCapacityFactor) export(WindPowerDensity) import(multiApply) -importFrom(s2dv,InsertDim) -importFrom(s2dv,Reorder) importFrom(stats,approxfun) importFrom(stats,ecdf) importFrom(stats,quantile) diff --git a/NEWS.md b/NEWS.md index 2b86867..e988a0a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ # CSIndicators 1.0.1 (Release date: 2023-05-18) **Fixes** - Add EnergyIndicators vignette figures -- Remove ClimProjDiags dependency +- Remove ClimProjDiags dependency +- Remove s2dv dependency # CSIndicators 1.0.0 (Release date: 2023-04-05) **Fixes** diff --git a/R/AccumulationExceedingThreshold.R b/R/AccumulationExceedingThreshold.R index 7fd78f4..e346b53 100644 --- a/R/AccumulationExceedingThreshold.R +++ b/R/AccumulationExceedingThreshold.R @@ -170,7 +170,6 @@ CST_AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = #'GDD <- AccumulationExceedingThreshold(data, threshold = 0, start = list(1, 4), #' end = list(31, 10)) #'@import multiApply -#'@importFrom s2dv Reorder #'@export AccumulationExceedingThreshold <- function(data, threshold, op = '>', diff = FALSE, dates = NULL, start = NULL, end = NULL, diff --git a/R/MergeRefToExp.R b/R/MergeRefToExp.R index 1786826..434cae3 100644 --- a/R/MergeRefToExp.R +++ b/R/MergeRefToExp.R @@ -60,7 +60,6 @@ #' start2 = list(1, 7), end2 = list(21, 9)) #' #'@import multiApply -#'@importFrom s2dv InsertDim #'@export CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, time_dim = 'ftime', sdate_dim = 'sdate', @@ -200,7 +199,6 @@ CST_MergeRefToExp <- function(data1, data2, start1, end1, start2, end2, #' time_dim = 'time') #' #'@import multiApply -#'@importFrom s2dv InsertDim #'@export MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, end2, time_dim = 'ftime', sdate_dim = 'sdate', @@ -250,8 +248,8 @@ MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, dif_dims <- which(names(dim(data2)) %in% names(dim(data1)) == FALSE) if (length(dif_dims) > 0) { for (i in dif_dims) { - data1 <- InsertDim(data1, posdim = i, lendim = dim(data2)[i], - name = names(dim(data2))[i]) + data1 <- .insertdim(data1, posdim = i, lendim = dim(data2)[i], + name = names(dim(data2))[i]) } } } @@ -260,8 +258,8 @@ MergeRefToExp <- function(data1, dates1, start1, end1, data2, dates2, start2, dif_dims <- which(names(dim(data1)) %in% names(dim(data2)) == FALSE) if (length(dif_dims) > 0) { for (i in dif_dims) { - data2 <- InsertDim(data2, posdim = i, lendim = dim(data1)[i], - name = names(dim(data1))[i]) + data2 <- .insertdim(data2, posdim = i, lendim = dim(data1)[i], + name = names(dim(data1))[i]) } } } diff --git a/R/SelectPeriodOnDates.R b/R/SelectPeriodOnDates.R index 09633dd..fcb1a4c 100644 --- a/R/SelectPeriodOnDates.R +++ b/R/SelectPeriodOnDates.R @@ -20,7 +20,6 @@ #'the vector dates during the period requested from \code{start} to \code{end}. #' #'@import multiApply -#'@importFrom s2dv Reorder #' #'@examples #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), @@ -66,7 +65,8 @@ SelectPeriodOnDates <- function(dates, start, end, res <- as.POSIXct(res, origin = '1970-01-01', tz = 'UTC') } else { if (!all(names(dim(res)) == names(dim(dates)))) { - res <- s2dv::Reorder(res, names(dim(dates))) + pos <- match(names(dim(dates)), names(dim(res))) + res <- aperm(res, pos) } res <- dates[res] dim(res) <- dims diff --git a/R/zzz.R b/R/zzz.R index 5e20873..cf91639 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -35,6 +35,23 @@ 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 -- GitLab From fde621ed88f2f5f52a8fdf503af07497c5ef278d Mon Sep 17 00:00:00 2001 From: Eva Rifa Date: Thu, 18 May 2023 19:49:48 +0200 Subject: [PATCH 8/8] Correct NEWS format --- NEWS.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/NEWS.md b/NEWS.md index e988a0a..44285d2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,8 +1,8 @@ # CSIndicators 1.0.1 (Release date: 2023-05-18) **Fixes** - Add EnergyIndicators vignette figures -- Remove ClimProjDiags dependency -- Remove s2dv dependency +- Remove ClimProjDiags dependency +- Remove s2dv dependency # CSIndicators 1.0.0 (Release date: 2023-04-05) **Fixes** -- GitLab