Imputación de Datos

El presente trabajo indica el proceso para la imputación de datos el cual se realiza cuando la base de datos presenta datos faltantes.

BASE DE DATOS

Se lee la base de datos a utilizar, en la cual se encuentran las variables:

Mes:corresponde al número de mes .
Nro de visitas: el número de veces de acercamiento que tiene la empresa con el cliente.
Exito: indica si el chip fue entregado o no.
Capital: indica si la ciudad de destino es capital de una provincia.
Eficiencia:registra el porcentaje de eficiencia de la entrega.
Provincia: indica la provincia de destino.
Edad: registra el rango de edad de los clientes.

df<- read_excel("basenueva.xlsx")
skim(df)

Data summary
Name	df
Number of rows	2037
Number of columns	7
_______________________
Column type frequency:
numeric	7
________________________
Group variables	None

Variable type: numeric

skim_variable	n_missing	complete_rate	mean	sd	p0	p25	p50	p75	p100	hist
Mes	193	0.91	7.37	3.80	1	5	9	10.00	12	▅▁▃▅▇
NRO VISITAS	0	1.00	1.51	0.73	0	1	1	2.00	3	▁▇▁▃▂
Éxito	0	1.00	0.68	0.47	0	0	1	1.00	1	▃▁▁▁▇
CAPITAL	0	1.00	0.78	0.41	0	1	1	1.00	1	▂▁▁▁▇
Eficiencia	0	1.00	0.01	0.04	0	0	0	0.01	1	▇▁▁▁▁
Provincia	0	1.00	12.60	5.74	1	9	12	17.00	24	▂▇▃▇▂
Edad	40	0.98	41.45	13.72	18	30	41	53.00	70	▇▆▇▇▃

Entre estas variables se observa que los atributos correspondientes al Mes y Edad tienen 193 y 40 datos faltantes respectivamente. Obteniendo asi un total de 233 datos faltantes en la base de datos Retail.

n_miss(df)

## [1] 233

n_miss(df$Mes)

## [1] 193

n_miss(df$Edad)

## [1] 40

Se observa el porcentaje de missing que tienen cada variable en relación al total de observaciones que se posee en la base,en este caso se tiene un total de 2037 datos.

La variable mes tiene 9.47% de datos faltantes.

La variable edad tiene 1.96% de datos faltantes.

apply(is.na(df),2,FUN="mean")*100

##         Mes NRO VISITAS       Éxito     CAPITAL  Eficiencia   Provincia 
##    9.474718    0.000000    0.000000    0.000000    0.000000    0.000000 
##        Edad 
##    1.963672

Como se puede observar el porcentaje de datos perdido es menor al 20% por lo que se puede hacer la imputación.

Se procede a realizar un resumen de las variables que se tiene con sus datos y porcentajes correspondientes de datos faltantes, por lo que se concluye que Edad y Mes son variables a imputar.

miss_var_summary(df)

## # A tibble: 7 x 3
##   variable    n_miss pct_miss
##   <chr>        <int>    <dbl>
## 1 Mes            193     9.47
## 2 Edad            40     1.96
## 3 NRO VISITAS      0     0   
## 4 Éxito            0     0   
## 5 CAPITAL          0     0   
## 6 Eficiencia       0     0   
## 7 Provincia        0     0

miss_var_table(df)

## # A tibble: 3 x 3
##   n_miss_in_var n_vars pct_vars
##           <int>  <int>    <dbl>
## 1             0      5     71.4
## 2            40      1     14.3
## 3           193      1     14.3

miss_case_summary(df)

## # A tibble: 2,037 x 3
##     case n_miss pct_miss
##    <int>  <int>    <dbl>
##  1  2000      2     28.6
##  2  2001      2     28.6
##  3  2017      2     28.6
##  4  2018      2     28.6
##  5  2029      2     28.6
##  6  2030      2     28.6
##  7    17      1     14.3
##  8    39      1     14.3
##  9    57      1     14.3
## 10    91      1     14.3
## # ... with 2,027 more rows

miss_case_table(df)

## # A tibble: 3 x 3
##   n_miss_in_case n_cases pct_cases
##            <int>   <int>     <dbl>
## 1              0    1810    88.9  
## 2              1     221    10.8  
## 3              2       6     0.295

