Evaluacion_n2
Alegre Veliz Rosa Mercedes
5/6/2020
Data de Bitel empresa de telecomunicaciones
Carga de data
Carga de datos formato csv.
telco <- read.csv("https://raw.githubusercontent.com/VictorGuevaraP/Mineria-de-datos-2020/master/Desafiliado_miss.csv", sep = ";")A continuación se esta renombrando la variable ocupación, colocandola en este caso sin tilde, para omitir errores.
names (telco)[2] = "Ocupacion"Verificamos la carga y cambio de nombre a la variable
head(telco)## Genero Ocupacion Plan_Internacional Min_En_Dia
## 1 Masculino Proyectos personales no 265.1
## 2 Masculino Negocios no 161.6
## 3 Masculino Educación no 243.4
## 4 Masculino Proyectos personales si 299.4
## 5 Masculino Educación si NA
## 6 Masculino Otros si 223.4
## Min_Internacionales Reclamos Llamadas_Internacionales Desafiliado
## 1 10.0 1 3 no
## 2 13.7 1 3 no
## 3 12.2 0 5 no
## 4 6.6 2 7 no
## 5 10.1 3 3 no
## 6 6.3 0 6 noAhora establecemos la estructura inical de las variable de la data y un resumen de la data total, de la siguente manera:
str(telco)## 'data.frame': 3333 obs. of 8 variables:
## $ Genero : Factor w/ 2 levels "Femenino","Masculino": 2 2 2 2 2 2 2 2 1 2 ...
## $ Ocupacion : Factor w/ 5 levels " ","Educación",..: 5 3 2 5 2 4 2 1 3 1 ...
## $ Plan_Internacional : Factor w/ 2 levels "no","si": 1 1 1 2 2 2 1 2 1 2 ...
## $ Min_En_Dia : num 265 162 243 299 NA ...
## $ Min_Internacionales : num 10 13.7 12.2 6.6 10.1 6.3 7.5 7.1 8.7 11.2 ...
## $ Reclamos : int 1 1 0 2 3 0 3 0 1 0 ...
## $ Llamadas_Internacionales: int 3 3 5 7 3 6 7 6 4 5 ...
## $ Desafiliado : Factor w/ 2 levels "no","si": 1 1 1 1 1 1 1 1 1 1 ...De acuerdo a ello se establece lo siguiente:
Se tiene 3333 datos de 8 variables
Variables:
- Género: Género de los clientes, los cuales cuenta con los siguientes niveles
- Femenino
- Masculino
- La ocupación: Ocupación de trabajo de los clientes, en ellos tienen 5 niveles los cuales son los siguiente:
- " " (nivel faltante)
- Negocios
- Otros
- Proyectos personales
- Plan_Internacional: Si el cliente cuenta con un plan internacional o no, se detallan dos niveles:
- si
- no
Min_En_Dia: Los minutos al día consumidos en llamadas por los clientes.
Min_Internacionales: minutos consumidos en llamadas de tipo internacional. (no especifica el tiempo)
Reclamo: Cantidad de reclamos realizadas por el cliente.
Llamadas internacionales: la cantidad de llamadas internacionales realizadas.
Desafiliado: si el cliente se encuentra desafiliado o no, de detallan dos niveles:
- si
- no
2.3. Exploración de Datos
Se puede visualizar en todos los boxplot los siguientes valores: - Primer cuartil: el 25% de los valores son menores o igual a este valor. - Mediana o Segundo Cuartil: Divide en dos partes iguales la distribución. De forma que el 50% de los valores son menores o igual a este valor. - Tercer cuartil: el 75% de los valores son menores o igual a este valor. - Rango Intercuartílico (RIC): Diferencia entre el valor del tercer cuartil y el primer cuartil. - Outlier: Los valores atípicos (outilers en inglés) son aquellos puntos que están mas allá del límite inferior o superior.
boxplot(telco)
par(mfrow = c(2,2))
boxplot(telco$Min_En_Dia, main = "Min_En_Dia con outliers", xlab ="Min_En_Dia")
boxplot(telco$Min_Internacionales, main = "Min_Internacionales con outliers", xlab ="Min_Internacionales")
boxplot(telco$Reclamos, main = "Reclamos con outliers", xlab ="Reclamos")
boxplot(telco$Llamadas_Internacionales, main = "Llamadas_Internacionales con outliers", xlab ="Llamadas_Internacionales")
2.4. Verificación de la calidad de la data
- Primero se busca NA’s en la data general.
- En el siguiente gráfico se puede visualizar, el patrón de comportamiendo de los NA’s
#install.packages("VIM")
library(VIM)## Warning: package 'VIM' was built under R version 3.6.3## Loading required package: colorspace## Loading required package: grid## Loading required package: data.table## VIM is ready to use.
## Since version 4.0.0 the GUI is in its own package VIMGUI.
##
## Please use the package to use the new (and old) GUI.## Suggestions and bug-reports can be submitted at: https://github.com/alexkowa/VIM/issues##
## Attaching package: 'VIM'## The following object is masked from 'package:datasets':
##
## sleepmissing= aggr(telco, col=c('green', 'red'),
ylab = c("Histograma de NAs", "Patrón"))
summary(missing)##
## Missings per variable:
## Variable Count
## Genero 0
## Ocupacion 0
## Plan_Internacional 0
## Min_En_Dia 216
## Min_Internacionales 138
## Reclamos 0
## Llamadas_Internacionales 0
## Desafiliado 0
##
## Missings in combinations of variables:
## Combinations Count Percent
## 0:0:0:0:0:0:0:0 2992 89.768977
## 0:0:0:0:1:0:0:0 125 3.750375
## 0:0:0:1:0:0:0:0 203 6.090609
## 0:0:0:1:1:0:0:0 13 0.390039Paso 3: Preparación de la data
3.1 Seleccionar la data
Tomamos en cuenta las variables a patir de la segunda columna, es decir, desde la Ocupación. Ya que en el género no se visualizó mucha variación en si es femenino o masculino.
newtelco=telco[,2:8]3.2 Limpiar la data
- 1ro empezamos con la limpieza de los valores atípicos. Para ello creamos una funicón.
Capar los valores extremos, es decir, localizar todo lo que cayera fuera del bigote más arriba o más abajo de 1,5 veces de el rango intercuartilico. Y decidir capar dichas obsevaciones sustituyendolas con el percentil número 5. En el caso de los que están debajo del bigote inferior y con el percentil 95 con los que están por encima del bigote superior.
replace_outliers <- function(x, removeNA = TRUE){
qrts <- quantile(x, probs = c(0.25, 0.75), na.rm = removeNA)
caps <- quantile(x, probs = c(.05, 0.95), na.rm = removeNA)
iqr <- qrts[2]-qrts[1]
h <- 1.5*iqr
x[x<qrts[1]-h] <- caps[1]
x[x>qrts[2]+h] <- caps[2]
x
}Es un reemplazo no una imputación, de los valores atípicos
La función como entrada tiene vector numérico como entrada x, que sería la data$columna. Con el parámetro opcional que sería removeNA = TRUE.
- qrts <- quantile(x, probs = c(0.25, 0.75), na.rm = removeNA)
En primer lugar se obtiene los cuantil es Q1 y Q3 para poder calcular el rango inter cuatulico. Se hace uso de la función quantile para el parametro de entrada x, para obrtener aquellos que están exactamente con probabilidad 0.25 por debajo y 0.75 pordebajo y como segundo parametro na.rm igual a removeNA que se ha pasado.
- caps <- quantile(x, probs = c(.05, 0.95), na.rm = removeNA)
Obteniendo los valores de caping, los cuales detallamos que si está por debajo del rango intercuartil, se tomará el cuantil número 5 y por encima se tomará el 95, al igual que al cuantil de antes el de x. En este caso con probabilidades .05 y .95 con el mismo segundo parámetro de na.rm = removeNA.
- iqr <- qrts[2]-qrts[1]
Se calcula el rango intercualtilico. El qrts[2], representa el 95 osea menos del 95 - el del 0.25 qrts[1]. Voy a otener 1,5 veces el rando intercualtil el cual será igual a:
h <- 1.5*iqr h, que representa la altura.
x[x<qrts[1]-h] <- caps[1]
Reemplazo todo lo que se encuentre en “x”, los valores que se encuentrn por debajo del 1er cuantil - h con el caps número 1
- x[x>qrts[2]+h] <- caps[2]
Reemplazo todo lo que se encuentre en “x”, los valores que se encuentren por encima del 3er cuantil + h con el caps número 2
x Devuelvo x como valor final de la ejecucuón.
Hacemos uso de la función creada Las hacemos uso en las variables: Min_Internacionales, Llamadas_Internacionales, Min_En_Dia. En las cuales fueron en dónde se presentaron los valores atípicos.
newtelco$Min_Internacionales <-replace_outliers(newtelco$Min_Internacionales)
newtelco$Min_En_Dia <-replace_outliers(newtelco$Min_En_Dia)
newtelco$Reclamos <- replace_outliers(newtelco$Reclamos)
newtelco$Llamadas_Internacionales <- replace_outliers(newtelco$Llamadas_Internacionales)- Hacemos la comprobación de la función.
Se puede visualizar, una comparación con el uso del boxplot, de la data principal seleccionada con la data actual que se tiene sin outliers.
par(mfrow = c(1,2))
boxplot(telco$Min_Internacionales, main = "Min_Internacionales con outliers")
boxplot(newtelco$Min_Internacionales, main = "Min_Internacionales outliers")
boxplot(telco$Min_En_Dia, main = "Min_En_Dia con outliers")
boxplot(newtelco$Min_En_Dia , main = "Min_En_Dia sin outliers")
boxplot(telco$Reclamos, main = "Reclamos con outliers")
boxplot(newtelco$Reclamos, main = "Reclamos sin outliers")
boxplot(telco$Llamadas_Internacionales, main = "Llamadas_Internacionales con outliers")
boxplot(newtelco$Llamadas_Internacionales, main = "Llamadas_Internacionales sin outliers")
par(mfrow = c(1,2))Data antes de la imputación
summary(telco)## Genero Ocupacion Plan_Internacional Min_En_Dia
## Femenino :1714 :332 no:3010 Min. : 0.0
## Masculino:1619 Educación :745 si: 323 1st Qu.:143.6
## Negocios :732 Median :179.9
## Otros :797 Mean :180.0
## Proyectos personales:727 3rd Qu.:216.7
## Max. :350.8
## NA's :216
## Min_Internacionales Reclamos Llamadas_Internacionales Desafiliado
## Min. : 0.00 Min. :0.000 Min. : 0.000 no:2850
## 1st Qu.: 8.50 1st Qu.:1.000 1st Qu.: 3.000 si: 483
## Median :10.30 Median :1.000 Median : 4.000
## Mean :10.24 Mean :1.563 Mean : 4.479
## 3rd Qu.:12.10 3rd Qu.:2.000 3rd Qu.: 6.000
## Max. :20.00 Max. :9.000 Max. :20.000
## NA's :138Data después de la imputación
summary(newtelco)## Ocupacion Plan_Internacional Min_En_Dia
## :332 no:3010 Min. : 34.0
## Educación :745 si: 323 1st Qu.:143.6
## Negocios :732 Median :179.9
## Otros :797 Mean :180.0
## Proyectos personales:727 3rd Qu.:216.7
## Max. :326.3
## NA's :216
## Min_Internacionales Reclamos Llamadas_Internacionales Desafiliado
## Min. : 3.30 Min. :0.000 Min. : 0.00 no:2850
## 1st Qu.: 8.50 1st Qu.:1.000 1st Qu.: 3.00 si: 483
## Median :10.30 Median :1.000 Median : 4.00
## Mean :10.26 Mean :1.516 Mean : 4.39
## 3rd Qu.:12.10 3rd Qu.:2.000 3rd Qu.: 6.00
## Max. :17.50 Max. :4.000 Max. :10.00
## NA's :138Imputación a los valores NA’s, en toda la data.
Hacemos uso de la función knnImputació. La función rellena todos los valores de NA usando los k Vecinos más cercanos de cada caso con valores de NA. Por defecto utiliza los valores de los vecinos y obtiene una media ponderada (por la distancia al caso) de sus valores para rellenar las incógnitas. Se hace uso de la librería “DMwR”
# install.packages("DMwR")
library(DMwR)## Loading required package: lattice## Registered S3 method overwritten by 'xts':
## method from
## as.zoo.xts zoo## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo##
## Attaching package: 'DMwR'## The following object is masked from 'package:VIM':
##
## kNNtelconew <- knnImputation(newtelco)Comprobamos la imputacin de NA’s
summary(telconew)## Ocupacion Plan_Internacional Min_En_Dia
## :332 no:3010 Min. : 34.0
## Educación :745 si: 323 1st Qu.:146.0
## Negocios :732 Median :179.1
## Otros :797 Mean :179.9
## Proyectos personales:727 3rd Qu.:214.6
## Max. :326.3
## Min_Internacionales Reclamos Llamadas_Internacionales Desafiliado
## Min. : 3.30 Min. :0.000 Min. : 0.00 no:2850
## 1st Qu.: 8.60 1st Qu.:1.000 1st Qu.: 3.00 si: 483
## Median :10.30 Median :1.000 Median : 4.00
## Mean :10.27 Mean :1.516 Mean : 4.39
## 3rd Qu.:12.00 3rd Qu.:2.000 3rd Qu.: 6.00
## Max. :17.50 Max. :4.000 Max. :10.003.3. Construir data
1ro detallamos las librerías que haremos uso
#install.packages("caret")
library(caret)## Warning: package 'caret' was built under R version 3.6.3## Loading required package: ggplot2#install.packages("rpart")
library(rpart)## Warning: package 'rpart' was built under R version 3.6.3Se establece una semilla
set.seed(111)Seleccionamos data de entrenamiento de manera aleatoria, del 70% de la data general.
training.ids <- createDataPartition(telconew$Desafiliado, p = 0.7, list = F)
test <- telconew[-training.ids,]
dim(training.ids)## [1] 2334 1dim(test)## [1] 999 73.4. Integración de data
3.5. Formato de data
write.csv(telconew, file = "dataFinal.csv")
getwd()## [1] "D:/VII CICLO/MINERIA DE DATOS/CLASES/SEMANA5"Paso 4: Modelamiento
Modelo de arbol general
Desafiliado ~ . <-> Desafiliado ~ Ocupacion + Plan_Internacional + etc
En base a la función rpart, se establece una clasificación de tipo ‘class’
mod <- rpart(Desafiliado ~ . ,
data = telconew[training.ids,],
method = "class",
control = rpart.control(minsplit = 20, cp = 0.01))
mod## n= 2334
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 2334 339 no (0.85475578 0.14524422)
## 2) Reclamos< 3.5 2148 236 no (0.89013035 0.10986965)
## 4) Min_En_Dia< 264.45 2019 158 no (0.92174344 0.07825656)
## 8) Plan_Internacional=no 1834 91 no (0.95038168 0.04961832) *
## 9) Plan_Internacional=si 185 67 no (0.63783784 0.36216216)
## 18) Llamadas_Internacionales>=2.5 151 33 no (0.78145695 0.21854305)
## 36) Min_Internacionales< 13.1 125 7 no (0.94400000 0.05600000) *
## 37) Min_Internacionales>=13.1 26 0 si (0.00000000 1.00000000) *
## 19) Llamadas_Internacionales< 2.5 34 0 si (0.00000000 1.00000000) *
## 5) Min_En_Dia>=264.45 129 51 si (0.39534884 0.60465116)
## 10) Llamadas_Internacionales< 6.5 98 44 si (0.44897959 0.55102041)
## 20) Min_En_Dia< 285.15 60 27 no (0.55000000 0.45000000)
## 40) Min_En_Dia>=271.55 33 10 no (0.69696970 0.30303030) *
## 41) Min_En_Dia< 271.55 27 10 si (0.37037037 0.62962963) *
## 21) Min_En_Dia>=285.15 38 11 si (0.28947368 0.71052632) *
## 11) Llamadas_Internacionales>=6.5 31 7 si (0.22580645 0.77419355) *
## 3) Reclamos>=3.5 186 83 si (0.44623656 0.55376344)
## 6) Min_En_Dia>=160.2 119 44 no (0.63025210 0.36974790)
## 12) Min_En_Dia< 266.05 110 36 no (0.67272727 0.32727273)
## 24) Min_En_Dia>=182.75 68 13 no (0.80882353 0.19117647) *
## 25) Min_En_Dia< 182.75 42 19 si (0.45238095 0.54761905)
## 50) Min_En_Dia< 166.65 12 2 no (0.83333333 0.16666667) *
## 51) Min_En_Dia>=166.65 30 9 si (0.30000000 0.70000000) *
## 13) Min_En_Dia>=266.05 9 1 si (0.11111111 0.88888889) *
## 7) Min_En_Dia< 160.2 67 8 si (0.11940299 0.88059701) *Graficamos el modelo
Hacemos uso de la siguiente librería para poder graficar el modelo establecido anteriormente.
#install.packages("partykit)")
library(partykit)## Warning: package 'partykit' was built under R version 3.6.3## Loading required package: libcoin## Warning: package 'libcoin' was built under R version 3.6.3## Loading required package: mvtnorm## Warning: package 'mvtnorm' was built under R version 3.6.2plot(as.party(mod))
Otra manera de representar la gráfica del modelo
#install.packages("rpart.plot")
library(rpart.plot)## Warning: package 'rpart.plot' was built under R version 3.6.3prp(mod, type = 2, extra = 104, nn = TRUE,
fallen.leaves = TRUE, faclen = 4, varlen = 8,
shadow.col = "gray")## Warning: Bad 'data' field in model 'call' (expected a data.frame or a matrix).
## To silence this warning:
## Call prp with roundint=FALSE,
## or rebuild the rpart model with model=TRUE.
Podamos el árbol
Para poder consultamos con la variable dentro de mod (el modelo ya realizado), la variable cptable
En ella se puede visualizar una tabla, en la cual se tiene los siguiente:
- CP <- las componentes principales.
- rel error <- el error relativo.
- xerror <- error total.
- xstd <- la desviación estandar.
La principal idea en ello es poder elegir un valor no superior a la desviación estandar pero a su vez que se encuentre por encima del error mínimo.
mod$cptable## CP nsplit rel error xerror xstd
## 1 0.07669617 0 1.0000000 1.0000000 0.05021358
## 2 0.05014749 3 0.7699115 0.7846608 0.04528621
## 3 0.02064897 6 0.5929204 0.6076696 0.04042679
## 4 0.01769912 7 0.5722714 0.6106195 0.04051528
## 5 0.01278269 9 0.5368732 0.5988201 0.04015962
## 6 0.01000000 12 0.4985251 0.6047198 0.040338030.6047198 + 0.04051528## [1] 0.64523510.6448794 es mayor al error cometido
- Se le estable el valor de “4”
mod.pruned <- prune(mod, mod$cptable[4, "CP"])
prp(mod.pruned, type = 2, extra = 104, nn = TRUE,
fallen.leaves = TRUE, faclen = 4, varlen = 8,
shadow.col = "gray")## Warning: Bad 'data' field in model 'call' (expected a data.frame or a matrix).
## To silence this warning:
## Call prp with roundint=FALSE,
## or rebuild the rpart model with model=TRUE.
- Graficamos
plot(as.party(mod.pruned))
- Usamos la función predict para predecir los valores en base al modelo type “class” y “prob”
pred.pruned <- predict(mod.pruned, test, type="class")- Guardamos en una una variable llamada table la Matriz de confusión
table <- table(test$Desafiliado, pred.pruned,
dnn = c("Actual", "Predicho"))- También visualizarlo en un gráfico de barras
barplot(table, legend = TRUE,
xlab = "Nota predecida por el modelo")
- De este modo lo podemos visualizar en porcentajes
prop.table(table)## Predicho
## Actual no si
## no 0.82582583 0.03003003
## si 0.04904905 0.09509510round(prop.table(table, 1)*100, 2)## Predicho
## Actual no si
## no 96.49 3.51
## si 34.03 65.97pred.pruned2 <- predict(mod.pruned, test, type="prob")Hacemos uso de la curva ROC
Ya que esta proporciona la fiabilidad en la clasificación dada. (Probabilidad en que se tenga éxito o fracaso).
- Hacemos uso de la librería siguiente
#install.packages("ROCR")
library(ROCR)## Warning: package 'ROCR' was built under R version 3.6.3## Loading required package: gplots##
## Attaching package: 'gplots'## The following object is masked from 'package:stats':
##
## lowessPara el diagrama ROC Una vez predicho 1. 1ro objeto pred, se tiene la funcion prediction, de la segunda columna en la cual visualizamos los éxitos. En referencia al código anterior.
2. 2do evaluamos la performans para evaluar la eficiencia.
pred <- prediction(pred.pruned2[,2], telconew[-training.ids, "Desafiliado"])
perf <- performance(pred, "tpr", "fpr")Graficamos:
plot(perf)
lines(par()$usr[1:2],par()$usr[3:4])
Conocemos los puntos de la curva ROC Determiar en el corte y obtener la probabilidad que nos de. Me permitirá concer a parti de que valores voy a obtener un verdadero positivo o en cuales tengo que tener cuidado que podría darme un falso positivo.
prop.cuts <- data.frame(cut = perf@alpha.values[[1]],
fpr = perf@x.values[[1]],
tpr = perf@y.values[[1]])Visualizamos la cabecera y los últimos valores (cola), de la variable prop.cuts
head(prop.cuts)## cut fpr tpr
## 1 Inf 0.000000000 0.0000000
## 2 1.0000000 0.000000000 0.2291667
## 3 0.8888889 0.004678363 0.2500000
## 4 0.8805970 0.009356725 0.4305556
## 5 0.6046512 0.035087719 0.6597222
## 6 0.3272727 0.079532164 0.7013889tail(prop.cuts)## cut fpr tpr
## 3 0.88888889 0.004678363 0.2500000
## 4 0.88059701 0.009356725 0.4305556
## 5 0.60465116 0.035087719 0.6597222
## 6 0.32727273 0.079532164 0.7013889
## 7 0.05600000 0.138011696 0.7083333
## 8 0.04961832 1.000000000 1.0000000prop.cuts[prop.cuts$tpr>=0.6,]## cut fpr tpr
## 5 0.60465116 0.03508772 0.6597222
## 6 0.32727273 0.07953216 0.7013889
## 7 0.05600000 0.13801170 0.7083333
## 8 0.04961832 1.00000000 1.0000000Paso 5: Evaluación.
- Matriz de confusion
medida <- confusionMatrix(pred.pruned, test$Desafiliado)
medida## Confusion Matrix and Statistics
##
## Reference
## Prediction no si
## no 825 49
## si 30 95
##
## Accuracy : 0.9209
## 95% CI : (0.9024, 0.9369)
## No Information Rate : 0.8559
## P-Value [Acc > NIR] : 1.971e-10
##
## Kappa : 0.6609
##
## Mcnemar's Test P-Value : 0.04285
##
## Sensitivity : 0.9649
## Specificity : 0.6597
## Pos Pred Value : 0.9439
## Neg Pred Value : 0.7600
## Prevalence : 0.8559
## Detection Rate : 0.8258
## Detection Prevalence : 0.8749
## Balanced Accuracy : 0.8123
##
## 'Positive' Class : no
## accuracy=(825+95)/999
accuracy## [1] 0.9209209Para conocer en cuanto mi proyecto va a tener error
error_rate=1-accuracy
error_rate## [1] 0.07907908