Week 5 Project Arules

Project Prompt:

Given the following data set:

Source: Zumel, N. (2014). Practical Data Science with R, Manning Publications.

https://github.com/WinVector/zmPDSwR/blob/master/Bookdata/bxBooks.RData #then click download. This data set is quite large (271,380 rows). You are allowed to reduce the size to 135,000 for your analysis.

Set the minimum support to 0.005, and minimum confidence of 0.70. You can experiment adjusting the minimum support/and minimum confidence and compare the results.

      1) Lets begin with exploring the data e.g. create histogram for top 20 frequent books

      2) Use apriori() algorithm to display the top ten rules (sort by confidence), and summary information.

      3) You can try different things such as adjusting parameters (e.g. support, confidence, lift), restricting to specific

            subsets of rules, removing redundant rules. Discuss your results/findings

      4) Use library(e.g. aruleViz) to display rules

      5) Discuss any findings from your experiment results. Are there any rules that surprise you?

      6) From this analysis, what are the recommended actions?

Let’s begin the assignment by following the prompt to download the data, and load it into our environment. I have already done so, and load it below:

load("C:/Users/JP/Downloads/bxBooks.RData")
str(bxBookRatings)

'data.frame':   1149780 obs. of  3 variables:
 $ User.ID    : int  276725 276726 276727 276729 276729 276733 276736 276737 276744 276745 ...
 $ ISBN       : chr  "034545104X" "0155061224" "0446520802" "052165615X" ...
 $ Book.Rating: int  0 5 0 3 6 0 8 6 7 10 ...

str(bxBooks)

'data.frame':   271379 obs. of  8 variables:
 $ ISBN               : chr  "0195153448" "0002005018" "0060973129" "0374157065" ...
 $ Book.Title         : chr  "Classical Mythology" "Clara Callan" "Decision in Normandy" "Flu: The Story of the Great Influenza Pandemic of 1918 and the Search for the Virus That Caused It" ...
 $ Book.Author        : chr  "Mark P. O. Morford" "Richard Bruce Wright" "Carlo D'Este" "Gina Bari Kolata" ...
 $ Year.Of.Publication: int  2002 2001 1991 1999 1999 1991 2000 1993 1996 2002 ...
 $ Publisher          : chr  "Oxford University Press" "HarperFlamingo Canada" "HarperPerennial" "Farrar Straus Giroux" ...
 $ Image.URL.S        : chr  "http://images.amazon.com/images/P/0195153448.01.THUMBZZZ.jpg" "http://images.amazon.com/images/P/0002005018.01.THUMBZZZ.jpg" "http://images.amazon.com/images/P/0060973129.01.THUMBZZZ.jpg" "http://images.amazon.com/images/P/0374157065.01.THUMBZZZ.jpg" ...
 $ Image.URL.M        : chr  "http://images.amazon.com/images/P/0195153448.01.MZZZZZZZ.jpg" "http://images.amazon.com/images/P/0002005018.01.MZZZZZZZ.jpg" "http://images.amazon.com/images/P/0060973129.01.MZZZZZZZ.jpg" "http://images.amazon.com/images/P/0374157065.01.MZZZZZZZ.jpg" ...
 $ Image.URL.L        : chr  "http://images.amazon.com/images/P/0195153448.01.LZZZZZZZ.jpg" "http://images.amazon.com/images/P/0002005018.01.LZZZZZZZ.jpg" "http://images.amazon.com/images/P/0060973129.01.LZZZZZZZ.jpg" "http://images.amazon.com/images/P/0374157065.01.LZZZZZZZ.jpg" ...

str(bxUsers)

'data.frame':   278858 obs. of  3 variables:
 $ User.ID : int  1 2 3 4 5 6 7 8 9 10 ...
 $ Location: chr  "nyc, new york, usa" "stockton, california, usa" "moscow, yukon territory, russia" "porto, v.n.gaia, portugal" ...
 $ Age     : chr  "NULL" "18" "NULL" "17" ...

We have loaded in some interesting information. The prompt says that we can reduce our study set, but we do have some time, so let’s just start by seeing how long it takes to go through all of the data. First things firts, let’s take a look at most commonly reviewed books.

require(ggplot2)
require(arules)

Loading required package: arules
Loading required package: Matrix

Attaching package: <U+393C><U+3E31>arules<U+393C><U+3E32>

The following objects are masked from <U+393C><U+3E31>package:base<U+393C><U+3E32>:

    abbreviate, write