df %>% group_by('Éxito') %>% miss_var_summary()

## # A tibble: 7 x 4
## # Groups:   "Éxito" [1]
##   `"Éxito"` variable    n_miss pct_miss
##   <chr>     <chr>        <int>    <dbl>
## 1 Éxito     Mes            193     9.47
## 2 Éxito     Edad            40     1.96
## 3 Éxito     NRO VISITAS      0     0   
## 4 Éxito     Éxito            0     0   
## 5 Éxito     CAPITAL          0     0   
## 6 Éxito     Eficiencia       0     0   
## 7 Éxito     Provincia        0     0

df %>% group_by('Éxito') %>% miss_case_summary()

## # A tibble: 2,037 x 4
## # Groups:   "Éxito" [1]
##    `"Éxito"`  case n_miss pct_miss
##    <chr>     <int>  <int>    <dbl>
##  1 Éxito      2000      2     28.6
##  2 Éxito      2001      2     28.6
##  3 Éxito      2017      2     28.6
##  4 Éxito      2018      2     28.6
##  5 Éxito      2029      2     28.6
##  6 Éxito      2030      2     28.6
##  7 Éxito        17      1     14.3
##  8 Éxito        39      1     14.3
##  9 Éxito        57      1     14.3
## 10 Éxito        91      1     14.3
## # ... with 2,027 more rows

IMPUTACIÓN POR MODA

En el caso de la variable Mes, una imputación muy sencilla sería tomar la moda para completar estos datos faltantes, sin embargo esta aplicación puede generar errores.

# Moda

getmode <- function(v) {
  uniqv <- unique(v)
  uniqv[which.max(tabulate(match(v, uniqv)))]
}

Data_Impu_Moda<-ifelse(is.na(df$Mes),getmode(df$Mes),df$Mes)

El siguiente gráfico indica la imputación de la variable Mes, la figura en color rojo son los datos conocidos y la figura en color verde es la imputación, sin embargo se observa incosistencias en esta imputación puesto que no se ajusta la imputación con los datos de la base.

par(mfrow=c(1,1))
plot(density(df$Mes,na.rm = T),col=2,main="Mes") #ROJO CONOCIDO 
lines(density(Data_Impu_Moda),col=3) # VERDE IMPUTACION

IMPUTACIÓN CON LA MEDIA

La librería mice permite realizar la imputacion de los datos mediante diferentes técnicas. En particular con la funcion mice, se generá: Multivariate Imputations by Chained Equations (MICE).

Imputar con algún estadístico de tendencia central (media, mediana, moda) consiste en cambiar todos los valores faltantes por el promedio de los datos que tenemos. Sin embargo el problema es que se esta disminuyendo artificialmente la variabilidad de la muestra.

# Media

imputed_data <- mice(df%>%select(Edad,Mes), method = "mean")

## 
##  iter imp variable
##   1   1  Edad  Mes
##   1   2  Edad  Mes
##   1   3  Edad  Mes
##   1   4  Edad  Mes
##   1   5  Edad  Mes
##   2   1  Edad  Mes
##   2   2  Edad  Mes
##   2   3  Edad  Mes
##   2   4  Edad  Mes
##   2   5  Edad  Mes
##   3   1  Edad  Mes
##   3   2  Edad  Mes
##   3   3  Edad  Mes
##   3   4  Edad  Mes
##   3   5  Edad  Mes
##   4   1  Edad  Mes
##   4   2  Edad  Mes
##   4   3  Edad  Mes
##   4   4  Edad  Mes
##   4   5  Edad  Mes
##   5   1  Edad  Mes
##   5   2  Edad  Mes
##   5   3  Edad  Mes
##   5   4  Edad  Mes
##   5   5  Edad  Mes

Data_Impu_Media <- mice::complete(imputed_data)

sum(is.na(Data_Impu_Media))

## [1] 0

Como se observa en el gráfico los datos por media para la edad y mes han sido imputados. Por otro lado se visualiza que la imputación no se ajusta del todo con los datos de la base.

par(mfrow=c(1,2))

