Introducción


Una investigación realizada en la Ciudad de México revela que una persona puede utilizar medios de transporte públicos en función de su edad, la distancia que planea recorrer en su viaje y el ingreso que percibe. El propósito principal del presente trabajo es corroborar esta hipótesis y calcular en qué medida cada una de estas variables determinan la decisión de emplear o no el transporte público de la ciudad, en términos de la probabilidad.


Desarrollo


Se recogió una muestra con 2,201 personas, se les cuestionó sobre su edad, la distancia que recorrían diariamente de su hogar a su empleo y el ingreso que percibían diariamente. De las respuestas al cuestionario definamos a las variables de interés como:


  1. Uso del transporte público (metro). Categorizada como 1 si se emplea diariamente y como 0 si no.

  2. Edad. La edad de la persona encuestada.

  3. Distancia. La distancia medida en kilómetros que se recorre diariamente de los hogares a los empleos, calculada con una aproximación de GPS.

  4. Ingreso. El ingreso diario en pesos de las personas encuestadas.


Para tal información recopilada no sólo es inútil sino imposible el empleo de un modelo de regresión múltiple, dada la naturaleza categórica de la respuesta a la pregunta ¿Utiliza diariamente el metro para ir a su trabajo?, cuya respuesta sólo puede (en este caso) ser sí (1) o no (0). Una breve descripción de las variables de interés puede resultar interesante.


Descripción de las variables


Edad


La edad promedio de las personas encuestadas es de 38.8 años, la edad mínima de la encuesta es de 18 años y la máxima de 97 años. Esta variable se distribuye gráficamente como:



Distancia


La distancia que un citadino promedio recorre en promedio de su hogar a su trabajo diariamente es de 10.11 km, el que menos recorrido hace lo hace en 0.66 km y el que más 35.7 km. Esta variable se distribuye gráficamente como:



Ingreso


El ingreso promedio para la muestra recogida se calcula en $754.5 pesos diarios, para este caso la mediana constituye una mejor medida de tendencia central y se calcula en $734 pesos diarios. La variable ingreso se distribuye gráficamente como:



Ajuste del modelo


El modelo de regresión para una variable dependiente dicotómica logit se propone como:


## 
## Call:
## glm(formula = t_publico ~ edad + distancia + ingreso, family = binomial(logit), 
##     data = base)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.7976296  0.2339943   3.409 0.000653 ***
## edad        -0.0062323  0.0032650  -1.909 0.056285 .  
## distancia    0.0994633  0.0103584   9.602  < 2e-16 ***
## ingreso     -0.0026203  0.0002376 -11.029  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.3  on 2200  degrees of freedom
## Residual deviance: 2748.1  on 2197  degrees of freedom
## AIC: 2756.1
## 
## Number of Fisher Scoring iterations: 4


Para el que todos los coeficientes son significativos a excepción de la edad. Una primera interpretación es señalar que la edad estadísticamente no influye en la determinación de la decisión de si utilizar el transporte público en la Ciudad o no hacerlo, por el contrario la distancia a recorrer y el ingreso de las personas sí lo hace.


Ajuste y mejoras


Una primera evaluación de la calidad del modelo es sin lugar a dudas la observación de la significancia de los coeficientes de los predictores, por lo que una primera estratégia de mejora del ajuste es eliminar esta variable y observar cambios en la significancia de los coeficientes.


## 
## Call:
## glm(formula = t_publico ~ distancia + ingreso, family = binomial(logit), 
##     data = base)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.5588735  0.1973292   2.832  0.00462 ** 
## distancia    0.0995114  0.0103563   9.609  < 2e-16 ***
## ingreso     -0.0026240  0.0002374 -11.055  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.3  on 2200  degrees of freedom
## Residual deviance: 2751.8  on 2198  degrees of freedom
## AIC: 2757.8
## 
## Number of Fisher Scoring iterations: 4


La significancia de los coeficientes restantes no se afectó negativamente, optaremos por utilizar este nuevo modelo para continuar con el análisis, anque, es verdad que puede objetarse que aunque quizá la edad no es importante en la constante del modelo lineal, lo es en su pendiente, probamos este hecho como:


## 
## Call:
## glm(formula = t_publico ~ distancia + ingreso * edad, family = binomial(logit), 
##     data = base)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   7.706e-01  5.324e-01   1.448 0.147728    
## distancia     9.948e-02  1.036e-02   9.600  < 2e-16 ***
## ingreso      -2.584e-03  6.896e-04  -3.747 0.000179 ***
## edad         -5.541e-03  1.268e-02  -0.437 0.662054    
## ingreso:edad -9.417e-07  1.669e-05  -0.056 0.954997    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.3  on 2200  degrees of freedom
## Residual deviance: 2748.1  on 2196  degrees of freedom
## AIC: 2758.1
## 
## Number of Fisher Scoring iterations: 4


