Pattern Mining

Library



In [1]:

    
source("https://raw.githubusercontent.com/eogasawara/mylibrary/master/myPreprocessing.R")
loadlibrary("arules")
loadlibrary("arulesViz")
loadlibrary("arulesSequences")









    



Loading required package: ggplot2

Loading required package: scales

Loading required package: ggpubr

Loading required package: reshape

Loading required package: caret

Loading required package: lattice

Loading required package: MASS

Loading required package: DMwR

Loading required package: grid

Registered S3 method overwritten by 'quantmod':
  method            from
  as.zoo.data.frame zoo 

Loading required package: dplyr


Attaching package: ‘dplyr’


The following object is masked from ‘package:MASS’:

    select


The following object is masked from ‘package:reshape’:

    rename


The following objects are masked from ‘package:stats’:

    filter, lag


The following objects are masked from ‘package:base’:

    intersect, setdiff, setequal, union


Loading required package: arules

Loading required package: Matrix


Attaching package: ‘Matrix’


The following object is masked from ‘package:reshape’:

    expand



Attaching package: ‘arules’


The following object is masked from ‘package:dplyr’:

    recode


The following objects are masked from ‘package:base’:

    abbreviate, write


Loading required package: arulesViz

Registered S3 method overwritten by 'seriation':
  method         from 
  reorder.hclust gclus

Loading required package: arulesSequences



In [2]:

    
data(AdultUCI)
dim(AdultUCI)
head(AdultUCI)









    





48842
15







    





A data.frame: 6 × 15

	 age workclass fnlwgt education education-num marital-status occupation relationship race sex capital-gain capital-loss hours-per-week native-country income
	 <int> <fct> <int> <ord> <int> <fct> <fct> <fct> <fct> <fct> <int> <int> <int> <fct> <ord>


	1 39 State-gov        77516 Bachelors 13 Never-married     Adm-clerical     Not-in-family White Male  2174 0 40 United-States small
	2 50 Self-emp-not-inc  83311 Bachelors 13 Married-civ-spouse Exec-managerial  Husband      White Male     0 0 13 United-States small
	3 38 Private         215646 HS-grad   9 Divorced          Handlers-cleaners Not-in-family White Male     0 0 40 United-States small
	4 53 Private         234721 11th      7 Married-civ-spouse Handlers-cleaners Husband      Black Male     0 0 40 United-States small
	5 28 Private         338409 Bachelors 13 Married-civ-spouse Prof-specialty   Wife         Black Female    0 0 40 Cuba         small
	6 37 Private         284582 Masters  14 Married-civ-spouse Exec-managerial  Wife         White Female    0 0 40 United-States small

Removing attributes



In [3]:

    
AdultUCI$fnlwgt <- NULL
AdultUCI$"education-num" <- NULL

Conceptual Hierarchy and Binning



In [4]:

    
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"))

head(AdultUCI)









    





A data.frame: 6 × 13

	 age workclass education marital-status occupation relationship race sex capital-gain capital-loss hours-per-week native-country income
	 <ord> <fct> <ord> <fct> <fct> <fct> <fct> <fct> <ord> <ord> <ord> <fct> <ord>


	1 Middle-aged State-gov       Bachelors Never-married     Adm-clerical     Not-in-family White Male  Low None Full-time United-States small
	2 Senior     Self-emp-not-inc Bachelors Married-civ-spouse Exec-managerial  Husband      White Male  None None Part-time United-States small
	3 Middle-aged Private         HS-grad  Divorced          Handlers-cleaners Not-in-family White Male  None None Full-time United-States small
	4 Senior     Private         11th     Married-civ-spouse Handlers-cleaners Husband      Black Male  None None Full-time United-States small
	5 Middle-aged Private         Bachelors Married-civ-spouse Prof-specialty   Wife         Black Female None None Full-time Cuba         small
	6 Middle-aged Private         Masters  Married-civ-spouse Exec-managerial  Wife         White Female None None Full-time United-States small

Convert to transactions



In [5]:

    
AdultTrans <- as(AdultUCI, "transactions")

A Priori



In [6]:

    
rules <- apriori(AdultTrans, parameter=list(supp = 0.5, conf = 0.9, minlen=2, maxlen= 10, target = "rules"), 
                 appearance=list(rhs = c("capital-gain=None"), default="lhs"), control=NULL)
inspect(rules)









    



Apriori

Parameter specification:
 confidence minval smax arem  aval originalSupport maxtime support minlen
        0.9    0.1    1 none FALSE            TRUE       5     0.5      2
 maxlen target  ext
     10  rules TRUE

