diff --git a/R/Start.R b/R/Start.R index ac4fabaa946192efe50f0b49b77bbbbda26fa005..7ae30969c9da61f1695a77bd51d1437d1084c8c5 100644 --- a/R/Start.R +++ b/R/Start.R @@ -3747,9 +3747,26 @@ 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) + 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) + } } # The following several lines will only run if retrieve = TRUE diff --git a/R/zzz.R b/R/zzz.R index 8055c69aa16a786518d846403d1535a1d9fa743c..5a8ea5e8fe5cfe9abf729285c9662669c98a5e93 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 2374571d2e0653491ad7fbd2de4f16b699f0917a..5b50692cb2b17a34b8f1aa4782c1f83f7a456bb2 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(data, '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 +) + +})