Motivación

Mario tiene como idea de negocio crear una discoteca de gran formato enfocada en música urbana en la ciudad de Bucaramanga. Él tiene una idea clara de cómo se verá una noche habitual su negocio, y lo ha plasmado en las siguientes imágenes:

Para llevar a cabo su sueño, Mario, se encuentra interesado en conocer las características de sus futuros clientes y de esta forma hacer una publicidad eficiente. Para ello, decide contratar un Analista de datos que le ayude a caracterizar y clasificar a sus clientes potenciales; y que le brinde información que le pueda ser de utilidad para la toma de decisiones en la creación del negocio.

Luego de una extensa reflexión sobre el problema que incluyó revisión de literatura económica de los determinantes de la demanda de un servicios y de entrevistas semiestructuradas a dueños y administradores de discotecas similares se encontró que los principales determinantes teóricos son:

  • Edad

  • Sexo

  • Tenencia de hijos menores de edad

  • Ocupación (Ocupado, No ocupado)

  • Nível Educativo

Para ello ha diseñado el siguiente cuestionario: https://forms.gle/8ZRUTJdTowZJVKSy5

Limpieza de datos

La limpieza y arreglo de los datos es un tema crucial para el analista de datos, puede demandar hasta el 80% del tiempo en la programación. Para este caso el reto del Analista de datos es sitematizar los resultados de la encuesta construida en google forms para generar un informe en tiempo real a medida que se recogen los datos.

#Lectura de datos en línea 
datos=read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vQFG1qNbO1wndpqYC27XQMrEqUQwoMFil8YS3rIwYQ9TpOkLgj7lrnwqDs0bSWHYioWFrOgsDk-U1bv/pub?gid=242934044&single=true&output=csv", encoding="UTF-8")
colnames(datos)=c("Tiempo","Dispuesto","Edad","Sexo","Hijos","Trabaja","Educacion")
Tiempo Dispuesto Edad Sexo Hijos Trabaja Educacion
1 21/5/2022 9:19:51 No 21 Mujer No Sí Universidad
2 21/5/2022 9:21:48 No 20 Hombre No No Bachillerato
3 21/5/2022 9:22:18 No 16 Hombre No Sí Universidad
4 21/5/2022 9:29:44 No 17 Mujer No No Universidad
... ...
156 9/6/2022 10:55:55 Sí 45 Hombre Sí Sí Posgrado
157 9/6/2022 10:56:28 No 27 Hombre No Sí Universidad
158 9/6/2022 10:56:38 No 61 Hombre No Sí Posgrado
159 9/6/2022 10:56:57 No 53 Hombre Sí Sí Posgrado

Creación de variables dummies y filtro de población mayor de 18 años.

datos$Dispuesto2=as.numeric(ifelse(datos$Dispuesto=="Sí", 1,0) )

df_final=filter(datos,Edad>=18)
Tiempo Dispuesto Edad Sexo Hijos Trabaja Educacion Dispuesto2
1 21/5/2022 9:19:51 No 21 Mujer No Sí Universidad 0
2 21/5/2022 9:21:48 No 20 Hombre No No Bachillerato 0
3 21/5/2022 9:30:40 Sí 22 Hombre No No Universidad 1
4 21/5/2022 9:37:13 No 18 Hombre No No Bachillerato 0
... ... ...
146 9/6/2022 10:55:55 Sí 45 Hombre Sí Sí Posgrado 1
147 9/6/2022 10:56:28 No 27 Hombre No Sí Universidad 0
148 9/6/2022 10:56:38 No 61 Hombre No Sí Posgrado 0
149 9/6/2022 10:56:57 No 53 Hombre Sí Sí Posgrado 0

Estadística descriptiva

Vamos a indentificar descriptivamente la relación entre la disposición a asistir una discoteca de gran formato y la covariables: Educación, hijos menores de 18 años, Ocupación, Sexo y Edad.

Podemos evidenciar que ningun sexo parece tener predominio sobre la desición de asistir o no a la discoteca.

Freq % Total Cum.
No 65 43.62416
Sí 84 100.00000
Total 149 100.00000

