From 50616d75d74f48f1de6d315ab97910d033aaf35d Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 27 Sep 2021 14:46:42 +0200 Subject: [PATCH 1/3] Modularize --- R/Start.R | 54 +++++++++++++++++++++++++++++++++++++++++------------- R/zzz.R | 10 ++++++++++ 2 files changed, 51 insertions(+), 13 deletions(-) diff --git a/R/Start.R b/R/Start.R index b361eb1..5753820 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2077,16 +2077,21 @@ Start <- function(..., # dim = indices/selectors, # replaced for equivalent indices. if ((any(dat[[i]][['selectors']][[inner_dim]][[1]] %in% c('all', 'first', 'last'))) && (chunks[[inner_dim]]['n_chunks'] != 1)) { - selectors <- dat[[i]][['selectors']][[inner_dim]][[1]] - if (selectors == 'all') { - selectors <- indices(1:(data_dims[[inner_dim]] * chunk_amount)) - } else if (selectors == 'first') { - selectors <- indices(1) - } else { - selectors <- indices(data_dims[[inner_dim]] * chunk_amount) - } - dat[[i]][['selectors']][[inner_dim]][[1]] <- selectors +#------------NEW---------------------- +# selectors <- dat[[i]][['selectors']][[inner_dim]][[1]] +# if (selectors == 'all') { +# selectors <- indices(1:(data_dims[[inner_dim]] * chunk_amount)) +# } else if (selectors == 'first') { +# selectors <- indices(1) +# } else { +# selectors <- indices(data_dims[[inner_dim]] * chunk_amount) +# } +# dat[[i]][['selectors']][[inner_dim]][[1]] <- selectors + dat[[i]][['selectors']][[inner_dim]][[1]] <- + replace_character_with_indices(selectors = dat[[i]][['selectors']][[inner_dim]][[1]]) +#------------------NEW_END-------------------- } + # The selectors for the inner dimension are taken. selector_array <- dat[[i]][['selectors']][[inner_dim]][[1]] if (debug) { @@ -2135,6 +2140,7 @@ Start <- function(..., # dim = indices/selectors, var_ordered <- NULL var_unorder_indices <- NULL with_transform <- FALSE + #//////////////////////////////////////////////////////////////////// # If the selectors come with an associated variable if (!is.null(var_with_selectors_name)) { if ((var_with_selectors_name %in% transform_vars) && (!is.null(transform))) { @@ -2224,6 +2230,7 @@ Start <- function(..., # dim = indices/selectors, var_unorder_indices <- 1:m } } + if (debug) { if (inner_dim %in% dims_to_check) { print("-> SIZE OF ORIGINAL VARIABLE:") @@ -2236,8 +2243,13 @@ Start <- function(..., # dim = indices/selectors, print(var_unorder_indices) } } - var_dims <- dim(var_with_selectors) +#-----------------NEW-------------------- + var_dims <- var_full_dims <- dim(var_with_selectors) +#---------------NEW_END----------------- var_file_dims <- 1 + + # If this inner dim's selector (var_with_selectors) is an array + # that has file dim as dimension (e.g., across or depend relationship) if (any(names(var_dims) %in% found_file_dims[[i]])) { if (with_transform) { stop("Requested transformation for inner dimension '", @@ -2283,7 +2295,9 @@ 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) +#-----------------NEW-------------------- +# var_full_dims <- dim(var_with_selectors) +#-----------------NEW_END-------------------- 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 ", @@ -2317,6 +2331,8 @@ Start <- function(..., # dim = indices/selectors, # data_dims has been populated. If a selector variable was provided, # the variables var_dims, var_file_dims and var_full_dims have been # populated instead. + #//////////////////////////////////////////////////////////////////// + fri <- first_round_indices <- NULL sri <- second_round_indices <- NULL # This variable will keep the indices needed to crop the transformed @@ -2517,7 +2533,10 @@ Start <- function(..., # dim = indices/selectors, #} else if (!is.null(var_ordered)) { # sub_array_of_values <- var_ordered } else { - if (length(var_file_dims) > 0) { +#-------------NEW---------------- + if (length(names(var_file_dims)) > 0) { +# if (length(var_file_dims) > 0) { +#-------------NEW_END--------------- var_indices_to_take <- selector_indices_to_take[which(names(selector_indices_to_take) %in% names(var_file_dims))] sub_array_of_values <- Subset(var_with_selectors, names(var_indices_to_take), as.list(var_indices_to_take), drop = 'selected') @@ -2683,8 +2702,9 @@ Start <- function(..., # dim = indices/selectors, } } - # If chunking along this inner dim, this part creates the indices for each chunk. + #//////////////////////////////////////////////////////////// + # If chunking along this inner dim, this part creates the indices for each chunk. # For example, if 'sub_array_of_indices' is c(5:10) and chunked into 2, # 'sub_array_of_indices' becomes c(5:7) for chunk = 1, c(8:10) for chunk = 2. # If 'sub_array_of_indices' is list(55, 62) and chunked into 2, it becomes @@ -2718,6 +2738,8 @@ Start <- function(..., # dim = indices/selectors, } } # The sub_array_of_indices now contains numeric indices of the values to be taken by each chunk. + #//////////////////////////////////////////////////////////// + #---------------------------------------------------------- # 'sub_sub_array_of_values' is for sri chunking. If this inner dim is chunked, @@ -3244,6 +3266,8 @@ Start <- function(..., # dim = indices/selectors, crop_indices <- unique(unlist(tvi)) } vars_to_crop <- transformed_vars[[i]] +print('transformed_common_vars') +print(str(transformed_common_vars)) common_vars_to_crop <- transformed_common_vars } else if (type_of_var_to_crop == 'reordered') { crop_indices <- unique(unlist(ordered_fri)) @@ -3284,9 +3308,13 @@ Start <- function(..., # dim = indices/selectors, if (type_of_var_to_crop == 'transformed' & !aiat) { if (!(length(selector_array) == 1 & selector_array %in% c('all', 'first', 'last'))) { +print('transformed_subset_var') +print(str(transformed_subset_var)) common_vars_to_crop[[common_var_to_crop]] <- Subset(transformed_subset_var, inner_dim, crop_indices) } else { +print('transformed_var_with_selectors') +print(str(transformed_var_with_selectors)) common_vars_to_crop[[common_var_to_crop]] <- Subset(transformed_var_with_selectors, inner_dim, crop_indices) } diff --git a/R/zzz.R b/R/zzz.R index 3eeed1a..b84b9e8 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1357,3 +1357,13 @@ transform_indices <- function(v, n, m) { unique2(round(((v - 1) / (n - 1)) * (m - 1))) + 1 # this rounding may generate 0s. what then? } +replace_character_with_indices <- function(selectors) { + if (selectors == 'all') { + selectors <- indices(1:(data_dims[[inner_dim]] * chunk_amount)) + } else if (selectors == 'first') { + selectors <- indices(1) + } else if (selectors == 'last') { + selectors <- indices(data_dims[[inner_dim]] * chunk_amount) + } + return(selectors) +} -- GitLab From 463fc1b2cf0e9e8eed0c2d5489010c9f2d57b362 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 27 Sep 2021 14:55:52 +0200 Subject: [PATCH 2/3] Remove skip_on_cran() --- tests/testthat/test-Compute-transform_all.R | 4 ++-- tests/testthat/test-Compute-transform_indices.R | 6 +++--- tests/testthat/test-Compute-transform_values.R | 8 ++++---- 3 files changed, 9 insertions(+), 9 deletions(-) diff --git a/tests/testthat/test-Compute-transform_all.R b/tests/testthat/test-Compute-transform_all.R index 46430d7..2a676e4 100644 --- a/tests/testthat/test-Compute-transform_all.R +++ b/tests/testthat/test-Compute-transform_all.R @@ -1,7 +1,7 @@ context("Transform with 'all'") test_that("1. Chunk along non-lat/lon dim", { -skip_on_cran() +#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 +47,7 @@ tolerance = 0.0001 }) test_that("2. chunk along lon", { -skip_on_cran() +#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..12c838d 100644 --- a/tests/testthat/test-Compute-transform_indices.R +++ b/tests/testthat/test-Compute-transform_indices.R @@ -22,7 +22,7 @@ context("Transform with indices") test_that("1. global", { -skip_on_cran() +#skip_on_cran() path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' @@ -251,7 +251,7 @@ res_crop_T_4$output1 test_that("2. regional, no border", { -skip_on_cran() +#skip_on_cran() path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' @@ -465,7 +465,7 @@ res_crop_T_3$output1 test_that("3. regional, at lon border", { -skip_on_cran() +#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..8ea0ea5 100644 --- a/tests/testthat/test-Compute-transform_values.R +++ b/tests/testthat/test-Compute-transform_values.R @@ -6,8 +6,8 @@ context("Compute: Transform and chunk values()") ##################################################################### ##################################################################### -test_that("1. Global", { -skip_on_cran() +#test_that("1. Global", { +#skip_on_cran() lons.min <- 0 lons.max <- 359.9 @@ -346,7 +346,7 @@ res_crop_T_4 test_that("2. Regional, no border", { -skip_on_cran() +#skip_on_cran() lons.min <- 10 lons.max <- 20 @@ -556,7 +556,7 @@ res_crop_T_3 test_that("3. Regional, at lon border", { -skip_on_cran() +#skip_on_cran() lons.min <- 0 lons.max <- 20 -- GitLab From c17797c8c3833aa7b11ccda96c2825d1d201b655 Mon Sep 17 00:00:00 2001 From: aho Date: Mon, 27 Sep 2021 17:15:08 +0200 Subject: [PATCH 3/3] typo fix --- R/Start.R | 27 +------------------ R/zzz.R | 6 ++--- .../testthat/test-Compute-transform_values.R | 2 +- 3 files changed, 5 insertions(+), 30 deletions(-) diff --git a/R/Start.R b/R/Start.R index 5753820..d59e277 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2077,19 +2077,8 @@ Start <- function(..., # dim = indices/selectors, # replaced for equivalent indices. if ((any(dat[[i]][['selectors']][[inner_dim]][[1]] %in% c('all', 'first', 'last'))) && (chunks[[inner_dim]]['n_chunks'] != 1)) { -#------------NEW---------------------- -# selectors <- dat[[i]][['selectors']][[inner_dim]][[1]] -# if (selectors == 'all') { -# selectors <- indices(1:(data_dims[[inner_dim]] * chunk_amount)) -# } else if (selectors == 'first') { -# selectors <- indices(1) -# } else { -# selectors <- indices(data_dims[[inner_dim]] * chunk_amount) -# } -# dat[[i]][['selectors']][[inner_dim]][[1]] <- selectors dat[[i]][['selectors']][[inner_dim]][[1]] <- - replace_character_with_indices(selectors = dat[[i]][['selectors']][[inner_dim]][[1]]) -#------------------NEW_END-------------------- + replace_character_with_indices(selectors = dat[[i]][['selectors']][[inner_dim]][[1]], data_dims = data_dims[[inner_dim]], chunk_amount) } # The selectors for the inner dimension are taken. @@ -2243,9 +2232,7 @@ Start <- function(..., # dim = indices/selectors, print(var_unorder_indices) } } -#-----------------NEW-------------------- var_dims <- var_full_dims <- dim(var_with_selectors) -#---------------NEW_END----------------- var_file_dims <- 1 # If this inner dim's selector (var_with_selectors) is an array @@ -2295,9 +2282,6 @@ Start <- function(..., # dim = indices/selectors, } ## TODO HERE:: #- indices_of_first_files_with_data may change, because array is now extended -#-----------------NEW-------------------- -# var_full_dims <- dim(var_with_selectors) -#-----------------NEW_END-------------------- 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 ", @@ -2533,10 +2517,7 @@ Start <- function(..., # dim = indices/selectors, #} else if (!is.null(var_ordered)) { # sub_array_of_values <- var_ordered } else { -#-------------NEW---------------- if (length(names(var_file_dims)) > 0) { -# if (length(var_file_dims) > 0) { -#-------------NEW_END--------------- var_indices_to_take <- selector_indices_to_take[which(names(selector_indices_to_take) %in% names(var_file_dims))] sub_array_of_values <- Subset(var_with_selectors, names(var_indices_to_take), as.list(var_indices_to_take), drop = 'selected') @@ -3266,8 +3247,6 @@ Start <- function(..., # dim = indices/selectors, crop_indices <- unique(unlist(tvi)) } vars_to_crop <- transformed_vars[[i]] -print('transformed_common_vars') -print(str(transformed_common_vars)) common_vars_to_crop <- transformed_common_vars } else if (type_of_var_to_crop == 'reordered') { crop_indices <- unique(unlist(ordered_fri)) @@ -3308,13 +3287,9 @@ print(str(transformed_common_vars)) if (type_of_var_to_crop == 'transformed' & !aiat) { if (!(length(selector_array) == 1 & selector_array %in% c('all', 'first', 'last'))) { -print('transformed_subset_var') -print(str(transformed_subset_var)) common_vars_to_crop[[common_var_to_crop]] <- Subset(transformed_subset_var, inner_dim, crop_indices) } else { -print('transformed_var_with_selectors') -print(str(transformed_var_with_selectors)) common_vars_to_crop[[common_var_to_crop]] <- Subset(transformed_var_with_selectors, inner_dim, crop_indices) } diff --git a/R/zzz.R b/R/zzz.R index b84b9e8..109baa9 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1357,13 +1357,13 @@ transform_indices <- function(v, n, m) { unique2(round(((v - 1) / (n - 1)) * (m - 1))) + 1 # this rounding may generate 0s. what then? } -replace_character_with_indices <- function(selectors) { +replace_character_with_indices <- function(selectors, data_dims, chunk_amount) { if (selectors == 'all') { - selectors <- indices(1:(data_dims[[inner_dim]] * chunk_amount)) + selectors <- indices(1:(data_dims * chunk_amount)) } else if (selectors == 'first') { selectors <- indices(1) } else if (selectors == 'last') { - selectors <- indices(data_dims[[inner_dim]] * chunk_amount) + selectors <- indices(data_dims * chunk_amount) } return(selectors) } diff --git a/tests/testthat/test-Compute-transform_values.R b/tests/testthat/test-Compute-transform_values.R index 8ea0ea5..0abd1b5 100644 --- a/tests/testthat/test-Compute-transform_values.R +++ b/tests/testthat/test-Compute-transform_values.R @@ -6,7 +6,7 @@ context("Compute: Transform and chunk values()") ##################################################################### ##################################################################### -#test_that("1. Global", { +test_that("1. Global", { #skip_on_cran() lons.min <- 0 -- GitLab