context("test-dimensions") argofile <- system.file("extdata/argo/MD5903593_001.nc", package = "tidync", mustWork = TRUE) x <- tidync(argofile) test_that("dimension matchup works", { expect_named(x %>% hyper_tibble(select_var = c("PRES", "PRES_QC")), c("PRES", "PRES_QC", "N_LEVELS", "N_PROF")) %>% nrow() %>% expect_equal(986L) tab <- x %>% hyper_filter(N_LEVELS = N_LEVELS < 20) %>% hyper_tibble(select_var = c("TEMP_ADJUSTED_QC", "NITRATE_ADJUSTED", "CHLA_ADJUSTED_ERROR")) expect_equal(dim(tab), c(38L, 5L)) expect_equal(purrr::map_chr(tab, typeof), c(TEMP_ADJUSTED_QC = "character", NITRATE_ADJUSTED = "double", CHLA_ADJUSTED_ERROR = "double", N_LEVELS = "integer", N_PROF = "integer" )) expect_equivalent(tab$CHLA_ADJUSTED_ERROR, c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 1.28159999847412, 1.36080002784729, 1.20239996910095, 1.49759995937347, 1.20239996910095, 1.28159999847412, 1.28159999847412, 1.28159999847412, 1.64160001277924, 1.23839998245239, 1.28159999847412, 1.33920001983643, 1.21679997444153, 1.15919995307922, 1.07280004024506, 1.00080001354218, 0.986400008201599, 0.943199992179871, 1.38960003852844 )) }) test_that("grids are sensible", { expect_equal(hyper_grids(x), structure(list(grid = c("D0,D9,D11,D8", "D6,D9,D11,D8", "D7,D9,D11,D8", "D6,D9,D8", "D10,D8", "D1,D8", "D2,D8", "D3,D8", "D5,D8", "D6,D8", "D7,D8", "D9,D8", "D0", "D2", "D5", "D8"), ndims = c(4L, 4L, 4L, 3L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L), nvars = c(1L, 1L, 3L, 1L, 35L, 1L, 2L, 2L, 4L, 2L, 1L, 1L, 3L, 2L, 1L, 17L), active = c(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE )), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, -16L))) }) test_that("expanded tibble order is sane", { tab <- expect_s3_class( ## note na.rm, usually missing values are dropped hyper_tibble(x, select_var = "BBP700", na.rm = FALSE), "tbl_df" ) expect_equal(tab$N_LEVELS, rep(1:493, 2)) expect_equal(tab$N_PROF, rep(1:2, each = 493)) tab2 <- expect_s3_class( ## note na.rm, usually missing values are dropped hyper_tibble(x, select_var = "BBP700", na.rm = TRUE), "tbl_df" ) expect_equal(tab2$N_LEVELS, 1:64) expect_equal(tab2$N_PROF, rep(2, 64)) ar <- expect_s3_class(hyper_array(x, select_var = c("BBP700", "NITRATE")), "tidync_data") expect_named(ar, c("BBP700", "NITRATE")) expect_equal(dim(ar[[1]]), c(493, 2)) ## note drop = FALSE here ar1 <- expect_s3_class(hyper_array(x, N_PROF = index == 2, drop = FALSE, select_var = c("BBP700", "NITRATE")), "tidync_data") expect_named(ar1, c("BBP700", "NITRATE")) expect_equal(dim(ar1[[1]]), c(493, 1)) ## note drop = TRUE here ar2 <- expect_s3_class(hyper_array(x, N_PROF = index == 2, drop = TRUE, select_var = c("BBP700", "NITRATE")), "tidync_data") expect_named(ar2, c("BBP700", "NITRATE")) expect_equal(dim(ar2[[1]]), c(493)) expect_equal(attr(ar2, "transforms")$N_LEVELS$N_LEVELS, 1:493) expect_true(all(attr(ar2, "transforms")$N_LEVELS$N_LEVELS)) expect_equal(attr(ar2, "transforms")$N_PROF$N_PROF, 1:2) expect_equal(attr(ar2, "transforms")$N_PROF$selected, c(FALSE, TRUE)) }) test_that("deprecation is working", { expect_named(hyper_transforms(x), c("N_LEVELS", "N_PROF")) expect_named(hyper_transforms(x, all = TRUE), c("STRING32", "STRING4", "DATE_TIME", "STRING8", "N_PROF", "STRING64", "N_PARAM", "STRING2", "STRING256", "N_LEVELS", "N_CALIB")) })