arules.R
In arules: Mining Association Rules and Frequent Itemsets

### R code from vignette source 'arules.Rnw'

###################################################
### code chunk number 1: arules.Rnw:73-76
###################################################
options(width = 75)
### for sampling
set.seed <- 1234


###################################################
### code chunk number 2: arules.Rnw:1172-1173
###################################################
library("arules")


###################################################
### code chunk number 3: epub1
###################################################
data("Epub")
Epub


###################################################
### code chunk number 4: epub2
###################################################
summary(Epub)


###################################################
### code chunk number 5: arules.Rnw:1198-1200
###################################################
year <- strftime(as.POSIXlt(transactionInfo(Epub)[["TimeStamp"]]), "%Y")
table(year)


###################################################
### code chunk number 6: arules.Rnw:1208-1211
###################################################
Epub2003 <- Epub[year == "2003"]
length(Epub2003)
image(Epub2003)


###################################################
### code chunk number 7: epub
###################################################
print(image(Epub2003))


###################################################
### code chunk number 8: arules.Rnw:1237-1238
###################################################
transactionInfo(Epub2003[size(Epub2003) > 20])


###################################################
### code chunk number 9: arules.Rnw:1250-1251
###################################################
inspect(Epub2003[1:5])


###################################################
### code chunk number 10: arules.Rnw:1257-1258
###################################################
as(Epub2003[1:5], "list")


###################################################
### code chunk number 11: arules.Rnw:1264-1266
###################################################
EpubTidLists <- as(Epub, "tidLists")
EpubTidLists


###################################################
### code chunk number 12: arules.Rnw:1273-1274
###################################################
as(EpubTidLists[1:3], "list") 


###################################################
### code chunk number 13: data
###################################################
data("AdultUCI")
dim(AdultUCI)
AdultUCI[1:2,]


###################################################
### code chunk number 14: arules.Rnw:1323-1325
###################################################
AdultUCI[["fnlwgt"]] <- NULL
AdultUCI[["education-num"]] <- NULL


###################################################
### code chunk number 15: arules.Rnw:1341-1356
###################################################
AdultUCI[[ "age"]] <- ordered(cut(AdultUCI[[ "age"]], c(15,25,45,65,100)),
    labels = c("Young", "Middle-aged", "Senior", "Old"))

AdultUCI[[ "hours-per-week"]] <- ordered(cut(AdultUCI[[ "hours-per-week"]],
      c(0,25,40,60,168)),
    labels = c("Part-time", "Full-time", "Over-time", "Workaholic"))
			    
AdultUCI[[ "capital-gain"]] <- ordered(cut(AdultUCI[[ "capital-gain"]],
      c(-Inf,0,median(AdultUCI[[ "capital-gain"]][AdultUCI[[ "capital-gain"]]>0]),Inf)),
    labels = c("None", "Low", "High"))

AdultUCI[[ "capital-loss"]] <- ordered(cut(AdultUCI[[ "capital-loss"]],
      c(-Inf,0,
	median(AdultUCI[[ "capital-loss"]][AdultUCI[[ "capital-loss"]]>0]),Inf)),
    labels = c("none", "low", "high"))


###################################################
### code chunk number 16: coerce
###################################################
Adult <- transactions(AdultUCI)
Adult


###################################################
### code chunk number 17: summary
###################################################
summary(Adult)


###################################################
### code chunk number 18: itemFrequencyPlot (eval = FALSE)
###################################################
## itemFrequencyPlot(Adult, support = 0.1, cex.names=0.8)


###################################################
### code chunk number 19: arules.Rnw:1395-1396
###################################################
itemFrequencyPlot(Adult, support = 0.1, cex.names=0.8)


###################################################
### code chunk number 20: apriori
###################################################
rules <- apriori(Adult, 
                 parameter = list(support = 0.01, confidence = 0.6))
rules


###################################################
### code chunk number 21: summary
###################################################
summary(rules)


###################################################
### code chunk number 22: rules
###################################################
rulesIncomeSmall <- subset(rules, subset = rhs %in% "income=small" & lift > 1.2)
rulesIncomeLarge <- subset(rules, subset = rhs %in% "income=large" & lift > 1.2)


###################################################
### code chunk number 23: subset
###################################################
inspect(head(rulesIncomeSmall, n = 3, by = "confidence"))
inspect(head(rulesIncomeLarge, n = 3, by = "confidence"))


