tests/testthat/test-apriori.R

In mhahsler/arules: Mining Association Rules and Frequent Itemsets

library("arules")
library("testthat")

verb <- FALSE

options(digits = 2)

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 <- transactions(data)


##########################################################
# test the APRIORI interface
context("APRIORI interface")

### rules (all warnings are for low support)
r <- apriori(trans,
  parameter = list(supp = 0.25, conf = 0),
  control = list(verb = verb))

expect_identical(length(r), 18L)

#r
#summary(r)
#inspect(sort(r, by = "lift")[1:7])

### test appearance
r <- apriori(
  trans,
  parameter = list(supp = 0.25, conf = 0),
  appearance = list(rhs = c("a", "b")),
  control = list(verb = verb)
)

expect_identical(length(r), 6L)
#inspect(r)

r <- apriori(
  trans,
  parameter = list(supp = 0.25, conf = 0),
  appearance = list(lhs = c("a", "b"), rhs = "c"),
  control = list(verb = verb)
)
expect_identical(length(r), 2L)

r <- apriori(
  trans,
  parameter = list(supp = 0.25, conf = 0),
  appearance = list(none = c("a", "b")),
  control = list(verb = verb)
)
expect_identical(length(r), 3L)

expect_error(as(list(
  rhs = c("a", "b"),
  lhs = "a",
  labels = itemLabels(trans)
), "APappearance"))


### test lhs.support
r <- apriori(
  trans,
  parameter = list(
    supp = 0.25,
    conf = 0,
    originalSupp = FALSE,
    ext = TRUE
  ),
  control = list(verb = verb)
)

expect_true("coverage" %in% colnames(quality(r)))
#inspect(r[1:2])



##########################################################
# test the ECLAT interface

context("ECLAT interface")

f <- eclat(trans, control = list(verb = verb))

expect_identical(length(f), 20L)
sup <- c(
  0.14,
  0.14,
  0.14,
  0.29,
  0.29,
  0.29,
  0.14,
  0.14,
  0.29,
  0.14,
  0.14,
  0.14,
  0.14,
  0.29,
  0.57,
  0.71,
  0.71,
  0.43,
  0.43,
  0.29
)
expect_equal(round(quality(f)$support, 2), sup)
expect_equal(labels(f)[5], "{a,d}")

#f
#summary(f)
#inspect(f[1:2])
#labels(f[1:2])


### test subset
f.sub <- subset(f, subset = items %in% "a")
l <- labels(f.sub)
expect_equal(l, grep("a", l, value = T))

### test tidlists
f <-
  eclat(trans,
    parameter = list(tidLists = TRUE),
    control = list(verb = verb))

#f
#summary(f)
tl <- tidLists(f)

expect_identical(dim(tl), c(20L, 7L))

#tl
#summary(tl)
#inspect(tl)

expect_equal(as(tl[5], "list"), list('{a,d}' = c("Tr3", "Tr7")))


## Compare if APRIOR and ECLAT produce the same results
data("Income")
fsets <-
  apriori(
    Income,
    parameter = list(target = "frequ", supp = 0.2),
    control = list(verb = verb)
  )
esets <-
  eclat(
    Income,
    parameter = list(target = "frequ", supp = 0.2),
    control = list(verb = verb)
  )

## compare if output is the same
expect_true(all(table(match(fsets, esets)) == 1))

##########################################################
# test maximal and closed itemset mining

context("Maximal and closed itemsets")

is_a_freq <- apriori(trans, parameter = list(target = "frequent"), control = list(verb = verb))
is_a_max <- apriori(trans, parameter = list(target = "max"), control = list(verb = verb))
is_a_closed <- apriori(trans, parameter = list(target = "closed"), control = list(verb = verb))
is_a_gen <- apriori(trans, parameter = list(target = "generator"), control = list(verb = verb))

is_e_freq <- eclat(trans, parameter = list(target = "frequent"), control = list(verb = verb))
is_e_max <- eclat(trans, parameter = list(target = "max"), control = list(verb = verb))
is_e_closed <- eclat(trans, parameter = list(target = "closed"), control = list(verb = verb))
is_e_gen <- eclat(trans, parameter = list(target = "generator"), control = list(verb = verb))

expect_true(setequal(is_a_freq, is_e_freq))
expect_true(setequal(is_a_max, is_e_max))
expect_true(setequal(is_a_closed, is_e_closed))
expect_true(setequal(is_a_gen, is_e_gen))

#inspect(is_a_freq)
#inspect(is_e_freq)