diff --git a/R/Start.R b/R/Start.R index 606cb7a9d7d0f87cc9b2ebf0d479575feb6fd0fc..efa7e0d7c8b75013bf4e6f60020a44bfbe44cbd2 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,30 @@ 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]] & + !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]] + 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-metadata_dims.R b/tests/testthat/test-Start-metadata_dims.R index 1c0bc912705c088b30f3aecafced117375f6bc48..b446d1c29692b405aa3f71fe5a0ff9a6d1fcfdd3 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 ) @@ -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( 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 0000000000000000000000000000000000000000..4bf83c66f1be76cd5103d63a3a8d50bdee545695 --- /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) +) + +})