require(dplyr)

Loading required package: dplyr

Attaching package: <U+393C><U+3E31>dplyr<U+393C><U+3E32>

The following objects are masked from <U+393C><U+3E31>package:arules<U+393C><U+3E32>:

    intersect, recode, setdiff, setequal, union

The following objects are masked from <U+393C><U+3E31>package:stats<U+393C><U+3E32>:

    filter, lag

The following objects are masked from <U+393C><U+3E31>package:base<U+393C><U+3E32>:

    intersect, setdiff, setequal, union

top20<-bxBookRatings %>% group_by(ISBN) %>% summarise(n=n()) %>%
  top_n(n=20) %>% arrange(n)

Selecting by n

top20<-merge(top20,bxBooks[,c("ISBN","Book.Title")])
ggplot(top20,aes(x=reorder(Book.Title,n),n))+ geom_bar(stat='identity')+ theme(axis.text.x=element_text(angle=90, hjust=1))+ coord_flip() + labs(x = "Book Title",y="Number of Ratings")

The visualization reveals that the top 20 books. Now, we should begin using the arules package to find assocciations in our data. The first step requires us to transform our data a little bit into a transaction data format. I am going to take a sample at this point, runnign the whole set took up too much memory and required some extra time.

samplebooks<-bxBookRatings[sample(nrow(bxBookRatings), 50000), ]
samplebooks$User.ID<-as.factor(samplebooks$User.ID)
samplebooks$ISBN<-as.factor(samplebooks$ISBN)
samplebooks$Book.Rating<-as.factor(samplebooks$Book.Rating)
ratings<-as(split(samplebooks[,2],samplebooks[,1]),"transactions")
rm(ratings)
list(ratings)

Error: object 'ratings' not found

Using the sepcified parameters, no rules were provided. Let’s see if we lower the confidence or support, if we get any rules for the sample data set.

inspect(rules.sorted[1:20])

     lhs             rhs          support      confidence lift  
[1]  {3596800129} => {3746616905} 0.0001223017 1          8176.5
[2]  {3746616905} => {3596800129} 0.0001223017 1          8176.5
[3]  {0007140676} => {0380978202} 0.0001223017 1          8176.5
[4]  {0380978202} => {0007140676} 0.0001223017 1          8176.5
[5]  {0679410325} => {0553583573} 0.0001223017 1          8176.5
[6]  {0553583573} => {0679410325} 0.0001223017 1          8176.5
[7]  {0060092963} => {0440235758} 0.0001223017 1          8176.5
[8]  {0440235758} => {0060092963} 0.0001223017 1          8176.5
[9]  {0451126718} => {0590629778} 0.0001223017 1          8176.5
[10] {0590629778} => {0451126718} 0.0001223017 1          8176.5
[11] {0373108494} => {0373109482} 0.0001223017 1          8176.5
[12] {0373109482} => {0373108494} 0.0001223017 1          8176.5
[13] {050552533X} => {0345341228} 0.0001223017 1          8176.5
[14] {0345341228} => {050552533X} 0.0001223017 1          8176.5
[15] {0307129438} => {0816712301} 0.0001223017 1          8176.5
[16] {0816712301} => {0307129438} 0.0001223017 1          8176.5
[17] {0307290034} => {0307001040} 0.0001223017 1          8176.5
[18] {0307001040} => {0307290034} 0.0001223017 1          8176.5
[19] {0373272839} => {0373242867} 0.0001223017 1          8176.5
[20] {0373242867} => {0373272839} 0.0001223017 1          8176.5

It turns out that we needed a much lower support threshhol before any rules were produced. I do not find the results very exciting, and think it would be more interesting to view this data by looking at a greater min length.

 rules.sorted <- sort(rules, by="lift")
 rules.sorted <- sort(rules, by="lift")
inspect(rules.sorted[1:20])

     lhs                                   rhs          support      confidence lift  
