tests/testthat/test-dig.R

In nuggets: Extensible Framework for Data Pattern Exploration

#######################################################################
# nuggets: An R framework for exploration of patterns in data
# Copyright (C) 2025 Michal Burda
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <https://www.gnu.org/licenses/>.
#######################################################################


test_that("numeric matrix", {
    m <- matrix(1:12 / 12, ncol = 2)
    res <- dig(m, function() 1)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    attributes(res) <- NULL
    expect_equal(res, rep(list(1), 4))
})


test_that("logical matrix", {
    m <- matrix(T, ncol = 4, nrow = 10)
    res <- dig(m, function() 1)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 16)

    attributes(res) <- NULL
    expect_equal(res, rep(list(1), 16))
})


test_that("logical matrix", {
    m <- matrix(rep(c(T, F), 6), ncol = 2)
    res <- dig(m, function() 1)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    attributes(res) <- NULL
    expect_equal(res, rep(list(1), 4))
})


test_that("data frame", {
    d <- data.frame(a = 1:6 / 10,
                    b = c(T, T, T, F, F, F))
    res <- dig(d, function() 1)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    attributes(res) <- NULL
    expect_equal(res, rep(list(1), 4))
})


test_that("max_results limiting", {
    d <- data.frame(a = 1:6 / 10,
                    b = c(T, T, T, F, F, F))

    res <- dig(d, function() 1, max_results = Inf)
    expect_equal(length(res), 4)

    res <- dig(d, function() 1, max_results = 1)
    expect_equal(length(res), 1)

    res <- dig(d, function() 1, max_results = 2)
    expect_equal(length(res), 2)

    res <- dig(d, function() 1, max_results = 4)
    expect_equal(length(res), 4)

    res <- dig(d, function() 1, max_results = 10)
    expect_equal(length(res), 4)
})


test_that("select condition columns", {
    m <- matrix(rep(c(T, F), 12), ncol = 3)

    res <- dig(m,
               f = function(condition) list(cond = condition),
               condition = c("1", "3"))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)
    expect_equal(attr(res, "call_function"), "dig")

    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))

    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$condition, c("1", "3"))

    attributes(res) <- NULL
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("3"=3L))))
})


test_that("select condition columns with names", {
    m <- matrix(rep(c(T, F), 12), ncol = 3)
    colnames(m) <- c("aaah", "blee", "ciis")

    res <- dig(m,
               f = function(condition) list(cond = condition),
               condition = c("aaah", "ciis"))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$condition, c("aaah", "ciis"))
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("aaah"=1L)),
                              list(cond = c("aaah"=1L, "ciis"=3L)),
                              list(cond = c("ciis"=3L))))
})


test_that("condition arg", {
    m <- matrix(1:12 / 12, ncol = 2)
    res <- dig(m, function(condition) list(cond = condition))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L, "1"=1L)),
                              list(cond = c("2"=2L))))
})


test_that("condition arg with names", {
    m <- matrix(1:12 / 12, ncol = 2)
    colnames(m) <- c("aaah", "blee")
    res <- dig(m, function(condition) list(cond = condition))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("aaah"=1L)),
                              list(cond = c("blee"=2L, "aaah"=1L)),
                              list(cond = c("blee"=2L))))
})


test_that("support arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m, function(support) list(sup = support))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    res <- res[order(unlist(res), decreasing = TRUE)]
    expect_equal(res, list(list(sup = 1),
                           list(sup = 4/6),
                           list(sup = 3/6),
                           list(sup = 2/6)),
                 tolerance = 1e-6)
})


test_that("sum arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m, function(condition, sum) list(sum = sum))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    res <- res[order(unlist(res), decreasing = TRUE)]
    expect_setequal(res, list(list(sum = 6),
                              list(sum = 4),
                              list(sum = 3),
                              list(sum = 2)))
})


test_that("indices arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m, function(indices) list(i = indices))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    res <- res[order(sapply(res, function(x) sum(x$i)), decreasing = TRUE)]
    expect_setequal(res, list(list(i = c(T,T,T,T,T,T)),
                              list(i = c(T,T,T,T,F,F)),
                              list(i = c(T,F,T,F,T,F)),
                              list(i = c(T,F,T,F,F,F))))
})


test_that("weights arg", {
    c1 <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0)
    c2 <- c(0.5, 0.6, 0.7, 0.8, 0.9, 1.0)
    m <- matrix(c(c1, c2), ncol = 2)
    res <- dig(m, function(weights) list(w = weights))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(length(res), 4)

    attributes(res) <- NULL
    expect_equal(res, list(list(w = c(1,1,1,1,1,1)),
                           list(w = c2),
                           list(w = c1 * c2),
                           list(w = c1)),
                 tolerance = 1e-6)
})


test_that("foci_supports arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m,
               f = function(foci_supports) list(fs = foci_supports),
               condition = "1",
               focus = "2")

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$condition, "1")
    expect_equal(attr(res, "call_args")$focus, "2")

    attributes(res) <- NULL
    expect_equal(length(res), 2)
    expect_equal(res, list(list(fs = c("2" = 3/6)),
                           list(fs = c("2" = 2/6))),
                 tolerance = 1e-6)
})


