INSTRUCCIONES
El siguiente taller incluye un problema de aplicación de la técnica multivariada conocida como Análisis de Correspondencias (AC).
Problema
Elija dos variables categóricas de una base de datos relacionada con su área de conocimientos y desarrolle un análisis de correspondencias (AC), mostrando la tabla de contingencia, la tabla de frecuencias relativas, las gráficas de barras de los perfiles fila y columna, y la gráfica de los puntos de los perfiles fila y columna superpuestos en el primer plano factorial (biplot). Haga una interpretación práctica de los resultados. ¿Están relacionadas las dos variables seleccionadas o son independientes?
Contexto
La industria de telecomunicaciones se enfrenta a una competencia fuerte con el propósito de satisfacer a sus clientes. El papel en el sistema predicción de abandono es muy importante y no solo se limita a predecir con precisión los abandonos, si no también a interpretar el comportamiento del abandono del cliente.
Esta base de datos se ha descargado de kaggle:https://www.kaggle.com/jpacse/datasets-for-churn-telecom?select=cell2celltrain.csv además se ha procesado previamente y se proporciona una versión equilibrada para analizar el proceso. Consta de 71 047 registros y 58 atributos o variables.
Cargamos el dataset y vemos el nombre de las variables:
names(data)## [1] "CustomerID" "Churn"
## [3] "MonthlyRevenue" "MonthlyMinutes"
## [5] "TotalRecurringCharge" "DirectorAssistedCalls"
## [7] "OverageMinutes" "RoamingCalls"
## [9] "PercChangeMinutes" "PercChangeRevenues"
## [11] "DroppedCalls" "BlockedCalls"
## [13] "UnansweredCalls" "CustomerCareCalls"
## [15] "ThreewayCalls" "ReceivedCalls"
## [17] "OutboundCalls" "InboundCalls"
## [19] "PeakCallsInOut" "OffPeakCallsInOut"
## [21] "DroppedBlockedCalls" "CallForwardingCalls"
## [23] "CallWaitingCalls" "MonthsInService"
## [25] "UniqueSubs" "ActiveSubs"
## [27] "ServiceArea" "Handsets"
## [29] "HandsetModels" "CurrentEquipmentDays"
## [31] "AgeHH1" "AgeHH2"
## [33] "ChildrenInHH" "HandsetRefurbished"
## [35] "HandsetWebCapable" "TruckOwner"
## [37] "RVOwner" "Homeownership"
## [39] "BuysViaMailOrder" "RespondsToMailOffers"
## [41] "OptOutMailings" "NonUSTravel"
## [43] "OwnsComputer" "HasCreditCard"
## [45] "RetentionCalls" "RetentionOffersAccepted"
## [47] "NewCellphoneUser" "NotNewCellphoneUser"
## [49] "ReferralsMadeBySubscriber" "IncomeGroup"
## [51] "OwnsMotorcycle" "AdjustmentsToCreditRating"
## [53] "HandsetPrice" "MadeCallToRetentionTeam"
## [55] "CreditRating" "PrizmCode"
## [57] "Occupation" "MaritalStatus"Se eligen dos variables categóricas para realizar el análisis de correspondencia simple:
| Variable | Descripción |
|---|---|
| CreditRating | Nivel de crédito del subscriptor |
| Occupation | La ocupación del subscriptor |
Hacemos el filtrado de variables
data_cat = data[,c("CreditRating","Occupation")]
data_cat$CreditRating = as.factor(data$CreditRating)
data_cat$Occupation = as.factor(data$Occupation)
str(data_cat)## 'data.frame': 51047 obs. of 2 variables:
## $ CreditRating: Factor w/ 7 levels "1-Highest","2-High",..: 1 4 3 4 1 3 1 1 1 3 ...
## $ Occupation : Factor w/ 8 levels "Clerical","Crafts",..: 5 5 2 4 5 4 7 5 4 5 ...Ya definidas las dos variables categóricas y para aplicar la temática eliminamos todos los registros que contienen un NA en este nuevo dataframe data_cat
data_cat <- na.omit(data_cat)
nrow(data_cat)## [1] 51047Cómo vemos el número de registros es igual al dataframe original por lo que no se eliminó alguno ya que ninguno contiene un NA
Observamos los datos:
library(DT)
DT::datatable(data_cat)str(data_cat)## 'data.frame': 51047 obs. of 2 variables:
## $ CreditRating: Factor w/ 7 levels "1-Highest","2-High",..: 1 4 3 4 1 3 1 1 1 3 ...
## $ Occupation : Factor w/ 8 levels "Clerical","Crafts",..: 5 5 2 4 5 4 7 5 4 5 ...Tabla de Contingencia
Obtenemos la tabla de contigencia o de frecuencia absoluta para todos los registros en función de las dos variables categóricas así:
dt = table(data_cat)
dt## Occupation
## CreditRating Clerical Crafts Homemaker Other Professional Retired Self Student
## 1-Highest 183 232 29 5536 2082 161 225 74
## 2-High 360 598 54 12897 4196 385 335 168
## 3-Good 171 277 33 6482 1154 87 153 53
## 4-Medium 106 171 13 4403 518 44 68 34
## 5-Low 129 189 19 5434 587 45 69 27
## 6-VeryLow 19 16 3 978 106 4 14 12
## 7-Lowest 18 36 6 1907 112 7 15 13La suma de todas las celdas de la tabla es igual al total de registro de la tabla de categorías, de modo que se hacen conjuntos que pertenecen a dos grupos en particular o categorías de las variables CrediRating y Occupation
Tabla de Frecuencias Relativas
De igual manera, la tabla de frecuencias relativas:
dt_r = round(prop.table(dt)*100,2)
dt_r## Occupation
## CreditRating Clerical Crafts Homemaker Other Professional Retired Self Student
## 1-Highest 0.36 0.45 0.06 10.84 4.08 0.32 0.44 0.14
## 2-High 0.71 1.17 0.11 25.26 8.22 0.75 0.66 0.33
## 3-Good 0.33 0.54 0.06 12.70 2.26 0.17 0.30 0.10
## 4-Medium 0.21 0.33 0.03 8.63 1.01 0.09 0.13 0.07
## 5-Low 0.25 0.37 0.04 10.65 1.15 0.09 0.14 0.05
## 6-VeryLow 0.04 0.03 0.01 1.92 0.21 0.01 0.03 0.02
## 7-Lowest 0.04 0.07 0.01 3.74 0.22 0.01 0.03 0.03Esta tabla es de frecuencias, por lo que indica lo mismo que la absoluta pero facilita su interpretación por que describe las proporciones de personas o registros que pertecen a categorías específicas.
Realizamos un gráfico de balones para identificar de manera visual y más fácil la proporción, así:
library("FactoMineR")
library("factoextra")
library("ggplot2")
library("gplots")
balloonplot(t(dt), main = "Teleco Business", xlab="Occupation",
label=FALSE, show.margins =FALSE)
Esta tabla es la más gráfica y facilita la interpretación para la cantidad de registros que pertenecen a las categorías que en este caso están en función de dos variables no más. Vemos que no existe demasiada información para el analista porque la categoría de mayor peso en la variable Occupation es “other”. Sin embargo nos indica que la mayoría de clientes son el complemento de las demás categorías de ocupación: Clerical, Student, etc.
También puede indicar que el cliente no quiere dar datos exactos de acuerdo a su ocupación o que el encuestador no los ha obtenido de la manera correcta. Además de esto la otra categoría que mayor tiene peso en Occupation es “Professional” con un CreditRating “High” apreciable.
Gráfica de barras de los perfiles fila y columna
Agregamos la fila suma y columna suma a la tabla de contingencia que describe la suma de manera marginal de los grupos que están en la categoría particular, así:
library(reshape2)
library(lattice)
tabla = addmargins(dt)
tabla## Occupation
## CreditRating Clerical Crafts Homemaker Other Professional Retired Self Student
## 1-Highest 183 232 29 5536 2082 161 225 74
## 2-High 360 598 54 12897 4196 385 335 168
## 3-Good 171 277 33 6482 1154 87 153 53
## 4-Medium 106 171 13 4403 518 44 68 34
## 5-Low 129 189 19 5434 587 45 69 27
## 6-VeryLow 19 16 3 978 106 4 14 12
## 7-Lowest 18 36 6 1907 112 7 15 13
## Sum 986 1519 157 37637 8755 733 879 381
## Occupation
## CreditRating Sum
## 1-Highest 8522
## 2-High 18993
## 3-Good 8410
## 4-Medium 5357
## 5-Low 6499
## 6-VeryLow 1152
## 7-Lowest 2114
## Sum 51047Prueba de Independencia
Para realizar la prueba de independencia realizamos el test chi cuadrado sobre la tabla de contingencia, así:
chisq = chisq.test(dt)
chisq##
## Pearson's Chi-squared test
##
## data: dt
## X-squared = 1938.8, df = 42, p-value < 2.2e-16Esta prueba nos dice que H0 = Independencia y H1 = Dependencia. De modo que como el p_valor es < 0.05 rechazamos la hipótesis nula y por ende no tiene sentido hacer un análisis de correspondencia para estas variables.
Sin embargo para efectos prácticos de este laboratorio se realizará este análisis de correspondencia.
Análisis de Correspondencia
Realizamos el análisis de correspondencia para la tabla de contingencia
res.ca <- CA(dt, graph = FALSE)
print(res.ca)## **Results of the Correspondence Analysis (CA)**
## The row variable has 7 categories; the column variable has 8 categories
## The chi square of independence between the two variables is equal to 1938.767 (p-value = 0 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"Al igual que cuando realizamos el test chi cuadrado, este resumen nos aclara nuevamente que no existe la independencia entre estas variables.
extraemos los autovalores/varianzas retenidos por cada dimensión(eje)
get_eigenvalue(res.ca)## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.634659e-02 95.69916151 95.69916
## Dim.2 7.738330e-04 2.03747263 97.73663
## Dim.3 6.775577e-04 1.78398346 99.52062
## Dim.4 8.343151e-05 0.21967196 99.74029
## Dim.5 8.018723e-05 0.21112989 99.95142
## Dim.6 1.845092e-05 0.04858055 100.00000Este análisis indica que sólo la primer componente Dim 1 es capaz de representar el 95% de la varianza de los datos
Visualizamos los valores propios
fviz_eig(res.ca)
Ahora si, las gráficas de barras de los perfiles fila y columna
datosf = melt(prop.table(tabla))
#Perfiles Fila
barchart(value~Occupation|CreditRating, data=datosf,
xlab="Occupation", main="Perfiles Fila",
scales = list(x = list(rot = 90)))
dt## Occupation
## CreditRating Clerical Crafts Homemaker Other Professional Retired Self Student
## 1-Highest 183 232 29 5536 2082 161 225 74
## 2-High 360 598 54 12897 4196 385 335 168
## 3-Good 171 277 33 6482 1154 87 153 53
## 4-Medium 106 171 13 4403 518 44 68 34
## 5-Low 129 189 19 5434 587 45 69 27
## 6-VeryLow 19 16 3 978 106 4 14 12
## 7-Lowest 18 36 6 1907 112 7 15 13#Perfiles Columna
barchart(value~CreditRating|Occupation, data=datosf,
xlab="CreditRating", main="Perfiles Columna",
scales = list(x = list(rot = 90)))
De estos gráficos no se puede obtener mucha información más allá de la comentada anteriormente. Por ejemplo para el perfil de Columna la categoría Other es representativa en comparación a las demás, y el CreditRating es alto para High y va disminuyendo a medida que baja el CreditRating generando el comportamiento de una normal sesgada hacia la derecha. Para la de perfiles ila la mayor información está en la categoría High pero esta no es demasiado representativa.
Gráfico de los perfiles fila y columna superpuestos en el primer plano factorial
En este caso usamos un biplot simétrico:
library("FactoMineR")
library("factoextra")
library("ggplot2")
res.ca <- CA(dt, graph = FALSE)
print(res.ca)## **Results of the Correspondence Analysis (CA)**
## The row variable has 7 categories; the column variable has 8 categories
## The chi square of independence between the two variables is equal to 1938.767 (p-value = 0 ).
## *The results are available in the following objects:
##
## name description
## 1 "$eig" "eigenvalues"
## 2 "$col" "results for the columns"
## 3 "$col$coord" "coord. for the columns"
## 4 "$col$cos2" "cos2 for the columns"
## 5 "$col$contrib" "contributions of the columns"
## 6 "$row" "results for the rows"
## 7 "$row$coord" "coord. for the rows"
## 8 "$row$cos2" "cos2 for the rows"
## 9 "$row$contrib" "contributions of the rows"
## 10 "$call" "summary called parameters"
## 11 "$call$marge.col" "weights of the columns"
## 12 "$call$marge.row" "weights of the rows"fviz_ca_biplot(res.ca, repel = TRUE)
En este gráfico la filas están representadas por los puntos azules y las columnas por los triángulos rojos y podemos interpretarlo como que las categorías Low, Medium y Good están relacionados a la categoría Other; y que para las categorías High y Highest están relacionados a las categorías Professional y Retired. Sin embargo se demuestra que las distancias son significativas por lo que esa asociación no es fuerte.
Además a continuación se presenta el biplot asimétrico que explica una asociación en función del ángulo, entre mejor ángulo hay mayor será la asociación.
fviz_ca_biplot(res.ca,
map="rowprincipal", arrow=c(TRUE,TRUE),
repel=TRUE)
Este gráfico permite de manera más fácil identificar esas distancias que en el biplot simétrico a simple vista pueden ser más complicadas entre los diferentes perfiles de acuerdo al ángulo que se forman entre los dos perfiles. De igual manera vemos la asociación que existe entre Professional y Good y Highest sin embargo éstas dos últimas categorías correspondientes a las filas de la tabla, la norma del vector es demasiado pequeña indicando que esa transformación a dos dimensiones no explica demasiado su comportamiento. Esto también pasa con todas las categorías de CreditRating.
Como se explicó al principio no era necesario realizar un análisis de correspondencia entre estas variables porque no existió independencia de variables ya que no cumplia el test chi cuadrado. Esto lo pudimos corroborar porque al hacer este análisis no vimos una claridad en la agrupación de las categorías, ya que las distancias entre estos perfiles eran demasiado grandes cuando se realizaron los biplot. Como conclusión este análisis no modela o explica de ninguna manera la independencia entre variables y no aporta mucho al análisis final.