From eaff808315346e952221a458c6582a01d7c1eda9 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 7 Jan 2022 21:04:27 +0100 Subject: [PATCH 1/5] Deprecate 'crop' in CDORemapper(). It is automatically assigned as the borders of lat/lon selectors in Start() call. (WIP) --- R/CDORemapper.R | 86 ++++++++++++++++++++++++++++++++++++++++++---- R/Start.R | 90 +++++++++++++++++++++++++++++++++---------------- R/zzz.R | 16 +++++++++ 3 files changed, 157 insertions(+), 35 deletions(-) diff --git a/R/CDORemapper.R b/R/CDORemapper.R index 8e2a468..16aa21b 100644 --- a/R/CDORemapper.R +++ b/R/CDORemapper.R @@ -42,8 +42,7 @@ #' longitude_reorder = CircularSort(-180, 180), #' transform = CDORemapper, #' transform_params = list(grid = 'r360x181', -#' method = 'conservative', -#' crop = c(-120, 120, -60, 60)), +#' method = 'conservative'), #' transform_vars = c('latitude', 'longitude'), #' return_vars = list(latitude = 'dat', #' longitude = 'dat', @@ -52,7 +51,8 @@ #' } #'@importFrom s2dv CDORemap #'@export -CDORemapper <- function(data_array, variables, file_selectors = NULL, ...) { +CDORemapper <- function(data_array, variables, file_selectors = NULL, + crop_domain = NULL, ...) { file_dims <- names(file_selectors) known_lon_names <- startR:::.KnownLonNames() known_lat_names <- startR:::.KnownLatNames() @@ -89,11 +89,85 @@ CDORemapper <- function(data_array, variables, file_selectors = NULL, ...) { } } extra_params <- list(...) - if (!all(c('grid', 'method', 'crop') %in% names(extra_params))) { - stop("Parameters 'grid', 'method' and 'crop' must be specified for the ", + + if (!all(c('grid', 'method') %in% names(extra_params))) { + stop("Parameters 'grid' and 'method' must be specified for the ", "CDORemapper, via the 'transform_params' argument.") } - result <- s2dv::CDORemap(data_array, lons, lats, ...) +#-----------NEW------------- + # Use crop_domain to get 'crop' + ## lon + known_lon_names <- startR:::.KnownLonNames() + lon_name <- names(crop_domain)[which(names(crop_domain) %in% known_lon_names)] +# if (attr(crop_domain[[lon_name]], 'values')) { +# if (is.list(crop_domain[[lon_name]])) { +# crop_lon <- unlist(crop_domain[[lon_name]]) +# } else { # vector +# crop_lon <- c(crop_domain[[lon_name]][1], tail(crop_domain[[lon_name]], 1)) +# } +# } else if (crop_domain[[lon_name]] == 'all') { +# crop_lon <- c(lons[1], tail(lons, 1)) +# } else { # indices() +# if (is.list(crop_domain[[lon_name]])) { +# crop_lon <- lons[unlist(crop_domain[[lon_name]])] +# } else { # vector +# crop_lon <- c(lons[crop_domain[[lon_name]][1]], +# lons[tail(crop_domain[[lon_name]], 1)]) +# } +# } + crop_lon <- unlist(crop_domain[[lon_name]]) + +#PROBLEM----------------------------------- + # If lon_reorder is not used and lon selector is from big to small (e.g., + # lon is expected to be c(20, 19, ..., 1, 0)), crop_lon need to exchange the order from c(20, 10) to c(10, 20). The 2nd criteria is, if lon_reorder is used, + # the meridian is crossed and lons will cover the smallest and biggest values; if not, the range of lons will be smaller than the whole region. + # The third criteria is for an odd Start() call that the longitude selector is not aligned with CircularSort(). E.g., lon = values(20, 10) but lon_reorder = CircularSort(-180, 180). Not sure if it is univerally correct. It's better to know if lon_reorder is used, but in CDORemapper() this info is missing. +#print('lons') +#print(str(lons)) +#print('val') +#print(str((attr(lons, 'variables')[[lon_name]]$dim[[1]]$vals))) + if (crop_lon[1] > crop_lon[2] & + diff(range(lons)) != diff(range(attr(lons, 'variables')[[lon_name]]$dim[[1]]$vals)) & + all(crop_lon >= range(lons)[1] & crop_lon <= range(lons)[2])) { + crop_lon <- rev(crop_lon) + } +#PROBLEM----------------------------------- + + + ## lat + known_lat_names <- startR:::.KnownLatNames() + lat_name <- names(crop_domain)[which(names(crop_domain) %in% known_lat_names)] +# if (attr(crop_domain[[lat_name]], 'values')) { +# if (is.list(crop_domain[[lat_name]])) { +# crop_lat <- unlist(crop_domain[[lat_name]]) +# } else { # vector +# crop_lat <- c(crop_domain[[lat_name]][1], tail(crop_domain[[lat_name]], 1)) +# } +# } else if (crop_domain[[lat_name]] == 'all') { +# crop_lat <- c(lats[1], tail(lats, 1)) +# } else { # indices() +# if (is.list(crop_domain[[lat_name]])) { +# crop_lat <- lats[unlist(crop_domain[[lat_name]])] +# } else { # vector +##lats and indices are both original?? without reorder?? +# crop_lat <- c(lats[crop_domain[[lat_name]][1]], +# lats[tail(crop_domain[[lat_name]], 1)]) +# } +# } + crop_lat <- unlist(crop_domain[[lat_name]]) + crop_values <- c(crop_lon, crop_lat) +print('crop_values') +print(crop_values) + if ('crop' %in% names(extra_params)) { + .warning("Argument 'crop' in 'transform_params' for CDORemapper() is ", + "deprecated. It is automatically assigned as the selected .", + "domain in Start() call.") + } + extra_params[['crop']] <- crop_values + + result <- do.call(s2dv::CDORemap, c(list(data_array, lons, lats), extra_params)) +# result <- s2dv::CDORemap(data_array, lons, lats, ...) +#-------NEW_END-------------- return_variables <- list(result$lons, result$lats) names(return_variables) <- c(lon_name, lat_name) list(data_array = result$data_array, variables = return_variables) diff --git a/R/Start.R b/R/Start.R index ba01959..5599d49 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1803,6 +1803,7 @@ Start <- function(..., # dim = indices/selectors, picked_vars <- lapply(picked_vars, setNames, names(return_vars)) } picked_vars_ordered <- picked_vars + picked_vars_unorder_indices <- picked_vars for (i in 1:length(dat)) { @@ -2003,11 +2004,55 @@ Start <- function(..., # dim = indices/selectors, # picked_common_vars vars_to_transform <- generate_vars_to_transform(vars_to_transform, picked_common_vars, transform_vars, picked_common_vars_ordered) +#-----------NEW---------------- + # Save the crop domain from selectors of transformed vars + # PROB: It doesn't consider aiat. If aiat, the indices are for + # after transformed data; we don't know the corresponding + # values yet. + transform_crop_domain <- vector('list') + for (transform_var in transform_vars) { + transform_crop_domain[[transform_var]] <- dat[[i]][['selectors']][[transform_var]][[1]] + # Turn indices into values + if (attr(transform_crop_domain[[transform_var]], 'indices')) { + if (transform_var %in% names(common_return_vars)) { + if (transform_var %in% names(dim_reorder_params)) { + transform_crop_domain[[transform_var]] <- + generate_transform_crop_domain_values( + transform_crop_domain[[transform_var]], + picked_vars = picked_common_vars_ordered[[transform_var]]) + } else { + transform_crop_domain[[transform_var]] <- + generate_transform_crop_domain_values( + transform_crop_domain[[transform_var]], + picked_vars = picked_common_vars[[transform_var]]) + } + } else { # return_vars + if (transform_var %in% names(dim_reorder_params)) { + transform_crop_domain[[transform_var]] <- + generate_transform_crop_domain_values( + transform_crop_domain[[transform_var]], + picked_vars = picked_vars_ordered[[i]][[transform_var]]) + } else { + transform_crop_domain[[transform_var]] <- + generate_transform_crop_domain_values( + transform_crop_domain[[transform_var]], + picked_vars = picked_vars[[i]][[transform_var]]) + } + } + } else if (is.atomic(transform_crop_domain[[transform_var]])) { + # if it is values but vector + transform_crop_domain[[transform_var]] <- + c(transform_crop_domain[[transform_var]][1], + tail(transform_crop_domain[[transform_var]], 1)) + } + } # Transform the variables transformed_data <- do.call(transform, c(list(data_array = NULL, variables = vars_to_transform, - file_selectors = selectors_of_first_files_with_data[[i]]), + file_selectors = selectors_of_first_files_with_data[[i]], + crop_domain = transform_crop_domain), transform_params)) +#----------NEW_END----------------- # Discard the common transformed variables if already transformed before if (!is.null(transformed_common_vars)) { common_ones <- which(names(picked_common_vars) %in% names(transformed_data$variables)) @@ -2506,6 +2551,7 @@ Start <- function(..., # dim = indices/selectors, selector_store_position[names(selector_indices_to_take)] <- selector_indices_to_take sub_array_of_selectors <- Subset(selector_array, names(selector_indices_to_take), as.list(selector_indices_to_take), drop = 'selected') + if (debug) { if (inner_dim %in% dims_to_check) { print("-> ITERATING OVER FILE DIMENSIONS OF THE SELECTORS.") @@ -2775,7 +2821,6 @@ Start <- function(..., # dim = indices/selectors, sub_array_of_fri <- generate_sub_array_of_fri( with_transform, goes_across_prime_meridian, sub_array_of_indices, n, beta, is_circular_dim) - # May be useful for crop = T. 'subset_vars_to_transform' may not need # to include extra cells, but currently it shows mistake if not include. sub_array_of_fri_no_beta <- generate_sub_array_of_fri( @@ -2810,33 +2855,11 @@ Start <- function(..., # dim = indices/selectors, inner_dim, sub_array_of_fri) } } - - # Change the order of longitude crop if no reorder + from big to small. - # cdo -sellonlatbox, the lon is west, east (while lat can be north - # to south or opposite) - - # Before changing crop, first we need to find the name of longitude. - # NOTE: The potential bug here (also the bug for CDORemapper): the lon name - # is limited (only the ones listed in .KnownLonNames() are available. - known_lon_names <- startR:::.KnownLonNames() - lon_name <- names(subset_vars_to_transform)[which(names(subset_vars_to_transform) %in% known_lon_names)[1]] - - # NOTE: The cases not considered: (1) if lon reorder(decreasing = T) - # It doesn't make sense, but if someone uses it, here should - # occur error. (2) crop = TRUE/FALSE - if ('crop' %in% names(transform_params) & var_with_selectors_name == lon_name & is.null(dim_reorder_params[[inner_dim]])) { - if (is.numeric(class(transform_params$crop))) { - if (transform_params$crop[1] > transform_params$crop[2]) { - tmp <- transform_params$crop[1] - transform_params$crop[1] <- transform_params$crop[2] - transform_params$crop[2] <- tmp - } - } - } - + transformed_subset_var <- do.call(transform, c(list(data_array = NULL, variables = subset_vars_to_transform, - file_selectors = selectors_of_first_files_with_data[[i]]), + file_selectors = selectors_of_first_files_with_data[[i]], + crop_domain = transform_crop_domain), transform_params))$variables[[var_with_selectors_name]] # Sorting the transformed variable and working out the indices again after transform. if (!is.null(dim_reorder_params[[inner_dim]])) { @@ -3600,6 +3623,9 @@ Start <- function(..., # dim = indices/selectors, synonims = synonims, transform = transform, transform_params = transform_params, +#-------------NEW--------------- + transform_crop_domain = transform_crop_domain, +#-------NEW_END------------- silent = silent, debug = debug) } else { cluster <- parallel::makeCluster(num_procs, outfile = "") @@ -3611,6 +3637,9 @@ Start <- function(..., # dim = indices/selectors, synonims = synonims, transform = transform, transform_params = transform_params, +#-------------NEW--------------- + transform_crop_domain = transform_crop_domain, +#-------NEW_END------------- silent = silent, debug = debug) }) parallel::stopCluster(cluster) @@ -3811,7 +3840,9 @@ Start <- function(..., # dim = indices/selectors, # piece. .LoadDataFile <- function(work_piece, shared_matrix_pointer, file_data_reader, synonims, - transform, transform_params, +#---------------------NEW---------------------- + transform, transform_params, transform_crop_domain, +#------------------NEW_END-------------------- silent = FALSE, debug = FALSE) { #warning(attr(shared_matrix_pointer, 'description')$sharedName) # suppressPackageStartupMessages({library(bigmemory)}) @@ -3850,7 +3881,8 @@ Start <- function(..., # dim = indices/selectors, } sub_array <- do.call(transform, c(list(data_array = sub_array, variables = work_piece[['vars_to_transform']], - file_selectors = work_piece[['file_selectors']]), + file_selectors = work_piece[['file_selectors']], + crop_domain = transform_crop_domain), transform_params)) if (debug) { if (all(unlist(store_indices[1:6]) == 1)) { diff --git a/R/zzz.R b/R/zzz.R index 109baa9..8b8c2bf 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -560,6 +560,22 @@ generate_vars_to_transform <- function(vars_to_transform, picked_vars, transform return(vars_to_transform) } +# Turn indices to values for transform_crop_domain +generate_transform_crop_domain_values <- function(transform_crop_domain, picked_vars) { + if (transform_crop_domain == 'all') { + transform_crop_domain <- c(picked_vars[1], tail(picked_vars, 1)) + } else { # indices() + if (is.list(transform_crop_domain)) { + transform_crop_domain <- picked_vars[unlist(transform_crop_domain)] + } else { # vector + transform_crop_domain <- + c(picked_vars[transform_crop_domain[1]], + picked_vars[tail(transform_crop_domain, 1)]) + } + } + return(transform_crop_domain) +} + # Out-of-range warning show_out_of_range_warning <- function(inner_dim, range, bound) { # bound: 'lower' or 'upper' -- GitLab From ad29d7485aeb9fb0d9f733ba9c70ed1cc0a859c5 Mon Sep 17 00:00:00 2001 From: aho Date: Fri, 7 Jan 2022 21:05:13 +0100 Subject: [PATCH 2/5] Revise unit test for crop being deeprecated --- .../testthat/test-Compute-transform_indices.R | 27 ++------- .../testthat/test-Start-indices_list_vector.R | 59 ++++++++++--------- ...st-Start-reorder-lon-transform_-180to180.R | 4 +- .../test-Start-reorder-lon-transform_0to360.R | 4 +- 4 files changed, 39 insertions(+), 55 deletions(-) diff --git a/tests/testthat/test-Compute-transform_indices.R b/tests/testthat/test-Compute-transform_indices.R index e482b21..162e4e8 100644 --- a/tests/testthat/test-Compute-transform_indices.R +++ b/tests/testthat/test-Compute-transform_indices.R @@ -269,8 +269,7 @@ exp <- Start(dat = path, transform = CDORemapper, transform_extra_cells = 8, transform_params = list(grid = 'r100x50', - method = 'conservative', - crop = c(0, 22, -90, -60)), + method = 'conservative'), transform_vars = c('lat','lon'), synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), @@ -304,27 +303,17 @@ res3$output1 expect_equal( drop(res$output1)[, 1], -c(241.5952, 243.0271, 247.6998, 246.7727, 248.7175, 267.7744, 273.2705), +c(241.4042, 242.5804, 246.8507, 245.8008, 246.4318, 267.0983), tolerance = 0.001 ) expect_equal( drop(res$output1)[, 2], -c(241.4042, 242.5804, 246.8507, 245.8008, 246.4318, 267.0983, 272.9651), +c(241.2223, 242.2564, 245.9863, 244.5377, 244.8937, 266.5749), tolerance = 0.001 ) expect_equal( drop(res$output1)[, 3], -c(241.2223, 242.2564, 245.9863, 244.5377, 244.8937, 266.5749, 272.5154), -tolerance = 0.001 -) -expect_equal( -drop(res$output1)[, 4], -c(241.0894, 242.1896, 245.3183, 243.1169, 243.9446, 266.4386, 272.4731), -tolerance = 0.001 -) -expect_equal( -drop(res$output1)[, 5], -c(241.0217, 242.3326, 244.6789, 241.6538, 244.3845, 266.6960, 272.4390), +c(241.0895, 242.1896, 245.3183, 243.1169, 243.9446, 266.4386), tolerance = 0.001 ) @@ -482,8 +471,7 @@ exp <- Start(dat = path, lon_reorder = CircularSort(0, 360), transform = CDORemapper, transform_extra_cells = 8, - transform_params = list(grid = 'r100x50', method = 'conservative', - crop = c(0, 18, -90, -67)), + transform_params = list(grid = 'r100x50', method = 'conservative'), transform_vars = c('lat','lon'), synonims = list(lon = c('lon', 'longitude'), lat = c('lat', 'latitude')), return_vars = list(lat = 'dat', lon = 'dat', time = 'sdate'), @@ -539,11 +527,6 @@ drop(res1$output1)[, 5], c(241.0894, 242.1896, 245.3183, 243.1169, 243.9446, 266.4386), tolerance = 0.001 ) -expect_equal( -drop(res1$output1)[, 6], -c(241.0217, 242.3326, 244.6789, 241.6538, 244.3845, 266.6960), -tolerance = 0.001 -) #------------------------------------------------------ # crop = FALSE diff --git a/tests/testthat/test-Start-indices_list_vector.R b/tests/testthat/test-Start-indices_list_vector.R index 39ecb24..0ad897a 100644 --- a/tests/testthat/test-Start-indices_list_vector.R +++ b/tests/testthat/test-Start-indices_list_vector.R @@ -153,35 +153,36 @@ exp1 <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var retrieve= T) ) -# lat and lon are vectors of indices -suppressWarnings( -exp2 <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc', - var = 'tas', - sdate = '20000101', - ensemble = indices(1), - time = indices(1), - latitude = 30:1, - latitude_reorder = Sort(), - longitude = 40:1, - longitude_reorder = CircularSort(0, 360), - transform = CDORemapper, - transform_params = list(grid = 'r100x50', - method = 'con', - crop = c(0, 11, -90, -81)), - transform_vars = c('latitude', 'longitude'), - transform_extra_cells = 8, - synonims = list(latitude = c('lat', 'latitude'), - longitude = c('longitude', 'lon')), - return_vars = list(latitude = NULL, - longitude = NULL, - time = 'sdate'), - retrieve= T) -) - -expect_equal( -as.vector(drop(exp1)[, 4:1]), -as.vector(exp2) -) +# This test is not valid because it doesn't make sense to use longitude = 40:1. With the automatic "crop" values, the result is not correct. +## lat and lon are vectors of indices +#suppressWarnings( +#exp2 <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc', +# var = 'tas', +# sdate = '20000101', +# ensemble = indices(1), +# time = indices(1), +# latitude = 30:1, +# latitude_reorder = Sort(), +# longitude = 40:1, +# longitude_reorder = CircularSort(0, 360), +# transform = CDORemapper, +# transform_params = list(grid = 'r100x50', +# method = 'con', +# crop = c(0, 11, -90, -81)), +# transform_vars = c('latitude', 'longitude'), +# transform_extra_cells = 8, +# synonims = list(latitude = c('lat', 'latitude'), +# longitude = c('longitude', 'lon')), +# return_vars = list(latitude = NULL, +# longitude = NULL, +# time = 'sdate'), +# retrieve= T) +#) +# +#expect_equal( +#as.vector(drop(exp1)[, 4:1]), +#as.vector(exp2) +#) }) diff --git a/tests/testthat/test-Start-reorder-lon-transform_-180to180.R b/tests/testthat/test-Start-reorder-lon-transform_-180to180.R index d8b43ee..4351aa4 100644 --- a/tests/testthat/test-Start-reorder-lon-transform_-180to180.R +++ b/tests/testthat/test-Start-reorder-lon-transform_-180to180.R @@ -207,7 +207,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( range((attr(res, 'Variables')$dat1$longitude)), - c(170, 180), + c(170, 190), tolerance = 0.0001 ) expect_equal( @@ -216,7 +216,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( length(attr(res, 'Variables')$dat1$longitude), - 11 + 21 ) }) ############################################## diff --git a/tests/testthat/test-Start-reorder-lon-transform_0to360.R b/tests/testthat/test-Start-reorder-lon-transform_0to360.R index a722bea..234c99e 100644 --- a/tests/testthat/test-Start-reorder-lon-transform_0to360.R +++ b/tests/testthat/test-Start-reorder-lon-transform_0to360.R @@ -133,7 +133,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( range((attr(res, 'Variables')$dat1$longitude)), - c(0, 10), + c(-10, 10), tolerance = 0.0001 ) expect_equal( @@ -142,7 +142,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( length(attr(res, 'Variables')$dat1$longitude), - 11 + 21 ) }) -- GitLab From 13588499f44c5b72bd53127af704147441e8a7dc Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 Jan 2022 16:10:36 +0100 Subject: [PATCH 3/5] Deprecate 'crop' in CDORemapper() and add variable 'crop_domain' for automatically generating 'crop' --- R/CDORemapper.R | 62 ++++------------------------------------------ R/Start.R | 24 ++++++++++++------ man/CDORemapper.Rd | 14 ++++++++--- 3 files changed, 32 insertions(+), 68 deletions(-) diff --git a/R/CDORemapper.R b/R/CDORemapper.R index 16aa21b..6b8e78d 100644 --- a/R/CDORemapper.R +++ b/R/CDORemapper.R @@ -16,6 +16,8 @@ #'@param file_selectors A charcter vector indicating the information of the path of #' the file parameter 'data_array' comes from. See details in the documentation of #' the parameter 'transform' of the function Start(). The default value is NULL. +#'@param crop_domain A list of the transformed domain of each transform +#' variable, automatically provided by Start(). #'@param \dots A list of additional parameters to adjust the transform process, #' as provided in the parameter 'transform_params' in a Start() call. See details #' in the documentation of the parameter 'transform' of the function Start(). @@ -94,80 +96,26 @@ CDORemapper <- function(data_array, variables, file_selectors = NULL, stop("Parameters 'grid' and 'method' must be specified for the ", "CDORemapper, via the 'transform_params' argument.") } -#-----------NEW------------- + # Use crop_domain to get 'crop' ## lon known_lon_names <- startR:::.KnownLonNames() lon_name <- names(crop_domain)[which(names(crop_domain) %in% known_lon_names)] -# if (attr(crop_domain[[lon_name]], 'values')) { -# if (is.list(crop_domain[[lon_name]])) { -# crop_lon <- unlist(crop_domain[[lon_name]]) -# } else { # vector -# crop_lon <- c(crop_domain[[lon_name]][1], tail(crop_domain[[lon_name]], 1)) -# } -# } else if (crop_domain[[lon_name]] == 'all') { -# crop_lon <- c(lons[1], tail(lons, 1)) -# } else { # indices() -# if (is.list(crop_domain[[lon_name]])) { -# crop_lon <- lons[unlist(crop_domain[[lon_name]])] -# } else { # vector -# crop_lon <- c(lons[crop_domain[[lon_name]][1]], -# lons[tail(crop_domain[[lon_name]], 1)]) -# } -# } crop_lon <- unlist(crop_domain[[lon_name]]) - -#PROBLEM----------------------------------- - # If lon_reorder is not used and lon selector is from big to small (e.g., - # lon is expected to be c(20, 19, ..., 1, 0)), crop_lon need to exchange the order from c(20, 10) to c(10, 20). The 2nd criteria is, if lon_reorder is used, - # the meridian is crossed and lons will cover the smallest and biggest values; if not, the range of lons will be smaller than the whole region. - # The third criteria is for an odd Start() call that the longitude selector is not aligned with CircularSort(). E.g., lon = values(20, 10) but lon_reorder = CircularSort(-180, 180). Not sure if it is univerally correct. It's better to know if lon_reorder is used, but in CDORemapper() this info is missing. -#print('lons') -#print(str(lons)) -#print('val') -#print(str((attr(lons, 'variables')[[lon_name]]$dim[[1]]$vals))) - if (crop_lon[1] > crop_lon[2] & - diff(range(lons)) != diff(range(attr(lons, 'variables')[[lon_name]]$dim[[1]]$vals)) & - all(crop_lon >= range(lons)[1] & crop_lon <= range(lons)[2])) { - crop_lon <- rev(crop_lon) - } -#PROBLEM----------------------------------- - - ## lat known_lat_names <- startR:::.KnownLatNames() lat_name <- names(crop_domain)[which(names(crop_domain) %in% known_lat_names)] -# if (attr(crop_domain[[lat_name]], 'values')) { -# if (is.list(crop_domain[[lat_name]])) { -# crop_lat <- unlist(crop_domain[[lat_name]]) -# } else { # vector -# crop_lat <- c(crop_domain[[lat_name]][1], tail(crop_domain[[lat_name]], 1)) -# } -# } else if (crop_domain[[lat_name]] == 'all') { -# crop_lat <- c(lats[1], tail(lats, 1)) -# } else { # indices() -# if (is.list(crop_domain[[lat_name]])) { -# crop_lat <- lats[unlist(crop_domain[[lat_name]])] -# } else { # vector -##lats and indices are both original?? without reorder?? -# crop_lat <- c(lats[crop_domain[[lat_name]][1]], -# lats[tail(crop_domain[[lat_name]], 1)]) -# } -# } crop_lat <- unlist(crop_domain[[lat_name]]) crop_values <- c(crop_lon, crop_lat) -print('crop_values') -print(crop_values) + if ('crop' %in% names(extra_params)) { .warning("Argument 'crop' in 'transform_params' for CDORemapper() is ", "deprecated. It is automatically assigned as the selected .", "domain in Start() call.") } extra_params[['crop']] <- crop_values - + result <- do.call(s2dv::CDORemap, c(list(data_array, lons, lats), extra_params)) -# result <- s2dv::CDORemap(data_array, lons, lats, ...) -#-------NEW_END-------------- return_variables <- list(result$lons, result$lats) names(return_variables) <- c(lon_name, lat_name) list(data_array = result$data_array, variables = return_variables) diff --git a/R/Start.R b/R/Start.R index 5599d49..c0526ba 100644 --- a/R/Start.R +++ b/R/Start.R @@ -2004,7 +2004,6 @@ Start <- function(..., # dim = indices/selectors, # picked_common_vars vars_to_transform <- generate_vars_to_transform(vars_to_transform, picked_common_vars, transform_vars, picked_common_vars_ordered) -#-----------NEW---------------- # Save the crop domain from selectors of transformed vars # PROB: It doesn't consider aiat. If aiat, the indices are for # after transformed data; we don't know the corresponding @@ -2045,14 +2044,29 @@ Start <- function(..., # dim = indices/selectors, c(transform_crop_domain[[transform_var]][1], tail(transform_crop_domain[[transform_var]], 1)) } + + # For CDORemapper (not sure if it's also suitable for other transform functions): + # If lon_reorder is not used + lon selector is from big to small, + # lonmax and lonmin need to be exchanged. The ideal way is to + # exchange in CDORemapper(), but lon_reorder is used or not is not + # known by CDORemapper(). + # NOTE: lat's order doesn't matter, big to small and small to big + # both work. Since we shouldn't assume transform_var in Start(), + # e.g., transform_var can be anything transformable in the assigned transform function, + # we exchange whichever parameter here anyway. + if (!transform_var %in% names(dim_reorder_params) & + diff(unlist(transform_crop_domain[[transform_var]])) < 0) { + transform_crop_domain[[transform_var]] <- rev(transform_crop_domain[[transform_var]]) + } + } + # Transform the variables transformed_data <- do.call(transform, c(list(data_array = NULL, variables = vars_to_transform, file_selectors = selectors_of_first_files_with_data[[i]], crop_domain = transform_crop_domain), transform_params)) -#----------NEW_END----------------- # Discard the common transformed variables if already transformed before if (!is.null(transformed_common_vars)) { common_ones <- which(names(picked_common_vars) %in% names(transformed_data$variables)) @@ -3623,9 +3637,7 @@ Start <- function(..., # dim = indices/selectors, synonims = synonims, transform = transform, transform_params = transform_params, -#-------------NEW--------------- transform_crop_domain = transform_crop_domain, -#-------NEW_END------------- silent = silent, debug = debug) } else { cluster <- parallel::makeCluster(num_procs, outfile = "") @@ -3637,9 +3649,7 @@ Start <- function(..., # dim = indices/selectors, synonims = synonims, transform = transform, transform_params = transform_params, -#-------------NEW--------------- transform_crop_domain = transform_crop_domain, -#-------NEW_END------------- silent = silent, debug = debug) }) parallel::stopCluster(cluster) @@ -3840,9 +3850,7 @@ Start <- function(..., # dim = indices/selectors, # piece. .LoadDataFile <- function(work_piece, shared_matrix_pointer, file_data_reader, synonims, -#---------------------NEW---------------------- transform, transform_params, transform_crop_domain, -#------------------NEW_END-------------------- silent = FALSE, debug = FALSE) { #warning(attr(shared_matrix_pointer, 'description')$sharedName) # suppressPackageStartupMessages({library(bigmemory)}) diff --git a/man/CDORemapper.Rd b/man/CDORemapper.Rd index 3f4238a..024ce32 100644 --- a/man/CDORemapper.Rd +++ b/man/CDORemapper.Rd @@ -4,7 +4,13 @@ \alias{CDORemapper} \title{CDO Remap Data Transformation for 'startR'} \usage{ -CDORemapper(data_array, variables, file_selectors = NULL, ...) +CDORemapper( + data_array, + variables, + file_selectors = NULL, + crop_domain = NULL, + ... +) } \arguments{ \item{data_array}{A data array to be transformed. See details in the @@ -18,6 +24,9 @@ parameter 'transform' of the function Start().} the file parameter 'data_array' comes from. See details in the documentation of the parameter 'transform' of the function Start(). The default value is NULL.} +\item{crop_domain}{A list of the transformed domain of each transform +variable, automatically provided by Start().} + \item{\dots}{A list of additional parameters to adjust the transform process, as provided in the parameter 'transform_params' in a Start() call. See details in the documentation of the parameter 'transform' of the function Start().} @@ -53,8 +62,7 @@ perform the interpolation, hence CDO is required to be installed. longitude_reorder = CircularSort(-180, 180), transform = CDORemapper, transform_params = list(grid = 'r360x181', - method = 'conservative', - crop = c(-120, 120, -60, 60)), + method = 'conservative'), transform_vars = c('latitude', 'longitude'), return_vars = list(latitude = 'dat', longitude = 'dat', -- GitLab From 27255225b99ebf73c93a613a7fdf7198760ff3a8 Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 Jan 2022 16:11:13 +0100 Subject: [PATCH 4/5] Modify unit tests for the deprecation of 'crop' in transform --- .../test-Start-reorder-lon-transform_0to360.R | 88 +++++++++--------- ...Start-reorder-lon-transform_0to360Coarse.R | 90 ++++++++++--------- .../test-Start-transform-lat-Sort-all.R | 2 + .../test-Start-transform-lat-Sort-indices.R | 2 + .../test-Start-transform-lat-Sort-values.R | 2 + .../test-Start-transform-three-selectors.R | 2 + .../testthat/test-Start-values_list_vector.R | 2 +- 7 files changed, 100 insertions(+), 88 deletions(-) diff --git a/tests/testthat/test-Start-reorder-lon-transform_0to360.R b/tests/testthat/test-Start-reorder-lon-transform_0to360.R index 234c99e..3d2047e 100644 --- a/tests/testthat/test-Start-reorder-lon-transform_0to360.R +++ b/tests/testthat/test-Start-reorder-lon-transform_0to360.R @@ -162,7 +162,7 @@ res <- Start(dat = list(list(path=path_exp)), longitude = values(list(lons.min, lons.max)), transform = CDORemapper, transform_params = list(grid ='r360x181', - method = 'con', crop = T), + method = 'con'), transform_vars = c('longitude', 'latitude'), transform_extra_cells = 2, synonims = list(latitude=c('lat','latitude'), @@ -175,7 +175,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( range((attr(res, 'Variables')$dat1$longitude)), - c(0, 10), + c(-10, 10), tolerance = 0.0001 ) expect_equal( @@ -184,7 +184,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( length(attr(res, 'Variables')$dat1$longitude), - 11 + 21 ) }) ############################################## @@ -229,46 +229,48 @@ res <- Start(dat = list(list(path=path_exp)), ) }) ############################################## -test_that("1-8-2-2-1-1-2-4", { -lons.min <- 350 -lons.max <- 370 -lats.min <- 10 -lats.max <- 20 -suppressWarnings( -res <- Start(dat = list(list(path=path_exp)), - var = variable, - member = indices(1), - sdate = sdate, - time = indices(4), - latitude = values(list(lats.min, lats.max)), - longitude = values(list(lons.min, lons.max)), - transform = CDORemapper, - transform_params = list(grid ='r360x181', - method = 'con', crop = T), - transform_vars = c('longitude', 'latitude'), - transform_extra_cells = 2, - synonims = list(latitude=c('lat','latitude'), - longitude=c('lon','longitude'), - member=c('ensemble','realization')), - return_vars = list(latitude = 'dat', - longitude = 'dat', - time = NULL), - retrieve = F) -) - expect_equal( - range((attr(res, 'Variables')$dat1$longitude)), - c(350, 359), - tolerance = 0.0001 - ) - expect_equal( - (attr(res, 'Variables')$dat1$longitude)[1] < (attr(res, 'Variables')$dat1$longitude)[2], - TRUE - ) - expect_equal( - length(attr(res, 'Variables')$dat1$longitude), - 10 - ) -}) +#NOTE_18/01/2022: This Start() call returns ERROR now since "crop" +#is decrepated and automatically assigned as c(lons.min, lons.max, lats.min, lats.max). lons.max cannot excess 360. +#test_that("1-8-2-2-1-1-2-4", { +#lons.min <- 350 +#lons.max <- 370 +#lats.min <- 10 +#lats.max <- 20 +#suppressWarnings( +#res <- Start(dat = list(list(path=path_exp)), +# var = variable, +# member = indices(1), +# sdate = sdate, +# time = indices(4), +# latitude = values(list(lats.min, lats.max)), +# longitude = values(list(lons.min, lons.max)), +# transform = CDORemapper, +# transform_params = list(grid ='r360x181', +# method = 'con', crop = T), +# transform_vars = c('longitude', 'latitude'), +# transform_extra_cells = 2, +# synonims = list(latitude=c('lat','latitude'), +# longitude=c('lon','longitude'), +# member=c('ensemble','realization')), +# return_vars = list(latitude = 'dat', +# longitude = 'dat', +# time = NULL), +# retrieve = F) +#) +# expect_equal( +# range((attr(res, 'Variables')$dat1$longitude)), +# c(350, 359), +# tolerance = 0.0001 +# ) +# expect_equal( +# (attr(res, 'Variables')$dat1$longitude)[1] < (attr(res, 'Variables')$dat1$longitude)[2], +# TRUE +# ) +# expect_equal( +# length(attr(res, 'Variables')$dat1$longitude), +# 10 +# ) +#}) ############################################## ############################################## ############################################## diff --git a/tests/testthat/test-Start-reorder-lon-transform_0to360Coarse.R b/tests/testthat/test-Start-reorder-lon-transform_0to360Coarse.R index 2a4f2ca..d4629af 100644 --- a/tests/testthat/test-Start-reorder-lon-transform_0to360Coarse.R +++ b/tests/testthat/test-Start-reorder-lon-transform_0to360Coarse.R @@ -137,7 +137,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( range((attr(res, 'Variables')$dat1$longitude)), - c(0, 10), + c(-10, 10), tolerance = 0.0001 ) expect_equal( @@ -146,7 +146,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( length(attr(res, 'Variables')$dat1$longitude), - 11 + 21 ) }) @@ -179,7 +179,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( range((attr(res, 'Variables')$dat1$longitude)), - c(0, 10), + c(-10, 10), tolerance = 0.0001 ) expect_equal( @@ -188,7 +188,7 @@ res <- Start(dat = list(list(path=path_exp)), ) expect_equal( length(attr(res, 'Variables')$dat1$longitude), - 11 + 21 ) }) ############################################## @@ -233,46 +233,48 @@ res <- Start(dat = list(list(path=path_exp)), ) }) ############################################## -test_that("1-8-2-2-1-1-2-4", { -lons.min <- 350 -lons.max <- 370 -lats.min <- 10 -lats.max <- 20 -suppressWarnings( -res <- Start(dat = list(list(path=path_exp)), - var = variable, - member = indices(1), - sdate = sdate, - time = indices(4), - latitude = values(list(lats.min, lats.max)), - longitude = values(list(lons.min, lons.max)), - transform = CDORemapper, - transform_params = list(grid ='r360x181', - method = 'con', crop = T), - transform_vars = c('longitude', 'latitude'), - transform_extra_cells = 2, - synonims = list(latitude=c('lat','latitude'), - longitude=c('lon','longitude'), - member=c('ensemble','realization')), - return_vars = list(latitude = 'dat', - longitude = 'dat', - time = NULL), - retrieve = F) -) - expect_equal( - range((attr(res, 'Variables')$dat1$longitude)), - c(350, 359), - tolerance = 0.0001 - ) - expect_equal( - (attr(res, 'Variables')$dat1$longitude)[1] < (attr(res, 'Variables')$dat1$longitude)[2], - TRUE - ) - expect_equal( - length(attr(res, 'Variables')$dat1$longitude), - 10 - ) -}) +#NOTE_18/01/2022: This Start() call returns ERROR now since "crop" +#is decrepated and automatically assigned as c(lons.min, lons.max, lats.min, lats.max). lons.max cannot excess 360. +#test_that("1-8-2-2-1-1-2-4", { +#lons.min <- 350 +#lons.max <- 370 +#lats.min <- 10 +#lats.max <- 20 +#suppressWarnings( +#res <- Start(dat = list(list(path=path_exp)), +# var = variable, +# member = indices(1), +# sdate = sdate, +# time = indices(4), +# latitude = values(list(lats.min, lats.max)), +# longitude = values(list(lons.min, lons.max)), +# transform = CDORemapper, +# transform_params = list(grid ='r360x181', +# method = 'con', crop = T), +# transform_vars = c('longitude', 'latitude'), +# transform_extra_cells = 2, +# synonims = list(latitude=c('lat','latitude'), +# longitude=c('lon','longitude'), +# member=c('ensemble','realization')), +# return_vars = list(latitude = 'dat', +# longitude = 'dat', +# time = NULL), +# retrieve = F) +#) +# expect_equal( +# range((attr(res, 'Variables')$dat1$longitude)), +# c(350, 359), +# tolerance = 0.0001 +# ) +# expect_equal( +# (attr(res, 'Variables')$dat1$longitude)[1] < (attr(res, 'Variables')$dat1$longitude)[2], +# TRUE +# ) +# expect_equal( +# length(attr(res, 'Variables')$dat1$longitude), +# 10 +# ) +#}) ############################################## ############################################## ############################################## diff --git a/tests/testthat/test-Start-transform-lat-Sort-all.R b/tests/testthat/test-Start-transform-lat-Sort-all.R index 2839369..b41ec0a 100644 --- a/tests/testthat/test-Start-transform-lat-Sort-all.R +++ b/tests/testthat/test-Start-transform-lat-Sort-all.R @@ -20,8 +20,10 @@ lats <- NcToArray(file, lons <- NcToArray(file, dim_indices = list(longitude = 1:1296), vars_to_read = 'longitude') NcClose(file) +suppressWarnings( arr2 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), grid = 'r100x50', method = 'con', crop = FALSE)$data_array +) #--------------------------------------------------------------- path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' diff --git a/tests/testthat/test-Start-transform-lat-Sort-indices.R b/tests/testthat/test-Start-transform-lat-Sort-indices.R index 1a1f1ee..6c3a797 100644 --- a/tests/testthat/test-Start-transform-lat-Sort-indices.R +++ b/tests/testthat/test-Start-transform-lat-Sort-indices.R @@ -25,8 +25,10 @@ lats <- NcToArray(file, lons <- NcToArray(file, dim_indices = list(longitude = 1:1296), vars_to_read = 'longitude') NcClose(file) +suppressWarnings( arr2 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), grid = 'r100x50', method = 'con', crop = FALSE)$data_array +) #--------------------------------------------------------------- path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' diff --git a/tests/testthat/test-Start-transform-lat-Sort-values.R b/tests/testthat/test-Start-transform-lat-Sort-values.R index af00f73..92490ae 100644 --- a/tests/testthat/test-Start-transform-lat-Sort-values.R +++ b/tests/testthat/test-Start-transform-lat-Sort-values.R @@ -23,8 +23,10 @@ lats <- NcToArray(file, lons <- NcToArray(file, dim_indices = list(longitude = 1:1296), vars_to_read = 'longitude') NcClose(file) +suppressWarnings( arr2 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), grid = 'r100x50', method = 'con', crop = FALSE)$data_array +) #--------------------------------------------------------------- path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' diff --git a/tests/testthat/test-Start-transform-three-selectors.R b/tests/testthat/test-Start-transform-three-selectors.R index 3eb0040..657cca3 100644 --- a/tests/testthat/test-Start-transform-three-selectors.R +++ b/tests/testthat/test-Start-transform-three-selectors.R @@ -24,8 +24,10 @@ lats <- NcToArray(file, lons <- NcToArray(file, dim_indices = list(longitude = 1:1296), vars_to_read = 'longitude') NcClose(file) +suppressWarnings( arr2 <- s2dv::CDORemap(arr, lons = as.vector(lons), lats = as.vector(lats), grid = 'r100x50', method = 'con', crop = FALSE)$data_array +) #--------------------------------------------------------------- path <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' diff --git a/tests/testthat/test-Start-values_list_vector.R b/tests/testthat/test-Start-values_list_vector.R index d93b247..76c4f91 100644 --- a/tests/testthat/test-Start-values_list_vector.R +++ b/tests/testthat/test-Start-values_list_vector.R @@ -170,7 +170,7 @@ exp2 <- Start(dat = '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var time = indices(1), latitude = values(rev(c(81, 84.6, 88.2))), latitude_reorder = Sort(), - longitude = values(rev(c(0, 3.6, 7.2))), + longitude = values(c(0, 3.6, 7.2)), # It can't be reversed; different meanings longitude_reorder = CircularSort(0, 360), transform = CDORemapper, transform_params = list(grid = 'r100x50', -- GitLab From fdf480d1d9d4914848fe01a4673b4d95d69888fe Mon Sep 17 00:00:00 2001 From: aho Date: Tue, 18 Jan 2022 17:47:27 +0100 Subject: [PATCH 5/5] Consider crop_domain = NULL --- R/CDORemapper.R | 30 ++++++++++++++++-------------- R/Start.R | 2 +- 2 files changed, 17 insertions(+), 15 deletions(-) diff --git a/R/CDORemapper.R b/R/CDORemapper.R index 6b8e78d..7d4620f 100644 --- a/R/CDORemapper.R +++ b/R/CDORemapper.R @@ -98,22 +98,24 @@ CDORemapper <- function(data_array, variables, file_selectors = NULL, } # Use crop_domain to get 'crop' - ## lon - known_lon_names <- startR:::.KnownLonNames() - lon_name <- names(crop_domain)[which(names(crop_domain) %in% known_lon_names)] - crop_lon <- unlist(crop_domain[[lon_name]]) - ## lat - known_lat_names <- startR:::.KnownLatNames() - lat_name <- names(crop_domain)[which(names(crop_domain) %in% known_lat_names)] - crop_lat <- unlist(crop_domain[[lat_name]]) - crop_values <- c(crop_lon, crop_lat) + if (!is.null(crop_domain)) { + ## lon + known_lon_names <- startR:::.KnownLonNames() + lon_name <- names(crop_domain)[which(names(crop_domain) %in% known_lon_names)] + crop_lon <- unlist(crop_domain[[lon_name]]) + ## lat + known_lat_names <- startR:::.KnownLatNames() + lat_name <- names(crop_domain)[which(names(crop_domain) %in% known_lat_names)] + crop_lat <- unlist(crop_domain[[lat_name]]) + crop_values <- c(crop_lon, crop_lat) - if ('crop' %in% names(extra_params)) { - .warning("Argument 'crop' in 'transform_params' for CDORemapper() is ", - "deprecated. It is automatically assigned as the selected .", - "domain in Start() call.") + if ('crop' %in% names(extra_params)) { + .warning("Argument 'crop' in 'transform_params' for CDORemapper() is ", + "deprecated. It is automatically assigned as the selected .", + "domain in Start() call.") + } + extra_params[['crop']] <- crop_values } - extra_params[['crop']] <- crop_values result <- do.call(s2dv::CDORemap, c(list(data_array, lons, lats), extra_params)) return_variables <- list(result$lons, result$lats) diff --git a/R/Start.R b/R/Start.R index c0526ba..bec0936 100644 --- a/R/Start.R +++ b/R/Start.R @@ -3850,7 +3850,7 @@ Start <- function(..., # dim = indices/selectors, # piece. .LoadDataFile <- function(work_piece, shared_matrix_pointer, file_data_reader, synonims, - transform, transform_params, transform_crop_domain, + transform, transform_params, transform_crop_domain = NULL, silent = FALSE, debug = FALSE) { #warning(attr(shared_matrix_pointer, 'description')$sharedName) # suppressPackageStartupMessages({library(bigmemory)}) -- GitLab