test_that("pp arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m,
               f = function(pp) list(fs = pp),
               condition = "1",
               focus = "2")

    attributes(res) <- NULL
    expect_equal(length(res), 2)
    expect_equal(res, list(list(fs = c("2" = 3)),
                           list(fs = c("2" = 2))),
                 tolerance = 1e-6)
})


test_that("np arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)
    res <- dig(m,
               f = function(np) list(fs = np),
               condition = "1",
               focus = "2")

    attributes(res) <- NULL
    expect_equal(length(res), 2)
    expect_equal(res, list(list(fs = c("2" = 0)),
                           list(fs = c("2" = 1))),
                 tolerance = 1e-6)
})


test_that("pn arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,F,F), ncol = 2)
    res <- dig(m,
               f = function(pn) list(fs = pn),
               condition = "1",
               focus = "2")

    attributes(res) <- NULL
    expect_equal(length(res), 2)
    expect_equal(res, list(list(fs = c("2" = 4)),
                           list(fs = c("2" = 2))),
                 tolerance = 1e-6)
})


test_that("nn arg", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,F,T), ncol = 2)
    res <- dig(m,
               f = function(nn) list(fs = nn),
               condition = "1",
               focus = "2")

    attributes(res) <- NULL
    expect_equal(length(res), 2)
    expect_equal(res, list(list(fs = c("2" = 0)),
                           list(fs = c("2" = 1))),
                 tolerance = 1e-6)
})


test_that("complex contingency table test (logical)", {
    set.seed(234)
    cols <- 5
    rows <- 65
    m <- matrix(sample(c(T, F), cols * rows, TRUE), nrow = rows)
    colnames(m) <- letters[seq_len(cols)]

    a <- m[, "a"]
    b <- m[, "b"]
    c <- m[, "c"]
    d <- m[, "d"]
    e <- m[, "e"]

    res <- dig(m,
               f = function(condition, pp, pn, np, nn) {
                   list(cond = format_condition(sort(colnames(m)[condition])),
                        a_pp = pp[1], a_pn = pn[1], a_np = np[1], a_nn = nn[1],
                        b_pp = pp[2], b_pn = pn[2], b_np = np[2], b_nn = nn[2])
               },
               condition = c:e,
               focus = a:b)
    res <- lapply(res, as.data.frame)
    res <- do.call(rbind, res)
    rownames(res) <- res$cond
    res$cond <- NULL

    expect_true(is.data.frame(res))
    expect_equal(nrow(res), 8)
    expect_equal(ncol(res), 8)

    expect_equal(res["{}", "a_pp"], sum(a), tolerance = 1e-6)
    expect_equal(res["{}", "a_pn"], sum(!a), tolerance = 1e-6)
    expect_equal(res["{}", "a_np"], 0, tolerance = 1e-6)
    expect_equal(res["{}", "a_nn"], 0, tolerance = 1e-6)

    expect_equal(res["{}", "b_pp"], sum(b), tolerance = 1e-6)
    expect_equal(res["{}", "b_pn"], sum(!b), tolerance = 1e-6)
    expect_equal(res["{}", "b_np"], 0, tolerance = 1e-6)
    expect_equal(res["{}", "b_nn"], 0, tolerance = 1e-6)

    expect_equal(res["{d}", "a_pp"], sum(d & a), tolerance = 1e-6)
    expect_equal(res["{d}", "a_pn"], sum(d & !a), tolerance = 1e-6)
    expect_equal(res["{d}", "a_np"], sum(!d & a), tolerance = 1e-6)
    expect_equal(res["{d}", "a_nn"], sum(!d & !a), tolerance = 1e-6)

    expect_equal(res["{d}", "b_pp"], sum(d & b), tolerance = 1e-6)
    expect_equal(res["{d}", "b_pn"], sum(d & !b), tolerance = 1e-6)
    expect_equal(res["{d}", "b_np"], sum(!d & b), tolerance = 1e-6)
    expect_equal(res["{d}", "b_nn"], sum(!d & !b), tolerance = 1e-6)

    expect_equal(res["{d,e}", "a_pp"], sum(e & d & a), tolerance = 1e-6)
    expect_equal(res["{d,e}", "a_pn"], sum(e & d & !a), tolerance = 1e-6)
    expect_equal(res["{d,e}", "a_np"], sum(!(e & d) & a), tolerance = 1e-6)
    expect_equal(res["{d,e}", "a_nn"], sum(!(e & d) & !a), tolerance = 1e-6)

    expect_equal(res["{d,e}", "b_pp"], sum(e & d & b), tolerance = 1e-6)
    expect_equal(res["{d,e}", "b_pn"], sum(e & d & !b), tolerance = 1e-6)
    expect_equal(res["{d,e}", "b_np"], sum(!(e & d) & b), tolerance = 1e-6)
    expect_equal(res["{d,e}", "b_nn"], sum(!(e & d) & !b), tolerance = 1e-6)

    expect_equal(res["{c,d,e}", "a_pp"], sum(e & c & d & a), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "a_pn"], sum(e & c & d & !a), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "a_np"], sum(!(e & c & d) & a), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "a_nn"], sum(!(e & c & d) & !a), tolerance = 1e-6)

    expect_equal(res["{c,d,e}", "b_pp"], sum(e & c & d & b), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "b_pn"], sum(e & c & d & !b), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "b_np"], sum(!(e & c & d) & b), tolerance = 1e-6)
    expect_equal(res["{c,d,e}", "b_nn"], sum(!(e & c & d) & !b), tolerance = 1e-6)
})