## 
## Call:
## glm(formula = t_publico ~ distancia * edad + ingreso, family = binomial(logit), 
##     data = base)
## 
## Coefficients:
##                  Estimate Std. Error z value Pr(>|z|)    
## (Intercept)     0.8916132  0.3801861   2.345  0.01902 *  
## distancia       0.0903512  0.0308120   2.932  0.00336 ** 
## edad           -0.0086004  0.0082313  -1.045  0.29609    
## ingreso        -0.0026222  0.0002377 -11.032  < 2e-16 ***
## distancia:edad  0.0002329  0.0007426   0.314  0.75384    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 2976.3  on 2200  degrees of freedom
## Residual deviance: 2748.0  on 2196  degrees of freedom
## AIC: 2758
## 
## Number of Fisher Scoring iterations: 4


Se observa que ningún cambio en la pendiente de la regresión lineal es aprovechable, el mejor modelo en términos de los coeficientes es el modelo 2. Las relaciones de las variables distacia e ingresos con la categoría: Sí usa el transporte público (1) y no usa el transporte público (0), se ven según la frecuencia como:




Probando la relación lineal entre las variables


## Cargando paquete requerido: carData
##  MLE of lambda Score Statistic (t) Pr(>|t|)
##         1.3927              1.1935   0.2328
## 
## iterations =  4
##  MLE of lambda Score Statistic (t) Pr(>|t|)
##        0.64681               0.917   0.3592
## 
## iterations =  5


Interpretación de los coeficientes


## (Intercept)   distancia     ingreso 
##  0.55887347  0.09951139 -0.00262398


  1. La probabilidad de que la persona emplee el transporte público dado que percibe un ingreso diariode $500 es de:
## [1] 0.3421776


  1. La probabilidad de que una persona emplee el transporte público dado que recorrerá los 5 km de su casa al trabajo es de:
## [1] 0.7415052


Significancia global del modelo


## [1] 1.806933e-49


El valor es significativo.


## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: t_publico
## 
## Terms added sequentially (first to last)
## 
## 
##           Df Deviance Resid. Df Resid. Dev  Pr(>Chi)    
## NULL                       2200     2976.3              
## distancia  1   87.438      2199     2888.8 < 2.2e-16 ***
## ingreso    1  137.032      2198     2751.8 < 2.2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


##          [,1]     [,2]
## [1,] 2756.147 2757.815
##          [,1]     [,2]
## [1,] 2748.147 2751.815


En este caso el modelo 1 tiene menor aic y devianza pero elegimos al modelo 2 dado el análisis anterior.


Curvas de ROC


## Warning: package 'pROC' was built under R version 4.4.2
## Type 'citation("pROC")' for a citation.
## 
## Adjuntando el paquete: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var


Para distancia


## Setting levels: control = 0, case = 1
## Setting direction: controls < cases


## Area under the curve: 0.6064


Punto de corte

## Setting levels: control = 0, case = 1
## Setting direction: controls < cases

## 
## Call:
## plot.roc.default(x = base$t_publico, predictor = base$distancia,     main = "Confidence interval of a threshold", percent = TRUE,     ci = TRUE, print.auc = TRUE, of = "thresholds", thresholds = "best",     print.thres = "best")
## 
## Data: base$distancia in 1303 controls (base$t_publico 0) < 898 cases (base$t_publico 1).
## Area under the curve: 60.64%
## 95% CI (2000 stratified bootstrap replicates):
##  thresholds sp.low sp.median sp.high se.low se.median se.high
##       9.695  47.12     49.81   52.42  63.59     66.82    69.6


Para ingreso


## Setting levels: control = 0, case = 1
## Setting direction: controls > cases


## Area under the curve: 0.6381


Punto de corte

## Setting levels: control = 0, case = 1
## Setting direction: controls > cases

## 
## Call:
## plot.roc.default(x = base$t_publico, predictor = base$ingreso,     main = "Confidence interval of a threshold", percent = TRUE,     ci = TRUE, print.auc = TRUE, of = "thresholds", thresholds = "best",     print.thres = "best")
## 
## Data: base$ingreso in 1303 controls (base$t_publico 0) > 898 cases (base$t_publico 1).
## Area under the curve: 63.81%
## 95% CI (2000 stratified bootstrap replicates):
##  thresholds sp.low sp.median sp.high se.low se.median se.high
##       743.5  54.41      57.1   59.94  61.47     64.37   67.48


Predicción


X0<-data.frame(distancia=1, ingreso=500)
predict(modelo2,X0)
##          1 
## -0.6536052
a<-exp(-0.6536052)
b<-exp(1-0.6536052)
a/b
## [1] 0.3678794


La información se verifica con el caso expuesto en la interpretación de los coeficientes.