########################################################################################
#   Market basket analysis
#   cf. http://www.salemmarafi.com/code/market-basket-analysis-with-r/
#	and https://en.wikipedia.org/wiki/Association_rule_learning
########################################################################################
source("http://ceresanalytics.com/R_for_IBF_BootCamp/installLoadPkg.r")
installLoadPkg("arules")
installLoadPkg("arulesViz")

library(datasets)
data(Groceries)
str(Groceries)

#B.  Item frequency plot for the top 20 items
itemFrequencyPlot(Groceries,topN=20,type="absolute",main="Frequency of top 20 items purchased",col="turquoise1")

#C.  Find association rules, given support and confidence
# 	1. Get the rules--they can be really rare 
rules <- apriori(Groceries, parameter = list(supp = 0.001, conf = 0.8))

#	2. what can you do with such rules?  See available methods for the class...
methods(class=class(rules))	

# 	3. Show the top 5 rules by support , but only 2 digits
rules_supp <- sort (rules, by="support", decreasing=TRUE) 
options(digits=2)
inspect(rules_supp[1:20])


#	4. more per http://r-statistics.co/Association-Mining-With-R.html
#		a. sort the rules by confidence 
rules_conf <- sort (rules, by="confidence", decreasing=TRUE) 
inspect(rules_conf[1:20]) # show the support, lift and confidence for all rules	

#		b. sort the rules by lift
rules_lift <- sort (rules, by="lift", decreasing=TRUE) 
inspect(rules_lift[1:20]) # show the support, lift and confidence for all rules	



########################################################################################
#B. Association of personal characteristics 
#	per https://rdrr.io/cran/arules/man/Adult.html
#   this will be traits that co-occur with others 
#	Youll start with a dataset in which traits are columns 
########################################################################################

#	1. tell R to work with the dataset 
data("AdultUCI")

#	2. check it out 
#		a. size 
dim(AdultUCI)
#		b. column names 
names(AdultUCI)
#		c. first few obs 
head(AdultUCI)

#	3. per site:
	## remove attributes
	AdultUCI[["fnlwgt"]] <- NULL
	AdultUCI[["education-num"]] <- NULL

	## map metric attributes
	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"))

	## create transactions
	Adult <- as(AdultUCI, "transactions")
	Adult

# 	4. Get the rules--they can be really rare 
rulesAdult <- apriori(Adult, parameter = list(supp = 0.25, conf = 0.8))
	
#		a. see top 10 overall
options(digits=2)
inspect(rulesAdult[1:10])