Algorithmic control:
 filter tree heap memopt load sort verbose
    0.1 TRUE TRUE  FALSE TRUE    2    TRUE

Absolute minimum support count: 24421 

set item appearances ...[1 item(s)] done [0.00s].
set transactions ...[115 item(s), 48842 transaction(s)] done [0.08s].
sorting and recoding items ... [9 item(s)] done [0.01s].
creating transaction tree ... done [0.05s].
checking subsets of size 1 2 3 4 done [0.00s].
writing ... [18 rule(s)] done [0.00s].
creating S4 object  ... done [0.01s].
     lhs                               rhs                   support confidence  coverage      lift count
[1]  {hours-per-week=Full-time}     => {capital-gain=None} 0.5435895  0.9290688 0.5850907 1.0127342 26550
[2]  {sex=Male}                     => {capital-gain=None} 0.6050735  0.9051455 0.6684820 0.9866565 29553
[3]  {workclass=Private}            => {capital-gain=None} 0.6413742  0.9239073 0.6941976 1.0071078 31326
[4]  {race=White}                   => {capital-gain=None} 0.7817862  0.9143240 0.8550428 0.9966616 38184
[5]  {native-country=United-States} => {capital-gain=None} 0.8219565  0.9159062 0.8974243 0.9983862 40146
[6]  {capital-loss=None}            => {capital-gain=None} 0.8706646  0.9133376 0.9532779 0.9955863 42525
[7]  {capital-loss=None,                                                                                 
      hours-per-week=Full-time}     => {capital-gain=None} 0.5191638  0.9259787 0.5606650 1.0093657 25357
[8]  {race=White,                                                                                        
      sex=Male}                     => {capital-gain=None} 0.5313050  0.9030799 0.5883256 0.9844048 25950
[9]  {sex=Male,                                                                                          
      native-country=United-States} => {capital-gain=None} 0.5406003  0.9035349 0.5983170 0.9849008 26404
[10] {workclass=Private,                                                                                 
      race=White}                   => {capital-gain=None} 0.5472339  0.9208931 0.5942427 1.0038221 26728
[11] {workclass=Private,                                                                                 
      native-country=United-States} => {capital-gain=None} 0.5689570  0.9218444 0.6171942 1.0048592 27789
[12] {workclass=Private,                                                                                 
      capital-loss=None}            => {capital-gain=None} 0.6111748  0.9204465 0.6639982 1.0033354 29851
[13] {race=White,                                                                                        
      native-country=United-States} => {capital-gain=None} 0.7194628  0.9128933 0.7881127 0.9951019 35140
[14] {race=White,                                                                                        
      capital-loss=None}            => {capital-gain=None} 0.7404283  0.9099693 0.8136849 0.9919147 36164
[15] {capital-loss=None,                                                                                 
      native-country=United-States} => {capital-gain=None} 0.7793702  0.9117168 0.8548380 0.9938195 38066
[16] {workclass=Private,                                                                                 
      race=White,                                                                                        
      capital-loss=None}            => {capital-gain=None} 0.5204742  0.9171628 0.5674829 0.9997559 25421
[17] {workclass=Private,                                                                                 
      capital-loss=None,                                                                                 
      native-country=United-States} => {capital-gain=None} 0.5414807  0.9182030 0.5897179 1.0008898 26447
[18] {race=White,                                                                                        
      capital-loss=None,                                                                                 
      native-country=United-States} => {capital-gain=None} 0.6803980  0.9083504 0.7490480 0.9901500 33232



In [7]:

    
rules_a <- as(rules, "data.frame")
head(rules_a)









    





A data.frame: 6 × 6

	 rules support confidence coverage lift count
	 <fct> <dbl> <dbl> <dbl> <dbl> <int>


	1 {hours-per-week=Full-time} => {capital-gain=None}    0.5435895 0.9290688 0.5850907 1.0127342 26550
	2 {sex=Male} => {capital-gain=None}                    0.6050735 0.9051455 0.6684820 0.9866565 29553
	3 {workclass=Private} => {capital-gain=None}           0.6413742 0.9239073 0.6941976 1.0071078 31326
	4 {race=White} => {capital-gain=None}                  0.7817862 0.9143240 0.8550428 0.9966616 38184
	5 {native-country=United-States} => {capital-gain=None} 0.8219565 0.9159062 0.8974243 0.9983862 40146
	6 {capital-loss=None} => {capital-gain=None}           0.8706646 0.9133376 0.9532779 0.9955863 42525

Analysis of Rules



In [8]:

    
imrules <- interestMeasure(rules, transactions = AdultTrans)
head(imrules)









    





