diff --git a/.Rbuildignore b/.Rbuildignore index 83f840f062b3f6d4dcdc548e6458946c58f1bf70..2a2a753d061baa9dab657853b564427c97df1ec6 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -6,6 +6,7 @@ ./.nc$ .*^(?!data)\.RData$ .*\.gitlab-ci.yml$ +.lintr ^tests$ ./.nfs* ^cran-comments\.md$ diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0873a3f93a877059b3067dfeb9874a5364513428..88519c591160ae35c8889c6a539b224bffe45b9c 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -1,5 +1,6 @@ stages: - build + build: stage: build script: @@ -7,3 +8,11 @@ build: - R CMD build --resave-data . - R CMD check --as-cran --no-manual --run-donttest CSIndicators_*.tar.gz - R -e 'covr::package_coverage()' + +lint-check: + stage: build + script: + - module load R/4.1.2-foss-2015a-bare + - module load CDO/1.9.8-foss-2015a + - echo "Run lintr on the package..." + - Rscript -e 'lintr::lint_package(path = ".")' diff --git a/.lintr b/.lintr new file mode 100644 index 0000000000000000000000000000000000000000..d56581da01dbf465e6799b8d027ede435e8e9ffb --- /dev/null +++ b/.lintr @@ -0,0 +1,22 @@ +linters: linters_with_tags( # lintr_3.1.1 + tags = c("package_development", "readability", "best_practices"), + line_length_linter = line_length_linter(100L), + T_and_F_symbol_linter = NULL, + quotes_linter = NULL, + commented_code_linter = NULL, + implicit_integer_linter = NULL, + vector_logic_linter = NULL, + extraction_operator_linter = NULL, + function_left_parentheses_linter = NULL, + semicolon_linter = NULL, + indentation_linter = NULL, + unnecessary_nested_if_linter = NULL, + if_not_else_linter = NULL, + object_length_linter = NULL, + infix_spaces_linter(exclude_operators = "~") + ) +exclusions: list( + "inst", + "tests/testthat/", + "tests/testthat.R" + ) diff --git a/DESCRIPTION b/DESCRIPTION index 98fecac842870eb8bc56bcfb6379228bf67f9314..2fc850e7062e3837df08804b24d93cd9995afd59 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,9 @@ Package: CSIndicators Title: Climate Services' Indicators Based on Sub-Seasonal to Decadal Predictions -Version: 1.1.0 +Version: 1.1.1 Authors@R: c( - person("Eva", "Rifà", , "eva.rifarovira@bsc.es", role = c("cre")), + person("Victòria", "Agudetse", , "victoria.agudetse@bsc.es", role = c("cre")), + person("Eva", "Rifà", , "eva.rifarovira@bsc.es", role = c("ctb")), person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = c("aut"), comment = c(ORCID = "0000-0001-8568-3071")), person("Chou", "Chihchung", ,"chihchung.chou@bsc.es", role = "aut"), person("Llorenç", "Lledó", , "llorenc.lledo@bsc.es", role = "aut"), @@ -36,7 +37,8 @@ Imports: SPEI, lmom, lmomco, - zoo + zoo, + s2dv Suggests: testthat, knitr, @@ -47,5 +49,5 @@ License: GPL-3 URL: https://earth.bsc.es/gitlab/es/csindicators/ BugReports: https://earth.bsc.es/gitlab/es/csindicators/-/issues Encoding: UTF-8 -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.3 Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index bab43edcccecb70f92ef63df66c81e870745ec26..15c3c9a6e194bd8fea84dac36081c0d8033674aa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -54,6 +54,7 @@ importFrom(lmomco,parpe3) importFrom(lmomco,pwm.pp) importFrom(lmomco,pwm.ub) importFrom(lmomco,pwm2lmom) +importFrom(s2dv,Reorder) importFrom(stats,approxfun) importFrom(stats,ecdf) importFrom(stats,qnorm) diff --git a/NEWS.md b/NEWS.md index c3047f968328c38145628e7111e5cdcb9a0d5d8c..613ff3d314ed923d54617b34aab89466e5221be6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,11 @@ +# CSIndicators 1.1.1 (Release date: 2024-01-24) + +### Fixes +- Corrected error in SelectPeriodOnDates to allow dates to be transposed + +### Other +- Included CITATION file in the pacakge + # CSIndicators 1.1.0 (Release date: 2023-11-20) ### Fixes diff --git a/R/SelectPeriodOnData.R b/R/SelectPeriodOnData.R index a4cc07c1e7493e44ae6c944a740e9bd1eda6de3a..1cc2792ed9a1bb3cdd909fd99a4a1a1db6402559 100644 --- a/R/SelectPeriodOnData.R +++ b/R/SelectPeriodOnData.R @@ -101,6 +101,7 @@ CST_SelectPeriodOnData <- function(data, start, end, time_dim = 'time', #'Period <- SelectPeriodOnData(data, Dates, start = list(21, 6), end = list(21, 9)) #'@import multiApply #'@importFrom ClimProjDiags Subset +#'@importFrom s2dv Reorder #'@export SelectPeriodOnData <- function(data, dates, start, end, time_dim = 'time', ncores = NULL) { @@ -153,7 +154,8 @@ SelectPeriodOnData <- function(data, dates, start, end, 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) + if (any(names(dims) != names(dim(res)))) { + res <- Reorder(res, names(dims)) + } return(res) } diff --git a/R/SelectPeriodOnDates.R b/R/SelectPeriodOnDates.R index 0919c5d0cf216b92e17e69a7028796990317654d..550aad94ff28525af253b13a68b80d785f10725f 100644 --- a/R/SelectPeriodOnDates.R +++ b/R/SelectPeriodOnDates.R @@ -19,8 +19,6 @@ #'@return A multidimensional array with named dimensions containing the subset of #'the vector dates during the period requested from \code{start} to \code{end}. #' -#'@import multiApply -#' #'@examples #'Dates <- c(seq(as.Date("01-05-2000", format = "%d-%m-%Y"), #' as.Date("30-11-2000", format = "%d-%m-%Y"), by = 'day'), @@ -30,6 +28,8 @@ #' as.Date("30-11-2002", format = "%d-%m-%Y"), by = 'day')) #'dim(Dates) <- c(time = 214, sdate = 3) #'Period <- SelectPeriodOnDates(Dates, start = list(21, 6), end = list(21, 9)) +#'@import multiApply +#'@importFrom s2dv Reorder #'@export SelectPeriodOnDates <- function(dates, start, end, time_dim = 'time', ncores = NULL) { @@ -45,6 +45,12 @@ SelectPeriodOnDates <- function(dates, start, end, ini_day = start[[1]], ini_month = start[[2]], end_day = end[[1]], end_month = end[[2]], ncores = ncores)$output1 + reorder <- FALSE + if (which(names(dim(dates)) == time_dim) != 1) { + dimdates <- names(dim(dates)) + dates <- Reorder(dates, c(time_dim, names(dim(dates))[which(names(dim(dates)) != time_dim)])) + reorder <- TRUE + } # when 29Feb is included the length of the output changes: regular <- Apply(list(res), target_dims = time_dim, fun = sum, ncores = ncores)$output1 @@ -64,12 +70,11 @@ SelectPeriodOnDates <- function(dates, start, end, }, ncores = ncores)$output1 res <- as.POSIXct(res, origin = '1970-01-01', tz = 'UTC') } else { - if (!all(names(dim(res)) == names(dim(dates)))) { - pos <- match(names(dim(dates)), names(dim(res))) - res <- aperm(res, pos) - } res <- dates[res] dim(res) <- dims + if (reorder) { + res <- Reorder(res, dimdates) + } } return(res) } diff --git a/README.md b/README.md index 360ecbee9b29b493c8fd2e43e595515612747f72..f2789842c1cd2808c1c97654d89b66392ba982a3 100644 --- a/README.md +++ b/README.md @@ -41,61 +41,76 @@ Functions documentation can be found [here](https://CRAN.R-project.org/package=C | Function | CST version | Indicators | |--------------------------------|------------------------------------|---------------------------------| -|PeriodMean |CST_PeriodMean |GST, SprTX, DTR | -|PeriodAccumulation |CST_PeriodAccumulation |SprR, HarR, PRCPTOT | -|AccumulationExceedingThreshold |CST_AccumulationExceedingThreshold |GDD, R95pTOT, R99pTOT | -|TotalTimeExceedingThreshold |CST_TotalTimeExceedingThreshold |SU35, SU, FD, ID, TR, R10mm, Rnmm| -|TotalSpellTimeExceedingThreshold|CST_TotalSpellTimeExceedingThreshold|WSDI, CSDI | -|WindCapacityFactor |CST_WindCapacityFactor |Wind Capacity Factor | -|WindPowerDensity |CST_WindPowerDensity |Wind Power Density | +|[PeriodMean](R/PeriodMean.R) |CST_PeriodMean |GST, SprTX, DTR, BIO1, BIO2 | +|[PeriodMax](R/PeriodMax.R) |CST_PeriodMax |BIO5, BIO13 | +|[PeriodMin](R/PeriodMin.R) |PeriodMin |BIO6, BIO14 | +|[PeriodVariance](R/PeriodVariance.R) |CST_PeriodVariance |BIO4, BIO15 | +|[PeriodAccumulation](R/PeriodAccumulation.R) |CST_PeriodAccumulation |SprR, HarR, PRCPTOT, BIO16, ... | +|[PeriodPET](R/PeriodPET.R) |CST_PeriodPET |PET, SPEI | +|[PeriodStandardization](R/PeriodStandardization.R) |CST_PeriodStandardization |SPEI, SPI | +|[AccumulationExceedingThreshold](R/AccumulationExceedingThreshold.R) |CST_AccumulationExceedingThreshold |GDD, R95pTOT, R99pTOT | +|[TotalTimeExceedingThreshold](R/TotalTimeExceedingThreshold.R) |CST_TotalTimeExceedingThreshold |SU35, SU, FD, ID, TR, R10mm, Rnmm| +|[TotalSpellTimeExceedingThreshold](R/TotalSpellTimeExceedingThreshold.R)|CST_TotalSpellTimeExceedingThreshold|WSDI, CSDI | +|[WindCapacityFactor](R/WindCapacityFactor.R) |CST_WindCapacityFactor |Wind Capacity Factor | +|[WindPowerDensity](R/WindPowerDensity.R) |CST_WindPowerDensity |Wind Power Density | | Auxiliar function | CST version | |-------------------|----------------------| -|AbsToProbs |CST_AbsToProbs | -|QThreshold |CST_QThreshold | -|Threshold |CST_Threshold | -|MergeRefToExp |CST_MergeRefToExp | -|SelectPeriodOnData |CST_SelectPeriodOnData| -|SelectPeriodOnDates| | +|[AbsToProbs](R/AbsToProbs.R) |CST_AbsToProbs | +|[QThreshold](R/QThreshold.R) |CST_QThreshold | +|[Threshold](R/Threshold.R) |CST_Threshold | +|[MergeRefToExp](R/MergeRefToExp.R) |CST_MergeRefToExp | +|[SelectPeriodOnData](R/SelectPeriodOnData.R) |CST_SelectPeriodOnData| +|[SelectPeriodOnDates](R/SelectPeriodOnDates.R)| | Find the current status of each function in [this link](https://docs.google.com/spreadsheets/d/1arqgw-etNPs-XRyMTJ4ekF5YjQxAZBzssxxr2GMXp3c/edit#gid=0). -*Note: the CST version uses 's2dv_cube' objects as inputs and outputs while the former version uses multidimensional arrays with named dimensions as inputs and outputs* +> **Note I:** the CST version uses 's2dv_cube' objects as inputs and outputs while the former version uses multidimensional arrays with named dimensions as inputs and outputs. -*Note: All functions computing indicators allows to subset a time period if required, although this temporal subsetting can also be done with functions `SelectPeriodOnData` in a separated step.* +> **Note II:** All functions computing indicators allows to subset a time period if required, although this temporal subsetting can also be done with functions `SelectPeriodOnData` in a separated step. -#### Object class 's2dv_cube' +#### Object class s2dv_cube -This package is designed to be compatible with other R packages such as [CSTools](https://CRAN.R-project.org/package=CSTools) through a common object: the `s2dv_cube` object class, used in functions with the prefix **CST_**. This object can be created from Start ([startR](https://CRAN.R-project.org/package=startR) package) and from Load ([s2dv](https://CRAN.R-project.org/package=s2dv) package) directly. +This package is designed to be compatible with other R packages such as [CSTools](https://CRAN.R-project.org/package=CSTools) through a common object: the `s2dv_cube`, used in functions with the prefix **CST**. -The class `s2dv_cube` is mainly a list of named elements to keep data and metadata in a single object. Basic structure of the object: +An `s2dv_cube` is an object to store ordered multidimensional array with named dimensions, specific coordinates and stored metadata. As an example, this is how it looks like (see `CSTools::lonlat_temp_st$exp`): ```r -$ data: [data array] -$ dims: [dimensions vector] -$ coords: [List of coordinates vectors] - $ sdate - $ time - $ lon - [...] -$ attrs: [List of the attributes] - $ Variable: - $ varName - $ metadata - $ Datasets - $ Dates - $ source_files - $ when - $ load_parameters +'s2dv_cube' +Data [ 279.99, 280.34, 279.45, 281.99, 280.92, ... ] +Dimensions ( dataset = 1, var = 1, member = 15, sdate = 6, ftime = 3, lat = 22, lon = 53 ) +Coordinates + * dataset : dat1 + * var : tas + member : 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15 + * sdate : 20001101, 20011101, 20021101, 20031101, 20041101, 20051101 + ftime : 1, 2, 3 + * lat : 48, 47, 46, 45, 44, 43, 42, 41, 40, 39, 38, 37, 36, 35, 34, ... + * lon : 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, ... +Attributes + Dates : 2000-11-01 2001-11-01 2002-11-01 2003-11-01 2004-11-01 ... + varName : tas + metadata : + lat + units : degrees_north + long name : latitude + lon + units : degrees_east + long name : longitude + ftime + units : hours since 2000-11-01 00:00:00 + tas + units : K + long name : 2 metre temperature + Datasets : dat1 + when : 2023-10-02 10:11:06 + source_files : "/ecmwf/system5c3s/monthly_mean/tas_f6h/tas_20001101.nc" ... + load_parameters : + ( dat1 ) : dataset = dat1, var = tas, sdate = 20001101 ... ``` -More information about the `s2dv_cube` object class can be found here: [description of the s2dv_cube object structure document](https://docs.google.com/document/d/1ko37JFl_h6mOjDKM5QSQGikfLBKZq1naL11RkJIwtMM/edit?usp=sharing). - -The current `s2dv_cube` object (CSIndicators 1.0.0 and CSTools 5.0.0) differs from the original object used in the previous versions of the packages. If you have **questions** on this change you can follow some of the points below: - -- [New s2dv_cube object discussion in CSTools](https://earth.bsc.es/gitlab/external/cstools/-/issues/94) -- [How to deal with the compatibility break in CSIndicators](https://earth.bsc.es/gitlab/es/csindicators/-/issues/25) +> **Note:** The current `s2dv_cube` object (CSIndicators > 0.0.2 and CSTools > 4.1.1) differs from the original object used in the previous versions of the packages. More information about the `s2dv_cube` object class can be found here: [description of the s2dv_cube object structure document](https://docs.google.com/document/d/1ko37JFl_h6mOjDKM5QSQGikfLBKZq1naL11RkJIwtMM/edit?usp=sharing). Contribute ---------- @@ -105,7 +120,7 @@ Contribute 3. Create a new branch from master with a meaningful name 4. Once the development is finished, open a merge request to merge the branch on master -*Note: Remember to work with multidimensionals arrays with named dimensions when possible and use [multiApply](https://earth.bsc.es/gitlab/ces/multiApply).* +> **Note:** Remember to work with multidimensionals arrays with named dimensions when possible and use [multiApply](https://earth.bsc.es/gitlab/ces/multiApply). #### Add a function diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000000000000000000000000000000000000..af27d374775d31dab7fadd43ede5747e0e67fe31 --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,24 @@ +citHeader("To cite package 'CSTools' in publications use:") + +yr <- sub('.*(2[[:digit:]]{3})-.*', '\\1', meta$Date, perl = TRUE) +if (length(yr) == 0) yr <- format(Sys.Date(), '%Y') + +bibentry( + bibtype = 'Manual', + title = paste0(meta$Package, ': ', meta$Title), + author = Filter(function(p) 'aut' %in% p$role, as.person(meta$Author)), + year = yr, + note = paste('R package version', meta$Version), + url = meta$URL +) + +bibentry( + bibtype = "Article", + author = c(person("Núria", "Pérez-Zanón", email = "nuria.perez@bsc.es"), person("", "et al.")), + title = "CSIndicators: Get tailored climate indicators for applications in your sector", + doi = "10.1016/j.cliser.2023.100393", + url = "https://www.sciencedirect.com/science/article/pii/S2405880723000547", + journal = "Climate Services", + publisher = "Elsevier", + year = "2023" +) diff --git a/tests/testthat/test-SelectPeriod.R b/tests/testthat/test-SelectPeriod.R index 93fc6eb52dd94714db6be8dc3fc67dcbb505d3aa..03b40722a1737d7941e880732d1dd8036e0d3c14 100644 --- a/tests/testthat/test-SelectPeriod.R +++ b/tests/testthat/test-SelectPeriod.R @@ -56,7 +56,6 @@ test_that("2. Output checks", { dim(res), c(time = 52) ) - }) ############################################## @@ -250,3 +249,49 @@ test_that("4. Seasonal", { ) }) +############################################## + +test_that("5. Test sample data", { + dates <- c(seq(as.POSIXct("10-03-2011", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2011", format = "%d-%m-%Y", tz = "UTC"), by = 'day'), + seq(as.POSIXct("10-03-2012", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2012", format = "%d-%m-%Y", tz = "UTC"), by = 'day'), + seq(as.POSIXct("10-03-2013", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("20-03-2013", format = "%d-%m-%Y", tz = "UTC"), by = 'day')) + dim(dates) <- c(ftime = 11, sdate = 3) + expect_equal( + SelectPeriodOnDates(dates = lonlat_prec$attrs$Dates, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + dates + ) + dates_lonlat <- lonlat_prec_st$attrs$Dates + dates_lonlat <- Reorder(dates_lonlat-12*3600, c(2,1)) + expect_equal( + SelectPeriodOnDates(dates = dates_lonlat, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + dates + ) + # test error + dates <- CSTools::lonlat_prec_st$attrs$Dates + out_sdates <- c(as.POSIXct("10-03-2011", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("10-03-2012", format = "%d-%m-%Y", tz = "UTC"), + as.POSIXct("10-03-2013", format = "%d-%m-%Y", tz = "UTC")) + dim(dates) <- c(a = 3, len = 31) + expect_error( + SelectPeriodOnDates(dates = dates, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime'), + "Could not find dimension 'ftime' in 1th object provided in 'data'." + ) + dim(dates) <- c(sdate = 3, ftime = 31) + expect_equal( + SelectPeriodOnDates(dates = dates-12*3600, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime')[, 1], + out_sdates + ) + dates <- Reorder(dates, c(2,1)) + expect_equal( + SelectPeriodOnDates(dates = dates-12*3600, start = list(10, 03), + end = list(20, 03), time_dim = 'ftime')[1, ], + out_sdates + ) +})