###################################################
### code chunk number 24: write_rules (eval = FALSE)
###################################################
## write(rulesIncomeSmall, file = "data.csv", sep = ",", col.names = NA)


###################################################
### code chunk number 25: pmml (eval = FALSE)
###################################################
## write.PMML(rulesIncomeSmall, file = "data.xml")


###################################################
### code chunk number 26: arules.Rnw:1520-1523
###################################################
data("Adult")
fsets <- eclat(Adult, parameter = list(support = 0.05), 
	control = list(verbose=FALSE))


###################################################
### code chunk number 27: arules.Rnw:1531-1538
###################################################
singleItems <- fsets[size(items(fsets)) == 1]

## Get the col numbers we have support for
singleSupport <- quality(singleItems)$support
names(singleSupport) <- unlist(LIST(items(singleItems),
	    decode = FALSE))
head(singleSupport, n = 5)


###################################################
### code chunk number 28: arules.Rnw:1547-1554
###################################################
itemsetList <- LIST(items(fsets), decode = FALSE)

allConfidence <- quality(fsets)$support / 
    sapply(itemsetList, function(x) 
    max(singleSupport[as.character(x)]))

quality(fsets) <- cbind(quality(fsets), allConfidence)


###################################################
### code chunk number 29: arules.Rnw:1558-1559
###################################################
summary(fsets)


###################################################
### code chunk number 30: arules.Rnw:1567-1570
###################################################
fsetsEducation <- subset(fsets, subset = items %pin% "education")
inspect(sort(fsetsEducation[size(fsetsEducation)>1], 
	by = "allConfidence")[1 : 3])


###################################################
### code chunk number 31: arules.Rnw:1583-1585
###################################################
data("Adult")
Adult


###################################################
### code chunk number 32: arules.Rnw:1594-1600
###################################################
supp <- 0.05
epsilon <- 0.1
c <- 0.1

n <- -2 * log(c)/ (supp * epsilon^2)
n


###################################################
### code chunk number 33: arules.Rnw:1609-1610
###################################################
AdultSample <- sample(Adult, n, replace = TRUE)


###################################################
### code chunk number 34: itemFrequencyPlot2 (eval = FALSE)
###################################################
## itemFrequencyPlot(AdultSample, population = Adult, support = supp,
##     cex.names = 0.7)


###################################################
### code chunk number 35: arules.Rnw:1628-1629
###################################################
itemFrequencyPlot(AdultSample, population = Adult, support = supp,
    cex.names = 0.7)


###################################################
### code chunk number 36: itemFrequencyPlot3 (eval = FALSE)
###################################################
## itemFrequencyPlot(AdultSample, population = Adult, 
##     support = supp, lift = TRUE, 
##     cex.names = 0.9)


###################################################
### code chunk number 37: arules.Rnw:1657-1658
###################################################
itemFrequencyPlot(AdultSample, population = Adult, 
    support = supp, lift = TRUE, 
    cex.names = 0.9)


###################################################
### code chunk number 38: arules.Rnw:1669-1676
###################################################
time <- system.time(itemsets <- eclat(Adult, 
    parameter = list(support = supp), control = list(verbose = FALSE)))
time

timeSample <- system.time(itemsetsSample <- eclat(AdultSample, 
    parameter = list(support = supp), control = list(verbose = FALSE)))
timeSample


###################################################
### code chunk number 39: arules.Rnw:1685-1687
###################################################
# speed up
time[1] / timeSample[1]


###################################################
### code chunk number 40: arules.Rnw:1695-1697
###################################################
itemsets
itemsetsSample


###################################################
### code chunk number 41: arules.Rnw:1705-1708
###################################################
match <- match(itemsets, itemsetsSample, nomatch = 0)
## remove no matches
sum(match > 0) / length(itemsets)


###################################################
### code chunk number 42: arules.Rnw:1717-1719
###################################################
summary(quality(itemsets[match == 0])$support)
summary(quality(itemsetsSample[-match])$support)


###################################################
### code chunk number 43: arules.Rnw:1728-1734
###################################################
supportItemsets <- quality(itemsets[which(match > 0)])$support
supportSample <- quality(itemsetsSample[match])$support

accuracy <- 1 - abs(supportSample - supportItemsets) / supportItemsets

summary(accuracy)