tests/testthat/test-functional_dependency.r

In autodb: Automatic Database Normalisation for Data Frames

describe("functional_dependency", {
  gen.fd <- function(x, from, to, unique = TRUE) {
    gen.element(x) |>
      gen.and_then(\(dependant) {
        list(
          gen.subsequence(setdiff(sample(x), dependant)),
          dependant
        )
      }) |>
      gen.list(from = from, to = to) |>
      gen.and_then(\(lst) {
        c(list(lst), list(gen.sample(unique(unlist(lst)))))
      }) |>
      gen.with(\(lst) {
        functional_dependency(lst[[1]], lst[[2]], unique = unique)
      })
  }
  it("expects valid input: FD elements correct lengths, contain characters of valid lengths", {
    expect_error(
      functional_dependency(list(NULL), character()),
      "^FDs elements must have length two: element 1$"
    )
    expect_error(
      functional_dependency(list(list(integer(), "a")), "a"),
      "^FD determinant sets must be characters: element 1$"
    )
    expect_error(
      functional_dependency(list(list(character(), 1L)), "1"),
      "^FD dependants must be length-one characters: element 1$"
    )
    expect_error(
      functional_dependency(list(list(character(), character())), character()),
      "^FD dependants must be length-one characters: element 1$"
    )
  })
  it("expects valid input: no duplicate determinants", {
    expect_error(
      functional_dependency(list(list(c("a", "a"), "b")), c("a", "b")),
      "^attributes in determinant sets must be unique: element 1$"
    )
  })
  it("expects valid input: all attributes given in attrs_order", {
    expect_error(
      functional_dependency(list(list(character(), "a")), "b"),
      "^attributes in FDs must be present in attrs_order: element 1$"
    )
  })
  it("expects valid input: no duplicates in attrs_order", {
    expect_error(
      functional_dependency(list(), c("a", "a")),
      "^attrs_order must be unique: duplicated a$"
    )
  })
  it("returns a set, i.e. no duplicated FD elements", {
    forall(
      gen.fd(letters[1:2], 2, 6),
      Negate(anyDuplicated) %>>% expect_true
    )
  })
  it("orders attributes in each determinant set with respect to order in attrs_order", {
    detset_attributes_ordered <- function(fds) {
      matches <- vapply(
        fds,
        with_args(`[[`, i = 1L) %>>%
          with_args(match, table = attrs_order(fds)) %>>%
          (Negate(is.unsorted)),
        logical(1)
      )
      expect_true(all(matches))
    }
    forall(gen.fd(letters[1:6], 0, 8), detset_attributes_ordered)
  })
  it("prints", {
    expect_output(
      print(functional_dependency(list(), character())),
      "\\A0 functional dependencies\\n0 attributes\\Z",
      perl = TRUE
    )
    expect_output(
      print(functional_dependency(list(list("a", "b")), c("a", "b"))),
      "\\A1 functional dependency\\n2 attributes: a, b\\na -> b\\Z",
      perl = TRUE
    )
  })
  it("is subsetted to a valid functional dependency object, follows usual subsetting rules", {
    forall(
      gen.fd(letters[1:6], 0, 8) |>
        gen.and_then(\(fd) list(
          gen.pure(fd),
          gen.sample_resampleable(c(FALSE, TRUE), of = length(fd))
        )),
      \(fd, i) {
        is_valid_functional_dependency(fd[i])

        inum <- which(i)
        is_valid_functional_dependency(fd[inum])
        expect_identical(fd[i], fd[inum])

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

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

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

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

        ints <- seq_along(fd)
        expect_identical(fd[[inum]], fd[[ints[[inum]]]])
        expect_identical(
          tryCatch(fd[[ineg]], error = function(e) e$message),
          tryCatch(fd[[ints[[ineg]]]], error = function(e) e$message)
        )
      },
      curry = TRUE
    )
    forall(
      gen.fd(letters[1:6], 1, 8) |>
        gen.and_then(\(fd) list(
          gen.pure(fd),
          gen.sample_resampleable(c(FALSE, TRUE), of = length(fd))
        )),
      \(fd) {
        expect_identical(fd[[TRUE]], fd[[1]])
      }
    )
  })
  it("can be subsetted while preserving attributes", {
    x <- functional_dependency(list(list("a", "b")), letters[1:5])
    expect_identical(x[TRUE], x)
    expect_identical(x[[1]], x)
    expect_error(x[[integer()]])
    expect_error(x[[c(1, 1)]])
  })
  describe("can have subsets re-assigned, without changing relation names", {
    it("[<-", {
      x <- functional_dependency(
        list(
          list("a", "b"),
          list(c("b", "c"), "d")
        ),
        letters[1:4]
      )
      x[c(1, 2, 1)] <- functional_dependency(
        list(
          list(c("a", "b"), "c"),
          list(c("b", "c"), "d"),
          list("b", "a")
        ),
        letters[1:4]
      )
      expect_identical(
        x,
        functional_dependency(
          list(
            list("b", "a"),
            list(c("b", "c"), "d")
          ),
          letters[1:4]
        )
      )
    })
    it("[[<-", {
      x <- functional_dependency(
        list(
          list("a", "b"),
          list(c("b", "c"), "d")
        ),
        letters[1:4]
      )
      x[[1]] <- functional_dependency(
        list(
          list("b", "a")
        ),
        letters[1:4]
      )
      expect_identical(
        x,
        functional_dependency(
          list(
            list("b", "a"),
            list(c("b", "c"), "d")
          ),
          letters[1:4]
        )
      )
    })
  })
  it("can be made unique within class", {
    forall(
      gen.fd(letters[1:6], 0, 8, unique = FALSE),
      unique %>>% class %>>% with_args(expect_identical, "functional_dependency")
    )
  })
  it("concatenates within class", {
    concatenate_within_class <- function(...) {
      expect_identical(class(c(...)), class(..1))
    }
    forall(
      gen.fd(letters[1:6], 0, 8) |> gen.list(from = 1, to = 10),
      concatenate_within_class,
      curry = TRUE
    )
  })
  it("concatenates with duplicates removed", {
    concatenate_unique <- function(...) {
      expect_true(!anyDuplicated(c(...)))
    }
    forall(
      gen.fd(letters[1:6], 0, 8) |> gen.list(from = 1, to = 10),
      concatenate_unique,
      curry = TRUE
    )
  })
  it("concatenates without losing attributes", {
    concatenate_lossless_for_attributes <- function(...) {
      lst <- list(...)
      res <- c(...)
      for (l in lst) {
        expect_true(all(is.element(attrs_order(l), attrs_order(res))))
      }
    }
    forall(
      gen.fd(letters[1:6], 0, 8) |> gen.list(from = 1, to = 10),
      concatenate_lossless_for_attributes,
      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(functional_dependency, FDs = list())) |>
        gen.list(from = 2, to = 5),
      concatenate_keeps_attribute_order,
      curry = TRUE
    )

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

    forall(
      gen.subsequence(letters[1:6]) |>
        gen.with(\(attrs) functional_dependency(list(), attrs)) |>
        gen.list(from = 2, to = 10),
      concatenate_keeps_attribute_order,
      curry = TRUE,
      discard.limit = 10
    )
  })
  it("concatenates without losing FDs", {
    concatenate_lossless_for_FDs <- function(...) {
      lst <- list(...)
      res <- c(...)
      for (l in lst) {
        expect_true(all(is.element(
          # sort determinant sets to keep test independent from that for
          # attribute orderings
          lapply(unclass(l), \(fd) list(sort(fd[[1]]), fd[[2]])),
          lapply(unclass(res), \(fd) list(sort(fd[[1]]), fd[[2]]))
        )))
      }
    }
    forall(
      gen.fd(letters[1:6], 0, 8) |> gen.list(from = 1, to = 10),
      concatenate_lossless_for_FDs,
      curry = TRUE
    )
  })
  it("is composed of its detset() and dependant() outputs, with attrs_order() attribute", {
    forall(
      gen.fd(letters[1:6], 0, 8),
      \(fd) expect_identical(
        fd,
        functional_dependency(
          Map(list, detset(fd), dependant(fd)),
          attrs_order = attrs_order(fd)
        )
      )
    )
  })
  it("can be added to a data frame as a column", {
    fds <- functional_dependency(
      list(list(c("a", "b"), "c"), list("a", "d")),
      letters[1:4]
    )
    expect_no_error(tb <- data.frame(id = 1:2, fd = fds))
    expect_identical(tb$fd, fds)
  })

  it("can have its attributes renamed", {
    forall(
      gen.fd(letters[1:6], 0, 8),
      function(fds) {
        fds2 <- rename_attrs(fds, toupper(attrs_order(fds)))
        expect_identical(
          fds2,
          functional_dependency(
            Map(
              list,
              lapply(detset(fds), toupper),
              toupper(dependant(fds))
            ),
            attrs_order = toupper(attrs_order(fds))
          )
        )
      }
    )
  })

  it("can be compared for equality", {
    fds <- functional_dependency(
      list(list(c("a", "b"), "c"), list("a", "d")),
      letters[1:4]
    )
    expect_true(all(fds == fds))
    expect_false(any(fds == rev(fds)))
    expect_true(all(fds != rev(fds)))
    expect_false(any(fds != fds))
  })
  it("ignores attrs_order/header when comparing for equality", {
    fds <- functional_dependency(
      list(list(c("a", "b"), "c"), list("a", "d")),
      letters[1:4]
    )
    fds2 <- fds
    attrs_order(fds2) <- letters[4:1]
    expect_true(all(fds == fds2))
    expect_false(any(fds == rev(fds2)))
    expect_true(all(fds != rev(fds2)))
    expect_false(any(fds != fds2))
  })
  it("recycles when comparing for equality", {
    fds <- functional_dependency(
      list(list(c("a", "b"), "c"), list("a", "d")),
      letters[1:4]
    )
    expect_identical(fds == fds[1], c(TRUE, FALSE))
    expect_true(all(c(fds, fds, unique = FALSE) == fds))
  })
})