15 GAMS en clasificación

También se pueden usar cuando la respuesta es cualitativa. Se asume que $Y$ toma valores cero o uno, y sea $p(X) = Pr(Y = 1|X)$ la probabilidad condicional dado los preditores de que $Y$ sea $1$. Recodemos el modelo logístico:

\[ log\left(\frac{p(X)}{1-p(X)}\right) = \beta_0+\beta_1X_1+\cdots+\beta_pX_p \]

El logit es el logaritmo de los odds de $Pr(Y = 1|X)$ vs $Pr(Y = 0|X)$ que se representa como una función lineal de los predictores en la ecuación anterior.

Se puede extender usando relaciones no lineales de los predictores.

\[ log\left(\frac{p(X)}{1-p(X)}\right) = \beta_0+f_1(X_1)+\cdots+f_p(X_p) \]

Esta ecuación representa un modelo GAM logístico.

15.1 Ejemplo

Ajustamos un GAM a los datos de Salario para predecir la probabilidad de que los ingresos de una persona superen los $\$250,000$ por año. El GAM que ajustamos toma la forma.

\[ log\left(\frac{p(X)}{1-p(X)}\right) = \beta_0+\beta_1\texttt{year}+f_1(\texttt{age})+f_3(\texttt{education}) \]

donde

\[ p(X)=Pr(\texttt{wage}>250|\texttt{year,age,education}) \]

gam.lr <- gam(I(wage > 250) ~ year + s(age, df = 5) + education, 
              family = binomial, data = Wage)
summary(gam.lr)

## 
## Call: gam(formula = I(wage > 250) ~ year + s(age, df = 5) + education, 
##     family = binomial, data = Wage)
## Deviance Residuals:
##      Min       1Q   Median       3Q      Max 
## -0.58206 -0.26780 -0.12341 -0.08241  3.31242 
## 
## (Dispersion Parameter for binomial family taken to be 1)
## 
##     Null Deviance: 730.5345 on 2999 degrees of freedom
## Residual Deviance: 602.4588 on 2989 degrees of freedom
## AIC: 624.4586 
## 
## Number of Local Scoring Iterations: NA 
## 
## Anova for Parametric Effects
##                  Df  Sum Sq Mean Sq F value  Pr(>F)    
## year              1    0.48  0.4845  0.5995 0.43883    
## s(age, df = 5)    1    3.83  3.8262  4.7345 0.02964 *  
## education         4   65.81 16.4514 20.3569 < 2e-16 ***
## Residuals      2989 2415.55  0.8081                    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Anova for Nonparametric Effects
##                Npar Df Npar Chisq  P(Chi)  
## (Intercept)                                
## year                                       
## s(age, df = 5)       4     10.364 0.03472 *
## education                                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Veamos las relaciones entre las variables:

par(mfrow = c(1, 3))
plot(gam.lr, se = TRUE, col = "green")

par(mfrow = c(1, 1))

El ajuste resultante se muestra en la figura. El último panel parece sospechoso, con intervalos de confianza muy amplios para el nivel <HS, veamos

with(Wage,table(education, I(wage > 250)))

##                     
## education            FALSE TRUE
##   1. < HS Grad         268    0
##   2. HS Grad           966    5
##   3. Some College      643    7
##   4. College Grad      663   22
##   5. Advanced Degree   381   45

No hay unos para esa categoría: ningún individuo con menos de una educación secundaria gana más de $ 250, 000 por año. Re ajustamos el modelo:

gam.lr.s <- gam(I(wage > 250) ~ year + s(age, df = 5) + education,
                family = binomial, data = Wage, 
                subset = (education != "1. < HS Grad"))
summary(gam.lr.s)

## 
## Call: gam(formula = I(wage > 250) ~ year + s(age, df = 5) + education, 
##     family = binomial, data = Wage, subset = (education != "1. < HS Grad"))
## Deviance Residuals:
##     Min      1Q  Median      3Q     Max 
## -0.5821 -0.2760 -0.1415 -0.1072  3.3124 
## 
## (Dispersion Parameter for binomial family taken to be 1)
## 
##     Null Deviance: 715.5412 on 2731 degrees of freedom
## Residual Deviance: 602.4588 on 2722 degrees of freedom
## AIC: 622.4586 
## 
## Number of Local Scoring Iterations: NA 
## 
## Anova for Parametric Effects
##                  Df  Sum Sq Mean Sq F value    Pr(>F)    
## year              1    0.48  0.4845  0.5459   0.46004    
## s(age, df = 5)    1    3.83  3.8262  4.3116   0.03795 *  
## education         3   65.80 21.9339 24.7166 8.933e-16 ***
## Residuals      2722 2415.55  0.8874                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Anova for Nonparametric Effects
##                Npar Df Npar Chisq  P(Chi)  
## (Intercept)                                
## year                                       
## s(age, df = 5)       4     10.364 0.03472 *
## education                                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Evaluemos los resultados:

par(mfrow = c(1, 3))
plot(gam.lr.s, se = TRUE, col = "green")

Los tres paneles tienen la misma escala vertical. Esto nos permite evaluar visualmente las contribuciones relativas de cada una de las variables. Observamos que la edad y la educación tienen un efecto mucho mayor que el año en la probabilidad de ser una fuente de ingresos elevada.