Esta práctica está basada en los puntos 3.3.2, 3.3.3 y 3.4 del material didáctico (Business Analytics) de la asignatura. En los puntos 3.3.2 y 3.3.3 se explican procedimientos de segmentación no jerárquica para la formación de grupos que, respecto a la información utilizada, sean homogéneos dentro de si mismos y heterogéneos entre unos y otros. El punto 3.4 se centra en la búsqueda de asociaciones las cuales en nuestro caso se darín entre las características de los asegurados que forman parte de la catera analizada.
A lo largo de la práctica se proponen una serie de representaciones gráficas que ayudan a la interpretación de los resultados, sin embargo, podéis insertar más visualizaciones de las propuestas o incluso más código del estrictamente exigido en los ejercicios, eso sí, siempre con el objetivo de completar y mejorar el estudio propuesto.
En esta práctica importaremos los datos desde un fichero de texto .csv con los campos delimitados por “;”. Dichos datos corresponden a la información sobre algunas características de una muestra de asegurados procedentes de una cartera de seguros de automóvil. Los datos han sido extraídos de una cartera de asegurados real, aunque para garantizar la confidencialidad de la información se ha seleccionado una muestra no representativa o sesgada de la realidad.
Los objetivos de esta tercera PEC son dos. El primero se centra en la determinación de distintos perfiles de asegurados del automóvil. El segundo objetivo es encontrar asociaciones entre las características del asegurado y el tipo de garantía contratada.
Las variables que se definen en la base de datos y sus contenidos son:
–poliza: Identificador de póliza
–Sexo: Sexo del cliente
–sri: Situación de riesgo o zona de circulación urbana o no urbana
–gdi: Contratada garantía de daños propios o no
–sin: Número de siniestros en el año analizado
–ant_comp: Antigüedad del cliente en la compañía (en años)
–ant_perm: Antigüedad del permiso de conducir del asegurado (en años)
–edad: Edad del asegurado (en años)
–ant_veh: Antigüedad del vehículo asegurado (en años).
El código R que utilizaremos en la práctica se divide en apartados según las tareas que iremos realizando:
Directorio de trabajo
Importación del fichero de datos.csv. Manipulación y representación de las variables
Agrupación no jerárquica: Algoritmo kmeans
Normalización de atributos
Uso de la función kmeans() para la formación de cluster (o perfiles de individuos)
Elección del número de clústers
Búsqueda de asociaciones
Resultados por defecto del algoritmo apriori
Resultados fijando el soporte y la confianza
Resultados fijando las consecuencias (rhs)
Ejercicios PEC3: Análisis cluster con kmeans
Ejercicios PEC3: Búsqueda de asociaciones
Antes de pasar a la importación y análisis de los datos definimos un directorio de trabajo o carpeta donde tenéis guardado el fichero de datos. Recordad que si abrís el RStudio desde vuestro directorio de trabajo, pulsando sobre el fichero .RMD que se os proporciona como parte del enunciado, este paso no haría falta.
#setwd("C:/Users/Isidro/Desktop/Master/BA/PEC3")
#Cambiar el argumento de setwd() con vuestro directorio, recordad utilizad las barras /.
En primer lugar leemos el fichero de datos con extensión .csv que contiene la información de las 18.008 pólizas analizadas y mostramos su cabecera.
# Lectura de datos
Cartera<-read.table("Datos_analisis_cluster.csv",head=TRUE,sep=";")
head(Cartera)
## poliza Sexo sri gdi sin
## 1 9301800620 Mujer No urbano No contratada 0
## 2 9900363073 Hombre Urbano Garantía daños propios contratada 0
## 3 9904663030 Hombre Urbano Garantía daños propios contratada 0
## 4 9711552622 Hombre Urbano No contratada 0
## 5 9601952133 Hombre No urbano Garantía daños propios contratada 0
## 6 9905051938 Hombre No urbano No contratada 0
## ant_comp ant_perm edad ant_veh
## 1 7 9 30 7
## 2 1 0 18 2
## 3 1 35 59 1
## 4 3 43 61 2
## 5 4 0 18 1
## 6 1 32 60 1
A continuación describimos su contenido con la función summary() y con algunos gráficos. Observamos que para las variables cuantitativas la función summary() proporciona una serie de estadísticos descriptivos relacionados con la posición de la variable (media, mediana, máximo, mínimo,…). Sin embargo, para las variables cualitativas el resultado muestra las frecuencias absolutas (número de casos) de las categorías de las variables.
summary(Cartera)
## poliza Sexo sri
## Min. :1.025e+05 Hombre:13752 No urbano:11810
## 1st Qu.:8.702e+09 Mujer : 4256 Urbano : 6198
## Median :9.301e+09
## Mean :8.026e+09
## 3rd Qu.:9.703e+09
## Max. :1.000e+10
## gdi sin
## Garantía daños propios contratada: 3897 Min. :0.00000
## No contratada :14111 1st Qu.:0.00000
## Median :0.00000
## Mean :0.07741
## 3rd Qu.:0.00000
## Max. :6.00000
## ant_comp ant_perm edad ant_veh
## Min. : 0.000 Min. : 0.00 Min. :18.00 Min. : 0.000
## 1st Qu.: 1.000 1st Qu.:11.00 1st Qu.:30.00 1st Qu.: 2.000
## Median : 6.000 Median :17.00 Median :40.00 Median : 7.000
## Mean : 6.208 Mean :17.88 Mean :41.92 Mean : 7.375
## 3rd Qu.: 9.000 3rd Qu.:25.00 3rd Qu.:50.00 3rd Qu.:11.000
## Max. :30.000 Max. :47.00 Max. :65.00 Max. :38.000
Realizamos algunas representaciones gráficas para describir la base de datos Cartera, utilizamos las herramientas gráficas adecuadas para cada tipo de variable: Cualitativa o Cuantitativa. Recordad que, antes de realizar cualquier análisis, es imprescindible estudiar el comportamiento univariante y bivariante de las variables.
plot(Cartera[c("ant_comp","ant_perm")], xlab="Fidelidad", ylab="Experiencia")
title(main="Nube de puntos original", col.main="blue", font.main=1)
freq<-table(Cartera$sin)
freq
##
## 0 1 2 3 4 5 6
## 16784 1085 116 19 1 2 1
barplot(freq,xlab="Número de siniestros", ylab="Frecuencia")
title(main="Número de siniestros", col.main="blue", font.main=1)
table(Cartera$Sexo,Cartera$sin)
##
## 0 1 2 3 4 5 6
## Hombre 12849 799 84 17 1 2 0
## Mujer 3935 286 32 2 0 0 1
prop.table(table(Cartera$Sexo,Cartera$sin))
##
## 0 1 2 3 4
## Hombre 7.135162e-01 4.436917e-02 4.664594e-03 9.440249e-04 5.553088e-05
## Mujer 2.185140e-01 1.588183e-02 1.776988e-03 1.110618e-04 0.000000e+00
##
## 5 6
## Hombre 1.110618e-04 0.000000e+00
## Mujer 0.000000e+00 5.553088e-05
barplot(prop.table(table(Cartera$Sexo,Cartera$sin)),col=c("darkblue","red"))
legend(5,0.8,c("Hombre","Mujer"),fill = c("darkblue","red"))
El objetivo es utilizar la información cuantitativa relacionada con la experiencia (edad y ant_perm), con la fidelidad (ant_comp), con el vehículo (ant_veh) y con la siniestralidad (sin) para segmentar a los asegurados. Para ello, en primer lugar, definimos la base de datos con las variables cuantitativas que utilizamos en la segmentación, el resto de variables pueden servir para caracterizar los grupos formados o para otro tipo de análisis que plantearemos más adelante.
clus<-Cartera[,c("sin","ant_comp","ant_perm","edad","ant_veh")]
La varianza de las variables (o su rango de valores) utilizadas en el análisis son distintas debido a que miden características diferentes de los individuos y de su vehículo. Por ejemplo, entre las variables utilizadas en el cluster hay algunas que miden el número de años y otra que mide el número de siniestro, es decir, las escalas son muy distintas. Por tanto, antes de iniciar el proceso de segmentación es necesario normalizar los valores de las variables para eliminar el efecto de las distintas escalas de medida, esto equivale a restarles su media y dividirlas por su desviación estándar.
Para la normalización de las variables en la base de datos clus, en primer lugar copiamos su contenido en clus2:
clus2<-clus
Remplazamos las columnas de clus2 por las columnas de clus normalizadas:
clus2[,c("sin")] <- (clus$sin-mean(clus$sin))/sd(clus$sin)
clus2[,c("ant_comp")] <- (clus$ant_comp-mean(clus$ant_comp))/sd(clus$ant_comp)
clus2[,c("ant_perm")] <- (clus$ant_perm-mean(clus$ant_perm))/sd(clus$ant_perm)
clus2[,c("edad")] <- (clus$edad-mean(clus$edad))/sd(clus$edad)
clus2[,c("ant_veh")] <- (clus$ant_veh-mean(clus$ant_veh))/sd(clus$ant_veh)
Realizamos algunas representaciones gráficas para describir las variables normalizadas y comprobamos que la nube de puntos representada es igual a la original, lo único que cambia es la escala de los ejes.
#Normalizadas
plot(clus2[c("ant_comp","ant_perm")], xlab="Fidelidad", ylab="Experiencia")
title(main="Nube de puntos normalizados", col.main="blue", font.main=1)
#Originales
plot(clus[c("ant_comp","ant_perm")], xlab="Fidelidad", ylab="Experiencia")
title(main="Nube de puntos originales", col.main="blue", font.main=1)
A PARTIR DE AHORA TRABAJAMOS CON LOS DATOS NORMALIZADOS.
Los algoritmos de segmentación no supervisados, como es el kmeans(), requieren que el analista determine cuál es el número de clústers (grupos) a formar, de hecho, la función kmeans() incorpora como parámetro el número de clústers (centers=).
Para seleccionar el número de grupos podemos utilizar criterios subjetivos o criterios objetivos. Los criterios subjetivos se basan en la visualización de los resultados para determinar el número de clústers más apropiado o en la simple experiencia. A continuación, utilizamos la función kmeans() para formar 3 grupos de individuos y visualizamos algunos resultados como son: los centros de grupos (centers), la suma de cuadrados totales (totss), las sumas de cuadrados dentro de cada grupo y para todos de forma conjunta (withinss y tot.withinss) y la suma de cuadrados entre grupos (betweenss).
set.seed(123)
clus2_k3<-kmeans(clus2,centers=3)
clus2_k3$centers
## sin ant_comp ant_perm edad ant_veh
## 1 0.005437711 -0.2027385 -1.0355525 -1.2070387 -0.1032724
## 2 0.065396764 -0.5994100 0.3558975 0.5799653 -0.2997005
## 3 -0.103954510 1.1181227 0.5858263 0.4351901 0.5611122
clus2_k3$totss
## [1] 90035
clus2_k3$withinss
## [1] 16051.53 25565.78 16869.30
clus2_k3$tot.withinss
## [1] 58486.61
clus2_k3$betweenss
## [1] 31548.39
Para la selección del número de clústers también existen criterios objetivos los cuales están basados en la optimización de un criterio de ajuste.
Los criterios de ajustes en el kmeans() se basan en los conceptos de sumas de cuadrados entre grupos (betweens) y dentro de grupos (withins). Hay que tener en cuenta que la suma de cuadrados entre grupos (betweenss) más las sumas de cuadrados dentro de grupos (tot.withinss) nos proporciona la suma de cuadrados totales (tots). Recordad también que las sumas de cuadrados corresponden a los numeradores de las varianzas correspondientes.
Una segmentación ‘óptima’ es aquella donde los individuos pertenecientes a un mismo grupo son lo más homogéneos posible y los individuos pertenecientes a distintos grupos son lo más heterogéneos posible. Dicha segmentación coincidirán con aquella que, teniendo un número de grupos razonable, posee una suma de cuadrados entre suficientemente grande y, por tanto, una suma de cuadrados dentro lo suficientemente pequeña. Es decir, la varianza dentro de grupos debe ser reducida (individuos dentro de un mismo grupo tiene que ser similares) y la varianza entre grupos debe ser grande (individuos de distintos grupos tienen que ser distintos). También, tenemos que tener en cuenta que a medida que el número de grupos aumenta la suma de cuadrados entre aumenta y, por tanto, la suma de cuadrados dentro disminuye, por tanto, el analista a de decidir cuando el aumento de la suma de cuadrados entre o, alternativamente, la disminución de la suma de cuadrados dentro no son lo suficientemente pronunciados. Por ejemplo, comparamos los resultados para los casos de formar 2 y 3 grupos.
#Suma de cuadrados entre grupos
kmeans(clus2,2)$betweenss
## [1] 20737.36
kmeans(clus2,3)$betweenss
## [1] 31548.39
#Suma de cuadrados dentro grupos
kmeans(clus2,2)$tot.withinss
## [1] 69297.64
kmeans(clus2,3)$tot.withinss
## [1] 58486.58
#Suma de cuadrados total
kmeans(clus2,2)$totss
## [1] 90035
kmeans(clus2,3)$totss
## [1] 90035
A continuación, definimos el modo de obtener un gráfico que nos represente la suma de cuadrados entre grupos en función del número de grupos.
set.seed(123)
bss <- kmeans(clus2,centers=1)$betweenss
for (i in 2:10) bss[i] <- kmeans(clus2,centers=i)$betweenss
plot(1:10, bss, type="l", xlab="Número de grupos",ylab="Sumas de cuadrados entre grupos")
En este apartado de la práctica nos centraremos en la búsqueda de asociaciones entre algunos atributos de los individuos analizados, los cuales están registrados en la base de datos Cartera definida al inicio de esta PEC. En concreto trabajaremos con las variables: Sexo, sri y gdi. Denominamos a nuestra nueva base de datos aso_car.
aso_car<-Cartera[,c("Sexo","sri","gdi")]
head(aso_car)
## Sexo sri gdi
## 1 Mujer No urbano No contratada
## 2 Hombre Urbano Garantía daños propios contratada
## 3 Hombre Urbano Garantía daños propios contratada
## 4 Hombre Urbano No contratada
## 5 Hombre No urbano Garantía daños propios contratada
## 6 Hombre No urbano No contratada
Para realizar el análisis necesitamos instalar el paquete “arules”. Para ello marca la siguiente fila y ejecuta de forma aislada:
install.packages(“arules”)
El algoritmo apriori fue diseñado para la búsqueda de asociaciones entre los productos que forman parte de la cesta de la compra en el supermercado, hipermercado o gran superficie. El objetivo era determinar que productos eran causa de la compra de otros. Sin embargo, el algoritmo apriori puede generalizarse para la búsqueda de asociaciones entre cualquier conjunto de items. En esta PEC el objetivo sería buscar asociaciones entre los items que caracterizan a los asegurados, en total 6 características: hombre, mujer, urbano, no urbano, garantía daños propios contratada y no contratada. Para ello se definen las denominadas “reglas de asociación”. Una “regla de asociación” está formada por uno o más antecedentes y una consecuencia y, en su forma más simple, está caracterizada por su “soporte” (porcentaje de casos en los que se dan los antecedentes conjuntamente) y su confianza (porcentaje de casos en los que se da la consecuencia junto con los antecedentes respecto a las veces que se dan los antecedentes conjuntamente).
A continuación, se realiza la búsqueda de reglas de asociación que el algoritmo apriori determina por defecto. Observamos que únicamente encuentra una regla de asociación que nos indica que aquellos asegurados hombres con situación de riesgo urbana (antecedentes) no contratan la garantía daños propios (consecuencia), el soporte de esta regla es del 21,21% y su confianza es del 80,88%. El parámetro lift o apalancamiento (=1.03) es el cociente entre la confianza de la regla y el soporte de la consecuencia, este parámetro permite valorar si dicha consecuencia tiene más probabilidad cuando se da el antecedente o en general.
library(arules)
## Loading required package: Matrix
##
## Attaching package: 'arules'
## The following objects are masked from 'package:base':
##
## abbreviate, write
apriori(aso_car)
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.1 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 1800
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [1 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 1 rules
inspect(apriori(aso_car))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.1 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 1800
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [1 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## lhs rhs support confidence
## [1] {Sexo=Hombre,sri=Urbano} => {gdi=No contratada} 0.2121279 0.808808
## lift
## [1] 1.032174
De los resultados del apartado 7.1 también puede deducirse que, por defecto, el algoritmo apriori de R busca reglas de asociación con un soporte del 10% o superior y una confianza del 80% o superior. Sin embargo, dada la frecuencia de casos que tenemos en nuestra base de datos y su elevada dispersión, se decide reducir el soporte al 5% y la confianza al 70%. Se observa que con estos parámetros el número de reglas asciende a 18 y las 2 primeras no tienen antecedente (en estos 2 casos el soporte coincide con la confianza).
apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.7 , target = "rules"))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [18 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 18 rules
inspect(apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.7 , target = "rules")))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.01s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [18 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## lhs rhs support confidence lift
## [1] {} => {Sexo=Hombre} 0.76366060 0.7636606 1.0000000
## [2] {} => {gdi=No contratada} 0.78359618 0.7835962 1.0000000
## [3] {gdi=Garantía daños propios contratada} => {Sexo=Hombre} 0.15493114 0.7159353 0.9375046
## [4] {Sexo=Mujer} => {gdi=No contratada} 0.17486673 0.7398966 0.9442320
## [5] {sri=Urbano} => {Sexo=Hombre} 0.26227232 0.7620200 0.9978517
## [6] {sri=Urbano} => {gdi=No contratada} 0.27326744 0.7939658 1.0132334
## [7] {sri=No urbano} => {Sexo=Hombre} 0.50138827 0.7645216 1.0011275
## [8] {sri=No urbano} => {gdi=No contratada} 0.51032874 0.7781541 0.9930550
## [9] {Sexo=Hombre} => {gdi=No contratada} 0.60872945 0.7971204 1.0172592
## [10] {gdi=No contratada} => {Sexo=Hombre} 0.60872945 0.7768408 1.0172592
## [11] {sri=Urbano,
## gdi=Garantía daños propios contratada} => {Sexo=Hombre} 0.05014438 0.7071261 0.9259691
## [12] {sri=No urbano,
## gdi=Garantía daños propios contratada} => {Sexo=Hombre} 0.10478676 0.7202290 0.9431271
## [13] {Sexo=Mujer,
## sri=Urbano} => {gdi=No contratada} 0.06113949 0.7464407 0.9525834
## [14] {Sexo=Mujer,
## sri=No urbano} => {gdi=No contratada} 0.11372723 0.7364257 0.9398026
## [15] {Sexo=Hombre,
## sri=Urbano} => {gdi=No contratada} 0.21212794 0.8088080 1.0321745
## [16] {sri=Urbano,
## gdi=No contratada} => {Sexo=Hombre} 0.21212794 0.7762650 1.0165052
## [17] {Sexo=Hombre,
## sri=No urbano} => {gdi=No contratada} 0.39660151 0.7910068 1.0094571
## [18] {sri=No urbano,
## gdi=No contratada} => {Sexo=Hombre} 0.39660151 0.7771491 1.0176629
También, es importante tener en cuenta que en ocasiones el interés radica en la búsqueda de antecedentes dada una consecuencia. En el ejemplo de esta PEC el interés podría ser analizar los antecedentes asociados a las garantías contratadas (en este caso representadas por las dos categorías de la variable gdi). Para ello se le indica al algoritmo que busque las reglas de asociación con dichos antecedentes.
apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.7 , target = "rules"),appearance = list(rhs=c("gdi=No contratada", "gdi=Garantía daños propios contratada"), default="lhs"))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[2 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [9 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 9 rules
inspect(apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.7 , target = "rules"),appearance = list(rhs=c("gdi=No contratada", "gdi=Garantía daños propios contratada"), default="lhs")))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.7 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[2 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [9 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## lhs rhs support
## [1] {} => {gdi=No contratada} 0.78359618
## [2] {Sexo=Mujer} => {gdi=No contratada} 0.17486673
## [3] {sri=Urbano} => {gdi=No contratada} 0.27326744
## [4] {sri=No urbano} => {gdi=No contratada} 0.51032874
## [5] {Sexo=Hombre} => {gdi=No contratada} 0.60872945
## [6] {Sexo=Mujer,sri=Urbano} => {gdi=No contratada} 0.06113949
## [7] {Sexo=Mujer,sri=No urbano} => {gdi=No contratada} 0.11372723
## [8] {Sexo=Hombre,sri=Urbano} => {gdi=No contratada} 0.21212794
## [9] {Sexo=Hombre,sri=No urbano} => {gdi=No contratada} 0.39660151
## confidence lift
## [1] 0.7835962 1.0000000
## [2] 0.7398966 0.9442320
## [3] 0.7939658 1.0132334
## [4] 0.7781541 0.9930550
## [5] 0.7971204 1.0172592
## [6] 0.7464407 0.9525834
## [7] 0.7364257 0.9398026
## [8] 0.8088080 1.0321745
## [9] 0.7910068 1.0094571
En el apartado 6.1, se seleccionan las variables cuantitativas para realizar la segmentación. ¿Sería posible incluir variables categóricas? ¿Cómo se incluirían? Elige una variable categórica e inclúyela en una segmentación K-means.
Las variables categóricas como tal no se pueden incluir en el algoritmo k-means, lo que sí podemos hacer es construir una nueva variable númerica binaria que asocie un 1 o 0 según tengan dicha categoría o no. En el caso de variables categorícas con solo dos valores nos valdría con crear una sola variable ya que el valor 1 representaría a uno de los valores y el 0 al otro. En nuestro caso las tres variables categóricas tienen solo dos valores por lo que en los tres casos podríamos incluirlas de la misma forma. De esta forma haríamos la siguientes transformaciones:
# Código respuesta 1
Sexo_n=as.numeric(Cartera$Sexo=="Hombre")
gdi_n=as.numeric(Cartera$gdi=="Garantía daños propios contratada")
sri_n=as.numeric(Cartera$sri=="Urbano")
Estas nuevas variables las pordríamos usar en nuestra segmentación.
En el apartado 6.2 se ha establecido una semilla mediante el comando set.seed(). ¿Por que motivo hay que incluir una semilla? ¿Qué pasaría si no se incluye la semilla? Justifique su respuesta y compleméntela con ejemplos.
K-means usa numeros aleatorios para el cálculo de los centros, la semilla se incluye para que dichos valores aleatorios sean los mismos y por tanto nuestros resultados sean los mismos cada vez que ejecutemos. Si no incluimos la semilla no tenemos asegurados que en diferentes ejecuciones los centros calculados sean los mismos.
# Código respuesta 2
set.seed(123)
clus2_k3_p1<-kmeans(clus2,centers=3)
print("Semilla 123")
## [1] "Semilla 123"
clus2_k3_p1$centers
## sin ant_comp ant_perm edad ant_veh
## 1 0.005437711 -0.2027385 -1.0355525 -1.2070387 -0.1032724
## 2 0.065396764 -0.5994100 0.3558975 0.5799653 -0.2997005
## 3 -0.103954510 1.1181227 0.5858263 0.4351901 0.5611122
# Cambiamos la semilla
set.seed(40)
clus2_k3_p2<-kmeans(clus2,centers=3)
#Obtenemos valores distintos
print("Semilla 40")
## [1] "Semilla 40"
clus2_k3_p2$centers
## sin ant_comp ant_perm edad ant_veh
## 1 0.070418545 -0.5991331 0.3537699 0.5784068 -0.3054042
## 2 -0.106605321 1.1103612 0.5861008 0.4365967 0.5672132
## 3 0.001636349 -0.2032214 -1.0359683 -1.2081546 -0.1047207
# Sin especificar semilla volvemos a obterner valores distintos
clus2_k3_p3<-kmeans(clus2,centers=3)
print("Semilla no especificada")
## [1] "Semilla no especificada"
clus2_k3_p3$centers
## sin ant_comp ant_perm edad ant_veh
## 1 0.070418545 -0.5991331 0.3537699 0.5784068 -0.3054042
## 2 0.001636349 -0.2032214 -1.0359683 -1.2081546 -0.1047207
## 3 -0.106605321 1.1103612 0.5861008 0.4365967 0.5672132
#Si volvemos a poner la semilla inicia obtenemos identicos resultados
set.seed(123)
clus2_k3_p4<-kmeans(clus2,centers=3)
print("Semilla 123")
## [1] "Semilla 123"
clus2_k3_p4$centers
## sin ant_comp ant_perm edad ant_veh
## 1 0.005437711 -0.2027385 -1.0355525 -1.2070387 -0.1032724
## 2 0.065396764 -0.5994100 0.3558975 0.5799653 -0.2997005
## 3 -0.103954510 1.1181227 0.5858263 0.4351901 0.5611122
En el apartado 5 se muestra la nube de puntos original de la relación entre la Experiencia y la Fidelidad. En este ejercicio se pide colorear los puntos en función al segmento al que se clasifica, incluyendo el atributo col=clus2_k3$cluster, dentro de la función plot. Muestre el nuevo gráfico e interprete los resultados. ¿Hay diferencias en la Experiencia y la Fidelidad de los tres segmentos?
Comentarios respuesta 3
# Código respuesta 3
col=clus2_k3$cluster
Cartera_k<-data.frame(Cartera,col)
plot(Cartera_k[c("ant_comp","ant_perm")],col=Cartera_k$col, xlab="Fidelidad", ylab="Experiencia")
title(main="Número de siniestros", col.main="blue", font.main=1)
Podemos observar como por un lado uno de los clúster se agrupa en la parte inferior, perteneciendo a este la mayoría de los usuarios con menor experiencia. Ya entre los asegurados con más experiencia tenemos los otros dos clústers dividiendo los que llevan menos tiempo en la compañía de los que llevan más tiempo.
Por lo que podemos afirmar que si hay diferencias entre experiencia y fidelidad entre los tres grupos en términos generales.
Una de las funciones más comunes de las segmentaciones es separar conjuntos de clientes con características comunes para gestionarlos de forma específica.
En el apartado 6.2 se muestran los centroides de los 3 segmentos, pero la información no es fácilmente interpretable puesto que las variables están normalizadas. Para poder interpretar las variables deberíamos invertir la normalización. Así, para la semgnetación kmeans con k=3 tenemos que los centros originales serían:
aggregate(clus, by = list(clus2_k3$cluster), mean)
## Group.1 sin ant_comp ant_perm edad ant_veh
## 1 1 0.07908773 5.125253 7.220526 26.69800 6.803200
## 2 2 0.09758685 3.007292 21.542164 49.23919 5.714665
## 3 3 0.04533705 12.177769 23.908729 47.41300 10.484987
En este caso, podríamos ver diferencias entre los segmentos, por ejemplo, la edad media del primer segmento es 26,7 años, mientras que los segmentos 2 y 3 están conformados por personas con edad media cercana a los 48 años. Por lo que las estrategias de gestión serán distintas.
En este apartado se pide, realizar una segmentación para k=5 utilizando la información normalizada en el apartado 6.1 (data.frame clus2) e interprete los 5 grupos que aparecen. Para unificar los resultados fijar la semilla en 123 (set.seed(123))
Comentarios respuesta 4
# Código respuesta 4
set.seed(123)
clus2_k5<-kmeans(clus2,centers=5)
#clus2_k5$centers
#Desnormalizamos
aggregate(clus, by = list(clus2_k5$cluster), mean)
## Group.1 sin ant_comp ant_perm edad ant_veh
## 1 1 1.139458573 5.141920 17.266612 41.28794 6.656276
## 2 2 0.000000000 3.426709 21.561833 49.40083 3.255235
## 3 3 0.001377031 13.768383 24.135224 47.20518 8.861195
## 4 4 0.000000000 5.205975 6.988639 26.23038 6.462024
## 5 5 0.000000000 4.019743 21.214478 47.40862 13.561771
Observamos la sigueientes diferencias:
Cluster 1: Se diferencia del resto por el número de sinietros.
Cluster 2: Este grupo tenemos a los asegurados más recientes en la compañía con vehículos más nuevos.
Cluster 3: En este grupo tenemos a los más fieles a la compañía, los que tienen más años de antigüedad.
Cluster 4: Este cluster reune a en su mayoría a los más jóvenes. Media de edad 26 años.
Cluster 5: Este aglutina los asegurados con vehículos con más años, su media dobla al de resto de grupos.
En el apartado 6.3 sobre la elección del numero de clústers se muestra un gráfico que toma como variable referencia la suma de cuadrados entre ‘$betweenss’.
Dibuja un gráfico equivalente, tomando como referencia la suma de cuadrados en ‘$tot.withinss’ e interpreta el resultado proponiendo un número de clústers adecuado para el juego de datos.
Para la elección de K intentamos que la suma de cuadrados sea lo mayor posible etre grupos y menor posible inter grupo. Teniendo en cuenta que cuanto mayor k dichos valores aumentan y disminuyen respectivamente, tendremos que tener en cuenta cuando un cluster más nos aporta una mejora rentable en dichos valores. Si revisamos el gráfico del apartado 6.3 vemos que a partir de k=5 la pendiente de crecimiento es mucho menor, por lo que parece que más de 5 clusteres no nos proporcionan benecios en cuanto a suma de cuadrados entre grupos. Veamos que obtenemos intergrupo:
# Código respuesta 5
set.seed(123)
tot_w <- kmeans(clus2,centers=1)$tot.withinss
for (i in 2:10) tot_w[i] <- kmeans(clus2,centers=i)$tot.withinss
plot(1:10, tot_w, type="l", xlab="Número de grupos",ylab="Sumas de cuadrados entre grupos")
Observamos que al igual que con los cuadrados entre grupos a partir de k=5, la pendiente deja de ser tan pronunciada dejando de ser rentable crear grupos adicionales. Por lo que yo elegiría K=5, ya que sí hay una mejora significativa respecto a k=4.
¿Tiene sentido normalizar variables para un algoritmo de búsqueda de asociaciones como Apriori?
No, ya que buscas asociaciones entre items no importando la escala de estos. Lo que si sería interesante e una variable continua pasarla a categórica por tramos, para buscar asociaciones más sencillas.
En el apartado 7 se han seleccionado las variables categóricas para la búsqueda de asociaciones. Analice y justifique el motivo por el que no se han incluido variables cuantitativas. ¿Habría alguna forma de incluirlas para enriquecer el análisis y las reglas de asociación?
Cómo indicaba en la pregunta anterior el algoritmo usca asociaciones entre items, al tener variables continuas con mucho posibles valores su utilidad disminuye y dificulta la búsqueda de asociaciones. Una forma de incorporar variables cuantitativa es agrupar sus valores por tramos, por ejemplo con la edad podríamos agrupar enlos siguientes rangos: menores de 26 años, entre 26 y 55 años y mayores a 55.
De igual forma el resto de variables cada uno con sus tramos convenientes. Hacemos el ejemplo definido con la edad:
# Código respuesta 7
edad_c<-Cartera$edad
edad_c[edad_c<26] <- "18-26"
edad_c[edad_c>=26 & edad_c<=55] <- "26-55"
edad_c[Cartera$edad>55] <- "55+"
table(edad_c)
## edad_c
## 18-26 26-55 55+
## 2082 12729 3197
barplot(table(edad_c))
Así l avariable edad_c podríamos usarla en nuestras asociaciones
En el apartado 7.1 no se ha fijado la semilla antes de realizar el algoritmo apriori. ¿Cuál es el motivo de no incluirla?. Si se ejecuta el algoritmo varias veces, ¿Se obtendrían los mismos resultados? ¿Qué resultados cambian?. Justifique su respuesta y acompañela de los ejemplos necesarios.
El algoritmo a priori no usa ningún número aleatorio para su ejecución es por ello que no es necesario indicar una semilla. Este se basa en nuestro dataframe y busca asociaciones entre cuando apraece un valor en una de las variables en cuanto porcentaje esta asociado el valor de otra.
Para probar que tal como decimos no usa la aletoreidad vamos a ejecutar varias veces el algoritmo con diatintas semillas
# Código respuesta 8
set.seed(128)
apriori(aso_car)
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.1 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 1800
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.01s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [1 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 1 rules
set.seed(40)
apriori(aso_car)
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.8 0.1 1 none FALSE TRUE 5 0.1 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 1800
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.02s].
## checking subsets of size 1 2 3 done [0.00s].
## writing ... [1 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 1 rules
Podemos ver que no cambia nada. Siempre que tengamos los mismos valores de entrada obtendremos las mismas asociaciones para un soporte y confianza determinado.
¿Están relacionadas las reglas de asociación X->Y e Y->X?. Analice las relaciones entre el soporte y la esperanza de ambas reglas. Para facilitar la comprensión puede comparar la regla 10 del apartado 7.2 con la regla 5 del apartado 7.3.
Vemos los valores de ambas asociaciones: lhs rhs support confidence lift
[10] {gdi=No contratada} => {Sexo=Hombre} 0.60872945 0.7768408 1.0172592
[5] {Sexo=Hombre} => {gdi=No contratada} 0.60872945 0.7971204 1.0172592
Las asociaciones X->Y e Y->X son identicas, ya que no se tiene en cuenta la causalidad sino la coocurrencia, por lo que los resultados de una y otra son iguales.
En el apartado 7.3 se han fijado las consecuencias, pero es probable que en algunas circunstancias sólo conozcamos algunos antecedentes. Por ejemplo que sólo se disponga de la información sobre el sexo. En este apartado se solicita calcular las reglas que se podrían extraer si sólo se conociese el sexo del cliente. Para ello cambie los parámetros por la siguiente expresión: parameter = list ( supp = 0.05 , conf= 0.6 , target = “rules”),appearance = list(lhs=c(“Sexo=Mujer”,“Sexo=Hombre”), default=“rhs”)
¿Cuántas reglas obtenemos?
Interprete las reglas obtenidas y valore su eficacia.
Comentarios respuesta 10
# Código respuesta 10
apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.6 , target = "rules"),appearance = list(lhs=c("Sexo=Mujer","Sexo=Hombre"), default="rhs"))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[2 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.01s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 done [0.00s].
## writing ... [6 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## set of 6 rules
Por lo vemos que hemos obtenido 6 asociaciones
Pasamos a ver cada una de estas reglas
inspect(apriori(aso_car,parameter = list ( supp = 0.05 , conf= 0.6 , target = "rules"),appearance = list(lhs=c("Sexo=Mujer","Sexo=Hombre"), default="rhs")))
## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 1
## maxlen target ext
## 10 rules FALSE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 900
##
## set item appearances ...[2 item(s)] done [0.00s].
## set transactions ...[6 item(s), 18008 transaction(s)] done [0.00s].
## sorting and recoding items ... [6 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 done [0.00s].
## writing ... [6 rule(s)] done [0.00s].
## creating S4 object ... done [0.00s].
## lhs rhs support confidence lift
## [1] {} => {sri=No urbano} 0.6558196 0.6558196 1.0000000
## [2] {} => {gdi=No contratada} 0.7835962 0.7835962 1.0000000
## [3] {Sexo=Mujer} => {sri=No urbano} 0.1544314 0.6534305 0.9963569
## [4] {Sexo=Mujer} => {gdi=No contratada} 0.1748667 0.7398966 0.9442320
## [5] {Sexo=Hombre} => {sri=No urbano} 0.5013883 0.6565590 1.0011275
## [6] {Sexo=Hombre} => {gdi=No contratada} 0.6087295 0.7971204 1.0172592
Pasamos a comentar cada una de las obtenidas - [1] Independientemente del sexo prodíamos decir que la zona de circulación es no urbana con una confiaza del 65%
[2] Igual que la anterior, sin importar el sexo podríamos decir con una confianza del 78% que no se tendrá la garantía de daños contratada.
[3] y [4] En este caso tenemos que para las mujeres con una confianza del 65% y 73% podemos decir que circulan por zona no urbana y sin garantía contratada respectivamente. En ambos casos el soporte es muy bajo, indicando que en ambos casos menos del 18 % ha aparecido esta asociación, por lo que su eficacia no será muy alta.
[5] y [6] Lo contrario pasa con con los hombres donde obtenemos valores de confianza similares, pero el soporte es bastante mayor por lo que son reglas más eficaces.
Viendo todas las más eficaces serían la [2] y la [6] ya que son las que cuentan con mayor aportación y mantienen la confianza requerida.