plot(density(df$Edad,na.rm = T),col=2,main="Edad") 
lines(density(Data_Impu_Media$Edad),col=3)  
plot(density(df$Mes,na.rm = T),col=2,main="Mes")
lines(density(Data_Impu_Media$Mes),col=3)

REGRESIÓN LINEAL USANDO BOOSTRAP

La imputación por regresión produce estimaciones que no son sesgadas de las medias bajo MCAR además esta imputación de regresión fortalece por simulación las relaciones en los datos.

# Regresión lineal usando bootstrap

imputed_data <- mice(df%>%select(Edad,Mes), method = "norm.boot")

## 
##  iter imp variable
##   1   1  Edad  Mes
##   1   2  Edad  Mes
##   1   3  Edad  Mes
##   1   4  Edad  Mes
##   1   5  Edad  Mes
##   2   1  Edad  Mes
##   2   2  Edad  Mes
##   2   3  Edad  Mes
##   2   4  Edad  Mes
##   2   5  Edad  Mes
##   3   1  Edad  Mes
##   3   2  Edad  Mes
##   3   3  Edad  Mes
##   3   4  Edad  Mes
##   3   5  Edad  Mes
##   4   1  Edad  Mes
##   4   2  Edad  Mes
##   4   3  Edad  Mes
##   4   4  Edad  Mes
##   4   5  Edad  Mes
##   5   1  Edad  Mes
##   5   2  Edad  Mes
##   5   3  Edad  Mes
##   5   4  Edad  Mes
##   5   5  Edad  Mes

Data_Impu_boot <- mice::complete(imputed_data)

sum(is.na(Data_Impu_boot))

## [1] 0

par(mfrow=c(1,2))

plot(density(df$Edad,na.rm = T),col=2,main="Edad")
lines(density(Data_Impu_boot$Edad),col=3)
plot(density(df$Mes,na.rm = T),col=2,main="Mes")
lines(density(Data_Impu_boot$Mes),col=3)

IMPORTANTE

Es importante señalar que para los dos anteriores metodos se asumió a la variable Mes como una variable cuantitativa, cuando realmente debe ser tratada como cualitativa es decir una factor de 12 categorias.

ÁRBOLES DE CLASIFICACIÓN MEDIANTE REGRESIONES

El objetivo de estos métodos es obtener individuos más homogéneos con respecto a la variable que se desea discriminar dentro de cada subgrupo y heterogéneos entre los subgrupos. Para la construcción del árbol se requiere información de variables explicativas.

df$Mes<-as.factor(df$Mes)
imputed_data <- mice(df%>%select(Edad,Mes), method = "cart")

## 
##  iter imp variable
##   1   1  Edad  Mes
##   1   2  Edad  Mes
##   1   3  Edad  Mes
##   1   4  Edad  Mes
##   1   5  Edad  Mes
##   2   1  Edad  Mes
##   2   2  Edad  Mes
##   2   3  Edad  Mes
##   2   4  Edad  Mes
##   2   5  Edad  Mes
##   3   1  Edad  Mes
##   3   2  Edad  Mes
##   3   3  Edad  Mes
##   3   4  Edad  Mes
##   3   5  Edad  Mes
##   4   1  Edad  Mes
##   4   2  Edad  Mes
##   4   3  Edad  Mes
##   4   4  Edad  Mes
##   4   5  Edad  Mes
##   5   1  Edad  Mes
##   5   2  Edad  Mes
##   5   3  Edad  Mes
##   5   4  Edad  Mes
##   5   5  Edad  Mes

Data_Impu_tree <- mice::complete(imputed_data)

sum(is.na(Data_Impu_tree))

## [1] 0

par(mfrow=c(1,2))

plot(density(df$Edad,na.rm = T),col=2,main="Edad")
lines(density(Data_Impu_tree$Edad),col=3)

#Para graficar les hacemos numericas de lo contrario usaríamos histograma
plot(density(as.numeric(df$Mes),na.rm = T),col=2,main="Mes")
lines(density(as.numeric(Data_Impu_tree$Mes)),col=3)

RANDOM FOREST

El bosque aleatorio es un algoritmo de clasificación que consta de una serie de árboles de decisiones.Su predicción es más precisa que la de un árbol en particular. Se procede a realizar este método para las dos variables.

# Random forest