[1]  {0671001795,074343627X}            => {0553295608} 0.0001223017 1          8176.5
[2]  {0446515078,0843950765}            => {1579730175} 0.0001223017 1          8176.5
[3]  {0446515078,1579730175}            => {0843950765} 0.0001223017 1          8176.5
[4]  {0380724979,0440203856}            => {0307740161} 0.0001223017 1          8176.5
[5]  {0451141083,0553205315}            => {0590456512} 0.0001223017 1          8176.5
[6]  {0515121843,0553205315}            => {0590456512} 0.0001223017 1          8176.5
[7]  {0451141083,0515121843}            => {0590456512} 0.0001223017 1          8176.5
[8]  {0312955731,0425137945}            => {0345377168} 0.0001223017 1          8176.5
[9]  {0345377168,0425137945}            => {0312955731} 0.0001223017 1          8176.5
[10] {0345404777,0918949165}            => {0804108749} 0.0001223017 1          8176.5
[11] {0345443284,0918949165}            => {0804108749} 0.0001223017 1          8176.5
[12] {0345404777,0345443284}            => {0804108749} 0.0001223017 1          8176.5
[13] {0451141083,0515121843,0553205315} => {0590456512} 0.0001223017 1          8176.5
[14] {0345404777,0345443284,0918949165} => {0804108749} 0.0001223017 1          8176.5
[15] {0843950765,1579730175}            => {0446515078} 0.0001223017 1          5451.0
[16] {0307740161,0440203856}            => {0380724979} 0.0001223017 1          5451.0
[17] {0553205315,0590456512}            => {0451141083} 0.0001223017 1          5451.0
[18] {0451141083,0590456512}            => {0553205315} 0.0001223017 1          5451.0
[19] {0515121843,0590456512}            => {0553205315} 0.0001223017 1          5451.0
[20] {0515121843,0590456512}            => {0451141083} 0.0001223017 1          5451.0

From here, you can see that there are some reduntant rules. Let’s take those out before we make any plots.

inspect(rules[1:20])

     lhs                        rhs          support      confidence lift  
[1]  {0671001795,074343627X} => {0553295608} 0.0001223017 1          8176.5
[2]  {0446515078,0843950765} => {1579730175} 0.0001223017 1          8176.5
[3]  {0446515078,1579730175} => {0843950765} 0.0001223017 1          8176.5
[4]  {0380724979,0440203856} => {0307740161} 0.0001223017 1          8176.5
[5]  {0451141083,0553205315} => {0590456512} 0.0001223017 1          8176.5
[6]  {0515121843,0553205315} => {0590456512} 0.0001223017 1          8176.5
[7]  {0451141083,0515121843} => {0590456512} 0.0001223017 1          8176.5
[8]  {0312955731,0425137945} => {0345377168} 0.0001223017 1          8176.5
[9]  {0345377168,0425137945} => {0312955731} 0.0001223017 1          8176.5
[10] {0345404777,0918949165} => {0804108749} 0.0001223017 1          8176.5
[11] {0345443284,0918949165} => {0804108749} 0.0001223017 1          8176.5
[12] {0345404777,0345443284} => {0804108749} 0.0001223017 1          8176.5
[13] {0843950765,1579730175} => {0446515078} 0.0001223017 1          5451.0
[14] {0307740161,0440203856} => {0380724979} 0.0001223017 1          5451.0
[15] {0553205315,0590456512} => {0451141083} 0.0001223017 1          5451.0
[16] {0451141083,0590456512} => {0553205315} 0.0001223017 1          5451.0
[17] {0515121843,0590456512} => {0553205315} 0.0001223017 1          5451.0
[18] {0515121843,0590456512} => {0451141083} 0.0001223017 1          5451.0
[19] {0515121843,0553205315} => {0451141083} 0.0001223017 1          5451.0
[20] {0451141083,0515121843} => {0553205315} 0.0001223017 1          5451.0

library(arulesViz)
plot(rules[1:5])

plot(rules[1:5], method="graph", control=list(type="items"))

plot(rules[1:5], method="paracoord", control=list(reorder=TRUE))

plot(rules[1:5],method = "matrix3D")

Itemsets in Antecedent (LHS)
[1] "{0671001795,074343627X}" "{0446515078,0843950765}" "{0446515078,1579730175}" "{0380724979,0440203856}" "{0451141083,0553205315}"
Itemsets in Consequent (RHS)
[1] "{0553295608}" "{1579730175}" "{0843950765}" "{0307740161}" "{0590456512}"

It is interesting to see that there are so few connections here. The biggest take away from this exercise is that sheer amount of memory needed to evaluate this data. This comes as a result of the way the transaction data type is stored. The way this was run, we would need to go through several iterations of these tests before feeling confident about book reviews by users. From the charts above, I belive the most helpful is the first, dsiplaying a clear indication for lift, support and confidence. The second chart is also interesting as it shows tha there is at least some overlap in to the top rules. If we were to keep going with this data, we could see exactly which users rated the books and their actual name.