Balanceo y partición

Como el objetivo principal de la técnica es clasificar a los posibles clientes de la discoteca, deseo tener similar cantidad de información de las personas que están y las que no están dispuestas a participar. Así el algoritmo tendrá sufuciente información para clasificar a cada grupo.

# Balanceo
set.seed(1234)
df_balan=stratified(df_final, "Dispuesto", c("Sí"= 62,"No"= 62))

#Partición
set.seed(1)
entrenamiento <- createDataPartition(y = df_balan$Dispuesto, p = 0.70, list = FALSE)
training <- df_balan[entrenamiento,]
testing <- df_balan[-entrenamiento,]

Estimación del modelo logit

\[\log \left( \frac{\Pi_i}{1-\Pi_i} \right) = \beta_0+ \beta_1 Educ_i +\beta_2 Sex_i+\beta_3 hijos_i+\beta_4 trabaja_i+\beta_5 Edad+ \epsilon_i\]

  1. Estimación del modelo con todas las covaraibles

  2. Selección del mejor modelo según algoritmo StepAIC \[AIC=2K-2 \ln (L)\] donde K es el número de parámetros del Modelo y L es el logaritmo de la verosimilitud del modelo.

  3. Estimación los parámetros del mejor modelos según Algoritmo StepAIC

m_logit=glm(Dispuesto2~Hijos+Educacion+Edad+Sexo+Trabaja, data=training, family = binomial(logit))
summary(m_logit)
## 
## Call:
## glm(formula = Dispuesto2 ~ Hijos + Educacion + Edad + Sexo + 
##     Trabaja, family = binomial(logit), data = training)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.92528  -0.74326  -0.05153   0.90719   1.92959  
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)  
## (Intercept)           1.88666    1.14358   1.650   0.0990 .
## HijosSí              -0.78315    0.59865  -1.308   0.1908  
## EducacionPosgrado     0.37381    0.73692   0.507   0.6120  
## EducacionUniversidad  1.82353    0.76194   2.393   0.0167 *
## Edad                 -0.04085    0.02263  -1.805   0.0710 .
## SexoMujer            -0.53683    0.53109  -1.011   0.3121  
## TrabajaSí            -0.92445    0.81505  -1.134   0.2567  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 121.994  on 87  degrees of freedom
## Residual deviance:  91.634  on 81  degrees of freedom
## AIC: 105.63
## 
## Number of Fisher Scoring iterations: 4
stepAIC(m_logit, direction = "both",steps = 2000)
## Start:  AIC=105.63
## Dispuesto2 ~ Hijos + Educacion + Edad + Sexo + Trabaja
## 
##             Df Deviance    AIC
## - Sexo       1   92.677 104.68
## - Trabaja    1   92.991 104.99
## - Hijos      1   93.376 105.38
## <none>           91.634 105.63
## - Edad       1   94.939 106.94
## - Educacion  2  100.248 110.25
## 
## Step:  AIC=104.68
## Dispuesto2 ~ Hijos + Educacion + Edad + Trabaja
## 
##             Df Deviance    AIC
## - Trabaja    1   93.748 103.75
## - Hijos      1   94.532 104.53
## <none>           92.677 104.68
## + Sexo       1   91.634 105.63
## - Edad       1   95.693 105.69
## - Educacion  2  100.916 108.92
## 
## Step:  AIC=103.75
## Dispuesto2 ~ Hijos + Educacion + Edad
## 
##             Df Deviance    AIC
## <none>           93.748 103.75
## - Hijos      1   95.911 103.91
## + Trabaja    1   92.677 104.68
## + Sexo       1   92.991 104.99
## - Edad       1   98.330 106.33
## - Educacion  2  102.464 108.46
## 
## Call:  glm(formula = Dispuesto2 ~ Hijos + Educacion + Edad, family = binomial(logit), 
##     data = training)
## 
## Coefficients:
##          (Intercept)               HijosSí     EducacionPosgrado  
##              1.10153              -0.86433               0.23860  
## EducacionUniversidad                  Edad  
##              1.71953              -0.04531  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  83 Residual
## Null Deviance:       122 
## Residual Deviance: 93.75     AIC: 103.7
m_logit2=glm(Dispuesto2~Hijos+Educacion+Edad, data=training, family = binomial(logit))
summary(m_logit2)
## 
## Call:
## glm(formula = Dispuesto2 ~ Hijos + Educacion + Edad, family = binomial(logit), 
##     data = training)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.00646  -0.70905   0.05407   0.98446   1.99528  
## 
## Coefficients:
##                      Estimate Std. Error z value Pr(>|z|)  
## (Intercept)           1.10153    0.95623   1.152   0.2493  
## HijosSí              -0.86433    0.59334  -1.457   0.1452  
## EducacionPosgrado     0.23860    0.70430   0.339   0.7348  
## EducacionUniversidad  1.71953    0.73330   2.345   0.0190 *
## Edad                 -0.04531    0.02178  -2.080   0.0375 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 121.994  on 87  degrees of freedom
## Residual deviance:  93.748  on 83  degrees of freedom
## AIC: 103.75
## 
## Number of Fisher Scoring iterations: 4