test_that("complex contingency table test (numeric)", {
    set.seed(234)
    cols <- 5
    rows <- 65
    m <- matrix(sample(c(0:10) / 10, cols * rows, TRUE), nrow = rows)
    colnames(m) <- letters[seq_len(cols)]

    a <- m[, "a"]
    b <- m[, "b"]
    c <- m[, "c"]
    d <- m[, "d"]
    e <- m[, "e"]

    res <- dig(m,
               f = function(condition, pp, pn, np, nn) {
                   list(cond = format_condition(sort(colnames(m)[condition])),
                        a_pp = pp[1], a_pn = pn[1], a_np = np[1], a_nn = nn[1],
                        b_pp = pp[2], b_pn = pn[2], b_np = np[2], b_nn = nn[2])
               },
               condition = c:e,
               focus = a:b,
               t_norm = "goedel")
    res <- lapply(res, as.data.frame)
    res <- do.call(rbind, res)
    rownames(res) <- res$cond
    res$cond <- NULL

    expect_true(is.data.frame(res))
    expect_equal(nrow(res), 8)
    expect_equal(ncol(res), 8)

    expect_equal(res["{}", "a_pp"], sum(a), tolerance = 1e-2)
    expect_equal(res["{}", "a_pn"], sum(1 - a), tolerance = 1e-2)
    expect_equal(res["{}", "a_np"], 0, tolerance = 1e-2)
    expect_equal(res["{}", "a_nn"], 0, tolerance = 1e-2)

    expect_equal(res["{}", "b_pp"], sum(b), tolerance = 1e-2)
    expect_equal(res["{}", "b_pn"], sum(1 - b), tolerance = 1e-2)
    expect_equal(res["{}", "b_np"], 0, tolerance = 1e-2)
    expect_equal(res["{}", "b_nn"], 0, tolerance = 1e-2)

    pp <- sum(pmin(d, a))
    expect_equal(res["{d}", "a_pp"], pp, tolerance = 1e-2)
    expect_equal(res["{d}", "a_pn"], sum(d) - pp, tolerance = 1e-2)
    expect_equal(res["{d}", "a_np"], sum(a) - pp, tolerance = 1e-2)
    expect_equal(res["{d}", "a_nn"], nrow(m) - sum(d) - sum(a) + pp, tolerance = 1e-1)

    pp <- sum(pmin(d, b))
    expect_equal(res["{d}", "b_pp"], pp, tolerance = 1e-2)
    expect_equal(res["{d}", "b_pn"], sum(d) - pp, tolerance = 1e-2)
    expect_equal(res["{d}", "b_np"], sum(b) - pp, tolerance = 1e-2)
    expect_equal(res["{d}", "b_nn"], nrow(m) - sum(d) - sum(b) + pp, tolerance = 1e-1)

    pp <- sum(pmin(e, d, a))
    expect_equal(res["{d,e}", "a_pp"], pp, tolerance = 1e-1)
    expect_equal(res["{d,e}", "a_pn"], sum(pmin(e, d)) - pp, tolerance = 1e-2)
    expect_equal(res["{d,e}", "a_np"], sum(a) - pp, tolerance = 1e-2)
    expect_equal(res["{d,e}", "a_nn"], nrow(m) - sum(pmin(e, d)) - sum(a) + pp, tolerance = 1e-2)

    pp <- sum(pmin(e, d, b))
    expect_equal(res["{d,e}", "b_pp"], pp, tolerance = 1e-1)
    expect_equal(res["{d,e}", "b_pn"], sum(pmin(e, d)) - pp, tolerance = 1e-2)
    expect_equal(res["{d,e}", "b_np"], sum(b) - pp, tolerance = 1e-2)
    expect_equal(res["{d,e}", "b_nn"], nrow(m) - sum(pmin(e, d)) - sum(b) + pp, tolerance = 1e-2)

    pp <- sum(pmin(e, d, c, a))
    expect_equal(res["{c,d,e}", "a_pp"], pp, tolerance = 1e-1)
    expect_equal(res["{c,d,e}", "a_pn"], sum(pmin(e, c, d)) - pp, tolerance = 1e-2)
    expect_equal(res["{c,d,e}", "a_np"], sum(a) - pp, tolerance = 1e-2)
    expect_equal(res["{c,d,e}", "a_nn"], nrow(m) - sum(pmin(c, d, e)) - sum(a) + pp, tolerance = 1e-2)

    pp <- sum(pmin(e, d, c, b))
    expect_equal(res["{c,d,e}", "b_pp"], pp, tolerance = 1e-1)
    expect_equal(res["{c,d,e}", "b_pn"], sum(pmin(e, c, d)) - pp, tolerance = 1e-2)
    expect_equal(res["{c,d,e}", "b_np"], sum(b) - pp, tolerance = 1e-2)
    expect_equal(res["{c,d,e}", "b_nn"], nrow(m) - sum(pmin(c, d, e)) - sum(b) + pp, tolerance = 1e-2)
})


