diff --git a/.Rbuildignore b/.Rbuildignore index 15222c0c49a1e16886a535ce490d47940170e23c..31cdda424dd02966ebb9f5f9ee8c1caa31ee008e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,5 +1,6 @@ .*\.git$ .*\.gitignore$ +.*\.gitlab$ .*\.tar.gz$ .*\.pdf$ ./.nc$ @@ -7,8 +8,8 @@ .*\.gitlab-ci.yml$ ^tests$ #^inst/doc$ -^inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF100\.R$ -^inst/doc/UseCase1_WindEvent_March2018\.R$ -^inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF4\.R$ -^inst/doc/UseCase3_data_preparation_SCHEME_model\.R$ -^inst/doc/launch_UseCase2_PrecipitationDownscaling_RF4\.sh$ +^inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF100\.R$ +^inst/doc/usecase/UseCase1_WindEvent_March2018\.R$ +^inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF4\.R$ +^inst/doc/usecase/UseCase3_data_preparation_SCHEME_model\.R$ +^inst/doc/usecase/launch_UseCase2_PrecipitationDownscaling_RF4\.sh$ diff --git a/.gitlab/.gitkeep b/.gitlab/.gitkeep new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/.gitlab/issue_templates/.gitkeep b/.gitlab/issue_templates/.gitkeep new file mode 100644 index 0000000000000000000000000000000000000000..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 diff --git a/.gitlab/issue_templates/default.md b/.gitlab/issue_templates/default.md new file mode 100644 index 0000000000000000000000000000000000000000..e7af1cb5b0485ab0bc1f512d1931cf47abcfff1b --- /dev/null +++ b/.gitlab/issue_templates/default.md @@ -0,0 +1,25 @@ +(This is a template to report errors and bugs. Please fill in the relevant information and delete the rest.) + +Hi @erifarov (and @aho), + +#### R and packages Version +(Which R version are you using? ex. 4.1.2) +(Which R packages versions are you using? use sessionInfo(). ex. CSTools_5.0.1, ClimProjDiags_0.3.2, ...) +(Which machine are you using? WS, Nord3, other...) + +#### Summary +(Bug: Summarize the bug and explain briefly the expected and the current behavior.) +(New development: Summarize the development needed.) + +#### Example +(Bug: Provide a **minimal reproducible example** and the error message.) +(New development: Provide an example script or useful piece of code if needed.) + +``` +Example: +[ERROR!]: Something went really wrong! +This is the error message that showed up on the terminal. +``` + +#### Other Relevant Information +(Additional information.) diff --git a/DESCRIPTION b/DESCRIPTION index 0085fa4ff7fa1b79aa7e32ec2dccc172ef633dec..14cd34f6f7fac882ba03cd00ef5579e04ffbbaf3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: CSTools Title: Assessing Skill of Climate Forecasts on Seasonal-to-Decadal Timescales -Version: 5.0.1 +Version: 5.1.0 Authors@R: c( person("Nuria", "Perez-Zanon", , "nuria.perez@bsc.es", role = "aut", comment = c(ORCID = "0000-0001-8568-3071")), person("Louis-Philippe", "Caron", , "louis-philippe.caron@bsc.es", role = "aut", comment = c(ORCID = "0000-0001-5221-0147")), @@ -62,6 +62,7 @@ Depends: easyVerification Imports: s2dv, + startR, rainfarmr, multiApply (>= 2.1.1), ClimProjDiags, @@ -84,8 +85,7 @@ Suggests: testthat, knitr, markdown, - rmarkdown, - startR + rmarkdown VignetteBuilder: knitr License: GPL-3 Encoding: UTF-8 diff --git a/NAMESPACE b/NAMESPACE index a2df146de80c562d887008c4185466dffb1c7021..012f76cfb679e9a7bf310fc913581d7b07bd4caa 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method(print,s2dv_cube) export(AdamontAnalog) export(AdamontQQCorr) export(Analogs) @@ -35,6 +36,7 @@ export(CST_RainFARM) export(CST_RegimesAssign) export(CST_SaveExp) export(CST_SplitDim) +export(CST_Start) export(CST_Subset) export(CST_WeatherRegimes) export(Calibration) @@ -75,6 +77,7 @@ import(qmap) import(rainfarmr) import(s2dv) import(scales) +import(startR) import(stats) importFrom(ClimProjDiags,SelBox) importFrom(ClimProjDiags,Subset) diff --git a/NEWS.md b/NEWS.md index 5474779afe4fcc46415e9906c5c974e2628e4580..f2f8f099299897223878854151e8e11bc24852d9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,25 +1,48 @@ +# CSTools 5.1.0 (Release date: 17-10-2023) + +### Fixes +- Calibration() show warnings in atomic function when multiple cores are used. +- PlotForecastPDF fix background color in different machines. +- Correct CST_Subset indices for metadata. +- CST_Analogs: Add sdate_dim parameter and improve initial checks. +- Remove CST_Anomaly repeated checks in order to accept no member dimensions in obs. +- CST_SaveExp developments: improve warning, save metadata correctly. +- Improve print method in order that time_bounds are correctly displayed. + +### Development +- PlotWeeklyClim to allow years outside the reference period. +- PlotWeeklyClim to allow setting y limits. +- New function CST_Start(). +- PlotCombinedMap() has upper triangle_end; the color bars can have different breaks. +- New print method. +- CST_MultiEOF development treat spatial NAs. +- Correct PlotCombinedMap error. +- Substitute mentions of CST_Load by CST_Start. +- Modify necessary vignettes to the use of CST_Start. + # CSTools 5.0.1 (Release date: 06-06-2023) - Resubmit to CRAN because it was archived due to dependency issue -**Fixes** +### Fixes - Standardize the coordinates of 's2dv_cube' by setting the coordinates to vectors with NULL dimensions - Include a check for SaveExp output filenames that only contain date information - In SaveExp the dates parameter is allowed to have additional time dimensions of length 1 - Removed dot from the internal function named mergedatasets() used in CST_CategoricalEnsCombination -**New Features** +### Development - New parameter 'startdates' in CST_SaveExp used to manually decide the name of the output files -**Other** +### Other - Switch to testthat version 3 # CSTools 5.0.0 (Release date: 05-04-2023) -**Fixes** + +### Fixes - Correct vignettes: Analogs, MultiModelSkill and MultivarRMSE - Add 'ncores' to s2dv function calls in CST_Anomaly - Reduce computing time of examples and tests and improve documentation -**New features** +### Development - Add dat_dim parameter in CST_BiasCorrection and CST_Calibration - New plotting function for case studies temporal visualisation: PlotWeeklyClim - Deprecate indices in dim_anom parameter of CST_Anomaly @@ -31,26 +54,28 @@ - New color set in PlotForecastPDF Vitigeoss colors - New function CST_InsertDim -**Other** +### Other - Added contribution from ArticXchange project due to PlotWeeklyClim - Update NEWS.md with the correct format - Change Licence # CSTools 4.1.1 (Release date: 10-11-2022) -**Fixes** + +### Fixes - CST_Analogs corrected input of ClimProjDiags::Subset() - PlotCombinedMap corrected use of 'cex_bar_titles' parameter - CST_Anomaly added 'memb_dim', 'dat_dim' and 'ftime_dim' and improved use for 'dim_anom' parameters -# CSTools 4.1.0 (Release date: 25-10-2022) -**New features** +# CSTools 4.1.0 (Release date: 25-10-2022) + +### Development - Dependency on package 's2dverification' is changed to 's2dv' - CST_BiasCorrection new parameters 'memb_dim', 'sdate_dim', 'ncores' - CST_Calibration is able to calibrate forecast with new parameter 'exp_cor' - CST_QuantileMapping uses cross-validation and provides option to remove NAs; new parameters 'memb_dim', 'sdate_dim', 'window_dim' and 'na.rm'; 'sample_dim' and 'sample_length' are removed - s2dv_cube() new parameter 'time_dim' -**Fixes** +### Fixes - as.s2dv_cube() detects latitude and longitude structure in startR_array object - Data correction: 'lonlat_data' is renamed to 'lonlat_temp'; 'lonlat_prec' is corrected by one-day shift - Typo and parameter correction in vignette 'MostLikelyTercile_vignette' @@ -58,20 +83,22 @@ - PlotMostLikelyQuantileMap() works with s2dv::PlotLayout # CSTools 4.0.1 (Release date: 05-10-2021) -**New features** + +### Development - Dynamical Bias Correction method: `CST_ProxiesAttractors` and `CST_DynBiasCorrection` (optionally `Predictability`) - CST_BiasCorrection and BiasCorrection allows to calibrate a forecast given the calibration in the hindcast by using parameter 'exp_cor' - Use cases - CST_SaveExp includes parameter extra_string - PlotCombinedMap includes parameter cex_bar_titles -**Fixes** +### Fixes - Calibration retains correlation absolute value - Calibration fixed when cal.methodi == rpc-based, apply_to == sign, eval.method == 'leave-one-out' and the correlation is not significant - PlotMostLikelyQuantileMap reoder latitudes of an array provided in 'dots' parameter # CSTools 4.0.0 (Release date: 23-02-2021) -**New features** + +### Development - ADAMONT downscaling method: requires CST_AdamontAnalogs and CST_AdamontQQCor functions - Analogs method using Predictors: requires training_analogs and CST_AnalogsPredictors - PlotPDFsOLE includes parameters to modify legend style @@ -88,7 +115,7 @@ - Analogs vignette - Data Storage and retrieval vignette -**Fixes** +### Fixes - PlotForecastPDF correctly displays terciles labels - CST_SaveExp correctly save time units - CST_SplitDims returns ordered output following ascending order provided in indices when it is numeric @@ -100,7 +127,8 @@ - Decrease package size compresing vignettes figures and removing areave_data sample # CSTools 3.1.0 (Release date: 02-07-2020) -**New features** + +### Development - EnsClustering vignette - EnsClustering has a new parameter 'time_dim' - CST_BiasCorrection has na.rm paramter @@ -111,7 +139,7 @@ - CST_RFTemp/RF_Temp functions available for downscaling temperature - Weather Regimes vignette -**Fixes** +### Fixes - CST_Anomaly handles exp, obs or both - PlotForecastPDF vignette displays figures correctly - Calibration function is exposed to users @@ -123,17 +151,19 @@ - CST_SaveExp uses multiApply and save time dimension correctly # CSTools 3.0.0 (Release date: 10-02-2020) -**New features** + +### Development - CST_MergeDims and MergeDims - Version working with R 3.4.2 - PlotForecastPDF handles independent terciles, extremes and observations for each panel -**Fixes** +### Fixes - CST_Calibration handles missing values - BEI functions handle missing values -# CSTools 2.0.0 (Release date: 25-11-2019) -**New features** +# CSTools 2.0.0 (Release date: 25-11-2019) + +### Development - CST_Analogs Analogs downscaling method, - CST_MultiEOFS for multiple variables, - Ensemble Clustering, @@ -151,13 +181,14 @@ - Adding reference to S2S4E H2020 project into the DESCRIPTION file - Adding NEWS.md file -**Fixes** +### Fixes - Minor fix in CST_BiasCorrection when checking parameter 'obs' - Minor fix in data lonlat_prec to be of class 's2dv_cube' - Minor fix in RainFARM vignette ### CSTools 1.0.1 (Release date: 19-06-2019) -**Fixes and new features** + +### Fixes and development - Correcting test of PlotForecastPDF for compatibility with ggplot2 release - New function PlotCombinedMap - Adding reference to MEDSCOPE ERA4CS Project into the DESCRIPTION file diff --git a/R/CST_Analogs.R b/R/CST_Analogs.R index b6cbfa4e3fb5f4764985a6ae0ec13db84069274b..425210859659c31f3763d183486ed053d2895852 100644 --- a/R/CST_Analogs.R +++ b/R/CST_Analogs.R @@ -24,7 +24,7 @@ #'This function has not constrains of specific regions, variables to downscale, #'or data to be used (seasonal forecast data, climate projections data, #'reanalyses data). The regrid into a finner scale is done interpolating with -#'CST_Load. Then, this interpolation is corrected selecting the analogs in the +#'CST_Start. Then, this interpolation is corrected selecting the analogs in the #'large and local scale in based of the observations. The function is an #'adapted version of the method of Yiou et al 2013. For an advanced search of #'Analogs (multiple Analogs, different criterias, further information from the @@ -54,6 +54,8 @@ #' analog of parameter 'expVar'. #'@param obsVar An 's2dv_cube' containing the field of the same variable as the #' passed in parameter 'expVar' for the same region. +#'@param sdate_dim A character string indicating the name of the start date +#' dimension. By default, it is set to 'sdate'. #'@param region A vector of length four indicating the minimum longitude, the #' maximum longitude, the minimum latitude and the maximum latitude. #'@param criteria A character string indicating the criteria to be used for the @@ -77,7 +79,8 @@ #' and dates are taken from element \code{$attrs$Dates} from expL. #'@param time_obsL A character string indicating the date of the observations #' in the date format (i.e. "yyyy-mm-dd"). By default it is NULL and dates are -#' taken from element \code{$attrs$Dates} from obsL. +#' taken from element \code{$attrs$Dates} from obsL. It must have time +#' dimensions. #'@param region A vector of length four indicating the minimum longitude, #' the maximum longitude, the minimum latitude and the maximum latitude. #'@param nAnalogs Number of Analogs to be selected to apply the criterias @@ -101,8 +104,7 @@ #' best analog, for instance for downscaling. #'@param ncores The number of cores to use in parallel computation #' -#'@seealso \code{\link{CST_Load}}, \code{\link[s2dv]{Load}} and -#'\code{\link[s2dv]{CDORemap}} +#'@seealso \code{\link{CST_Start}}, \code{\link[startR]{Start}} #' #'@return An 's2dv_cube' object containing an array with the dowscaled values of #'the best analogs in element 'data'. If 'AnalogsInfo' is TRUE, 'data' is a list @@ -117,6 +119,7 @@ #' format = "%d-%m-%y") #'dim(time_obsL) <- c(time = 10) #'time_expL <- time_obsL[1] +#'dim(time_expL) <- c(time = 1) #'lon <- seq(-1, 5, 1.5) #'lat <- seq(30, 35, 1.5) #'coords <- list(lon = seq(-1, 5, 1.5), lat = seq(30, 35, 1.5)) @@ -131,9 +134,11 @@ #' #'@import multiApply #'@import abind +#'@import s2dv #'@importFrom ClimProjDiags SelBox Subset #'@export -CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, +CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, + sdate_dim = 'sdate', region = NULL, criteria = 'Large_dist', excludeTime = NULL, time_expL = NULL, time_obsL = NULL, nAnalogs = NULL, AnalogsInfo = FALSE, @@ -141,16 +146,13 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, # Check 's2dv_cube' if (!inherits(expL, "s2dv_cube") || !inherits(obsL, "s2dv_cube")) { - stop("Parameter 'expL' and 'obsL' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'expL' and 'obsL' must be of the class 's2dv_cube'.") } if (!is.null(expVar) && !inherits(expVar, "s2dv_cube")) { - stop("Parameter 'expVar' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'expVar' must be of the class 's2dv_cube'.") } if (!is.null(obsVar) && !inherits(obsVar, "s2dv_cube")) { - stop("Parameter 'obsVar' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'obsVar' must be of the class 's2dv_cube'.") } # Check 'obsL' object structure @@ -215,7 +217,8 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, lonL = as.vector(obsL$coords[[lon_name]]), latL = as.vector(obsL$coords[[lat_name]]), expVar = expVar$data, - obsVar = obsVar$data, criteria = criteria, + obsVar = obsVar$data, sdate_dim = sdate_dim, + criteria = criteria, excludeTime = excludeTime, region = region, lonVar = as.vector(lonVar), latVar = as.vector(latVar), nAnalogs = nAnalogs, AnalogsInfo = AnalogsInfo, @@ -228,6 +231,7 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, } expL$data <- res + expL$dims <- dim(res) if (!is.null(obsL$coords[[lon_name]]) | !is.null(obsL$coords[[lat_name]])) { if (is.null(region)) { @@ -237,11 +241,15 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, expL$coords[[lon_name]] <- SelBox(obsL$data, lon = as.vector(obsL$coords[[lon_name]]), lat = as.vector(obsL$coords[[lat_name]]), - region = region)$lon + region = region, + londim = lon_name, + latdim = lat_name)$lon expL$coords[[lat_name]] <- SelBox(obsL$data, lon = as.vector(obsL$coords[[lon_name]]), lat = as.vector(obsL$coords[[lat_name]]), - region = region)$lat + region = region, + londim = lon_name, + latdim = lat_name)$lat } } @@ -281,7 +289,7 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, #'ones. This function has not constrains of specific regions, variables to #'downscale, or data to be used (seasonal forecast data, climate projections #'data, reanalyses data). The regrid into a finner scale is done interpolating -#'with CST_Load. Then, this interpolation is corrected selecting the analogs in +#'with CST_Start. Then, this interpolation is corrected selecting the analogs in #'the large and local scale in based of the observations. The function is an #'adapted version of the method of Yiou et al 2013. #' @@ -304,10 +312,12 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, #' the same latitudinal and longitudinal dimensions as parameter 'expL' and a #' single temporal dimension with the maximum number of available observations. #'@param time_obsL A character string indicating the date of the observations -#' in the format "dd-mm-yyyy". Reference time to search for analogs. +#' in the format "dd-mm-yyyy". Reference time to search for analogs. It must +#' have time dimensions. #'@param time_expL An array of N named dimensions (coinciding with time #' dimensions in expL) of character string(s) indicating the date(s) of the -#' experiment in the format "dd-mm-yyyy". Time(s) to find the analogs. +#' experiment in the format "dd-mm-yyyy". Time(s) to find the analogs. If it +#' is not an scalar it must have named dimensions. #'@param lonL A vector containing the longitude of parameter 'expL'. #'@param latL A vector containing the latitude of parameter 'expL'. #'@param excludeTime An array of N named dimensions (coinciding with time @@ -322,6 +332,8 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, #' function will be the analog of parameter 'expVar'. #'@param obsVar An array of N named dimensions containing the field of the #' same variable as the passed in parameter 'expVar' for the same region. +#'@param sdate_dim A character string indicating the name of the start date +#' dimension. By default, it is set to 'sdate'. #'@param AnalogsInfo A logical value. If it is TRUE it returns a list #' with two elements: 1) the downscaled field and #' 2) the AnalogsInfo which contains: a) the number of the best @@ -368,6 +380,7 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, #'obsSLP <- c(rnorm(1:180), expSLP * 1.2) #'dim(obsSLP) <- c(time = 10, lat = 4, lon = 5) #'time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +#'dim(time_obsSLP) <- c(time = 10) #'downscale_field <- Analogs(expL = expSLP, obsL = obsSLP, #' time_obsL = time_obsSLP,time_expL = "01-01-1994") #' @@ -413,11 +426,12 @@ CST_Analogs <- function(expL, obsL, expVar = NULL, obsVar = NULL, region = NULL, #' AnalogsInfo = TRUE) #'@import multiApply #'@import abind +#'@import s2dv #'@importFrom ClimProjDiags SelBox Subset #'@export Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, - lonL = NULL, latL = NULL, expVar = NULL, - obsVar = NULL, criteria = "Large_dist", + lonL = NULL, latL = NULL, expVar = NULL, obsVar = NULL, + sdate_dim = 'sdate', criteria = "Large_dist", excludeTime = NULL, lonVar = NULL, latVar = NULL, region = NULL, nAnalogs = NULL, AnalogsInfo = FALSE, ncores = NULL) { @@ -532,12 +546,61 @@ Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, } if (!inherits(time_obsL, "character")) { warning('imposing time_obsL to be a character') + dims_time_obsL <- dim(time_obsL) time_obsL <- format(as.Date(time_obsL), '%d-%m-%Y') + dim(time_obsL) <- dims_time_obsL } if (!inherits(time_expL, "character")) { warning('imposing time_expL to be a character') + dims_time_expL <- dim(time_expL) time_expL <- format(as.Date(time_expL), '%d-%m-%Y') + dim(time_expL) <- dims_time_expL } + # time_obsL, time_expL (2) + if (is.null(names(dim(time_obsL)))) { + stop("Parameter 'time_obsL' must have named dimensions.") + } + if (!is.character(sdate_dim)) { + stop("Parameter 'sdate_dim' must be a character string.") + } + if (!sdate_dim %in% names(dim(time_obsL))) { + if (length(dim(time_obsL)) == 1) { + dim(time_obsL) <- c(dim(time_obsL), sdate = 1) + } else { + stop("Parameters 'time_obsL' must have 'sdate_dim' dimension name. ", + "If it has multiple time dimensions.") + } + } + if (length(time_expL) != 1) { + if (is.null(names(dim(time_expL)))) { + stop("Parameter 'time_expL' must have named dimensions.") + } + } else { + dim(time_expL) <- 1 + } + if (!sdate_dim %in% names(dim(time_expL))) { + if (length(dim(time_expL)) == 1) { + dim(time_expL) <- c(dim(time_expL), sdate = 1) + } else { + stop("Parameters 'time_expL' must have 'sdate_dim' dimension name. ", + "If it has multiple time dimensions.") + } + } + if (length(dim(time_obsL)) == 2) { + if (which(sdate_dim %in% names(dim(time_obsL))) == 1) { + time_obsL <- Reorder(time_obsL, c(2,1)) + } + } else { + warning("Parameter 'time_obsL' should have forecast time and start date dimension in this order.") + } + if (length(dim(time_expL)) == 2) { + if (which(sdate_dim %in% names(dim(time_expL))) == 1) { + time_expL <- Reorder(time_expL, c(2,1)) + } + } else { + warning("Parameter 'time_expL' should have forecast time and start date dimension in this order.") + } + # excludeTime if (!is.null(excludeTime)) { if (!inherits(excludeTime, "character")) { @@ -545,23 +608,7 @@ Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, excludeTime <- format(as.Date(excludeTime),'%d-%m-%Y') } } - # time_obsL - if (is.null(time_obsL)) { - stop("Parameter 'time_obsL' cannot be NULL") - } - if (any(names(dim(obsL)) %in% 'ftime')) { - if (any(names(dim(obsL)) %in% 'time')) { - stop("Multiple temporal dimensions ('ftime' and 'time') found", - "in parameter 'obsL'.") - } else { - time_pos_obsL <- which(names(dim(obsL)) == 'ftime') - names(dim(obsL))[time_pos_obsL] <- 'time' - if (any(names(dim(expL)) %in% 'ftime')) { - time_pos_expL <- which(names(dim(expL)) == 'ftime') - names(dim(expL))[time_pos_expL] <- 'time' - } - } - } + # obsVar, expVar if (!is.null(obsVar)) { if (any(names(dim(obsVar)) %in% 'ftime')) { if (any(names(dim(obsVar)) %in% 'time')) { @@ -577,6 +624,20 @@ Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, } } } + # obsL + if (any(names(dim(obsL)) %in% 'ftime')) { + if (any(names(dim(obsL)) %in% 'time')) { + stop("Multiple temporal dimensions ('ftime' and 'time') found", + "in parameter 'obsL'.") + } else { + time_pos_obsL <- which(names(dim(obsL)) == 'ftime') + names(dim(obsL))[time_pos_obsL] <- 'time' + if (any(names(dim(expL)) %in% 'ftime')) { + time_pos_expL <- which(names(dim(expL)) == 'ftime') + names(dim(expL))[time_pos_expL] <- 'time' + } + } + } if ((any(names(dim(obsL)) %in% 'sdate')) && (any(names(dim(obsL)) %in% 'time'))) { dims_obsL <- dim(obsL) @@ -600,7 +661,7 @@ Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, if (any(names(dim(obsL)) %in% 'time')) { dims_obsL <- dim(obsL) pos_time <- which(names(dim(obsL)) == 'time') - if(length(time_obsL) != dim(obsL)[pos_time]) { + if (length(time_obsL) != dim(obsL)[pos_time]) { stop("'time_obsL' and 'obsL' must have same length in the temporal dimension.") } @@ -614,6 +675,7 @@ Analogs <- function(expL, obsL, time_obsL, time_expL = NULL, } } } + # obsVar if (!is.null(obsVar)) { if (any(names(dim(obsVar)) %in% 'sdate')) { if (any(names(dim(obsVar)) %in% 'time')) { @@ -933,8 +995,10 @@ FindAnalog <- function(expL, obsL, time_obsL, expVar, obsVar, criteria, dim(Analogs_dates) <- dim(best) if (all(!is.null(region), !is.null(lonVar), !is.null(latVar))) { if (is.null(obsVar)) { - obsVar <- SelBox(obsL, lon = lonL, lat = latL, region = region)$data - expVar <- SelBox(expL, lon = lonL, lat = latL, region = region)$data + obsVar <- SelBox(obsL, lon = lonL, lat = latL, region = region, + londim = lon_name, latdim = lat_name)$data + expVar <- SelBox(expL, lon = lonL, lat = latL, region = region, + londim = lon_name, latdim = lat_name)$data Analogs_fields <- Subset(obsVar, along = which(names(dim(obsVar)) == 'time'), indices = best) @@ -943,7 +1007,7 @@ FindAnalog <- function(expL, obsL, time_obsL, expVar, obsVar, criteria, } else { obslocal <- SelBox(obsVar, lon = lonVar, lat = latVar, - region = region)$data + region = region, londim = lon_name, latdim = lat_name)$data Analogs_fields <- Subset(obslocal, along = which(names(dim(obslocal)) == 'time'), indices = best) @@ -1102,8 +1166,10 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, position = pos1)) } if (criteria == "Local_dist" | criteria == "Local_cor") { - obs <- SelBox(obsL, lon = lonL, lat = latL, region = region)$data - exp <- SelBox(expL, lon = lonL, lat = latL, region = region)$data + obs <- SelBox(obsL, lon = lonL, lat = latL, region = region, + londim = lon_name, latdim = lat_name)$data + exp <- SelBox(expL, lon = lonL, lat = latL, region = region, + londim = lon_name, latdim = lat_name)$data metric2 <- Apply(list(obs), target_dims = list(c(lat_name, lon_name)), fun = .select, exp, metric = "dist", lon_name = lon_name, lat_name = lat_name)$output1 @@ -1128,8 +1194,10 @@ Select <- function(expL, obsL, expVar = NULL, obsVar = NULL, } } if (criteria == "Local_cor") { - obs <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region)$data - exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region)$data + obs <- SelBox(obsVar, lon = lonVar, lat = latVar, region = region, + londim = lon_name, latdim = lat_name)$data + exp <- SelBox(expVar, lon = lonVar, lat = latVar, region = region, + londim = lon_name, latdim = lat_name)$data metric3 <- Apply(list(obs), target_dims = list(c(lat_name, lon_name)), fun = .select, exp, metric = "cor", lon_name = lon_name, lat_name = lat_name)$output1 diff --git a/R/CST_Anomaly.R b/R/CST_Anomaly.R index c93267413c41aa336280715f389d0c540ec1e82b..654bb0790a94f5a8571585c2b0e99e35e6d49497 100644 --- a/R/CST_Anomaly.R +++ b/R/CST_Anomaly.R @@ -9,10 +9,10 @@ #'computation is carried out independently for experimental and observational #'data products. #' -#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function, containing the seasonal forecast experiment data in the element #' named \code{$data}. -#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function, containing the observed data in the element named \code{$data}. #'@param dim_anom A character string indicating the name of the dimension #' along which the climatology will be computed. The default value is 'sdate'. @@ -57,7 +57,7 @@ #'anom <- CST_Anomaly(exp = exp, obs = obs, cross = FALSE, memb = TRUE) #' #'@seealso \code{\link[s2dv]{Ano_CrossValid}}, \code{\link[s2dv]{Clim}} and -#'\code{\link{CST_Load}} +#'\code{\link{CST_Start}} #' #'@import multiApply #'@importFrom s2dv InsertDim Clim Ano_CrossValid Reorder @@ -69,8 +69,7 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, dim_anom = 'sdate', # Check 's2dv_cube' if (!inherits(exp, 's2dv_cube') & !is.null(exp) || !inherits(obs, 's2dv_cube') & !is.null(obs)) { - stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") } # exp and obs if (is.null(exp$data) & is.null(obs$data)) { @@ -91,13 +90,10 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, dim_anom = 'sdate', any(is.null(names(dim(obs$data))))| any(nchar(names(dim(obs$data))) == 0)) { stop("Parameter 'exp' and 'obs' must have dimension names in element 'data'.") } - if (!all(names(dim(exp$data)) %in% names(dim(obs$data))) | - !all(names(dim(obs$data)) %in% names(dim(exp$data)))) { - stop("Parameter 'exp' and 'obs' must have same dimension names in element 'data'.") - } dim_exp <- dim(exp$data) dim_obs <- dim(obs$data) - dimnames_data <- names(dim_exp) + dimnames_exp <- names(dim_exp) + dimnames_obs <- names(dim_obs) # dim_anom if (!is.character(dim_anom)) { stop("Parameter 'dim_anom' must be a character string.") @@ -129,19 +125,12 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, dim_anom = 'sdate', if (!is.character(memb_dim) | length(memb_dim) > 1) { stop("Parameter 'memb_dim' must be a character string.") } - if (!memb_dim %in% names(dim_exp) | !memb_dim %in% names(dim_obs)) { - stop("Parameter 'memb_dim' is not found in 'exp' or in 'obs' dimension.") - } } # dat_dim if (!is.null(dat_dim)) { if (!is.character(dat_dim)) { stop("Parameter 'dat_dim' must be a character vector.") } - if (!all(dat_dim %in% names(dim_exp)) | !all(dat_dim %in% names(dim_obs))) { - stop("Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension in element 'data'. ", - "Set it as NULL if there is no dataset dimension.") - } } # filter_span if (!is.null(filter_span)) { @@ -161,7 +150,7 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, dim_anom = 'sdate', if (!is.character(ftime_dim)) { stop("Parameter 'ftime_dim' must be a character string.") } - if (!ftime_dim %in% names(dim_exp) | !memb_dim %in% names(dim_obs)) { + if (!ftime_dim %in% names(dim_exp) | !ftime_dim %in% names(dim_obs)) { stop("Parameter 'ftime_dim' is not found in 'exp' or in 'obs' dimension in element 'data'.") } } @@ -206,15 +195,17 @@ CST_Anomaly <- function(exp = NULL, obs = NULL, dim_anom = 'sdate', ano <- NULL # Permuting back dimensions to original order - clim_exp <- Reorder(clim_exp, dimnames_data) - clim_obs <- Reorder(clim_obs, dimnames_data) + clim_exp <- Reorder(clim_exp, dimnames_exp) + clim_obs <- Reorder(clim_obs, dimnames_obs) ano$exp <- exp$data - clim_exp ano$obs <- obs$data - clim_obs } exp$data <- ano$exp + exp$dims <- dim(ano$exp) obs$data <- ano$obs + obs$dims <- dim(ano$obs) # Outputs # ~~~~~~~~~ diff --git a/R/CST_BiasCorrection.R b/R/CST_BiasCorrection.R index 772d23ef6e1e9f36fc5ca5d5eec616e4b8d6c6a6..06f2c519411c009664d44174fd455f9f662e2e1b 100644 --- a/R/CST_BiasCorrection.R +++ b/R/CST_BiasCorrection.R @@ -5,14 +5,14 @@ #'described in Torralba et al. (2017). The adjusted forecasts have an equivalent #'standard deviation and mean to that of the reference dataset. #' -#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function, containing the seasonal forecast experiment data in the element #' named \code{$data} with at least time and member dimensions. -#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function, containing the observed data in the element named \code{$data} #' with at least time dimension. #'@param exp_cor An object of class \code{s2dv_cube} as returned by -#' \code{CST_Load} function, containing the seasonal forecast experiment to be +#' \code{CST_Start} function, containing the seasonal forecast experiment to be #' corrected with at least time dimension. If it is NULL, the 'exp' forecast #' will be corrected. If there is only one corrected dataset, it should not #' have dataset dimension. If there is a corresponding corrected dataset for @@ -44,9 +44,9 @@ #' #'@examples #'mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) -#'dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, time = 5, lat = 6, lon = 7) #'obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) -#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, time = 5, lat = 6, lon = 7) #'lon <- seq(0, 30, 5) #'lat <- seq(0, 25, 5) #'coords <- list(lat = lat, lon = lon) @@ -134,9 +134,9 @@ CST_BiasCorrection <- function(exp, obs, exp_cor = NULL, na.rm = FALSE, #' #'@examples #'mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) -#'dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, time = 5, lat = 6, lon = 7) #'obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) -#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +#'dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, time = 5, lat = 6, lon = 7) #'a <- BiasCorrection(exp = mod1, obs = obs1) #'@import multiApply #'@export diff --git a/R/CST_Calibration.R b/R/CST_Calibration.R index e973c4d84dae5973e4f02653ea92747d13c98c1d..3ba22917679947eb71b1b6c2211b9e60bda804be 100644 --- a/R/CST_Calibration.R +++ b/R/CST_Calibration.R @@ -18,16 +18,16 @@ #'(2014). It is equivalent to function \code{Calibration} but for objects #'of class \code{s2dv_cube}. #' -#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param exp An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function with at least 'sdate' and 'member' dimensions, containing the #' seasonal hindcast experiment data in the element named \code{data}. The #' hindcast is used to calibrate the forecast in case the forecast is provided; #' if not, the same hindcast will be calibrated instead. -#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Load} +#'@param obs An object of class \code{s2dv_cube} as returned by \code{CST_Start} #' function with at least 'sdate' dimension, containing the observed data in #' the element named \code{$data}. #'@param exp_cor An optional object of class \code{s2dv_cube} as returned by -#' \code{CST_Load} function with at least 'sdate' and 'member' dimensions, +#' \code{CST_Start} function with at least 'sdate' and 'member' dimensions, #' containing the seasonal forecast experiment data in the element named #' \code{data}. If the forecast is provided, it will be calibrated using the #' hindcast and observations; if not, the hindcast will be calibrated instead. @@ -106,7 +106,7 @@ #'Quarterly Journal of the Royal Meteorological Society, 141(688), 807-818. #'\doi{10.1002/qj.2397} #' -#'@seealso \code{\link{CST_Load}} +#'@seealso \code{\link{CST_Start}} #' #'@examples #'# Example 1: @@ -287,7 +287,7 @@ CST_Calibration <- function(exp, obs, exp_cor = NULL, cal.method = "mse_min", #'Quarterly Journal of the Royal Meteorological Society, 141(688), 807-818. #'\doi{10.1002/qj.2397} #' -#'@seealso \code{\link{CST_Load}} +#'@seealso \code{\link{CST_Start}} #' #'@examples #'mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) @@ -450,9 +450,9 @@ Calibration <- function(exp, obs, exp_cor = NULL, if (!inherits(na.rm, "logical")) { stop("Parameter 'na.rm' must be a logical value.") } - if (length(na.rm) > 1) { - na.rm <- na.rm[1] - warning("Paramter 'na.rm' has length greater than 1, and only the fist element is used.") + ## na.fill + if (!inherits(na.fill, "logical")) { + stop("Parameter 'na.fill' must be a logical value.") } ## cal.method, apply_to, alpha if (!any(cal.method %in% c('bias', 'evmos', 'mse_min', 'crps_min', 'rpc-based'))) { @@ -491,8 +491,22 @@ Calibration <- function(exp, obs, exp_cor = NULL, warning(paste0("The 'multi.model' parameter is ignored when using the ", "calibration method '", cal.method, "'.")) } + ## data sufficiently large + data.set.sufficiently.large.out <- + Apply(data = list(exp = exp, obs = obs), + target_dims = list(exp = target_dims_exp, obs = target_dims_obs), + fun = .data.set.sufficiently.large, dat_dim = dat_dim, + ncores = ncores)$output1 - warning_shown <- FALSE + if (!all(data.set.sufficiently.large.out)) { + if (na.fill) { + warning("Some forecast data could not be corrected due to data lack", + " and is replaced with NA values.") + } else { + warning("Some forecast data could not be corrected due to data lack", + " and is replaced with uncorrected values.") + } + } if (is.null(exp_cor)) { calibrated <- Apply(data = list(exp = exp, obs = obs), dat_dim = dat_dim, @@ -509,6 +523,7 @@ Calibration <- function(exp, obs, exp_cor = NULL, exp_cor = target_dims_cor), ncores = ncores, fun = .cal)$output1 } + if (!is.null(dat_dim)) { pos <- match(c(names(dim(exp))[-which(names(dim(exp)) == dat_dim)], 'nexp', 'nobs'), names(dim(calibrated))) @@ -521,14 +536,35 @@ Calibration <- function(exp, obs, exp_cor = NULL, if (exp_cor_remove_memb) { dim(calibrated) <- dim(calibrated)[-which(names(dim(calibrated)) == memb_dim)] } + + dims <- dim(calibrated) + if (is.logical(calibrated)) { + calibrated <- array(as.numeric(calibrated), dim = dims) + } + return(calibrated) } -.data.set.sufficiently.large <- function(exp, obs) { +.data.set.sufficiently.large <- function(exp, obs, dat_dim = NULL) { amt.min.samples <- 3 - amt.good.pts <- sum(!is.na(obs) & !apply(exp, c(2), function(x) all(is.na(x)))) - return(amt.good.pts > amt.min.samples) + if (is.null(dat_dim)) { + amt.good.pts <- sum(!is.na(obs) & !apply(exp, c(2), function(x) all(is.na(x)))) + return(amt.good.pts > amt.min.samples) + } else { + nexp <- as.numeric(dim(exp)[dat_dim]) + nobs <- as.numeric(dim(obs)[dat_dim]) + amt.good.pts <- NULL + for (i in 1:nexp) { + for (j in 1:nobs) { + agp <- sum(!is.na(obs[, j, drop = FALSE]) & + !apply(exp[, , i, drop = FALSE], c(2), + function(x) all(is.na(x)))) + amt.good.pts <- c(amt.good.pts, agp) + } + } + return(amt.good.pts > amt.min.samples) + } } .make.eval.train.dexes <- function(eval.method, amt.points, amt.points_cor) { @@ -587,26 +623,16 @@ Calibration <- function(exp, obs, exp_cor = NULL, for (i in 1:nexp) { for (j in 1:nobs) { - if (!.data.set.sufficiently.large(exp = exp[, , i, drop = FALSE], - obs = obs[, j, drop = FALSE])) { + exp_data <- exp[, , i] + dim(exp_data) <- dim(exp)[1:2] + obs_data <- as.vector(obs[, j]) + if (!.data.set.sufficiently.large(exp = exp_data, obs = obs_data)) { if (!na.fill) { exp_subset <- exp[, , i] var.cor.fc[, , i, j] <- exp_subset - if (!warning_shown) { - warning("Some forecast data could not be corrected due to data lack", - " and is replaced with uncorrected values.") - warning_shown <<- TRUE - } - } else if (!warning_shown) { - warning("Some forecast data could not be corrected due to data lack", - " and is replaced with NA values.") - warning_shown <<- TRUE } } else { # Subset data for dataset dimension - obs_data <- as.vector(obs[, j]) - exp_data <- exp[, , i] - dim(exp_data) <- dim(exp)[1:2] if (cor_dat_dim) { expcor_data <- exp_cor[, , i] dim(expcor_data) <- dim(exp_cor)[1:2] @@ -680,8 +706,6 @@ Calibration <- function(exp, obs, exp_cor = NULL, # no significant -> replacing with observed climatology var.cor.fc[, eval.dexes, i, j] <- array(data = mean(obs.tr, na.rm = na.rm), dim = dim(fc.ev)) } - } else { - stop("unknown calibration method: ", cal.method) } } } @@ -691,7 +715,6 @@ Calibration <- function(exp, obs, exp_cor = NULL, if (is.null(dat_dim)) { dim(var.cor.fc) <- dim(exp_cor)[1:2] } - return(var.cor.fc) } diff --git a/R/CST_MergeDims.R b/R/CST_MergeDims.R index a1ecbd156b4b72f6d72efbc64c8fa4bd2e389f3c..4b66629ef724460287e01e26a22b098ae705ab05 100644 --- a/R/CST_MergeDims.R +++ b/R/CST_MergeDims.R @@ -33,8 +33,7 @@ CST_MergeDims <- function(data, merge_dims = c('ftime', 'monthly'), rename_dim = NULL, na.rm = FALSE) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { - stop("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'data' must be of the class 's2dv_cube'.") } data$data <- MergeDims(data$data, merge_dims = merge_dims, rename_dim = rename_dim, na.rm = na.rm) diff --git a/R/CST_MultiEOF.R b/R/CST_MultiEOF.R index bd218423f314806e36a796b34c5b7e2ff6850869..3a6c9026a78d486f2241f066a30321d4c9ddbbd8 100644 --- a/R/CST_MultiEOF.R +++ b/R/CST_MultiEOF.R @@ -17,20 +17,57 @@ #' "lon" and "lat", a dimension "ftime" and a dimension "sdate". Latitudinal #' dimension accepted names: 'lat', 'lats', 'latitude', 'y', 'j', 'nav_lat'. #' Longitudinal dimension accepted names: 'lon', 'lons','longitude', 'x', 'i', -#' 'nav_lon'. -#'@param neof_composed Number of composed eofs to return in output. -#'@param minvar Minimum variance fraction to be explained in first decomposition. +#' 'nav_lon'. NAs can exist but it should be consistent along 'time_dim'. That +#' is, if one grid point has NAs for each variable, all the time steps at this +#' point should be NAs. +#'@param lon_dim A character string indicating the name of the longitudinal +#' dimension. By default, it is set to 'lon'. +#'@param lat_dim A character string indicating the name of the latitudinal +#' dimension. By default, it is set to 'lat'. +#'@param time_dim A character string indicating the name of the temporal +#' dimension. By default, it is set to 'time'. +#'@param sdate_dim A character string indicating the name of the start date +#' dimension. By default, it is set to 'sdate'. +#'@param var_dim A character string indicating the name of the variable +#' dimension. By default, it is set to 'var'. #'@param neof_max Maximum number of single eofs considered in the first #' decomposition. +#'@param neof_composed Number of composed eofs to return in output. +#'@param minvar Minimum variance fraction to be explained in first decomposition. #'@param lon_lim Vector with longitudinal range limits for the EOF calculation #' for all input variables. #'@param lat_lim Vector with latitudinal range limits for the EOF calculation #' for all input variables. -#'@return A list with elements \code{$coeff} (an array of time-varying principal -#'component coefficients), \code{$variance} (a matrix of explained variances), -#'\code{eof_pattern} (a matrix of EOF patterns obtained by regression for each -#'variable). -#'@import abind +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#'@return +#'A list containing: +#'\item{coeff}{ +#' An 's2dv_cube' with the data element being an array of principal components +#' with dimensions 'time_dim', 'sdate_dim', number of eof, rest of the +#' dimensions of 'data' except 'lon_dim' and 'lat_dim'. +#'} +#'\item{variance}{ +#' An 's2dv_cube' with the data element being an array of explained variances +#' with dimensions 'eof' and the rest of the dimensions of 'data' except +#' 'time_dim', 'sdate_dim', 'lon_dim' and 'lat_dim'. +#'} +#'\item{eof_pattern}{ +#' An 's2dv_cube' with the data element being an array of EOF patterns obtained +#' by regression with dimensions: 'eof' and the rest of the dimensions of +#' 'data' except 'time_dim' and 'sdate_dim'. +#'} +#'\item{mask}{ +#' An 's2dv_cube' with the data element being an array of the mask with +#' dimensions ('lon_dim', 'lat_dim', rest of the dimensions of 'data' except +#' 'time_dim'). It is made from 'data', 1 for the positions that 'data' has +#' value and NA for the positions that 'data' has NA. It is used to replace NAs +#' with 0s for EOF calculation and mask the result with NAs again after the +#' calculation. +#'} +#'\item{coordinates}{ +#' Longitudinal and latitudinal coordinates vectors. +#'} #'@examples #'seq <- 1 : (2 * 3 * 4 * 5 * 6 * 8) #'mod1 <- sin( 0.7 + seq )^2 + cos( seq ^ 2 * 1.22 ) @@ -54,34 +91,28 @@ #'exp2$attrs$Dates = d #' #'cal <- CST_MultiEOF(datalist = list(exp1, exp2), neof_composed = 2) +#'@import abind #'@export -CST_MultiEOF <- function(datalist, neof_max = 40, neof_composed = 5, - minvar = 0.6, lon_lim = NULL, lat_lim = NULL) { - # Check s2dv_cube +CST_MultiEOF <- function(datalist, lon_dim = "lon", lat_dim = "lat", + time_dim = 'ftime', sdate_dim = 'sdate', + var_dim = 'var', neof_max = 40, neof_composed = 5, + minvar = 0.6, lon_lim = NULL, lat_lim = NULL, + ncores = NULL) { + # Check 's2dv_cube' if (!(all(sapply(datalist, inherits, 's2dv_cube')))) { - stop("Elements of the list in parameter 'datalist' must be of the class ", - "'s2dv_cube', as output by CSTools::CST_Load.") - } - - # Check if all dims equal - adims = lapply(lapply(datalist, function(x) x$data), dim) - if(!all(apply(apply(abind(adims, along = 0), 2, duplicated), 2, sum) == - (length(adims)-1))) { - stop("Input data fields must all have the same dimensions.") - } - - exp <- abind(lapply(datalist, '[[', 'data'), along = 0) - dim(exp) <- c(var = length(datalist), dim(datalist[[1]]$data)) - - if (any(is.na(exp))) { - stop("Input data contain NA values.") + stop("Elements of the list in parameter 'datalist' must be of the ", + "class 's2dv_cube'.") } - - # Check coordinates if (!all(c('data', 'coords', 'attrs') %in% names(datalist[[1]]))) { stop("Parameter 'datalist' must have 'data', 'coords' and 'attrs' elements ", "within the 's2dv_cube' structure.") } + # Dates + dates <- datalist[[1]]$attrs$Dates + if (is.null(dates)) { + stop("Element 'Dates' is not found in 'attrs' list of the first array.") + } + # coordinates if (!any(names(datalist[[1]]$coords) %in% .KnownLonNames()) | !any(names(datalist[[1]]$coords) %in% .KnownLatNames())) { stop("Spatial coordinate names do not match any of the names accepted by the ", @@ -89,28 +120,47 @@ CST_MultiEOF <- function(datalist, neof_max = 40, neof_composed = 5, "'nav_lat'. Longitudes accepted names: 'lon', 'lons', 'longitude', 'x',", " 'i', 'nav_lon'.") } - # Check dimensions - if (!any(names(dim(datalist[[1]]$data)) %in% .KnownLonNames()) | - !any(names(dim(datalist[[1]]$data)) %in% .KnownLatNames())) { - stop("Spatial dimension names do not match any of the names accepted by ", - "the package.") - } - lon <- names(datalist[[1]]$coords)[[which(names(datalist[[1]]$coords) %in% .KnownLonNames())]] - lat <- names(datalist[[1]]$coords)[[which(names(datalist[[1]]$coords) %in% .KnownLatNames())]] - - lon_name <- names(dim(datalist[[1]]$data))[[which(names(dim(datalist[[1]]$data)) %in% .KnownLonNames())]] - lat_name <- names(dim(datalist[[1]]$data))[[which(names(dim(datalist[[1]]$data)) %in% .KnownLatNames())]] + # Check if all dims equal + adims = lapply(lapply(datalist, function(x) x$data), dim) + if (!all(apply(apply(abind(adims, along = 0), 2, duplicated), 2, sum) == + (length(adims)-1))) { + stop("Input data fields must all have the same dimensions.") + } - result <- MultiEOF(exp, - lon = as.vector(datalist[[1]]$coords[[lon]]), - lat = as.vector(datalist[[1]]$coords[[lat]]), - lon_dim = lon_name, lat_dim = lat_name, - time = datalist[[1]]$attrs$Dates, minvar = minvar, + exp <- abind(lapply(datalist, '[[', 'data'), along = 0) + dim(exp) <- c(length(datalist), dim(datalist[[1]]$data)) + names(dim(exp)) <- c(var_dim, names(dim(datalist[[1]]$data))) + + lon_name <- names(datalist[[1]]$coords)[[which(names(datalist[[1]]$coords) %in% .KnownLonNames())]] + lat_name <- names(datalist[[1]]$coords)[[which(names(datalist[[1]]$coords) %in% .KnownLatNames())]] + lon <- as.vector(datalist[[1]]$coords[[lon_name]]) + lat <- as.vector(datalist[[1]]$coords[[lat_name]]) + + result <- MultiEOF(data = exp, lon = lon, lat = lat, + lon_dim = lon_dim, lat_dim = lat_dim, time_dim = time_dim, + sdate_dim = sdate_dim, var_dim = var_dim, + dates = dates, minvar = minvar, neof_max = neof_max, neof_composed = neof_composed, - lon_lim = lon_lim, lat_lim = lat_lim) - - return(result) + lon_lim = lon_lim, lat_lim = lat_lim, ncores = ncores) + names_res <- names(result[1:4]) + res <- lapply(seq_along(result)[1:4], function(i) { + coords = list(lon, lat) + names(coords) <- c(lon_dim, lat_dim) + dates <- dates + varName <- names(result)[[i]] + metadata <- lapply(datalist, function(x) x$attrs$Variable$metadata) + metadata <- unlist(metadata, recursive=FALSE) + metadata <- metadata[unique(names(metadata))] + suppressWarnings( + cube <- s2dv_cube(data = result[[i]], coords = coords, varName = varName, Dates = dates, + source_files = unlist(sapply(datalist, function(x) x$attrs$source_files)), + metadata = metadata, when = Sys.time()) + ) + return(cube) + }) + names(res) <- names_res + return(c(res, result[5:6])) } #'@rdname MultiEOF #'@title EOF analysis of multiple variables starting from an array (reduced @@ -132,24 +182,61 @@ CST_MultiEOF <- function(datalist, neof_max = 40, neof_composed = 5, #' as the \code{"exp"} element of a 's2dv_cube' object. Latitudinal #' dimension accepted names: 'lat', 'lats', 'latitude', 'y', 'j', 'nav_lat'. #' Longitudinal dimension accepted names: 'lon', 'lons','longitude', 'x', 'i', -#' 'nav_lon'. +#' 'nav_lon'. NAs can exist but it should be consistent along 'time_dim'. That +#' is, if one grid point has NAs for each variable, all the time steps at this +#' point should be NAs. #'@param lon Vector of longitudes. #'@param lat Vector of latitudes. -#'@param time Vector or matrix of dates in POSIXct format. -#'@param lon_dim String with dimension name of longitudinal coordinate. -#'@param lat_dim String with dimension name of latitudinal coordinate. -#'@param neof_composed Number of composed eofs to return in output. -#'@param minvar Minimum variance fraction to be explained in first decomposition. +#'@param dates Vector or matrix of dates in POSIXct format. +#'@param time Deprecated parameter, it has been substituted by 'dates'. It will +#' be removed in the next release. +#'@param lon_dim A character string indicating the name of the longitudinal +#' dimension. By default, it is set to 'lon'. +#'@param lat_dim A character string indicating the name of the latitudinal +#' dimension. By default, it is set to 'lat'. +#'@param time_dim A character string indicating the name of the temporal +#' dimension. By default, it is set to 'time'. +#'@param sdate_dim A character string indicating the name of the start date +#' dimension. By default, it is set to 'sdate'. +#'@param var_dim A character string indicating the name of the variable +#' dimension. By default, it is set to 'var'. #'@param neof_max Maximum number of single eofs considered in the first #' decomposition. +#'@param neof_composed Number of composed eofs to return in output. +#'@param minvar Minimum variance fraction to be explained in first decomposition. #'@param lon_lim Vector with longitudinal range limits for the calculation for #' all input variables. #'@param lat_lim Vector with latitudinal range limits for the calculation for #' all input variables. -#'@return A list with elements \code{$coeff} (an array of time-varying principal -#'component coefficients), \code{$variance} (a matrix of explained variances), -#'\code{eof_pattern} (a matrix of EOF patterns obtained by regression for each -#'variable). +#'@param ncores An integer indicating the number of cores to use for parallel +#' computation. The default value is NULL. +#'@return +#'A list containing: +#'\item{coeff}{ +#' An array of principal components with dimensions 'time_dim', 'sdate_dim', +#' number of eof, rest of the dimensions of 'data' except 'lon_dim' and +#' 'lat_dim'. +#'} +#'\item{variance}{ +#' An array of explained variances with dimensions 'eof' and the rest of the +#' dimensions of 'data' except 'time_dim', 'sdate_dim', 'lon_dim' and +#' 'lat_dim'. +#'} +#'\item{eof_pattern}{ +#' An array of EOF patterns obtained by regression with dimensions: 'eof' and +#' the rest of the dimensions of 'data' except 'time_dim' and 'sdate_dim'. +#'} +#'\item{mask}{ +#' An array of the mask with dimensions ('lon_dim', 'lat_dim', rest of the +#' dimensions of 'data' except 'time_dim'). It is made from 'data', 1 for the +#' positions that 'data' has value and NA for the positions that 'data' has NA. +#' It is used to replace NAs with 0s for EOF calculation and mask the result +#' with NAs again after the calculation. +#'} +#'\item{coordinates}{ +#' Longitudinal and latitudinal coordinates vectors. +#'} +#' #'@examples #'exp <- array(runif(1280)*280, dim = c(dataset = 2, member = 2, sdate = 3, #' ftime = 3, lat = 4, lon = 4, var = 1)) @@ -159,41 +246,133 @@ CST_MultiEOF <- function(datalist, neof_max = 40, neof_composed = 5, #' "2001-12-01", "2002-01-01", "2002-11-01", "2002-12-01", "2003-01-01") #'Dates <- as.POSIXct(dates, format = "%Y-%m-%d") #'dim(Dates) <- c(ftime = 3, sdate = 3) -#'cal <- MultiEOF(data = exp, lon = lon, lat = lat, time = Dates) +#'cal <- MultiEOF(data = exp, lon = lon, lat = lat, dates = Dates) #'@import multiApply #'@export -MultiEOF <- function(data, lon, lat, time, +MultiEOF <- function(data, lon, lat, dates, time = NULL, lon_dim = "lon", lat_dim = "lat", + time_dim = 'ftime', sdate_dim = 'sdate', var_dim = 'var', neof_max = 40, neof_composed = 5, minvar = 0.6, - lon_lim = NULL, lat_lim = NULL) { - - # Know spatial coordinates names - if (!any(lon_dim %in% .KnownLonNames()) | - !any(lat_dim %in% .KnownLatNames())) { - stop("Spatial coordinate names do not match any of the names accepted by ", - "the package.") + lon_lim = NULL, lat_lim = NULL, ncores = NULL) { + # Check inputs + # data + if (is.null(data)) { + stop("Parameter 'data' cannot be NULL.") + } + if (!is.numeric(data)) { + stop("Parameter 'data' must be a numeric array.") + } + if (any(is.null(names(dim(data))))| any(nchar(names(dim(data))) == 0)) { + stop("Parameter 'data' must have dimension names.") + } + # dates + if (!is.null(time)) { + warning("The parameter 'time' is deprecated, use 'dates' instead.") + dates <- time + } + # lon_dim + if (!is.character(lon_dim) | length(lon_dim) != 1) { + stop("Parameter 'lon_dim' must be a character string.") + } + if (!lon_dim %in% names(dim(data))) { + stop("Parameter 'lon_dim' is not found in 'data' dimension.") + } + # lat_dim + if (!is.character(lat_dim) | length(lat_dim) != 1) { + stop("Parameter 'lat_dim' must be a character string.") + } + if (!lat_dim %in% names(dim(data))) { + stop("Parameter 'lat_dim' is not found in 'data' dimension.") + } + # lon + if (!is.numeric(lon) | length(lon) != dim(data)[lon_dim]) { + stop(paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'data'.")) + } + if (any(lon > 360 | lon < -360)) { + warning("Some 'lon' is out of the range [-360, 360].") + } + # lat + if (!is.numeric(lat) | length(lat) != dim(data)[lat_dim]) { + stop(paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'data'.")) + } + if (any(lat > 90 | lat < -90)) { + stop("Parameter 'lat' must contain values within the range [-90, 90].") + } + # time_dim + if (!is.character(time_dim) | length(time_dim) != 1) { + stop("Parameter 'time_dim' must be a character string.") + } + if (!time_dim %in% names(dim(data))) { + stop("Parameter 'time_dim' is not found in 'data' dimension.") + } + # sdate_dim + if (!is.character(sdate_dim) | length(sdate_dim) != 1) { + stop("Parameter 'sdate_dim' must be a character string.") + } + if (!sdate_dim %in% names(dim(data))) { + stop("Parameter 'sdate_dim' is not found in 'data' dimension.") + } + # var_dim + if (!is.character(var_dim) | length(var_dim) != 1) { + stop("Parameter 'var_dim' must be a character string.") + } + if (!var_dim %in% names(dim(data))) { + stop("Parameter 'var_dim' is not found in 'data' dimension.") + } + # neof_max + if (!is.numeric(neof_max)) { + stop("Parameter 'neof_max' must be a positive integer.") + } + # neof_composed + if (!is.numeric(neof_composed)) { + stop("Parameter 'neof_composed' must be a positive integer.") + } + # minvar + if (!is.numeric(minvar)) { + stop("Parameter 'minvar' must be a positive number between 0 and 1.") + } + # lon_lim + if (!is.null(lon_lim)) { + if (!is.numeric(lon_lim)) { + stop("Parameter 'lon_lim' must be numeric.") + } + } + # lat_lim + if (!is.null(lat_lim)) { + if (!is.numeric(lat_lim)) { + stop("Parameter 'lat_lim' must be numeric.") + } + } + # ncores + if (!is.null(ncores)) { + if (!is.numeric(ncores) | ncores %% 1 != 0 | ncores <= 0 | + length(ncores) > 1) { + stop("Parameter 'ncores' must be a positive integer.") + } } # Reorder and group ftime and sdate together at the end in that order - cdim0 <- dim(data) - imaskt <- names(cdim0) %in% "ftime" - imasks <- names(cdim0) %in% "sdate" + imaskt <- names(dim(data)) %in% time_dim + imasks <- names(dim(data)) %in% sdate_dim data <- .aperm2(data, c(which(!(imasks | imaskt)), which(imaskt), which(imasks))) - cdim <- dim(data) + dims <- dim(data) ind <- 1:length(which(!(imaskt | imasks))) # compact (multiply) time_dim dimensions - dim(data) <- c(cdim[ind], samples = prod(cdim[-ind])) + dim(data) <- c(dims[ind], samples = prod(dims[-ind])) # Repeatedly apply .multi.eofs - result <- Apply(data, c("var", lon_dim, lat_dim, "samples"), - .multi.eofs, lon, lat, time, neof_max = neof_max, - neof_composed = neof_composed, minvar = minvar, - xlim = lon_lim, ylim = lat_lim, - lon_dim = lon_dim, lat_dim = lat_dim) + result <- Apply(data = data, + target_dims = c(var_dim, lon_dim, lat_dim, "samples"), + fun = .multi.eofs, lon = lon, lat = lat, dates = dates, + neof_max = neof_max, neof_composed = neof_composed, + minvar = minvar, xlim = lon_lim, ylim = lat_lim, + lon_dim = lon_dim, lat_dim = lat_dim, ncores = ncores) # Expand back samples to compacted dims - dim(result$coeff) <- c(cdim[-ind], dim(result$coeff)[-1]) + dim(result$coeff) <- c(dims[-ind], dim(result$coeff)[-1]) # Recover first lon and first lat list dd = dim(result[[lon_dim]])[1]; m = matrix(1, nrow = dd, ncol = length(dim(result[[lon_dim]]))); m[1:dd] = 1:dd; result[[lon_dim]] = result[[lon_dim]][m] @@ -222,7 +401,7 @@ MultiEOF <- function(data, lon, lat, time, #'variable). #'@noRd -.multi.eofs <- function(field_arr_raw, lon, lat, time, neof_max = 40, +.multi.eofs <- function(field_arr_raw, lon, lat, dates, neof_max = 40, neof_composed = 5, minvar = 0.6, xlim = NULL, ylim = NULL, lon_dim = "lon", lat_dim = "lat") { @@ -231,9 +410,14 @@ MultiEOF <- function(data, lon, lat, time, } else { lin.fit <- lm.fit } - + + # Dimensions n_field <- dim(field_arr_raw)[1] - etime <- .power.date(time) + n_lon <- dim(field_arr_raw)[2] + n_lat <- dim(field_arr_raw)[3] + nt <- dim(field_arr_raw)[4] + + etime <- .power.date(dates) field_arr <- array(dim = dim(field_arr_raw)) for (k in seq(1, n_field, 1)) { @@ -243,8 +427,33 @@ MultiEOF <- function(data, lon, lat, time, # area weighting, based on the root of cosine ww <- .area.weight(lon, lat, root = T) + # create a mask + mask_arr <- array(dim = c(n_lon, n_lat, n_field)) + for (k in seq(1, n_field, 1)) { field_orig <- field_arr[k, , , ] + + # Check if all the time steps at one grid point are NA-consistent + # The grid point should have all NAs or no NA along time dim. + if (anyNA(field_orig)) { + field_latlon <- array(field_orig, dim = c(n_lon*n_lat, nt)) # [lon*lat, time] + na_ind <- which(is.na(field_latlon), arr.ind = T) + if (dim(na_ind)[1] != nt * length(unique(na_ind[,1]))) { + stop("Detected certain grid points have NAs but not consistent across time ", + "dimension. If the grid point is NA, it should have NA at all time step.") + } + } + # Build the mask + mask <- field_orig[, , 1] + mask[!is.finite(mask)] <- NA + mask[is.finite(mask)] <- 1 + dim(mask) <- c(n_lon, n_lat) + mask_arr[,,k] <- mask + + # Replace mask of NAs with 0s for EOF analysis. + field_arr[k, , , ][!is.finite(field_orig)] <- 0 + field_orig[!is.finite(field_orig)] <- 0 + # calculate the area weight field <- sweep(field_orig, c(1, 2), ww, "*") idx <- .selbox(lon, lat, xlim, ylim) @@ -274,7 +483,7 @@ MultiEOF <- function(data, lon, lat, time, for (i in 1:reqPC) { regression[, , i] <- apply(field_orig, c(1, 2), function(x) lin.fit(as.matrix(coefficient[, i], - ncol = 1), x)$coefficients) + ncol = 1), x)$coefficients)*mask } assign(paste0("pc", k), list(coeff = coefficient, variance = variance, wcoeff = sweep(coefficient, c(2), variance, "*"), @@ -300,19 +509,20 @@ MultiEOF <- function(data, lon, lat, time, for (i in 1:neof_composed) { regression[k, , , i] <- apply(field_arr[k, , , ], c(1, 2), function(x) lin.fit(as.matrix(coefficient[, i], - ncol = 1), x)$coefficients) + ncol = 1), x)$coefficients)*mask_arr[,,k] } } - names(dim(coefficient)) <- c("time", "eof") + names(dim(coefficient)) <- c("dates", "eof") variance <- array(variance) names(dim(variance)) <- "eof" - names(dim(regression)) <- c("var", "lon", "lat", "eof") + names(dim(regression)) <- c(names(dim(field_arr_raw))[1:3], "eof") - out <- list(coeff = coefficient, variance = variance, eof_pattern = regression) + out <- list(coeff = coefficient, variance = variance, eof_pattern = regression, + mask = mask_arr) - out[[lon_dim]] <- slon - out[[lat_dim]] <- slat + out[[names(n_lon)]] <- slon + out[[names(n_lat)]] <- slat return(out) } diff --git a/R/CST_QuantileMapping.R b/R/CST_QuantileMapping.R index 92b7ac038161d037ab3b9409bf42c97dd3376aa1..cbb76c9937942d98254e625eb9c8637a26d34307 100644 --- a/R/CST_QuantileMapping.R +++ b/R/CST_QuantileMapping.R @@ -58,13 +58,11 @@ CST_QuantileMapping <- function(exp, obs, exp_cor = NULL, sdate_dim = 'sdate', ncores = NULL, ...) { # Check 's2dv_cube' if (!inherits(exp, 's2dv_cube') || !inherits(obs, 's2dv_cube')) { - stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") } if (!is.null(exp_cor)) { if (!inherits(exp_cor, 's2dv_cube')) { - stop("Parameter 'exp_cor' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'exp_cor' must be of the class 's2dv_cube'.") } } diff --git a/R/CST_RFTemp.R b/R/CST_RFTemp.R index 1bf7ecdeedab5eed1078f395e120d17d47b31997..d8c9e138df48465e7613f5d42ad1e45e9c5da515 100644 --- a/R/CST_RFTemp.R +++ b/R/CST_RFTemp.R @@ -144,7 +144,7 @@ CST_RFTemp <- function(data, oro, xlim = NULL, ylim = NULL, lapse = 6.5, #'The output grid can be irregularly spaced in lon and/or lat. #'@references Method described in ERA4CS MEDSCOPE milestone M3.2: #'High-quality climate prediction data available to WP4 here: -#'\ url{https://www.medscope-project.eu/the-project/deliverables-reports/} +#'\url{https://www.medscope-project.eu/the-project/deliverables-reports/} #'and in H2020 ECOPOTENTIAL Deliverable No. 8.1: #'High resolution (1-10 km) climate, land use and ocean change scenarios here: #'\url{https://ec.europa.eu/research/participants/documents/downloadPublic?documentIds=080166e5b6cd2324&appId=PPGMS}. diff --git a/R/CST_SaveExp.R b/R/CST_SaveExp.R index 2c363e46b1ae076a3bf50d1b2b3fd0e57f256c7b..7d5733f1f21fe3c756c85a918fd0f3790bfce7be 100644 --- a/R/CST_SaveExp.R +++ b/R/CST_SaveExp.R @@ -36,6 +36,9 @@ #' If it is NULL, the coordinate corresponding the the start date dimension or #' the first Date of each time step will be used as the name of the files. #' It is NULL by default. +#'@param drop_dims A vector of character strings indicating the dimension names +#' of length 1 that need to be dropped in order that they don't appear in the +#' netCDF file. It is NULL by default (optional). #'@param single_file A logical value indicating if all object is saved in a #' single file (TRUE) or in multiple files (FALSE). When it is FALSE, #' the array is separated for Datasets, variable and start date. It is FALSE @@ -69,10 +72,10 @@ #' #'@examples #'\dontrun{ -#'data <- lonlat_temp$exp +#'data <- lonlat_temp_st$exp #'destination <- "./" #'CST_SaveExp(data = data, destination = destination, ftime_dim = 'ftime', -#' var_dim = NULL, ftime_dim = 'ftime', var_dim = NULL) +#' var_dim = 'var', dat_dim = 'dataset') #'} #' #'@import ncdf4 @@ -83,12 +86,11 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', ftime_dim = 'time', dat_dim = 'dataset', var_dim = 'var', memb_dim = 'member', - startdates = NULL, single_file = FALSE, - extra_string = NULL) { + startdates = NULL, drop_dims = NULL, + single_file = FALSE, extra_string = NULL) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { - stop("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'data' must be of the class 's2dv_cube'.") } # Check object structure if (!all(c('data', 'attrs') %in% names(data))) { @@ -167,7 +169,8 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', startdates = startdates, dat_dim = dat_dim, sdate_dim = sdate_dim, ftime_dim = ftime_dim, var_dim = var_dim, - memb_dim = memb_dim, + memb_dim = memb_dim, + drop_dims = drop_dims, extra_string = extra_string, single_file = single_file) } @@ -217,13 +220,16 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', #'@param memb_dim A character string indicating the name of the member dimension. #' By default, it is set to 'member'. It can be NULL if there is no member #' dimension. +#'@param drop_dims A vector of character strings indicating the dimension names +#' of length 1 that need to be dropped in order that they don't appear in the +#' netCDF file. It is NULL by default (optional). #'@param single_file A logical value indicating if all object is saved in a #' unique file (TRUE) or in separated directories (FALSE). When it is FALSE, #' the array is separated for Datasets, variable and start date. It is FALSE -#' by default. +#' by default (optional). #'@param extra_string A character string to be include as part of the file name, #' for instance, to identify member or realization. It would be added to the -#' file name between underscore characters. +#' file name between underscore characters (optional). #' #'@return Multiple or single NetCDF files containing the data array.\cr #'\item{\code{single_file = TRUE}}{ @@ -247,19 +253,19 @@ CST_SaveExp <- function(data, destination = "./", sdate_dim = 'sdate', #' #'@examples #'\dontrun{ -#'data <- lonlat_temp$exp$data -#'lon <- lonlat_temp$exp$coords$lon -#'lat <- lonlat_temp$exp$coords$lat +#'data <- lonlat_temp_st$exp$data +#'lon <- lonlat_temp_st$exp$coords$lon +#'lat <- lonlat_temp_st$exp$coords$lat #'coords <- list(lon = lon, lat = lat) -#'Datasets <- lonlat_temp$exp$attrs$Datasets +#'Datasets <- lonlat_temp_st$exp$attrs$Datasets #'varname <- 'tas' -#'Dates <- lonlat_temp$exp$attrs$Dates +#'Dates <- lonlat_temp_st$exp$attrs$Dates #'destination = './' -#'metadata <- lonlat_temp$exp$attrs$Variable$metadata +#'metadata <- lonlat_temp_st$exp$attrs$Variable$metadata #'SaveExp(data = data, destination = destination, coords = coords, #' Datasets = Datasets, varname = varname, Dates = Dates, #' metadata = metadata, single_file = TRUE, ftime_dim = 'ftime', -#' var_dim = NULL) +#' var_dim = 'var', dat_dim = 'dataset') #'} #' #'@import ncdf4 @@ -271,7 +277,7 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, varname = NULL, metadata = NULL, Datasets = NULL, startdates = NULL, dat_dim = 'dataset', sdate_dim = 'sdate', ftime_dim = 'time', var_dim = 'var', memb_dim = 'member', - single_file = FALSE, extra_string = NULL) { + drop_dims = NULL, single_file = FALSE, extra_string = NULL) { ## Initial checks # data if (is.null(data)) { @@ -296,6 +302,21 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, stop("Parameter 'Dates' must have dimension names.") } } + # drop_dims + if (!is.null(drop_dims)) { + if (!is.character(drop_dims) | any(!drop_dims %in% names(dim(data)))) { + warning("Parameter 'drop_dims' must be character string containing ", + "the data dimension names to be dropped. It will not be used.") + } else if (!all(dim(data)[drop_dims] %in% 1)) { + warning("Parameter 'drop_dims' can only contain dimension names ", + "that are of length 1. It will not be used.") + } else { + data <- Subset(x = data, along = drop_dims, + indices = lapply(1:length(drop_dims), function(x) 1), + drop = 'selected') + dimnames <- names(dim(data)) + } + } # coords if (!is.null(coords)) { if (!all(names(coords) %in% dimnames)) { @@ -352,7 +373,6 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, # Spatial coordinates if (!any(dimnames %in% .KnownLonNames()) | !any(dimnames %in% .KnownLatNames())) { - warning("Spatial coordinates not found.") lon_dim <- NULL lat_dim <- NULL } else { @@ -517,7 +537,6 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, alldims <- c(dat_dim, var_dim, sdate_dim, lon_dim, lat_dim, memb_dim, ftime_dim) if (!all(dimnames %in% alldims)) { unknown_dims <- dimnames[which(!dimnames %in% alldims)] - # warning("Detected unknown dimension: ", paste(unknown_dims, collapse = ', ')) memb_dim <- c(memb_dim, unknown_dims) alldims <- c(dat_dim, var_dim, sdate_dim, lon_dim, lat_dim, memb_dim, ftime_dim) } @@ -823,7 +842,8 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (dim in names(defined_dims)) { if (dim %in% names(extra_info_dim)) { for (info_dim in names(extra_info_dim[[dim]])) { - ncatt_put(file_nc, dim, info_dim, as.character(extra_info_dim[[dim]][[info_dim]])) + add_info_dim <- paste0(extra_info_dim[[dim]][[info_dim]], collapse = ', ') + ncatt_put(file_nc, dim, info_dim, add_info_dim) } } } @@ -831,7 +851,8 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (var in names(defined_vars)) { if (var %in% names(extra_info_var)) { for (info_var in names(extra_info_var[[var]])) { - ncatt_put(file_nc, var, info_var, as.character(extra_info_var[[var]][[info_var]])) + add_info_var <- paste0(extra_info_var[[var]][[info_var]], collapse = ', ') + ncatt_put(file_nc, var, info_var, add_info_var) } } } @@ -924,14 +945,16 @@ SaveExp <- function(data, destination = "./", Dates = NULL, coords = NULL, for (dim in names(defined_dims)) { if (dim %in% names(extra_info_dim)) { for (info_dim in names(extra_info_dim[[dim]])) { - ncatt_put(file_nc, dim, info_dim, as.character(extra_info_dim[[dim]][[info_dim]])) + add_info_dim <- paste0(extra_info_dim[[dim]][[info_dim]], collapse = ', ') + ncatt_put(file_nc, dim, info_dim, add_info_dim) } } } # Additional dimension attributes if (!is.null(extra_info_var)) { for (info_var in names(extra_info_var)) { - ncatt_put(file_nc, varname, info_var, as.character(extra_info_var[[info_var]])) + add_info_var <- paste0(extra_info_var[[info_var]], collapse = ', ') + ncatt_put(file_nc, varname, info_var, add_info_var) } } diff --git a/R/CST_SplitDim.R b/R/CST_SplitDim.R index 25d610da8ffb14fae278e7bc2ba559c12464b299..71f51bab4bdc27e7567241e9758c6a0e08d07937 100644 --- a/R/CST_SplitDim.R +++ b/R/CST_SplitDim.R @@ -57,8 +57,7 @@ CST_SplitDim <- function(data, split_dim = 'time', indices = NULL, insert_ftime = NULL) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { - stop("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'data' must be of the class 's2dv_cube'.") } if (!is.null(insert_ftime)) { if (!is.numeric(insert_ftime)) { diff --git a/R/CST_Start.R b/R/CST_Start.R new file mode 100644 index 0000000000000000000000000000000000000000..722568ccbcdb75e2a027a63c3572e9ccf6b753fb --- /dev/null +++ b/R/CST_Start.R @@ -0,0 +1,47 @@ +#'CSTools data retrieval function using Start +#' +#'This function aggregates, subsets and retrieves sub-seasonal, seasonal, +#'decadal or climate projection data from NetCDF files in a local file system +#'and arranges it for easy application of the CSTools functions. It calls the +#'function \code{Start} from startR, which is an R package started at BSC with +#'the aim to develop a tool that allows the user to automatically process large +#'multidimensional distributed data sets. Then, the output is transformed into +#'`s2dv_cube` object. +#' +#'It receives any number of parameters (`...`) that are automatically forwarded +#'to the `startR::Start` function. See details in `?startR::Start`. +#' +#'@param ... Parameters that are automatically forwarded to the `startR::Start` +#' function. See details in `?startR::Start`. +#'@examples +#'\dontrun{ +#' sdates <- c('20101101', '20111101', '20121101') +#' latmin <- 44 +#' latmax <- 47 +#' lonmin <- 6 +#' lonmax <- 9 +#' data <- CST_Start(dat = path, +#' var = 'prlr', +#' ensemble = indices(1:6), +#' sdate = sdates, +#' time = 121:151, +#' latitude = values(list(latmin, latmax)), +#' longitude = values(list(lonmin, lonmax)), +#' synonims = list(longitude = c('lon', 'longitude'), +#' latitude = c('lat', 'latitude')), +#' return_vars = list(time = 'sdate', +#' longitude = NULL, latitude = NULL), +#' retrieve = FALSE) +#'} +#'\dontshow{ +#' exp <- CSTools::lonlat_temp_st$exp +#' obs <- CSTools::lonlat_temp_st$obs +#' data <- CSTools::lonlat_prec +#'} +#'@import startR +#'@export +CST_Start <- function(...) { + res <- Start(...) + res <- as.s2dv_cube(res) + return(res) +} \ No newline at end of file diff --git a/R/CST_Subset.R b/R/CST_Subset.R index 372e39812329c4cc06624b37a427086d5a971cf2..2e69c1f9fe2d7de0d2d87170f1806d20d0b9737a 100644 --- a/R/CST_Subset.R +++ b/R/CST_Subset.R @@ -137,7 +137,7 @@ CST_Subset <- function(x, along, indices, drop = FALSE, var_dim = NULL, for (variable in 1:length(names(x$attrs$Variable$metadata))) { if (any(along %in% names(dim(x$attrs$Variable$metadata[[variable]])))) { dim_along <- along[along %in% names(dim(x$attrs$Variable$metadata[[variable]]))] - index_along <- indices[[which(along == dim_along)]] + index_along <- indices[match(dim_along, along)] x$attrs$Variable$metadata[[variable]] <- .subset_with_attrs(x$attrs$Variable$metadata[[variable]], along = dim_along, indices = index_along, @@ -151,7 +151,7 @@ CST_Subset <- function(x, along, indices, drop = FALSE, var_dim = NULL, .subset_with_attrs <- function(x, ...) { args_subset <- list(...) if (is.null(dim(x)) | length(dim(x)) == 1) { - l <- x[args_subset[['indices']]] + l <- x[args_subset[['indices']][[1]]] } else { l <- ClimProjDiags::Subset(x, along = args_subset[['along']], indices = args_subset[['indices']], diff --git a/R/CST_WeatherRegimes.R b/R/CST_WeatherRegimes.R index 56783aebb44f8aaac9b282c403b7a52441e1af12..355a1d8bcb67d81ed61220a0567bf817f913b094 100644 --- a/R/CST_WeatherRegimes.R +++ b/R/CST_WeatherRegimes.R @@ -72,8 +72,7 @@ CST_WeatherRegimes <- function(data, ncenters = NULL, ncores = NULL) { # Check 's2dv_cube' if (!inherits(data, 's2dv_cube')) { - stop("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + stop("Parameter 'data' must be of the class 's2dv_cube'.") } # Check 'exp' object structure if (!all(c('data', 'coords') %in% names(data))) { diff --git a/R/PlotCombinedMap.R b/R/PlotCombinedMap.R index 7d639a49016b44752231d17458efac1324e15d1d..5c88babbb37df4486106d6a4b5e0b87aea397541 100644 --- a/R/PlotCombinedMap.R +++ b/R/PlotCombinedMap.R @@ -35,6 +35,35 @@ #' colour bar will be automatically interpolated to match the number of breaks. #' Each item in this list can be named, and the name will be used as title for #' the corresponding colour bar (equivalent to the parameter 'bar_titles'). +#'@param bar_limits Parameter from s2dv::ColorBar. Vector of two numeric values +#' with the extremes of the range of values represented in the colour bar. If +#' 'var_limits' go beyond this interval, the drawing of triangle extremes is +#' triggered at the corresponding sides, painted in 'col_inf' and 'col_sup'. +#' Either of them can be set as NA and will then take as value the +#' corresponding extreme in 'var_limits' (hence a triangle end won't be +#' triggered for these sides). Takes as default the extremes of 'brks' if +#' available, else the same values as 'var_limits'. +#'@param triangle_ends Parameter from s2dv::ColorBar. Vector of two logical +#' elements, indicating whether to force the drawing of triangle ends at each +#' of the extremes of the colour bar. This choice is automatically made from +#' the provided 'brks', 'bar_limits', 'var_limits', 'col_inf' and 'col_sup', +#' but the behaviour can be manually forced to draw or not to draw the triangle +#' ends with this parameter. If 'cols' is provided, 'col_inf' and 'col_sup' +#' will take priority over 'triangle_ends' when deciding whether to draw the +#' triangle ends or not. +#'@param col_inf Parameter from s2dv::ColorBar. Colour to fill the inferior +#' triangle end with. Useful if specifying colours manually with parameter +#' 'cols', to specify the colour and to trigger the drawing of the lower +#' extreme triangle, or if 'cols' is not specified, to replace the colour +#' automatically generated by ColorBar(). +#'@param col_sup Parameter from s2dv::ColorBar. Colour to fill the superior +#' triangle end with. Useful if specifying colours manually with parameter +#' 'cols', to specify the colour and to trigger the drawing of the upper +#' extreme triangle, or if 'cols' is not specified, to replace the colour +#' automatically generated by ColorBar(). +#'@param bar_extra_margin Parameter from s2dv::ColorBar. Extra margins to be +#' added around the colour bar, in the format c(y1, x1, y2, x2). The units are +#' margin lines. Takes rep(0, 4) by default. #'@param col_unknown_map Colour to use to paint the grid cells for which a map #' is not possible to be chosen according to 'map_select_fun' or for those #' values that go beyond 'display_range'. Takes the value 'white' by default. @@ -78,6 +107,12 @@ #' 'down', 'd', 'D', 'bottom', 'b', 'B', 'south', 's', 'S' (default)\cr #' 'right', 'r', 'R', 'east', 'e', 'E'\cr #' 'left', 'l', 'L', 'west', 'w', 'W' +#'@param return_leg A logical value indicating if the color bars information +#' should be returned by the function. If TRUE, the function doesn't plot the +#' color bars but still creates the layout with color bar areas, and the +#' arguments for GradientCatsColorBar() or ColorBar() will be returned. It is +#' convenient for users to adjust the color bars manually. The default is +#' FALSE, the color bars will be plotted directly. #'@param ... Additional parameters to be passed on to \code{PlotEquiMap}. #' #'@examples @@ -121,14 +156,15 @@ PlotCombinedMap <- function(maps, lon, lat, map_select_fun, display_range, map_dim = 'map', brks = NULL, cols = NULL, + bar_limits = NULL, triangle_ends = c(F, F), col_inf = NULL, col_sup = NULL, col_unknown_map = 'white', mask = NULL, col_mask = 'grey', dots = NULL, bar_titles = NULL, legend_scale = 1, cex_bar_titles = 1.5, - plot_margin = NULL, + plot_margin = NULL, bar_extra_margin = c(2, 0, 2, 0), fileout = NULL, width = 8, height = 5, - size_units = 'in', res = 100, drawleg = T, + size_units = 'in', res = 100, drawleg = T, return_leg = FALSE, ...) { args <- list(...) @@ -255,12 +291,16 @@ PlotCombinedMap <- function(maps, lon, lat, # Generate the desired brks and cols. Only nmap, brks, cols, bar_limits, and # bar_titles matter here because plot = F. - colorbar <- GradientCatsColorBar(nmap = dim(maps)[map_dim], + var_limits_maps <- range(maps, na.rm = TRUE) + if (is.null(bar_limits)) bar_limits <- display_range + nmap <- dim(maps)[map_dim] + colorbar <- GradientCatsColorBar(nmap = nmap, brks = brks, cols = cols, vertical = FALSE, - subsampleg = NULL, bar_limits = display_range, var_limits = NULL, - triangle_ends = NULL, plot = FALSE, draw_separators = TRUE, + subsampleg = NULL, bar_limits = bar_limits, + var_limits = var_limits_maps, + triangle_ends = triangle_ends, col_inf = col_inf, col_sup = col_sup, plot = FALSE, draw_separators = TRUE, bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, - extra_margin = c(2, 0, 2, 0)) + extra_margin = bar_extra_margin) # Check legend_scale if (!is.numeric(legend_scale)) { @@ -304,23 +344,38 @@ PlotCombinedMap <- function(maps, lon, lat, #---------------------- # Identify the most likely map #---------------------- - brks_norm <- seq(0, 1, length.out = length(colorbar$brks)) - if (is.function(map_select_fun)) { - range_width <- display_range[2] - display_range[1] + #TODO: Consider col_inf + if (!is.null(colorbar$col_inf[[1]])) { + .warning("Lower triangle is not supported now. Please contact maintainer if you have this need.") + } + if (!is.null(colorbar$col_sup[[1]])) { + + brks_norm <- vector('list', length = nmap) + range_width <- vector('list', length = nmap) + slightly_tune_val <- vector('list', length = nmap) + for (ii in 1:nmap) { + brks_norm[[ii]] <- seq(0, 1, length.out = length(colorbar$brks[[ii]]) + 1) # add one break for col_sup + slightly_tune_val[[ii]] <- brks_norm[[ii]][2] / (length(brks_norm[[ii]]) * 2) + range_width[[ii]] <- diff(range(colorbar$brks[[ii]])) + } ml_map <- apply(maps, c(lat_dim, lon_dim), function(x) { if (any(is.na(x))) { res <- NA } else { res <- which(x == map_select_fun(x)) if (length(res) > 0) { - res <- res[1] - if (map_select_fun(x) < display_range[1] || - map_select_fun(x) > display_range[2]) { + res <- res_ind <- res[1] + if (map_select_fun(x) < display_range[1] || map_select_fun(x) > display_range[2]) { res <- -0.5 } else { - res <- res + (map_select_fun(x) - display_range[1]) / range_width - if (map_select_fun(x) == display_range[1]) { - res <- res + brks_norm[2] / (length(brks_norm) * 2) + if (map_select_fun(x) > tail(colorbar$brks[[res_ind]], 1)) { # col_sup + res <- res + 1 - slightly_tune_val[[res_ind]] + } else { + res <- res + ((map_select_fun(x) - colorbar$brks[[res_ind]][1]) / + range_width[[res_ind]] * ((length(brks_norm[[res_ind]]) - 2) / (length(brks_norm[[res_ind]]) - 1))) + if (map_select_fun(x) == colorbar$brks[[res_ind]][1]) { + res <- res + slightly_tune_val[[res_ind]] + } } } } else { @@ -329,18 +384,49 @@ PlotCombinedMap <- function(maps, lon, lat, } res }) + } else { - stop("Providing 'map_select_fun' as array not implemented yet.") - ml_map <- map_select_fun + + brks_norm <- vector('list', length = nmap) + range_width <- vector('list', length = nmap) + slightly_tune_val <- vector('list', length = nmap) + for (ii in 1:nmap) { + brks_norm[[ii]] <- seq(0, 1, length.out = length(colorbar$brks[[ii]])) + slightly_tune_val[[ii]] <- brks_norm[[ii]][2] / (length(brks_norm[[ii]]) * 2) + range_width[[ii]] <- diff(range(colorbar$brks[[ii]])) + } + ml_map <- apply(maps, c(lat_dim, lon_dim), function(x) { + if (any(is.na(x))) { + res <- NA + } else { + res <- which(x == map_select_fun(x)) + if (length(res) > 0) { + res <- res_ind <- res[1] + if (map_select_fun(x) < display_range[1] || + map_select_fun(x) > display_range[2]) { + res <- -0.5 + } else { + res <- res + ((map_select_fun(x) - colorbar$brks[[res_ind]][1]) / + range_width[[res_ind]]) + if (map_select_fun(x) == colorbar$brks[[res_ind]][1]) { + res <- res + slightly_tune_val[[res_ind]] + } + } + } else { + res <- -0.5 + } + } + res + }) } - nmap <- dim(maps)[map_dim] + nlat <- length(lat) nlon <- length(lon) #---------------------- # Set latitudes from minimum to maximum #---------------------- - if (lat[1] > lat[nlat]){ + if (lat[1] > lat[nlat]) { lat <- lat[nlat:1] indices <- list(nlat:1, TRUE) ml_map <- do.call("[", c(list(x = ml_map), indices)) @@ -373,11 +459,21 @@ PlotCombinedMap <- function(maps, lon, lat, #---------------------- # Set colors and breaks and then PlotEquiMap #---------------------- - tcols <- c(col_unknown_map, colorbar$cols[[1]]) - for (k in 2:nmap) { - tcols <- append(tcols, c(col_unknown_map, colorbar$cols[[k]])) + if (!is.null(colorbar$col_sup[[1]])) { + tcols <- c(col_unknown_map, colorbar$cols[[1]], colorbar$col_sup[[1]]) + tbrks <- c(-1, brks_norm[[1]] + rep(1, each = length(brks_norm[[1]]))) + for (k in 2:nmap) { + tcols <- append(tcols, c(col_unknown_map, colorbar$cols[[k]], colorbar$col_sup[[k]])) + tbrks <- c(tbrks, brks_norm[[k]] + rep(k, each = length(brks_norm[[k]]))) + } + } else { # original code + tcols <- c(col_unknown_map, colorbar$cols[[1]]) + tbrks <- c(-1, brks_norm[[1]] + rep(1, each = length(brks_norm[[1]]))) + for (k in 2:nmap) { + tcols <- append(tcols, c(col_unknown_map, colorbar$cols[[k]])) + tbrks <- c(tbrks, brks_norm[[k]] + rep(k, each = length(brks_norm[[k]]))) + } } - tbrks <- c(-1, brks_norm + rep(1:nmap, each = length(brks_norm))) if (is.null(plot_margin)) { plot_margin <- c(5, 4, 4, 2) + 0.1 # default of par()$mar @@ -430,16 +526,35 @@ PlotCombinedMap <- function(maps, lon, lat, par(mar = old_mar) } - if (drawleg) { - GradientCatsColorBar(nmap = dim(maps)[map_dim], + if (drawleg & !return_leg) { + GradientCatsColorBar(nmap = dim(maps)[map_dim], brks = colorbar$brks, cols = colorbar$cols, vertical = FALSE, - subsampleg = NULL, bar_limits = display_range, var_limits = NULL, - triangle_ends = NULL, plot = TRUE, draw_separators = TRUE, + subsampleg = NULL, bar_limits = bar_limits, + var_limits = var_limits_maps, + triangle_ends = triangle_ends, col_inf = colorbar$col_inf, col_sup = colorbar$col_sup, + plot = TRUE, draw_separators = TRUE, bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, - extra_margin = c(2, 0, 2, 0)) + extra_margin = bar_extra_margin) } - - # If the graphic was saved to file, close the connection with the device - if (!is.null(fileout)) dev.off() + + if (!return_leg) { + # If the graphic was saved to file, close the connection with the device + if (!is.null(fileout)) dev.off() + } + + if (return_leg) { + tmp <- list(nmap = dim(maps)[map_dim], + brks = colorbar$brks, cols = colorbar$cols, vertical = FALSE, + subsampleg = NULL, bar_limits = bar_limits, + var_limits = var_limits_maps, + triangle_ends = triangle_ends, col_inf = colorbar$col_inf, col_sup = colorbar$col_sup, + plot = TRUE, draw_separators = TRUE, + bar_titles = bar_titles, title_scale = cex_bar_titles, label_scale = legend_scale * 1.5, + extra_margin = bar_extra_margin) + .warning("The device is not off yet. Use dev.off() after plotting the color bars.") + return(tmp) + #NOTE: The device is not off! Can keep plotting the color bars. + } + } diff --git a/R/PlotForecastPDF.R b/R/PlotForecastPDF.R index 7143294472db2653fff3ca08d4cbc08a07b0a8a5..086880954d81e11f1e5679a9b53dd516971a2978 100644 --- a/R/PlotForecastPDF.R +++ b/R/PlotForecastPDF.R @@ -441,7 +441,9 @@ PlotForecastPDF <- function(fcst, tercile.limits, extreme.limits = NULL, obs = N panel.border = element_rect(fill = NA, color = "black"), strip.background = element_rect(colour = "black", fill = "gray80"), panel.spacing = unit(0.2, "in"), - panel.grid.major.x = element_line(color = "grey93")) + + panel.grid.major.x = element_line(color = "grey93"), + panel.background = element_rect(fill = "white"), + plot.background = element_rect(fill = "white", color = NA)) + guides(fill = guide_legend(order = 1), color = guide_legend(order = 2), shape = guide_legend(order = 3, label = F), diff --git a/R/PlotPDFsOLE.R b/R/PlotPDFsOLE.R index bf95abb76c745410447d0cdf59c22f34b2509231..2d1447defbcbb9d1b71b14d5f92b02f645b0d6f0 100644 --- a/R/PlotPDFsOLE.R +++ b/R/PlotPDFsOLE.R @@ -1,7 +1,7 @@ #'Plotting two probability density gaussian functions and the optimal linear #'estimation (OLE) as result of combining them. #' -#'@author Eroteida Sanchez-Garcia - AEMET, //email{esanchezg@aemet.es} +#'@author Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es} #' #'@description This function plots two probability density gaussian functions #'and the optimal linear estimation (OLE) as result of combining them. diff --git a/R/PlotWeeklyClim.R b/R/PlotWeeklyClim.R index 6f103d9641ca7f02d19f853dfabd4bfbc0587408..48e713287c5b542aa302d0e9b097b58c39613f33 100644 --- a/R/PlotWeeklyClim.R +++ b/R/PlotWeeklyClim.R @@ -3,24 +3,45 @@ #'@description This function plots the observed weekly means and climatology of #'a timeseries data using ggplot package. It compares the weekly climatology in #'a specified period (reference period) to the observed conditions during the -#'target period analyzed in the case study (included in the reference period). +#'target period analyzed in the case study. #' #'@param data A multidimensional array with named dimensions with at least sdate #' and time dimensions containing observed daily data. It can also be a -#' dataframe with computed percentiles as input for ggplot. The target year -#' must be included in the input data. -#'@param first_date The first date of the target period of timeseries. It can be -#' of class 'Date', 'POSIXct' or a character string in the format 'yyyy-mm-dd'. -#' It must be a date included in the reference period. -#'@param ref_period_ini A numeric value indicating the first year of the -#' reference period. -#'@param ref_period_end A numeric value indicating the last year of the -#' reference period. +#' dataframe with computed percentiles as input for ggplot. If it's a +#' dataframe, it must contain the following column names: 'week', 'clim', +#' 'p10', 'p90', 'p33', 'p66', 'week_mean', 'day' and 'data'. +#'@param first_date The first date of the observed values of timeseries. It can +#' be of class 'Date', 'POSIXct' or a character string in the format +#' 'yyyy-mm-dd'. If parameter 'data_years' is not provided, it must be a date +#' included in the reference period. +#'@param last_date Optional parameter indicating the last date of the target +#' period of the daily timeseries. It can be of class 'Date', 'POSIXct' or a +#' character string in the format 'yyyy-mm-dd'. If it is NULL, the last date of +#' the daily timeseries will be set as the last date of 'data'. As the data is +#' plotted by weeks, only full groups of 7 days will be plotted. If the last +#' date of the timeseries is not a multiple of 7 days, the last week will +#' not be plotted. +#'@param ref_period A vector of numeric values indicating the years of the +#' reference period. If parameter 'data_years' is not specified, it must +#' be of the same length of dimension 'sdate_dim' of parameter 'data'. +#'@param data_years A vector of numeric values indicating the years of the +#' data. It must be of the same length of dimension 'sdate_dim' of parameter +#' 'data'. It is optional, if not specified, all the years will be used as the +#' target period. #'@param time_dim A character string indicating the daily time dimension name. #' The default value is 'time'. #'@param sdate_dim A character string indicating the start year dimension name. #' The default value is 'sdate'. -#'@param title The text for the top title of the plot. +#'@param ylim A numeric vector of length two providing limits of the scale. +#' Use NA to refer to the existing minimum or maximum. For more information, +#' see 'ggplot2' documentation of 'scale_y_continuous' parameter. +#'@param title The text for the top title of the plot. It is NULL by default. +#'@param subtitle The text for the subtitle of the plot. It is NULL bu default. +#'@param ytitle Character string to be drawn as y-axis title. It is NULL by +#' default. +#'@param legend A logical value indicating whether a legend should be included +#' in the plot. If it is TRUE or NA, the legend will be included. If it is +#' FALSE, the legend will not be included. It is TRUE by default. #'@param palette A palette name from the R Color Brewer’s package. The default #' value is 'Blues'. #'@param fileout A character string indicating the file name where to save the @@ -40,10 +61,13 @@ #'@return A ggplot object containing the plot. #' #'@examples -#'data <- array(rnorm(49*20, 274, 7), dim = c(time = 49, sdate = 20)) -#'PlotWeeklyClim(data = data, first_date = '2010-08-09', -#' ref_period_ini = 1998, -#' ref_period_end = 2020) +#'data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) +#'PlotWeeklyClim(data = data, first_date = '2002-08-09', +#' last_date = '2002-09-15', ref_period = 2010:2019, +#' data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', +#' title = "Observed weekly means and climatology", +#' subtitle = "Target years: 2010 to 2019", +#' ytitle = paste0('tas', " (", "deg.C", ")")) #' #'@import multiApply #'@import lubridate @@ -53,13 +77,14 @@ #'@importFrom ClimProjDiags Subset #'@importFrom s2dv MeanDims #'@export -PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, - time_dim = 'time', sdate_dim = 'sdate', - title = "Observed weekly means and climatology", - palette = "Blues", fileout = NULL, - device = NULL, width = 8, height = 6, - units = 'in', dpi = 300) { - # Check input arguments +PlotWeeklyClim <- function(data, first_date, ref_period, last_date = NULL, + data_years = NULL, time_dim = 'time', + sdate_dim = 'sdate', ylim = NULL, + title = NULL, subtitle = NULL, + ytitle = NULL, legend = TRUE, + palette = "Blues", fileout = NULL, device = NULL, + width = 8, height = 6, units = 'in', dpi = 300) { + ## Check input arguments # data if (is.array(data)) { if (is.null(names(dim(data)))) { @@ -99,9 +124,18 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, "A dimension of length 1 has been added.")) data <- InsertDim(data, 1, lendim = 1, name = sdate_dim) } - # ref_period_ini and ref_period_end - if (!is.numeric(ref_period_ini) | !is.numeric(ref_period_end)) { - stop("Parameters 'ref_period_ini' and 'ref_period_end' must be numeric.") + # legend + if (!is.logical(legend)) { + stop("Parameter 'legend' must be a logical value.") + } + if (is.na(legend)) { + legend <- TRUE + } else if (legend) { + legend <- NA + } + # ref_period (1) + if (!is.numeric(ref_period)) { + stop("Parameter 'ref_period' must be numeric.") } # first_date if ((!inherits(first_date, "POSIXct") & !inherits(first_date, "Date")) && @@ -112,19 +146,88 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, } first_date <- ymd(first_date) target_year <- year(first_date) - if (target_year < ref_period_ini | target_year > ref_period_end) { - stop("Parameter 'first_date' must be a date included in the reference period.") + taget_year_outside_reference <- FALSE + # data_years + if (!is.null(data_years)) { + if (!is.numeric(data_years)) { + stop("Parameter 'data_years' must be numeric.") + } + if (length(data_years) != dim(data)[sdate_dim]) { + stop(paste0("Parameter 'data_years' must have the same length as ", + "the dimension '", sdate_dim, "' of 'data'.")) + } + if (!all(ref_period %in% data_years)) { + stop(paste0("The 'ref_period' must be included in the 'data_years' ", + "period.")) + } + if (!any(target_year %in% data_years)) { + stop(paste0("Parameter 'first_date' must be a date included ", + "in the 'data_years' period.")) + } + taget_year_outside_reference <- TRUE + } else { + # ref_period (2) + if (length(ref_period) != dim(data)[sdate_dim]) { + stop(paste0("Parameter 'ref_period' must have the same length as the ", + "dimension '", sdate_dim ,"' of 'data' if ", + "'data_years' is not provided.")) + } + if (!any(target_year %in% ref_period)) { + stop(paste0("If parameter 'data_years' is NULL, parameter 'first_date' ", + "must be a date included in the 'ref_period' period.")) + } + data_years <- ref_period + } + # last_date + if (!is.null(last_date)) { + if ((!inherits(last_date, "POSIXct") & !inherits(last_date, "Date")) && + (!is.character(last_date) | nchar(last_date) != 10)) { + stop(paste0("Parameter 'last_date' must be a character string ", + "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", + "or 'Dates' class.")) + } + last_date <- ymd(last_date) + dates <- seq(first_date, last_date, by = "1 day") + if (length(dates) > dim(data)[time_dim]) { + warning(paste0("Parameter 'last_date' is greater than the last date ", + "of 'data'. The last date of 'data' will be used.")) + dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") + } + } else { + dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") + } + # ylim + if (is.character(ylim)) { + warning("Parameter 'ylim' can't be a character string, it will not be used.") + ylim <- NULL } - # Dates creation - dates <- seq(first_date, first_date + days(dim(data)[time_dim]-1), by = "1 day") index_first_date <- which(dates == first_date) index_last_date <- length(dates) - (length(dates) %% 7) last_date <- dates[index_last_date] - # Weekly aggregations + ## Data preparation + # subset time_dim for weeks data_subset <- Subset(data, along = time_dim, indices = index_first_date:index_last_date) + + # remove other dimensions + dims_subset <- names(dim(data_subset))[which(!names(dim(data_subset)) %in% c(time_dim, sdate_dim))] + if (!identical(dims_subset, character(0))) { + data_subset <- Subset(data_subset, dims_subset, as.list(rep(1, length(dims_subset))), drop = TRUE) + } + # observed daily data creation + daily <- Subset(data_subset, along = sdate_dim, + indices = which(data_years == target_year), + drop = TRUE) + if (taget_year_outside_reference) { + indexes_reference_period <- which(data_years %in% ref_period) + # remove values outside reference period for computing the means + data_subset <- Subset(data_subset, along = sdate_dim, + indices = indexes_reference_period) + } + + ## Weekly aggregations for reference period weekly_aggre <- SplitDim(data_subset, split_dim = time_dim, indices = sort(rep(1:(length(index_first_date:index_last_date)/7), 7)), new_dim_name = 'week') @@ -148,16 +251,7 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, p66 = as.vector(weekly_p66), week = 1:(length(index_first_date:index_last_date)/7)) - daily <- Subset(data_subset, along = sdate_dim, - indices = which(ref_period_ini:ref_period_end == target_year), - drop = TRUE) - - dims_subset <- names(dim(daily))[which(!names(dim(daily)) %in% c(time_dim, sdate_dim))] - - if (!identical(dims_subset, character(0))) { - daily <- Subset(daily, dims_subset, as.list(rep(1, length(dims_subset))), drop = TRUE) - } - + ## Prepare observations from target year daily_data <- data.frame(day = seq(first_date, last_date, by = "1 day"), data = daily, week = sort(rep(1:(length(index_first_date:index_last_date)/7), 7))) @@ -169,25 +263,25 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, all <- data } - # Create a ggplot object + ## Create a ggplot object cols <- colorRampPalette(brewer.pal(9, palette))(6) p <- ggplot(all, aes(x = day)) + geom_ribbon(aes(ymin = p10, ymax = p90, group = week, fill = "p10-p90"), - alpha = 0.7) + # extremes clim + alpha = 0.7, show.legend = legend) + # extremes clim geom_ribbon(aes(ymin = p33, ymax = p66, group = week, fill = "p33-p66"), - alpha = 0.7) + # terciles clim + alpha = 0.7, show.legend = legend) + # terciles clim geom_line(aes(y = clim, group = week, color = "climatological mean", linetype = "climatological mean"), - alpha = 1.0, size = 0.7) + # mean clim + alpha = 1.0, size = 0.7, show.legend = legend) + # mean clim geom_line(aes(y = data, color = "observed daily mean", linetype = "observed daily mean"), - alpha = 1, size = 0.2) + # daily evolution + alpha = 1, size = 0.2, show.legend = legend) + # daily evolution geom_line(aes(y = week_mean, group = week, color = "observed weekly mean", linetype = "observed weekly mean"), - alpha = 1, size = 0.7) + # weekly evolution - theme_bw() + ylab(paste0('tas', " (", "deg.C", ")")) + xlab(NULL) + - ggtitle(title) + + alpha = 1, size = 0.7, show.legend = legend) + # weekly evolution + theme_bw() + ylab(ytitle) + xlab(NULL) + + ggtitle(title, subtitle = subtitle) + scale_x_date(breaks = seq(min(all$day), max(all$day), by = "7 days"), minor_breaks = NULL, expand = c(0.03, 0.03), labels = date_format("%d %b %Y")) + @@ -206,7 +300,8 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, "observed daily mean" = "dashed", "observed weekly mean" = "solid"), guide = guide_legend(override.aes = list(lwd = c(0.7, 0.2, 0.7)))) + - guides(fill = guide_legend(order = 1)) + guides(fill = guide_legend(order = 1)) + + scale_y_continuous(limits = ylim) # Return the ggplot object if (is.null(fileout)) { @@ -215,17 +310,4 @@ PlotWeeklyClim <- function(data, first_date, ref_period_ini, ref_period_end, ggsave(filename = fileout, plot = p, device = device, height = height, width = width, units = units, dpi = dpi) } -} - - - - - - - - - - - - - \ No newline at end of file +} \ No newline at end of file diff --git a/R/Predictability.R b/R/Predictability.R index 680666df92b5c779e79c7488f5d6906672f88eb3..d43a20a02eeb2579c44f5e069db7c721f2f81ae3 100644 --- a/R/Predictability.R +++ b/R/Predictability.R @@ -29,21 +29,22 @@ #'@param ncores The number of cores to use in parallel computation. #' #'@return A list of length 2: -#' \itemize{ -#' \item\code{pred.dim} {a list of two lists 'qdim' and 'pos.d'. The 'qdim' list -#'contains values of local dimension 'dim' divided by terciles: -#'d1: lower tercile (high predictability), -#'d2: middle tercile, -#'d3: higher tercile (low predictability) -#'The 'pos.d' list contains the position of each tercile in parameter 'dim'} -#' -#' \item\code{pred.theta} {a list of two lists 'qtheta' and 'pos.t'. -#'The 'qtheta' list contains values of the inverse of persistence 'theta' -#'divided by terciles: -#'th1: lower tercile (high predictability), -#'th2: middle tercile, -#'th3: higher tercile (low predictability) -#'The 'pos.t' list contains the position of each tercile in parameter 'theta'} +#'\itemize{ +#' \item{'pred.dim', a list of two lists 'qdim' and 'pos.d'. The 'qdim' list +#' contains values of local dimension 'dim' divided by terciles: +#' d1: lower tercile (high predictability), +#' d2: middle tercile, +#' d3: higher tercile (low predictability) +#' The 'pos.d' list contains the position of each tercile in parameter +#' 'dim'.} +#'\item{'pred.theta', a list of two lists 'qtheta' and 'pos.t'. +#' The 'qtheta' list contains values of the inverse of persistence 'theta' +#' divided by terciles: +#' th1: lower tercile (high predictability), +#' th2: middle tercile, +#' th3: higher tercile (low predictability) +#' The 'pos.t' list contains the position of each tercile in parameter +#' 'theta'.} #'} #'@return dyn_scores values from 0 to 1. A dyn_score of 1 indicates the highest #'predictability. diff --git a/R/as.s2dv_cube.R b/R/as.s2dv_cube.R index 75d6a6da8fbed42cda36f42af09af68c1d1c69b1..f81766ecdf376b340094ab19ceeaa2fa54b2cb5c 100644 --- a/R/as.s2dv_cube.R +++ b/R/as.s2dv_cube.R @@ -51,7 +51,7 @@ #' } #'} #' -#'@seealso \code{\link{s2dv_cube}}, \code{\link[s2dv]{Load}}, +#'@seealso \code{\link{s2dv_cube}}, \code{\link{CST_Start}}, #'\code{\link[startR]{Start}} and \code{\link{CST_Load}} #'@examples #'\dontrun{ diff --git a/R/print.s2dv_cube.R b/R/print.s2dv_cube.R new file mode 100644 index 0000000000000000000000000000000000000000..4fece519a27d8be1d2a7213631d66617c4de4e7a --- /dev/null +++ b/R/print.s2dv_cube.R @@ -0,0 +1,151 @@ +#'Print method for s2dv_cube objects +#' +#'This is an S3 method of the generic 'print' for the class 's2dv_cube'. When +#'you will call 'print' on an 's2dv_cube' object, this method will display the +#'content of the object in a clear and informative way. +#' +#'The object will be displayed following 's2dv_cube' class conventions. The +#'top-level elements are: 'Data', a multidimensional array containing the +#'object's data; 'Dimensions', the dimensions of the array; 'Coordinates', the +#'array coordinates that match its dimensions, explicit coordinates have an +#'asterisk (*) at the beginning while index coordinates do not; and +#''Attributes', which contains all the metadata of the object. For more +#'information about the 's2dv_cube', see \code{s2dv_cube()} and +#'\code{as.s2dv_cube()} functions. +#' +#'@param x An 's2dv_cube' object. +#'@param ... Additional arguments of print function. +#' +#'@export +print.s2dv_cube <- function(x, ...) { + if (is.atomic(x)) { + cat(x, "\n") + } else { + cat("'s2dv_cube'\n") + cat("Data ", "[" , paste0(x$data[1:8], collapse = ", "), '...', "]", "\n") + cat("Dimensions ", "(", paste(names(x$dims), x$dims, sep = " = ", collapse = ', '), ")", "\n") + cat("Coordinates \n") + for (coord in names(x$coords)) { + if (!is.null(attr(x$coords[[coord]], 'indices'))) { + if (attr(x$coords[[coord]], 'indices')) { + cat(" ", coord, ":", paste(x$coords[[coord]], collapse = ", "), "\n") + } else { + cat(" *", coord, ":", paste(x$coords[[coord]], collapse = ", "), "\n") + } + } else { + cat(" *", coord, ":", paste(x$coords[[coord]], collapse = ", "), "\n") + } + } + cat("Attributes \n") + for (attr_name in names(x$attrs)) { + if (attr_name == "Variable") { + cat(" ", "varName :", x$attrs$Variable$varName, "\n") + cat(" ", "metadata : ", "\n") + for (metadata_i in names(x$attrs$Variable$metadata)) { + cat(" ", " ", metadata_i, "\n") + .print_metadata(x$attrs$Variable$metadata[[metadata_i]]) + } + } else { + cat(" ", attr_name, " : ") + .print_beginning(x = x$attrs[[attr_name]], name = attr_name) + } + } + } + +} + +## Auxiliary function for the print method +.print_beginning <- function(x, name, n = 5, j = 1) { + if (inherits(x, 'numeric') | inherits(x, 'POSIXct') | inherits(x, 'Date')) { + if (length(x) <= n) { + cat(as.character(x), "\n") + } else { + cat(paste0(as.character(x[seq_len(n)])), "...", "\n") + } + } else if (name == "time_bounds") { + cat("\n") + for (param in names(x)) { + cat(" ", "(", param,")", " : ") + if (length(x[[param]]) <= n) { + cat(as.character(x[[param]]), "\n") + } else { + cat(paste0(as.character(x[[param]][seq_len(n)])), "...", "\n") + } + } + } else if (inherits(x, 'list')) { + cat("\n") + k = 1 + for (param in names(x)) { + k = k + 1 + param_i <- x[[param]] + if (!is.null(param_i)) { + param_i <- lapply(param_i, function(x) {if (length(x[[1]]) > 1) { + x[[1]] <- paste0(x[[1]][1],' ...') + } else { + x + }}) + cat(" ", "(", param,")", " : ") + cat(paste0(names(unlist(param_i)), " = ", unlist(param_i), collapse = ', '), "\n") + } else { + j = j + 1 + } + if (k > j) { + cat(" ", "...", "\n") + break + } + } + } else { + if (length(x) > 1) { + cat(x[[1]], "...", "\n") + } else { + cat(x[[1]], "\n") + } + } +} + +## Auxiliary function for the print method +.print_metadata <- function(x) { + if (inherits(x, 'list')) { + info_names <- NULL + for (info_i in names(x)) { + if (info_i == 'units') { + cat(" ", " ", " units :", x[[info_i]], "\n") + } else if (info_i %in% c('longname', 'long_name')) { + cat(" ", " ", " long name :", x[[info_i]], "\n") + } else { + info_names <- c(info_names, info_i) + } + } + cat(" ", " ", " other :", paste0(info_names, collapse = ', '), "\n") + } else if (!is.null(attributes(x))) { + if ('variables' %in% names(attributes(x))) { + info_names <- NULL + attrs <- attributes(x)[['variables']] + for (attrs_i in names(attrs)) { + for (info_i in names(attrs[[attrs_i]])) { + if (!inherits(attrs[[attrs_i]][[info_i]], 'list')) { + if (info_i == 'units') { + cat(" ", " ", " units :", attrs[[attrs_i]][[info_i]], "\n") + } else if (info_i %in% c('longname', 'long_name')) { + cat(" ", " ", " long name :", attrs[[attrs_i]][[info_i]], "\n") + } else { + info_names <- c(info_names, info_i) + } + } + } + } + cat(" ", " ", " other :", paste0(info_names, collapse = ', '), "\n") + } else { + attrs <- attributes(x) + info_names <- NULL + for (info_i in names(attrs)) { + if (info_i == 'cdo_grid_name') { + cat(" ", " ", " cdo_grid_name :", attrs[[info_i]], "\n") + } else { + info_names <- c(info_names, info_i) + } + } + cat(" ", " ", " other :", paste0(info_names, collapse = ', '), "\n") + } + } +} \ No newline at end of file diff --git a/R/s2dv_cube.R b/R/s2dv_cube.R index f4e5be6689bc9f86cc4b55d4e37cf08bbc8b127b..6bf86a8cf406d9d44fe16424902b7cd9bfd1be60 100644 --- a/R/s2dv_cube.R +++ b/R/s2dv_cube.R @@ -2,7 +2,7 @@ #' #'@description This function allows to create an 's2dv_cube' object by passing #'information through its parameters. This function will be needed if the data -#'hasn't been loaded using CST_Load or has been transformed with other methods. +#'hasn't been loaded using CST_Start or has been transformed with other methods. #'An 's2dv_cube' object has many different components including metadata. This #'function will allow to create 's2dv_cube' objects even if not all elements #'are defined and for each expected missed parameter a warning message will be @@ -11,7 +11,7 @@ #'@author Perez-Zanon Nuria, \email{nuria.perez@bsc.es} #' #'@param data A multidimensional array with named dimensions, typically with -#' dimensions: dataset, member, sdate, ftime, lat and lon. +#' dimensions: dataset, member, sdate, time, lat and lon. #'@param coords A list of named vectors with the coordinates corresponding to #' the dimensions of the data parameter. If any coordinate has dimensions, they #' will be set as NULL. If any coordinate is not provided, it is set as an @@ -65,7 +65,7 @@ #' } #'} #' -#'@seealso \code{\link[s2dv]{Load}} and \code{\link{CST_Load}} +#'@seealso \code{\link[s2dv]{Load}} and \code{\link{CST_Start}} #'@examples #'exp_original <- 1:100 #'dim(exp_original) <- c(lat = 2, time = 10, lon = 5) diff --git a/R/sample_data_st.R b/R/sample_data_st.R new file mode 100644 index 0000000000000000000000000000000000000000..cd33ee069d270640c08a27c0a8dadb4b2fb4c0b2 --- /dev/null +++ b/R/sample_data_st.R @@ -0,0 +1,143 @@ +#'Sample Of Experimental And Observational Climate Data In Function Of Longitudes And Latitudes with Start +#' +#'This sample data set contains gridded seasonal forecast and corresponding +#'observational data from the Copernicus Climate Change ECMWF-System 5 forecast +#'system, and from the Copernicus Climate Change ERA-5 reconstruction. +#'Specifically, for the 'tas' (2-meter temperature) variable, for the 15 first +#'forecast ensemble members, monthly averaged, for the 3 first forecast time +#'steps (lead months 1 to 4) of the November start dates of 2000 to 2005, for +#'the Mediterranean region (27N-48N, 12W-40E). The data was generated on (or +#'interpolated onto, for the reconstruction) a rectangular regular grid of size +#'360 by 181. +#' +#'The `CST_Start` call used to generate the data set in the infrastructure of +#'the Earth Sciences Department of the Barcelona Supercomputing Center is shown +#'next. Note that `CST_Start` internally calls `startR::Start` and then uses +#'`as.s2dv_cube` that converts the `startR_array` into `s2dv_cube`. +#'\preformatted{ +#' lonlat_temp_st <- NULL +#' repos_exp <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', +#' '$var$_f6h/$var$_$sdate$.nc') +#' sdates <- sapply(2000:2005, function(x) paste0(x, '1101')) +#' lonmax <- 40 +#' lonmin <- -12 +#' latmax <- 48 +#' latmin <- 27 +#' lonlat_temp_st$exp <- CST_Start(dataset = repos_exp, +#' var = 'tas', +#' member = indices(1:15), +#' sdate = sdates, +#' ftime = indices(1:3), +#' lat = values(list(latmin, latmax)), +#' lat_reorder = Sort(decreasing = TRUE), +#' lon = values(list(lonmin, lonmax)), +#' lon_reorder = CircularSort(0, 360), +#' synonims = list(lon = c('lon', 'longitude'), +#' lat = c('lat', 'latitude'), +#' member = c('member', 'ensemble'), +#' ftime = c('ftime', 'time')), +#' return_vars = list(lat = NULL, +#' lon = NULL, ftime = 'sdate'), +#' retrieve = TRUE) +#' +#' dates <- c(paste0(2000, c(11, 12)), paste0(2001, c('01', 11, 12)), +#' paste0(2002, c('01', 11, 12)), paste0(2003, c('01', 11, 12)), +#' paste0(2004, c('01', 11, 12)), paste0(2005, c('01', 11, 12)), 200601) +#' dates <- sapply(dates, function(x) {paste0(x, '01')}) +#' dates <- as.POSIXct(dates, format = '%Y%m%d', 'UTC') +#' dim(dates) <- c(ftime = 3, sdate = 6) +#' +#' dates <- t(dates) +#' names(dim(dates)) <- c('sdate', 'ftime') +#' +#' path.obs <- '/esarchive/recon/ecmwf/era5/monthly_mean/$var$_f1h-r1440x721cds/$var$_$date$.nc' +#' lonlat_temp_st$obs <- CST_Start(dataset = path.obs, +#' var = 'tas', +#' date = unique(format(dates, '%Y%m')), +#' ftime = values(dates), +#' ftime_across = 'date', +#' ftime_var = 'ftime', +#' merge_across_dims = TRUE, +#' split_multiselected_dims = TRUE, +#' lat = values(list(latmin, latmax)), +#' lat_reorder = Sort(decreasing = TRUE), +#' lon = values(list(lonmin, lonmax)), +#' lon_reorder = CircularSort(0, 360), +#' synonims = list(lon = c('lon', 'longitude'), +#' lat = c('lat', 'latitude'), +#' ftime = c('ftime', 'time')), +#' transform = CDORemapper, +#' transform_extra_cells = 2, +#' transform_params = list(grid = 'r360x181', +#' method = 'conservative'), +#' transform_vars = c('lat', 'lon'), +#' return_vars = list(lon = NULL, +#' lat = NULL, +#' ftime = 'date'), +#' retrieve = TRUE) +#' +#' library(lubridate) +#' dates_exp <- lonlat_temp_st$exp$attrs$Dates +#' lonlat_temp_st$exp$attrs$Dates <- floor_date(ymd_hms(dates_exp), unit = "months") +#' dim(lonlat_temp_st$exp$attrs$Dates) <- dim(dates_exp) +#' +#' dates_obs <- lonlat_temp_st$obs$attrs$Dates +#' lonlat_temp_st$obs$attrs$Dates <- floor_date(ymd_hms(dates_obs), unit = "months") +#' dim(lonlat_temp_st$obs$attrs$Dates) <- dim(dates_obs) +#' +#'} +#' +#'@name lonlat_temp_st +#'@docType data +#'@author Nicolau Manubens \email{nicolau.manubens@bsc.es} +#'@keywords data +NULL + +#'Sample Of Experimental Precipitation Data In Function Of Longitudes And Latitudes with Start +#' +#'This sample data set contains a small cutout of gridded seasonal precipitation +#'forecast data from the Copernicus Climate Change ECMWF-System 5 forecast +#'system, to be used to demonstrate downscaling. Specifically, for the 'pr' +#'(precipitation) variable, for the first 6 forecast ensemble members, daily +#'values, for all 31 days in March following the forecast starting dates in +#'November of years 2010 to 2012, for a small 4x4 pixel cutout in a region in +#'the North-Western Italian Alps (44N-47N, 6E-9E). The data resolution is 1 +#'degree. +#' +#'The `CST_Start` call used to generate the data set in the infrastructure of +#'the Marconi machine at CINECA is shown next, working on files which were +#'extracted from forecast data available in the MEDSCOPE internal archive. +#' +#'\preformatted{ +#' path <- paste0('/esarchive/exp/ecmwf/system5c3s/daily_mean/', +#' '$var$_s0-24h/$var$_$sdate$.nc') +#' sdates = c('20101101', '20111101', '20121101') +#' latmin <- 44 +#' latmax <- 47 +#' lonmin <- 6 +#' lonmax <- 9 +#' +#' lonlat_prec_st <- CST_Start(dataset = path, +#' var = 'prlr', +#' member = indices(1:6), +#' sdate = sdates, +#' ftime = 121:151, +#' lat = values(list(latmin, latmax)), +#' lat_reorder = Sort(decreasing = TRUE), +#' lon = values(list(lonmin, lonmax)), +#' lon_reorder = CircularSort(0, 360), +#' synonims = list(lon = c('lon', 'longitude'), +#' lat = c('lat', 'latitude'), +#' ftime = c('time', 'ftime'), +#' member = c('member', 'ensemble')), +#' return_vars = list(ftime = 'sdate', +#' lon = NULL, lat = NULL), +#' retrieve = TRUE) +#'} +#' +#'@name lonlat_prec_st +#'@docType data +#'@author Jost von Hardenberg \email{j.vonhardenberg@isac.cnr.it} +#'@author An-Chi Ho \email{an.ho@bsc.es} +#'@keywords data +NULL diff --git a/R/zzz.R b/R/zzz.R index b0c8b259b6434bbc11ad9c3d99a30bb22ae8b319..b181d75845acb8fa4780e58e0213449924fcffb1 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -83,26 +83,46 @@ #categories, and each category has different color set. GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE, subsampleg = NULL, bar_limits, var_limits = NULL, - triangle_ends = NULL, plot = TRUE, + triangle_ends = NULL, col_inf = NULL, col_sup = NULL, plot = TRUE, draw_separators = FALSE, bar_titles = NULL, title_scale = 1, label_scale = 1, extra_margin = rep(0, 4), ...) { - # bar_limits - if (!is.numeric(bar_limits) || length(bar_limits) != 2) { - stop("Parameter 'bar_limits' must be a numeric vector of length 2.") - } + # bar_limits: a vector of 2 or a list + if (!is.list(bar_limits)) { + if (!is.numeric(bar_limits) || length(bar_limits) != 2) { + stop("Parameter 'bar_limits' must be a numeric vector of length 2 or a list containing that.") + } + # turn into list + bar_limits <- rep(list(bar_limits), nmap) + } else { + if (any(!sapply(bar_limits, is.numeric)) || any(sapply(bar_limits, length) != 2)) { + stop("Parameter 'bar_limits' must be a numeric vector of length 2 or a list containing that.") + } + if (length(bar_limits) != nmap) { + stop("Parameter 'bar_limits' must have the length of 'nmap'.") + } + } # Check brks - if (is.null(brks) || (is.numeric(brks) && length(brks) == 1)) { - num_brks <- 5 - if (is.numeric(brks)) { - num_brks <- brks + if (!is.list(brks)) { + if (is.null(brks)) { + brks <- 5 + } else if (!is.numeric(brks)) { + stop("Parameter 'brks' must be a numeric vector.") + } + # Turn it into list + brks <- rep(list(brks), nmap) + } else { + if (length(brks) != nmap) { + stop("Parameter 'brks' must have the length of 'nmap'.") } - brks <- seq(from = bar_limits[1], to = bar_limits[2], length.out = num_brks) } - if (!is.numeric(brks)) { - stop("Parameter 'brks' must be a numeric vector.") + for (i_map in 1:nmap) { + if (length(brks[[i_map]]) == 1) { + brks[[i_map]] <- seq(from = bar_limits[[i_map]][1], to = bar_limits[[i_map]][2], length.out = brks[[i_map]]) + } } + # Check cols col_sets <- list(c("#A1D99B", "#74C476", "#41AB5D", "#238B45"), c("#6BAED6FF", "#4292C6FF", "#2171B5FF", "#08519CFF"), @@ -117,6 +137,44 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE chosen_sets <- array(1:length(col_sets), nmap) } cols <- col_sets[chosen_sets] + + # Set triangle_ends, col_sup, col_inf + #NOTE: The "col" input of ColorBar() later is not NULL (since we determine it here) + # so ColorBar() cannot decide these parameters for us. + #NOTE: Here, col_inf and col_sup are prior to triangle_ends, which is consistent with ColorBar(). + #TODO: Make triangle_ends a list + if (is.null(triangle_ends)) { + if (!is.null(var_limits)) { + triangle_ends <- c(FALSE, FALSE) + #TODO: bar_limits is a list + if (bar_limits[1] >= var_limits[1] | !is.null(col_inf)) { + triangle_ends[1] <- TRUE + if (is.null(col_inf)) { + col_inf <- lapply(cols, head, 1) + cols <- lapply(cols, '[', -1) + } + } + if (bar_limits[2] < var_limits[2] | !is.null(col_sup)) { + triangle_ends[2] <- TRUE + if (is.null(col_sup)) { + col_sup <- lapply(cols, tail, 1) + cols <- lapply(cols, '[', -length(cols[[1]])) + } + } + } else { + triangle_ends <- c(!is.null(col_inf), !is.null(col_sup)) + } + } else { # triangle_ends has values + if (triangle_ends[1] & is.null(col_inf)) { + col_inf <- lapply(cols, head, 1) + cols <- lapply(cols, '[', -1) + } + if (triangle_ends[2] & is.null(col_sup)) { + col_sup <- lapply(cols, tail, 1) + cols <- lapply(cols, '[', -length(cols[[1]])) + } + } + } else { if (!is.list(cols)) { stop("Parameter 'cols' must be a list of character vectors.") @@ -125,13 +183,12 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE stop("Parameter 'cols' must be a list of character vectors.") } if (length(cols) != nmap) { - stop("Parameter 'cols' must be a list of the same length as the number of ", - "maps in 'maps'.") + stop("Parameter 'cols' must be a list of the same length as 'nmap'.") } } - for (i in 1:length(cols)) { - if (length(cols[[i]]) != (length(brks) - 1)) { - cols[[i]] <- grDevices::colorRampPalette(cols[[i]])(length(brks) - 1) + for (i_map in 1:length(cols)) { + if (length(cols[[i_map]]) != (length(brks[[i_map]]) - 1)) { + cols[[i_map]] <- grDevices::colorRampPalette(cols[[i_map]])(length(brks[[i_map]]) - 1) } } @@ -149,16 +206,16 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE if (plot) { for (k in 1:nmap) { - s2dv::ColorBar(brks = brks, cols = cols[[k]], vertical = FALSE, subsampleg = subsampleg, -# bar_limits = bar_limits, var_limits = var_limits, - triangle_ends = triangle_ends, plot = TRUE, +#TODO: Add s2dv:: + ColorBar(brks = brks[[k]], cols = cols[[k]], vertical = FALSE, subsampleg = subsampleg, + bar_limits = bar_limits[[k]], #var_limits = var_limits, + triangle_ends = triangle_ends, col_inf = col_inf[[k]], col_sup = col_sup[[k]], plot = TRUE, draw_separators = draw_separators, title = bar_titles[[k]], title_scale = title_scale, label_scale = label_scale, extra_margin = extra_margin) } } else { - #TODO: col_inf and col_sup - return(list(brks = brks, cols = cols)) + return(list(brks = brks, cols = cols, col_inf = col_inf, col_sup = col_sup)) } } @@ -195,4 +252,4 @@ GradientCatsColorBar <- function(nmap, brks = NULL, cols = NULL, vertical = TRUE } # Definition of a global variable to store the warning message used in Calibration -warning_shown <- FALSE \ No newline at end of file +warning_shown <- FALSE diff --git a/data/lonlat_prec_st.rda b/data/lonlat_prec_st.rda new file mode 100644 index 0000000000000000000000000000000000000000..02e8e28453a1fbbf3c3019b3f7b4fd6b43c28dd7 Binary files /dev/null and b/data/lonlat_prec_st.rda differ diff --git a/data/lonlat_temp_st.rda b/data/lonlat_temp_st.rda new file mode 100644 index 0000000000000000000000000000000000000000..cad51c5546cb13c7dd3b556890388f93959e74bb Binary files /dev/null and b/data/lonlat_temp_st.rda differ diff --git a/inst/doc/UseCase1_WindEvent_March2018.R b/inst/doc/usecase/UseCase1_WindEvent_March2018.R similarity index 100% rename from inst/doc/UseCase1_WindEvent_March2018.R rename to inst/doc/usecase/UseCase1_WindEvent_March2018.R diff --git a/inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF100.R b/inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF100.R similarity index 100% rename from inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF100.R rename to inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF100.R diff --git a/inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF4.R b/inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF4.R similarity index 100% rename from inst/doc/UseCase2_PrecipitationDownscaling_RainFARM_RF4.R rename to inst/doc/usecase/UseCase2_PrecipitationDownscaling_RainFARM_RF4.R diff --git a/inst/doc/UseCase3_data_preparation_SCHEME_model.R b/inst/doc/usecase/UseCase3_data_preparation_SCHEME_model.R similarity index 100% rename from inst/doc/UseCase3_data_preparation_SCHEME_model.R rename to inst/doc/usecase/UseCase3_data_preparation_SCHEME_model.R diff --git a/inst/doc/launch_UseCase2_PrecipitationDownscaling_RF4.sh b/inst/doc/usecase/launch_UseCase2_PrecipitationDownscaling_RF4.sh similarity index 100% rename from inst/doc/launch_UseCase2_PrecipitationDownscaling_RF4.sh rename to inst/doc/usecase/launch_UseCase2_PrecipitationDownscaling_RF4.sh diff --git a/man/Analogs.Rd b/man/Analogs.Rd index 6cf62ad42b64d1e6f29ea5320f27bda32e0dd38f..5b58ee004a2ca4a10f79919db60dfae648ba10b8 100644 --- a/man/Analogs.Rd +++ b/man/Analogs.Rd @@ -13,6 +13,7 @@ Analogs( latL = NULL, expVar = NULL, obsVar = NULL, + sdate_dim = "sdate", criteria = "Large_dist", excludeTime = NULL, lonVar = NULL, @@ -40,11 +41,13 @@ the same latitudinal and longitudinal dimensions as parameter 'expL' and a single temporal dimension with the maximum number of available observations.} \item{time_obsL}{A character string indicating the date of the observations -in the format "dd-mm-yyyy". Reference time to search for analogs.} +in the format "dd-mm-yyyy". Reference time to search for analogs. It must +have time dimensions.} \item{time_expL}{An array of N named dimensions (coinciding with time dimensions in expL) of character string(s) indicating the date(s) of the -experiment in the format "dd-mm-yyyy". Time(s) to find the analogs.} +experiment in the format "dd-mm-yyyy". Time(s) to find the analogs. If it +is not an scalar it must have named dimensions.} \item{lonL}{A vector containing the longitude of parameter 'expL'.} @@ -58,6 +61,9 @@ function will be the analog of parameter 'expVar'.} \item{obsVar}{An array of N named dimensions containing the field of the same variable as the passed in parameter 'expVar' for the same region.} +\item{sdate_dim}{A character string indicating the name of the start date +dimension. By default, it is set to 'sdate'.} + \item{criteria}{A character string indicating the criteria to be used for the selection of analogs: \itemize{\item{Large_dist} minimum Euclidean distance in the large scale pattern; @@ -137,7 +143,7 @@ the selection of the best analogs in a short number of posibilities, the best ones. This function has not constrains of specific regions, variables to downscale, or data to be used (seasonal forecast data, climate projections data, reanalyses data). The regrid into a finner scale is done interpolating -with CST_Load. Then, this interpolation is corrected selecting the analogs in +with CST_Start. Then, this interpolation is corrected selecting the analogs in the large and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. } @@ -148,6 +154,7 @@ dim(expSLP) <- c(lat = 4, lon = 5) obsSLP <- c(rnorm(1:180), expSLP * 1.2) dim(obsSLP) <- c(time = 10, lat = 4, lon = 5) time_obsSLP <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +dim(time_obsSLP) <- c(time = 10) downscale_field <- Analogs(expL = expSLP, obsL = obsSLP, time_obsL = time_obsSLP,time_expL = "01-01-1994") diff --git a/man/BiasCorrection.Rd b/man/BiasCorrection.Rd index fa087478548e9b9f6bff5ba7394f8bd00b0ca472..e2b86f997d47552722d7a30dbd5865b6d2c81354 100644 --- a/man/BiasCorrection.Rd +++ b/man/BiasCorrection.Rd @@ -60,9 +60,9 @@ standard deviation and mean to that of the reference dataset. } \examples{ mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) -dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, time = 5, lat = 6, lon = 7) obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) -dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, time = 5, lat = 6, lon = 7) a <- BiasCorrection(exp = mod1, obs = obs1) } \references{ diff --git a/man/CST_Analogs.Rd b/man/CST_Analogs.Rd index cac70cdc023cf2898a37628c6acc4320fc540e45..d837d70fb614b4ac424901738b9ffc9de3da4a51 100644 --- a/man/CST_Analogs.Rd +++ b/man/CST_Analogs.Rd @@ -9,6 +9,7 @@ CST_Analogs( obsL, expVar = NULL, obsVar = NULL, + sdate_dim = "sdate", region = NULL, criteria = "Large_dist", excludeTime = NULL, @@ -42,6 +43,9 @@ analog of parameter 'expVar'.} \item{obsVar}{An 's2dv_cube' containing the field of the same variable as the passed in parameter 'expVar' for the same region.} +\item{sdate_dim}{A character string indicating the name of the start date +dimension. By default, it is set to 'sdate'.} + \item{region}{A vector of length four indicating the minimum longitude, the maximum longitude, the minimum latitude and the maximum latitude.} @@ -69,7 +73,8 @@ and dates are taken from element \code{$attrs$Dates} from expL.} \item{time_obsL}{A character string indicating the date of the observations in the date format (i.e. "yyyy-mm-dd"). By default it is NULL and dates are -taken from element \code{$attrs$Dates} from obsL.} +taken from element \code{$attrs$Dates} from obsL. It must have time +dimensions.} \item{nAnalogs}{Number of Analogs to be selected to apply the criterias 'Local_dist' or 'Local_cor'. This is not the necessary the number of analogs @@ -119,7 +124,7 @@ analogs. This function has not constrains of specific regions, variables to downscale, or data to be used (seasonal forecast data, climate projections data, reanalyses data). The regrid into a finner scale is done interpolating with -CST_Load. Then, this interpolation is corrected selecting the analogs in the +CST_Start. Then, this interpolation is corrected selecting the analogs in the large and local scale in based of the observations. The function is an adapted version of the method of Yiou et al 2013. For an advanced search of Analogs (multiple Analogs, different criterias, further information from the @@ -135,6 +140,7 @@ time_obsL <- as.POSIXct(paste(rep("01", 10), rep("01", 10), 1994:2003, sep = "-" format = "\%d-\%m-\%y") dim(time_obsL) <- c(time = 10) time_expL <- time_obsL[1] +dim(time_expL) <- c(time = 1) lon <- seq(-1, 5, 1.5) lat <- seq(30, 35, 1.5) coords <- list(lon = seq(-1, 5, 1.5), lat = seq(30, 35, 1.5)) @@ -155,8 +161,7 @@ from surface pressure using analogues. Clim. Dyn., 41, 1419-1437. \email{pascal.yiou@lsce.ipsl.fr} } \seealso{ -\code{\link{CST_Load}}, \code{\link[s2dv]{Load}} and -\code{\link[s2dv]{CDORemap}} +\code{\link{CST_Start}}, \code{\link[startR]{Start}} } \author{ M. Carmen Alvarez-Castro, \email{carmen.alvarez-castro@cmcc.it} diff --git a/man/CST_Anomaly.Rd b/man/CST_Anomaly.Rd index 5a2784e1dfb9387a4c5a4b70c56b9d44b55ccca8..ada952eed088a2c256bf136b32030a0aeb2810fd 100644 --- a/man/CST_Anomaly.Rd +++ b/man/CST_Anomaly.Rd @@ -19,11 +19,11 @@ CST_Anomaly( ) } \arguments{ -\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function, containing the seasonal forecast experiment data in the element named \code{$data}.} -\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function, containing the observed data in the element named \code{$data}.} \item{dim_anom}{A character string indicating the name of the dimension @@ -86,7 +86,7 @@ anom <- CST_Anomaly(exp = exp, obs = obs, cross = FALSE, memb = TRUE) } \seealso{ \code{\link[s2dv]{Ano_CrossValid}}, \code{\link[s2dv]{Clim}} and -\code{\link{CST_Load}} +\code{\link{CST_Start}} } \author{ Perez-Zanon Nuria, \email{nuria.perez@bsc.es} diff --git a/man/CST_BiasCorrection.Rd b/man/CST_BiasCorrection.Rd index 4de9257784afa9affd1f9ca9f45b5f2425fe421b..c438d0614df6ae7e0d5b67613937fac1cb6229fb 100644 --- a/man/CST_BiasCorrection.Rd +++ b/man/CST_BiasCorrection.Rd @@ -16,16 +16,16 @@ CST_BiasCorrection( ) } \arguments{ -\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function, containing the seasonal forecast experiment data in the element named \code{$data} with at least time and member dimensions.} -\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function, containing the observed data in the element named \code{$data} with at least time dimension.} \item{exp_cor}{An object of class \code{s2dv_cube} as returned by -\code{CST_Load} function, containing the seasonal forecast experiment to be +\code{CST_Start} function, containing the seasonal forecast experiment to be corrected with at least time dimension. If it is NULL, the 'exp' forecast will be corrected. If there is only one corrected dataset, it should not have dataset dimension. If there is a corresponding corrected dataset for @@ -63,9 +63,9 @@ standard deviation and mean to that of the reference dataset. } \examples{ mod1 <- 1 : (1 * 3 * 4 * 5 * 6 * 7) -dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 7) +dim(mod1) <- c(dataset = 1, member = 3, sdate = 4, time = 5, lat = 6, lon = 7) obs1 <- 1 : (1 * 1 * 4 * 5 * 6 * 7) -dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, ftime = 5, lat = 6, lon = 7) +dim(obs1) <- c(dataset = 1, member = 1, sdate = 4, time = 5, lat = 6, lon = 7) lon <- seq(0, 30, 5) lat <- seq(0, 25, 5) coords <- list(lat = lat, lon = lon) diff --git a/man/CST_Calibration.Rd b/man/CST_Calibration.Rd index c8d1320f8e674f6c5d89ef9353c7a487010e94d8..491b727195638d98ef7f7a891825696fbbaa5f9e 100644 --- a/man/CST_Calibration.Rd +++ b/man/CST_Calibration.Rd @@ -22,18 +22,18 @@ CST_Calibration( ) } \arguments{ -\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{exp}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function with at least 'sdate' and 'member' dimensions, containing the seasonal hindcast experiment data in the element named \code{data}. The hindcast is used to calibrate the forecast in case the forecast is provided; if not, the same hindcast will be calibrated instead.} -\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Load} +\item{obs}{An object of class \code{s2dv_cube} as returned by \code{CST_Start} function with at least 'sdate' dimension, containing the observed data in the element named \code{$data}.} \item{exp_cor}{An optional object of class \code{s2dv_cube} as returned by -\code{CST_Load} function with at least 'sdate' and 'member' dimensions, +\code{CST_Start} function with at least 'sdate' and 'member' dimensions, containing the seasonal forecast experiment data in the element named \code{data}. If the forecast is provided, it will be calibrated using the hindcast and observations; if not, the hindcast will be calibrated instead. @@ -181,7 +181,7 @@ Quarterly Journal of the Royal Meteorological Society, 141(688), 807-818. \doi{10.1002/qj.2397} } \seealso{ -\code{\link{CST_Load}} +\code{\link{CST_Start}} } \author{ Verónica Torralba, \email{veronica.torralba@bsc.es} diff --git a/man/CST_MultiEOF.Rd b/man/CST_MultiEOF.Rd index 11f8877fa0ada4c68692da0052eba93ad1567bdc..7162c9473a5455b93273732116ffc045d0f890dc 100644 --- a/man/CST_MultiEOF.Rd +++ b/man/CST_MultiEOF.Rd @@ -6,11 +6,17 @@ \usage{ CST_MultiEOF( datalist, + lon_dim = "lon", + lat_dim = "lat", + time_dim = "ftime", + sdate_dim = "sdate", + var_dim = "var", neof_max = 40, neof_composed = 5, minvar = 0.6, lon_lim = NULL, - lat_lim = NULL + lat_lim = NULL, + ncores = NULL ) } \arguments{ @@ -20,7 +26,24 @@ an element named \code{$data} with at least two spatial dimensions named "lon" and "lat", a dimension "ftime" and a dimension "sdate". Latitudinal dimension accepted names: 'lat', 'lats', 'latitude', 'y', 'j', 'nav_lat'. Longitudinal dimension accepted names: 'lon', 'lons','longitude', 'x', 'i', -'nav_lon'.} +'nav_lon'. NAs can exist but it should be consistent along 'time_dim'. That +is, if one grid point has NAs for each variable, all the time steps at this +point should be NAs.} + +\item{lon_dim}{A character string indicating the name of the longitudinal +dimension. By default, it is set to 'lon'.} + +\item{lat_dim}{A character string indicating the name of the latitudinal +dimension. By default, it is set to 'lat'.} + +\item{time_dim}{A character string indicating the name of the temporal +dimension. By default, it is set to 'time'.} + +\item{sdate_dim}{A character string indicating the name of the start date +dimension. By default, it is set to 'sdate'.} + +\item{var_dim}{A character string indicating the name of the variable +dimension. By default, it is set to 'var'.} \item{neof_max}{Maximum number of single eofs considered in the first decomposition.} @@ -34,12 +57,38 @@ for all input variables.} \item{lat_lim}{Vector with latitudinal range limits for the EOF calculation for all input variables.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ -A list with elements \code{$coeff} (an array of time-varying principal -component coefficients), \code{$variance} (a matrix of explained variances), -\code{eof_pattern} (a matrix of EOF patterns obtained by regression for each -variable). +A list containing: +\item{coeff}{ + An 's2dv_cube' with the data element being an array of principal components + with dimensions 'time_dim', 'sdate_dim', number of eof, rest of the + dimensions of 'data' except 'lon_dim' and 'lat_dim'. +} +\item{variance}{ + An 's2dv_cube' with the data element being an array of explained variances + with dimensions 'eof' and the rest of the dimensions of 'data' except + 'time_dim', 'sdate_dim', 'lon_dim' and 'lat_dim'. +} +\item{eof_pattern}{ + An 's2dv_cube' with the data element being an array of EOF patterns obtained + by regression with dimensions: 'eof' and the rest of the dimensions of + 'data' except 'time_dim' and 'sdate_dim'. +} +\item{mask}{ + An 's2dv_cube' with the data element being an array of the mask with + dimensions ('lon_dim', 'lat_dim', rest of the dimensions of 'data' except + 'time_dim'). It is made from 'data', 1 for the positions that 'data' has + value and NA for the positions that 'data' has NA. It is used to replace NAs + with 0s for EOF calculation and mask the result with NAs again after the + calculation. +} +\item{coordinates}{ + Longitudinal and latitudinal coordinates vectors. +} } \description{ This function performs EOF analysis over multiple variables, diff --git a/man/CST_SaveExp.Rd b/man/CST_SaveExp.Rd index f8918eb9aa88ca8fae91b62951a31590378b8f27..9352e03604b75409efd9764194e12d43a11e7169 100644 --- a/man/CST_SaveExp.Rd +++ b/man/CST_SaveExp.Rd @@ -13,6 +13,7 @@ CST_SaveExp( var_dim = "var", memb_dim = "member", startdates = NULL, + drop_dims = NULL, single_file = FALSE, extra_string = NULL ) @@ -54,6 +55,10 @@ If it is NULL, the coordinate corresponding the the start date dimension or the first Date of each time step will be used as the name of the files. It is NULL by default.} +\item{drop_dims}{A vector of character strings indicating the dimension names +of length 1 that need to be dropped in order that they don't appear in the +netCDF file. It is NULL by default (optional).} + \item{single_file}{A logical value indicating if all object is saved in a single file (TRUE) or in multiple files (FALSE). When it is FALSE, the array is separated for Datasets, variable and start date. It is FALSE @@ -93,10 +98,10 @@ has been created from \code{CST_Load()}, then it can be reloaded with } \examples{ \dontrun{ -data <- lonlat_temp$exp +data <- lonlat_temp_st$exp destination <- "./" CST_SaveExp(data = data, destination = destination, ftime_dim = 'ftime', - var_dim = NULL, ftime_dim = 'ftime', var_dim = NULL) + var_dim = 'var', dat_dim = 'dataset') } } diff --git a/man/CST_Start.Rd b/man/CST_Start.Rd new file mode 100644 index 0000000000000000000000000000000000000000..6069f0c8607414610c60adf491ee3c3202c6da3c --- /dev/null +++ b/man/CST_Start.Rd @@ -0,0 +1,51 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CST_Start.R +\name{CST_Start} +\alias{CST_Start} +\title{CSTools data retrieval function using Start} +\usage{ +CST_Start(...) +} +\arguments{ +\item{...}{Parameters that are automatically forwarded to the `startR::Start` +function. See details in `?startR::Start`.} +} +\description{ +This function aggregates, subsets and retrieves sub-seasonal, seasonal, +decadal or climate projection data from NetCDF files in a local file system +and arranges it for easy application of the CSTools functions. It calls the +function \code{Start} from startR, which is an R package started at BSC with +the aim to develop a tool that allows the user to automatically process large +multidimensional distributed data sets. Then, the output is transformed into +`s2dv_cube` object. +} +\details{ +It receives any number of parameters (`...`) that are automatically forwarded +to the `startR::Start` function. See details in `?startR::Start`. +} +\examples{ +\dontrun{ + sdates <- c('20101101', '20111101', '20121101') + latmin <- 44 + latmax <- 47 + lonmin <- 6 + lonmax <- 9 + data <- CST_Start(dat = path, + var = 'prlr', + ensemble = indices(1:6), + sdate = sdates, + time = 121:151, + latitude = values(list(latmin, latmax)), + longitude = values(list(lonmin, lonmax)), + synonims = list(longitude = c('lon', 'longitude'), + latitude = c('lat', 'latitude')), + return_vars = list(time = 'sdate', + longitude = NULL, latitude = NULL), + retrieve = FALSE) +} +\dontshow{ +exp <- CSTools::lonlat_temp_st$exp +obs <- CSTools::lonlat_temp_st$obs +data <- CSTools::lonlat_prec +} +} diff --git a/man/Calibration.Rd b/man/Calibration.Rd index b907326aafb8c44a9e773096afb6c5434997d0d4..1c9bb1b55b2714f4a50ca9a303439d7c476e7f47 100644 --- a/man/Calibration.Rd +++ b/man/Calibration.Rd @@ -151,7 +151,7 @@ Quarterly Journal of the Royal Meteorological Society, 141(688), 807-818. \doi{10.1002/qj.2397} } \seealso{ -\code{\link{CST_Load}} +\code{\link{CST_Start}} } \author{ Verónica Torralba, \email{veronica.torralba@bsc.es} diff --git a/man/MultiEOF.Rd b/man/MultiEOF.Rd index 04963e1ac27d7d68a464dc0c8bb62291a53360e1..fb8eefa6e7afcc3807f127f1b9258af6002ffaf0 100644 --- a/man/MultiEOF.Rd +++ b/man/MultiEOF.Rd @@ -9,14 +9,19 @@ MultiEOF( data, lon, lat, - time, + dates, + time = NULL, lon_dim = "lon", lat_dim = "lat", + time_dim = "ftime", + sdate_dim = "sdate", + var_dim = "var", neof_max = 40, neof_composed = 5, minvar = 0.6, lon_lim = NULL, - lat_lim = NULL + lat_lim = NULL, + ncores = NULL ) } \arguments{ @@ -25,17 +30,33 @@ the variables to be analysed. The other diemnsions follow the same structure as the \code{"exp"} element of a 's2dv_cube' object. Latitudinal dimension accepted names: 'lat', 'lats', 'latitude', 'y', 'j', 'nav_lat'. Longitudinal dimension accepted names: 'lon', 'lons','longitude', 'x', 'i', -'nav_lon'.} +'nav_lon'. NAs can exist but it should be consistent along 'time_dim'. That +is, if one grid point has NAs for each variable, all the time steps at this +point should be NAs.} \item{lon}{Vector of longitudes.} \item{lat}{Vector of latitudes.} -\item{time}{Vector or matrix of dates in POSIXct format.} +\item{dates}{Vector or matrix of dates in POSIXct format.} -\item{lon_dim}{String with dimension name of longitudinal coordinate.} +\item{time}{Deprecated parameter, it has been substituted by 'dates'. It will +be removed in the next release.} -\item{lat_dim}{String with dimension name of latitudinal coordinate.} +\item{lon_dim}{A character string indicating the name of the longitudinal +dimension. By default, it is set to 'lon'.} + +\item{lat_dim}{A character string indicating the name of the latitudinal +dimension. By default, it is set to 'lat'.} + +\item{time_dim}{A character string indicating the name of the temporal +dimension. By default, it is set to 'time'.} + +\item{sdate_dim}{A character string indicating the name of the start date +dimension. By default, it is set to 'sdate'.} + +\item{var_dim}{A character string indicating the name of the variable +dimension. By default, it is set to 'var'.} \item{neof_max}{Maximum number of single eofs considered in the first decomposition.} @@ -49,12 +70,36 @@ all input variables.} \item{lat_lim}{Vector with latitudinal range limits for the calculation for all input variables.} + +\item{ncores}{An integer indicating the number of cores to use for parallel +computation. The default value is NULL.} } \value{ -A list with elements \code{$coeff} (an array of time-varying principal -component coefficients), \code{$variance} (a matrix of explained variances), -\code{eof_pattern} (a matrix of EOF patterns obtained by regression for each -variable). +A list containing: +\item{coeff}{ + An array of principal components with dimensions 'time_dim', 'sdate_dim', + number of eof, rest of the dimensions of 'data' except 'lon_dim' and + 'lat_dim'. +} +\item{variance}{ + An array of explained variances with dimensions 'eof' and the rest of the + dimensions of 'data' except 'time_dim', 'sdate_dim', 'lon_dim' and + 'lat_dim'. +} +\item{eof_pattern}{ + An array of EOF patterns obtained by regression with dimensions: 'eof' and + the rest of the dimensions of 'data' except 'time_dim' and 'sdate_dim'. +} +\item{mask}{ + An array of the mask with dimensions ('lon_dim', 'lat_dim', rest of the + dimensions of 'data' except 'time_dim'). It is made from 'data', 1 for the + positions that 'data' has value and NA for the positions that 'data' has NA. + It is used to replace NAs with 0s for EOF calculation and mask the result + with NAs again after the calculation. +} +\item{coordinates}{ + Longitudinal and latitudinal coordinates vectors. +} } \description{ This function performs EOF analysis over multiple variables, @@ -74,7 +119,7 @@ dates <- c("2000-11-01", "2000-12-01", "2001-01-01", "2001-11-01", "2001-12-01", "2002-01-01", "2002-11-01", "2002-12-01", "2003-01-01") Dates <- as.POSIXct(dates, format = "\%Y-\%m-\%d") dim(Dates) <- c(ftime = 3, sdate = 3) -cal <- MultiEOF(data = exp, lon = lon, lat = lat, time = Dates) +cal <- MultiEOF(data = exp, lon = lon, lat = lat, dates = Dates) } \author{ Jost von Hardenberg - ISAC-CNR, \email{j.vonhardenberg@isac.cnr.it} diff --git a/man/PlotCombinedMap.Rd b/man/PlotCombinedMap.Rd index d013f80e5aa5bf42c70bfdb8b4faa34990c24813..452c24f28e1820bdcdaae1bb5015a4f961ac4816 100644 --- a/man/PlotCombinedMap.Rd +++ b/man/PlotCombinedMap.Rd @@ -13,6 +13,10 @@ PlotCombinedMap( map_dim = "map", brks = NULL, cols = NULL, + bar_limits = NULL, + triangle_ends = c(F, F), + col_inf = NULL, + col_sup = NULL, col_unknown_map = "white", mask = NULL, col_mask = "grey", @@ -21,12 +25,14 @@ PlotCombinedMap( legend_scale = 1, cex_bar_titles = 1.5, plot_margin = NULL, + bar_extra_margin = c(2, 0, 2, 0), fileout = NULL, width = 8, height = 5, size_units = "in", res = 100, drawleg = T, + return_leg = FALSE, ... ) } @@ -67,6 +73,36 @@ colour bar will be automatically interpolated to match the number of breaks. Each item in this list can be named, and the name will be used as title for the corresponding colour bar (equivalent to the parameter 'bar_titles').} +\item{bar_limits}{Parameter from s2dv::ColorBar. Vector of two numeric values +with the extremes of the range of values represented in the colour bar. If +'var_limits' go beyond this interval, the drawing of triangle extremes is +triggered at the corresponding sides, painted in 'col_inf' and 'col_sup'. +Either of them can be set as NA and will then take as value the +corresponding extreme in 'var_limits' (hence a triangle end won't be +triggered for these sides). Takes as default the extremes of 'brks' if +available, else the same values as 'var_limits'.} + +\item{triangle_ends}{Parameter from s2dv::ColorBar. Vector of two logical +elements, indicating whether to force the drawing of triangle ends at each +of the extremes of the colour bar. This choice is automatically made from +the provided 'brks', 'bar_limits', 'var_limits', 'col_inf' and 'col_sup', +but the behaviour can be manually forced to draw or not to draw the triangle +ends with this parameter. If 'cols' is provided, 'col_inf' and 'col_sup' +will take priority over 'triangle_ends' when deciding whether to draw the +triangle ends or not.} + +\item{col_inf}{Parameter from s2dv::ColorBar. Colour to fill the inferior +triangle end with. Useful if specifying colours manually with parameter +'cols', to specify the colour and to trigger the drawing of the lower +extreme triangle, or if 'cols' is not specified, to replace the colour +automatically generated by ColorBar().} + +\item{col_sup}{Parameter from s2dv::ColorBar. Colour to fill the superior +triangle end with. Useful if specifying colours manually with parameter +'cols', to specify the colour and to trigger the drawing of the upper +extreme triangle, or if 'cols' is not specified, to replace the colour +automatically generated by ColorBar().} + \item{col_unknown_map}{Colour to use to paint the grid cells for which a map is not possible to be chosen according to 'map_select_fun' or for those values that go beyond 'display_range'. Takes the value 'white' by default.} @@ -100,6 +136,10 @@ following order: bottom, left, top, and right. If not specified, use the default of par("mar"), c(5.1, 4.1, 4.1, 2.1). Used as 'margin_scale' in s2dv::PlotEquiMap.} +\item{bar_extra_margin}{Parameter from s2dv::ColorBar. Extra margins to be +added around the colour bar, in the format c(y1, x1, y2, x2). The units are +margin lines. Takes rep(0, 4) by default.} + \item{fileout}{File where to save the plot. If not specified (default) a graphics device will pop up. Extensions allowed: eps/ps, jpeg, png, pdf, bmp and tiff} @@ -124,6 +164,13 @@ FALSE or:\cr 'right', 'r', 'R', 'east', 'e', 'E'\cr 'left', 'l', 'L', 'west', 'w', 'W'} +\item{return_leg}{A logical value indicating if the color bars information +should be returned by the function. If TRUE, the function doesn't plot the +color bars but still creates the layout with color bar areas, and the +arguments for GradientCatsColorBar() or ColorBar() will be returned. It is +convenient for users to adjust the color bars manually. The default is +FALSE, the color bars will be plotted directly.} + \item{...}{Additional parameters to be passed on to \code{PlotEquiMap}.} } \description{ diff --git a/man/PlotPDFsOLE.Rd b/man/PlotPDFsOLE.Rd index e2c6606eb20822b0b29d40c99411dbb0de451710..748310349c001ac09f54a0f374fc79eb24a22f17 100644 --- a/man/PlotPDFsOLE.Rd +++ b/man/PlotPDFsOLE.Rd @@ -70,5 +70,5 @@ dim(pdf_2) <- c(statistic = 2) PlotPDFsOLE(pdf_1, pdf_2) } \author{ -Eroteida Sanchez-Garcia - AEMET, //email{esanchezg@aemet.es} +Eroteida Sanchez-Garcia - AEMET, \email{esanchezg@aemet.es} } diff --git a/man/PlotWeeklyClim.Rd b/man/PlotWeeklyClim.Rd index 746c641ea4f411cfc36d5d52249f87b45ebbb5d2..3e064e8db54ad73d1cca4ccebb00ec0a1591d067 100644 --- a/man/PlotWeeklyClim.Rd +++ b/man/PlotWeeklyClim.Rd @@ -7,11 +7,16 @@ PlotWeeklyClim( data, first_date, - ref_period_ini, - ref_period_end, + ref_period, + last_date = NULL, + data_years = NULL, time_dim = "time", sdate_dim = "sdate", - title = "Observed weekly means and climatology", + ylim = NULL, + title = NULL, + subtitle = NULL, + ytitle = NULL, + legend = TRUE, palette = "Blues", fileout = NULL, device = NULL, @@ -24,18 +29,31 @@ PlotWeeklyClim( \arguments{ \item{data}{A multidimensional array with named dimensions with at least sdate and time dimensions containing observed daily data. It can also be a -dataframe with computed percentiles as input for ggplot. The target year -must be included in the input data.} +dataframe with computed percentiles as input for ggplot. If it's a +dataframe, it must contain the following column names: 'week', 'clim', +'p10', 'p90', 'p33', 'p66', 'week_mean', 'day' and 'data'.} -\item{first_date}{The first date of the target period of timeseries. It can be -of class 'Date', 'POSIXct' or a character string in the format 'yyyy-mm-dd'. -It must be a date included in the reference period.} +\item{first_date}{The first date of the observed values of timeseries. It can +be of class 'Date', 'POSIXct' or a character string in the format +'yyyy-mm-dd'. If parameter 'data_years' is not provided, it must be a date +included in the reference period.} -\item{ref_period_ini}{A numeric value indicating the first year of the -reference period.} +\item{ref_period}{A vector of numeric values indicating the years of the +reference period. If parameter 'data_years' is not specified, it must +be of the same length of dimension 'sdate_dim' of parameter 'data'.} -\item{ref_period_end}{A numeric value indicating the last year of the -reference period.} +\item{last_date}{Optional parameter indicating the last date of the target +period of the daily timeseries. It can be of class 'Date', 'POSIXct' or a +character string in the format 'yyyy-mm-dd'. If it is NULL, the last date of +the daily timeseries will be set as the last date of 'data'. As the data is +plotted by weeks, only full groups of 7 days will be plotted. If the last +date of the timeseries is not a multiple of 7 days, the last week will +not be plotted.} + +\item{data_years}{A vector of numeric values indicating the years of the +data. It must be of the same length of dimension 'sdate_dim' of parameter +'data'. It is optional, if not specified, all the years will be used as the +target period.} \item{time_dim}{A character string indicating the daily time dimension name. The default value is 'time'.} @@ -43,7 +61,20 @@ The default value is 'time'.} \item{sdate_dim}{A character string indicating the start year dimension name. The default value is 'sdate'.} -\item{title}{The text for the top title of the plot.} +\item{ylim}{A numeric vector of length two providing limits of the scale. +Use NA to refer to the existing minimum or maximum. For more information, +see 'ggplot2' documentation of 'scale_y_continuous' parameter.} + +\item{title}{The text for the top title of the plot. It is NULL by default.} + +\item{subtitle}{The text for the subtitle of the plot. It is NULL bu default.} + +\item{ytitle}{Character string to be drawn as y-axis title. It is NULL by +default.} + +\item{legend}{A logical value indicating whether a legend should be included +in the plot. If it is TRUE or NA, the legend will be included. If it is +FALSE, the legend will not be included. It is TRUE by default.} \item{palette}{A palette name from the R Color Brewer’s package. The default value is 'Blues'.} @@ -74,12 +105,15 @@ A ggplot object containing the plot. This function plots the observed weekly means and climatology of a timeseries data using ggplot package. It compares the weekly climatology in a specified period (reference period) to the observed conditions during the -target period analyzed in the case study (included in the reference period). +target period analyzed in the case study. } \examples{ -data <- array(rnorm(49*20, 274, 7), dim = c(time = 49, sdate = 20)) -PlotWeeklyClim(data = data, first_date = '2010-08-09', - ref_period_ini = 1998, - ref_period_end = 2020) +data <- array(rnorm(49*20*3, 274), dim = c(time = 49, sdate = 20, member = 3)) +PlotWeeklyClim(data = data, first_date = '2002-08-09', + last_date = '2002-09-15', ref_period = 2010:2019, + data_years = 2000:2019, time_dim = 'time', sdate_dim = 'sdate', + title = "Observed weekly means and climatology", + subtitle = "Target years: 2010 to 2019", + ytitle = paste0('tas', " (", "deg.C", ")")) } diff --git a/man/Predictability.Rd b/man/Predictability.Rd index 04f7204eea53f35f0dad6e1ffcb75a0b86232ffe..792af61ad8e30be0c2a06e3c79e0209d6230ca10 100644 --- a/man/Predictability.Rd +++ b/man/Predictability.Rd @@ -20,20 +20,21 @@ ProxiesAttractor.} \value{ A list of length 2: \itemize{ -\item\code{pred.dim} {a list of two lists 'qdim' and 'pos.d'. The 'qdim' list -contains values of local dimension 'dim' divided by terciles: -d1: lower tercile (high predictability), -d2: middle tercile, -d3: higher tercile (low predictability) -The 'pos.d' list contains the position of each tercile in parameter 'dim'} - -\item\code{pred.theta} {a list of two lists 'qtheta' and 'pos.t'. -The 'qtheta' list contains values of the inverse of persistence 'theta' -divided by terciles: -th1: lower tercile (high predictability), -th2: middle tercile, -th3: higher tercile (low predictability) -The 'pos.t' list contains the position of each tercile in parameter 'theta'} + \item{'pred.dim', a list of two lists 'qdim' and 'pos.d'. The 'qdim' list + contains values of local dimension 'dim' divided by terciles: + d1: lower tercile (high predictability), + d2: middle tercile, + d3: higher tercile (low predictability) + The 'pos.d' list contains the position of each tercile in parameter + 'dim'.} +\item{'pred.theta', a list of two lists 'qtheta' and 'pos.t'. + The 'qtheta' list contains values of the inverse of persistence 'theta' + divided by terciles: + th1: lower tercile (high predictability), + th2: middle tercile, + th3: higher tercile (low predictability) + The 'pos.t' list contains the position of each tercile in parameter + 'theta'.} } dyn_scores values from 0 to 1. A dyn_score of 1 indicates the highest diff --git a/man/RFTemp.Rd b/man/RFTemp.Rd index 957ccc918d42b5bbdc160b21d7b2cd3f86ad8b8f..e55e14c0de639fbb7815c4a93e039052e1c9d2ba 100644 --- a/man/RFTemp.Rd +++ b/man/RFTemp.Rd @@ -104,7 +104,7 @@ res <- RFTemp(t, lon, lat, o, lono, lato, xlim = c(4, 8), ylim = c(43, 46), \references{ Method described in ERA4CS MEDSCOPE milestone M3.2: High-quality climate prediction data available to WP4 here: -\ url{https://www.medscope-project.eu/the-project/deliverables-reports/} +\url{https://www.medscope-project.eu/the-project/deliverables-reports/} and in H2020 ECOPOTENTIAL Deliverable No. 8.1: High resolution (1-10 km) climate, land use and ocean change scenarios here: \url{https://ec.europa.eu/research/participants/documents/downloadPublic?documentIds=080166e5b6cd2324&appId=PPGMS}. diff --git a/man/SaveExp.Rd b/man/SaveExp.Rd index a9c0ac36d9e65636fcb938c60b9fb88404555bcb..c690d97edf7d4aab44d38b529cf0fcaf86aeb8db 100644 --- a/man/SaveExp.Rd +++ b/man/SaveExp.Rd @@ -18,6 +18,7 @@ SaveExp( ftime_dim = "time", var_dim = "var", memb_dim = "member", + drop_dims = NULL, single_file = FALSE, extra_string = NULL ) @@ -74,14 +75,18 @@ dimension.} By default, it is set to 'member'. It can be NULL if there is no member dimension.} +\item{drop_dims}{A vector of character strings indicating the dimension names +of length 1 that need to be dropped in order that they don't appear in the +netCDF file. It is NULL by default (optional).} + \item{single_file}{A logical value indicating if all object is saved in a unique file (TRUE) or in separated directories (FALSE). When it is FALSE, the array is separated for Datasets, variable and start date. It is FALSE -by default.} +by default (optional).} \item{extra_string}{A character string to be include as part of the file name, for instance, to identify member or realization. It would be added to the -file name between underscore characters.} +file name between underscore characters (optional).} } \value{ Multiple or single NetCDF files containing the data array.\cr @@ -112,19 +117,19 @@ from StartR package. If the original 's2dv_cube' object has been created from } \examples{ \dontrun{ -data <- lonlat_temp$exp$data -lon <- lonlat_temp$exp$coords$lon -lat <- lonlat_temp$exp$coords$lat +data <- lonlat_temp_st$exp$data +lon <- lonlat_temp_st$exp$coords$lon +lat <- lonlat_temp_st$exp$coords$lat coords <- list(lon = lon, lat = lat) -Datasets <- lonlat_temp$exp$attrs$Datasets +Datasets <- lonlat_temp_st$exp$attrs$Datasets varname <- 'tas' -Dates <- lonlat_temp$exp$attrs$Dates +Dates <- lonlat_temp_st$exp$attrs$Dates destination = './' -metadata <- lonlat_temp$exp$attrs$Variable$metadata +metadata <- lonlat_temp_st$exp$attrs$Variable$metadata SaveExp(data = data, destination = destination, coords = coords, Datasets = Datasets, varname = varname, Dates = Dates, metadata = metadata, single_file = TRUE, ftime_dim = 'ftime', - var_dim = NULL) + var_dim = 'var', dat_dim = 'dataset') } } diff --git a/man/as.s2dv_cube.Rd b/man/as.s2dv_cube.Rd index 30f9abd40e6f2d9bd26143a4cc9d12a588d48d11..9d7bbde4f70c8e5f3ed69b2c3eec89d31c0b78ac 100644 --- a/man/as.s2dv_cube.Rd +++ b/man/as.s2dv_cube.Rd @@ -85,7 +85,7 @@ data <- as.s2dv_cube(data) } } \seealso{ -\code{\link{s2dv_cube}}, \code{\link[s2dv]{Load}}, +\code{\link{s2dv_cube}}, \code{\link{CST_Start}}, \code{\link[startR]{Start}} and \code{\link{CST_Load}} } \author{ diff --git a/man/lonlat_prec_st.Rd b/man/lonlat_prec_st.Rd new file mode 100644 index 0000000000000000000000000000000000000000..817156319de7f4fb82522e78d807b4ae3397f0d4 --- /dev/null +++ b/man/lonlat_prec_st.Rd @@ -0,0 +1,54 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_data_st.R +\docType{data} +\name{lonlat_prec_st} +\alias{lonlat_prec_st} +\title{Sample Of Experimental Precipitation Data In Function Of Longitudes And Latitudes with Start} +\description{ +This sample data set contains a small cutout of gridded seasonal precipitation +forecast data from the Copernicus Climate Change ECMWF-System 5 forecast +system, to be used to demonstrate downscaling. Specifically, for the 'pr' +(precipitation) variable, for the first 6 forecast ensemble members, daily +values, for all 31 days in March following the forecast starting dates in +November of years 2010 to 2012, for a small 4x4 pixel cutout in a region in +the North-Western Italian Alps (44N-47N, 6E-9E). The data resolution is 1 +degree. +} +\details{ +The `CST_Start` call used to generate the data set in the infrastructure of +the Marconi machine at CINECA is shown next, working on files which were +extracted from forecast data available in the MEDSCOPE internal archive. + +\preformatted{ + path <- paste0('/esarchive/exp/ecmwf/system5c3s/daily_mean/', + '$var$_s0-24h/$var$_$sdate$.nc') + sdates = c('20101101', '20111101', '20121101') + latmin <- 44 + latmax <- 47 + lonmin <- 6 + lonmax <- 9 + + lonlat_prec_st <- CST_Start(dataset = path, + var = 'prlr', + member = indices(1:6), + sdate = sdates, + ftime = 121:151, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('time', 'ftime'), + member = c('member', 'ensemble')), + return_vars = list(ftime = 'sdate', + lon = NULL, lat = NULL), + retrieve = TRUE) +} +} +\author{ +Jost von Hardenberg \email{j.vonhardenberg@isac.cnr.it} + +An-Chi Ho \email{an.ho@bsc.es} +} +\keyword{data} diff --git a/man/lonlat_temp_st.Rd b/man/lonlat_temp_st.Rd new file mode 100644 index 0000000000000000000000000000000000000000..8dc554f2656a7d7d967d3683b66a49eb78dc2072 --- /dev/null +++ b/man/lonlat_temp_st.Rd @@ -0,0 +1,99 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sample_data_st.R +\docType{data} +\name{lonlat_temp_st} +\alias{lonlat_temp_st} +\title{Sample Of Experimental And Observational Climate Data In Function Of Longitudes And Latitudes with Start} +\description{ +This sample data set contains gridded seasonal forecast and corresponding +observational data from the Copernicus Climate Change ECMWF-System 5 forecast +system, and from the Copernicus Climate Change ERA-5 reconstruction. +Specifically, for the 'tas' (2-meter temperature) variable, for the 15 first +forecast ensemble members, monthly averaged, for the 3 first forecast time +steps (lead months 1 to 4) of the November start dates of 2000 to 2005, for +the Mediterranean region (27N-48N, 12W-40E). The data was generated on (or +interpolated onto, for the reconstruction) a rectangular regular grid of size +360 by 181. +} +\details{ +The `CST_Start` call used to generate the data set in the infrastructure of +the Earth Sciences Department of the Barcelona Supercomputing Center is shown +next. Note that `CST_Start` internally calls `startR::Start` and then uses +`as.s2dv_cube` that converts the `startR_array` into `s2dv_cube`. +\preformatted{ + lonlat_temp_st <- NULL + repos_exp <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') + sdates <- sapply(2000:2005, function(x) paste0(x, '1101')) + lonmax <- 40 + lonmin <- -12 + latmax <- 48 + latmin <- 27 + lonlat_temp_st$exp <- CST_Start(dataset = repos_exp, + var = 'tas', + member = indices(1:15), + sdate = sdates, + ftime = indices(1:3), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) + + dates <- c(paste0(2000, c(11, 12)), paste0(2001, c('01', 11, 12)), + paste0(2002, c('01', 11, 12)), paste0(2003, c('01', 11, 12)), + paste0(2004, c('01', 11, 12)), paste0(2005, c('01', 11, 12)), 200601) + dates <- sapply(dates, function(x) {paste0(x, '01')}) + dates <- as.POSIXct(dates, format = '%Y%m%d', 'UTC') + dim(dates) <- c(ftime = 3, sdate = 6) + + dates <- t(dates) + names(dim(dates)) <- c('sdate', 'ftime') + + path.obs <- '/esarchive/recon/ecmwf/era5/monthly_mean/$var$_f1h-r1440x721cds/$var$_$date$.nc' + lonlat_temp_st$obs <- CST_Start(dataset = path.obs, + var = 'tas', + date = unique(format(dates, '%Y%m')), + ftime = values(dates), + ftime_across = 'date', + ftime_var = 'ftime', + merge_across_dims = TRUE, + split_multiselected_dims = TRUE, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r360x181', + method = 'conservative'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, + lat = NULL, + ftime = 'date'), + retrieve = TRUE) + + library(lubridate) + dates_exp <- lonlat_temp_st$exp$attrs$Dates + lonlat_temp_st$exp$attrs$Dates <- floor_date(ymd_hms(dates_exp), unit = "months") + dim(lonlat_temp_st$exp$attrs$Dates) <- dim(dates_exp) + + dates_obs <- lonlat_temp_st$obs$attrs$Dates + lonlat_temp_st$obs$attrs$Dates <- floor_date(ymd_hms(dates_obs), unit = "months") + dim(lonlat_temp_st$obs$attrs$Dates) <- dim(dates_obs) + +} +} +\author{ +Nicolau Manubens \email{nicolau.manubens@bsc.es} +} +\keyword{data} diff --git a/man/print.s2dv_cube.Rd b/man/print.s2dv_cube.Rd new file mode 100644 index 0000000000000000000000000000000000000000..415e3f07f6b428558238634d040d3891e8c4ca61 --- /dev/null +++ b/man/print.s2dv_cube.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/print.s2dv_cube.R +\name{print.s2dv_cube} +\alias{print.s2dv_cube} +\title{Print method for s2dv_cube objects} +\usage{ +\method{print}{s2dv_cube}(x, ...) +} +\arguments{ +\item{x}{An 's2dv_cube' object.} + +\item{...}{Additional arguments of print function.} +} +\description{ +This is an S3 method of the generic 'print' for the class 's2dv_cube'. When +you will call 'print' on an 's2dv_cube' object, this method will display the +content of the object in a clear and informative way. +} +\details{ +The object will be displayed following 's2dv_cube' class conventions. The +top-level elements are: 'Data', a multidimensional array containing the +object's data; 'Dimensions', the dimensions of the array; 'Coordinates', the +array coordinates that match its dimensions, explicit coordinates have an +asterisk (*) at the beginning while index coordinates do not; and +'Attributes', which contains all the metadata of the object. For more +information about the 's2dv_cube', see \code{s2dv_cube()} and +\code{as.s2dv_cube()} functions. +} diff --git a/man/s2dv_cube.Rd b/man/s2dv_cube.Rd index e17a460781b027e02e4fcf5b401a8c0ebbd7ddd6..53ba4acb0f0ad300d23aaccf0af16269ab893bc2 100644 --- a/man/s2dv_cube.Rd +++ b/man/s2dv_cube.Rd @@ -18,7 +18,7 @@ s2dv_cube( } \arguments{ \item{data}{A multidimensional array with named dimensions, typically with -dimensions: dataset, member, sdate, ftime, lat and lon.} +dimensions: dataset, member, sdate, time, lat and lon.} \item{coords}{A list of named vectors with the coordinates corresponding to the dimensions of the data parameter. If any coordinate has dimensions, they @@ -84,7 +84,7 @@ elements in the structure:\cr \description{ This function allows to create an 's2dv_cube' object by passing information through its parameters. This function will be needed if the data -hasn't been loaded using CST_Load or has been transformed with other methods. +hasn't been loaded using CST_Start or has been transformed with other methods. An 's2dv_cube' object has many different components including metadata. This function will allow to create 's2dv_cube' objects even if not all elements are defined and for each expected missed parameter a warning message will be @@ -134,7 +134,7 @@ exp8 <- s2dv_cube(data = exp_original, coords = coords, class(exp8) } \seealso{ -\code{\link[s2dv]{Load}} and \code{\link{CST_Load}} +\code{\link[s2dv]{Load}} and \code{\link{CST_Start}} } \author{ Perez-Zanon Nuria, \email{nuria.perez@bsc.es} diff --git a/tests/testthat/test-CST_Analogs.R b/tests/testthat/test-CST_Analogs.R index 80e5da861cba5e430e3c5dd78b6c7f143d298156..808c6317dc43e5fbaf8b46531fe1eeefccbac180 100644 --- a/tests/testthat/test-CST_Analogs.R +++ b/tests/testthat/test-CST_Analogs.R @@ -8,7 +8,9 @@ obs1 <- c(rnorm(1:180), exp1 * 1.2) dim(obs1) <- c(time = 10, lat = 4, lon = 5) time_obsL1 <- paste(rep("01", 10), rep("01", 10), 1994 : 2003, sep = "-") +dim(time_obsL1) <- c(time = 10) time_expL1 <- "01-01-1994" +dim(time_expL1) <- c(time = 1) lon1 <- seq(0, 20, 5) lat1 <- seq(0, 15, 4) coords = list(lat = lat1, lon = lon1) @@ -30,18 +32,15 @@ test_that("1. Input checks: CST_Analogs", { # Check 's2dv_cube' expect_error( CST_Analogs(expL = 1, obsL = 1), - paste0("Parameter 'expL' and 'obsL' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'expL' and 'obsL' must be of the class 's2dv_cube'.") ) expect_error( CST_Analogs(expL = exp, obsL = obs, expVar = 1), - paste0("Parameter 'expVar' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'expVar' must be of the class 's2dv_cube'.") ) expect_error( CST_Analogs(expL = exp, obsL = obs, obsVar = 1), - paste0("Parameter 'obsVar' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'obsVar' must be of the class 's2dv_cube'.") ) # Check 'obsL' object structure @@ -144,7 +143,7 @@ test_that("3. Output checks" , { ) expect_equal( names(res), - c('data', 'coords', 'attrs') + c('data', 'coords', 'attrs', 'dims') ) expect_equal( dim(res$data), diff --git a/tests/testthat/test-CST_Anomaly.R b/tests/testthat/test-CST_Anomaly.R index 772352aa1e4280219b83f0dff812401731dceddb..8c9b149fe857a50e30b1486afc710729f9e27a66 100644 --- a/tests/testthat/test-CST_Anomaly.R +++ b/tests/testthat/test-CST_Anomaly.R @@ -49,7 +49,7 @@ test_that("1. Input checks", { # s2dv_cube expect_error( CST_Anomaly(exp = 1, obs = 1), - "Parameter 'exp' and 'obs' must be of the class 's2dv_cube', as output by CSTools::CST_Load." + "Parameter 'exp' and 'obs' must be of the class 's2dv_cube'." ) # exp and obs expect_error( @@ -58,7 +58,7 @@ test_that("1. Input checks", { ) expect_error( CST_Anomaly(exp = exp2, obs = obs), - "Parameter 'exp' and 'obs' must have same dimension names in element 'data'." + "Parameter 'dat_dim' is not found in 'exp' dimensions." ) # dim_anom expect_error( @@ -87,10 +87,6 @@ test_that("1. Input checks", { CST_Anomaly(exp = exp, obs = obs, memb_dim = 1), "Parameter 'memb_dim' must be a character string." ) - expect_error( - names(CST_Anomaly(exp4, obs4, dim_anom = 'sdates')), - "Parameter 'memb_dim' is not found in 'exp' or in 'obs' dimension." - ) # filter_span expect_warning( CST_Anomaly(exp = exp, obs = obs, filter_span = 'a'), @@ -98,8 +94,8 @@ test_that("1. Input checks", { ) # dat_dim expect_error( - names(CST_Anomaly(exp4, obs4, dim_anom = 'sdates', memb_dim = 'members')), - "Parameter 'dat_dim' is not found in 'exp' or 'obs' dimension in element 'data'. Set it as NULL if there is no dataset dimension." + CST_Anomaly(exp4, obs4, dim_anom = 'sdates', memb_dim = 'members', dat_dim = 1), + "Parameter 'dat_dim' must be a character vector." ) # ftime_dim expect_error( diff --git a/tests/testthat/test-CST_BiasCorrection.R b/tests/testthat/test-CST_BiasCorrection.R index ec9b596e889a56798bfab20e55df2e467eece00a..61b40c7401a425ca735b4ea4f52dd15213c263be 100644 --- a/tests/testthat/test-CST_BiasCorrection.R +++ b/tests/testthat/test-CST_BiasCorrection.R @@ -108,9 +108,8 @@ test_that("1. Input checks", { ) expect_warning( CST_BiasCorrection(exp = exp2, obs = obs2), - "Parameter 'obs' contains NA values", "Parameter 'exp' contains NA values." - ) + ) # exp_cor expect_error( CST_BiasCorrection(exp = exp1, obs = obs1, exp_cor = exp_cor1, sdate_dim = 'time'), diff --git a/tests/testthat/test-CST_Calibration.R b/tests/testthat/test-CST_Calibration.R index 64a09e5a6cbc1f93a9a1a28ed05c4598adae7d56..491aff29556fc0a67f4abc9fb5ad11500aca272d 100644 --- a/tests/testthat/test-CST_Calibration.R +++ b/tests/testthat/test-CST_Calibration.R @@ -91,9 +91,7 @@ test_that("1. Input checks", { ) expect_warning( CST_Calibration(exp = exp2, obs = obs2, exp_cor = exp2), - "Parameter 'obs' contains NA values", - "Parameter 'exp' contains NA values.", - "Parameter 'exp_cor' contains NA values." + "Parameter 'exp' contains NA values." ) # exp_cor expect_error( @@ -190,9 +188,10 @@ test_that("1. Input checks", { CST_Calibration(exp = exp, obs = obs, na.rm = 1), "Parameter 'na.rm' must be a logical value." ) - expect_warning( - CST_Calibration(exp = exp, obs = obs, na.rm = c(T,F)), - "Paramter 'na.rm' has length greater than 1, and only the fist element is used." + # na.fill + expect_error( + CST_Calibration(exp = exp, obs = obs, na.fill = 1), + "Parameter 'na.fill' must be a logical value." ) # cal.method expect_error( @@ -508,7 +507,7 @@ test_that("7. Output checks: dat4", { expect_equal( Calibration(exp = array(1:6, dim = c(member = 2, sdate = 3)), obs = array(1:3, dim = c(sdate = 3))), - array(dim = c(member = 2, sdate = 3)) + array(as.numeric(NA), dim = c(member = 2, sdate = 3)) ) ) suppressWarnings( diff --git a/tests/testthat/test-CST_CategoricalEnsCombination.R b/tests/testthat/test-CST_CategoricalEnsCombination.R index a52f822b9a4a28ff8545caaa067e3587b3ea79dd..0a13866385283f08d7d08763825b373590685428 100644 --- a/tests/testthat/test-CST_CategoricalEnsCombination.R +++ b/tests/testthat/test-CST_CategoricalEnsCombination.R @@ -26,7 +26,8 @@ obs2$data[1, 1, 2, 1, 1, 1] <- NA test_that("Sanity checks", { expect_error( CST_CategoricalEnsCombination(exp = 1), - "Parameter 'exp' and 'obs' must be of the class 's2dv_cube', " + paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", + "as output by CSTools::CST_Load.") ) expect_error( CST_CategoricalEnsCombination(obs = 1), @@ -83,6 +84,6 @@ test_that("Sanity checks", { ) expect_warning( CST_CategoricalEnsCombination(exp = exp2, obs = obs2), - "Parameter 'obs' contains NA values", "Parameter 'exp' contains NA values." + "Parameter 'exp' contains NA values." ) -}) \ No newline at end of file +}) diff --git a/tests/testthat/test-CST_MergeDims.R b/tests/testthat/test-CST_MergeDims.R index 0717a3064d595dc117326ee80be445884095b3cf..f7eac6acf5369988d1bdff0f0a38921810b8f215 100644 --- a/tests/testthat/test-CST_MergeDims.R +++ b/tests/testthat/test-CST_MergeDims.R @@ -3,8 +3,7 @@ test_that("Sanity checks", { expect_error( CST_MergeDims(data = 1), - paste0("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.")) + paste0("Parameter 'data' must be of the class 's2dv_cube'.")) data <- list(data = 1:10) class(data) <- 's2dv_cube' expect_error( diff --git a/tests/testthat/test-CST_MultiEOF.R b/tests/testthat/test-CST_MultiEOF.R index 66a6352516148ddc6e88ae0148c3c404202f55ec..a2f66257b54a16c27381cbb47b1b01b31da4ef27 100644 --- a/tests/testthat/test-CST_MultiEOF.R +++ b/tests/testthat/test-CST_MultiEOF.R @@ -32,6 +32,9 @@ mod3 <- cos( 0.5 + seq ) + sin( seq ^ 2 * 0.2 ) dim(mod3) <- c(dataset = 2, member = 3, sdate = 4, ftime = 5, lat = 6, lon = 8) exp3$data <- mod3 +dat3 <- mod3 +dim(dat3) <- c(var = 1, dim(mod3)) + # dat0 dat0 <- exp1 dat01 <- exp2 @@ -39,27 +42,39 @@ dat0$coords <- NULL dat01$coords <- NULL dat02 <- dat0 dat03 <- dat01 +dat04 <- exp1 +dat04$attrs$Dates <- NULL dat02$coords <- list(long = seq(1:4), lati = seq(1:4)) dat03$coords <- list(long = seq(1:4), lati = seq(1:4)) +# dat4 +exp4 <- array(runif(1280)*280, dim = c(dataset = 2, member = 2, sdates = 3, + time = 3, latitude = 4, longitude = 4, vars = 1)) +lon4 <- seq(0, 3) +lat4 <- seq(47, 44) +dates4 <- c("2000-11-01", "2000-12-01", "2001-01-01", "2001-11-01", + "2001-12-01", "2002-01-01", "2002-11-01", "2002-12-01", "2003-01-01") +Dates4 <- as.POSIXct(dates4, format = "%Y-%m-%d") +dim(Dates4) <- c(ftime = 3, sdate = 3) + ############################################## test_that("1. Input checks", { expect_error( CST_MultiEOF(datalist = 1), - paste0("Elements of the list in parameter 'datalist' must be of the class ", - "'s2dv_cube', as output by CSTools::CST_Load.") + paste0("Elements of the list in parameter 'datalist' must be of the class.", + "'s2dv_cube'.") ) - # Check if all dims equal - expect_error( - CST_MultiEOF(list(exp1, exp03)), - "Input data fields must all have the same dimensions." - ) - # Know spatial coordinates names expect_error( CST_MultiEOF(list(dat0, dat01)), paste0("Parameter 'datalist' must have 'data', 'coords' and 'attrs' elements ", "within the 's2dv_cube' structure.") ) + # Dates + expect_error( + CST_MultiEOF(list(dat04)), + "Element 'Dates' is not found in 'attrs' list of the first array." + ) + # coordinates expect_error( CST_MultiEOF(list(dat02, dat03)), paste0("Spatial coordinate names do not match any of the names accepted by ", @@ -67,16 +82,69 @@ test_that("1. Input checks", { " 'y', 'j', 'nav_lat'. Longitudes accepted names: 'lon', 'lons',", " 'longitude', 'x', 'i', 'nav_lon'.") ) + # Check if all dims equal + expect_error( + CST_MultiEOF(list(exp1, exp03)), + "Input data fields must all have the same dimensions." + ) + expect_error( + CST_MultiEOF(list(exp1, exp2, exp3), lon_lim = c(-250, -245), lat_lim = c(10, 25)), + "No intersection between longitude bounds and data domain." + ) +}) + +############################################## + +test_that("2. Input checks MultiEOF", { + # time + expect_warning( + MultiEOF(data = dat3, lon = lon, lat = lat, time = d), + "The parameter 'time' is deprecated, use 'dates' instead." + ) + expect_error( + MultiEOF(data = 1, lon = lon, lat = lat, time = d), + "Parameter 'data' must have dimension names." + ) + # lon_dim + expect_error( + MultiEOF(data = dat3, lon = lon, lat = lat, dates = d, lon_dim = 'lons'), + "Parameter 'lon_dim' is not found in 'data' dimension." + ) + # lat_dim + expect_error( + MultiEOF(data = dat3, lon = lon, lat = lat, dates = d, lat_dim = 1), + "Parameter 'lat_dim' must be a character string." + ) + # lon expect_error( MultiEOF(data = array(rnorm(96), dim = c(var = 2, lonss = 8, latss = 6)), lon = seq(1:7), lat = seq(1:5), lon_dim = 'lonss', lat_dim = 'latss'), - paste0("Spatial coordinate names do not match any of the names accepted by ", - "the package.") + paste0("Parameter 'lon' must be a numeric vector with the same ", + "length as the longitude dimension of 'data'.") ) + # lat expect_error( - CST_MultiEOF(list(exp1, exp2, exp3), lon_lim = c(-250, -245), lat_lim = c(10, 25)), - "No intersection between longitude bounds and data domain.") -}) + MultiEOF(data = array(rnorm(96), dim = c(var = 2, lonss = 8, latss = 6)), + lon = seq(1:8), lat = seq(1:5), lon_dim = 'lonss', lat_dim = 'latss'), + paste0("Parameter 'lat' must be a numeric vector with the same ", + "length as the latitude dimension of 'data'.") + ) + # time_dim + expect_error( + MultiEOF(data = dat3, lon = lon, lat = lat, dates = d, time_dim = 'lons'), + "Parameter 'time_dim' is not found in 'data' dimension." + ) + # sdate_dim + expect_error( + MultiEOF(data = dat3, lon = lon, lat = lat, dates = d, sdate_dim = 1), + "Parameter 'sdate_dim' must be a character string." + ) + # var_dim + expect_error( + MultiEOF(data = dat3, lon = lon, lat = lat, dates = d, var_dim = 'vars'), + "Parameter 'var_dim' is not found in 'data' dimension." + ) +}) ############################################## @@ -84,47 +152,47 @@ test_that("2. Output checks", { cal <- CST_MultiEOF(datalist = list(exp1, exp2, exp3), neof_composed=2) expect_equal( length(cal), - 5 + 6 ) dimexp = dim(exp1$data) expect_equal( - dim(cal$coeff), + dim(cal$coeff$data), c(dimexp["ftime"], dimexp["sdate"], eof=2, dimexp["dataset"], dimexp["member"]) ) expect_equal( - dim(cal$variance), + dim(cal$variance$data), c(eof = 2, dimexp["dataset"], dimexp["member"]) ) expect_equal( - dim(cal$eof_pattern), + dim(cal$eof_pattern$data), c(var = 3, dimexp["lon"], dimexp["lat"], eof = 2, dimexp["dataset"], dimexp["member"]) ) expect_equal( - cal$variance[1, 1, 1], + cal$variance$data[1, 1, 1], 0.2909419, tolerance = .00001 ) expect_equal( - cal$coeff[2, 1, 1, 1, 1], + cal$coeff$data[2, 1, 1, 1, 1], 0.5414261, tolerance = .00001 ) expect_equal( - cal$eof_pattern[1, 2, 2, 2, 1, 1], + cal$eof_pattern$data[1, 2, 2, 2, 1, 1], 0.3932484, tolerance = .00001 ) cal <- CST_MultiEOF(list(exp1, exp2, exp3), neof_max = 5, neof_composed = 2, minvar = 0.2) expect_equal( - cal$coeff[2, 1, 1, 1, 1], + cal$coeff$data[2, 1, 1, 1, 1], -0.6117927, tolerance = .00001 ) cal <- CST_MultiEOF(list(exp1, exp2, exp3), lon_lim = c(5, 30), lat_lim = c(10, 25)) expect_equal( - cal$coeff[2, 1, 1, 1, 1], + cal$coeff$data[2, 1, 1, 1, 1], 0.8539488, tolerance = .00001 ) @@ -152,6 +220,35 @@ test_that("2. Output checks", { exp3$data[1, 1, 1, 1, 1, 1] = NaN expect_error( CST_MultiEOF(list(exp1, exp3), neof_max = 8, neof_composed=2), - "Input data contain NA values." + paste0("Detected certain grid points have NAs but not consistent across time ", + "dimension. If the grid point is NA, it should have NA at all time step.") ) }) + +############################################## + +test_that("3. Output checks II", { + # time_dim, sdate_dim, var_dim, lon_dim, lat_dim + cal <- MultiEOF(data = exp4, lon = lon4, lat = lat4, dates = Dates4, + time_dim = 'time', sdate_dim = 'sdates', var_dim = 'vars', + lon_dim = 'longitude', lat_dim = 'latitude') + expect_equal( + dim(cal[[3]]), + c(vars = 1, longitude = 4, latitude = 4, eof = 5, dataset = 2, member = 2) + ) + # NA + exp4_1 <- exp4 + exp4_1[1,2,1,1,1:2,1,1] <- NA # random NA + expect_error( + MultiEOF(data = exp4_1, lon = lon4, lat = lat4, dates = Dates4, + time_dim = 'time', sdate_dim = 'sdates', var_dim = 'vars', + lon_dim = 'longitude', lat_dim = 'latitude'), + paste0("Detected certain grid points have NAs but not consistent across time ", + "dimension. If the grid point is NA, it should have NA at all time step.") + ) + exp4_2 <- exp4 + exp4_2[,,,,1,1,] <- NA # spatial NA + cal <- MultiEOF(data = exp4_2, lon = lon4, lat = lat4, dates = Dates4, + time_dim = 'time', sdate_dim = 'sdates', var_dim = 'vars', + lon_dim = 'longitude', lat_dim = 'latitude') +}) diff --git a/tests/testthat/test-CST_MultivarRMSE.R b/tests/testthat/test-CST_MultivarRMSE.R index f7bc347c844773cf85c9c05e261bf73c528613cd..1cc87593cedb3095c9f2f914e0a80ddcfd8d56e4 100644 --- a/tests/testthat/test-CST_MultivarRMSE.R +++ b/tests/testthat/test-CST_MultivarRMSE.R @@ -156,7 +156,7 @@ test_that("2. Output checks", { memb_dim = 'members', sdate_dim = 'sdates') expect_equal( names(res1), - c('data', 'coords', 'attrs') + c('data', 'coords', 'attrs', 'dims') ) expect_equal( dim(res1$data), diff --git a/tests/testthat/test-CST_QuantileMapping.R b/tests/testthat/test-CST_QuantileMapping.R index e12f1d9a87353abf17019441dfc87c6b199efd3a..1f58ad4be4dd1861b9bb831cd9b5c2a38c4798f0 100644 --- a/tests/testthat/test-CST_QuantileMapping.R +++ b/tests/testthat/test-CST_QuantileMapping.R @@ -113,8 +113,7 @@ test_that("1. Sanity checks", { # s2dv_cube expect_error( CST_QuantileMapping(exp = 1), - paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") ) expect_error( CST_QuantileMapping(exp = exp1), @@ -122,13 +121,11 @@ test_that("1. Sanity checks", { ) expect_error( CST_QuantileMapping(exp = exp1, obs = 1), - paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'exp' and 'obs' must be of the class 's2dv_cube'.") ) expect_error( CST_QuantileMapping(exp = exp1, obs = obs1, exp_cor = 1), - paste0("Parameter 'exp_cor' must be of the class 's2dv_cube', as output ", - "by CSTools::CST_Load.") + paste0("Parameter 'exp_cor' must be of the class 's2dv_cube'.") ) # exp and obs expect_error( diff --git a/tests/testthat/test-CST_SaveExp.R b/tests/testthat/test-CST_SaveExp.R index 7f6332703111445e711d9ad53a94d22c2d7ff43e..f39dffe9e147739b101725af556378572cd8db71 100644 --- a/tests/testthat/test-CST_SaveExp.R +++ b/tests/testthat/test-CST_SaveExp.R @@ -49,8 +49,7 @@ test_that("1. Input checks: CST_SaveExp", { # s2dv_cube expect_error( CST_SaveExp(data = 1), - paste0("Parameter 'data' must be of the class 's2dv_cube', ", - "as output by CSTools::CST_Load.") + paste0("Parameter 'data' must be of the class 's2dv_cube'.") ) # structure expect_error( @@ -103,7 +102,7 @@ test_that("1. Input checks: CST_SaveExp", { # CST_SaveExp(data = cube1, ftime_dim = 'ftime', memb_dim = NULL, # dat_dim = NULL, var_dim = NULL, startdates = '20100101'), # paste0("Parameter 'startdates' doesn't have the same length ", - # "as dimension '", sdate_dim,"', it will not be used.") + # "as dimension '", 'sdate',"', it will not be used.") # ) # # metadata # expect_warning( @@ -175,6 +174,31 @@ test_that("1. Input checks", { Dates = as.Date('2022-02-01', format = "%Y-%m-%d")), paste0("Parameter 'Dates' must have dimension names.") ) + # # drop_dims + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 1), + # paste0("Parameter 'drop_dims' must be character string containing ", + # "the data dimension names to be dropped. It will not be used.") + # ) + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 'time'), + # paste0("Parameter 'drop_dims' must be character string containing ", + # "the data dimension names to be dropped. It will not be used.") + # ) + # expect_warning( + # SaveExp(data = dat2, coords = coords2, + # metadata = list(tas = list(level = '2m')), + # Dates = dates2, ftime_dim = 'ftime', memb_dim = NULL, + # dat_dim = NULL, var_dim = NULL, drop_dims = 'sdate'), + # paste0("Parameter 'drop_dims' can only contain dimension names ", + # "that are of length 1. It will not be used.") + # ) # # varname # expect_warning( # SaveExp(data = dat2, coords = coords2, diff --git a/tests/testthat/test-CST_SplitDim.R b/tests/testthat/test-CST_SplitDim.R index 0c8f2e013e815c94c8d88157aca12e60b3f2b0cc..45e2b1a89cf9895241f2181ea3ea324a2700fc23 100644 --- a/tests/testthat/test-CST_SplitDim.R +++ b/tests/testthat/test-CST_SplitDim.R @@ -51,8 +51,7 @@ class(data4) <- 's2dv_cube' test_that("1. Input checks", { expect_error( CST_SplitDim(data = 1), - paste0("Parameter 'data' must be of the class 's2dv_cube', as output by ", - "CSTools::CST_Load.") + paste0("Parameter 'data' must be of the class 's2dv_cube'.") ) expect_error( CST_SplitDim(data = data1), diff --git a/tests/testthat/test-CST_Subset.R b/tests/testthat/test-CST_Subset.R index 2d270e38a1eb315f78f31ac191e9a0f5c7fcf29a..9fc04b48408c654e40c13f3537a5daff387261f9 100644 --- a/tests/testthat/test-CST_Subset.R +++ b/tests/testthat/test-CST_Subset.R @@ -117,8 +117,8 @@ suppressWarnings( sdate = c('20170101'), ensemble = indices(1), time = indices(1:3), - lat = indices(1:10), - lon = indices(1:10), + lat = indices(1:2), + lon = indices(1:2), synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', @@ -146,7 +146,7 @@ test_that("3. Output checks with Start", { # Check dimensions expect_equal( dim(res8$data), - c(dat = 1, var = 1, sdate = 1, ensemble = 1, time = 3, lat = 10, lon = 2) + c(dat = 1, var = 1, sdate = 1, ensemble = 1, time = 3, lat = 2, lon = 2) ) expect_equal( dim(res8$data), @@ -154,7 +154,7 @@ test_that("3. Output checks with Start", { ) expect_equal( dim(res10$data), - c(time = 3, lat = 10, lon = 2) + c(time = 3, lat = 2, lon = 2) ) # Check coordinates expect_equal( @@ -227,7 +227,7 @@ test_that("3. Output checks with Start", { var_dim = 'var', drop = 'non-selected') expect_equal( dim(res11$data), - c(dat = 1, var = 1, time = 2, lat = 10, lon = 2) + c(dat = 1, var = 1, time = 2, lat = 2, lon = 2) ) expect_equal( names(res11$coords), diff --git a/tests/testthat/test-CST_WeatherRegimes.R b/tests/testthat/test-CST_WeatherRegimes.R index 796c551923623732e28b6ba0c00ebc8879d4ec59..59eeb38800bad55d3e637c999776509ade58a6a9 100644 --- a/tests/testthat/test-CST_WeatherRegimes.R +++ b/tests/testthat/test-CST_WeatherRegimes.R @@ -27,8 +27,7 @@ class(data1) <- 's2dv_cube' test_that("1. Input checks", { expect_error( CST_WeatherRegimes(data = 1), - paste0("Parameter 'data' must be of the class 's2dv_cube', as output by ", - "CSTools::CST_Load.") + paste0("Parameter 'data' must be of the class 's2dv_cube'.") ) # Check 'exp' object structure expect_error( @@ -84,9 +83,11 @@ test_that("1. Input checks", { ############################################## test_that("2. Output checks", { - expect_equal( - names(dim(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), - c('lat', 'lon', 'cluster') + suppressWarnings( + expect_equal( + names(dim(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), + c('lat', 'lon', 'cluster') + ) ) data1 <- 1 : 400 dim(data1) <- c(sdate = 2, ftime = 10, lat = 5, lon = 4) @@ -137,13 +138,17 @@ test_that("2. Output checks", { data1[, 2, 3] <- NA data1 <- list(data = data1, coords = list(lat = 1:5, lon = 1:4)) class(data1) <- 's2dv_cube' - expect_equal( - any(is.na(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), - TRUE + suppressWarnings( + expect_equal( + any(is.na(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), + TRUE + ) ) - expect_equal( - names(dim(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), - c('lat', 'lon', 'cluster') + suppressWarnings( + expect_equal( + names(dim(CST_WeatherRegimes(data = data1, ncenters = 3, EOFs = FALSE)$data)), + c('lat', 'lon', 'cluster') + ) ) }) diff --git a/tests/testthat/test-PlotWeeklyClim.R b/tests/testthat/test-PlotWeeklyClim.R index 19aae749329b91b207050448928ff7668558bb37..5fc203f491e70d56ffc50eaf14aaada2c4ae5c51 100644 --- a/tests/testthat/test-PlotWeeklyClim.R +++ b/tests/testthat/test-PlotWeeklyClim.R @@ -2,6 +2,7 @@ # dat1 dat1 <- array(rnorm(1*7), dim = c(dat = 1, var = 1, sdate = 1, time = 7)) +dat2 <- array(rnorm(21), dim = c(dat = 1, var = 1, sdate = 3, time = 7)) ############################################## @@ -9,79 +10,125 @@ test_that("1. Input checks", { # data expect_error( PlotWeeklyClim(data = array(1:92), first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), "Parameter 'data' must have named dimensions." ) expect_error( PlotWeeklyClim(data = data.frame(week = 1:92), first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), paste0("If parameter 'data' is a data frame, it must contain the ", "following column names: 'week', 'clim', 'p10', 'p90', 'p33', ", "'p66', 'week_mean', 'day' and 'data'.") ) expect_error( PlotWeeklyClim(data = 1:92, first_date = '2020-03-01', - ref_period_ini = 1993, ref_period_end = 2021), + ref_period = 1993:2021), "Parameter 'data' must be an array or a data frame." ) # time_dim expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = 2020, ref_period_end = 2020, time_dim = 1), + ref_period = 2020, time_dim = 1), "Parameter 'time_dim' must be a character string." ) expect_error( PlotWeeklyClim(data = array(rnorm(1), dim = c(dat = 1)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), "Parameter 'time_dim' is not found in 'data' dimension." ) expect_error( PlotWeeklyClim(data = array(rnorm(1*7), dim = c(time = 6)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), paste0("Parameter 'data' must have the dimension 'time_dim' of length ", "equal or grater than 7 to compute the weekly means.") ) # sdate_dim expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = 2020, ref_period_end = 2020, - sdate_dim = 1), + ref_period = 2020, sdate_dim = 1), "Parameter 'sdate_dim' must be a character string." ) expect_warning( PlotWeeklyClim(data = array(rnorm(7), dim = c(time = 7)), - first_date = '2020-03-01', ref_period_ini = 2020, - ref_period_end = 2020), + first_date = '2020-03-01', ref_period = 2020), paste0("Parameter 'sdate_dim' is not found in 'data' dimension. ", "A dimension of length 1 has been added.") ) - # ref_period_ini + # legend expect_error( PlotWeeklyClim(data = dat1, first_date = '2020-03-01', - ref_period_ini = "2020", ref_period_end = 2020), - "Parameters 'ref_period_ini' and 'ref_period_end' must be numeric." + ref_period = 2020, legend = 1), + "Parameter 'legend' must be a logical value." + ) + # ref_period (1) + expect_error( + PlotWeeklyClim(data = dat1, first_date = '2020-03-01', ref_period = "2020"), + "Parameter 'ref_period' must be numeric." ) # first_date expect_error( - PlotWeeklyClim(data = dat1, first_date = 2020-03-01, - ref_period_ini = 2020, ref_period_end = 2020), + PlotWeeklyClim(data = dat1, first_date = 2020-03-01, ref_period = 2020), paste0("Parameter 'first_date' must be a character string ", "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", "or 'Dates' class.") ) + # data_years expect_error( - PlotWeeklyClim(data = dat1, first_date = 'a', - ref_period_ini = 2020, ref_period_end = 2020), - paste0("Parameter 'first_date' must be a character string ", + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = '2020'), + "Parameter 'data_years' must be numeric." + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', ref_period = 2020, + data_years = 2005:2020), + paste0("Parameter 'data_years' must have the same length as the ", + "dimension 'sdate' of 'data'.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2010-03-01', + ref_period = 2020:2021, data_years = 2018:2020), + paste0("The 'ref_period' must be included in the 'data_years' ", + "period.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2021-03-01', + ref_period = 2018:2019, data_years = 2018:2020), + paste0("Parameter 'first_date' must be a date included ", + "in the 'data_years' period.") + ) + # ref_period (2) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2021), + paste0("Parameter 'ref_period' must have the same length as the ", + "dimension 'sdate' of 'data' if 'data_years' is not provided.") + ) + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2017:2019), + paste0("If parameter 'data_years' is NULL, parameter 'first_date' ", + "must be a date included in the 'ref_period' period.") + ) + # last_date + expect_error( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = 2020-03-01), + paste0("Parameter 'last_date' must be a character string ", "indicating the date in the format 'yyyy-mm-dd', 'POSIXct' ", "or 'Dates' class.") ) - expect_error( - PlotWeeklyClim(data = dat1, first_date = '2020-03-01', ref_period_ini = 2021, - ref_period_end = 2022), - "Parameter 'first_date' must be a date included in the reference period." + expect_warning( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, last_date = '2020-03-08'), + paste0("Parameter 'last_date' is greater than the last date ", + "of 'data'. The last date of 'data' will be used.") + ) + # ylim + expect_warning( + PlotWeeklyClim(data = dat2, first_date = '2020-03-01', + ref_period = 2020:2022, ylim = 'i'), + paste0("Parameter 'ylim' can't be a character string, it will ", + "not be used.") ) }) diff --git a/tests/testthat/test-as.s2dv_cube.R b/tests/testthat/test-as.s2dv_cube.R index f2343080560a11e72ab0f643b7c8df2d9dd33f63..8ff195827853e4e974a147ea75d2617786c9e22e 100644 --- a/tests/testthat/test-as.s2dv_cube.R +++ b/tests/testthat/test-as.s2dv_cube.R @@ -17,145 +17,145 @@ test_that("1. Input checks", { ############################################## -test_that("2. Tests from Load()", { - startDates <- c('20001101', '20011101') - suppressWarnings( - ob1 <- Load(var = 'tas', exp = 'system5c3s', - nmember = 2, sdates = startDates, - leadtimemax = 3, latmin = 30, latmax = 35, - lonmin = 10, lonmax = 20, output = 'lonlat') - ) - res1 <- as.s2dv_cube(ob1) +# test_that("2. Tests from Load()", { +# startDates <- c('20001101', '20011101') +# suppressWarnings( +# ob1 <- Load(var = 'tas', exp = 'system5c3s', +# nmember = 2, sdates = startDates, +# leadtimemax = 3, latmin = 30, latmax = 35, +# lonmin = 10, lonmax = 20, output = 'lonlat') +# ) +# res1 <- as.s2dv_cube(ob1) - # dimensions - expect_equal( - dim(res1$data), - c(dataset = 1, member = 2, sdate = 2, ftime = 3, lat = 6, lon = 11) - ) - # elements - expect_equal( - names(res1), - c("data", "dims", "coords", "attrs") - ) - expect_equal( - names(res1$attrs), - c("Variable", "Datasets", "Dates", "when", "source_files", - "not_found_files", "load_parameters") - ) - # coordinates - expect_equal( - attributes(res1$coords$sdate), - list(indices = FALSE) - ) - expect_equal( - attributes(res1$coords$ftime), - list(indices = TRUE) - ) - expect_equal( - dim(res1$coords$lat), - NULL - ) - expect_equal( - dim(res1$coords$lon), - NULL - ) - expect_equal( - length(res1$coords$lat), - 6 - ) - # Dates - expect_equal( - dim(res1$attrs$Dates), - c(ftime = 3, sdate = 2) - ) -}) +# # dimensions +# expect_equal( +# dim(res1$data), +# c(dataset = 1, member = 2, sdate = 2, ftime = 3, lat = 6, lon = 11) +# ) +# # elements +# expect_equal( +# names(res1), +# c("data", "dims", "coords", "attrs") +# ) +# expect_equal( +# names(res1$attrs), +# c("Variable", "Datasets", "Dates", "when", "source_files", +# "not_found_files", "load_parameters") +# ) +# # coordinates +# expect_equal( +# attributes(res1$coords$sdate), +# list(indices = FALSE) +# ) +# expect_equal( +# attributes(res1$coords$ftime), +# list(indices = TRUE) +# ) +# expect_equal( +# dim(res1$coords$lat), +# NULL +# ) +# expect_equal( +# dim(res1$coords$lon), +# NULL +# ) +# expect_equal( +# length(res1$coords$lat), +# 6 +# ) +# # Dates +# expect_equal( +# dim(res1$attrs$Dates), +# c(ftime = 3, sdate = 2) +# ) +# }) ############################################## -test_that("3. Tests from Load()", { - obs_path <- list(name = "ERA5", - path = "/esarchive/recon/ecmwf/era5/$STORE_FREQ$_mean/$VAR_NAME$_f1h/$VAR_NAME$_$YEAR$$MONTH$.nc") - ob2 <- Load(var = 'windagl100', obs = list(obs_path), - sdates = '20180301', nmember = 1, - leadtimemin = 1, leadtimemax = 1, - storefreq = "monthly", sampleperiod = 1, - latmin = 36, latmax = 38, lonmin = 0, lonmax = 4, - output = 'lonlat', nprocs = 1, grid = 'r360x181') +# test_that("3. Tests from Load()", { +# obs_path <- list(name = "ERA5", +# path = "/esarchive/recon/ecmwf/era5/$STORE_FREQ$_mean/$VAR_NAME$_f1h/$VAR_NAME$_$YEAR$$MONTH$.nc") +# ob2 <- Load(var = 'windagl100', obs = list(obs_path), +# sdates = '20180301', nmember = 1, +# leadtimemin = 1, leadtimemax = 1, +# storefreq = "monthly", sampleperiod = 1, +# latmin = 36, latmax = 38, lonmin = 0, lonmax = 4, +# output = 'lonlat', nprocs = 1, grid = 'r360x181') - res2 <- as.s2dv_cube(ob2) +# res2 <- as.s2dv_cube(ob2) - # dimensions - expect_equal( - dim(res2$data), - c(dataset = 1, member = 1, sdate = 1, ftime = 1, lat = 3, lon = 5) - ) - # elements - expect_equal( - names(res2$attrs), - c("Variable", "Datasets", "Dates", "when", "source_files", - "not_found_files", "load_parameters") - ) - # coordinates - expect_equal( - attributes(res2$coords$sdate), - list(indices = FALSE) - ) - expect_equal( - unlist(res2$coords)[1:4], - c(dataset = "ERA5", member = "1", sdate = "20180301", ftime = "1") - ) - expect_equal( - dim(res2$coords$ftime), - NULL - ) - expect_equal( - length(res2$coords$lat), - 3 - ) - # Dates - expect_equal( - dim(res2$attrs$Dates), - c(ftime = 1, sdate = 1) - ) -}) +# # dimensions +# expect_equal( +# dim(res2$data), +# c(dataset = 1, member = 1, sdate = 1, ftime = 1, lat = 3, lon = 5) +# ) +# # elements +# expect_equal( +# names(res2$attrs), +# c("Variable", "Datasets", "Dates", "when", "source_files", +# "not_found_files", "load_parameters") +# ) +# # coordinates +# expect_equal( +# attributes(res2$coords$sdate), +# list(indices = FALSE) +# ) +# expect_equal( +# unlist(res2$coords)[1:4], +# c(dataset = "ERA5", member = "1", sdate = "20180301", ftime = "1") +# ) +# expect_equal( +# dim(res2$coords$ftime), +# NULL +# ) +# expect_equal( +# length(res2$coords$lat), +# 3 +# ) +# # Dates +# expect_equal( +# dim(res2$attrs$Dates), +# c(ftime = 1, sdate = 1) +# ) +# }) ############################################## -test_that("4. Tests from Load()", { - exp <- list(name = 'ecmwfS5', - path = "/esarchive/exp/ecmwf/system5c3s/$STORE_FREQ$_mean/$VAR_NAME$_s0-24h/$VAR_NAME$_$START_DATE$.nc") - obs <- list(name = 'era5', - path = '/esarchive/recon/ecmwf/era5/$STORE_FREQ$_mean/$VAR_NAME$_f1h-r1440x721cds/$VAR_NAME$_$YEAR$$MONTH$.nc') - suppressWarnings( - ob3 <- Load(var = 'prlr', exp = list(exp), obs = list(obs), - sdates = paste0(1993:1995, '1101'), nmember = 1, - storefreq = "monthly", sampleperiod = 1, - latmin = 42, latmax = 45, lonmin = 4, lonmax = 6, - output = 'lonlat', nprocs = 1) - ) - expect_warning( - as.s2dv_cube(ob3), - "The output is a list of two 's2dv_cube' objects corresponding to 'exp' and 'obs'." - ) - suppressWarnings( - res3 <- as.s2dv_cube(ob3) - ) +# test_that("4. Tests from Load()", { +# exp <- list(name = 'ecmwfS5', +# path = "/esarchive/exp/ecmwf/system5c3s/$STORE_FREQ$_mean/$VAR_NAME$_s0-24h/$VAR_NAME$_$START_DATE$.nc") +# obs <- list(name = 'era5', +# path = '/esarchive/recon/ecmwf/era5/$STORE_FREQ$_mean/$VAR_NAME$_f1h-r1440x721cds/$VAR_NAME$_$YEAR$$MONTH$.nc') +# suppressWarnings( +# ob3 <- Load(var = 'prlr', exp = list(exp), obs = list(obs), +# sdates = paste0(1993:1995, '1101'), nmember = 1, +# storefreq = "monthly", sampleperiod = 1, +# latmin = 42, latmax = 45, lonmin = 4, lonmax = 6, +# output = 'lonlat', nprocs = 1) +# ) +# expect_warning( +# as.s2dv_cube(ob3), +# "The output is a list of two 's2dv_cube' objects corresponding to 'exp' and 'obs'." +# ) +# suppressWarnings( +# res3 <- as.s2dv_cube(ob3) +# ) - # dimensions - expect_equal( - dim(res3[[1]]$data), - c(dataset = 1, member = 1, sdate = 3, ftime = 8, lat = 4, lon = 3) - ) - expect_equal( - unlist(res3[[1]]$coords)[1:4], - c(dataset = "ecmwfS5", member = "1", sdate1 = "19931101", sdate2 = "19941101") - ) - # Dates - expect_equal( - dim(res3[[1]]$attrs$Dates), - dim(res3[[2]]$attrs$Dates) - ) -}) +# # dimensions +# expect_equal( +# dim(res3[[1]]$data), +# c(dataset = 1, member = 1, sdate = 3, ftime = 8, lat = 4, lon = 3) +# ) +# expect_equal( +# unlist(res3[[1]]$coords)[1:4], +# c(dataset = "ecmwfS5", member = "1", sdate1 = "19931101", sdate2 = "19941101") +# ) +# # Dates +# expect_equal( +# dim(res3[[1]]$attrs$Dates), +# dim(res3[[2]]$attrs$Dates) +# ) +# }) ############################################## @@ -166,9 +166,9 @@ test_that("5. Tests from Start()", { var = 'tas', sdate = c('20170101', '20180101'), ensemble = indices(1:3), - time = 'all', - latitude = indices(1:10), - longitude = indices(1:10), + time = indices(1:3), + latitude = indices(1:2), + longitude = indices(1:2), return_vars = list(latitude = 'dat', longitude = 'dat', time = 'sdate'), retrieve = TRUE) ) @@ -178,7 +178,7 @@ test_that("5. Tests from Start()", { # dimensions expect_equal( dim(res4$data), - c(dat = 1, var = 1, sdate = 2, ensemble = 3, time = 7, latitude = 10, longitude = 10) + c(dat = 1, var = 1, sdate = 2, ensemble = 3, time = 3, latitude = 2, longitude = 2) ) # elements expect_equal( @@ -204,12 +204,12 @@ test_that("5. Tests from Start()", { ) expect_equal( length(res4$coords$latitude), - 10 + 2 ) # Dates expect_equal( dim(res4$attrs$Dates), - c(sdate = 2, time = 7) + c(sdate = 2, time = 3) ) }) @@ -228,10 +228,10 @@ test_that("6. Tests from Start()", { suppressWarnings( hcst <- Start(dat = anlgs, var = vari, - latitude = indices(1:4), #'all', - longitude= indices(1:4), #'all', - member= indices(1), #'all', - time = 'all', + latitude = indices(1:2), #'all', + longitude = indices(1:2), #'all', + member = indices(1), #'all', + time = indices(1:3), syear = indices(1:4), file_date = file_date_array, split_multiselected_dims = TRUE, @@ -248,7 +248,7 @@ test_that("6. Tests from Start()", { # dimensions expect_equal( dim(res5$data), - c(dat = 1, var = 1, latitude = 4, longitude = 4, member = 1, time = 4, + c(dat = 1, var = 1, latitude = 2, longitude = 2, member = 1, time = 3, syear = 4, sweek = 2, sday = 3) ) # elements diff --git a/vignettes/Analogs_vignette.Rmd b/vignettes/Analogs_vignette.Rmd index 674dccac5e42d414b1b611b83c705fa06d4c39ab..de4594e8c8db0952452e1c5599bffb1bb928b568 100644 --- a/vignettes/Analogs_vignette.Rmd +++ b/vignettes/Analogs_vignette.Rmd @@ -3,7 +3,7 @@ title: "Analogs based on large scale for downscaling" author: "M. Carmen Alvarez-Castro and M. del Mar Chaves-Montero (CMCC, Italy)" date: "November 2020" revisor: "Eva Rifà" -revision date: "January 2023" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -21,8 +21,7 @@ In this example, the seasonal temperature forecasts, initialized in october, wil ## 1. Introduction of the function -For instance if we want to perform a temperature donwscaling in Balearic Island for October we will get a daily series of temperature with 1 analog per day, -the best analog. How we define the best analog for a certain day? This function offers three options for that: +For instance if we want to perform a temperature donwscaling in Balearic Island for October we will get a daily series of temperature with 1 analog per day, the best analog. How we define the best analog for a certain day? This function offers three options for that: (1) The day with the minimum Euclidean distance in a large scale field: using i.e. pressure or geopotencial height as variables and North Atlantic region as large scale region. The Atmospheric circulation pattern in the North Atlantic (LargeScale) has an important role in the climate in Spain (LocalScale). The function will find the day with the most similar pattern in atmospheric circulation in the database (obs, slp in ERA5) to the day of interest (exp, slp in model). Once the date of the best analog is found, the function takes the associated temperature to that day (obsVar, tas in ERA5), with a subset of the region of interest (Balearic Island). @@ -39,7 +38,7 @@ Two datasets are used to illustrate how to use the function. The first one could ### Example 1: using data from CSTools -After loading **CSTools** package on the R session, the user will have access to the sample data `lonlat_temp` and `lonlat_prec`. +After loading **CSTools** package on the R session, the user will have access to the sample data created with using `CST_Start`: lonlat_temp_st` and `lonlat_prec_st`. *Note: If it is the first time using CSTools, install the package by running `install.packages("CSTools")`. @@ -50,32 +49,24 @@ library(CSTools) After exploring the data, the user can directly run the Analogs downscaling method using the 'Large_dis' metric: ``` -class(lonlat_temp$exp) -names(lonlat_temp$obs) -dim(lonlat_temp$obs$data) -dim(lonlat_temp$exp$data) -head(lonlat_temp$exp$attrs$Dates) +class(lonlat_temp_st$exp) +names(lonlat_temp_st$obs) +dim(lonlat_temp_st$obs$data) +dim(lonlat_temp_st$exp$data) +lonlat_temp_st$exp$attrs$Dates +lonlat_temp_st$obs$attrs$Dates ``` -There are 15 ensemble members available in the `exp` data set, 6 starting dates and 3 forecast times, which refer to monthly values during 3 months following starting dates on November 1st in the years 2000, 2001, 2002, 2003, 2004 and 2005. +There are 15 ensemble members available in the `exp` data set, 6 starting dates and 3 forecast times, which refer to monthly values during 3 months following starting dates on November in the years 2000, 2001, 2002, 2003, 2004 and 2005. ``` -exp1 <- lonlat_temp$exp -exp1$data <- exp1$data[, , 1, 1, , , drop = FALSE] -exp1$attrs$Dates <- exp1$attrs$Dates[1] +exp1 <- CST_Subset(x = lonlat_temp_st$exp, along = c('sdate', 'ftime'), indices = list(1, 1)) +down_1 <- CST_Analogs(expL = exp1, obsL = lonlat_temp_st$obs) -down_1 <- CST_Analogs(expL = exp1, obsL = lonlat_temp$obs) +exp2 <- CST_Subset(x = lonlat_temp_st$exp, along = c('sdate', 'ftime'), indices = list(1, 2)) +down_2 <- CST_Analogs(expL = exp2, obsL = lonlat_temp_st$obs) -exp2 <- lonlat_temp$exp -exp2$data <- exp2$data[, , 1, 2, , , drop = FALSE] -exp2$attrs$Dates <- exp2$attrs$Dates[2] - -down_2 <- CST_Analogs(expL = exp2, obsL = lonlat_temp$obs) - -exp3 <- lonlat_temp$exp -exp3$data <- exp3$data[, , 1, 3, , , drop = FALSE] -exp3$attrs$Dates <- exp3$attrs$Dates[3] - -down_3 <- CST_Analogs(expL = exp3, obsL = lonlat_temp$obs) +exp3 <- CST_Subset(x = lonlat_temp_st$exp, along = c('sdate', 'ftime'), indices = list(1, 3)) +down_3 <- CST_Analogs(expL = exp3, obsL = lonlat_temp_st$obs) ``` The visualization of the first three time steps for the ensemble mean of the forecast initialized the 1st of Noveber 2000 can be done using the package **s2dv**: @@ -97,13 +88,12 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), width = 10, height = 4) ``` - ![](./Figures/Analogs1.png) The user can also request extra Analogs and the information: ``` -down <- CST_Analogs(expL = exp1, obsL = lonlat_temp$obs, +down <- CST_Analogs(expL = exp1, obsL = lonlat_temp_st$obs, nAnalogs = 2, AnalogsInfo = TRUE) ``` @@ -121,7 +111,7 @@ The last command run concludes that the best analog of the ensemble 15 correspon ``` PlotLayout(PlotEquiMap, c('lat', 'lon'), var = list(down$data$fields[1, , , 15], - lonlat_temp$obs$data[1, 1, 5, 1, , ]), nrow = 1, ncol = 2, + lonlat_temp_st$obs$data[1, 1, 5, 1, , ]), nrow = 1, ncol = 2, lon = down$coords$lon, lat = down$coords$lat, filled.continents = FALSE, titles = c("Downscaled 2000-11-01", "Observed 2004-11-01"), units = 'T(K)', width = 7, height = 4) @@ -131,71 +121,118 @@ PlotLayout(PlotEquiMap, c('lat', 'lon'), var = list(down$data$fields[1, , , 15], As expected, they are exatly the same. -### Exemple 2: Load data using CST_Load +### Exemple 2: Load data using CST_Start -In this case, the spatial field of a single forecast day will be downscale using Analogs in this example. This will allow illustrating how to use CST_Load to retrieve observations separated from simulations. To explore other options, see other CSTools vignettes as well as `CST_Load` documentation. +In this case, the spatial field of a single forecast day will be downscale using Analogs in this example. This will allow illustrating how to use `CST_Start` to retrieve observations separated from simulations. To explore other options, see other CSTools vignettes as well as `CST_Start` documentation and [startR](https://CRAN.R-project.org/package=startR) package. The simulations available for the desired model cover the period 1993-2016. Here, the 15th of October 2000 (for the simulation initialized in the 1st of October 2000), will be downscaled. For ERA5 from 1979 to the present days. For this example we will just use October days from 2000 to 2006, so, the starting dates can be defined by running the following lines: ``` start <- as.Date(paste(2000, 10, "01", sep = ""), "%Y%m%d") end <- as.Date(paste(2006, 10, "01", sep = ""), "%Y%m%d") -dateseq <- format(seq(start, end, by = "year"), "%Y%m%d") +dates <- as.POSIXct(seq(start, end, by = "year"), format = '%Y%m%d', 'UTC') ``` -Using the `CST_Load` function from **CSTool package**, the data available in our data store can be loaded. The following lines show how this function can be used. The experimental datasets are interpolated to the ERA5 grid by specifying the 'grid' parameter while ERA5 doesn't need to be interpolated. While parameter leadtimemax is set to 1 for the experimental dataset, it is set to 31 for the observations, returning the daily observations for October for the years requested in 'sdate' (2000-2006). Download the data to run the recipe under the HTTPS: downloads.cmcc.bo.it/d_chaves/ANALOGS/data_for_Analogs.Rdat or ask carmen.alvarez-castro at cmcc.it or nuria.perez at bsc.es. - -``` -exp <- list(name = 'ECMWF_system4_m1', - path = file.path("/esarchive/exp/ecmwf/system4_m1/", - "$STORE_FREQ$_mean/$VAR_NAME$_*/$VAR_NAME$_$START_DATE$.nc")) -obs <- list(name = 'ERA5', - path = file.path("/esarchive/recon/ecmwf/era5/$STORE_FREQ$_mean/", - "$VAR_NAME$_f1h-r1440x721cds/$VAR_NAME$_$YEAR$$MONTH$.nc")) - -expTAS <- CST_Load(var = 'tas', exp = list(exp), obs = NULL, - sdates = '20001001', latmin = 22, latmax = 70, - lonmin = -80, lonmax = 50, output = 'lonlat', - storefreq = 'daily', nmember = 15, leadtimemin = 15, - leadtimemax = 15, method = "bilinear", grid = 'r1440x721', - nprocs = 1) -obsTAS <- CST_Load(var = 'tas', exp = NULL, obs = list(obs), - sdates = dateseq, leadtimemax = 31, - latmin = 22, latmax = 70, - lonmin = -80, lonmax = 50, output = 'lonlat', - nprocs = 1, storefreq = "daily", nmember = 1) - -expPSL <- CST_Load(var = 'psl', exp = list(exp), obs = NULL, - sdates = '20001001', latmin = 22, latmax = 70, - lonmin = -80, lonmax = 50, output = 'lonlat', - storefreq = 'daily', nmember = 15, leadtimemin = 15, - leadtimemax = 15, method = "bilinear", grid = 'r1440x721', - nprocs = 1) -obsPSL <- CST_Load(var = 'psl', exp = NULL, obs = list(obs), - sdates = dateseq, leadtimemax = 31, - latmin = 22, latmax = 70, - lonmin = -80, lonmax = 50, output = 'lonlat', - nprocs = 1, storefreq = "daily", nmember = 1) - -``` - -*Note: `CST_Load` allows to load the data simultaneously for 'exp' and 'obs' already formatted to have the same dimensions as in this example. However, it is possible to request separated 'obs' and 'exp'. In this second case, the observations could be return in a continous time series instead of being split in start dates and forecast time.* - -The s2dv_cube objects `expTAS`,`obsTAS`, `expPSL` and `obsPSL` are now loaded in the R enviroment. The first two elements correspond to the experimental and observed data for temperature and the other two are the equivalent for the SLP data. - -Loading the data using `CST_Load` allows to obtain two lists, one for the experimental data and another for the observe data, with the same elements and compatible dimensions of the data element: - +Using the `CST_Start` function from **CSTools package**, the data available in our data store can be loaded. The following lines show how this function can be used. The experimental datasets are interpolated to the ERA5 grid by specifying the 'grid' parameter while ERA5 doesn't need to be interpolated. While dimension 'time' is set to 1 for the experimental dataset, it is set to 31 for the observations, returning the daily observations for October for the years requested in 'sdate' (2000-2006). Download the data to run the recipe under the HTTPS: downloads.cmcc.bo.it/d_chaves/ANALOGS/data_for_Analogs.Rdat or ask carmen.alvarez-castro at cmcc.it or nuria.perez at bsc.es. + +``` +exp_path <- paste0('/esarchive/exp/ecmwf/system4_m1/daily_mean/', + '$var$_f6h/$var$_$sdate$.nc') +obs_path <- paste0('/esarchive/recon/ecmwf/era5/daily_mean/', + '$var$_f1h-r1440x721cds/$var$_$sdate$.nc') + +date_exp <- '20001001' +lonmax <- 50 +lonmin <- -80 +latmax <- 70 +latmin <- 22 + +expTAS <- CST_Start(dataset = exp_path, + var = 'tas', + member = indices(1:15), + sdate = '20001001', + ftime = indices(15), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_params = list(grid = 'r1440x721', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) + +expPSL <- CST_Start(dataset = exp_path, + var = 'psl', + member = indices(1:15), + sdate = '20001001', + ftime = indices(15), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_params = list(grid = 'r1440x721', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) + +obsTAS <- CST_Start(dataset = obs_path, + var = 'tas', + sdate = unique(format(dates, '%Y%m')), + ftime = indices(1:31), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) + +obsPSL <- CST_Start(dataset = obs_path, + var = 'psl', + sdate = unique(format(dates, '%Y%m')), + ftime = indices(1:31), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) +``` + +The 's2dv_cube' objects `expTAS`,`obsTAS`, `expPSL` and `obsPSL` are now loaded in the R environment. The first two elements correspond to the experimental and observed data for temperature and the other two are the equivalent for the SLP data. + +Loading the data using `CST_Start` allows to obtain two lists, one for the experimental data and another for the observe data, with the same elements and compatible dimensions of the data element: ``` dim(expTAS$data) -# dataset member sdate ftime lat lon -# 1 15 1 1 193 521 +# dataset var member sdate ftime lat lon +# 1 1 15 1 1 193 521 dim(obsTAS$data) -# dataset member sdate ftime lat lon -# 1 1 7 31 193 521 +# dataset var sdate ftime lat lon +# 1 1 7 31 193 521 ``` - #### Two variables and criteria Large [scale] Distance: The aim is to downscale the temperature field of the simulation for the 15th of October 2000 but looking at the pressure pattern: @@ -210,11 +247,11 @@ Some warnings could appear indicating information about undefining parameters. I ``` names(down1$data) dim(down1$data$field) -# nAnalogs lat lon member time -# 3 193 521 15 1 +# nAnalogs lat lon member +# 3 193 521 15 dim(down1$data$dates) -# nAnalogs member time -# 3 15 1 +# nAnalogs member +# 3 15 down1$data$dates[1,1] # "07-10-2005" ``` @@ -222,14 +259,14 @@ Now, we can visualize the output: ``` PlotLayout(PlotEquiMap, c('lat', 'lon'), - var = list(expPSL$data[1, 1, 1, 1, , ], obsPSL$data[1, 1, 1, 15, , ], + var = list(expPSL$data[1, 1, 1, 1, 1, , ], obsPSL$data[1, 1, 1, 15, , ], obsPSL$data[1, 1, 6, 7, , ]), lon = obsPSL$coords$lon, lat = obsPSL$coords$lat, filled.continents = FALSE, titles = c('Exp PSL 15-10-2000','Obs PSL 15-10-2000', 'Obs PSL 7-10-2005'), toptitle = 'First member', ncol = 3, nrow = 1, width = 10, height = 4) PlotLayout(PlotEquiMap, c('lat', 'lon'), var = list( - expTAS$data[1, 1, 1, 1, , ], obsTAS$data[1, 1, 1, 15, , ], + expTAS$data[1, 1, 1, 1, 1, , ], obsTAS$data[1, 1, 1, 15, , ], down1$data$field[1, , , 1], obsTAS$data[1, 1, 6, 7, , ]), lon = obsTAS$coords$lon, lat = obsTAS$coords$lat, filled.continents = FALSE, titles = c('Exp TAS 15-10-2000', 'Obs TAS 15-10-2000', @@ -252,8 +289,8 @@ The aim is to downscale the temperature simulation of the 15th of October 2000, ``` region <- c(lonmin = 0, lonmax = 5, latmin = 38.5, latmax = 40.5) -expPSL$data <- expPSL$data[1, 1, 1, 1, , ] -expTAS$data <- expTAS$data[1, 1, 1, 1, , ] +expPSL$data <- expPSL$data[1, 1, 1, 1, 1, , ] +expTAS$data <- expTAS$data[1, 1, 1, 1, 1, , ] down2 <- CST_Analogs(expL = expPSL, obsL = obsPSL, AnalogsInfo = TRUE, criteria = "Local_dist", # nAnalogs = 50, obsVar = obsTAS, expVar = expTAS, @@ -262,11 +299,11 @@ down2 <- CST_Analogs(expL = expPSL, obsL = obsPSL, AnalogsInfo = TRUE, The parameter 'nAnalogs' doesn't correspond to the number of Analogs returned, but to the number of the best observations to use in the comparison between large and local scale. -In this case, when looking to a large scale pattern and also to local scale pattern the best analog for the first member is the 13th of October 2001: +In this case, when looking to a large scale pattern and also to local scale pattern the best analog for the first member is the 7th of October 2001: ``` down2$data$dates[2] -# [1] "13-10-2001" +# "13-10-2001" ``` ``` @@ -276,7 +313,7 @@ var = list(expTAS$data, obsTAS$data[1, 1, 1, 15, , ], down2$data$field[1, , ], SelBox(obsTAS$data[1, 1, 2, 13, , ], lon = as.vector(obsTAS$coords$lon), lat = as.vector(obsTAS$coords$lat), - region)$data) + region, londim = 'lon', latdim = 'lat')$data) PlotLayout(PlotEquiMap, c('lat', 'lon'), var = var, special_args = list(list(lon = expTAS$coords$lon, lat = expTAS$coords$lat), @@ -311,9 +348,11 @@ down3$data$dates[3] ``` ``` -var = list(down3$data$field[1, , ], SelBox(obsTAS$data[1, 1, 2, 10, , ], - lon = as.vector(obsTAS$coords$lon), lat = as.vector(obsTAS$coords$lat), - region)$data) +var = list(down3$data$field[1, , ], + SelBox(obsTAS$data[1, 1, 2, 10, , ], + lon = as.vector(obsTAS$coords$lon), + lat = as.vector(obsTAS$coords$lat), + region, londim = 'lon', latdim = 'lat')$data) PlotLayout(PlotEquiMap, c('lat', 'lon'), var = var, lon = down3$coords$lon, lat = down3$coords$lat, diff --git a/vignettes/Data_Considerations.Rmd b/vignettes/Data_Considerations.Rmd index 979e1c751727edfab63b9c767ca098170986f926..a07f6aeb52126ba89b986e77ed31721d933f0530 100644 --- a/vignettes/Data_Considerations.Rmd +++ b/vignettes/Data_Considerations.Rmd @@ -1,6 +1,8 @@ --- author: "Nuria Perez" date: "`r Sys.Date()`" +revisor: "Eva Rifà" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -49,6 +51,7 @@ All CSTools functions have been developed following the same guidelines. The mai A reasonable important doubt that a new user may have at this point is: what 's2dv_cube' object is? 's2dv_cube' is a class of an object storing the data and metadata in several elements: + $data element is an N-dimensional array with named dimensions containing the data (e.g.: temperature values), + + $dims vector with the dimensions of $data + $coords is a named list with elements of the coordinates vectors corresponding to the dimensions of the $data, + $attrs is a named list with elements corresponding to attributes of the object. It has the following elements: + $Variable is a list with the variable name in element $varName and with the metadata of all the variables in the $metadata element, @@ -59,9 +62,9 @@ It is possible to visualize an example of the structure of 's2dv_cube' object by ``` library(CSTools) -class(lonlat_temp$exp) # check the class of the object lonlat_temp$exp -names(lonlat_temp$exp) # shows the names of the elements in the object lonlat_temp$exp -str(lonlat_temp$exp) # shows the full structure of the object lonlat_temp$exp +class(lonlat_temp_st$exp) # check the class of the object lonlat_temp$exp +names(lonlat_temp_st$exp) # shows the names of the elements in the object lonlat_temp$exp +str(lonlat_temp_st$exp) # shows the full structure of the object lonlat_temp$exp ``` ### 3. Data storage recommendations @@ -75,9 +78,11 @@ CSTools main objective is to share state-of-the-arts post-processing methods wit - CST_Load can perform spatial averages over a defined region or return the lat-lon grid and - CST_Load can read from files using multiple parallel processes among other possibilites. -If you plan to use CST_Load, we have developed guidelines to download and formatting the data. See [CDS_Seasonal_Downloader](https://earth.bsc.es/gitlab/es/cds-seasonal-downloader). +CSTools also has the function `CST_Start` from [startR](https://CRAN.R-project.org/package=startR) that is more flexible than `CST_Load`. We recommend to use `CST_Start` since it's more efficient and flexible. -There are alternatives to CST_Load function, for instance, the user can: +If you plan to use `CST_Load` or `CST_Start`, we have developed guidelines to download and formatting the data. See [CDS_Seasonal_Downloader](https://earth.bsc.es/gitlab/es/cds-seasonal-downloader). + +There are alternatives to these functions, for instance, the user can: 1) use another tool to read the data from files (e.g.: ncdf4, easyNDCF, startR packages) and then convert it to the class 's2dv_cube' with `s2dv.cube()` function or 2) If they keep facing problems to convert the data to that class, they can just skip it and work with the functions without the prefix 'CST_'. In this case, they will be able to work with the basic class 'array'. @@ -108,6 +113,55 @@ c(exp, obs) %<-% CST_Load(var = 'sfcWind', grid = "r360x180") ``` +### 5. CST_Start example +``` +path_exp <- paste0('/esarchive/exp/meteofrance/system6c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') + +sdates <- sapply(1993:2012, function(x) paste0(x, '0501')) + +lonmax <- 60.5 +lonmin <- -19 +latmax <- 79.5 +latmin <- 0 +exp <- CST_Start(dataset = path_exp, + var = 'sfcWind', + ensemble = indices(1:9), + sdate = sdates, + time = indices(1:3), + latitude = values(list(latmin, latmax)), + latitude_reorder = Sort(decreasing = TRUE), + longitude = values(list(lonmin, lonmax)), + longitude_reorder = CircularSort(0, 360), + synonims = list(longitude = c('lon', 'longitude'), + latitude = c('lat', 'latitude')), + return_vars = list(latitude = NULL, + longitude = NULL, time = 'sdate'), + retrieve = TRUE) + +path_obs <- paste0('/esarchive/recon/ecmwf/erainterim/daily_mean/', + '$var$_f6h/$var$_$sdate$.nc') +dates <- as.POSIXct(sdates, format = '%Y%m%d', 'UTC') +obs <- CST_Start(dataset = path_obs, + var = 'sfcWind', + sdate = unique(format(dates, '%Y%m')), + time = indices(2:4), + latitude = values(list(latmin, latmax)), + latitude_reorder = Sort(decreasing = TRUE), + longitude = values(list(lonmin, lonmax)), + longitude_reorder = CircularSort(0, 360), + synonims = list(longitude = c('lon', 'longitude'), + latitude = c('lat', 'latitude')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r360x181', + method = 'conservative'), + transform_vars = c('latitude', 'longitude'), + return_vars = list(longitude = NULL, + latitude = NULL, + time = 'sdate'), + retrieve = TRUE) +``` Extra lines to see the size of the objects and visualize the data: @@ -118,11 +172,10 @@ object_size(exp) object_size(obs) # 3.09 MB library(s2dv) -PlotEquiMap(exp$data[1,1,1,1,,], lon = exp$coords$lon, lat= exp$coords$lat, +PlotEquiMap(exp$data[1,1,1,1,1,,], lon = exp$coords$longitude, lat= exp$coords$latitude, filled.continents = FALSE, fileout = "Meteofrance_r360x180.png") ``` - ![Meteofrance](../vignettes/Figures/Meteofrance_r360x180.png) ### Managing big datasets and memory issues diff --git a/vignettes/ENSclustering_vignette.Rmd b/vignettes/ENSclustering_vignette.Rmd index 073a32100d71cf19991b1081eaa7a88ac5ce7d04..4eb96e7fad24d7c5de5991b659228db6ef08a8b9 100644 --- a/vignettes/ENSclustering_vignette.Rmd +++ b/vignettes/ENSclustering_vignette.Rmd @@ -1,6 +1,8 @@ --- author: "Ignazio Giuntoli and Federico Fabiano - CNR-ISAC" date: "`r Sys.Date()`" +revisor: "Eva Rifà" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -42,15 +44,15 @@ For our example we will use the sample seasonal temperature data provided within Data can be loaded as follows: ```r -datalist <- lonlat_temp$exp +datalist <- lonlat_temp_st$exp ``` The data will has the following dimension: ```r dim(datalist$data) -dataset member sdate ftime lat lon - 1 15 6 3 22 53 +dataset var member sdate ftime lat lon + 1 1 15 6 3 22 53 ``` Therefore the number of members is 15, the number of start dates is 6, while the forecast time steps are 3. The lat and lon dimensions refer to a 22x53 grid. @@ -101,11 +103,11 @@ results$freq [4,] 15.55556 ``` -Further, the cluster number to which each 'member - start-date' pair is assigned can be displayed by quering '$cluster' in 'results' as shown below (members (15) are in row and the start-dates (6) are in column (i.e. 15*6 pairs). +Further, the cluster number to which each 'member - start-date' pair is assigned can be displayed by quering '$cluster' in 'results' as shown below (members (15) are in row and the start-dates (6) are in column (i.e. 15*6 pairs)). ```r results$cluster - +, , 1, 1 [,1] [,2] [,3] [,4] [,5] [,6] [1,] 3 2 1 1 4 2 [2,] 2 4 4 2 3 1 @@ -131,16 +133,16 @@ To achieve this we can get an idea of how the clustering has performed by lookin ```r dim(results$composites) -cluster lat lon dataset - 4 22 53 1 +cluster lat lon dataset var + 4 22 53 1 1 ``` while the 'repr_field' argument of 'results' provides the spatial pattern of the member lying closes to the centroid (has the same dimensions as those of 'composites'): ```r dim(results$repr_field) -cluster lat lon dataset - 4 22 53 1 +cluster lat lon dataset var + 4 22 53 1 1 ``` Finally, the pairs 'member - start-dates' to be picked as representative for each cluster are found in the 'closest_member' argument. @@ -169,12 +171,12 @@ The following lines produce a multiplot of the representative temperature anomal These are actually the closest realizations (member - start-date pair) to the cluster centroids noted as 'repr_field' above. ```r -EnsMean <- MeanDims(datalist $data, c('member', 'sdate', 'ftime')) -EnsMean <- InsertDim(Reorder(EnsMean, c("lat", "lon", "dataset")), +EnsMean <- MeanDims(datalist$data, c('member', 'sdate', 'ftime')) +EnsMean <- InsertDim(Reorder(EnsMean, c("lat", "lon", "dataset", "var")), posdim = 1, lendim = 4, name = 'cluster') PlotLayout(PlotEquiMap, plot_dims = c("lat", "lon"), - var = results$repr_field[,,,1] - EnsMean[,,,1], + var = results$repr_field[,,,1,1] - EnsMean[,,,1,1], lon = results$lon, lat = results$lat, filled.continents = FALSE, titles = c("1","2","3","4"), brks = seq(-2, 2, 0.5), fileout = "EnsClus_4clus_both_mem_std_Fig1.png") @@ -188,16 +190,18 @@ The lines below produce a multiplot of the temperature anomaly patterns for each ```r ExpMean <- MeanDims(datalist$data, 'ftime') -EnsMean <- InsertDim(InsertDim(InsertDim(EnsMean[1,,,], +EnsMean <- InsertDim(InsertDim(InsertDim(InsertDim(EnsMean[1,,,,], posdim = 1, lendim = 6, name = 'sdate'), posdim = 1, lendim = 15, name = 'member'), - posdim = 1, lendim = 1, name = 'dataset') -ExpMeanSd <- Reorder(ExpMean - EnsMean, c('dataset', 'sdate', 'member' , 'lat', 'lon')) + posdim = 1, lendim = 1, name = 'var'), + posdim = 1, lendim = 1, name = 'dataset') + +ExpMeanSd <- Reorder(ExpMean - EnsMean, c('dataset', 'var', 'sdate', 'member' , 'lat', 'lon')) PlotLayout(PlotEquiMap, plot_dims = c("lat", "lon"), - var = ExpMeanSd[, , 1:4, , ], title_scale = 0.7, + var = ExpMeanSd[, , , 1:4, , ], title_scale = 0.7, ncol = 6, nrow = 4, row_titles = paste('member' , 1:4), col_titles = paste('sdate', 1:6), lon = results$lon, lat = results$lat, filled.continents = FALSE, - titles = as.character(t(results$cluster[1:4, 1:6,])), brks = seq(-2, 2, 0.5), + titles = as.character(t(results$cluster[1:4, 1:6,,])), brks = seq(-2, 2, 0.5), width = 24, height = 20, size_units = 'cm', fileout = "EnsClus_4clus_both_mem_std_Fig2.png") ``` diff --git a/vignettes/Figures/Analogs1.png b/vignettes/Figures/Analogs1.png index 5b4f05a94584422a6e58a638888be481a197b3b0..98011c3b16639c624a1e5a905061cee14cb2c7b5 100644 Binary files a/vignettes/Figures/Analogs1.png and b/vignettes/Figures/Analogs1.png differ diff --git a/vignettes/Figures/Analogs2.png b/vignettes/Figures/Analogs2.png index eb67ce3f2b5a3b405a1c36cfbf5ec466d170e73d..4878191a858e143835e7c5016e865db86ca053c7 100644 Binary files a/vignettes/Figures/Analogs2.png and b/vignettes/Figures/Analogs2.png differ diff --git a/vignettes/Figures/Analogs3.png b/vignettes/Figures/Analogs3.png index 465510727fdd046a35c8318400df73f18c57d2a0..7755b62056360c5541eb5dfbb59fa66d95a7120f 100644 Binary files a/vignettes/Figures/Analogs3.png and b/vignettes/Figures/Analogs3.png differ diff --git a/vignettes/Figures/Analogs4.png b/vignettes/Figures/Analogs4.png index 2e7c9c64c332e7521a0f140a5ed423e6bd4e5864..f5b8c1c77be9c063156bdb7bb3793f70e155fbdf 100644 Binary files a/vignettes/Figures/Analogs4.png and b/vignettes/Figures/Analogs4.png differ diff --git a/vignettes/Figures/Analogs5.png b/vignettes/Figures/Analogs5.png index 79907c8065e536f3a7e70536ee8b79efc9eed71d..ba4e8ac0eca7cf45534eb0cfc0fd73c2682e99b2 100644 Binary files a/vignettes/Figures/Analogs5.png and b/vignettes/Figures/Analogs5.png differ diff --git a/vignettes/Figures/Analogs6.png b/vignettes/Figures/Analogs6.png index abbc0d7a93988ffd4f2350ba746474188896214e..9283d88e4633dff2eaa2c691b15eca17924172ec 100644 Binary files a/vignettes/Figures/Analogs6.png and b/vignettes/Figures/Analogs6.png differ diff --git a/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig1.png b/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig1.png index 123fdb7795fc91926af753592d66c21d60f2b092..b87a3b6428938c63089c0e1c4e3b9b9ef23ca8d4 100644 Binary files a/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig1.png and b/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig1.png differ diff --git a/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig2.png b/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig2.png index 2c05166cfa25e349166f301957fa23a47e96efcd..64f99b17490c2fd965b21ec367ba71ba0861b3aa 100644 Binary files a/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig2.png and b/vignettes/Figures/EnsClus_4clus_both_mem_std_Fig2.png differ diff --git a/vignettes/Figures/Meteofrance_r360x180.png b/vignettes/Figures/Meteofrance_r360x180.png index 1438bd493288c10cf80b1796660e97ba51e5df56..06d63a3d8c6c8368fb96ed944045b2efa4339147 100644 Binary files a/vignettes/Figures/Meteofrance_r360x180.png and b/vignettes/Figures/Meteofrance_r360x180.png differ diff --git a/vignettes/Figures/MostLikelyTercile_fig1.png b/vignettes/Figures/MostLikelyTercile_fig1.png index bd282ed25fda569eaca3c29616e0e5c9d471eda5..0150a7f2cf1fa75388598d3e83031450252309c0 100644 Binary files a/vignettes/Figures/MostLikelyTercile_fig1.png and b/vignettes/Figures/MostLikelyTercile_fig1.png differ diff --git a/vignettes/Figures/MostLikelyTercile_fig2.png b/vignettes/Figures/MostLikelyTercile_fig2.png index b96854ad8a9a3ded41e0d3be2a148eda4b2c47b5..5ba969e4dba881f34a5364707327524a84d56989 100644 Binary files a/vignettes/Figures/MostLikelyTercile_fig2.png and b/vignettes/Figures/MostLikelyTercile_fig2.png differ diff --git a/vignettes/Figures/MostLikelyTercile_fig3.png b/vignettes/Figures/MostLikelyTercile_fig3.png index 1fa8460723a07d2abb08251758a585a2c3bcf7fc..edf922e1a3071e653c35f862e7fbfa0173ce8dc8 100644 Binary files a/vignettes/Figures/MostLikelyTercile_fig3.png and b/vignettes/Figures/MostLikelyTercile_fig3.png differ diff --git a/vignettes/Figures/MultiModelSkill_cor_tas_1993-2012.png b/vignettes/Figures/MultiModelSkill_cor_tas_1993-2012.png index d87618198c05bcc4ec3fa3e9cf26dd9c5432bb55..cad7506c9a9a442180cc891fd8dcae6001db32a7 100644 Binary files a/vignettes/Figures/MultiModelSkill_cor_tas_1993-2012.png and b/vignettes/Figures/MultiModelSkill_cor_tas_1993-2012.png differ diff --git a/vignettes/Figures/MultiModelSkill_rms_tas_1993-2012.png b/vignettes/Figures/MultiModelSkill_rms_tas_1993-2012.png index 199ab861e264bcb25a48959b8dfcbefb179dc473..764a6fc20dc86668addec44db2e556c80c538b94 100644 Binary files a/vignettes/Figures/MultiModelSkill_rms_tas_1993-2012.png and b/vignettes/Figures/MultiModelSkill_rms_tas_1993-2012.png differ diff --git a/vignettes/Figures/MultiModelSkill_rmsss_tas_1993-2012.png b/vignettes/Figures/MultiModelSkill_rmsss_tas_1993-2012.png index c8ab0c65bee47265e5b1c0990ff72ce4a5f56cf2..5c4b4a1b6d0574b3e0489105435f6bcaa9f1d911 100644 Binary files a/vignettes/Figures/MultiModelSkill_rmsss_tas_1993-2012.png and b/vignettes/Figures/MultiModelSkill_rmsss_tas_1993-2012.png differ diff --git a/vignettes/Figures/MultivarRMSE_gloseas5_tas_prlr_1993-2012.png b/vignettes/Figures/MultivarRMSE_gloseas5_tas_prlr_1993-2012.png index 14d7055e00914ddf144262d07dc8af2b6d1c8c3e..4c49afcac163b9ab20b096ccf498c55495276f0f 100644 Binary files a/vignettes/Figures/MultivarRMSE_gloseas5_tas_prlr_1993-2012.png and b/vignettes/Figures/MultivarRMSE_gloseas5_tas_prlr_1993-2012.png differ diff --git a/vignettes/Figures/PlotForecastPDF_ex1.png b/vignettes/Figures/PlotForecastPDF_ex1.png index 516bd717e792da8c885d42257ae4d9fcb72291b1..0fddba29a26775647f1ee454f8f2c920a07c3dab 100644 Binary files a/vignettes/Figures/PlotForecastPDF_ex1.png and b/vignettes/Figures/PlotForecastPDF_ex1.png differ diff --git a/vignettes/Figures/PlotForecastPDF_ex2.png b/vignettes/Figures/PlotForecastPDF_ex2.png index c7f9d9e434180700fa858117c8cc52bf5835957c..8288d3a1c9bb64669b136fcfb07820e9f3dc58ce 100644 Binary files a/vignettes/Figures/PlotForecastPDF_ex2.png and b/vignettes/Figures/PlotForecastPDF_ex2.png differ diff --git a/vignettes/Figures/PlotForecastPDF_ex3.png b/vignettes/Figures/PlotForecastPDF_ex3.png index d8eec5bedfc2696266972d2eb61a8eae5e514764..3525ad0ccef39302421dbcd5e8d47b3e0a4c549e 100644 Binary files a/vignettes/Figures/PlotForecastPDF_ex3.png and b/vignettes/Figures/PlotForecastPDF_ex3.png differ diff --git a/vignettes/Figures/PlotForecastPDF_ex4.png b/vignettes/Figures/PlotForecastPDF_ex4.png index 7254ee2e5a21740739659f5ab5b87b4927f5383a..95d6d3bcc051abdc1c055a6e221953f81f648e71 100644 Binary files a/vignettes/Figures/PlotForecastPDF_ex4.png and b/vignettes/Figures/PlotForecastPDF_ex4.png differ diff --git a/vignettes/Figures/RainFARM_fig1.png b/vignettes/Figures/RainFARM_fig1.png index 9c80d8fb80e3e6fc05af907ccf811193e6e7ae59..1eaede22326e9a35ce8440d86ce1222fc36ed29e 100644 Binary files a/vignettes/Figures/RainFARM_fig1.png and b/vignettes/Figures/RainFARM_fig1.png differ diff --git a/vignettes/Figures/observed_regimes.png b/vignettes/Figures/observed_regimes.png index 678ac72aad7fd3f7e55e01abcbd90372c838b3c0..4825d22803d98a8432bf01b8a920bc18d20d0879 100644 Binary files a/vignettes/Figures/observed_regimes.png and b/vignettes/Figures/observed_regimes.png differ diff --git a/vignettes/Figures/predicted_regimes.png b/vignettes/Figures/predicted_regimes.png index 9f69484f5c97a041454330247f967b5c912c2cff..a9caba8343b177a38615976187ab994324deb175 100644 Binary files a/vignettes/Figures/predicted_regimes.png and b/vignettes/Figures/predicted_regimes.png differ diff --git a/vignettes/MostLikelyTercile_vignette.Rmd b/vignettes/MostLikelyTercile_vignette.Rmd index aa9e998e1465afb5d9f9cdafb00c28e09d3de370..ded05182ac9bbe7bd865a0232f034d2b1aa03c0e 100644 --- a/vignettes/MostLikelyTercile_vignette.Rmd +++ b/vignettes/MostLikelyTercile_vignette.Rmd @@ -1,6 +1,8 @@ --- author: "Louis-Philippe Caron and Núria Pérez-Zanón" date: "`r Sys.Date()`" +revisor: "Eva Rifà" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -66,40 +68,84 @@ mon1 <- 2 monf <- 4 ``` - Finally, we define the forecast system, an observational reference, the variable of interest and the common grid onto which to interpolate. ```r -forecastsys <- 'system5c3s' -obs <- 'erainterim' -grid <- "256x128" clim_var = 'tas' ``` -Finally, the data are loaded using `CST_Load`: - +Finally, the data are loaded using `CST_Start`: ```r -c(exp, obs) %<-% CST_Load(var = clim_var, exp = forecastsys, obs = obs, - sdates = dateseq, leadtimemin = mon1, leadtimemax = monf, - lonmin = lon_min, lonmax = lon_max, - latmin = lat_min, latmax = lat_max, - storefreq = "monthly", sampleperiod = 1, nmember = 10, - output = "lonlat", method = "bilinear", - grid = paste("r", grid, sep = "")) -``` - -Loading the data using CST_Load returns two objects, one for the experimental data and another one for the observe data, with the same elements and compatible dimensions of the data element: +repos_exp <- paste0('/esarchive/exp/ecmwf/system5c3s/monthly_mean/', + '$var$_f6h/$var$_$sdate$.nc') +exp <- CST_Start(dataset = repos_exp, + var = clim_var, + member = indices(1:10), + sdate = dateseq, + ftime = indices(2:4), + lat = values(list(lat_min, lat_max)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lon_min, lon_max)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) + +# Give the correct time values (identical as the netCDF files) +dates_obs <- c(paste0(ini:fin, '-06-30 18:00:00'), + paste0(ini:fin, '-07-31 18:00:00'), + paste0(ini:fin, '-08-31 18:00:00')) +dates_obs <- as.POSIXct(dates_obs, tz = "UTC") +dim(dates_obs) <- c(sdate = 40, ftime = 3) + +date_arr <- array(format(dates_obs, '%Y%m'), dim = c(sdate = 40, ftime = 3)) + +repos_obs <- paste0('/esarchive/recon/ecmwf/erainterim/monthly_mean/', + '$var$/$var$_$date$.nc') + +obs <- CST_Start(dataset = repos_obs, + var = clim_var, + date = date_arr, + split_multiselected_dims = TRUE, + lat = values(list(lat_min, lat_max)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lon_min, lon_max)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, + lat = NULL, + ftime = 'date'), + retrieve = TRUE) +``` + +Loading the data using CST_Start returns two objects, one for the experimental data and another one for the observe data, with the same elements and compatible dimensions of the data element: ```r > dim(exp$data) -dataset member sdate ftime lat lon - 1 10 40 3 19 36 +dataset var member sdate ftime lat lon + 1 1 10 40 3 19 36 > dim(obs$data) -dataset member sdate ftime lat lon - 1 1 40 3 19 36 +dataset var sdate ftime lat lon + 1 1 40 3 19 36 ``` @@ -130,7 +176,7 @@ Finally, the probabilities of each tercile are computed by evaluating which terc ```r PB <- ProbBins(Ano_Exp$data, fcyr = numyears, thr = c(1/3, 2/3), compPeriod = "Without fcyr") -prob_map <- MeanDims(PB, c('sdate', 'member', 'dataset')) +prob_map <- MeanDims(PB, c('sdate', 'member', 'dataset', 'var')) ``` ### 4. Visualization with PlotMostLikelyQuantileMap @@ -163,8 +209,10 @@ First, we evaluate and plot the RPSS. Therefore, we use `RPSS` metric included i ```r -Ano_Exp$data <- Subset(Ano_Exp$data, along = 'sdate', indices = 1:38) -Ano_Obs$data <- Subset(Ano_Obs$data, along = 'sdate', indices = 1:38) +Ano_Exp <- CST_Subset(Ano_Exp, along = 'sdate', indices = 1:38) +Ano_Obs <- CST_Subset(Ano_Obs, along = 'sdate', indices = 1:38) +Ano_Obs <- CST_InsertDim(Ano_Obs, posdim = 3, lendim = 1, name = "member") + RPSS <- CST_MultiMetric(Ano_Exp, Ano_Obs, metric = 'rpss', multimodel = FALSE) PlotEquiMap(RPSS$data[[1]], lat = Lat, lon = Lon, brks = seq(-1, 1, by = 0.1), @@ -190,7 +238,7 @@ Finally, we plot the latest forecast, as in the previous step, but add the mask ```r PlotMostLikelyQuantileMap(probs = prob_map, lon = Lon, lat = Lat, coast_width = 1.5, - legend_scale = 0.5, mask = mask_rpss[ , , 1], + legend_scale = 0.5, mask = mask_rpss[ , , ,], toptitle = paste('Most likely tercile -', clim_var, '- ECMWF System5 - JJA 2020'), width = 10, height = 8) diff --git a/vignettes/MultiModelSkill_vignette.Rmd b/vignettes/MultiModelSkill_vignette.Rmd index 5d9d123924276abd8a7df512fcdb6228345b3084..dd35e256512dfcb3dc084953d4a476d1f81f132d 100644 --- a/vignettes/MultiModelSkill_vignette.Rmd +++ b/vignettes/MultiModelSkill_vignette.Rmd @@ -2,7 +2,7 @@ author: "Nuria Perez" date: "`r Sys.Date()`" revisor: "Eva Rifà" -revision date: "March 2023" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -20,6 +20,7 @@ The R package s2dv should be loaded by running: ```r library(s2dv) +library(zeallot) ``` Library *CSTools*, should be installed from CRAN and loaded: @@ -51,35 +52,68 @@ ini <- 1993 fin <- 2012 start <- as.Date(paste(ini, mth, "01", sep = ""), "%Y%m%d") end <- as.Date(paste(fin, mth, "01", sep = ""), "%Y%m%d") -dateseq <- format(seq(start, end, by = "year"), "%Y%m%d") +dateseq <- format(seq(start, end, by = "year"), "%Y%m") ``` +The grid in which all data will be interpolated needs to be specified within the `CST_Start` call (256x128 grid). The observational dataset used in this example is the EraInterim. -The grid in which all data will be interpolated should be also specified. The observational dataset used in this example is the EraInterim. - - -```r -grid <- "256x128" -obs <- "erainterim" -``` - -Using the `CST_Load` function, the data available in our data store can be loaded. The following lines, shows how this function can be used. However, the data is loaded from a previous saved `.RData` file: +Using the `CST_Start` function, the data available in our data store can be loaded. The following lines, shows how this function can be used. However, the data is loaded from a previous saved `.RData` file: Ask nuria.perez at bsc.es to achieve the data to run the recipe. ```r -require(zeallot) - -glosea5 <- '/esarchive/exp/glosea5/glosea5c3s/$STORE_FREQ$_mean/$VAR_NAME$_f6h/$VAR_NAME$_$YEAR$$MONTH$.nc' - -c(exp, obs) %<-% - CST_Load(var = clim_var, exp = list(list(name = 'glosea5', path = glosea5), - list(name = 'ecmwf/system4_m1'), - list(name = 'meteofrance/system5_m1')), - obs = obs, sdates = dateseq, leadtimemin = 2, leadtimemax = 4, - lonmin = -20, lonmax = 70, latmin = 25, latmax = 75, - storefreq = "monthly", sampleperiod = 1, nmember = 9, - output = "lonlat", method = "bilinear", - grid = paste("r", grid, sep = "")) +lonmin = -20 +lonmax = 70 +latmin = 25 +latmax = 75 +repos1 <- "/esarchive/exp/glosea5/glosea5c3s/monthly_mean/$var$_f6h/$var$_$sdate$.nc" +repos2 <- "/esarchive/exp/ecmwf/system4_m1/monthly_mean/$var$_f6h/$var$_$sdate$01.nc" +repos3 <- "/esarchive/exp/meteofrance/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$01.nc" + +exp <- CST_Start(dataset = list(list(name = 'glosea5c3s', path = repos1), + list(name = 'ecmwf/system4_m1', path = repos2), + list(name = 'meteofrance/system5_m1', path = repos3)), + var = clim_var, + member = indices(1:4), sdate = dateseq, ftime = indices(2:4), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = 'dataset', lon = 'dataset', ftime = 'sdate'), + retrieve = TRUE) + +dates_exp <- exp$attrs$Dates +repos_obs <- "/esarchive/recon/ecmwf/erainterim/monthly_mean/$var$/$var$_$date$.nc" +obs <- CST_Start(dataset = list(list(name = 'erainterim', path = repos_obs)), + var = clim_var, + date = unique(format(dates_exp, '%Y%m')), + ftime = values(dates_exp), + ftime_across = 'date', + ftime_var = 'ftime', + merge_across_dims = TRUE, + split_multiselected_dims = TRUE, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, + lat = NULL, + ftime = 'date'), + retrieve = TRUE) + # save(exp, obs, file = "../tas_toydata.RData") # Or use the following line to load the file provided in .RData format: @@ -88,7 +122,6 @@ c(exp, obs) %<-% There should be two new elements loaded in the R working environment: `exp` and `obs`, containing the experimental and the observed data for temperature. It is possible to check that they are of class `sd2v_cube` by running: - ``` class(exp) class(obs) @@ -98,10 +131,10 @@ The corresponding data is saved in the element `data` of each object, while othe ```r > dim(exp$data) -dataset member sdate ftime lat lon - 3 9 20 3 35 64 +dataset var member sdate ftime lat lon + 3 1 9 20 3 35 64 > dim(obs$data) -dataset member sdate ftime lat lon +dataset var sdate ftime lat lon 1 1 20 3 35 64 Lat <- exp$coords$lat Lon <- exp$coords$lon @@ -121,15 +154,16 @@ The dimensions are preserved: ``` > str(ano_exp$data) - num [1:20, 1:3, 1:9, 1:3, 1:35, 1:64] -1.3958 -0.0484 -0.1326 0.3621 -5.6905 ... + num [1:20, 1:3, 1:9, 1, 1:3, 1:35, 1:64] -1.399 -0.046 -0.133 0.361 -5.696 ... > str(ano_obs$data) - num [1:20, 1, 1, 1:3, 1:35, 1:64] 1.551 1.393 -0.344 -5.986 -0.27 ... + num [1:20, 1, 1, 1, 1:3, 1:35, 1:64] 1.556 1.397 -0.346 -5.99 -0.273 ... ``` The ACC is obtained by running the `CST_MultiMetric` function defining the parameter 'metric' as correlation. The function also includes the option of computing the Multi-Model Mean ensemble (MMM). ```r +ano_obs <- CST_InsertDim(ano_obs, posdim = 3, lendim = 1, name = "member") AnomDJF <- CST_MultiMetric(exp = ano_exp, obs = ano_obs, metric = 'correlation', multimodel = TRUE) ``` @@ -141,13 +175,13 @@ While other relevant data is being stored in the corresponding element of the ob ```r > str(AnomDJF$data) List of 4 - $ corr : num [1:4, 1, 1:35, 1:64] 0.584 0.649 0.131 0.565 0.484 ... - $ p.val : num [1:4, 1, 1:35, 1:64] 0.0034 0.000989 0.291589 0.00475 0.015262 ... - $ conf.lower: num [1:4, 1, 1:35, 1:64] 0.192 0.289 -0.331 0.163 0.053 ... - $ conf.upper: num [1:4, 1, 1:35, 1:64] 0.816 0.848 0.542 0.806 0.763 ... + $ corr : num [1:4, 1, 1, 1:35, 1:64] 0.3061 0.4401 0.0821 0.2086 0.1948 ... + $ p.val : num [1:4, 1, 1, 1:35, 1:64] 0.0947 0.0261 0.3653 0.1887 0.2052 ... + $ conf.lower: num [1:4, 1, 1, 1:35, 1:64] -0.15782 -0.00297 -0.37399 -0.25768 -0.27106 ... + $ conf.upper: num [1:4, 1, 1, 1:35, 1:64] 0.659 0.739 0.506 0.596 0.587 ... > names(AnomDJF) [1] "data" "dims" "coords" "attrs" -> names(AnomDJF$attrs$Datasets) +> AnomDJF$attrs$Datasets [1] "glosea5" "ecmwf/system4_m1" "meteofrance/system5_m1" "erainterim" ``` @@ -156,14 +190,14 @@ In the element $data of the `AnomDJF` object is a list of object for the metric To obtain a spatial plot with a scale from -1 to 1 value of correlation for the model with the highest correlation for each grid point, the following lines should be run: ```r -PlotCombinedMap(AnomDJF$data$corr[,1,,], lon = Lon, lat = Lat, map_select_fun = max, +PlotCombinedMap(AnomDJF$data$corr[,1,1,,], lon = Lon, lat = Lat, map_select_fun = max, display_range = c(0, 1), map_dim = 'nexp', legend_scale = 0.5, brks = 11, cols = list(c('white', 'black'), c('white', 'darkblue'), c('white', 'darkred'), c('white', 'darkorange')), - bar_titles = c("MMM", names(AnomDJF$attrs$Datasets)), + bar_titles = c("MMM", AnomDJF$attrs$Datasets), width = 14, height = 8) ``` @@ -186,15 +220,14 @@ AnomDJF <- CST_MultiMetric(exp = ano_exp, obs = ano_obs, metric = 'rms', The following lines are necessary to obtain the plot which visualizes the best model given this metric for each grid point. ```r -names(dim(RMS)) <- c("maps", "lat", "lon") -PlotCombinedMap(AnomDJF$data$rms[,1,,], lon = Lon, lat = Lat, map_select_fun = min, +PlotCombinedMap(AnomDJF$data$rms[,1,1,,], lon = Lon, lat = Lat, map_select_fun = min, display_range = c(0, ceiling(max(abs(AnomDJF$data$rms)))), map_dim = 'nexp', legend_scale = 0.5, brks = 11, cols = list(c('black', 'white'), c('darkblue', 'white'), c('darkred', 'white'), c('darkorange', 'white')), - bar_titles = c("MMM", names(AnomDJF$attrs$Datasets)), + bar_titles = c("MMM", AnomDJF$attrs$Datasets), width = 14, height = 8) ``` @@ -211,9 +244,9 @@ Notice that the perfect RMSSS is 1 and the parameter `map_select_fun` from `Plo ```r AnomDJF <- CST_MultiMetric(exp = ano_exp, obs = ano_obs, metric = 'rmsss', - multimodel = TRUE) + multimodel = TRUE) -PlotCombinedMap(AnomDJF$data$rmsss[,1,,], lon = Lon, lat = Lat, +PlotCombinedMap(AnomDJF$data$rmsss[,1,1,,], lon = Lon, lat = Lat, map_select_fun = function(x) {x[which.min(abs(x - 1))]}, display_range = c(0, ceiling(max(abs(AnomDJF$data$rmsss)))), map_dim = 'nexp', @@ -222,7 +255,7 @@ PlotCombinedMap(AnomDJF$data$rmsss[,1,,], lon = Lon, lat = Lat, c('white', 'darkblue'), c('white', 'darkred'), c('white', 'darkorange')), - bar_titles = c("MMM", names(AnomDJF$attrs$Datasets)), + bar_titles = c("MMM", AnomDJF$attrs$Datasets), width = 14, height = 8) ``` diff --git a/vignettes/MultivarRMSE_vignette.Rmd b/vignettes/MultivarRMSE_vignette.Rmd index 744350a8a083a9b0fdbe1a4e75cfec78c45951d6..73f08fe33695c5cc67a9f5a4e11b0199df0a1501 100644 --- a/vignettes/MultivarRMSE_vignette.Rmd +++ b/vignettes/MultivarRMSE_vignette.Rmd @@ -2,7 +2,7 @@ author: "Deborah Verfaillie" date: "`r Sys.Date()`" revisor: "Eva Rifà" -revision date: "March 2023" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -20,6 +20,7 @@ To run this vignette, the next R packages should be installed and loaded: ```r library(s2dv) library(RColorBrewer) +library(zeallot) ``` Library *CSTools*, should be installed from CRAN and loaded: @@ -61,30 +62,114 @@ grid <- "256x128" obs <- "erainterim" ``` -Using the `CST_Load` function from **CSTool package**, the data available in our data store can be loaded. The following lines show how this function can be used. Here, the data is loaded from a previous saved `.RData` file: +Using the `CST_Start` function from **CSTool package**, the data available in our data store can be loaded. The following lines show how this function can be used. Here, the data is loaded from a previous saved `.RData` file: Ask nuria.perez at bsc.es for the data to run the recipe. ```r -require(zeallot) - -glosea5 <- '/esarchive/exp/glosea5/glosea5c3s/$STORE_FREQ$_mean/$VAR_NAME$_f6h/$VAR_NAME$_$YEAR$$MONTH$.nc' - -c(exp_T, obs_T) %<-% - CST_Load(var = temp, exp = list(list(name = 'glosea5', path = glosea5)), - obs = obs, sdates = dateseq, leadtimemin = 2, leadtimemax = 4, - latmin = 25, latmax = 75, lonmin = -20, lonmax = 70, output = 'lonlat', - nprocs = 1, storefreq = "monthly", sampleperiod = 1, nmember = 9, - method = "bilinear", grid = paste("r", grid, sep = "")) - -glosea5 <- '/esarchive/exp/glosea5/glosea5c3s/$STORE_FREQ$_mean/$VAR_NAME$_f24h/$VAR_NAME$_$YEAR$$MONTH$.nc' - -c(exp_P, obs_P) %<-% - CST_Load(var = precip, exp = list(list(name = 'glosea5', path = glosea5)), - obs = obs, sdates = dateseq, leadtimemin = 2, leadtimemax = 4, - latmin = 25, latmax = 75, lonmin = -20, lonmax = 70, output = 'lonlat', - nprocs = 1, storefreq = "monthly", sampleperiod = 1, nmember = 9, - method = "bilinear", grid = paste("r", grid, sep = "")) - +latmin = 25 +latmax = 75 +lonmin = -20 +lonmax = 70 +dateseq <- format(seq(start, end, by = "year"), "%Y%m") + +repos1 <- "/esarchive/exp/glosea5/glosea5c3s/monthly_mean/$var$_f6h/$var$_$sdate$.nc" + +exp_T <- CST_Start(dataset = list(list(name = 'glosea5c3s', path = repos1)), + var = temp, + member = indices(1:9), + sdate = dateseq, + ftime = indices(2:4), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) +dates_exp <- exp_T$attrs$Dates +repos2 <- "/esarchive/recon/ecmwf/erainterim/monthly_mean/$var$/$var$_$date$.nc" +obs_T <- CST_Start(dataset = list(list(name = 'erainterim', path = repos2)), + var = temp, + date = unique(format(dates_exp, '%Y%m')), + ftime = values(dates_exp), + ftime_across = 'date', + ftime_var = 'ftime', + merge_across_dims = TRUE, + split_multiselected_dims = TRUE, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, + lat = NULL, + ftime = 'date'), + retrieve = TRUE) + +repos3 <- "/esarchive/exp/glosea5/glosea5c3s/monthly_mean/$var$_f24h/$var$_$sdate$.nc" + +exp_P <- CST_Start(dataset = list(list(name = 'glosea5c3s', path = repos3)), + var = precip, + member = indices(1:9), + sdate = dateseq, + ftime = indices(2:4), + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + member = c('member', 'ensemble'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lat = NULL, + lon = NULL, ftime = 'sdate'), + retrieve = TRUE) +dates_exp <- exp_P$attrs$Dates +obs_P <- CST_Start(dataset = list(list(name = 'erainterim', path = repos2)), + var = precip, + date = unique(format(dates_exp, '%Y%m')), + ftime = values(dates_exp), + ftime_across = 'date', + ftime_var = 'ftime', + merge_across_dims = TRUE, + split_multiselected_dims = TRUE, + lat = values(list(latmin, latmax)), + lat_reorder = Sort(decreasing = TRUE), + lon = values(list(lonmin, lonmax)), + lon_reorder = CircularSort(0, 360), + synonims = list(lon = c('lon', 'longitude'), + lat = c('lat', 'latitude'), + ftime = c('ftime', 'time')), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r256x128', + method = 'bilinear'), + transform_vars = c('lat', 'lon'), + return_vars = list(lon = NULL, + lat = NULL, + ftime = 'date'), + retrieve = TRUE) # save(exp_T, obs_T, exp_P, obs_P, file = "./tas_prlr_toydata.RData") # Or use the following line to load the file provided in .RData format: # load(file = "./tas_prlr_toydata.RData") @@ -105,11 +190,11 @@ Loading the data using `CST_Load` allows to obtain two lists, one for the experi ``` > dim(exp_T$data) -dataset member sdate ftime lat lon - 1 9 20 3 35 64 +dataset var member sdate ftime lat lon + 1 1 9 20 3 35 64 > dim(obs_T$data) -dataset member sdate ftime lat lon - 1 1 20 3 35 64 +dataset var sdate ftime lat lon + 1 1 20 3 35 64 ``` Latitudes and longitudes of the common grid can be saved: @@ -131,9 +216,9 @@ The original dimensions are preserved and the anomalies are stored in the `data` ``` > str(ano_exp_T$data) - num [1:20, 1, 1:9, 1:3, 1:35, 1:64] -1.3958 -0.0484 -0.1326 0.3621 -5.6905 ... + num [1:20, 1, 1:9, 1, 1:3, 1:35, 1:64] -1.399 -0.046 -0.133 0.361 -5.696 ... > str(ano_obs_T$data) - num [1:20, 1, 1, 1:3, 1:35, 1:64] 1.551 1.393 -0.344 -5.986 -0.27 ... + num [1:20, 1, 1, 1, 1:3, 1:35, 1:64] 1.556 1.397 -0.346 -5.99 -0.273 ... ``` Two lists containing the experiment ,`ano_exp`, and the observation, `ano_obs`, lists should be put together to serve as input of the function to compute multivariate RMSEs. @@ -154,6 +239,8 @@ It is obtained by running the `CST_MultivarRMSE` function: ```r +ano_obs[[1]] <- CST_InsertDim(ano_obs[[1]], posdim = 3, lendim = 1, name = "member") +ano_obs[[2]] <- CST_InsertDim(ano_obs[[2]], posdim = 3, lendim = 1, name = "member") mvrmse <- CST_MultivarRMSE(exp = ano_exp, obs = ano_obs, weight) ``` @@ -163,51 +250,185 @@ The function `CST_MultivarRMSE` returns the multivariate RMSE value for 2 or mor ```r > class(mvrmse) > str(mvrmse$data) - num [1, 1, 1:35, 1:64] 1002261 1034354 1041180 1034907 1238147 ... + num [1, 1, 1, 1:35, 1:64] 806916 832753 838254 833206 996828 ... > str(mvrmse$attrs$Variable) List of 2 $ varName : chr [1:2] "tas" "prlr" - $ metadata:List of 6 - ..$ tas :List of 7 - .. ..$ use_dictionary : logi FALSE - .. ..$ units : chr "K" - .. ..$ longname : chr "2 metre temperature" - .. ..$ description : chr "none" - .. ..$ daily_agg_cellfun : chr "none" - .. ..$ monthly_agg_cellfun: chr "none" - .. ..$ verification_time : chr "none" - ..$ lon : num [1:64(1d)] 0 1.41 2.81 4.22 5.62 ... - .. ..- attr(*, "cdo_grid_name")= chr "r256x128" - .. ..- attr(*, "data_across_gw")= logi TRUE - .. ..- attr(*, "array_across_gw")= logi FALSE - .. ..- attr(*, "first_lon")= num 340 - .. ..- attr(*, "last_lon")= num 68.9 - .. ..- attr(*, "projection")= chr "none" - ..$ lat : num [1:35(1d)] 73.8 72.4 71 69.6 68.2 ... - .. ..- attr(*, "cdo_grid_name")= chr "r256x128" - .. ..- attr(*, "first_lat")= num [1(1d)] 26 - .. ..- attr(*, "last_lat")= num [1(1d)] 73.8 - .. ..- attr(*, "projection")= chr "none" - ..$ prlr:List of 7 - .. ..$ use_dictionary : logi FALSE - .. ..$ units : chr "m s-1" - .. ..$ longname : chr "Total precipitation" - .. ..$ description : chr "none" - .. ..$ daily_agg_cellfun : chr "none" - .. ..$ monthly_agg_cellfun: chr "none" - .. ..$ verification_time : chr "none" - ..$ lon : num [1:64(1d)] 0 1.41 2.81 4.22 5.62 ... - .. ..- attr(*, "cdo_grid_name")= chr "r256x128" - .. ..- attr(*, "data_across_gw")= logi TRUE - .. ..- attr(*, "array_across_gw")= logi FALSE - .. ..- attr(*, "first_lon")= num 340 - .. ..- attr(*, "last_lon")= num 68.9 - .. ..- attr(*, "projection")= chr "none" - ..$ lat : num [1:35(1d)] 73.8 72.4 71 69.6 68.2 ... - .. ..- attr(*, "cdo_grid_name")= chr "r256x128" - .. ..- attr(*, "first_lat")= num [1(1d)] 26 - .. ..- attr(*, "last_lat")= num [1(1d)] 73.8 - .. ..- attr(*, "projection")= chr "none" + $ metadata:List of 8 + ..$ lat : num [1:35(1d)] 73.8 72.4 71 69.6 68.2 ... + ..$ lon : num [1:64(1d)] 0 1.41 2.81 4.22 5.62 ... + ..$ ftime: POSIXct[1:60], format: "1993-12-16 00:00:00" "1994-12-16 00:00:00" ... + ..$ tas :List of 11 + .. ..$ prec : chr "float" + .. ..$ units : chr "K" + .. ..$ dim :List of 4 + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "lon" + .. .. .. ..$ len : int 64 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 1 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 1 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "degrees_east" + .. .. .. ..$ vals : num [1:64(1d)] -19.7 -18.3 -16.9 -15.5 -14.1 ... + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "lat" + .. .. .. ..$ len : int 35 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 0 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 0 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "degrees_north" + .. .. .. ..$ vals : num [1:35(1d)] 26 27.4 28.8 30.2 31.6 ... + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "ensemble" + .. .. .. ..$ len : int 14 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 3 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int -1 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ vals : int [1:14] 1 2 3 4 5 6 7 8 9 10 ... + .. .. .. ..$ units : chr "" + .. .. .. ..$ create_dimvar: logi FALSE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 11 + .. .. .. ..$ name : chr "time" + .. .. .. ..$ len : int 7 + .. .. .. ..$ unlim : logi TRUE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 2 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 2 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "months since 1993-11-15 12:00:00" + .. .. .. ..$ calendar : chr "proleptic_gregorian" + .. .. .. ..$ vals : num [1:7(1d)] 0 1 2 3 4 5 6 + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. ..$ unlim : logi TRUE + .. ..$ make_missing_value: logi TRUE + .. ..$ missval : num -9e+33 + .. ..$ hasAddOffset : logi FALSE + .. ..$ hasScaleFact : logi FALSE + .. ..$ table : int 128 + .. ..$ _FillValue : num -9e+33 + .. ..$ missing_value : num -9e+33 + ..$ lat : num [1:35(1d)] 73.8 72.4 71 69.6 68.2 ... + ..$ lon : num [1:64(1d)] 0 1.41 2.81 4.22 5.62 ... + ..$ ftime: POSIXct[1:60], format: "1993-12-16 00:00:00" "1994-12-16 00:00:00" ... + ..$ prlr :List of 9 + .. ..$ prec : chr "float" + .. ..$ units : chr "m s-1" + .. ..$ dim :List of 4 + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "lon" + .. .. .. ..$ len : int 64 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 1 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 1 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "degrees_east" + .. .. .. ..$ vals : num [1:64(1d)] -19.7 -18.3 -16.9 -15.5 -14.1 ... + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "lat" + .. .. .. ..$ len : int 35 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 0 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 0 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "degrees_north" + .. .. .. ..$ vals : num [1:35(1d)] 26 27.4 28.8 30.2 31.6 ... + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 10 + .. .. .. ..$ name : chr "ensemble" + .. .. .. ..$ len : int 14 + .. .. .. ..$ unlim : logi FALSE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 3 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int -1 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ vals : int [1:14] 1 2 3 4 5 6 7 8 9 10 ... + .. .. .. ..$ units : chr "" + .. .. .. ..$ create_dimvar: logi FALSE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. .. ..$ :List of 11 + .. .. .. ..$ name : chr "time" + .. .. .. ..$ len : int 7 + .. .. .. ..$ unlim : logi TRUE + .. .. .. ..$ group_index : int 1 + .. .. .. ..$ group_id : int 65536 + .. .. .. ..$ id : int 2 + .. .. .. ..$ dimvarid :List of 5 + .. .. .. .. ..$ id : int 2 + .. .. .. .. ..$ group_index: int 1 + .. .. .. .. ..$ group_id : int 65536 + .. .. .. .. ..$ list_index : num -1 + .. .. .. .. ..$ isdimvar : logi TRUE + .. .. .. .. ..- attr(*, "class")= chr "ncid4" + .. .. .. ..$ units : chr "months since 1993-11-15 12:00:00" + .. .. .. ..$ calendar : chr "proleptic_gregorian" + .. .. .. ..$ vals : num [1:7(1d)] 0 1 2 3 4 5 6 + .. .. .. ..$ create_dimvar: logi TRUE + .. .. .. ..- attr(*, "class")= chr "ncdim4" + .. ..$ unlim : logi TRUE + .. ..$ make_missing_value: logi FALSE + .. ..$ missval : num 1e+30 + .. ..$ hasAddOffset : logi FALSE + .. ..$ hasScaleFact : logi FALSE + .. ..$ table : int 128 ``` The following lines plot the multivariate RMSE diff --git a/vignettes/PlotForecastPDF.Rmd b/vignettes/PlotForecastPDF.Rmd index bafbe7d6d001f804329b9219eb5aa823e71e1d9b..34bcb223847d7b767427df28cb01c7f3c1f77e96 100644 --- a/vignettes/PlotForecastPDF.Rmd +++ b/vignettes/PlotForecastPDF.Rmd @@ -75,12 +75,12 @@ plot <- PlotForecastPDF(fcst, tercile.limits = c(23, 27)) ggsave("outfile.pdf", plot, width = 7, height = 5) ``` -### 5.- A reproducible example using lonlat_temp +### 5.- A reproducible example using lonlat_temp_st This final example uses the sample lonlat data from CSTools. It is suitable for checking reproducibility of results. ```{r,fig.show = 'hide',warning=F} -fcst <- data.frame(fcst1 = lonlat_temp$exp$data[1,,1,1,1,1] - 273.15, - fcst2 = lonlat_temp$exp$data[1,,1,2,1,1] - 273.15) +fcst <- data.frame(fcst1 = lonlat_temp_st$exp$data[1,1,,1,1,1,1] - 273.15, + fcst2 = lonlat_temp_st$exp$data[1,1,,1,2,1,1] - 273.15) PlotForecastPDF(fcst, tercile.limits = c(5, 7), extreme.limits = c(4, 8), var.name = "Temperature (ºC)", title = "Forecasts initialized on Nov 2000 at sample Mediterranean region", diff --git a/vignettes/RainFARM_vignette.Rmd b/vignettes/RainFARM_vignette.Rmd index 28ab753ded112a1d670fb8a00abc6dc9d0f8e0b8..a51d75cb9160e14b5b1247ee1a4039486a2f1279 100644 --- a/vignettes/RainFARM_vignette.Rmd +++ b/vignettes/RainFARM_vignette.Rmd @@ -2,6 +2,8 @@ title: "Rainfall Filtered Autoregressive Model (RainFARM) precipitation downscaling" author: "Jost von Hardenberg (ISAC-CNR)" date: "26/03/2019" +revisor: "Eva Rifà" +revision date: "October 2023" output: rmarkdown::html_vignette vignette: > %\VignetteEngine{knitr::knitr} @@ -38,23 +40,22 @@ library(CSTools) We use test data provided by CSTools to load a seasonal precipitation forecast: ```{r} -library(CSTools) -exp <- lonlat_prec +exp <- lonlat_prec_st ``` This gives us a CSTools object `exp`, containing an element `exp$data` with dimensions: ```{r} dim(exp$data) -# dataset member sdate ftime lat lon -# 1 6 3 31 4 4 +# dataset var member sdate ftime lat lon +# 1 1 6 3 31 4 4 ``` There are 6 ensemble members available in the data set, 3 starting dates and 31 forecast times, which refer to daily values in the month of March following starting dates on November 1st in the years 2010, 2011, 2012. Please notice that RainFARM (in this version) only accepts square domains, possibly with an even number of pixels on each side, so we always need to select an appropriate cutout. Also, there are time and memory limitations when a large ensemble of downscaled realizations is generated with RainFARM, so that selecting a smaller target area is advised. On the other hand, if spectral slopes are to be determined from the large scales we will still need enough resolution to allow this estimation. In this example we have preselected a 4x4 pixel cutout at resolution 1 degree in a smaller area lon=[6,9], lat=[44,47] covering Northern Italy. ```{r} ilon <- which(exp$coords$lon %in% 5:12) -ilat <- which(exp$coords$lat %in% 40:47 ) -exp$data <- exp$data[ , , , , ilon, ilat, drop = FALSE] -names(dim(exp$data)) <- names(dim(lonlat_prec$data)) +ilat <- which(exp$coords$lat %in% 40:47) +exp$data <- exp$data[, , , , , ilat, ilon, drop = FALSE] +names(dim(exp$data)) <- names(dim(lonlat_prec_st$data)) exp$coords$lon <- exp$coords$lon[ilon] exp$coords$lat <- exp$coords$lat[ilat] ``` @@ -65,13 +66,14 @@ Our goal is to downscale with RainFARM these data from the resolution of 1 degre RainFARM can compute automatically its only free parameter, i.e. the spatial spectral slope, from the large-scale field (here only with size 4x4 pixel, but in general we reccomend selecting at least 8x8 pixels). In this example we would like to compute this slope as an average over the _member_ and _ftime_ dimensions, while we will use different slopes for the remaining _dataset_ and _sdate_ dimensions (a different choice may be more appropriate in a real application). To obtain this we specify the parameter `time_dim = c("member", "ftime")`. The slope is computed starting from the wavenumber corresponding to the box, `kmin = 1`. We create 3 stochastic realizations for each dataset, member, starting date and forecast time with `nens = 5`. The command to donwscale and the resulting fields are: -```{r} +``` exp_down <- CST_RainFARM(exp, nf = 20, kmin = 1, nens = 3, time_dim = c("member", "ftime")) dim(exp_down$data) -# dataset member realization sdate ftime lat lon -# 1 6 3 3 31 80 80 +# dataset var member realization sdate ftime lat lon +# 1 1 6 3 3 31 80 80 + str(exp_down$coords$lon) # num [1:80] 5.53 5.58 5.62 5.67 5.72 ... str(exp_down$coords$lat) @@ -95,13 +97,13 @@ png("Figures/RainFARM_fig1.png", width = 640, height = 365) par(mfrow = c(1,2)) --> ```{r} -a <- exp$data[1, 1, 1, 17, , ] * 86400 * 1000 +a <- exp$data[1, 1, 1, 1, 17, , ] * 86400 * 1000 a[a > 60] <- 60 image(exp$coords$lon, rev(exp$coords$lat), t(apply(a, 2, rev)), xlab = "lon", ylab = "lat", col = rev(terrain.colors(20)), zlim = c(0,60)) map("world", add = TRUE) title(main = "pr 17/03/2010 original") -a <- exp_down$data[1, 1, 1, 1, 17, , ] * 86400 * 1000 +a <- exp_down$data[1, 1, 1, 1, 1, 17, , ] * 86400 * 1000 a[a > 60] <- 60 image(exp_down$coords$lon, rev(exp_down$coords$lat), t(apply(a, 2, rev)), xlab = "lon", ylab = "lat", col = rev(terrain.colors(20)), zlim = c(0, 60)) @@ -137,8 +139,8 @@ From a single realization and time it is not possible to see that a more realist