diff --git a/R/NcDataReader.R b/R/NcDataReader.R index 25e33d412dca7545f1878b18eabe90d07e0432d4..47817c65e54684380670ab35b2bd928268afce62 100644 --- a/R/NcDataReader.R +++ b/R/NcDataReader.R @@ -62,7 +62,6 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, if (is.null(file_to_read)) { return(NULL) } - var_requested <- is.null(inner_indices) drop_var_dim <- FALSE diff --git a/R/Start.R b/R/Start.R index 42f72b6ff21519f53409f4269cf345296f78f780..3616f232d39ec36bf685a0ef88f7c60018545790 100644 --- a/R/Start.R +++ b/R/Start.R @@ -880,7 +880,6 @@ Start <- function(..., # dim = indices/selectors, if (!merge_across_dims & merge_across_dims_narm) { merge_across_dims_narm <- FALSE } - # Leave alone the dimension parameters in the variable dim_params dim_params <- rebuild_dim_params(dim_params, merge_across_dims, inner_dims_across_files) @@ -2774,10 +2773,10 @@ Start <- function(..., # dim = indices/selectors, !is.null(dim_reorder_params[[inner_dim]])) { if ('circular' %in% names(attributes(dim_reorder_params[[inner_dim]]))) { is_circular_dim <- attr(dim_reorder_params[[inner_dim]], "circular") - if (is_circular_dim & is.list(sub_array_of_selectors)) { - tmp <- dim_reorder_params[[inner_dim]](unlist(sub_array_of_selectors))$ix - goes_across_prime_meridian <- tmp[1] > tmp[2] - } + if (is_circular_dim & is.list(sub_array_of_selectors)) { + tmp <- dim_reorder_params[[inner_dim]](unlist(sub_array_of_selectors))$ix + goes_across_prime_meridian <- tmp[1] > tmp[2] + } } } @@ -2924,7 +2923,7 @@ Start <- function(..., # dim = indices/selectors, sub_array_of_indices[[1]] <- vect[tmp[1]] sub_array_of_indices[[2]] <- vect[tmp[length(tmp)]] } - } + } # The sub_array_of_indices now contains numeric indices of the values to be taken by each chunk. #//////////////////////////////////////////////////////////// @@ -3201,10 +3200,12 @@ Start <- function(..., # dim = indices/selectors, } } # If "_across = + merge_across_dims = FALSE + chunk over ", return error because this instance is not logically correct. - if (chunks[[inner_dim]]["n_chunks"] > 1 & inner_dim %in% inner_dims_across_files) { + if (chunks[[inner_dim]]["n_chunks"] > 1 & inner_dim %in% inner_dims_across_files & + merge_across_dims == FALSE) { stop("Chunk over dimension '", inner_dim, "' is not allowed because '", inner_dim, "' is across '", - names(inner_dims_across_files)[which(inner_dim %in% inner_dims_across_files)], "'.") + names(inner_dims_across_files)[which(inner_dim %in% inner_dims_across_files)], + "' and 'merge_across_dims' is set to FALSE'.") } if (inner_dim %in% names(dim(sub_array_of_selectors))) { diff --git a/R/zzz.R b/R/zzz.R index f098a3b11651e260dc72a23f5ec490e5e76a7320..267c27f861d3d3d68a9200de15352a2fb95204d0 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -151,7 +151,7 @@ rebuild_dim_params <- function(dim_params, merge_across_dims, # Look for chunked dims look_for_chunks <- function(dim_params, dim_names) { - chunks <- vector('list', length(dim_names)) + chunks <- vector('list', length(dim_names)) names(chunks) <- dim_names for (dim_name in dim_names) { if (!is.null(attr(dim_params[[dim_name]], 'chunk'))) { @@ -1021,7 +1021,6 @@ build_work_pieces <- function(work_pieces, i, selectors, file_dims, inner_dims, } j <- j + 1 } - return(work_pieces) } diff --git a/tests/testthat/test-Compute-chunk_across_dim.R b/tests/testthat/test-Compute-chunk_across_dim.R new file mode 100644 index 0000000000000000000000000000000000000000..0fb3382facf9e6dcadf687ec2c64024362038db7 --- /dev/null +++ b/tests/testthat/test-Compute-chunk_across_dim.R @@ -0,0 +1,129 @@ +suppressMessages({ +# This unit test tests the chunking over dimension that goes across files. +# 1. across dim is a vector +# a. merge_across_dims is TRUE +# b. merge_across_dims is FALSE +# Note that 1.b. doesn't work. + +path <- '/esarchive/exp/CMIP6/dcppA-hindcast/HadGEM3-GC31-MM/DCPP/MOHC/HadGEM3-GC31-MM/dcppA-hindcast/r1i1p1f2/Omon/tos/gn/v20200417/$var$_Omon_HadGEM3-GC31-MM_dcppA-hindcast_s$sdate$-r1i1p1f2_gn_$chunk$.nc' +path <- paste0('/esarchive/scratch/aho/startR_unittest_files/', path) + +sdates <- c('2016', '2017', '2018') + +# retrieve = T for verification +suppressWarnings( + data_T <- Start(dat = path, + var = 'tos', + sdate = sdates, + chunk = 'all', + chunk_depends = 'sdate', + time = indices(1:24), + i = indices(450:452), + j = indices(650:651), + time_across = 'chunk', + merge_across_dims = TRUE, + largest_dims_length = TRUE, + retrieve = TRUE, + return_vars = list(time = 'sdate')) +) + +test_that("1.a. across dim is a vector, merge_across_dims = TRUE", { + +suppressWarnings( +data <- Start(dat = path, + var = 'tos', + sdate = sdates, + chunk = 'all', + chunk_depends = 'sdate', + time = indices(1:24), + i = indices(450:452), + j = indices(650:651), + merge_across_dims = TRUE, + largest_dims_length = TRUE, + time_across = 'chunk', + return_vars = list(time = 'sdate'), + retrieve = FALSE) +) + +fun <- function(x) { +return(x) +} + +step <- Step(fun = fun, + target_dims = 'dat', output_dims = 'dat') +wf <- AddStep(inputs = data, step_fun = step) +suppressWarnings( +res1 <- Compute(workflow = wf, chunks = list(time = 1))$output1 +) +suppressWarnings( +res2 <- Compute(workflow = wf, chunks = list(time = 2))$output1 +) +suppressWarnings( +res3 <- Compute(workflow = wf, chunks = list(time = 3))$output1 +) + +expect_equal( +as.vector(data_T), +as.vector(res1) +) +expect_equal( +res1, +res2 +) +expect_equal( +res1, +res3 +) + +expect_equal( +as.vector(drop(res1)[ , 1, 1, 1]), +c(29.91125, 29.94805, 30.35584), +tolerance = 0.0001 +) +expect_equal( +as.vector(drop(res1)[ , 2, 1, 1]), +c(29.53878, 29.72491, 30.34167), +tolerance = 0.0001 +) + +}) + +################################################################# +################################################################# +################################################################# + +test_that("1.b. across dim is a vector, merge_across_dims = FALSE", { + +suppressWarnings( +data <- Start(dat = path, + var = 'tos', + sdate = sdates, + chunk = 'all', + chunk_depends = 'sdate', + time = indices(1:24), + i = indices(450:452), + j = indices(650:651), + merge_across_dims = FALSE, + largest_dims_length = TRUE, + time_across = 'chunk', + return_vars = list(time = 'sdate'), + retrieve = FALSE) +) + +fun <- function(x) { +return(x) +} + +step <- Step(fun = fun, + target_dims = 'dat', output_dims = 'dat') +wf <- AddStep(inputs = data, step_fun = step) + +expect_error( +suppressWarnings( +res <- Compute(workflow = wf, chunks = list(time = 2))$output1), +"Chunk over dimension 'time' is not allowed because 'time' is across 'chunk' and 'merge_across_dims' is set to FALSE'." +) + +}) + +}) #suppressMessages diff --git a/tests/testthat/test-Start-DCPP-across-depends-largest_dims_length.R b/tests/testthat/test-Start-DCPP-across-depends-largest_dims_length.R index 3e10c55392f16d30af0c00792f2ee0ad908b7d8f..843ea98de3da653d488a705328c1872742e5fd1d 100644 --- a/tests/testthat/test-Start-DCPP-across-depends-largest_dims_length.R +++ b/tests/testthat/test-Start-DCPP-across-depends-largest_dims_length.R @@ -11,8 +11,8 @@ suppressWarnings( chunk = 'all', chunk_depends = 'sdate', time = indices(1:15), - i = indices(1:10), - j = indices(1:10), + i = indices(450:452), + j = indices(650:651), time_across = 'chunk', merge_across_dims = TRUE, largest_dims_length = TRUE, @@ -28,8 +28,8 @@ suppressWarnings( chunk = 'all', chunk_depends = 'sdate', time = indices(3:15), - i = indices(1:10), - j = indices(1:10), + i = indices(450:452), + j = indices(650:651), time_across = 'chunk', merge_across_dims = TRUE, largest_dims_length = TRUE, @@ -37,7 +37,7 @@ suppressWarnings( return_vars = list(time = 'sdate')) ) -expect_equal(dat1[1, 1, 1:2, 3:15, 10, 10], dat2[1, 1, 1:2, , 10, 10]) +expect_equal(dat1[1, 1, 1:2, 3:15, , ], dat2[1, 1, 1:2, , , ]) # Start at chunk 3 (skip time steps in the first and second files) suppressWarnings( @@ -47,8 +47,8 @@ suppressWarnings( chunk = 'all', chunk_depends = 'sdate', time = indices(15), - i = indices(1:10), - j = indices(1:10), + i = indices(450:452), + j = indices(650:651), time_across = 'chunk', merge_across_dims = TRUE, largest_dims_length = TRUE, @@ -56,7 +56,7 @@ suppressWarnings( return_vars = list(time = 'sdate')) ) -expect_equal(dat1[1, 1, 1:2, 15, 10, 10], dat3[1, 1, 1:2, , 10, 10]) +expect_equal(dat1[1, 1, 1:2, 15, , ], dat3[1, 1, 1:2, , , ]) })