test_that("min_length filter", {
    m <- matrix(1:12 / 12, ncol = 2)

    res <- dig(m, function() 1, min_length = 0L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_length, 0L)
    expect_equal(length(res), 4)

    res <- dig(m, function() 1, min_length = 1L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_length, 1L)
    expect_equal(length(res), 3)

    res <- dig(m, function() 1, min_length = 2L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_length, 2L)
    expect_equal(length(res), 1)

    res <- dig(m, function() 1, min_length = 3L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_length, 3L)
    expect_equal(length(res), 0)
})


test_that("max_length filter", {
    m <- matrix(1:12 / 12, ncol = 2)

    res <- dig(m, function() 1, max_length = 0L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_length, 0L)
    expect_equal(length(res), 1)

    res <- dig(m, function() 1, max_length = 1L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_length, 1L)
    expect_equal(length(res), 3)

    res <- dig(m, function() 1, max_length = 2L)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_length, 2L)
    expect_equal(length(res), 4)

    res <- dig(m, function() 1, max_length = Inf)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_length, Inf)
    expect_equal(length(res), 4)
})


test_that("min_support filter", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)

    res <- dig(m, function() 1, min_support = 0)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0)
    expect_equal(length(res), 4)

    res <- dig(m, function() 1, min_support = 0.001)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.001)
    expect_equal(length(res), 4)

    res <- dig(m, function() 1, min_support = 0.5)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.5)
    expect_equal(length(res), 3)

    res <- dig(m, function() 1, min_support = 0.6)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.6)
    expect_equal(length(res), 2)

    res <- dig(m, function() 1, min_support = 1)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 1)
    expect_equal(length(res), 1)
})


test_that("max_support filter", {
    m <- matrix(c(T,T,T,T,F,F, T,F,T,F,T,F), ncol = 2)

    res <- dig(m, function() 1, max_support = 1)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_support, 1)
    expect_equal(length(res), 4)

    res <- dig(m, function(condition, support) list(con=condition, sup=support), max_support = 0.7)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_support, 0.7)
    expect_equal(length(res), 3)

    res <- dig(m, function() 1, max_support = 0.6)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_support, 0.6)
    expect_equal(length(res), 2)

    res <- dig(m, function() 1, max_support = 0.4)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_support, 0.4)
    expect_equal(length(res), 1)

    res <- dig(m, function() 1, max_support = 0.3)
    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$max_support, 0.3)
    expect_equal(length(res), 0)
})


test_that("disjoint filter", {
    m <- matrix(T, ncol = 3)

    res <- dig(m, function() 1)
    expect_equal(length(res), 8)

    # disjoint 1, 2, 3
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = c(1, 2, 3))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, 1:3)
    expect_equal(length(res), 8)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("2"=2L, "3"=3L)),
                              list(cond = c("1"=1L, "2"=2L)),
                              list(cond = c("1"=1L, "2"=2L, "3"=3L))))

    # disjoint 1, 1, 2
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = c(1, 1, 2))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, c(1, 1, 2))
    expect_equal(length(res), 6)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("2"=2L, "3"=3L))))

    # disjoint 1, 1, 1
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = c(1, 1, 1))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, c(1, 1, 1))
    expect_equal(length(res), 4)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L))))


    # disjoint 1, 1, 2 with condition and focus
    m <- m[, c(1:3, 1:3), drop = FALSE]
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = c(1, 1, 2, 3, 4, 5),
               condition = 1:3,
               focus = 4:6)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, c(1, 1, 2, 3, 4, 5))
    expect_equal(attr(res, "call_args")$condition, c("1", "2", "3"))
    expect_equal(attr(res, "call_args")$focus, c("4", "5", "6"))
    expect_equal(length(res), 6)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("2"=2L, "3"=3L))))
})


test_that("disjoint is factor", {
    m <- matrix(T, ncol = 3)

    res <- dig(m, function() 1)
    expect_equal(length(res), 8)

    # disjoint 1, 2, 3
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = factor(c(1, 2, 3)))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, factor(c(1, 2, 3)))
    expect_equal(length(res), 8)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("2"=2L, "3"=3L)),
                              list(cond = c("1"=1L, "2"=2L)),
                              list(cond = c("1"=1L, "2"=2L, "3"=3L))))

    # disjoint 1, 1, 2
    res <- dig(m,
               function(condition) list(cond = condition),
               disjoint = factor(c(1, 1, 2)))

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$disjoint, factor(c(1, 1, 2)))
    expect_equal(length(res), 6)
    expect_setequal(res, list(list(cond = integer(0)),
                              list(cond = c("1"=1L)),
                              list(cond = c("2"=2L)),
                              list(cond = c("3"=3L)),
                              list(cond = c("1"=1L, "3"=3L)),
                              list(cond = c("2"=2L, "3"=3L))))
})


test_that("conditions and foci are disjoint", {
    d <- data.frame(a = c(T,    T, T, F, F),
                    b = c(T,    F, T, T, T),
                    c = c(T,    T, F, F, F),
                    d = c(T,    F, F, F, F))

    f <- function(condition, foci_supports) {
        paste(paste(sort(names(condition)), collapse = "&"),
              "~",
              paste(sort(names(foci_supports)), collapse = "|"))
    }

    expected <- c(" ~ a|b|c|d",
                  "a ~ c|d",
                  "b ~ c|d",
                  "c ~ a|b|d",
                  "d ~ a|b|c",
                  "a&c ~ d",
                  "a&d ~ c",
                  "b&c ~ d",
                  "b&d ~ c",
                  "c&d ~ a|b",
                  "a&c&d ~ ",
                  "b&c&d ~ ")

    res <- dig(d,
               f,
               condition = everything(),
               focus = everything(),
               disjoint = c(1, 1, 2, 3))
    res <- unlist(res)

    expect_equal(sort(res), sort(expected))
})


