INSTRUCCIONES
El siguiente taller incluye un problema de aplicación de la técnica multivariada conocida como Análisis de Componentes Principales (ACP)
Problema
Realice un análisis de componentes principales (ACP) sobre las variables cuantitativas (por lo menos 5) de una base de datos relacionada con su área de conocimientos. Muestre el porcentaje de varianza explicado por cada dimensión. Basado en el autovalor medio o en un diagrama de sedimentación, decida cuántos componentes debe retener. Determine la calidad de representación de las variables respecto a las componentes seleccionadas y la contribución que realiza cada variable a la construcción de cada componente. Defina e interprete los componentes principales obtenidos.
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"De acuerdo a que hay tantas variables para este ejercicio práctico se elegirán 8 variables cuantitativas para su estudio:
| Variable | Descripción |
|---|---|
| MonthlyRevenue | Promedio ingreso mensual |
| MonthlyMinutes | Promedio minutos mensuales |
| TotalRecurringCharge | Promedio cargo recurrente total |
| PercChangeMinutes | Cambio porcentual en minutos de uso |
| UnansweredCalls | Llamadas sin contestar |
| OutboundCalls | Número medio de llamadas de voz salientes |
| DroppedBlockedCalls | Número medio de llamadas caídas o bloqueadas |
| MonthInService | Número de meses en servicio |
Hacemos el filtrado de variables
data = data[,c("MonthlyRevenue","MonthlyMinutes","TotalRecurringCharge","PercChangeMinutes","UnansweredCalls","OutboundCalls","DroppedBlockedCalls","MonthsInService")]Eliminamos todos los registros que tienen algún NA
data <- na.omit(data)
nrow(data)## [1] 50680Tomamos una muestra aleatoria
set.seed(1234)
datos = sample(1:nrow(data), size = 200) # Vector de 20 elementosObservamos los datos:
library(DT)
DT::datatable(data)str(data)## 'data.frame': 50680 obs. of 8 variables:
## $ MonthlyRevenue : num 24 17 38 82.3 17.1 ...
## $ MonthlyMinutes : int 219 10 8 1312 0 682 26 98 24 1056 ...
## $ TotalRecurringCharge: int 22 17 38 75 17 52 30 66 35 75 ...
## $ PercChangeMinutes : int -157 -4 -2 157 0 148 60 24 20 43 ...
## $ UnansweredCalls : num 6.3 2.7 0 76 0 13 2.3 4 1 0 ...
## $ OutboundCalls : num 0 0 0.3 370.3 0 ...
## $ DroppedBlockedCalls : num 1.3 0.3 0 59.7 0 10.7 1 0.3 0 0 ...
## $ MonthsInService : int 61 58 60 59 53 53 57 59 53 55 ...
## - attr(*, "na.action")= 'omit' Named int [1:367] 92 123 127 462 642 672 796 926 928 952 ...
## ..- attr(*, "names")= chr [1:367] "92" "123" "127" "462" ...- Análisis de componentes principales (ACP) sobre las variables cuantitativas Muestre el porcentaje de varianza explicado por cada dimensión.
Realizamos el ACP con los datos originales ( sin estandarizar )
#install.packages(c("FactoMineR", "factoextra", "ggplot2"))
library("FactoMineR")
library("factoextra")
library("ggplot2")
res.pca = PCA(data, scale.unit=FALSE, graph = F)
eig.val = get_eigenvalue(res.pca)
eig.val## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 283622.44717 80.37458896 80.37459
## Dim.2 66141.28169 18.74350349 99.11809
## Dim.3 1052.11276 0.29815387 99.41625
## Dim.4 965.60396 0.27363850 99.68988
## Dim.5 551.13605 0.15618416 99.84607
## Dim.6 297.75730 0.08438021 99.93045
## Dim.7 152.38873 0.04318481 99.97363
## Dim.8 93.03925 0.02636601 100.00000Estos valores propios son la varianzas de los componentes principales. Determinamos la matriz de covarianzas y de acuerdo a la varianza de cada variable hallamos la varianza total que es la suma de las varianzas individuales o la suma de los elementos de la diagonal principal
varianzas = apply(data, 2 ,var)
varianzas #varianza de cada variable individual ## MonthlyRevenue MonthlyMinutes TotalRecurringCharge
## 1981.19649 280928.51302 567.66420
## PercChangeMinutes UnansweredCalls OutboundCalls
## 66313.85796 1514.68641 1239.29024
## DroppedBlockedCalls MonthsInService
## 242.48901 95.03251(S = cov(data)) ## MonthlyRevenue MonthlyMinutes TotalRecurringCharge
## MonthlyRevenue 1981.1964907 16826.6107 668.62365
## MonthlyMinutes 16826.6106528 280928.5130 7381.32889
## TotalRecurringCharge 668.6236495 7381.3289 567.66420
## PercChangeMinutes -314.0544573 -6162.6370 -98.68156
## UnansweredCalls 779.6699491 13324.9374 331.70864
## OutboundCalls 776.9940669 12967.1980 343.29607
## DroppedBlockedCalls 289.0295066 4726.1323 123.82860
## MonthsInService 0.4901507 -341.4386 -10.55945
## PercChangeMinutes UnansweredCalls OutboundCalls
## MonthlyRevenue -314.054457 779.66995 776.994067
## MonthlyMinutes -6162.637015 13324.93745 12967.197981
## TotalRecurringCharge -98.681564 331.70864 343.296066
## PercChangeMinutes 66313.857962 -864.79450 -577.735553
## UnansweredCalls -864.794497 1514.68641 787.659911
## OutboundCalls -577.735553 787.65991 1239.290241
## DroppedBlockedCalls -350.138249 301.42120 269.707800
## MonthsInService 9.932451 -24.23546 -8.080591
## DroppedBlockedCalls MonthsInService
## MonthlyRevenue 289.02951 0.4901507
## MonthlyMinutes 4726.13232 -341.4386045
## TotalRecurringCharge 123.82860 -10.5594500
## PercChangeMinutes -350.13825 9.9324510
## UnansweredCalls 301.42120 -24.2354594
## OutboundCalls 269.70780 -8.0805914
## DroppedBlockedCalls 242.48901 -11.6576595
## MonthsInService -11.65766 95.0325138var.total = sum(diag(S)) #forma de obtener obtener la varianza total, sumar las varianzas de vada variable
var.total #Varianza total## [1] 352882.7Estandarizmos los datos y volvemos a obtener la matriz de covarianzas dando como resultado la matriz de correlaciones
datos.est = scale(data)
R = cov(datos.est)
R## MonthlyRevenue MonthlyMinutes TotalRecurringCharge
## MonthlyRevenue 1.000000000 0.71323880 0.63048129
## MonthlyMinutes 0.713238800 1.00000000 0.58450858
## TotalRecurringCharge 0.630481291 0.58450858 1.00000000
## PercChangeMinutes -0.027399273 -0.04515091 -0.01608378
## UnansweredCalls 0.450075794 0.64596041 0.35772531
## OutboundCalls 0.495869519 0.69496305 0.40929511
## DroppedBlockedCalls 0.416996464 0.57261396 0.33375607
## MonthsInService 0.001129613 -0.06608130 -0.04546314
## PercChangeMinutes UnansweredCalls OutboundCalls
## MonthlyRevenue -0.027399273 0.45007579 0.49586952
## MonthlyMinutes -0.045150912 0.64596041 0.69496305
## TotalRecurringCharge -0.016083780 0.35772531 0.40929511
## PercChangeMinutes 1.000000000 -0.08628780 -0.06372949
## UnansweredCalls -0.086287802 1.00000000 0.57489809
## OutboundCalls -0.063729488 0.57489809 1.00000000
## DroppedBlockedCalls -0.087315506 0.49735489 0.49199530
## MonthsInService 0.003956564 -0.06387836 -0.02354618
## DroppedBlockedCalls MonthsInService
## MonthlyRevenue 0.41699646 0.001129613
## MonthlyMinutes 0.57261396 -0.066081304
## TotalRecurringCharge 0.33375607 -0.045463141
## PercChangeMinutes -0.08731551 0.003956564
## UnansweredCalls 0.49735489 -0.063878364
## OutboundCalls 0.49199530 -0.023546183
## DroppedBlockedCalls 1.00000000 -0.076794342
## MonthsInService -0.07679434 1.000000000cor(data)## MonthlyRevenue MonthlyMinutes TotalRecurringCharge
## MonthlyRevenue 1.000000000 0.71323880 0.63048129
## MonthlyMinutes 0.713238800 1.00000000 0.58450858
## TotalRecurringCharge 0.630481291 0.58450858 1.00000000
## PercChangeMinutes -0.027399273 -0.04515091 -0.01608378
## UnansweredCalls 0.450075794 0.64596041 0.35772531
## OutboundCalls 0.495869519 0.69496305 0.40929511
## DroppedBlockedCalls 0.416996464 0.57261396 0.33375607
## MonthsInService 0.001129613 -0.06608130 -0.04546314
## PercChangeMinutes UnansweredCalls OutboundCalls
## MonthlyRevenue -0.027399273 0.45007579 0.49586952
## MonthlyMinutes -0.045150912 0.64596041 0.69496305
## TotalRecurringCharge -0.016083780 0.35772531 0.40929511
## PercChangeMinutes 1.000000000 -0.08628780 -0.06372949
## UnansweredCalls -0.086287802 1.00000000 0.57489809
## OutboundCalls -0.063729488 0.57489809 1.00000000
## DroppedBlockedCalls -0.087315506 0.49735489 0.49199530
## MonthsInService 0.003956564 -0.06387836 -0.02354618
## DroppedBlockedCalls MonthsInService
## MonthlyRevenue 0.41699646 0.001129613
## MonthlyMinutes 0.57261396 -0.066081304
## TotalRecurringCharge 0.33375607 -0.045463141
## PercChangeMinutes -0.08731551 0.003956564
## UnansweredCalls 0.49735489 -0.063878364
## OutboundCalls 0.49199530 -0.023546183
## DroppedBlockedCalls 1.00000000 -0.076794342
## MonthsInService -0.07679434 1.000000000Como son 5 variables la varianza total es: 5 = 1 + 1 + 1 + 1 + 1. Así que volvemos a determinar el PCA para estos datos estandarizados
#install.packages(c("FactoMineR", "factoextra", "ggplot2"))
#library("FactoMineR")
#library("factoextra")
#library("ggplot2")
res.pca = PCA(data, scale.unit=TRUE, graph = F)
eig.val = get_eigenvalue(res.pca)
eig.val## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 3.6624524 45.780655 45.78066
## Dim.2 1.0236075 12.795094 58.57575
## Dim.3 0.9996403 12.495504 71.07125
## Dim.4 0.7982625 9.978281 81.04953
## Dim.5 0.5300540 6.625675 87.67521
## Dim.6 0.4205988 5.257485 92.93269
## Dim.7 0.3635902 4.544877 97.47757
## Dim.8 0.2017943 2.522429 100.00000Ahora de acuerdo al criterio de Kaiser que nos dice retener las componentes principales cuyo valor propio es mayor que uno, las componentes principales a tener en cuenta serían Dim.1, Dim.2 y Dim.3 que es muy próximo a 1.
Ahora vamos a determinar el gráfico de sedimentación:
fviz_eig(res.pca, addlabels = TRUE, ylim=c(0,80))
Con este gráfico vemos que existe un codo en la segunda componente principal por lo que de acuerdo a la teoría deberíamos obtener los anteriores a éste, en este caso sólo tendríamos en cuenta el primero. Sin embargo habría una contradicción con el criterio de Kaiser porque ahí podríamos obtener los 3 primeros.
Vamos a obtener el círculo de correlaciones
var = get_pca_var(res.pca)
View(var$coord)Cada elemento de la matriz representa la correlación entre la variable natural y la componente principal
Para representar gráficamente el círculo de correlaciones:
fviz_pca_var(res.pca, col.var = "black")
Este gráfico nos permite identificar cuales variables están correlacionadas entre sí, aquellas que estén juntas indican que están muy correlacionadas positivamente y al igual que la tabla anterior indica la relación con las componentes principales o en otras palabras las que más contribuyen a la construcción de la dimensión en particular. Por lo tanto de acuerdo al gráfico podemos obtener 4 grupos de pares indicando la correlación entre variables así
| Grupo | Variables correlacionadas |
|---|---|
| 1 | PerchangeMinutes y MonthsInService |
| 2 | TotalRecurringCharge y MonthlyRevenue |
| 3 | MonthlyMinutes y OutboundCalls |
| 4 | UnansweredCalls y DroppedBlockedCalls |
Estas correlaciones tienen sentido, por ejemplo entre más meses de servicio haya tenido el cambio porcentual en minutos de uso aumenta. También el promedio de cargo recurrente total aumenta a medida que hay un ingreso mensual a la operadora; además entre más minutos hayan gastado el número de llamadas de voz salientes aumenta, y el último grupo indica que el número de llamadas bloqueadas o caídas es directamente proporcional al número de llamadas sin contestar. Ahora bien, vemos que hay un grupo general que contribuye más a la construcción de la dimensión 2 o segundo componente principal y las 4 restantes que contribuyen más a la dimensión 1 o primer componente principal, esto es debido a la proyección sobre sus ejes. Además podemos observar el mismo comportamiento en la tabla de correlación para cada dimensión vista anteriormente.
Algo también importante a resaltar es que el grupo 1 forma un ángulo casi recto con los demás grupos, esto indica que no existe una correlación con las demás variables y tiene sentido porque no es posible demostrar los meses de servicio en función del número de llamadas caídas, no contestadas, minutos mensuales usados, etc.
Ahora bien, para determinar las variables que más aportan a cada dimensión tenemos:
| CP o dimensión | Variables que aportan más a su construcción |
|---|---|
| Dim1 | TotalRecurringCharge, MonthlyRevenue, MonthlyMinutes, OutboundCalls, UnansweredCalls y DroppedBlockedCalls |
| Dim2 | PerchangeMinutes y MonthsInService |
Para el caso es interesante, porque tenemos 2 grupos de variables casi independientes de manera que no hay variables que puedan explicar equitativamente las dos dimensiones, en cambio cada una resalta la contrucción de un componente principal en particular.
Otra medida es la calidad de la representación de cada variable en el plano factorial usando coseno cuadrado, así:
var$cos2## Dim.1 Dim.2 Dim.3 Dim.4
## MonthlyRevenue 0.634153240 0.0408412033 6.222437e-04 1.185387e-01
## MonthlyMinutes 0.831243143 0.0020666531 3.693074e-04 1.949127e-05
## TotalRecurringCharge 0.492476886 0.0449883300 2.608673e-03 2.935504e-01
## PercChangeMinutes 0.008923212 0.6130892055 3.003783e-01 7.683562e-02
## UnansweredCalls 0.572690430 0.0165885009 3.166025e-04 1.126968e-01
## OutboundCalls 0.624405298 0.0006172895 2.553922e-03 6.062321e-02
## DroppedBlockedCalls 0.492192999 0.0283680820 5.616398e-05 1.162175e-01
## MonthsInService 0.006367204 0.2770482487 6.927351e-01 1.978086e-02
## Dim.5
## MonthlyRevenue 0.0010215600
## MonthlyMinutes 0.0044700993
## TotalRecurringCharge 0.0057585442
## PercChangeMinutes 0.0003772814
## UnansweredCalls 0.0813359371
## OutboundCalls 0.0756504339
## DroppedBlockedCalls 0.3595789017
## MonthsInService 0.0018612485fviz_pca_var(res.pca, col.var="cos2", gradient.cols = c("red","#00AFBB", "#E7B800"), repel = TRUE)
Como un coseno cuadrado nos mide la calidad de la representación de cada una de las variables sobre los componentes principales. Observamos en la tabla que se cumple lo que se concluyó anteriormente de acuerdo a las variables que aportan más en cada dimensión. Además vemos que para la CP 3 y 4 ninguna variable aporta y en la dimensión 5 la variable DroppedBlockedCalls aporta un poco a su construcción.
De igual manera el gráfico nos permite ver de acuerdo a los colores cuáles son las variables que tiene “mejor” calidad para representar una dimensión. Y este se diferencia al gráfico anterior porque el color es de acuerdo a las dos dimensiones y no sólo a una.
Otra manera de ver las variables que más aportan a cada componente es así: - Para la dimensión 1:
fviz_contrib(res.pca, choice="var", axes = 1, top = 10)
- Para la dimensión 2:
fviz_contrib(res.pca, choice="var", axes = 2, top = 10)
fviz_contrib(res.pca, choice="var", axes = 3, top = 10)
Éstos últimos gáficos nos corrobora lo explicado anteriormente, que las variables que explican la 2 componente principal no influyen para la construcción de la primera componente principal. Además vemos que para la construcción de la dimensión 3 las mismas variables de la dimensión uno lo explican.
En conclusión, tenemos que las 3 primeras componentes principales cumplen el criterio de Kaiser pero de acuerdo a la calidad de representación de cada variable usando el coseno cuadrado sólo usaríamos las dos primeras dimensiones; además la tabla y gráficos del circulo de correlaciones, y éstos últimos gráficos de la contribución de las variables indican que no es necesario la 3 dimensión o componente principal. Así que, si sólo tuviese estos datos y con este modelo(PCA) usaría las 3 primeras dimensiones, porque con los datos estandarizados podría explicar el 71,1% de la variabilidad de los datos(suma de los valores propios o varianza de cada CP de acuerdo a la tabla anterior obtenida). Sin embargo de se han elegido apenas algunas variables y 200 registros del dataset por lo que lo ideal sería elegir otras o todas las variables y los más de 5000 registros para hacer este mismo análisis.