Falsifiable after 1 tests, and 100 shrinks
<simpleError in expect_all_true(mapply(identical, lapply(lst, attrs_order), lapply(lst,     function(x) intersect(attrs_order(res), attrs_order(x))))): could not find function "expect_all_true">
Counterexample:
[[1]]
database with 0 relations
0 attributes
no references

[[2]]
database with 0 relations
3 attributes: a, d, e
no references

empty_rs <- relation_schema(setNames(list(), character()), character())
it("expects valid input: relations is a relation", {
it("expects valid input: references is a list", {
it("expects valid input: reference elements are length-four lists", {
"^reference elements must be length-four lists: element 1$"
it("expects valid input: unique relation names", {
a = list(df = data.frame(), keys = list(character())),
a = list(df = data.frame(), keys = list(character()))
"^relation names must be unique: duplicated a$"
it("expects valid input: non-empty relation names", {
it("expects valid input: reference relation names are within relation names", {
database(rs, list(list("r3", "b", "r4", "b"))),
"^reference relation names must be within relation names: absent r4$"
database(rs, list(list("r4", "b", "r3", "b"))),
it("expects valid input: reference attribute names are within referrer's attributes and referee's keys", {
"^reference attributes must be within referrer's attributes and referee's keys: reference 1$"
# should have something about collected FK being a key of the citee,
it("can take referree keys out of order", {
df = data.frame(a = logical(), b = logical(), c = logical()),
df = data.frame(b = logical(), c = logical()),
df = data.frame(d = logical(), e = logical()),
it("expects valid input: references aren't self-references", {
create(relation_schema(list(a = list(c("a", "b"), list("a"))), c("a", "b"))),
"^reference cannot be from a relation's attribute to itself$"
it("expects valid input: records satisfy database schema", {
a = list(df = data.frame(a = 1:3, b = 3:1), keys = list("a")),
b = list(df = data.frame(b = 1:2, c = 3:4), keys = list("b"))
"^relations must satisfy references in schema:\na\\.\\{b\\} -> b\\.\\{b\\}$"
c = list(df = data.frame(c = 1:2, d = 3:4), keys = list("c"))
"^relations must satisfy references in schema:\na\\.\\{b\\} -> c\\.\\{c\\}$"
# accounts for duplicate references before checking
a = list(df = data.frame(a = 1:3, b = c(1L, 1L, 2L)), keys = list("a")),
b = list(df = data.frame(b = 1:2), keys = list("b"))
it("handles merge duplicates due to floating-point when checking references", {
# FDs: acd -> b, ab -> d, bd -> a if numbers were represented exactly,
# ad -> b, b -> d when using 15 significant digits
# 3NF schema: abcd[acd].{ab} -> ab[ab,bd].{ab} if exact,
# abd[ad].{b} -> bd[b].{b}, abc[abc].{b} -> b.{b} for 15 sig. digits
x_sig[2:4] <- lapply(x_sig[2:4], format, digits = 15) |> lapply(as.numeric)
ds <- normalise(fds, remove_avoidable = TRUE)
rel <- subschemas(ds) |> create() |> insert(x_sig, digits = 15)
check <- df_join(referrer, referee, by = "b")
expect_true(df_equiv(y, x, digits = 15))
it("expects record reassignments to have all prime attributes, maybe others, order-independent", {
list(a = list(df = data.frame(a = 1:4, b = 1:2), keys = list("a"))),
records(x) <- list(a = data.frame(b = 1:2)),
"^record reassignments must keep key attributes$"
records(x) <- list(a = data.frame(a = 1:4, c = 1)),
"^record reassignments can not add attributes$"
expect_silent(records(y) <- list(a = data.frame(b = 1:2, a = 1:4)))
expect_silent(records(y) <- list(a = data.frame(a = 1:4)))
list(a = list(df = data.frame(b = 1:4, a = 1:2), keys = list("b"))),
expect_silent(records(y2) <- list(a = data.frame(a = 1:2, b = 1:4)))
it("expects records reassignments to have unique attribute names", {
records(x)[[1]] <- data.frame(a = 1:4, a = 1:2, check.names = FALSE)
it("expects records name reassignments to result in an error or a valid database", {
nonempty <- which(lengths(attrs(db)) > 0)
res <- try(names(records(db)[[n]]) <- nm, silent = TRUE)
class(try(is_valid_database(db), silent = TRUE))[[1]] != "try-error"
it("is subsetted to a valid database schema, obeys usual subsetting rules...", {
gen.sample_resampleable(c(FALSE, TRUE), of = length(lst[[3]]))
is_valid_database(db[i], same_attr_name = san, single_key_pairs = skp)
is_valid_database(db[inum], same_attr_name = san, single_key_pairs = skp)
is_valid_database(db[ineg], same_attr_name = san, single_key_pairs = skp)
is_valid_database(db[names(db)[i]], same_attr_name = san, single_key_pairs = skp)
tryCatch(db[[ineg]], error = function(e) e$message),
tryCatch(db[[ints[[ineg]]]], error = function(e) e$message)
it("... except allowing non-matches as NAs", {
it("can be subsetted while preserving attributes order", {
preserves_attributes_when_subsetting <- function(db, indices, op) {
gen.database(letters[1:6], 0, 8, same_attr_name = FALSE) |>
indices = gen.sample_resampleable(seq_along(db), from = 0, to = length(db))
gen.with(\(lst) c(lst, list(op = `[`))),
gen.database(letters[1:6], 1, 8, same_attr_name = FALSE) |>
gen.with(\(lst) c(lst, list(op = `[[`))),
it("keeps relevant references when subsetted", {
keeps_relevant_references <- function(db, indices, op) {
# this is too close to replicating the code for my liking
indices = gen.sample(seq_along(db), replace = FALSE)
it("duplicates references when taking duplicate relation schemas", {
indices = gen.sample_resampleable(seq_along(db), from = 2, to = 2*length(db))
if (!anyDuplicated(indices) || length(references(db)) == 0)
expected <- subset_refs(orig, indices, names(db), names(db_new))
it("expects a database value for subset re-assignment", {
expect_error(db[1] <- 1L, "^value must also be a database object$")
expect_error(db[[1]] <- 1L, "^value must also be a database object$")
expect_error(db$X <- 1L, "^value must also be a database object$")
describe("can have subsets re-assigned, without changing relation names", {
gen.db_reassignment_indices_format <- function(db, subseq) {
weights <- rep(1L, 3L + (length(subseq) < length(db)))
do.call(gen.choice, c(choices, list(prob = weights)))
expect_db_subset_reassignment_success <- function(db, indices, value) {
gen.db_single_reassignment_indices_format <- function(db, subseq) {
2L + (length(db) == 2) + (length(db) == 1)
gen.sample(seq_along(db), 2, replace = FALSE),
gen.with(unlist %>>% unique %>>% sort) |>
if (length(db) > 1) list(gen.db_single_reassignment_failure_multiint(db))
weights <- c(70, 15, if (length(db) > 1) 15)
expect_db_subset_single_reassignment_success <- function(db, ind, value) {
expect_db_subset_single_exact_reassignment_success <- function(db, ind, value) {
eval(parse(text = paste0("res$", ind, " <- value")))
eval(parse(text = paste0("db$", ind, " <- value"))),
it("is made unique to a valid database", {
gen.database(letters[1:6], 0, 8, same_attr_name = san)
unique(db) |> is_valid_database(unique = TRUE, same_attr_name = san)
it("is made unique with references preserved", {
gen.database(letters[1:3], 0, 8, same_attr_name = FALSE) |>
dup %>>% uncurry(c) %>>% unique %>>% references,
# special case: unique must merge two tables to keep both references
it("is made unique where tables with permuted rows count as duplicates", {
a = list(df = data.frame(a = c(T, F)), keys = list("a")),
a.1 = list(df = data.frame(a = c(F, T)), keys = list("a"))
it("concatenates to a valid database", {
gen.database(letters[1:6], 0, 8, same_attr_name = san) |>
\(san, dss) do.call(c, dss) |> is_valid_database(same_attr_name = san),
it("concatenates without losing an attribute order", {
it("concatenates without losing attribute orderings, if consistent", {
gen.with(\(x) if (length(x) > 3) x[1:3] else x) |>
# example where attributes aren't consistent, but are pairwise
it("concatenates without losing references", {
(identical(lengths(ks), 0L) && all(as %in% as2)) ||
it("concatenates without losing schemas", {
# sort attrs to keep test independent from that for attribute orderings
\(as, ks) list(sort(as), lapply(ks, sort)),
it("is composed of its records(), keys(), names(), attrs_order(), and references()", {
gen.database(letters[1:6], 0, 8, same_attr_name = FALSE),
list %>>% with_args(setNames, c("df", "keys")),
it("is composed of its subrelations() and references()", {
it("renames relations in its references when they're renamed", {
gen.database(letters[1:6], 0, 8, sek, san, skp)
it("expects new attribute names to be unique", {
df = data.frame(a = logical(), b = logical()),
"^attrs_order must be unique: duplicated c$"
a = list(df = data.frame(a = logical(), b = logical()), keys = list("a")),
b = list(df = data.frame(b = logical(), c = logical()), keys = list("b", "c"))
"relation a: a, b; 0 records\\n  key 1: a",
"relation b: b, c; 0 records\\n  key 1: b\\n  key 2: c",
a = list(df = data.frame(a = logical(), b = logical(), c = logical()), keys = list("a")),
b = list(df = data.frame(b = logical(), c = logical()), keys = list(c("b", "c")))
"relation a: a, b, c; 0 records\\n  key 1: a",
"relation b: b, c; 0 records\\n  key 1: b, c",
it("can be added to a data frame as a column", {
expect_no_error(tb <- data.frame(id = 1:2, relation = db))