Taller: Reglas de asociación
MD4
7/30/2020
En este trabajo buscaremos encontrar patrones de asociación dentro del conjunto de datos orders.csv, el cual contiene un gran numero de canastas de compra realizadas en un supermercado para ello cargaremos la base a R y de igual forma pasamos los datos a un objeto de tipo transacción que nos permitira trabajar de mejor manera.
pedidos <- read.csv(file = "https://raw.githubusercontent.com/CristinaGil/Ciencia-de-Datos-R/master/datos/orders.csv", header = TRUE, sep = ";")
transacciones <- read.transactions(file = "https://raw.githubusercontent.com/CristinaGil/Ciencia-de-Datos-R/master/datos/orders.csv",
header = TRUE,
format = "single",
sep = ";",
cols = c("order_id", "product_name"),
rm.duplicates = TRUE)
transacciones## transactions in sparse format with
## 12500 transactions (rows) and
## 17917 items (columns)Como podemos observar, tenemos un total de 17917 ítems y 12500 transacciones además realizaremos una inspección del primer ítem que contiene soda y Agua natural
inspect(transacciones[1:1])## items transactionID
## [1] {Soda,Spring Water} 100Podemos también calcular el tamaño de cada transacción y obtenemos el número máximo de ítems en un pedido es de 68, y el mínimo es de 1. La mitad de clientes compran un máximo de 8 ítems.
tamanhos_trans <- data.frame(tamanho = size(transacciones))
summary(tamanhos_trans)## tamanho
## Min. : 1.000
## 1st Qu.: 4.000
## Median : 8.000
## Mean : 9.354
## 3rd Qu.:13.000
## Max. :68.000Como nos interesa conocer qué productos aparecen juntos en los pedidos, restringiremos las transacciones a aquellas que contengan al menos dos ítems
transacciones <- transacciones[tamanhos_trans > 1]
dim(transacciones)## [1] 11733 17917Establecemos el soporte y la confianza
soporte <- 15/dim(transacciones)[1]
confianza <- 0.7(a) Proponga un método para extraer eficientemente un conjunto de relaciones.
Dado que se utiliza cestas de consumo el algoritmo apriori es un método eficaz para reducir el conjunto de búsqueda de los subconjuntos de datos tomando en cuenta la propiedad de antimonoticidad.
Analizando la base de datos se observa que no existe ningún valor nulo lo que corrobora la efectividad del a priori, debido a que este no es independiente de la nulidad de los datos.
itemsets_frecuentes <- apriori(data = transacciones,
parameter = list(support = soporte,
target = "frequent itemsets"),
control = list(verbose = FALSE))
summary(itemsets_frecuentes)## set of 2590 itemsets
##
## most frequent items:
## Banana Bag of Organic Bananas Organic Strawberries
## 218 174 148
## Organic Baby Spinach Organic Hass Avocado (Other)
## 138 126 3170
##
## element (itemset/transaction) length distribution:sizes
## 1 2 3
## 1314 1168 108
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 1.534 2.000 3.000
##
## summary of quality measures:
## support transIdenticalToItemsets count
## Min. :0.001364 Min. :0.000e+00 Min. : 16.00
## 1st Qu.:0.001619 1st Qu.:0.000e+00 1st Qu.: 19.00
## Median :0.002131 Median :0.000e+00 Median : 25.00
## Mean :0.003504 Mean :4.472e-05 Mean : 41.11
## 3rd Qu.:0.003324 3rd Qu.:8.523e-05 3rd Qu.: 39.00
## Max. :0.145743 Max. :2.557e-03 Max. :1710.00
##
## includes transaction ID lists: FALSE
##
## mining info:
## data ntransactions support confidence
## transacciones 11733 0.001278445 1Ahora mostraremos el top 6 de los items frecuentes
top6_itemsets <- sort(itemsets_frecuentes, by = "support", decreasing = TRUE)[1:6]
inspect(top6_itemsets)## items support transIdenticalToItemsets count
## [1] {Banana} 0.14574278 0.0025568908 1710
## [2] {Bag of Organic Bananas} 0.11957726 0.0019602830 1403
## [3] {Organic Strawberries} 0.08003068 0.0007670672 939
## [4] {Organic Baby Spinach} 0.07628058 0.0006818376 895
## [5] {Organic Hass Avocado} 0.06878036 0.0004261485 807
## [6] {Organic Avocado} 0.05284241 0.0005966079 620por podemos observar los itemsets frecuentes que contienen “Banana”
itemsets_bananas <- arules::subset(itemsets_frecuentes,
subset = items %ain% "Banana")
inspect(itemsets_bananas[1:5])## items support
## [1] {Banana} 0.145742777
## [2] {1% Low Fat Milk,Banana} 0.001363675
## [3] {Banana,Cheddar Bunnies Snack Crackers} 0.001448905
## [4] {Banana,Mandarin Oranges} 0.001363675
## [5] {Banana,Frozen Broccoli Florets} 0.001448905
## transIdenticalToItemsets count
## [1] 2.556891e-03 1710
## [2] 8.522969e-05 16
## [3] 0.000000e+00 17
## [4] 0.000000e+00 16
## [5] 0.000000e+00 17ahora lo que vamos hacer es obtener las reglas de asociacion y obtenemos un total de 7 reglas
reglas <- apriori(data = transacciones,
parameter = list(support = soporte,
confidence = confianza,
target = "rules"),
control = list(verbose = FALSE))
print(paste("Reglas generadas:", length(reglas)))## [1] "Reglas generadas: 7"En este puto podemos obtener los parámetros establecidos para las reglas que se han encontrado, con un lift mínimo de 34’41 (>>1), lo que indica patrones potencialmente reales en las compras.
Cinco de las reglas contienen 3 items en el antecedente (lhs), y las otras dos contienen 2 items:
summary(reglas)## set of 7 rules
##
## rule length distribution (lhs + rhs):sizes
## 2 3
## 2 5
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.000 2.500 3.000 2.714 3.000 3.000
##
## summary of quality measures:
## support confidence coverage lift
## Min. :0.001364 Min. :0.7143 Min. :0.001449 Min. : 34.41
## 1st Qu.:0.001364 1st Qu.:0.7560 1st Qu.:0.001747 1st Qu.:161.45
## Median :0.001364 Median :0.7619 Median :0.001790 Median :258.82
## Mean :0.001485 Mean :0.7913 Mean :0.001899 Mean :227.92
## 3rd Qu.:0.001577 3rd Qu.:0.8048 3rd Qu.:0.002088 3rd Qu.:322.03
## Max. :0.001790 Max. :0.9412 Max. :0.002386 Max. :335.23
## count
## Min. :16.00
## 1st Qu.:16.00
## Median :16.00
## Mean :17.43
## 3rd Qu.:18.50
## Max. :21.00
##
## mining info:
## data ntransactions support confidence
## transacciones 11733 0.001278445 0.7Finalmente obtendremos 5 reglas maximales de compra
reglas_maximales <- reglas[is.maximal(reglas)]
reglas_maximales## set of 5 rulesinspect(reglas_maximales)## lhs rhs support confidence coverage lift count
## [1] {Blueberry Whole Milk Yogurt Pouch,
## Yotoddler Organic Pear Spinach Mango Yogurt} => {Organic Whole Milk Strawberry Beet Berry Yogurt Pouch} 0.001363675 0.9411765 0.001448905 324.78893 16
## [2] {Blueberry Whole Milk Yogurt Pouch,
## Organic Whole Milk Strawberry Beet Berry Yogurt Pouch} => {Yotoddler Organic Pear Spinach Mango Yogurt} 0.001363675 0.8000000 0.001704594 335.22857 16
## [3] {Organic Whole Milk Strawberry Beet Berry Yogurt Pouch,
## Yotoddler Organic Pear Spinach Mango Yogurt} => {Blueberry Whole Milk Yogurt Pouch} 0.001363675 0.7619048 0.001789824 319.26531 16
## [4] {Total 2% Lowfat Greek Strained Yogurt With Blueberry,
## Total 2% Lowfat Greek Strained Yogurt with Peach} => {Total 2% with Strawberry Lowfat Greek Strained Yogurt} 0.001363675 0.7619048 0.001789824 76.40537 16
## [5] {Lime Sparkling Water,
## Pure Sparkling Water} => {Sparkling Water Grapefruit} 0.001448905 0.8095238 0.001789824 34.41356 17(b) Con base en los resultados de la minería y las medidas de evaluación del patrón discutidas en este capítulo, discuta qué medida puede descubrir de manera convincente patrones de compras.
Como se pudo observar en el literal a del presente escrito, el algoritmo A-Priori resulta ser un método eficiente para la descubrir de manera eficiente y convincente los patrones de compra de los clientes; sin embargo, existen medidas de evaluación que permitirán corroborar el resultado obtenido o permitirán descubrir una nueva y mejor forma de hacerlo. Dichas medidas se discuten a continuación.
LIFT: Esta es una medida que cuantifica la relación entre las variables dependientes e independiente e indica la proporción que tiene el soporte observado de un conjunto de ítems respecto al soporte teórico del mismo y puede ser usada siempre y cuando se tenga una base sobre el soporte de independencia; es decir, se busca descubrir la relación entre lo que se observa que sucede con el soporte versus lo que se esperaría que suceda con el mismo.
Para comprender el cálculo del lift, se debe tener como referencia a la siguiente tabla de contingencia: 
donde f11 indica el número de transacciones, teniendo en cuenta a p y q, y f00 indica el número de transacciones donde estos dos valores p y q no están presentes. Con ello en mente, se entiende a la fórmula del cálculo del lift de la siguiente manera: 
Ahora, la manera adecuada de interpretar la efectividad del valor obtenido por el lift es observando si se cumple uno de los siguientes casos:
- Lift = 1 → p y q son independientes, por lo que la regla no representa un valor real.
- Lift < 1 → p y q están correlacionados negativamente entre sí.
- Lift > 1 → p y q están correlacionados positivamente entre sí.
Con ello en mente y habiendo comprendido el funcionamiento del lift, se procede a interpretar el lift obtenido en el presente ejercicio, el cual tiene un valor de 34’41 cuando se trabaja con siete reglas, dado que este lift es mucho mayor que 1 (>>1), entonces quiere decir que p y q están correlacionados de manera positiva entre sí; es decir, que los patrones de las compras son potencialmente reales, lo cual es positivo, pues quiere decir que las reglas encontradas son adecuadas para explicar patrones de compra convincentes ya que están acorde a la realidad.
Del mismo modo, tras aplicar los filtros a las siete reglas aplicadas, se encuentra que cinco de esas siete reglas son maximales; de estas cinco, se ha obtenido que el lift tiene un valor de 34’41 todavía; es decir, se sigue encontrando que estas pueden ser reglas efectivas y convincentes sobre los patrones de compra de los clientes. Todo esto certifica y avala nuevamente los resultados obtenidos en la aplicación del algoritmo A-Priori, por lo que se puede decir que esta es una regla de evaluación apropiada en este caso de estudio.
FISHER: La prueba de Fisher es el test exacto utilizado cuando se quiere estudiar si existe asociación entre dos variables cualitativas, es decir, si las proporciones de una variable son diferentes dependiendo del valor que adquiera la otra variable y al momento de calcularlo obtenemos un resumen de los p-valores donde se tiene que todos los valores del test son pequeños, lo que quiere decir que es muy probable que las reglas reflejen patrones de comportamiento muy confiables.
testFisher <- interestMeasure(reglas,
measure = "fishersExactTest",
transactions = transacciones)
summary(testFisher)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.000e+00 0.000e+00 0.000e+00 9.942e-26 3.220e-29 6.959e-25CORRELACIONES: Otra medida que podemos utilizar además de la de Fisher ya implementada es: la medida de correlación, esta nos permite medir la correlación entre las reglas, el valor de esta medida está entre -1 y 1 y nos indica si existe correlación positiva o negativa.
C <- interestMeasure(reglas,
measure = "coverage",
transactions = transacciones)
summary(C)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.001449 0.001747 0.001790 0.001899 0.002088 0.002386En este caso tenemos correlaciones positivas en todos los casos que van de 0.0014 a 0.0023.
Es importante notar que si cambiamos de algoritmo, como emplear el algoritmo “ECLAT” Equivalence Class Clustering and bottom-up Lattice Transversal, que tiene un desarrollo vertical. Las medidas anteriores presentan inconvenientes, es ahí que medidas como la “Lift” ya expuesta nos pueden ayudar.
frequentItems <- eclat (transacciones, parameter = list(support = soporte , minlen=3, maxlen=10))## Eclat
##
## parameter specification:
## tidLists support minlen maxlen target ext
## FALSE 0.001278445 3 10 frequent itemsets TRUE
##
## algorithmic control:
## sparse sort verbose
## 7 -2 TRUE
##
## Absolute minimum support count: 15
##
## create itemset ...
## set transactions ...[17746 item(s), 11733 transaction(s)] done [0.10s].
## sorting and recoding items ... [1314 item(s)] done [0.00s].
## creating sparse bit matrix ... [1314 row(s), 11733 column(s)] done [0.01s].
## writing ... [108 set(s)] done [0.50s].
## Creating S4 object ... done [0.00s].testlift <- interestMeasure(frequentItems,
measure = "lift",
transactions = transacciones)
summary(testlift)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 2.70 5.37 7.62 842.24 10.72 82631.03en contraste, con esta medida y el algoritmo apriori obtenemos:
testlift_a <- interestMeasure(reglas,
measure = "lift",
transactions = transacciones)
summary(testlift_a)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 34.41 161.45 258.82 227.92 322.03 335.23En esta medida notamos que con el algoritmo apriori tenemos menor dispersión, por lo que para este ejemplo el algoritmo apriori tiene un mejor desempeño.