From 17dc8d4101667cacd56e68e8ca4fbe5ded180b1a Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 6 Aug 2021 13:51:12 +0200 Subject: [PATCH 1/2] Enable transformation of 'all' --- R/Start.R | 15 ++- tests/testthat/test-Compute-transform_all.R | 114 ++++++++++++++++++++ 2 files changed, 127 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-Compute-transform_all.R diff --git a/R/Start.R b/R/Start.R index 5f4a295..46c2d21 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1318,7 +1318,7 @@ Start <- function(..., # dim = indices/selectors, if (dim_name %in% c('var', 'variable')) { var_params <- c(var_params, setNames(list('var_names'), dim_name)) .warning(paste0("Found specified values for dimension '", dim_name, "' but no '", - dim_name, "_var' requested. ", '"', dim_name, "_var = '", + dim_name, "_var' provided. ", '"', dim_name, "_var = '", 'var_names', "'", '"', " has been automatically added to ", "the Start call.")) } else { @@ -1329,6 +1329,14 @@ Start <- function(..., # dim = indices/selectors, "the Start call.")) } } + if (attr(dat_selectors[[dim_name]], 'indices') & (dim_name %in% transform_vars) & + !(dim_name %in% names(var_params))) { + var_params <- c(var_params, setNames(list(dim_name), dim_name)) + .warning(paste0("Found dimension '", dim_name, "' is required to transform but no '", + dim_name, "_var' provided. ", '"', dim_name, "_var = '", + dim_name, "'", '"', " has been automatically added to ", + "the Start call.")) + } } ## (Check the *_var parameters). @@ -3141,7 +3149,10 @@ Start <- function(..., # dim = indices/selectors, if (!is.null(crop_indices)) { if (type_of_var_to_crop == 'transformed') { if (!aiat) { - vars_to_crop[[var_to_crop]] <- Subset(transformed_subset_var, inner_dim, crop_indices) + if (!(length(selector_array) == 1 & + selector_array %in% c('all', 'first', 'last'))) { + vars_to_crop[[var_to_crop]] <- Subset(transformed_subset_var, inner_dim, crop_indices) + } } else { vars_to_crop[[var_to_crop]] <- Subset(vars_to_crop[[var_to_crop]], inner_dim, crop_indices) } diff --git a/tests/testthat/test-Compute-transform_all.R b/tests/testthat/test-Compute-transform_all.R new file mode 100644 index 0000000..db13f35 --- /dev/null +++ b/tests/testthat/test-Compute-transform_all.R @@ -0,0 +1,114 @@ +context("Transform with 'all'") + +test_that("1. Specify lat and lon with 'all'; retrieve = TRUE", { + +path <- '/esarchive/exp/ecearth/a1ua/cmorfiles/DCPP/EC-Earth-Consortium/EC-Earth3/dcppA-hindcast/$member$/Amon/$var$/gr/v20190713/$var$_Amon_*_s$sdate$-$member$_gr_$fyear$.nc' +suppressWarnings( +data1 <- Start(dat = path, + var = 'tos', + sdate = paste0(1960), + time = indices(1:2), #'all', + lat = 'all', + lon = 'all', +# lat_reorder = Sort(decreasing = F), +# lon_reorder = CircularSort(0, 360), +# lat_var = 'lat', +# lon_var = 'lon', + fyear = indices(1), + member = indices(1), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r100x50', method = 'conservative', crop = FALSE), + transform_vars = c('lat','lon'), + synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = T) +) + +suppressWarnings( +data2 <- Start(dat = path, + var = 'tos', + sdate = paste0(1960), + time = indices(1:2), #'all', + lat = values(list(-90, 90)), + lon = values(list(0, 359.9)), + lat_reorder = Sort(decreasing = F), + lon_reorder = CircularSort(0, 360), +# lat_var = 'lat', +# lon_var = 'lon', + fyear = indices(1), + member = indices(1), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r100x50', method = 'conservative', crop = FALSE), + transform_vars = c('lat','lon'), + synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = T) +) + +expect_equal( +dim(data1), +c(dat = 1, var = 1, sdate = 1, time = 2, lat = 50, lon = 100, fyear = 1, member = 1) +) +expect_equal( +dim(data1), +dim(data2) +) +expect_equal( +as.vector(data1), +as.vector(data2) +) +expect_equal( +data1[1, 1, 1, 2, 10:12, 20, 1, 1], +c(274.6942, 276.2658, 278.2566), +tolerance = 0.0001 +) + +}) + +test_that("2. Specify lat and lon with 'all'; retrieve = FALSE", { + +path <- '/esarchive/exp/ecearth/a1ua/cmorfiles/DCPP/EC-Earth-Consortium/EC-Earth3/dcppA-hindcast/$member$/Amon/$var$/gr/v20190713/$var$_Amon_*_s$sdate$-$member$_gr_$fyear$.nc' +suppressWarnings( +data <- Start(dat = path, + var = 'tos', + sdate = paste0(1960), + time = indices(1:2), #'all', + lat = 'all', + lon = 'all', + fyear = indices(1), + member = indices(1:2), + transform = CDORemapper, + transform_extra_cells = 2, + transform_params = list(grid = 'r100x50', method = 'conservative', crop = FALSE), + transform_vars = c('lat','lon'), + synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), + return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + retrieve = FALSE) +) + + func <- function(x) { + a <- mean(x, na.rm = TRUE) + return(a) + } + step <- Step(func, target_dims = c('time'), + output_dims = NULL) + wf <- AddStep(data, step) +suppressWarnings( + res <- Compute(wf, + chunks = list(member = 2)) +) + +expect_equal( +dim(res$output1), +c(dat = 1, var = 1, sdate = 1, lat = 50, lon = 100, fyear = 1, member = 2) +) +expect_equal( +res$output1[1, 1, 1, 10:12, 20, 1, 1], +c(274.2808, 275.8509, 277.7623), +tolerance = 0.0001 +) + + +}) -- GitLab From 3ad4caff4a689d505437020ffb5c8b4cd5620d8a Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 24 Aug 2021 12:19:33 +0200 Subject: [PATCH 2/2] Fix for return_vars is NULL --- R/Start.R | 6 +++++- tests/testthat/test-Compute-transform_all.R | 2 +- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/R/Start.R b/R/Start.R index 67fb5c7..b6e3263 100644 --- a/R/Start.R +++ b/R/Start.R @@ -3168,7 +3168,11 @@ Start <- function(..., # dim = indices/selectors, if (inner_dim %in% names(dim(common_vars_to_crop[[common_var_to_crop]]))) { if (type_of_var_to_crop == 'transformed' & !aiat) { - common_vars_to_crop[[common_var_to_crop]] <- Subset(transformed_subset_var, inner_dim, crop_indices) + if (!(length(selector_array) == 1 & + selector_array %in% c('all', 'first', 'last'))) { + common_vars_to_crop[[common_var_to_crop]] <- + Subset(transformed_subset_var, inner_dim, crop_indices) + } } else { #old code common_vars_to_crop[[common_var_to_crop]] <- Subset(common_vars_to_crop[[common_var_to_crop]], inner_dim, crop_indices) } diff --git a/tests/testthat/test-Compute-transform_all.R b/tests/testthat/test-Compute-transform_all.R index db13f35..67011ee 100644 --- a/tests/testthat/test-Compute-transform_all.R +++ b/tests/testthat/test-Compute-transform_all.R @@ -43,7 +43,7 @@ data2 <- Start(dat = path, transform_params = list(grid = 'r100x50', method = 'conservative', crop = FALSE), transform_vars = c('lat','lon'), synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), - return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), + return_vars = list(lat = NULL, lon = NULL, time = 'sdate'), retrieve = T) ) -- GitLab