Nothing
context("Variable folders")
with_mock_crunch({
ds <- cachedLoadDataset("test ds")
test_that("Can load the root public variable folder", {
expect_is(publicFolder(ds), "VariableFolder")
})
test_that("Folder contents are ordered by @graph", {
expect_identical(names(publicFolder(ds)), c("Group 1", "Group 2"))
})
test_that("Other folder methods", {
expect_identical(types(publicFolder(ds)), c("folder", "folder"))
})
test_that("Can [[ from a folder", {
expect_is(publicFolder(ds)[[1]], "VariableFolder")
expect_identical(name(publicFolder(ds)[[1]]), "Group 1")
expect_is(publicFolder(ds)[["Group 2"]], "VariableFolder")
expect_identical(name(publicFolder(ds)[["Group 2"]]), "Group 2")
})
g1 <- publicFolder(ds)[[1]]
test_that("Folder with heterogeneous types", {
expect_identical(names(g1), c("Birth Year", "Nested", "Text variable ftw"))
expect_identical(types(g1), c("numeric", "folder", "text"))
expect_identical(aliases(g1), c("birthyr", NA, "textVar"))
# Extracting by alias
expect_identical(
names(g1[c("birthyr", "textVar")]),
c("Birth Year", "Text variable ftw")
)
})
test_that("variables() method on folders", {
expect_identical(aliases(variables(g1)), c("birthyr", "textVar"))
})
test_that("Get folder from a folder (via $)", {
expect_is(g1$Nested, "VariableFolder")
expect_identical(name(g1$Nested), "Nested")
})
test_that("Get a variable from a folder", {
expect_is(g1[[1]], "NumericVariable")
expect_identical(name(g1[[1]]), "Birth Year")
## Not identical to ds$birthyr bc the catalog tuples have different
## contents, but they work the same
expect_identical(self(g1[[1]]), self(ds$birthyr))
expect_identical(summary(g1[[1]]), summary(ds$birthyr))
})
test_that("Extract from a folder by path", {
expect_is(publicFolder(ds)[["Group 1/Nested"]], "VariableFolder")
expect_identical(publicFolder(ds)[["Group 1/Nested"]], g1$Nested)
expect_is(publicFolder(ds)[["Group 1/Birth Year"]], "NumericVariable")
expect_identical(name(publicFolder(ds)[["Group 1/Birth Year"]]), "Birth Year")
expect_is(publicFolder(ds)[["Group 1/birthyr"]], "NumericVariable")
})
test_that("Folder extract error handling", {
expect_null(publicFolder(ds)[["foo"]])
expect_null(publicFolder(ds)[["Group 1/foo"]])
expect_error(
publicFolder(ds)[["Group 1/foo/bar/baz"]],
'"Group 1/foo/bar/baz" is an invalid path: foo is not a folder'
)
expect_error(
publicFolder(ds)[["Group 1/Birth Year/bar/baz"]],
'"Group 1/Birth Year/bar/baz" is an invalid path: Birth Year is not a folder'
)
expect_error(
publicFolder(ds)[["Group 1/birthyr/bar/baz"]],
'"Group 1/birthyr/bar/baz" is an invalid path: birthyr is not a folder'
)
})
test_that("Set a folder's name", {
expect_PATCH(
name(publicFolder(ds)[[1]]) <- "First",
"https://app.crunch.io/api/datasets/1/folders/1/",
'{"element":"shoji:catalog","body":{"name":"First"}}'
)
})
test_that("But top-level folder doesn't have a name and you can't set it", {
skip("TODO")
})
test_that("Set names of objects inside a folder", {
expect_PATCH(
names(publicFolder(ds)[[1]]) <- c("Year of Birth", "A folder in a folder", "Plain text"),
"https://app.crunch.io/api/datasets/1/folders/1/",
'{"element":"shoji:catalog","index":',
'{"https://app.crunch.io/api/datasets/1/variables/birthyr/":',
'{"name":"Year of Birth"},',
'"https://app.crunch.io/api/datasets/1/folders/3/":',
'{"name":"A folder in a folder"},',
'"https://app.crunch.io/api/datasets/1/variables/textVar/":',
'{"name":"Plain text"}}}'
)
})
test_that("Set a variable's name inside a folder", {
## Note that this patches the catalog (folder) instead of the entity.
## Historical reasons, plus ensuring that name<- on entity and
## names<- on catalog do the same thing
expect_PATCH(
name(publicFolder(ds)[["Group 1/Birth Year"]]) <- "Year of birth",
"https://app.crunch.io/api/datasets/1/folders/1/",
'{"https://app.crunch.io/api/datasets/1/variables/birthyr/":',
'{"name":"Year of birth"}}'
)
})
test_that("folder() finds the parent folder", {
expect_identical(ds %>% cd("Group 1") %>% folder(), publicFolder(ds))
expect_identical(folder(cd(ds, "Group 1/Nested")), cd(ds, "Group 1"))
expect_identical(
folder(publicFolder(ds)[["Group 1/Birth Year"]]),
cd(ds, "Group 1")
)
expect_null(folder(publicFolder(ds)))
expect_error(folder("string"), "No folder for object of class character")
})
test_that("rootFolder() finds the top level", {
expect_identical(rootFolder(publicFolder(ds)), publicFolder(ds))
expect_identical(rootFolder(publicFolder(ds)[["Group 1/Nested"]]), publicFolder(ds))
expect_identical(rootFolder(ds$birthyr), publicFolder(ds))
})
test_that("delete folder", {
expect_error(
delete(publicFolder(ds)[["Group 1/Nested"]]),
"Must confirm deleting folder"
)
with_consent({
expect_DELETE(
delete(publicFolder(ds)[["Group 1/Nested"]]),
"https://app.crunch.io/api/datasets/1/folders/3/"
)
})
expect_error(
delete(publicFolder(ds)),
"Cannot delete root folder"
)
})
test_that("path()", {
expect_identical(path(publicFolder(ds)[["Group 1/Nested"]]), "/Group 1/Nested") # nolint
expect_identical(path(ds$birthyr), "/Group 1/Birth Year") # nolint
expect_identical(path(publicFolder(ds)), "/")
})
with(temp.option(crayon.enabled = FALSE), {
test_that("print folders: basic", {
## Coloring aside, the default print method should look like you
## printed the vector of names (plus the path printed above)
expect_output(
print(publicFolder(ds)),
capture.output(print(names(publicFolder(ds)))),
fixed = TRUE
)
})
test_that("An empty folder doesn't error on printing", {
expect_output(
print(VariableFolder()),
"folder(0)",
fixed = TRUE
)
})
test_that("If there are names longer than 'width', it still prints", {
skip_on_jenkins("Unskip when testthat is next updated on jenkins")
alphabet <- paste(letters, collapse = "")
expect_output(
colored_print(alphabet),
'[1] "abcdefghijklmnopqrstuvwxyz"',
fixed = TRUE,
width = 10
)
})
test_that("Folder tree printing", {
## These are obfuscated because of archaic restrictions on UTF-8
skip_on_cran()
source("print-folders.R", encoding = "UTF-8", local = TRUE)
})
})
test_that("copyFolders returns the target dataset with the order applied", {
ds_again <- cachedLoadDataset("test ds")
expect_silent(new_order <- copyFolders(ds, ds_again))
expect_is(new_order, "CrunchDataset")
expect_identical(entities(ordering(ds)), entities(ordering(new_order)))
})
test_that("copyFolders input validation", {
expect_error(
copyFolders(ds, "foo"),
"Both source and target must be Crunch datasets."
)
})
})
with_test_authentication({
ds <- createDataset(name = now())
test_that("folders are enabled by default in the tests", {
expect_true(settings(ds)$variable_folders)
})
ds <- newDataset(df)
test_that("copyFolders copies across datasets with simple order", {
ds_fork <- forkDataset(ds)
old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
ds %>% cd("/") %>% setOrder(c("v1", "v2", "v5", "v6", "v3", "v4"))
ds <- refresh(ds)
# test that ds_fork has the old order still
expect_identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
old_order
)
expect_false(identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
capture_output_lines(publicFolder(ds) %>% print(depth = 10))
))
# copy order, and check that ds_fork has the new order.
ds_fork <- copyFolders(ds, ds_fork)
expect_identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
capture_output_lines(publicFolder(ds) %>% print(depth = 10))
)
})
test_that("copyFolders copies across datasets with simple(-ish) order (and one nesting)", {
ds_fork <- forkDataset(ds)
old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
ds %>% cd("/") %>% mkdir("Group A") %>% mv(c("v4", "v3"), "Group A")
# test that ds_fork has the old order still
expect_identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
old_order
)
expect_false(identical(
capture_output_lines(publicFolder(ds) %>% print(depth = 10)),
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
))
# copy order, and check that ds_fork has the new order.
ds_fork <- copyFolders(ds, ds_fork)
expect_identical(
capture_output(publicFolder(ds_fork) %>% print(depth = 10)),
capture_output(publicFolder(ds) %>% print(depth = 10))
)
})
test_that("copyFolders copies across datasets with nested hierarchical order", {
ds_fork <- forkDataset(ds)
old_order <- capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
# reset order
ds %>% mv(aliases(allVariables(ds)), "/")
ds %>%
mkdir("Group 1") %>%
mv(c("v1", "v2"), "Group 1") %>%
mkdir("Group 1/Group 1.5") %>%
mv(c("v5", "v6"), "/Group 1/Group 1.5") %>% # nolint
mkdir("Group 2") %>%
mv(c("v4", "v3"), "/Group 2") # nolint
# test that ds_fork has the old order still
expect_identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
old_order
)
expect_false(identical(
capture_output_lines(publicFolder(ds) %>% print(depth = 10)),
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10))
))
# copy order, and check that ds_fork has the new order.
ds_fork <- copyFolders(ds, ds_fork)
expect_identical(
capture_output_lines(publicFolder(ds_fork) %>% print(depth = 10)),
capture_output_lines(publicFolder(ds) %>% print(depth = 10))
)
})
test_that("copyFolders copies across disparate datasets", {
# setup an alternative dataset that has some overlap with ds
df_alt <- df
df_alt$v12 <- df_alt$v1
df_alt$v1 <- NULL
df_alt$v2 <- NULL
df_alt$new_var <- 1
df_alt$new_var2 <- letters[20:1]
ds_alt <- newDataset(df_alt)
old_order <- capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))
# reset order
with_consent(
ds %>%
mv(aliases(allVariables(ds)), "/") %>%
rmdir(c("Group 1")) %>%
rmdir(c("Group 2")) %>%
rmdir(c("Group A"))
)
ds %>% mkdir("Group A") %>% mv(c("v4", "v3"), "Group A")
# test that ds_alt has the old order still
expect_identical(
capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10)),
old_order
)
expect_false(identical(
capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))[-c(4, 5, 6)],
capture_output_lines(publicFolder(ds) %>% print(depth = 10))[-c(2, 3)]
))
# copy order, and check that ds_alt has the new order.
ds_alt <- copyFolders(ds, ds_alt)
expect_identical(
# ignore lines 4, 5, and 6 because they are vars in ds_alt that are
# not in ds
capture_output_lines(publicFolder(ds_alt) %>% print(depth = 10))[-c(4, 5, 6)],
# ignore lines 3 and 2 because they are vars in ds that are
# not in ds_alt
capture_output_lines(publicFolder(ds) %>% print(depth = 10))[-c(2, 3)]
)
})
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.