test_that("conditions and foci are disjoint even if disjoints are not defined", {
    d <- data.frame(a = c(T,    T, T, F, F),
                    b = c(T,    F, T, T, T),
                    c = c(T,    T, F, F, F))

    f <- function(condition, foci_supports) {
        paste(paste(sort(names(condition)), collapse = "&"),
              "~",
              paste(sort(names(foci_supports)), collapse = "|"))
    }

    expected <- c(" ~ a|b|c",
                  "a ~ b|c",
                  "b ~ a|c",
                  "c ~ a|b",
                  "a&b ~ c",
                  "a&c ~ b",
                  "b&c ~ a",
                  "a&b&c ~ ")

    res <- dig(d,
               f,
               condition = everything(),
               focus = everything(),
               disjoint = NULL)
    res <- unlist(res)

    expect_equal(sort(res), sort(expected))
})


test_that("data frame select & disjoint", {
    set.seed(32344)

    d <- data.frame(a = c(T,    T, T, F, F),
                    b = c(T,    F, T, T, T),
                    c = c(T,    T, F, F, F),
                    d = c(T,    F, F, F, F),
                    x = c(1.0,  0.1, 0.2, 0.3, 0.4),
                    y = c(1.0,  0.9, 0.8, 0.7, 0.6),
                    z = c(1.0,  0.8, 0.6, 0.4, 0.2),
                    w = c(1.0,  0, 0, 0, 0))

    f <- function(condition, support) {
        paste(paste(sort(names(condition)), collapse = " & "),
              "=",
              round(support, 2))
    }

    disjoint <- c(1, 1, 2, 3,  5, 5, 6, 7)

    expected <- c("a = 0.6", "b = 0.8", "c = 0.4", "x = 0.4", "y = 0.8", "z = 0.6",
                  "a & c = 0.4", "a & x = 0.26", "a & y = 0.54", "a & z = 0.48",
                  "b & c = 0.2", "b & x = 0.38", "b & y = 0.62", "b & z = 0.44",
                  "c & x = 0.22", "c & y = 0.38", "c & z = 0.36",
                  "x & z = 0.28",
                  "y & z = 0.52")

    # permutation 1
    perm <- seq_along(d)
    res <- dig(d[, perm],
               f,
               condition = c(a, b, c, x, y, z),
               disjoint = disjoint[perm],
               min_length = 1,
               max_length = 2)
    expect_equal(sort(unlist(res)), sort(expected))

    # permutation 2
    perm <- sample(perm)
    res <- dig(d[, perm],
               f,
               condition = c(a, b, c, x, y, z),
               disjoint = disjoint[perm],
               min_length = 1,
               max_length = 2)
    expect_equal(sort(unlist(res)), sort(expected))

    # permutation 3
    perm <- sample(perm)
    res <- dig(d[, perm],
               f,
               condition = c(a, b, c, x, y, z),
               disjoint = disjoint[perm],
               min_length = 1,
               max_length = 2)
    expect_equal(sort(unlist(res)), sort(expected))

    # permuted condition 1
    res <- dig(d[, perm],
               f,
               condition = c(x, y, z, a, b, c),
               disjoint = disjoint[perm],
               min_length = 1,
               max_length = 2)
    expect_equal(sort(unlist(res)), sort(expected))

    # permuted condition 2
    res <- dig(d[, perm],
               f,
               condition = c(x, a, y, b, z, c),
               disjoint = disjoint[perm],
               min_length = 1,
               max_length = 2)
    expect_equal(sort(unlist(res)), sort(expected))
})