df$Mes<-as.factor(df$Mes)
imputed_data <- mice(df%>%select(Edad,Mes), method = "rf")

## 
##  iter imp variable
##   1   1  Edad  Mes
##   1   2  Edad  Mes
##   1   3  Edad  Mes
##   1   4  Edad  Mes
##   1   5  Edad  Mes
##   2   1  Edad  Mes
##   2   2  Edad  Mes
##   2   3  Edad  Mes
##   2   4  Edad  Mes
##   2   5  Edad  Mes
##   3   1  Edad  Mes
##   3   2  Edad  Mes
##   3   3  Edad  Mes
##   3   4  Edad  Mes
##   3   5  Edad  Mes
##   4   1  Edad  Mes
##   4   2  Edad  Mes
##   4   3  Edad  Mes
##   4   4  Edad  Mes
##   4   5  Edad  Mes
##   5   1  Edad  Mes
##   5   2  Edad  Mes
##   5   3  Edad  Mes
##   5   4  Edad  Mes
##   5   5  Edad  Mes

Data_Impu_tree <- mice::complete(imputed_data)

sum(is.na(Data_Impu_tree))

## [1] 0

Con los datos imputados podemos ver gráficamente cuánto se ajusta la imputación realizada con la base original en este caso se ajustan correctamente.

par(mfrow=c(1,2))

plot(density(df$Edad,na.rm = T),col=2,main="Edad")
lines(density(Data_Impu_tree$Edad),col=3)

#Para graficar les hacemos numericas de lo contrario usaríamos histograma
plot(density(as.numeric(df$Mes),na.rm = T),col=2,main="Mes")
lines(density(as.numeric(Data_Impu_tree$Mes)),col=3)

COMBINACIÓN DE MÉTODOS

Se determina que se puede combinar los métodos, en este caso se especifíca como vector los métodos a utilizarse para cada variable.

Se utilizará el método de regresión bayesiana para la variable numerica Edad y se aplicará el método de random forest para la variable categórica Mes puesto que es la mas precisa.

# Combinado 
df$Mes<-as.factor(df$Mes)
imputed_data <- mice(df%>%select(Edad,Mes), method = c("norm",'cart'))

## 
##  iter imp variable
##   1   1  Edad  Mes
##   1   2  Edad  Mes
##   1   3  Edad  Mes
##   1   4  Edad  Mes
##   1   5  Edad  Mes
##   2   1  Edad  Mes
##   2   2  Edad  Mes
##   2   3  Edad  Mes
##   2   4  Edad  Mes
##   2   5  Edad  Mes
##   3   1  Edad  Mes
##   3   2  Edad  Mes
##   3   3  Edad  Mes
##   3   4  Edad  Mes
##   3   5  Edad  Mes
##   4   1  Edad  Mes
##   4   2  Edad  Mes
##   4   3  Edad  Mes
##   4   4  Edad  Mes
##   4   5  Edad  Mes
##   5   1  Edad  Mes
##   5   2  Edad  Mes
##   5   3  Edad  Mes
##   5   4  Edad  Mes
##   5   5  Edad  Mes

Data_Impu_Mix <- mice::complete(imputed_data)

sum(is.na(Data_Impu_Mix))

## [1] 0

Con los datos imputados podemos ver gráficamente cuánto se ajusta nuestra imputación con la base origina en este caso se ajustan bien.

par(mfrow=c(1,2))

plot(density(df$Edad,na.rm = T),col=2,main="Edad")
lines(density(Data_Impu_Mix$Edad),col=3)
plot(density(as.numeric(df$Mes),na.rm = T),col=2,main="Mes")
lines(density(as.numeric(Data_Impu_Mix$Mes)),col=3)

Finalmente se reemplaza las variables imputadas en la base original.

df<-df%>%mutate(Mes = Data_Impu_Mix$Mes, Edad = Data_Impu_Mix$Edad)
skim(df)

Data summary
Name	df
Number of rows	2037
Number of columns	7
_______________________
Column type frequency:
factor	1
numeric	6
________________________
Group variables	None

Variable type: factor

skim_variable	n_missing	complete_rate	ordered	n_unique	top_counts
Mes	0	1	FALSE	9	10: 386, 1: 320, 9: 290, 11: 244