Telco Customer Churn
Actividad 06: describir los facotres controlable y no controlables, unidades experimentales, materia prima que infuyen en el proceso del experimento Asi, descrbir tambien la variable o variables de respuesta. Todo esto deve ser identificado en el tema de estudio del area actuante. en pdf Actividad 07: propornga los ttratamientos el tema en interes del experimento.
Se realizó un estudio para investigar el efecto de las ofertas sobre los meses de permanencia de clientes. Se cree que el crecimiento se ve afectado por el tipo de oferta con que inicia el contrato de servicio del cliente. Se quiere medir el grado de fidelidad de las promociones.
Se tomó todo los clientes (7043) hasta el culmino del Q3-2023, el cual se les fue ofreciendo diferentes promociones. Se observó que el 55% de clientes rechazó la oferta. Aún así se ha monitoreado a cada cliente escogido aleatoriamente y tenemos el tiempo (en meses) en permanencia con el servicio.
Ya practicado el experimento a 100 clientes diferentes por cada nivel.
Unidad Experimental: Conjunto de clientes hasta el Q3-2023
Factores Controlables: Caracteristicas de la oferta (ancho de banda, velocidad up y down, latencia, tipo conexión), disponibilidad de soporte
Factores No Controlables: Arquitectura de las casas, mudanzas.
Variable de Respuesta: Grado de fidelidad del cliente.
Tratamiento: Las ofertas.
Almacenamos los datos en dos variables:
variable característica, la llamaremos 𝑋,
variable factor, la llamaremos F.
Elegimos 100 individuos diferentes aleatoriamente de cada nivel y hacemos la operación de horizontalizar.
Adjuntando el paquete: 'dplyr'The following objects are masked from 'package:stats':
filter, lagThe following objects are masked from 'package:base':
intersect, setdiff, setequal, union# A tibble: 6 × 3
Tenure_Months Offer cEncod
<dbl> <chr> <dbl>
1 71 None 0
2 16 None 0
3 38 None 0
4 54 None 0
5 1 None 0
6 4 None 0Llamaremos a la variable 𝑋 permanencia.cliente (Tenure_Months) y a la variable F, nivel.offer (Offer).
permanencia.cliente = rbind(munone.clientes.100.sin
,muoffa.clientes.100.sin
,muoffb.clientes.100.sin
,muoffc.clientes.100.sin
,muoffd.clientes.100.sin
,muoffe.clientes.100.sin)
#nivel.offer("None","Offer_A","Offer_B","Offer_C","Offer_D","Offer_E")
tabla.datos.ANOVA <- permanencia.cliente %>%
filter(cEncod != c(0)) %>%
select(Tenure_Months,cEncod)
head(tabla.datos.ANOVA)# A tibble: 6 × 2
Tenure_Months cEncod
<dbl> <dbl>
1 70 1
2 70 1
3 70 1
4 72 1
5 72 1
6 66 1Ésta será la tabla sobre la que trabajaremos para realizar el contraste ANOVA.
Observamos gráficamente que los meses de permanencia de las muestras correspondientes a los 5 niveles de oferta parecen diferentes. Se deberia quitar la muestra de los clientes que no tienen oferta?
En el gráfico siguiente, dibujamos los 100 meses de permanancia correspondientes a los 100 clientes separándolos en 5 grupos correspondientes a los niveles de oferta.
También aparecen las medias de cada grupo, NOTA: media global es 32.37114.
Este gráfico corrobora lo que hemos dicho anteriormente: parecen que hay diferencias entre las medias de los porcentajes de aumentos de masa celular entre los 5 grupos.
#| echo: false
# A tibble: 5 × 2
cEncod mean_tenure
<dbl> <dbl>
1 1 69.9
2 2 54.9
3 3 30.6
4 4 15.9
5 5 3.54
sumas.niveles = aggregate(Tenure_Months ~ cEncod,
data = tabla.datos.ANOVA, FUN="sum")
sumas.niveles cEncod Tenure_Months
1 1 6987
2 2 5487
3 3 3057
4 4 1592
5 5 354medias.niveles = aggregate(Tenure_Months ~ cEncod,
data=tabla.datos.ANOVA, FUN="mean")
medias.niveles cEncod Tenure_Months
1 1 69.87
2 2 54.87
3 3 30.57
4 4 15.92
5 5 3.54suma.total = sum(tabla.datos.ANOVA$Tenure_Months)
suma.total[1] 17477media.muestral = mean(tabla.datos.ANOVA$Tenure_Months)
media.muestral[1] 34.954(ni=table(tabla.datos.ANOVA$cEncod))
1 2 3 4 5
100 100 100 100 100 (N=sum(ni))[1] 500#Verifica equivalencia de expresiones matemáticas
(SSTotal1 =sum((tabla.datos.ANOVA$Tenure_Months-media.muestral)^2))[1] 309319.9(SSTotal = sum(tabla.datos.ANOVA$Tenure_Months^2)-suma.total^2/N)[1] 309319.9(SSTr1=sum(ni*(medias.niveles[,2]-media.muestral)^2))[1] 298412.6(SSTr=sum(sumas.niveles[,2]^2/ni)-(suma.total^2)/N)[1] 298412.6#No se verifica equivalencia
(SSE1=sum((tabla.datos.ANOVA$Tenure_Months-medias.niveles[,2])^2))[1] 616831.7(SSE=SSTotal-SSTr)[1] 10907.33k=5
(MStr = SSTr/(k-1))[1] 74603.15(MSE = SSE/(N-k))[1] 22.03501(F = MStr/MSE)[1] 3385.665(p = pf(F,k-1,N-k,lower.tail = FALSE))[1] 0En resumen para el contraste ANOVA se necesita:
Si bien hemos realizado esta actividad digamos de manera manual, se puede calcular facilmente con una función de R, veamos:
En R
X=tabla.datos.ANOVA$Tenure_Months
F=tabla.datos.ANOVA$cEncod
modelo = aov(X~F)
summary(modelo) Df Sum Sq Mean Sq F value Pr(>F)
F 1 294500 294500 9896 <2e-16 ***
Residuals 498 14820 30
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Primero con el sgte gráfico podemos identificar de forma preliminar si existen asimetrías, datos atípicos o diferencia de varianzas. En este caso, los 5 grupos parecen no seguir una distribución simétrica.
El tamaño de las cajas es casi similar para todos los niveles por lo que no hay indicios de falta de homocedasticidad.
Independencia: Las observaciones de cada nivel se han elegido de manera aleatoria
Distribución normal de las observaciones: La variable cuantitativa debe de distribuirse de forma normal en cada uno de los grupos.
d1 <- sapply(datos[datos$cEncod == 1,“Tenure_Months”], as.double)
qqnorm(d1, main = “Offer A”)
Dado que los grupos tienen mas de 50 eventos se emplea el test de Kolmogorov-Smirnov con la corrección de Lilliefors. Si fuesen menos de 50 eventos por grupo se emplearía el test Shapiro-Wilk.
library(nortest)
by(data = datos,INDICES = datos$cEncod,FUN = function(x){ lillie.test(x$Tenure_Months)})datos$cEncod: 1
Lilliefors (Kolmogorov-Smirnov) normality test
data: x$Tenure_Months
D = 0.1866, p-value = 3.617e-09
------------------------------------------------------------
datos$cEncod: 2
Lilliefors (Kolmogorov-Smirnov) normality test
data: x$Tenure_Months
D = 0.12797, p-value = 0.0003619
------------------------------------------------------------
datos$cEncod: 3
Lilliefors (Kolmogorov-Smirnov) normality test
data: x$Tenure_Months
D = 0.16463, p-value = 4.839e-07
------------------------------------------------------------
datos$cEncod: 4
Lilliefors (Kolmogorov-Smirnov) normality test
data: x$Tenure_Months
D = 0.12178, p-value = 0.0009131
------------------------------------------------------------
datos$cEncod: 5
Lilliefors (Kolmogorov-Smirnov) normality test
data: x$Tenure_Months
D = 0.20504, p-value = 3.481e-11Los valores de p indican que no siguen normalidad.
Observamos que esta ultima condicion no se cumplen, por lo que no tiene mucho sentido seguir adelante.
plot(modelo)
La representación gráfica de los residuos no muestra falta de homocedasticidad (gráfico 1) y en el qqplot los residuos se distribuyen muy cercanos a la linea de la normal (gráfico 2).
##### Independencia dos residuos o errores #####
res = residuals(modelo)
plot(res,pch=19,ylab = "Residuos", col="blue") #grafico para ver independencia dos erros, não tem alguma tendencia
abline(h=0,col="red")
plot(density(res),main="Gráfico de densidad de residuos",ylab="Densidad",xlab="Residuos")
No es indicado si se realizan más de 6 comparaciones.
pairwise.t.test(x = datos$Tenure_Months, g = datos$cEncod, p.adjust.method = "holm",
pool.sd = TRUE, paired = FALSE, alternative = "two.sided")
Pairwise comparisons using t tests with pooled SD
data: datos$Tenure_Months and datos$cEncod
1 2 3 4
2 <2e-16 - - -
3 <2e-16 <2e-16 - -
4 <2e-16 <2e-16 <2e-16 -
5 <2e-16 <2e-16 <2e-16 <2e-16
P value adjustment method: holm library(agricolae)
resultado.anova=aov(X~F)
duncan.test(resultado.anova,"F",group=FALSE)$comparison difference pvalue signif. LCL UCL
1 - 2 15.00 0 *** 13.48424 16.51576
1 - 3 39.30 0 *** 37.70422 40.89578
1 - 4 53.95 0 *** 52.30070 55.59930
1 - 5 66.33 0 *** 64.64119 68.01881
2 - 3 24.30 0 *** 22.78424 25.81576
2 - 4 38.95 0 *** 37.35422 40.54578
2 - 5 51.33 0 *** 49.68070 52.97930
3 - 4 14.65 0 *** 13.13424 16.16576
3 - 5 27.03 0 *** 25.43422 28.62578
4 - 5 12.38 0 *** 10.86424 13.89576duncan.test(resultado.anova,"F",group=TRUE)$group X groups
1 69.87 a
2 54.87 b
3 30.57 c
4 15.92 d
5 3.54 eNos da una tabla donde las filas son las comparaciones entre los distintos pares del niveles del factor.
La tabla contiene 5 columnas:
la primera nos da la diferencia entre las dos medias de los dos niveles que se comparan,
la segunda nos da el p-valor que indica si hay o no diferencias entre las dos medias,
la tercera indica si la diferencia es significativa o no. Cuantos más asteriscos (*) aparezcan, más significativa es la diferencia y
las dos últimas representan un intervalo de confianza para la diferencia de medias.
Vemos que ningún caso aparecen dos letras, podemos concluir que las medias de cualquier par de niveles son significativamente diferentes.
Nuestros datos estan balanceados (submuestras tienen mismo tamaño).
aov.factor = aov(X ~ factor(F))
TukeyHSD(aov(aov.factor)) Tukey multiple comparisons of means
95% family-wise confidence level
Fit: aov(formula = aov.factor)
$`factor(F)`
diff lwr upr p adj
2-1 -15.00 -16.81754 -13.18246 0
3-1 -39.30 -41.11754 -37.48246 0
4-1 -53.95 -55.76754 -52.13246 0
5-1 -66.33 -68.14754 -64.51246 0
3-2 -24.30 -26.11754 -22.48246 0
4-2 -38.95 -40.76754 -37.13246 0
5-2 -51.33 -53.14754 -49.51246 0
4-3 -14.65 -16.46754 -12.83246 0
5-3 -27.03 -28.84754 -25.21246 0
5-4 -12.38 -14.19754 -10.56246 0plot(TukeyHSD(aov(aov.factor)))
Comprobamos que el p-valor es muy pequeño. Concluimos, por tanto, que tenemos evidencias suficientes para concluir que las medias de permanencia de los clientes no son iguales para los diferentes niveles de oferta.
Y, consecuentemente, la oferta puede influir en la permanencia.
Observación: concluimos que no todas las medias son iguales, en este experiemento todas las medias son diferentes.