test_that("exclude tautology 1", {
    d <- data.frame(a = c(T,    T, T, F, F),
                    b = c(T,    F, T, T, T),
                    c = c(T,    T, F, F, F),
                    d = c(T,    F, F, F, F),
                    x = c(1.0,  0.1, 0.2, 0.3, 0.4),
                    y = c(1.0,  0.9, 0.8, 0.7, 0.6),
                    z = c(1.0,  0.8, 0.6, 0.4, 0.2),
                    w = c(1.0,  0, 0, 0, 0))

    comb <- function(ante, n) {
        res <- combn(ante, n)
        apply(res, 2, function(w) {
            w <- sort(w)
            paste(w, collapse = " & ")
        })
    }

    comb2 <- function(ante, n, conseq) {
        result <- lapply(conseq, function(cc) {
            a <- setdiff(ante, cc)
            res <- comb(a, n)
            paste(res, "|", cc)
        })

        unlist(result)
    }

    f <- function(condition, foci_supports) {
        paste(paste(sort(names(condition)), collapse = " & "),
              "|",
              sort(names(foci_supports)))
    }

    sel <- c("a", "b", "c", "x", "y", "z")
    selnoX <- c("a", "b", "c", "y", "z")
    selnoC <- c("a", "b", "x", "y", "z")

    # no exclude
    expected <- c(comb2(sel, 1, sel),
                  comb2(sel, 2, sel),
                  comb2(sel, 3, sel))
    res <- dig(d,
               f,
               condition = c(a, b, c, x, y, z),
               focus = c(a, b, c, x, y, z),
               min_length = 1,
               max_length = 3)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(d))
    expect_equal(attr(res, "call_data")$ncol, ncol(d))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(d)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "d")
    expect_equal(attr(res, "call_args")$condition, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$focus, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$min_length, 1)
    expect_equal(attr(res, "call_args")$max_length, 3)
    expect_equal(attr(res, "call_args")$excluded, NULL)
    expect_equal(sort(unlist(res)), sort(expected))


    # exclude "-> x"
    expected <- c(comb2(selnoX, 1, selnoX),
                  comb2(selnoX, 2, selnoX),
                  comb2(selnoX, 3, selnoX))
    res <- dig(d,
               f,
               condition = c(a, b, c, x, y, z),
               focus = c(a, b, c, x, y, z),
               excluded = list(c("x")),
               min_length = 1,
               max_length = 3)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(d))
    expect_equal(attr(res, "call_data")$ncol, ncol(d))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(d)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "d")
    expect_equal(attr(res, "call_args")$condition, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$focus, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$min_length, 1)
    expect_equal(attr(res, "call_args")$max_length, 3)
    expect_equal(attr(res, "call_args")$excluded, list("x"))
    expect_equal(sort(unlist(res)), sort(expected))

    # exclude "c -> x"
    expected <- c(setdiff(comb2(sel, 1, sel),
                          c("c | x")),
                  setdiff(comb2(sel, 2, sel),
                          c("a & c | x", "b & c | x", "c & y | x", "c & z | x",
                            "c & x | a", "c & x | b", "c & x | y", "c & x | z")),
                  setdiff(comb2(sel, 3, sel),
                          c("a & b & c | x", "a & c & y | x", "a & c & z | x", "b & c & y | x", "b & c & z | x", "c & y & z | x",
                            "a & c & x | b", "a & c & x | y", "a & c & x | z",
                            "b & c & x | a", "b & c & x | y", "b & c & x | z",
                            "c & x & y | a", "c & x & y | b", "c & x & y | z",
                            "c & x & z | a", "c & x & z | b", "c & x & z | y")))

    res <- dig(d,
               f,
               condition = c(a, b, c, x, y, z),
               focus = c(a, b, c, x, y, z),
               excluded = list(c("c", "x")),
               min_length = 1,
               max_length = 3)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(d))
    expect_equal(attr(res, "call_data")$ncol, ncol(d))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(d)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "d")
    expect_equal(attr(res, "call_args")$condition, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$focus, c("a", "b", "c", "x", "y", "z"))
    expect_equal(attr(res, "call_args")$min_length, 1)
    expect_equal(attr(res, "call_args")$max_length, 3)
    expect_equal(attr(res, "call_args")$excluded, list(c("c", "x")))
    expect_equal(sort(unlist(res)), sort(expected))
})


test_that("t-norm goedel", {
    c1 <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0)
    c2 <- c(0.5, 0.6, 0.7, 0.8, 0.9, 1.0)
    m <- matrix(c(c1, c2), ncol = 2)

    res <- dig(m,
               function(weights) list(w = weights),
               min_length = 2,
               t_norm = "goedel")

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$t_norm, "goedel")

    attributes(res) <- NULL
    expect_equal(length(res), 1)
    expect_equal(res, list(list(w = pmin(c1, c2))),
                 tolerance = 1e-2)
})


test_that("t-norm goguen", {
    c1 <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0)
    c2 <- c(0.5, 0.6, 0.7, 0.8, 0.9, 1.0)
    m <- matrix(c(c1, c2), ncol = 2)

    res <- dig(m,
               function(weights) list(w = weights),
               min_length = 2,
               t_norm = "goguen")

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$t_norm, "goguen")

    attributes(res) <- NULL
    expect_equal(length(res), 1)
    expect_equal(res, list(list(w = c1 * c2)),
                 tolerance = 1e-2)
})


test_that("t-norm lukas", {
    c1 <- c(0.0, 0.2, 0.4, 0.6, 0.8, 1.0)
    c2 <- c(0.5, 0.6, 0.7, 0.8, 0.9, 1.0)
    m <- matrix(c(c1, c2), ncol = 2)

    res <- dig(m,
               function(weights) list(w = weights),
               min_length = 2,
               t_norm = "lukas")

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$t_norm, "lukas")

    attributes(res) <- NULL
    expect_equal(length(res), 1)
    expect_equal(res, list(list(w = pmax(0, c1 + c2 - 1))),
                 tolerance = 0.018)
})


#test_that("multithread", {
#    m <- matrix(T, ncol = 10, nrow=100)
#
#    res <- dig(m, function() 1, threads = 24)
#    expect_equal(length(res), 1024)
#})


