From cde6757cd7335efb4aa1e7986f90198c20ca8cc4 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 10 Feb 2021 11:56:19 +0100 Subject: [PATCH 1/5] If the name of return_vars is the synonmin of inner dim name, change it back to inner dim name. Unit test added. --- R/Start.R | 23 +- tests/testthat/test-Start-return_vars_name.R | 239 +++++++++++++++++++ 2 files changed, 261 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-Start-return_vars_name.R diff --git a/R/Start.R b/R/Start.R index 606cb7a..d81bc3b 100644 --- a/R/Start.R +++ b/R/Start.R @@ -945,7 +945,7 @@ Start <- function(..., # dim = indices/selectors, } if (!merge_across_dims & merge_across_dims_narm) { merge_across_dims_narm <- FALSE - warning(paste0("Parameter 'merge_across_dims_narm' can only be TRUE when ", + .warning(paste0("Parameter 'merge_across_dims_narm' can only be TRUE when ", "'merge_across_dims' is TRUE. Set 'merge_across_dims_narm'", " to FALSE.")) } @@ -1541,6 +1541,27 @@ Start <- function(..., # dim = indices/selectors, } } } + +#///////////////////////////////////////////////////// + # Check if return_vars name is inner dim name. If it is synonim, change back to + # inner dim name and return a warning. + if (any(!names(return_vars) %in% expected_inner_dims[[i]])) { + not_inner_dimname_ind <- which(!names(return_vars) %in% expected_inner_dims[[i]]) + for (not_inner_dim in 1:length(not_inner_dimname_ind)) { + wrong_name_return_vars <- names(return_vars)[not_inner_dimname_ind[not_inner_dim]] + if (!wrong_name_return_vars %in% unlist(synonims)) { + stop(paste0("Could not find variable '", wrong_name_return_vars, "' (or its ", "synonims if specified) in the inner dimension names. The expected ", "name should be ", paste(paste0("'", expected_inner_dims[[i]], "'"), collapse = ', '), ".")) + } else { + inner_dim_name <- names(unlist(lapply(lapply(synonims, '%in%', wrong_name_return_vars), which))) + names(return_vars)[not_inner_dimname_ind[not_inner_dim]] <- inner_dim_name + .warning(paste0("The name '", wrong_name_return_vars, "' in parameter 'return_vars' ", + "is synonim. Change it back to the inner dimension name, '", + inner_dim_name, "'.")) + } + } + } +#///////////////////////////////////////////////////// + ## (Check the *_var parameters). if (any(!(unlist(var_params) %in% names(return_vars)))) { vars_to_add <- which(!(unlist(var_params) %in% names(return_vars))) diff --git a/tests/testthat/test-Start-return_vars_name.R b/tests/testthat/test-Start-return_vars_name.R new file mode 100644 index 0000000..4bf83c6 --- /dev/null +++ b/tests/testthat/test-Start-return_vars_name.R @@ -0,0 +1,239 @@ +context("Start() return_vars name") +# The name of return_vars should be one of the inner dimension names. The synonims can +# be used but will be changed back to the inner dim names. + +repos_obs <- '/esarchive/obs/ukmo/hadisst_v1.1/monthly_mean/$var$/$var$_$date$.nc' + +#--------------------------------------------------------------- + +test_that("1. Selector is values()", { + +# (1) +suppressWarnings( +res <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = values(list(5, 10)), + lat_reorder = Sort(), + lon = values(list(15, 20)), + lon_reorder = CircularSort(0, 360), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(latitude = NULL, # the name should be lat + longitude = NULL, + time = 'date'), + retrieve = TRUE) +) + +expect_equal( +names(attr(res, 'Variables')$common), +c("lat", "lon", "time", "tos") +) +expect_equal( +range(attr(res, 'Variables')$common$lat), +c(5.5, 9.5) +) + + +# (2) +suppressWarnings( +res <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = values(list(5, 10)), + lat_reorder = Sort(), + lon = values(list(15, 20)), + lon_reorder = CircularSort(0, 360), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(lat = NULL, + lon = NULL, + time = 'date'), + retrieve = TRUE) +) + +expect_equal( +names(attr(res, 'Variables')$common), +c("lat", "lon", "time", "tos") +) +expect_equal( +range(attr(res, 'Variables')$common$lat), +c(5.5, 9.5) +) + +# (3) +suppressWarnings( +res <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = values(list(5, 10)), + lat_reorder = Sort(), + lon = values(list(15, 20)), + lon_reorder = CircularSort(0, 360), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(lat = 'dat', # the name should be lat + lon = 'dat', + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(res, 'Variables')$dat1), +c("lat", "lon") +) +expect_equal( +names(attr(res, 'Variables')$common), +c("time", "tos") +) +expect_equal( +range(attr(res, 'Variables')$dat1$lat), +c(5.5, 9.5) +) + +# (4) +suppressWarnings( +res <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = values(list(5, 10)), + lat_reorder = Sort(), + lon = values(list(15, 20)), + lon_reorder = CircularSort(0, 360), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(latitude = 'dat', # the name should be lat + longitude = 'dat', + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(res, 'Variables')$dat1), +c("lat", "lon") +) +expect_equal( +names(attr(res, 'Variables')$common), +c("time", "tos") +) +expect_equal( +range(attr(res, 'Variables')$dat1$lat), +c(5.5, 9.5) +) + +}) + + + + +test_that("2. Selector is indices()", { + +# (1) +suppressWarnings( +obs <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = indices(105:110), + lon = indices(105:110), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(lat = NULL, + lon = NULL, + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(obs, 'Variables')$common), +c("lat", "lon","time", "tos") +) +expect_equal( +range(attr(obs, 'Variables')$common$lat), +c(-19.5, -14.5) +) + + +# (2) +suppressWarnings( +obs <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = indices(105:110), + lon = indices(105:110), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(latitude = NULL, + longitude = NULL, + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(obs, 'Variables')$common), +c("lat", "lon","time", "tos") +) +expect_equal( +range(attr(obs, 'Variables')$common$lat), +c(-19.5, -14.5) +) + + +# (3) +suppressWarnings( +obs <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = indices(105:110), + lon = indices(105:110), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(latitude = 'dat', + longitude = 'dat', + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(obs, 'Variables')$common), +c("time", "tos") +) +expect_equal( +names(attr(obs, 'Variables')$dat1), +c("lat", "lon") +) +expect_equal( +range(attr(obs, 'Variables')$dat1$lat), +c(-19.5, -14.5) +) + +# (4) +suppressWarnings( +obs <- Start(dat = repos_obs, + var = 'tos', + date = '200505', + time = indices(1), + lat = indices(105:110), + lon = indices(105:110), + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(lat = 'dat', + lon = 'dat', + time = 'date'), + retrieve = TRUE) +) +expect_equal( +names(attr(obs, 'Variables')$common), +c("time", "tos") +) +expect_equal( +names(attr(obs, 'Variables')$dat1), +c("lat", "lon") +) +expect_equal( +range(attr(obs, 'Variables')$dat1$lat), +c(-19.5, -14.5) +) + +}) -- GitLab From 0a125012cda4ff950523e710e2eb6c999d06b6f1 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 10 Feb 2021 12:42:29 +0100 Subject: [PATCH 2/5] If return_vars name is in var_params, skip the synonim check --- R/Start.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/Start.R b/R/Start.R index d81bc3b..838afe1 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1545,7 +1545,8 @@ Start <- function(..., # dim = indices/selectors, #///////////////////////////////////////////////////// # Check if return_vars name is inner dim name. If it is synonim, change back to # inner dim name and return a warning. - if (any(!names(return_vars) %in% expected_inner_dims[[i]])) { + if (any(!names(return_vars) %in% expected_inner_dims[[i]] & + !names(return_vars) %in% unlist(var_params))) { not_inner_dimname_ind <- which(!names(return_vars) %in% expected_inner_dims[[i]]) for (not_inner_dim in 1:length(not_inner_dimname_ind)) { wrong_name_return_vars <- names(return_vars)[not_inner_dimname_ind[not_inner_dim]] -- GitLab From 82567281a8e7824688ef07e243e43ed7053cc31e Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 10 Feb 2021 12:43:07 +0100 Subject: [PATCH 3/5] Revise the unit test due to the development of return_vars name check --- tests/testthat/test-Start-metadata_dims.R | 42 +++++++++++------------ 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/tests/testthat/test-Start-metadata_dims.R b/tests/testthat/test-Start-metadata_dims.R index 1c0bc91..6f5551a 100644 --- a/tests/testthat/test-Start-metadata_dims.R +++ b/tests/testthat/test-Start-metadata_dims.R @@ -12,8 +12,8 @@ test_that("1. One data set, one var", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = 'dat', # it can be omitted since it is automatically specified as 'dat' retrieve = T ) @@ -32,7 +32,7 @@ test_that("1. One data set, one var", { ) expect_equal( names(attr(data, 'Variables')$system5_m1), - c("longitude", "latitude") + c("lon", "lat") ) expect_equal( length(attr(data, 'Variables')$common$tas), @@ -57,8 +57,8 @@ test_that("2. Two data sets, one var", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = 'dat', # it can be omitted since it is automatically specified as 'dat' retrieve = T ) @@ -77,11 +77,11 @@ test_that("2. Two data sets, one var", { ) expect_equal( names(attr(data, 'Variables')$system4_m1), - c("longitude", "latitude", "tas") + c("lon", "lat", "tas") ) expect_equal( names(attr(data, 'Variables')$system5_m1), - c("longitude", "latitude", "tas") + c("lon", "lat", "tas") ) expect_equal( length(attr(data, 'Variables')$system5_m1$tas), @@ -155,8 +155,8 @@ test_that("4. Two data sets, two vars", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = 'dat', retrieve = T ) @@ -175,11 +175,11 @@ test_that("4. Two data sets, two vars", { ) expect_equal( names(attr(data, 'Variables')$system4_m1), - c("longitude", "latitude", "tas") + c("lon", "lat", "tas") ) expect_equal( names(attr(data, 'Variables')$system5_m1), - c("longitude", "latitude", "tas") + c("lon", "lat", "tas") ) expect_equal( length(attr(data, 'Variables')$system5_m1$tas), @@ -202,8 +202,8 @@ test_that("4. Two data sets, two vars", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = c('dat', 'var'), retrieve = T ) @@ -221,11 +221,11 @@ test_that("4. Two data sets, two vars", { ) expect_equal( names(attr(data, 'Variables')$system4_m1), - c("longitude", "latitude", "tas", "sfcWind") + c("lon", "lat", "tas", "sfcWind") ) expect_equal( names(attr(data, 'Variables')$system5_m1), - c("longitude", "latitude", "tas", "sfcWind") + c("lon", "lat", "tas", "sfcWind") ) expect_equal( length(attr(data, 'Variables')$system5_m1$tas), @@ -261,8 +261,8 @@ test_that("5. Specify metadata_dims with another file dimension", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = 'sdate', retrieve = T ) @@ -280,11 +280,11 @@ test_that("5. Specify metadata_dims with another file dimension", { ) expect_equal( names(attr(data, 'Variables')$system4_m1), - c("longitude", "latitude") + c("lon", "lat") ) expect_equal( names(attr(data, 'Variables')$system5_m1), - c("longitude", "latitude") + c("lon", "lat") ) expect_equal( length(attr(data, 'Variables')$common$tas), @@ -346,8 +346,8 @@ test_that("7. Two data sets, while one is missing", { synonims = list(lat = c('lat', 'latitude'), lon = c('lon', 'longitude')), return_vars = list(time = 'sdate', - longitude = 'dat', - latitude = 'dat'), + lon = 'dat', + lat = 'dat'), metadata_dims = 'dat', # it can be omitted since it is automatically specified as 'dat' retrieve = T ) -- GitLab From 2124bd7f1f35c18027702db3cd9e16d1ccb55aa5 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 10 Feb 2021 13:06:46 +0100 Subject: [PATCH 4/5] Revise the unit test due to the development of return_vars name check --- tests/testthat/test-Start-metadata_dims.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-Start-metadata_dims.R b/tests/testthat/test-Start-metadata_dims.R index 6f5551a..b446d1c 100644 --- a/tests/testthat/test-Start-metadata_dims.R +++ b/tests/testthat/test-Start-metadata_dims.R @@ -361,7 +361,7 @@ test_that("7. Two data sets, while one is missing", { NULL ) expect_equal( - length(attr(data, "Variables")$system5_m1$longitude), + length(attr(data, "Variables")$system5_m1$lon), 1296 ) expect_equal( -- GitLab From 39170d0dcfbf2c86227678de2132bdd796582768 Mon Sep 17 00:00:00 2001 From: aho Date: Wed, 10 Feb 2021 13:27:48 +0100 Subject: [PATCH 5/5] Format adjustment. --- R/Start.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/Start.R b/R/Start.R index 838afe1..efa7e0d 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1551,7 +1551,9 @@ Start <- function(..., # dim = indices/selectors, for (not_inner_dim in 1:length(not_inner_dimname_ind)) { wrong_name_return_vars <- names(return_vars)[not_inner_dimname_ind[not_inner_dim]] if (!wrong_name_return_vars %in% unlist(synonims)) { - stop(paste0("Could not find variable '", wrong_name_return_vars, "' (or its ", "synonims if specified) in the inner dimension names. The expected ", "name should be ", paste(paste0("'", expected_inner_dims[[i]], "'"), collapse = ', '), ".")) + stop(paste0("Could not find variable '", wrong_name_return_vars, "' (or its ", + "synonims if specified) in the inner dimension names. The expected ", + "name should be ", paste(paste0("'", expected_inner_dims[[i]], "'"), collapse = ', '), ".")) } else { inner_dim_name <- names(unlist(lapply(lapply(synonims, '%in%', wrong_name_return_vars), which))) names(return_vars)[not_inner_dimname_ind[not_inner_dim]] <- inner_dim_name -- GitLab