tests/testthat/test-relation.r

In autodb: Automatic Database Normalisation for Data Frames

describe("relation", {
  it("expects valid input: relations is a named list", {
    expect_error(relation(1L, character()))
    expect_error(
      relation(list(), character()),
      "^relations must be named$"
    )
  })
  it("expects valid input: relation elements correct lengths", {
    expect_error(
      relation(list(a = NULL), character()),
      "^relation elements must have length two: element 1$"
    )
  })
  it("expects valid input: list elements contain df and keys elements, and no others, correct classes", {
    expect_error(
      relation(list(X = list(df = data.frame(), 1)), character()),
      "^relations must contain 'df' and 'keys' elements: element 1$"
    )
    expect_error(
      relation(
        list(X = list(df = data.frame(), keys = data.frame())),
        character()
      ),
      "^relation 'keys' elements must be lists: element 1$"
    )
    expect_error(
      relation(
        list(X = list(df = list(), keys = list())),
        character()
      ),
      "^relation 'df' elements must be data frames: element 1$"
    )
    expect_silent(relation(
      list(X = list(keys = setNames(list(), character()), df = data.frame())),
      character()
    ))
  })
  it("expects valid input: attrs_order is a character", {
    expect_error(relation(list(), 1L))
  })
  it("expects valid input: no duplicate attrs", {
    expect_error(
      relation(
        list(a = list(
          df = data.frame(a = logical(), a = logical(), check.names = FALSE),
          keys = list("a")
        )),
        "a"
      ),
      "^relation attributes must be unique: element 1$"
    )
  })
  it("expects valid input: no duplicate attrs in keys", {
    expect_error(
      relation(
        list(a = list(df = data.frame(a = logical()), keys = list(c("a", "a")))),
        "a"
      ),
      "^relation key attributes must be unique: element 1\\.1\\.\\{a\\}$"
    )
  })
  it("expects valid input: no duplicate attrs_order", {
    expect_error(
      relation(
        list(a = list(df = data.frame(a = logical()), keys = list("a"))),
        c("a", "a")
      ),
      "^attrs_order must be unique: duplicated a$"
    )
  })
  it("expects valid input: relation attributes are in attrs_order", {
    expect_error(
      relation(
        list(a = list(df = data.frame(a = integer()), keys = list("a"))),
        "b"
      ),
      "^relation attributes not in attrs_order: missing a$"
    )
  })
  it("expects valid input: relation attributes get ordered by key mentions first", {
    expect_silent(relation(
      list(b = list(df = data.frame(b = integer(), a = integer()), keys = list("b"))),
      c("a", "b")
    ))
  })
  it("expects valid input: keys are in columns", {
    expect_error(
      relation(
        list(a = list(
          df = data.frame(a = rep(1L, 2L), b = 1L, c = 1L),
          keys = list("b", c("c", "d"))
        )),
        c("a", "b", "c", "d")
      ),
      "^relation keys must be within relation attributes: element 1\\.2\\.\\{d\\}$"
    )
  })
  it("expects valid input: keys are satisfied", {
    expect_error(
      relation(
        list(a = list(df = data.frame(a = rep(1L, 2L)), keys = list("a"))),
        "a"
      ),
      "^relations must satisfy their keys: element 1\\.\\{a\\}$"
    )
    expect_error(
      relation(
        list(a = list(
          df = data.frame(a = 1:2),
          keys = list(character())
        )),
        "a"
      ),
      "^relations must satisfy their keys: element 1\\.\\{\\}$"
    )
  })
  it("expects valid input: unique relation names", {
    expect_error(
      relation(
        list(
          a = list(df = data.frame(), keys = list(character())),
          a = list(df = data.frame(), keys = list(character()))
        ),
        character()
      ),
      "^relation names must be unique: duplicated a$"
    )
  })
  it("expects valid input: non-empty relation names", {
    expect_error(
      relation(
        setNames(
          list(
            a = list(df = data.frame(), keys = list(character())),
            b = list(df = data.frame(), keys = list(character()))
          ),
          c("", "b")
        ),
        character()
      ),
      "^relation names must be non-empty: element 1"
    )
  })

  it("expects record reassignments to have all prime attributes, maybe others, order-independent", {
    x <- relation(
      list(a = list(df = data.frame(a = 1:4, b = 1:2), keys = list("a"))),
      attrs_order = c("a", "b")
    )
    expect_error(
      records(x) <- list(a = data.frame(b = 1:2)),
      "^record reassignments must keep key attributes$"
    )
    expect_error(
      records(x) <- list(a = data.frame(a = 1:4, c = 1)),
      "^record reassignments can not add attributes$"
    )
    y <- x
    expect_silent(records(y) <- list(a = data.frame(b = 1:2, a = 1:4)))
    expect_identical(y, x)
    expect_silent(records(y) <- list(a = data.frame(a = 1:4)))
    x2 <- relation(
      list(a = list(df = data.frame(b = 1:4, a = 1:2), keys = list("b"))),
      attrs_order = c("a", "b")
    )
    y2 <- x2
    expect_silent(records(y2) <- list(a = data.frame(a = 1:2, b = 1:4)))
    expect_identical(y2, x2)
  })
  it("expects records reassignments to have unique attribute names", {
    x <- relation(
      list(a = list(df = data.frame(a = 1:4, b = 1:2), keys = list("a"))),
      attrs_order = c("a", "b")
    )
    expect_error(
      records(x)[[1]] <- data.frame(a = 1:4, a = 1:2, check.names = FALSE)
    )
  })
  it("expect records name reassignments to result in an error or a valid relation", {
    forall(
      gen.relation(letters[1:6], 1, 8) |>
        gen.and_then(\(rel) {
          nonempty <- which(lengths(attrs(rel)) > 0)
          if (length(nonempty) == 0)
            return(list(
              gen.pure(rel),
              gen.pure(1L),
              gen.pure(attrs(rel)[[1]])
            ))
          gen.element(nonempty) |>
            gen.and_then(\(n) {
              list(
                gen.pure(rel),
                gen.pure(n),
                gen.sample_resampleable(
                  attrs(rel)[[n]],
                  to = length(attrs(rel)[[n]])
                )
              )
            })
        }),
      \(rel, n, nm) {
        res <- try(names(records(rel)[[n]]) <- nm, silent = TRUE)
        expect_true(
          class(res)[[1]] == "try-error" ||
            is.null(try(is_valid_relation(rel), silent = TRUE))
        )
      },
      curry = TRUE
    )
  })

  it("sorts relation key contents attrs_order", {
    expect_identical(
      keys(relation(
        list(
          a = list(
            df = data.frame(a = integer(), b = integer()),
            keys = list(c("b", "a"))
          )
        ),
        c("a", "b")
      )),
      list(a = list(c("a", "b")))
    )
  })
  it("sorts relation keys according to length and attrs_order", {
    expect_identical(
      keys(relation(
        list(
          a = list(
            df = data.frame(a = integer(), b = integer()),
            keys = list("b", "a")
          )
        ),
        c("a", "b")
      )),
      list(a = list("a", "b"))
    )
  })
  it("removes duplicate keys", {
    expect_no_dup_keys <- function(rel) {
      expect_true(all(vapply(keys(rel), Negate(anyDuplicated), logical(1))))
    }
    expect_no_dup_keys(relation(
      list(ab = list(
        df = data.frame(a = integer(), b = integer()),
        keys = list(c("a", "b"), c("a", "b"))
      )),
      c("a", "b")
    ))
  })
  it("sorts relation attributes according to sorted keys and attrs_order", {
    expect_identical(
      attrs(relation(
        list(
          a = list(
            df = data.frame(b = integer(), a = integer()),
            keys = list("a")
          )
        ),
        c("a", "b")
      )),
      list(a = c("a", "b"))
    )
  })

  it("is subsetted to a valid relation schema, obeys usual subsetting rules...", {
    forall(
      gen.relation(letters[1:6], 0, 8) |>
        gen.and_then(\(rel) list(
          gen.pure(rel),
          gen.sample_resampleable(c(FALSE, TRUE), of = length(rel))
        )),
      \(rel, i) {
        is_valid_relation(rel[i])

        inum <- which(i)
        is_valid_relation(rel[inum])
        expect_identical(rel[i], rel[inum])

        ineg <- -setdiff(seq_along(rel), inum)
        if (!all(i)) {
          is_valid_relation(rel[ineg])
          expect_identical(rel[i], rel[ineg])
        }

        is_valid_relation(rel[names(rel)[i]])
        expect_identical(rel[i], rel[names(rel)[i]])

        expect_length(rel[i], sum(i))

        ints <- stats::setNames(seq_along(rel), names(rel))
        expect_identical(rel[i], rel[ints[i]])
        expect_identical(rel[ineg], rel[ints[ineg]])
        expect_identical(rel[names(rel)[i]], rel[names(rel)[ints[i]]])
      },
      curry = TRUE
    )
    forall(
      gen.relation(letters[1:6], 1, 8) |>
        gen.and_then(\(rel) list(
          gen.pure(rel),
          gen.element(seq_along(rel))
        )),
      \(rel, inum) {
        is_valid_relation(rel[[inum]])
        expect_identical(rel[inum], rel[[inum]])

        ineg <- -setdiff(seq_along(rel), inum)
        if (length(ineg) == 1) {
          is_valid_relation(rel[[ineg]])
          expect_identical(rel[inum], rel[[ineg]])
        }

        is_valid_relation(rel[[names(rel)[[inum]]]])
        expect_identical(rel[inum], rel[[names(rel)[[inum]]]])

        is_valid_relation(eval(rlang::expr(`$`(rel, !!names(rel)[[inum]]))))
        expect_identical(rel[inum], eval(rlang::expr(`$`(rel, !!names(rel)[[inum]]))))

        ints <- stats::setNames(seq_along(rel), names(rel))
        expect_identical(rel[[inum]], rel[[ints[[inum]]]])
        expect_identical(
          tryCatch(rel[[ineg]], error = function(e) e$message),
          tryCatch(rel[[ints[[ineg]]]], error = function(e) e$message)
        )
        expect_identical(rel[[names(rel)[[inum]]]], rel[[names(rel)[[ints[[inum]]]]]])
      },
      curry = TRUE
    )
    forall(
      gen.relation(letters[1:6], 1, 8),
      \(rel) {
        expect_identical(rel[[TRUE]], rel[[1]])
      }
    )
    forall(
      gen.relation(letters[1:6], 1, 8) |>
        gen.and_then(\(rel) list(
          rel = gen.pure(rel),
          indices = gen.sample_resampleable(
            seq_along(rel),
            from = 2,
            to = 2*length(rel)
          )
        )),
      \(rel, indices) {
        is_valid_relation(rel[indices])
      },
      curry = TRUE
    )
  })
  it("... except allowing non-matches as NAs", {
    rel <- relation_schema(
      list(a = list("a", list("a"))),
      c("a")
    ) |>
      create()
    expect_error(
      rel[c("b", "c")],
      "^subset names that don't exist: b, c$"
    )
  })
  it("can be subsetted while preserving attributes", {
    x <- relation(
      list(a = list(
        df = data.frame(a = logical(), b = logical()),
        keys = list("a")
      )),
      letters[1:5]
    )
    expect_identical(x[TRUE], x)
    expect_identical(
      x[FALSE],
      relation(setNames(list(), character()), letters[1:5])
    )
    expect_identical(x[[1]], x)
    expect_error(x[[integer()]])
    expect_error(x[[c(1, 1)]])
  })

  it("expects a relation value for subset re-assignment", {
    rel <- create(relation_schema(
      list(X = list(character(), list(character()))),
      letters[1:6]
    ))
    expect_error(rel[1] <- 1L, "^value must also be a relation object$")
    expect_error(rel[[1]] <- 1L, "^value must also be a relation object$")
    expect_error(rel$X <- 1L, "^value must also be a relation object$")
  })
  describe("can have subsets re-assigned, without changing relation names", {
    it("[<-", {
      gen.rel_reassignment_indices_format <- function(rel, subseq) {
        choices <- c(
          list(gen.pure(subseq)),
          if (length(subseq) < length(rel))
            list(gen.pure(-setdiff(seq_along(rel), subseq))),
          list(gen.pure(names(rel)[subseq])),
          list(seq_along(rel) %in% subseq)
        )
        weights <- rep(1L, 3L + (length(subseq) < length(rel)))
        do.call(gen.choice, c(choices, list(prob = weights)))
      }
      gen.rel_reassignment <- function(rel) {
        gen.subsequence(seq_along(rel)) |>
          gen.and_then(\(subseq) {
            gen.rel_reassignment_indices_format(rel, subseq) |>
              gen.and_then(\(inds) {
                gen.relation(letters[1:6], length(subseq), length(subseq)) |>
                  gen.with(\(rs2) {
                    list(rel, inds, rs2)
                  })
              })
          })
      }
      expect_rel_subset_reassignment_success <- function(rel, indices, value) {
        res <- rel
        res[indices] <- value
        is_valid_relation(res)
        switch(
          class(indices),
          character = {
            negind <- setdiff(names(res), indices)
            expect_identical(res[negind], rel[negind])
            expect_identical(res[indices], setNames(value, indices))
          },
          integer = {
            expect_identical(res[-indices], rel[-indices])
            expect_identical(res[indices], setNames(value, names(rel)[indices]))
          },
          logical = {
            expect_identical(res[!indices], rel[!indices])
            expect_identical(res[indices], setNames(value, names(rel)[indices]))
          }
        )
      }
      forall(
        gen.relation(letters[1:6], 0, 8) |>
          gen.and_then(gen.rel_reassignment),
        expect_rel_subset_reassignment_success,
        curry = TRUE
      )
    })
    it("[[<-", {
      gen.rel_single_reassignment_indices_format <- function(rel, subseq) {
        choices <- c(
          list(gen.pure(subseq)),
          if (length(rel) == 2)
            list(gen.pure(-setdiff(seq_along(rel), subseq))),
          list(gen.pure(names(rel)[subseq])),
          if (length(rel) == 1)
            list(gen.pure(seq_along(rel) %in% subseq))
        )
        weights <- rep(
          1L,
          2L + (length(rel) == 2) + (length(rel) == 1)
        )
        do.call(gen.choice, c(choices, list(prob = weights)))
      }
      gen.rel_single_reassignment_success <- function(rel) {
        list(
          gen.pure(rel),
          gen.element(seq_along(rel)) |>
            gen.and_then(\(subseq) {
              gen.rel_single_reassignment_indices_format(rel, subseq)
            }),
          gen.relation(letters[1:6], 1, 1),
          gen.pure(NA_character_)
        )
      }
      gen.rel_single_reassignment_failure_emptyint <- function(rel) {
        list(
          gen.pure(rel),
          gen.rel_single_reassignment_indices_format(rel, integer()),
          gen.relation(letters[1:6], 0, 0)
        ) |>
          gen.with(\(lst) {
            c(
              lst,
              list(single_subset_failure_type(rel, lst[[2]]))
            )
          })
      }
      gen.rel_single_reassignment_failure_multiint <- function(rel) {
        list(
          gen.sample(seq_along(rel), 2, replace = FALSE),
          gen.subsequence(seq_along(rel))
        ) |>
          gen.with(unlist %>>% unique %>>% sort) |>
          gen.and_then(\(subseq) {
            gen.rel_single_reassignment_indices_format(rel, subseq) |>
              gen.and_then(\(indices) {
                gen.relation(letters[1:6], length(subseq), length(subseq)) |>
                  gen.with(\(rs2) {
                    list(
                      rel,
                      indices,
                      rs2,
                      single_subset_failure_type(rel, indices)
                    )
                  })
              })
          })
      }
      gen.rel_single_reassignment <- function(rel) {
        choices <- c(
          list(gen.rel_single_reassignment_success(rel)),
          list(gen.rel_single_reassignment_failure_emptyint(rel)),
          if (length(rel) > 1) list(gen.rel_single_reassignment_failure_multiint(rel))
        )
        weights <- c(70, 15, if (length(rel) > 1) 15)
        do.call(
          gen.choice,
          c(choices, list(prob = weights))
        )
      }
      expect_rel_subset_single_reassignment_success <- function(rel, ind, value) {
        res <- rel
        res[[ind]] <- value
        is_valid_relation(res)
        switch(
          class(ind),
          character = {
            negind <- setdiff(names(res), ind)
            expect_identical(res[negind], rel[negind])
            expect_identical(res[[ind]], setNames(value, ind))
          },
          integer = {
            expect_identical(res[-ind], rel[-ind])
            expect_identical(res[[ind]], setNames(value, names(rel)[[ind]]))
          },
          logical = {
            expect_identical(res[!ind], rel[!ind])
            expect_identical(res[[ind]], setNames(value, names(rel)[[ind]]))
          }
        )
      }
      forall(
        gen.relation(letters[1:6], 1, 8) |>
          gen.and_then(gen.rel_single_reassignment),
        \(rel, ind, value, error) {
          if (is.na(error)) {
            expect_rel_subset_single_reassignment_success(rel, ind, value)
          }else{
            expect_error(
              rel[[ind]] <- value,
              paste0("^", error, "$")
            )
          }
        },
        curry = TRUE
      )
    })
    it("$<-", {
      gen.rel_single_exact_reassignment_success_change <- function(rel) {
        list(
          gen.pure(rel),
          gen.element(seq_along(rel)) |>
            gen.with(\(subseq) names(rel)[[subseq]]),
          gen.relation(letters[1:6], 1, 1),
          gen.pure(NA_character_)
        )
      }
      gen.rel_single_exact_reassignment_success_add <- function(rel) {
        list(
          gen.pure(rel),
          gen.element(setdiff(letters, names(rel))),
          gen.relation(letters[1:6], 1, 1),
          gen.pure(NA_character_)
        )
      }
      gen.rel_single_exact_reassignment_failure <- function(rel) {
        gen.int(1) |>
          gen.and_then(\(n) {
            list(
              gen.pure(rel),
              gen.pure(n),
              gen.relation(letters[1:6], 1, 1),
              gen.pure(paste0(
                "<text>:1:5: unexpected numeric constant",
                "\n",
                "1: rel\\$", n,
                "\n",
                "        \\^"
              ))
            )
          })
      }
      gen.rel_single_exact_reassignment <- function(rel) {
        choices <- c(
          list(gen.rel_single_exact_reassignment_success_change(rel)),
          list(gen.rel_single_exact_reassignment_success_add(rel)),
          list(gen.rel_single_exact_reassignment_failure(rel))
        )
        weights <- c(40, 40, 20)
        do.call(
          gen.choice,
          c(choices, list(prob = weights))
        )
      }
      expect_rel_subset_single_exact_reassignment_success <- function(
        rel,
        ind,
        value
      ) {
        res <- rel
        eval(parse(text = paste0("res$", ind, " <- value")))
        is_valid_relation(res)
        if (ind %in% names(rel)) {
          negind <- setdiff(names(res), ind)
          expect_identical(res[negind], rel[negind])
          expect_identical(res[[ind]], setNames(value, ind))
        }else{
          expect_identical(res[names(rel)], rel)
          expect_identical(res[[ind]], setNames(value, ind))
        }
      }
      forall(
        gen.relation(letters[1:6], 1, 8) |>
          gen.and_then(gen.rel_single_exact_reassignment),
        \(rel, ind, value, error) {
          if (is.na(error)) {
            expect_rel_subset_single_exact_reassignment_success(rel, ind, value)
          }else{
            expect_error(
              eval(parse(text = paste0("rel$", ind, " <- value"))),
              paste0("^", error, "$")
            )
          }
        },
        curry = TRUE
      )
    })
  })

  it("is made unique to a valid relation", {
    forall(
      gen.relation(letters[1:6], 0, 8),
      unique %>>% is_valid_relation
    )
  })
  it("is made unique with no duplicate schemas", {
    forall(
      gen.relation(letters[1:6], 1, 8),
      \(rel) {
        rs2 <- c(rel, rel)
        expect_false(Negate(anyDuplicated)(rs2))
        expect_true(Negate(anyDuplicated)(unique(rs2)))
      }
    )
  })
  it("is made unique where tables with permuted rows count as duplicates", {
    rels <- relation(
      list(
        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"))
      ),
      "a"
    )
    expect_length(unique(rels), 1L)
  })

  it("concatenates to a valid relation schema", {
    forall(
      gen.relation(letters[1:6], from = 0, to = 4) |>
        gen.list(from = 1, to = 3),
      c %>>% with_args(is_valid_relation, single_empty_key = FALSE),
      curry = TRUE
    )
  })
  it("concatenates with duplicates preserved", {
    forall(
      gen.relation(letters[1:6], 1, 8) |>
        gen.with(\(rel) list(rel, rel)),
      \(lst) {
        expect_length(do.call(c, lst), sum(lengths(lst)))
      }
    )
  })
  it("concatenates without losing attributes", {
    concatenate_lossless_for_attrs_order <- function(...) {
      lst <- list(...)
      res <- c(...)
      for (l in lst) {
        expect_true(all(is.element(attrs_order(l), attrs_order(res))))
      }
    }
    forall(
      gen.relation(letters[1:6], from = 0, to = 8) |>
        gen.list(from = 1, to = 10),
      concatenate_lossless_for_attrs_order,
      curry = TRUE
    )
  })
  it("concatenates without losing attribute orderings, if consistent", {
    concatenate_keeps_attribute_order <- function(...) {
      lst <- list(...)
      expect_silent(res <- c(...))
      for (index in seq_along(lst)) {
        expect_identical(
          attrs_order(lst[[!!index]]),
          intersect(attrs_order(res), attrs_order(lst[[!!index]]))
        )
      }
    }

    forall(
      gen.sample(letters[1:8], gen.element(1:3)) |>
        gen.with(
          sort %>>%
            with_args(relation, relations = setNames(list(), character()))
        ) |>
        gen.list(from = 2, to = 5),
      concatenate_keeps_attribute_order,
      curry = TRUE
    )

    # example where attributes aren't consistent, but are pairwise
    schemas <- list(
      relation_schema(setNames(list(), character()), c("a", "b")),
      relation_schema(setNames(list(), character()), c("b", "c")),
      relation_schema(setNames(list(), character()), c("c", "a"))
    )
    expect_failure(do.call(concatenate_keeps_attribute_order, schemas))

    forall(
      gen.subsequence(letters[1:6]) |>
        gen.with(\(attrs) relation(setNames(list(), character()), attrs)) |>
        gen.list(from = 2, to = 10),
      concatenate_keeps_attribute_order,
      curry = TRUE
    )
  })
  it("concatenates without losing schemas", {
    concatenate_lossless_for_schemas <- function(...) {
      lst <- list(...)
      res <- c(...)
      for (l in lst) {
        sorted <- l
        # sort attrs to keep test independent from that for
        # attribute orderings
        attrs_order(sorted) <- attrs_order(res)
        expect_true(all(is.element(
          sorted,
          res
        )))
      }
    }
    forall(
      gen.relation(letters[1:6], from = 0, to = 8) |>
        gen.list(from = 1, to = 10),
      concatenate_lossless_for_schemas,
      curry = TRUE
    )
  })

  it("is composed of its records(), keys(), names(), and attrs_order()", {
    forall(
      gen.relation(letters[1:6], 0, 8),
      \(r) expect_identical(
        r,
        relation(
          setNames(
            Map(
              \(recs, ks) list(df = recs, keys = ks),
              records(r),
              keys(r)
            ),
            names(r)
          ),
          attrs_order = attrs_order(r)
        )
      )
    )
  })
  it("has record attributes given by attrs()", {
    forall(
      gen.relation(letters[1:6], 0, 8),
      \(r) expect_identical(
        attrs(r),
        lapply(records(r), names)
      )
    )
  })

  it("can have its attributes renamed", {
    forall(
      gen.relation(letters[1:6], 1, 8),
      function(rel) {
        rel2 <- rename_attrs(rel, toupper(attrs_order(rel)))
        expect_identical(
          rel2,
          relation(
            setNames(
              Map(
                \(recs, ks )list(df = recs, keys = ks),
                lapply(records(rel), \(df) `names<-`(df, toupper(names(df)))),
                lapply(keys(rel), lapply, toupper)
              ),
              names(rel)
            ),
            attrs_order = toupper(attrs_order(rel))
          )
        )
      }
    )
  })

  it("prints", {
    expect_output(
      print(relation(setNames(list(), character()), character())),
      "\\A0 relations\\n0 attributes\\Z",
      perl = TRUE
    )
    expect_output(
      print(relation(
        list(a = list(df = data.frame(a = logical(), b = logical()), keys = list("a"))),
        c("a", "b")
      )),
      paste0(
        "\\A",
        "1 relation",
        "\\n",
        "2 attributes: a, b",
        "\\n",
        "relation a: a, b; 0 records\\n  key 1: a",
        "\\Z"
      ),
      perl = TRUE
    )
    expect_output(
      print(relation(
        list(a = list(df = data.frame(a = FALSE, b = TRUE), keys = list("a"))),
        c("a", "b")
      )),
      paste0(
        "\\A",
        "1 relation",
        "\\n",
        "2 attributes: a, b",
        "\\n",
        "relation a: a, b; 1 record\\n  key 1: a",
        "\\Z"
      ),
      perl = TRUE
    )
  })
  it("can be added to a data frame as a column", {
    rel <- relation_schema(
      list(
        a_b = list(c("a", "b", "c"), list(c("a", "b"))),
        a = list(c("a", "d"), list("a"))
      ),
      letters[1:4]
    ) |>
      create()
    expect_no_error(tb <- data.frame(id = 1:2, relation = rel))
    expect_identical(tb$relation, rel)
  })
})