diff --git a/DESCRIPTION b/DESCRIPTION index c091bc3abc4aaa65c59522452d2b62a52c4d3f32..6d0d002f3375d2ee18dba3c4ecda8bcfd1e88931 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: startR Title: Automatically Retrieve Multidimensional Distributed Data Sets -Version: 2.1.0-1 +Version: 2.1.0-2 Authors@R: c( person("BSC-CNS", role = c("aut", "cph")), person("Nicolau", "Manubens", , "nicolau.manubens@bsc.es", role = c("aut")), diff --git a/R/CDORemapper.R b/R/CDORemapper.R index 867ee2660250adfdca2b2a1e26e04678f5297989..8aed954be45da45d9824b60a03f4b3503265aa68 100644 --- a/R/CDORemapper.R +++ b/R/CDORemapper.R @@ -89,8 +89,8 @@ CDORemapper <- function(data_array, variables, file_selectors = NULL, ...) { } } extra_params <- list(...) - if (!all(c('grid', 'method') %in% names(extra_params))) { - stop("Parameters 'grid' and 'method' must be specified for the ", + if (!all(c('grid', 'method', 'crop') %in% names(extra_params))) { + stop("Parameters 'grid', 'method' and 'crop' must be specified for the ", "CDORemapper, via the 'transform_params' argument.") } result <- s2dverification::CDORemap(data_array, lons, lats, ...) diff --git a/R/NcDataReader.R b/R/NcDataReader.R index 222d11dcfae494bbd622ccd6094ad01001ae5f49..72abc090582c407fc64e5eb2150848f7f3e33d14 100644 --- a/R/NcDataReader.R +++ b/R/NcDataReader.R @@ -197,6 +197,10 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, result[] <- paste(result[], units) } else if (grepl(' since ', units)) { + # Find the calendar + calendar <- attr(result, 'variables')$time$calendar + if (calendar == 'standard') calendar <- 'gregorian' + parts <- strsplit(units, ' since ')[[1]] units <- parts[1] @@ -211,14 +215,70 @@ NcDataReader <- function(file_path = NULL, file_object = NULL, # units <- 'days' result <- result * 24 * 60 * 60 # day to sec } else if (units %in% c('month', 'months')) { - result <- result * 30.5 - result <- result * 24 * 60 * 60 # day to sec -# units <- 'days' + # define day in each month + leap_month_day <- c(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + no_leap_month_day <- c(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31) + # Origin year and month + ori_year <- as.numeric(substr(parts[2], 1, 4)) + ori_month <- as.numeric(substr(parts[2], 6, 7)) + + if (calendar == 'gregorian') { + # Find how many years + months + yr_num <- floor(result / 12) + month_left <- result - yr_num * 12 + # Find the leap years we care + if (ori_month <= 2) { + leap_num <- length(which(sapply(ori_year:(ori_year + yr_num - 1), s2dv::LeapYear))) + } else { + leap_num <- length(which(sapply((ori_year + 1):(ori_year + yr_num), s2dv::LeapYear))) + } + total_days <- leap_num * 366 + (yr_num - leap_num) * 365 # not include month_left yet + + + if (month_left != 0) { + if ((ori_month + month_left) <= 12) { # the last month is still in the same last yr + # Is the last year a leap year? + last_leap <- s2dv::LeapYear(ori_year + yr_num) + if (last_leap) { + total_days <- total_days + sum(leap_month_day[ori_month:(ori_month + month_left - 1)]) + } else { + total_days <- total_days + sum(no_leap_month_day[ori_month:(ori_month + month_left - 1)]) + } + } else { # the last month ends in the next yr + if (ori_month == 2) { # e.g., 2005-02-16 + 11mth = 2006-01-16 + last_leap <- s2dv::LeapYear(ori_year + yr_num) # still consider 2005 + if (last_leap) { + total_days <- total_days + sum(leap_month_day[2:12]) + } else { + total_days <- total_days + sum(no_leap_month_day[2:12]) + } + } else { # e.g., 2005-04-16 + 11mth = 2006-03-16 + last_leap <- s2dv::LeapYear(ori_year + yr_num + 1) + needed_month <- c(ori_month:12, 1:(ori_month + month_left - 12 - 1)) + if (last_leap) { + total_days <- total_days + sum(leap_month_day[needed_month]) + } else { + total_days <- total_days + sum(no_leap_month_day[needed_month]) + } + } + } + } + result <- total_days * 24 * 60 * 60 # day to sec + } else if (calendar %in% c('365_day',' 365', 'noleap')) { + yr_num <- floor(result / 12) + month_left <- result - yr_num * 12 + total_days <- 365 * yr_num + sum(no_leap_month_day[ori_month:(month_left - 1)]) + result <- total_days * 24 * 60 * 60 # day to sec + + } else if (calendar %in% c('360_day', '360')) { + result <- result * 30 * 24 * 60 * 60 # day to sec + + } else { #old code. The calendar is not in any of the above. + result <- result * 30.5 + result <- result * 24 * 60 * 60 # day to sec + } } - # Find the calendar - calendar <- attr(result, 'variables')$time$calendar - if (calendar == 'standard') calendar <- 'gregorian' new_array <- PCICt::as.PCICt(result, cal = calendar, origin = parts[2])[] new_array <- suppressWarnings(PCICt::as.POSIXct.PCICt(new_array, tz = "UTC")) diff --git a/R/Start.R b/R/Start.R index 25b0e2dd1859bcdbbf9e09cb50a0371dd041dbd1..606cb7a9d7d0f87cc9b2ebf0d479575feb6fd0fc 100644 --- a/R/Start.R +++ b/R/Start.R @@ -1913,13 +1913,19 @@ Start <- function(..., # dim = indices/selectors, ## TODO: To be run in parallel (local multi-core) # Now time to work out the inner file dimensions. # First pick the requested variables. - dims_to_iterate <- NULL - for (return_var in names(return_vars)) { - dims_to_iterate <- unique(c(dims_to_iterate, return_vars[[return_var]])) - } - if (found_pattern_dim %in% dims_to_iterate) { - dims_to_iterate <- dims_to_iterate[-which(dims_to_iterate == found_pattern_dim)] - } + +#//// This part is moved below the new code//// +# NOTE: 'dims_to_iterate' only consider common_return_vars. Move to below can save some work +# and get the revised common_return_vars if it is changed. +# dims_to_iterate <- NULL +# for (return_var in names(return_vars)) { +# dims_to_iterate <- unique(c(dims_to_iterate, return_vars[[return_var]])) +# } +# if (found_pattern_dim %in% dims_to_iterate) { +# dims_to_iterate <- dims_to_iterate[-which(dims_to_iterate == found_pattern_dim)] +# } +#////////////////////////////////////////////// + common_return_vars <- NULL common_first_found_file <- NULL common_return_vars_pos <- NULL @@ -1940,6 +1946,58 @@ Start <- function(..., # dim = indices/selectors, x } }) + +#//////////////////////////////////////////// + # Force return_vars = (time = NULL) to (time = 'sdate') if (1) selector = [sdate = 2, time = 4] or + # (2) time_across = 'sdate'. + # NOTE: Here is not in for loop of dat[[i]] + for (i in 1:length(dat)) { + for (inner_dim in expected_inner_dims[[i]]) { + # The selectors for the inner dimension are taken. + selector_array <- dat[[i]][['selectors']][[inner_dim]] + file_dim_as_selector_array_dim <- 1 + + if (any(found_file_dims[[i]] %in% names(dim(selector_array)))) { + file_dim_as_selector_array_dim <- found_file_dims[[i]][which(found_file_dims[[i]] %in% names(dim(selector_array)))] + } + + if (inner_dim %in% inner_dims_across_files | is.character(file_dim_as_selector_array_dim)) { #(2) or (1) + # inner_dim is not in return_vars or is NULL + if (((!inner_dim %in% names(common_return_vars)) & (!inner_dim %in% names(return_vars))) | + (inner_dim %in% names(common_return_vars) & is.null(common_return_vars[[inner_dim]])) ) { + if (is.character(file_dim_as_selector_array_dim)) { #(1) + if (file_dim_as_selector_array_dim %in% found_pattern_dim) { + return_vars[[inner_dim]] <- file_dim_as_selector_array_dim + } else { + common_return_vars[[inner_dim]] <- file_dim_as_selector_array_dim + } + } else if (inner_dim %in% inner_dims_across_files) { #(2) + file_dim_name <- names(which(inner_dim == inner_dims_across_files)) + if (file_dim_name %in% found_pattern_dim) { + return_vars[[inner_dim]] <- file_dim_name + } else { + common_return_vars[[inner_dim]] <- file_dim_name + } + } + .warning(paste0("Found ", inner_dim, " dependency on file diemnsion '", tmp, + "', but '", inner_dim, "' is not in return_vars list or is NULL. ", + "To provide the correct metadata, the value of ", inner_dim, + " in 'return_vars' is specified as '", tmp, "'.")) + } + } + } + } +#//////////////////////////////////////////// + +# This part was above where return_vars is seperated into return_vars and common_return_vars +# NOTE: 'dims_to_iterate' only consider common_return_vars. Move to here can save some work +# and get the revised common_return_vars if it is changed in the part right above. + dims_to_iterate <- NULL + for (common_return_var in names(common_return_vars)) { + dims_to_iterate <- unique(c(dims_to_iterate, common_return_vars[[common_return_var]])) + } +#//////////////////////////////////////////// + if (length(common_return_vars) > 0) { picked_common_vars <- vector('list', length = length(common_return_vars)) names(picked_common_vars) <- names(common_return_vars) @@ -2510,9 +2568,13 @@ Start <- function(..., # dim = indices/selectors, } taken_chunks <- rep(FALSE, chunk_amount) selector_file_dims <- 1 + + #NOTE: Change 'selector_file_dims' (from 1) if selector is an array with a file_dim dimname. + # I.e., If time = [sdate = 2, time = 4], selector_file_dims <- array(sdate = 2) if (any(found_file_dims[[i]] %in% names(dim(selector_array)))) { selector_file_dims <- dim(selector_array)[which(names(dim(selector_array)) %in% found_file_dims[[i]])] } + selector_inner_dims <- dim(selector_array)[which(!(names(dim(selector_array)) %in% found_file_dims[[i]]))] var_with_selectors <- NULL var_with_selectors_name <- var_params[[inner_dim]] @@ -3589,7 +3651,10 @@ Start <- function(..., # dim = indices/selectors, picked_vars[[i]] <- vars_to_crop } if (i == length(dat)) { - picked_common_vars <- common_vars_to_crop + #NOTE: To avoid redundant run + if (inner_dim %in% names(common_vars_to_crop)) { + picked_common_vars <- common_vars_to_crop + } } } } diff --git a/README.md b/README.md index 2bf1c579ab5b08d0c585f94eaa102ee53944bd70..a4333bdfff3090193dcafcfbd82c6069f3260015 100644 --- a/README.md +++ b/README.md @@ -7,6 +7,7 @@ The useful information for learning startR: - [**use cases**](inst/doc/usecase.md) - [**FAQs**](inst/doc/faq.md) - [**tutorial**](inst/doc/tutorial/startR_tutorial_20200902.pdf) +- [**ecFlow config**](inst/doc/ecFlowConfig_startR.pdf) Following the startR framework, the user can represent in a one-page startR script all the information that defines a use case, including: diff --git a/inst/doc/ecFlowConfig_startR.pdf b/inst/doc/ecFlowConfig_startR.pdf new file mode 100644 index 0000000000000000000000000000000000000000..fbbf0c3d453ae4f9af2a3699383f15874504defc Binary files /dev/null and b/inst/doc/ecFlowConfig_startR.pdf differ diff --git a/inst/doc/usecase/ex1_12_rotated_coordinates.R b/inst/doc/usecase/ex1_12_rotated_coordinates.R index 3da4b794a376c71de0e6848e927b78e7824cf86e..f657a70418aead4f1bc7770e430f4a887f37b03a 100644 --- a/inst/doc/usecase/ex1_12_rotated_coordinates.R +++ b/inst/doc/usecase/ex1_12_rotated_coordinates.R @@ -5,11 +5,11 @@ #------------------------------- library(startR) -obs_path <- '/esarchive/exp/monarch-dustclim/3hourly/$var$/$var$_$date$03_av_an.nc' +path <- '/esarchive/oper/thredds-dust/monarch-dustclim/3hourly/$var$-av_an/$var$_$date$03_av_an.nc' date <- c('20131229', '20131230') # two temporal dimensions: one for days and another four hours -data_split <- Start(dataset = obs_path, +data_split <- Start(dataset = path, var = 'od550du', lev = 'all', date = date, @@ -21,7 +21,7 @@ data_split <- Start(dataset = obs_path, lat = NULL, lon = NULL), retrieve = TRUE, num_procs = 1) # one temporal dimension -data <- Start(dataset = obs_path, +data <- Start(dataset = path, var = 'od550du', lev = 'all', date = date, @@ -48,7 +48,7 @@ attributes(data)$Variables$common$time # PLOT: -map <- data[1,1,1,1,1,,] # Time-step 1 +map <- data[1,1,1,1,,] # Time-step 1 library(sf) library(ggplot2) map <- data.frame(rlat = rep(rlat, length(rlon)), diff --git a/inst/doc/usecase/ex2_1_timedim.R b/inst/doc/usecase/ex2_1_timedim.R index f06b766dd1fff0db1ef3a02b0c1005ad376e2752..f8253c85162db28d4471e56c47d1da855de42861 100644 --- a/inst/doc/usecase/ex2_1_timedim.R +++ b/inst/doc/usecase/ex2_1_timedim.R @@ -13,16 +13,14 @@ library(startR) return_vars = list(latitude = 'dat', longitude = 'dat', time = 'sdate'), retrieve = FALSE) - library(multiApply) fun_spring <- function(x) { - source("/esarchive/scratch/nperez/Season_v2.R") - y <- Season_v2(x, monini = 1, moninf = 3, monsup = 5) + y <- s2dv::Season(x, time_dim = 'time', monini = 1, moninf = 3, monsup = 5) return(y) } step1 <- Step(fun = fun_spring, - target_dims = c('time'), - output_dims = c('time')) + target_dims = c('var', 'time'), + output_dims = c('var', 'time')) wf1 <- AddStep(data, step1) diff --git a/tests/testthat/test-Start-calendar.R b/tests/testthat/test-Start-calendar.R index 19ac0dff59f48fe7c679c403c0440347315d6229..328aa0e1fe611e4f98b39c161b7d4fff4516265b 100644 --- a/tests/testthat/test-Start-calendar.R +++ b/tests/testthat/test-Start-calendar.R @@ -1,6 +1,6 @@ context("Start() different calendar") -test_that("1. 360_day, daily", { +test_that("1. 360_day, daily, unit = 'days since 1850-01-01'", { path_hadgem3 <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/hadgem3-gc31-mm/', 'cmip6-dcppA-hindcast_i1p1/DCPP/MOHC/HadGEM3-GC31-MM/', @@ -47,7 +47,7 @@ expect_equal( }) -test_that("2. 365_day, daily", { +test_that("2. 365_day, daily, unit = 'days since 1984-01-01'", { path_bcc_csm2 <- '/esarchive/exp/CMIP6/dcppA-hindcast/bcc-csm2-mr/cmip6-dcppA-hindcast_i1p1/DCPP/BCC/BCC-CSM2-MR/dcppA-hindcast/r1i1p1f1/day/$var$/gn/v20200408/$var$_day_BCC-CSM2-MR_dcppA-hindcast_s$sdate$-r1i1p1f1_gn_19800101-19891231.nc' data <- Start(dat = path_bcc_csm2, @@ -76,7 +76,7 @@ expect_equal( }) -test_that("3. gregorian/standard, daily", { +test_that("3. standard, daily, unit = 'days since 1850-1-1 00:00:00'", { path_mpi_esm <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/mpi-esm1-2-hr/', 'cmip6-dcppA-hindcast_i1p1/DCPP/MPI-M/MPI-ESM1-2-HR/', @@ -114,7 +114,7 @@ expect_equal( }) -test_that("4. gregorian/standard, monthly", { +test_that("4. standard, monthly, unit = 'days since 1850-1-1 00:00:00'", { path_mpi_esm <- paste0('/esarchive/exp/CMIP6/dcppA-hindcast/mpi-esm1-2-hr/', 'cmip6-dcppA-hindcast_i1p1/DCPP/MPI-M/MPI-ESM1-2-HR/', @@ -147,7 +147,7 @@ expect_equal( }) -test_that("4. gregorian/standard, 6hrly", { +test_that("5. proleptic_gregorian, 6hrly, unit = 'hours since 2000-11-01 00:00:00'", { repos_obs <- paste0('/esarchive/recon/ecmwf/erainterim/6hourly/', '$var$/$var$_199405.nc') date <- paste0('1994-05-', sprintf('%02d', 1:31), ' 00:00:00') @@ -178,3 +178,94 @@ expect_equal( tolerance = 0.0001 ) }) + +test_that("6. standard, monthly, unit = 'months since 1870-01-16 12:00:00'", { + + repos_obs <- '/esarchive/obs/ukmo/hadisst_v1.1/monthly_mean/$var$/$var$_$date$.nc' + obs <- Start(dat = repos_obs, + var = 'tos', + date = '200505', #dates_file, + time = 'all', + lat = indices(1:10), + lon = indices(1:10), + time_across = 'date', + #combine time and file_date dims + merge_across_dims = TRUE, + #exclude the additional NAs generated by merge_across_dims + merge_across_dims_narm = TRUE, + synonims = list(lat = c('lat', 'latitude'), + lon = c('lon', 'longitude')), + return_vars = list(lat = 'dat', + lon = 'dat', + time = 'date'), + retrieve = FALSE) + +expect_equal( + attr(obs, 'Variables')$common$time[1, 1], + as.POSIXct('2005-05-16 12:00:00', tz = 'UTC') +) + +}) + +test_that("7. proleptic_gregorian, monthly, unit = 'days since 1850-1-1 00:00:00'", { + + repos <- '/esarchive/exp/mpi-esm-lr/cmip5-historical_i0p1/monthly_mean/$var$/$var$_$sdate$.nc' + data <- Start(dat = repos, + var = 'tas', + sdate = '20000101', + time = indices(1:3), + ensemble = indices(1), + latitude = indices(1:4), + longitude = indices(1:3), + return_vars = list(time = NULL)) + + time <- c(as.POSIXct('2000-01-16 12:00:00', tz = 'UTC'), + as.POSIXct('2000-02-15 12:00:00', tz = 'UTC'), + as.POSIXct('2000-03-16 12:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" + + expect_equal( + attr(data, 'Variables')$common$time[1], + time[1] + ) + expect_equal( + attr(data, 'Variables')$common$time[2], + time[2] + ) + expect_equal( + attr(data, 'Variables')$common$time[3], + time[3] + ) + +}) + +test_that("8. gregorian, 3hrly, unit = 'days since 1850-1-1'", { + repos <- '/esarchive/exp/CMIP5/historical/ecearth/cmip5-historical_i0p1/$var$_3hr_EC-EARTH_historical_r6i1p1_$period$.nc' + data <- Start(dat = repos, + var = 'vas', + period = '200501010300-200601010000', + time = indices(1:3), + lat = indices(1:4), + lon = indices(1:3), + return_vars = list(time = NULL)) + + time <- c(as.POSIXct('2005-01-01 03:00:00', tz = 'UTC'), + as.POSIXct('2005-01-01 06:00:00', tz = 'UTC'), + as.POSIXct('2005-01-01 09:00:00', tz = 'UTC')) + attr(time, "tzone") <- "UTC" + + expect_equal( + attr(data, 'Variables')$common$time[1], + time[1] + ) + expect_equal( + attr(data, 'Variables')$common$time[2], + time[2] + ) + expect_equal( + attr(data, 'Variables')$common$time[3], + time[3] + ) + +}) + diff --git a/tests/testthat/test-Start-metadata_filedim_dependency.R b/tests/testthat/test-Start-metadata_filedim_dependency.R new file mode 100644 index 0000000000000000000000000000000000000000..a5fa558cb8a76ad5ff6542c5678c2c7187e17226 --- /dev/null +++ b/tests/testthat/test-Start-metadata_filedim_dependency.R @@ -0,0 +1,199 @@ +context("Start() metadata filedim dependency") +# When inner dimension selector is an array with filedim dimension name (e.g., time = [sdate = 2, time = 4], +# or *_across is used, the inner dim has dependency on file dim. In this case, return_vars must +# specify this relationship, i.e., return_vars = list(time = 'sdate'). + + +# Preparation: Get the time values +repos <- '/esarchive/exp/ecmwf/system5_m1/monthly_mean/$var$_f6h/$var$_$sdate$.nc' + +suppressWarnings( +data <- Start(dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + ensemble = indices(1), + time = indices(1:4), + latitude = indices(1), longitude = indices(1), + return_vars = list(time = 'sdate'), + silent = TRUE, + retrieve = FALSE) +) +time_val <- attr(data, 'Variables')$common$time +time_val_vector <- time_val[c(1, 3, 5, 7, 2, 4, 6, 8)] + +#--------------------------------------------------------------- + +test_that("1. Selector is values()", { + +#================== values() with dimensions =================== + suppressWarnings( + test4 <- Start( + dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + time = time_val, + # time_across = 'sdate', + ensemble = c(1, 3), + latitude = indices(1:3), + longitude = indices(1:2), + return_vars = list(time = 'sdate'), + retrieve = TRUE) + ) + time4 <- attr(test4, 'Variables')$common$time + +expect_equal( + dim(time4), + c(sdate = 2, time = 4) +) +expect_equal( + time4[2, 2], + as.POSIXct("2018-03-01", tz = 'UTC') +) + +#---------------------------------------- + + suppressWarnings( + test6 <- Start( + dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + time = time_val, + # time_across = 'sdate', + ensemble = c(1, 3), + latitude = indices(1:3), + longitude = indices(1:2), + return_vars = list(time = NULL), + retrieve = TRUE) + ) + time6 <- attr(test4, 'Variables')$common$time + +expect_equal( + dim(time6), + c(sdate = 2, time = 4) +) +expect_equal( + time6, + time4 +) +expect_equal( + as.vector(test6), + as.vector(test4) +) + +expect_equal( + test6, + test4, + check.attributes = FALSE +) + +#---------------------------------------- + + suppressWarnings( + test6a <- Start( + dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + time = time_val, + time_across = 'sdate', + ensemble = c(1, 3), + latitude = indices(1:3), + longitude = indices(1:2), + return_vars = list(time = NULL), + retrieve = TRUE) + ) + time6a <- attr(test4, 'Variables')$common$time + +expect_equal( + dim(time6a), + c(sdate = 2, time = 4) +) +expect_equal( + time6, + time6a +) +expect_equal( + as.vector(test6), + as.vector(test4) +) + +expect_equal( + test6, + test6a, + check.attributes = FALSE +) + +#---------------------------------------- + +#================== values() is vector =================== + + suppressWarnings( + test14a <- Start( + dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + time = time_val_vector, + time_across = 'sdate', + ensemble = c(1, 3), + latitude = indices(1:3), + longitude = indices(1:2), + return_vars = list(time = NULL), + retrieve = TRUE) + ) + time14a <- attr(test14a, 'Variables')$common$time + +expect_equal( + dim(time14a), + c(sdate = 2, time = 4) +) +expect_equal( + time14a, + time6a +) +expect_equal( + as.vector(test14a), + as.vector(test4) +) + +expect_equal( + test14a, + test6a, + check.attributes = FALSE +) + +#------------------------------------------------- + + suppressWarnings( + test15a <- Start( + dat = repos, + var = 'tas', + sdate = c('20170101', '20180101'), + time = time_val_vector, + time_across = 'sdate', + ensemble = c(1, 3), + latitude = indices(1:3), + longitude = indices(1:2), + return_vars = list(time = 'sdate'), + retrieve = TRUE) + ) + time15a <- attr(test15a, 'Variables')$common$time + +expect_equal( + dim(time15a), + c(sdate = 2, time = 4) +) +expect_equal( + time15a, + time6a +) +expect_equal( + as.vector(test15a), + as.vector(test4) +) + +expect_equal( + test15a, + test6a, + check.attributes = FALSE +) + +})