data <- list(
  c("a", "b", "c"),
  c("a", "b"),
  c("a", "b", "d"),
  c("b", "e"),
  c("a", "c"),
  c("c", "e"),
  c("a", "b", "d", "e")
)
names(data) <- paste("Tr", c(1:7), sep = "")
trans <- as(data, "transactions")

### rules
is <- apriori(trans,
  parameter = list(supp = 0.25, target = "frequent"),
  control = list(verb = FALSE)
)
# inspect(is)

## without transactions works with frequent and closed itemsets
r1 <- ruleInduction(is)
# inspect(r1)
#   lhs      rhs support   confidence lift
# 3  {d}   => {b} 0.2857143 1.0        1.40
# 5  {d}   => {a} 0.2857143 1.0        1.40
# 9  {b}   => {a} 0.5714286 0.8        1.12
# 10 {a}   => {b} 0.5714286 0.8        1.12
# 11 {b,d} => {a} 0.2857143 1.0        1.40
# 12 {a,d} => {b} 0.2857143 1.0        1.40

expect_equal(length(r1), 6L)
expect_true(all(quality(r1)$support >= .25))

r2 <- ruleInduction(is, confidence = 1)
# inspect(r2)
#  lhs      rhs support   confidence lift
# 3  {d}   => {b} 0.2857143 1          1.4
# 5  {d}   => {a} 0.2857143 1          1.4
# 11 {b,d} => {a} 0.2857143 1          1.4
# 12 {a,d} => {b} 0.2857143 1          1.4

expect_equal(length(r2), 4L)
expect_true(all(quality(r2)$confidence == 1))

## missing itemsets
is_incomplete <- is[labels(is) != "{a,b}"]
expect_error(r_incomplete <- ruleInduction(is_incomplete),
  regex = "cannot induce rules"
)

## missing support
is_nosupp <- is

# empty quality
quality(is_nosupp) <- data.frame()
expect_error(r_nosupp <- ruleInduction(is_nosupp), regex = "support is missing")

# no support
quality(is_nosupp) <- data.frame(weird_measure = runif(length(is_nosupp)))
# inspect(is_nosupp)
expect_error(r_nosupp <- ruleInduction(is_nosupp), regex = "support is missing")


expect_equal_rules <- function(r1, r2) {
  expect_equal(length(r1), length(r2))
  r2 <- r2[match(labels(r2), labels(r1))]
  expect_equal(labels(r1), labels(r1))
  ### Note rownames may differ in quality after matching
  q1 <- quality(r1)[, c("support", "confidence", "lift")]
  rownames(q1) <- NULL
  q2 <- quality(r2)[, c("support", "confidence", "lift")]
  rownames(q2) <- NULL
  expect_equal(q1, q2)
}

## with transactions
r1_w <- ruleInduction(is, transactions = trans)
expect_equal_rules(r1, r1_w)

r2_w <- ruleInduction(is, transactions = trans, confidence = 1)
expect_equal_rules(r2, r2_w)

r2_incomplete <- ruleInduction(is_incomplete, transactions = trans)
#> inspect(r2_incomplete)
#   lhs      rhs support   confidence lift itemset
# 3  {d}   => {b} 0.2857143 1          1.4   7
# 5  {d}   => {a} 0.2857143 1          1.4   8
# 9  {b,d} => {a} 0.2857143 1          1.4  10
# 10 {a,d} => {b} 0.2857143 1          1.4  10
expect_equal(length(r2_incomplete), 4)


r2_nosupp <- ruleInduction(is_nosupp, transactions = trans)
expect_equal_rules(r2_nosupp, r1)


## test method apriori and compare to ptree method (default)
## they all need specified transactions
r1_a <- ruleInduction(is,
  transactions = trans,
  control = list(method = "apriori")
)
expect_equal_rules(r1_a, r1)


r2_a <- ruleInduction(is,
  transactions = trans,
  control = list(method = "apriori"), confidence = 1
)
expect_equal_rules(r2_a, r2)



# test tidlists
# FIXME: tidlists does not work correctly!
# r1_t <- ruleInduction(is, transactions = trans,
#     control=list(method="tidlists"))
# expect_equal_rules(r1_t, r1)
#
# r2_t <- ruleInduction(is, transactions = trans,
#     control=list(method="tidlists"), confidence = 1)
# expect_equal_rules(r2_t, r2)

## test with problematic transactions (items have support of 0)
r_t0 <- ruleInduction(is, transactions = trans[0])
expect_equal(length(r_t0), 0L)

r_t2 <- ruleInduction(is, transactions = trans[1:2])
#> inspect(trans[1:2])
#  items   transactionID
# 1 {a,b,c} Tr1
# 2 {a,b}   Tr2

#> inspect(r_t2)
#  lhs    rhs support confidence lift itemset
# 1  {c} => {a} 0.5     1          1     6
# 9  {b} => {a} 1.0     1          1    10
# 10 {a} => {b} 1.0     1          1    10
expect_equal(length(r_t2), 3L)

# method apriori
r_t0a <- ruleInduction(is, transactions = trans[0], control = list(method = "apriori"))
expect_equal(length(r_t0a), 0L)

r_t2a <- ruleInduction(is,
  transactions = trans[1:2],
  control = list(method = "apriori")
)

## FIXME: apriori returns rules like {} -> rule induction does not!
expect_equal_rules(r_t2, r_t2a[size(r_t2a) > 1])

## test with problematic transactions (items missing, items in different order)
expect_error(ruleInduction(is, transactions = trans[, rev(1:nitems(trans))]),
  regex = "Item labels"
)

expect_error(ruleInduction(is, transactions = trans[, -2]),
  regex = "Dimensions"
)