A data.frame: 6 × 47

	 support confidence lift count coverage rhsSupport leverage hyperLift hyperConfidence fishersExactTest ⋯ casualConfidence leastContradiction centeredConfidence varyingLiaison yuleQ yuleY lerman implicationIndex importance stdLift
	 <dbl> <dbl> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> ⋯ <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>


	1 0.5435895 0.9290688 1.0127342 26550 0.5850907 0.9173867  0.006835121 1.0100434 1.000000e+00 1.121041e-28 ⋯ 0.9999976 0.5925413  0.011682156  0.012734168  0.1805312  0.09101332  2.0618407 -6.870784  0.013370119 0.29068832
	2 0.6050735 0.9051455 0.9866565 29553 0.6684820 0.9173867 -0.008183018 0.9844437 4.037659e-47 1.000000e+00 ⋯ 0.9999966 0.6595621 -0.012241193 -0.013343548 -0.2604097 -0.13249043 -2.3093466  7.695561 -0.017351596 0.05145482
	3 0.6413742 0.9239073 1.0071078 31326 0.6941976 0.9173867  0.004526583 1.0050048 1.000000e+00 4.115642e-15 ⋯ 0.9999973 0.6991318  0.006520598  0.007107796  0.1343742  0.06749314  1.2535725 -4.177348  0.010154765 0.23907273
	4 0.7817862 0.9143240 0.9966616 38184 0.8550428 0.9173867 -0.002618696 0.9953600 3.318642e-10 1.000000e+00 ⋯ 0.9999966 0.8521883 -0.003062649 -0.003338449 -0.1518210 -0.07635304 -0.6534489  2.177523 -0.009873694 0.11325898
	5 0.8219565 0.9159062 0.9983862 40146 0.8974243 0.9173867 -0.001328626 0.9973170 1.488781e-04 9.998511e-01 ⋯ 0.9999966 0.8959761 -0.001480488 -0.001613810 -0.1016143 -0.05093898 -0.3236118  1.078389 -0.006719212 0.08649318
	6 0.8706646 0.9133376 0.9955863 42525 0.9532779 0.9173867 -0.003859867 0.9948765 0.000000e+00 1.000000e+00 ⋯ 0.9999964 0.9490705 -0.004049047 -0.004413675 -1.0000000 -1.00000000 -0.9121852  3.039724 -0.039186904 0.00000000

Removing redundant rules



In [9]:

    
nrules <- rules[!is.redundant(rules)]



In [10]:

    
arules::inspect(nrules)









    



    lhs                               rhs                 support   confidence
[1] {hours-per-week=Full-time}     => {capital-gain=None} 0.5435895 0.9290688 
[2] {sex=Male}                     => {capital-gain=None} 0.6050735 0.9051455 
[3] {workclass=Private}            => {capital-gain=None} 0.6413742 0.9239073 
[4] {race=White}                   => {capital-gain=None} 0.7817862 0.9143240 
[5] {native-country=United-States} => {capital-gain=None} 0.8219565 0.9159062 
[6] {capital-loss=None}            => {capital-gain=None} 0.8706646 0.9133376 
    coverage  lift      count
[1] 0.5850907 1.0127342 26550
[2] 0.6684820 0.9866565 29553
[3] 0.6941976 1.0071078 31326
[4] 0.8550428 0.9966616 38184
[5] 0.8974243 0.9983862 40146
[6] 0.9532779 0.9955863 42525

Showing the transactions that support the rules

In this example, we can see the transactions (trans) that support rules 1.



In [16]:

    
st <- supportingTransactions(nrules[1], AdultTrans)
trans <- unique(st@data@i)
length(trans)
print(c(length(trans)/length(AdultTrans), nrules[1]@quality$support))









    




26550






    



[1] 0.5435895 0.5435895

Now we can see the transactions (trans) that support rules 1 and 2. As can be observed, the support for both rules is not the sum of the support of each rule.



In [17]:

    
st <- supportingTransactions(nrules[1:2], AdultTrans)
trans <- unique(st@data@i)
length(trans)
print(c(length(trans)/length(AdultTrans), nrules[1:2]@quality$support))









    




39392






    



[1] 0.8065190 0.5435895 0.6050735

Rules visualization



In [18]:

    
options(repr.plot.width=7, repr.plot.height=4)
plot(rules)



In [19]:

    
options(repr.plot.width=7, repr.plot.height=4)
plot(rules, method="paracoord", control=list(reorder=TRUE))

Sequence Mining



