it("expects valid input: schemas is a named list", {
it("expects valid input: schema elements correct lengths", {
"^schema elements must have length two: element 1$"
relation_schema(list(a = NULL, b = 1:3), character()),
"^schema elements must have length two: elements 1, 2$"
it("expects valid input: schema elements contain characters of valid lengths", {
relation_schema(list(a = list(integer(), "a")), "a"),
"^schema attribute sets must be characters: element 1$"
list(a = list(integer(), "a"), a.1 = list(logical(), "a")),
"^schema attribute sets must be characters: elements 1, 2$"
"^schema key sets must be lists: element 1$"
list(a = list(character(), 1L), b = list(character(), FALSE)),
"^schema key sets must be lists: elements 1, 2$"
relation_schema(list(a = list(character(), list())), "1"),
"^schema key sets must have at least one element: element 1$"
list(a = list(character(), list()), b = list(character(), list())),
"^schema key sets must have at least one element: elements 1, 2$"
relation_schema(list(a = list(character(), list(1L))), "1"),
"^schema key sets must have character elements: element 1\\.1$"
list(a = list(character(), list(1L)), b = list("1", list("1", 1L))),
"^schema key sets must have character elements: elements 1\\.1, 2\\.2$"
"^relation schema names must be non-empty: element 1"
relation_schema(list(a = list(c("a", "a"), list("a"))), "a"),
relation_schema(list(a = list("a", list(c("a", "a")))), "a"),
"^relation key attributes must be unique: elements 1\\.1\\.\\{a\\}, 2\\.2\\.\\{b\\}$"
relation_schema(list(a = list("a", list("a"))), c("a", "a")),
relation_schema(list(a = list("a", list("a"))), "b"),
"^attributes in schema must be present in attrs_order: absent a$"
it("expects valid input: key attributes are in relation", {
relation_schema(list(a = list("a", list("b"))), c("a", "b")),
"^attributes in keys must be present in relation: element 1\\.\\{b\\}$"
it("orders key attributes with respect to order in attrs_order", {
with_args(match, table = attrs_order(rs)) %>>%
it("orders attributes with respect to appearance in keys, then by attrs_order", {
it("is subsetted to a valid relation schema, follows usual subsetting rules...", {
gen.sample_resampleable(c(FALSE, TRUE), of = length(rs))
tryCatch(rs[[ineg]], error = function(e) e$message),
tryCatch(rs[[ints[[ineg]]]], error = function(e) e$message)
x <- relation_schema(list(a = list(c("a", "b"), list("a"))), letters[1:5])
it("expects a relation_schema value for subset re-assignment", {
expect_error(rs[1] <- 1L, "^value must also be a relation_schema object$")
expect_error(rs[[1]] <- 1L, "^value must also be a relation_schema object$")
expect_error(rs$X <- 1L, "^value must also be a relation_schema object$")
gen.rs_reassignment_indices_format <- function(rs, subseq) {
weights <- rep(1L, 3L + (length(subseq) < length(rs)))
expect_rs_subset_reassignment_success <- function(rs, indices, value) {
gen.rs_single_reassignment_indices_format <- function(rs, subseq) {
2L + (length(rs) == 2) + (length(rs) == 1)
gen.sample(seq_along(rs), 2, replace = FALSE),
if (length(rs) > 1) list(gen.rs_single_reassignment_failure_multiint(rs))
weights <- c(70, 15, if (length(rs) > 1) 15)
expect_rs_subset_single_reassignment_success <- function(rs, ind, value) {
expect_rs_subset_single_exact_reassignment_success <- function(rs, ind, value) {
eval(parse(text = paste0("rs$", ind, " <- value"))),
it("is made unique to a valid relation schema", {
gen.relation_schema(letters[1:6], from = 0, to = 4) |>
gen.relation_schema(letters[1:6], from = 0, to = 8) |>
with_args(relation_schema, schemas = setNames(list(), character()))
gen.with(\(attrs) relation_schema(setNames(list(), character()), attrs)) |>
if (sum(vapply(keys(rs), identical, logical(1), list(character()))) <= 1)
gen.relation_schema_empty_keys(letters[1:6], 1, 8, min_empty = 1),
it("is composed of its attrs(), keys(), names(), and attrs_order()", {
it("is created with logical attribute classes", {
expect_no_error(tb <- data.frame(id = 1:2, schema = rs))