From 8a7d1facb9eb495bb1142599dcb644e4bd79f09b Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 5 Oct 2021 10:54:44 +0200 Subject: [PATCH 1/2] Modify the inner dim check for missing or wrong name dim. It helps checking dim when retrieve = F --- R/Start.R | 49 +++++++++++++++++++++++++++++++++---------------- 1 file changed, 33 insertions(+), 16 deletions(-) diff --git a/R/Start.R b/R/Start.R index b361eb1..bf35fb0 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1936,7 +1936,7 @@ Start <- function(..., # dim = indices/selectors, # If any of the dimensions comes without defining variable, then we read # the data dimensions. data_dims <- NULL - if (length(unlist(var_params[expected_inner_dims[[i]]])) < length(expected_inner_dims[[i]])) { +# if (length(unlist(var_params[expected_inner_dims[[i]]])) < length(expected_inner_dims[[i]])) { file_to_open <- file_path data_dims <- file_dim_reader(file_to_open, NULL, selectors_of_first_files_with_data[[i]], lapply(dat[[i]][['selectors']][expected_inner_dims[[i]]], '[[', 1), @@ -1944,7 +1944,7 @@ Start <- function(..., # dim = indices/selectors, # file_dim_reader returns dimension names as found in the file. # Need to translate accoridng to synonims: names(data_dims) <- replace_with_synonmins(data_dims, synonims) - } +# } if (is.numeric(largest_dims_length)) { # largest_dims_length is a named vector # Check if the names fit the inner dimension names @@ -1971,6 +1971,23 @@ Start <- function(..., # dim = indices/selectors, } # end if (largest_dims_length == TRUE) #////////////////////////////////////////////////// + # Some dimension is defined in Start() call but doesn't exist in data + if (!all(expected_inner_dims[[i]] %in% names(data_dims))) { + tmp <- expected_inner_dims[[i]][which(!expected_inner_dims[[i]] %in% names(data_dims))] + stop("Could not find the dimension '", tmp, "' in the file. Either ", + "change the dimension name in your request, adjust the ", + "parameter 'dim_names_in_files' or fix the dimension name in ", + "the file.\n", file_path) + } + # Not all the inner dims are defined in Start() call + if (!all(names(data_dims) %in% expected_inner_dims[[i]])) { + tmp <- names(data_dims)[which(!names(data_dims) %in% expected_inner_dims[[i]])] + if (data_dims[tmp] != 1) { + stop("The dimension '", tmp, "' is found in the file ", file_path, + " but not defined in the Start call.") + } + } + #/////////////////////////////////////////////////////////////////// # Transform the variables if needed and keep them apart. @@ -2284,13 +2301,13 @@ Start <- function(..., # dim = indices/selectors, ## TODO HERE:: #- indices_of_first_files_with_data may change, because array is now extended var_full_dims <- dim(var_with_selectors) - if (!(inner_dim %in% names(var_full_dims))) { - stop("Could not find the dimension '", inner_dim, "' in ", - "the file. Either change the dimension name in ", - "your request, adjust the parameter ", - "'dim_names_in_files' or fix the dimension name in ", - "the file.\n", file_path) - } +# if (!(inner_dim %in% names(var_full_dims))) { +# stop("Could not find the dimension '", inner_dim, "' in ", +# "the file. Either change the dimension name in ", +# "your request, adjust the parameter ", +# "'dim_names_in_files' or fix the dimension name in ", +# "the file.\n", file_path) +# } } else if (((is.numeric(selector_array) || is.list(selector_array)) && selectors_are_indices) || (is.character(selector_array) && (length(selector_array) == 1) && (selector_array %in% c('all', 'first', 'last')) && @@ -2300,13 +2317,13 @@ Start <- function(..., # dim = indices/selectors, # Lines moved above for better performance. ##data_dims <- file_dim_reader(file_path, NULL, selectors_of_first_files_with_data[[i]], ## lapply(dat[[i]][['selectors']][expected_inner_dims[[i]]], '[[', 1)) - if (!(inner_dim %in% names(data_dims))) { - stop("Could not find the dimension '", inner_dim, "' in ", - "the file. Either change the dimension name in ", - "your request, adjust the parameter ", - "'dim_names_in_files' or fix the dimension name in ", - "the file.\n", file_path) - } +# if (!(inner_dim %in% names(data_dims))) { +# stop("Could not find the dimension '", inner_dim, "' in ", +# "the file. Either change the dimension name in ", +# "your request, adjust the parameter ", +# "'dim_names_in_files' or fix the dimension name in ", +# "the file.\n", file_path) +# } } else { stop(paste0("Can not translate the provided selectors for '", inner_dim, "' to numeric indices. Provide numeric indices and a ", -- GitLab From b2256769c5899ed9d090733261d75cb4de1573a3 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 6 Oct 2021 12:17:42 +0200 Subject: [PATCH 2/2] Remove skip_on_cran and run crop = T cases --- tests/testthat/test-Compute-transform_all.R | 2 -- .../testthat/test-Compute-transform_indices.R | 35 +++++++++---------- .../testthat/test-Compute-transform_values.R | 35 +++++++++---------- 3 files changed, 32 insertions(+), 40 deletions(-) diff --git a/tests/testthat/test-Compute-transform_all.R b/tests/testthat/test-Compute-transform_all.R index 46430d7..c99ae5f 100644 --- a/tests/testthat/test-Compute-transform_all.R +++ b/tests/testthat/test-Compute-transform_all.R @@ -1,7 +1,6 @@ context("Transform with 'all'") test_that("1. Chunk along non-lat/lon dim", { -skip_on_cran() 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( @@ -47,7 +46,6 @@ tolerance = 0.0001 }) test_that("2. chunk along lon", { -skip_on_cran() #!!!!!!!!!!!!!!!!!!!NOTE: the results are not identical when exp has extra cells = 2!!!!!!!!!!!!!!!!!! # But exp2 (retrieve = T) has the same results with extra_cells = 2 and 8. diff --git a/tests/testthat/test-Compute-transform_indices.R b/tests/testthat/test-Compute-transform_indices.R index d9d65cb..60057fb 100644 --- a/tests/testthat/test-Compute-transform_indices.R +++ b/tests/testthat/test-Compute-transform_indices.R @@ -22,7 +22,6 @@ context("Transform with indices") test_that("1. global", { -skip_on_cran() path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' @@ -187,33 +186,33 @@ func <- function(x) { step <- Step(func, target_dims = 'time', output_dims = 'time') wf <- AddStep(exp, step) -#WRONG!!!!!!!!!! -#suppressWarnings( -#res_crop_T_1 <- Compute(wf, chunks = list(lon = 2)) -#) +#WRONG?????? +suppressWarnings( +res_crop_T_1 <- Compute(wf, chunks = list(lon = 2)) +) suppressWarnings( res_crop_T_2 <- Compute(wf, chunks = list(ensemble = 1)) ) -#WRONG!!!!!!!!!! -#suppressWarnings( -#res_crop_T_3 <- Compute(wf, chunks = list(lon = 3)) -#) +#WRONG????? +suppressWarnings( +res_crop_T_3 <- Compute(wf, chunks = list(lon = 3)) +) suppressWarnings( res_crop_T_4 <- Compute(wf, chunks = list(lat = 2)) ) -#expect_equal( -#res1$output1, -#res_crop_T_1$output1 -#) +expect_equal( +res1$output1, +res_crop_T_1$output1 +) expect_equal( res1$output1, res_crop_T_2$output1 ) -#expect_equal( -#res1$output1, -#res_crop_T_3$output1 -#) +expect_equal( +res1$output1, +res_crop_T_3$output1 +) expect_equal( res1$output1, res_crop_T_4$output1 @@ -251,7 +250,6 @@ res_crop_T_4$output1 test_that("2. regional, no border", { -skip_on_cran() path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' @@ -465,7 +463,6 @@ res_crop_T_3$output1 test_that("3. regional, at lon border", { -skip_on_cran() path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' diff --git a/tests/testthat/test-Compute-transform_values.R b/tests/testthat/test-Compute-transform_values.R index 74975f7..dbae55b 100644 --- a/tests/testthat/test-Compute-transform_values.R +++ b/tests/testthat/test-Compute-transform_values.R @@ -7,7 +7,6 @@ context("Compute: Transform and chunk values()") ##################################################################### test_that("1. Global", { -skip_on_cran() lons.min <- 0 lons.max <- 359.9 @@ -290,33 +289,33 @@ func <- function(exp) { step <- Step(func, target_dims = 'sdate', output_dims = 'sdate') wf <- AddStep(exp, step) -#WRONG -#suppressWarnings( -#res_crop_T_1 <- Compute(wf, chunks = list(latitude = 2, longitude = 2))$output1 -#) +#WRONG? +suppressWarnings( +res_crop_T_1 <- Compute(wf, chunks = list(latitude = 2, longitude = 2))$output1 +) suppressWarnings( res_crop_T_2 <- Compute(wf, chunks = list(ensemble = 1))$output1 ) -#WRONG -#suppressWarnings( -#res_crop_T_3 <- Compute(wf, chunks = list(longitude = 3))$output1 -#) +#WRONG? +suppressWarnings( +res_crop_T_3 <- Compute(wf, chunks = list(longitude = 3))$output1 +) suppressWarnings( res_crop_T_4 <- Compute(wf, chunks = list(latitude = 3))$output1 ) -#expect_equal( -#res1, -#res_crop_T_1 -#) +expect_equal( +res1, +res_crop_T_1 +) expect_equal( res1, res_crop_T_2 ) -#expect_equal( -#res1, -#res_crop_T_3 -#) +expect_equal( +res1, +res_crop_T_3 +) expect_equal( res1, res_crop_T_4 @@ -346,7 +345,6 @@ res_crop_T_4 test_that("2. Regional, no border", { -skip_on_cran() lons.min <- 10 lons.max <- 20 @@ -556,7 +554,6 @@ res_crop_T_3 test_that("3. Regional, at lon border", { -skip_on_cran() lons.min <- 0 lons.max <- 20 -- GitLab