From a901dc5099397626373f4b1d6aa3ea424194924c Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 29 Mar 2022 11:46:08 +0200 Subject: [PATCH 1/3] Fix metadata reshaping when time dim is implicit and the split file dim array has time as a dimension --- R/Start.R | 29 +++++++- R/zzz.R | 18 +++-- .../testthat/test-Start-metadata_reshaping.R | 70 +++++++++++++++++++ 3 files changed, 104 insertions(+), 13 deletions(-) diff --git a/R/Start.R b/R/Start.R index ac4faba..36eed74 100644 --- a/R/Start.R +++ b/R/Start.R @@ -3747,9 +3747,32 @@ Start <- function(..., # dim = indices/selectors, } } if (merge_across_dims | split_multiselected_dims) { - final_dims_fake_metadata <- find_final_dims_fake_metadata( - merge_across_dims, split_multiselected_dims, picked_common_vars, across_inner_dim, - final_dims_fake, dims_of_merge_dim, all_split_dims, inner_dim_has_split_dim) +#--------NEW3-------------------- + if (!merge_across_dims & split_multiselected_dims & identical(inner_dim_has_split_dim, character(0))) { + final_dims_fake_metadata <- NULL + } else { + if (!merge_across_dims & split_multiselected_dims) { + if (any(names(all_split_dims[[1]]) %in% names(dim(picked_common_vars[[inner_dim_has_split_dim]]))) & + names(all_split_dims)[1] != inner_dim_has_split_dim) { + if (inner_dim_has_split_dim %in% names(final_dims)) { + stop("Detect inner dimension in the split array, but merge_across_dims is not used. The output dimensions will be repeated. Check if the dimensions and parameters are correctly defined.") + } else { + # Only split no merge, time dim is not explicitly defined because the + # length is 1, the sdate dim to be split having 'time' as one dimension. + # --> Take 'time' dim off from picked_common_vars. + dim(picked_common_vars[[inner_dim_has_split_dim]]) <- dim(picked_common_vars[[inner_dim_has_split_dim]])[-which(names(dim(picked_common_vars[[inner_dim_has_split_dim]])) == inner_dim_has_split_dim)] + } + } + } + final_dims_fake_metadata <- find_final_dims_fake_metadata( + merge_across_dims, split_multiselected_dims, picked_common_vars = picked_common_vars[[inner_dim_has_split_dim]], across_inner_dim, + final_dims_fake, dims_of_merge_dim, all_split_dims) + } + +# final_dims_fake_metadata <- find_final_dims_fake_metadata( +# merge_across_dims, split_multiselected_dims, picked_common_vars, across_inner_dim, +# final_dims_fake, dims_of_merge_dim, all_split_dims, inner_dim_has_split_dim) +#-------NEW3_END------------- } # The following several lines will only run if retrieve = TRUE diff --git a/R/zzz.R b/R/zzz.R index 8055c69..5a8ea5e 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -825,8 +825,7 @@ reorder_split_dims <- function(all_split_dims, inner_dim_pos_in_split_dims, fina # Find the final_dims_fake for metadata if it needs to be reshaped find_final_dims_fake_metadata <- function(merge_across_dims, split_multiselected_dims, picked_common_vars, across_inner_dim, final_dims_fake, - dims_of_merge_dim, all_split_dims, inner_dim_has_split_dim) { - final_dims_fake_metadata <- NULL + dims_of_merge_dim, all_split_dims) { if (merge_across_dims) { if (!split_multiselected_dims) { final_dims_fake_metadata <- final_dims_fake[names(final_dims_fake) %in% names(dims_of_merge_dim)] @@ -834,16 +833,15 @@ find_final_dims_fake_metadata <- function(merge_across_dims, split_multiselected final_dims_fake_metadata <- final_dims_fake[names(final_dims_fake) %in% names(all_split_dims[[across_inner_dim]])] } } else if (split_multiselected_dims) { - if (!identical(inner_dim_has_split_dim, character(0))) { - target_split_dim_ind <- which(names(dim(picked_common_vars[[inner_dim_has_split_dim]])) == names(all_split_dims)) - margin_dim_ind <- c(1:length(dim(picked_common_vars[[inner_dim_has_split_dim]])))[-target_split_dim_ind] - if (identical(margin_dim_ind, numeric(0)) | identical(margin_dim_ind, integer(0))) { - final_dims_fake_metadata <- all_split_dims[[1]] - } else { - final_dims_fake_metadata <- .ReplaceElementInVector(dim(picked_common_vars[[inner_dim_has_split_dim]]), target = names(all_split_dims), new_val = all_split_dims[[1]]) - } + target_split_dim_ind <- which(names(dim(picked_common_vars)) == names(all_split_dims)) + margin_dim_ind <- c(1:length(dim(picked_common_vars)))[-target_split_dim_ind] + if (identical(margin_dim_ind, numeric(0)) | identical(margin_dim_ind, integer(0))) { + final_dims_fake_metadata <- all_split_dims[[1]] + } else { + final_dims_fake_metadata <- .ReplaceElementInVector(dim(picked_common_vars), target = names(all_split_dims), new_val = all_split_dims[[1]]) } } + return(final_dims_fake_metadata) } diff --git a/tests/testthat/test-Start-metadata_reshaping.R b/tests/testthat/test-Start-metadata_reshaping.R index 2374571..bc048f0 100644 --- a/tests/testthat/test-Start-metadata_reshaping.R +++ b/tests/testthat/test-Start-metadata_reshaping.R @@ -617,3 +617,73 @@ dates }) +test_that("9. split file dim that contains 'time', and 'time' inner dim is implicit", { + +dates_arr <- array(c(paste0(1961, '0', 1:5), paste0(1962, '0', 1:5)), dim = c(time = 5, syear = 2)) + +suppressWarnings( +data <- Start(dat = '/esarchive/recon/jma/jra55/monthly_mean/$var$_f6h/$var$_$file_date$.nc', + var = 'tas', + file_date = dates_arr, # [syear, time] + split_multiselected_dims = TRUE, + latitude = indices(1), + longitude = indices(1), + synonims = list(latitude = c('lat','latitude'), + longitude = c('lon','longitude')), + return_vars = list(latitude = NULL, longitude = NULL, + time = 'file_date'), + retrieve = TRUE) +) +dim(obs) +# dat var time syear latitude longitude +# 1 1 5 2 1 1 + +dates <- attr(obs, 'Variables')$common$time + + +expect_equal( +dim(dates), +c(time = 5, syear = 2) +) +expect_equal( +dim(drop(data)), +dim(dates) +) +expect_equal( +length(attributes(dates)), +4 +) +expect_equal( +all(names(attributes(dates)) %in% c('variables', 'dim', 'class', 'tzone')), +TRUE +) +expect_equal( +class(dates), +c("POSIXct", "POSIXt") +) +expect_equal( +format(dates, '%Y%m'), +as.vector(dates_arr) +) + + +suppressWarnings( +dataF <- Start(dat = '/esarchive/recon/jma/jra55/monthly_mean/$var$_f6h/$var$_$file_date$.nc', + var = 'tas', + file_date = dates_arr, # [syear, time] + split_multiselected_dims = TRUE, + latitude = indices(1), + longitude = indices(1), + synonims = list(latitude = c('lat','latitude'), + longitude = c('lon','longitude')), + return_vars = list(latitude = NULL, longitude = NULL, + time = 'file_date'), + retrieve = FALSE) +) +datesF <- attr(dataF,'Variables')$common[['time']] +expect_equal( +datesF, +dates +) + +}) -- GitLab From a03c0eb22ca834389ff4625e021406cc8133fa37 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 29 Mar 2022 11:51:40 +0200 Subject: [PATCH 2/3] Remove extra comments --- R/Start.R | 6 ------ 1 file changed, 6 deletions(-) diff --git a/R/Start.R b/R/Start.R index 36eed74..7ae3096 100644 --- a/R/Start.R +++ b/R/Start.R @@ -3747,7 +3747,6 @@ Start <- function(..., # dim = indices/selectors, } } if (merge_across_dims | split_multiselected_dims) { -#--------NEW3-------------------- if (!merge_across_dims & split_multiselected_dims & identical(inner_dim_has_split_dim, character(0))) { final_dims_fake_metadata <- NULL } else { @@ -3768,11 +3767,6 @@ Start <- function(..., # dim = indices/selectors, merge_across_dims, split_multiselected_dims, picked_common_vars = picked_common_vars[[inner_dim_has_split_dim]], across_inner_dim, final_dims_fake, dims_of_merge_dim, all_split_dims) } - -# final_dims_fake_metadata <- find_final_dims_fake_metadata( -# merge_across_dims, split_multiselected_dims, picked_common_vars, across_inner_dim, -# final_dims_fake, dims_of_merge_dim, all_split_dims, inner_dim_has_split_dim) -#-------NEW3_END------------- } # The following several lines will only run if retrieve = TRUE -- GitLab From da6a1329e3c102d8b1eaa3955e70f4bb45f7301d Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 29 Mar 2022 12:53:41 +0200 Subject: [PATCH 3/3] Fix typo --- tests/testthat/test-Start-metadata_reshaping.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-Start-metadata_reshaping.R b/tests/testthat/test-Start-metadata_reshaping.R index bc048f0..5b50692 100644 --- a/tests/testthat/test-Start-metadata_reshaping.R +++ b/tests/testthat/test-Start-metadata_reshaping.R @@ -638,7 +638,7 @@ dim(obs) # dat var time syear latitude longitude # 1 1 5 2 1 1 -dates <- attr(obs, 'Variables')$common$time +dates <- attr(data, 'Variables')$common$time expect_equal( -- GitLab