In [20]:

    
x <- read_baskets(con = system.file("misc", "zaki.txt", package = "arulesSequences"), info = c("sequenceID","eventID","SIZE"))
as(x, "data.frame")









    





A data.frame: 10 × 4

	items sequenceID eventID SIZE
	<fct> <int> <int> <int>


	{C,D}    1 10 2
	{A,B,C}  1 15 3
	{A,B,F}  1 20 3
	{A,C,D,F} 1 25 4
	{A,B,F}  2 15 3
	{E}      2 20 1
	{A,B,F}  3 10 3
	{D,G,H}  4 10 3
	{B,F}    4 20 2
	{A,G,H}  4 25 3



In [21]:

    
s1 <- cspade(x, parameter = list(support = 0.4), control = list(verbose = TRUE))
as(s1, "data.frame")









    



parameter specification:
support : 0.4
maxsize :  10
maxlen  :  10

algorithmic control:
bfstype  : FALSE
verbose  :  TRUE
summary  : FALSE
tidLists : FALSE

preprocessing ... 1 partition(s), 0 MB [0.046s]
mining transactions ... 0 MB [0.032s]
reading sequences ... [0.027s]

total elapsed time: 0.105s






    





A data.frame: 18 × 2

	sequence support
	<fct> <dbl>


	<{A}>          1.00
	<{B}>          1.00
	<{D}>          0.50
	<{F}>          1.00
	<{A,F}>        0.75
	<{B,F}>        1.00
	<{D},{F}>      0.50
	<{D},{B,F}>    0.50
	<{A,B,F}>      0.75
	<{A,B}>        0.75
	<{D},{B}>      0.50
	<{B},{A}>      0.50
	<{D},{A}>      0.50
	<{F},{A}>      0.50
	<{D},{F},{A}>  0.50
	<{B,F},{A}>    0.50
	<{D},{B,F},{A}> 0.50
	<{D},{B},{A}>  0.50



In [ ]:

	age	workclass	fnlwgt	education	education-num	marital-status	occupation	relationship	race	sex	capital-gain	capital-loss	hours-per-week	native-country	income
	<int>	<fct>	<int>	<ord>	<int>	<fct>	<fct>	<fct>	<fct>	<fct>	<int>	<int>	<int>	<fct>	<ord>
1	39	State-gov	77516	Bachelors	13	Never-married	Adm-clerical	Not-in-family	White	Male	2174	0	40	United-States	small
2	50	Self-emp-not-inc	83311	Bachelors	13	Married-civ-spouse	Exec-managerial	Husband	White	Male	0	0	13	United-States	small
3	38	Private	215646	HS-grad	9	Divorced	Handlers-cleaners	Not-in-family	White	Male	0	0	40	United-States	small
4	53	Private	234721	11th	7	Married-civ-spouse	Handlers-cleaners	Husband	Black	Male	0	0	40	United-States	small
5	28	Private	338409	Bachelors	13	Married-civ-spouse	Prof-specialty	Wife	Black	Female	0	0	40	Cuba	small
6	37	Private	284582	Masters	14	Married-civ-spouse	Exec-managerial	Wife	White	Female	0	0	40	United-States	small

	rules	support	confidence	coverage	lift	count
	<fct>	<dbl>	<dbl>	<dbl>	<dbl>	<int>
1	{hours-per-week=Full-time} => {capital-gain=None}	0.5435895	0.9290688	0.5850907	1.0127342	26550
2	{sex=Male} => {capital-gain=None}	0.6050735	0.9051455	0.6684820	0.9866565	29553
3	{workclass=Private} => {capital-gain=None}	0.6413742	0.9239073	0.6941976	1.0071078	31326
4	{race=White} => {capital-gain=None}	0.7817862	0.9143240	0.8550428	0.9966616	38184
5	{native-country=United-States} => {capital-gain=None}	0.8219565	0.9159062	0.8974243	0.9983862	40146
6	{capital-loss=None} => {capital-gain=None}	0.8706646	0.9133376	0.9532779	0.9955863	42525

sequence	support
<fct>	<dbl>
<{A}>	1.00
<{B}>	1.00
<{D}>	0.50
<{F}>	1.00
<{A,F}>	0.75
<{B,F}>	1.00
<{D},{F}>	0.50
<{D},{B,F}>	0.50
<{A,B,F}>	0.75
<{A,B}>	0.75
<{D},{B}>	0.50
<{B},{A}>	0.50
<{D},{A}>	0.50
<{F},{A}>	0.50
<{D},{F},{A}>	0.50
<{B,F},{A}>	0.50
<{D},{B,F},{A}>	0.50
<{D},{B},{A}>	0.50