test_that("min_focus_support & filter_empty_foci", {
    m <- matrix(c(c(1,1,1,1,1,1,1,1,0,0),
                  c(1,1,1,1,1,1,0,0,1,1),
                  c(0,0,0,1,1,1,1,1,1,1),
                  c(0,0,0,0,1,1,1,1,1,1)), ncol = 4)

    f <- function(condition, foci_supports) {
       paste(paste(condition, collapse = " & "),
             "=",
             paste(round(foci_supports, 1), collapse = ", "))
    }

    res <- dig(m,
               f,
               condition = 1:2,
               focus = 3:4,
               min_support = 0.1,
               min_focus_support = 0.5,
               filter_empty_foci = FALSE)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.1)
    expect_equal(attr(res, "call_args")$min_focus_support, 0.5)
    expect_equal(attr(res, "call_args")$filter_empty_foci, FALSE)

    expect_setequal(unlist(res),
                    c(" = 0.7, 0.6", "1 = 0.5", "2 = 0.5", "1 & 2 = "))

    res <- dig(m,
               f,
               condition = 1:2,
               focus = 3:4,
               min_support = 0.1,
               min_focus_support = 0.5,
               filter_empty_foci = TRUE)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.1)
    expect_equal(attr(res, "call_args")$min_focus_support, 0.5)
    expect_equal(attr(res, "call_args")$filter_empty_foci, TRUE)

    expect_setequal(unlist(res),
                    c(" = 0.7, 0.6", "1 = 0.5", "2 = 0.5"))
})


test_that("min_conditional_focus_support & filter_empty_foci", {
    m <- matrix(c(c(1,1,1,1,1,1,1,1,0,0),
                  c(1,1,1,1,1,1,0,0,1,1),
                  c(0,0,0,1,1,1,1,1,1,1),
                  c(0,0,0,0,1,1,1,1,1,1)), ncol = 4)

    f <- function(condition, support, foci_supports) {
       paste(paste(condition, collapse = " & "),
             ":", round(support, 1),
             "=",
             paste0(names(foci_supports), "/", round(foci_supports, 1), collapse = ", "))
    }

    res <- dig(m,
               f,
               condition = 1:2,
               focus = 3:4,
               min_support = 0.1,
               min_conditional_focus_support = 0.6,
               filter_empty_foci = FALSE)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.1)
    expect_equal(attr(res, "call_args")$min_conditional_focus_support, 0.6)
    expect_equal(attr(res, "call_args")$filter_empty_foci, FALSE)

    expect_setequal(unlist(res),
                    c(" : 1 = 3/0.7, 4/0.6", "1 : 0.8 = 3/0.5", "2 : 0.8 = 3/0.5", "1 & 2 : 0.6 = /"))

    res <- dig(m,
               f,
               condition = 1:2,
               focus = 3:4,
               min_support = 0.1,
               min_conditional_focus_support = 0.6,
               filter_empty_foci = TRUE)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(m))
    expect_equal(attr(res, "call_data")$ncol, ncol(m))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(m)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "m")
    expect_equal(attr(res, "call_args")$min_support, 0.1)
    expect_equal(attr(res, "call_args")$min_conditional_focus_support, 0.6)
    expect_equal(attr(res, "call_args")$filter_empty_foci, TRUE)

    expect_setequal(unlist(res),
                    c(" : 1 = 3/0.7, 4/0.6", "1 : 0.8 = 3/0.5", "2 : 0.8 = 3/0.5"))
})


test_that("dig return object details", {
    d <- data.frame(a = c(T,    T, T, F, F),
                    b = c(T,    F, T, T, T),
                    c = c(T,    T, F, F, F),
                    d = c(T,    F, F, F, F),
                    x = c(1.0,  0.1, 0.2, 0.3, 0.4),
                    y = c(1.0,  0.9, 0.8, 0.7, 0.6),
                    z = c(1.0,  0.8, 0.6, 0.4, 0.2),
                    w = c(1.0,  0, 0, 0, 0))

    res <- dig(d,
               f = function(condition) list(cond = condition),
               condition = a:d,
               focus = x:z,
               disjoint = c(1, 1, 2, 3, 5, 5, 6, 7),
               excluded = list(c("x")),
               min_length = 1,
               max_length = 3,
               min_support = 0.1,
               min_focus_support = 0.5,
               min_conditional_focus_support = 0.6,
               max_support = 0.99,
               filter_empty_foci = TRUE,
               t_norm = "goedel",
               max_results = 1000,
               verbose = TRUE,
               threads = 1)

    expect_true(is_nugget(res))
    expect_true(is.list(res))
    expect_equal(attr(res, "call_function"), "dig")
    expect_true(is.list(attr(res, "call_data")))
    expect_equal(attr(res, "call_data")$nrow, nrow(d))
    expect_equal(attr(res, "call_data")$ncol, ncol(d))
    expect_equal(attr(res, "call_data")$colnames, as.character(colnames(d)))
    expect_true(is.list(attr(res, "call_args")))
    expect_equal(attr(res, "call_args")$x, "d")
    expect_equal(attr(res, "call_args")$condition, c("a", "b", "c", "d"))
    expect_equal(attr(res, "call_args")$focus, c("x", "y", "z"))
    expect_equal(attr(res, "call_args")$disjoint, c(1, 1, 2, 3, 5, 5, 6, 7))
    expect_equal(attr(res, "call_args")$excluded, list("x"))
    expect_equal(attr(res, "call_args")$min_length, 1)
    expect_equal(attr(res, "call_args")$max_length, 3)
    expect_equal(attr(res, "call_args")$min_support, 0.1)
    expect_equal(attr(res, "call_args")$min_focus_support, 0.5)
    expect_equal(attr(res, "call_args")$min_conditional_focus_support, 0.6)
    expect_equal(attr(res, "call_args")$max_support, 0.99)
    expect_equal(attr(res, "call_args")$filter_empty_foci, TRUE)
    expect_equal(attr(res, "call_args")$t_norm, "goedel")
    expect_equal(attr(res, "call_args")$max_results, 1000)
    expect_equal(attr(res, "call_args")$verbose, TRUE)
    expect_equal(attr(res, "call_args")$threads, 1)
})