El mejor modelo según el algoritmo StepAIC tiene como covariables la edad, la tenencia de hijos menores de 18 y el nivel de estudios.

Resultados

###odd ratio
exp(m_logit2$coefficients)
##          (Intercept)              HijosSí    EducacionPosgrado 
##            3.0087681            0.4213343            1.2694732 
## EducacionUniversidad                 Edad 
##            5.5819127            0.9557003
#Predicciión del modelo
testing$prediccion=predict(m_logit2, testing, type="response")

Para interpretar los parámetros es necesario calcular el exponencial de los parámetros. Si este valor es mayor que la unidad se puede afirmar que la variable explicativa afecta positivamente la razon de probabilidad. Si el resultado del exponencial es menor que la unidad se evidencia una mayor probabiliad de fracaso ante cambios positivo en las covariables.

Matriz de confusión

testing$prediccion1=ifelse(testing$prediccion>=0.45, 1, 0)


Accuracy=sum(diag(CrossTable( testing$Dispuesto, testing$prediccion1,
                           prop.c = FALSE,  prop.r=F, prop.t=FALSE, prop.chisq = FALSE)$t))/nrow(testing)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |-------------------------|
## 
##  
## Total Observations in Table:  36 
## 
##  
##                   | testing$prediccion1 
## testing$Dispuesto |         0 |         1 | Row Total | 
## ------------------|-----------|-----------|-----------|
##                No |        14 |         4 |        18 | 
## ------------------|-----------|-----------|-----------|
##                Sí |         6 |        12 |        18 | 
## ------------------|-----------|-----------|-----------|
##      Column Total |        20 |        16 |        36 | 
## ------------------|-----------|-----------|-----------|
## 
## 
Accuracy
## [1] 0.7222222

En la diagonal principal encontramos la frecuencia de acierto con lo cual se puede calcular la precisión del modelo.

Predicción con observaciones nuevas

####Datos nuevos para predecir 
datos_nuevos = data.frame(tail(df_final,5))

datos_nuevos$probabilidad=predict(m_logit, datos_nuevos, type="response")

datos_nuevos$prediccion=ifelse(datos_nuevos$probabilidad>=0.45, 1, 0)

kable(datos_nuevos)
Tiempo Dispuesto Edad Sexo Hijos Trabaja Educacion Dispuesto2 probabilidad prediccion
145 9/6/2022 10:55:53 Sí 35 Mujer Sí Sí Posgrado 1 0.1956754 0
146 9/6/2022 10:55:55 Sí 45 Hombre Sí Sí Posgrado 1 0.2166722 0
147 9/6/2022 10:56:28 No 27 Hombre No Sí Universidad 0 0.8432898 1
148 9/6/2022 10:56:38 No 61 Hombre No Sí Posgrado 0 0.2394775 0
149 9/6/2022 10:56:57 No 53 Hombre Sí Sí Posgrado 0 0.1663210 0