diff --git a/R/Start.R b/R/Start.R index 0076e9aa1236daa438573a94ccde57b93cab4fa5..ecd68d4466ea1450b9ec05510e0c16d6ccd07865 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2140,16 +2140,37 @@ print("-> SELECTORS REQUESTED BEFORE TRANSFORM.") ###NOTE: Here, the transform, is different from the below part of non-transform. # search 'if (goes_across_prime_meridian' to find the lines below. if (goes_across_prime_meridian) { -# NOTE: before changing, the return is already correct. sub_array_of_fri is defined -# again afterward. Not sure if here is redundant. - sub_array_of_fri <- c(1:min(unlist(sub_array_of_indices)), - max(unlist(sub_array_of_indices)):n) +# NOTE: before changing, the return is already correct. + +#NOTE: The fix below has the same explanation as no with_transform part below. +# Search the next next 'if (goes_across_prime_meridian) {'. + if (sub_array_of_indices[[1]] == sub_array_of_indices[[2]]) { + # global longitude + sub_array_of_fri <- 1:n + # Warning if transform_extra_cell != 0 + if (beta != 0) { + .warning(paste0("Adding parameter transform_extra_cells = ", + transform_extra_cells, " to the transformed index excesses ", + "the border. The border index is used for transformation.")) + } + } else { + # normal case, i.e., not global + first_index <- min(unlist(sub_array_of_indices)) + last_index <- max(unlist(sub_array_of_indices)) + gap_width <- last_index - first_index - 1 + sub_array_of_fri <- c(1:(min(unlist(sub_array_of_indices)) + min(gap_width, beta)), + (max(unlist(sub_array_of_indices)) - min(gap_width, beta)):n) + + if (min(gap_width, beta) != beta) { + .warning(paste0("Adding parameter transform_extra_cells = ", + transform_extra_cells, " to the transformed index excesses ", + "the border. The border index is used for transformation.")) + } + } - #gap_width <- sub_array_of_indices[[1]] - sub_array_of_indices[[2]] - 1 - #sub_array_of_fri <- c((1:(sub_array_of_indices[[2]] + min(gap_width, beta))), - # (sub_array_of_indices[[1]] - min(gap_width, beta)):n) } else { + #NOTE: This if seems redundant. if (is.list(sub_array_of_indices)) { sub_array_of_indices <- sub_array_of_indices[[1]]:sub_array_of_indices[[2]] } @@ -2226,10 +2247,17 @@ print("-> SELECTORS REQUESTED BEFORE TRANSFORM.") } if (goes_across_prime_meridian) { - # Because sub_array_of_sri order is exchanged due to - # previous development, here [[1]] and [[2]] should exchange - sub_array_of_sri <- c(1:sub_array_of_sri[[1]], - sub_array_of_sri[[2]]:length(transformed_subset_var)) + + if (sub_array_of_sri[[1]] == sub_array_of_sri[[2]]) { + # global longitude + sub_array_of_sri <- c(1:length(transformed_subset_var)) + } else { + # the common case, i.e., non-global + # NOTE: Because sub_array_of_sri order is exchanged due to + # previous development, here [[1]] and [[2]] should exchange + sub_array_of_sri <- c(1:sub_array_of_sri[[1]], + sub_array_of_sri[[2]]:length(transformed_subset_var)) + } } else if (is.list(sub_array_of_sri)) { sub_array_of_sri <- sub_array_of_sri[[1]]:sub_array_of_sri[[2]] @@ -2285,8 +2313,22 @@ print(str(tvi)) list(value = sub_array_of_sri))) } else { if (goes_across_prime_meridian) { +#NOTE: The potential problem here is, if it is global longitude, +# and the indices overlap (e.g., lon = [0, 359.723] and +# CircularSort(-180, 180), then sub_array_of_indices = list(649, 649)). +# Therefore, sub_array_of_fri will be c(1:649, 649:1296). We'll +# get two 649. +# The fix below may not be the best solution, but it works for +# the example above. + + if (sub_array_of_indices[[1]] == sub_array_of_indices[[2]]) { + # global longitude + sub_array_of_fri <- c(1:n) + } else { + # the common case, i.e., non-global sub_array_of_fri <- c(1:min(unlist(sub_array_of_indices)), max(unlist(sub_array_of_indices)):n) + } } else if (is.list(sub_array_of_indices)) { sub_array_of_fri <- sub_array_of_indices[[1]]:sub_array_of_indices[[2]] diff --git a/tests/testthat/test-Start-global-lon-across_meridian.R b/tests/testthat/test-Start-global-lon-across_meridian.R new file mode 100644 index 0000000000000000000000000000000000000000..aa1dc18f254a03a6e81cced65409123620758b42 --- /dev/null +++ b/tests/testthat/test-Start-global-lon-across_meridian.R @@ -0,0 +1,53 @@ +context("Start() across_meridia global lon length check") + +test_that("first test", { + + + repos <- "/esarchive/exp/ecmwf/system5_m1/monthly_mean/tas_f6h/$var$_$sdate$.nc" + var <- 'tas' + lon.min <- 0 + lon.max <- 359.723 #360 + lat.min <- -90 + lat.max <- 90 + + data <- Start(dat = repos, + var = var, + sdate = c('20170101'), + ensemble = indices(1), + time = indices(1), + latitude = values(list(lat.min, lat.max)), + latitude_reorder = Sort(decreasing = T), + longitude = values(list(lon.min, lon.max)), + longitude_reorder = CircularSort(-180, 180), + return_vars = list(time = 'sdate', + longitude = 'dat', + latitude = 'dat'), + retrieve = FALSE + ) + + data2 <- Start(dat = repos, + var = var, + sdate = c('20170101'), + ensemble = indices(1), + time = indices(1), + latitude = values(list(lat.min, lat.max)), + latitude_reorder = Sort(decreasing = T), + longitude = values(list(lon.min, lon.max)), + longitude_reorder = CircularSort(0, 360), + return_vars = list(time = 'sdate', + longitude = 'dat', + latitude = 'dat'), + retrieve = FALSE + ) + + expect_equal( + attr(data, 'Dimensions'), + c(dat = 1, var = 1, sdate = 1, ensemble = 1, + time = 1, latitude = 640, longitude = 1296) + ) + expect_equal( + attr(data, 'Dimensions'), + attr(data2, 'Dimensions') + ) + +})