test_that("errors", {
    f <- function(condition) { list() }
    d <- data.frame(n = 1:5 / 5, l = TRUE, i = 1:5, s = letters[1:5])

    expect_error(dig(list(), f), "`x` must be a matrix or a data frame.")
    expect_error(dig(matrix(0, nrow = 5, ncol = 0), f), "`x` must have at least one column.")
    expect_error(dig(matrix(0, nrow = 0, ncol = 5), f), "`x` must have at least one row.")

    expect_true(is.list(dig(d, f, condition = c(n, l))))
    expect_error(dig(d, f, condition = c(n, l, i)),
                 "All columns selected by `condition` must be logical or numeric")
    expect_error(dig(d, f, condition = c(n, l, s)),
                 "All columns selected by `condition` must be logical or numeric")

    expect_true(is.list(dig(d, f, condition = c(n, l), focus = c(n, l))))
    expect_error(dig(d, f, condition = c(n, l), focus = c(n, l, i)),
                 "All columns selected by `focus` must be logical or numeric")
    expect_error(dig(d, f, condition = c(n, l), focus = c(n, l, s)),
                 "All columns selected by `focus` must be logical or numeric")

    expect_error(dig(d, f = "x", condition = n),
                 "`f` must be a function.")
    expect_error(dig(d, f = function(a) { }, condition = n),
                 "Function `f` is allowed to have the following arguments")
    expect_error(dig(d, f, condition = n, disjoint = list("x")),
                 "`disjoint` must be a plain vector")
    expect_error(dig(d, f, condition = n, excluded = 3),
                 "`excluded` must be a list or NULL.")
    expect_error(dig(d, f, condition = n, excluded = list(3)),
                 "`excluded` must be a list of character vectors.")
    expect_error(dig(d, f, condition = n, disjoint = "x"),
                 "The length of `disjoint` must be 0 or must be equal to the number of columns in `x`.")
    expect_error(dig(d, f, condition = n, min_length = "x"),
                 "`min_length` must be an integerish scalar.")
    expect_error(dig(d, f, condition = n, min_length = Inf),
                 "`min_length` must be finite.")
    expect_error(dig(d, f, condition = n, min_length = -1),
                 "`min_length` must be >= 0.")
    expect_error(dig(d, f, condition = n, max_length = "x"),
                 "`max_length` must be an integerish scalar.")
    expect_error(dig(d, f, condition = n, max_length = -1),
                 "`max_length` must be >= 0.")
    expect_error(dig(d, f, condition = n, min_length = 5, max_length = 4),
                 "`max_length` must be greater or equal to `min_length`.")
    expect_error(dig(d, f, condition = n, min_support = "x"),
                 "`min_support` must be a double scalar.")
    expect_error(dig(d, f, condition = n, min_support = 1.1),
                 "`min_support` must be between 0 and 1.")
    expect_error(dig(d, f, condition = n, min_focus_support = "x"),
                 "`min_focus_support` must be a double scalar.")
    expect_error(dig(d, f, condition = n, min_focus_support = 1.1),
                 "`min_focus_support` must be between 0 and 1.")
    expect_error(dig(d, f, condition = n, filter_empty_foci = "x"),
                 "`filter_empty_foci` must be a flag")
    expect_error(dig(d, f, condition = n, t_norm = "x"),
                 "`t_norm` must be equal to one of:")
    expect_error(dig(d, f, condition = n, max_results = -1),
                 "`max_results` must be >= 1.")
    expect_error(dig(d, f, condition = n, verbose = "x"),
                 "`verbose` must be a flag")
    expect_error(dig(d, f, condition = n, threads = "x"),
                 "`threads` must be an integerish scalar.")
    expect_error(dig(d, f, condition = n, threads = 0),
                 "`threads` must be >= 1.")
    expect_error(dig(d, f, condition = n, excluded = FALSE),
                 "`excluded` must be a list or NULL.")
    expect_error(dig(d, f, condition = n, excluded = list(c(FALSE, TRUE))),
                 "`excluded` must be a list of character vectors.")
    expect_error(dig(d, f, condition = n, excluded = list(c("n", "l", "foo"))),
                 "Can't find some column names in `x` that correspond to all predicates in `excluded`.")
})


test_that("bug on mixed logical and numeric chains", {
    fuzzyCO2 <- CO2 |>
        partition(Plant:Treatment) |>
        partition(conc, .method = "triangle", .breaks = c(-Inf, 175, 350, 675, Inf)) |>
        partition(uptake, .method = "triangle", .breaks = c(-Inf, 18, 28, 37, Inf))

    disj <- sub("=.*", "", colnames(fuzzyCO2))

    result <- dig_associations(fuzzyCO2,
                               antecedent = !starts_with("Treatment"),
                               consequent = starts_with("Treatment"),
                               disjoint = disj,
                               min_support = 0.02,
                               min_confidence = 0.8)

    expect_true(is_tibble(result))
})