1. Métricas para problemas de clasificación

1.1. Matriz de confusión

  • TP = True Positive (Verdaderos positivos)
  • TN = True Negative (Verdaderos negativos)
  • FP = False Positive (Falsos positivos o error tipo I)
  • FN = False Negative (Falsos negativos o error tipo II)

1.1.1. Accuracy

Es la tasa de predicciones correctas del modelo. Es decir, la ratio entre el número de predicciones correctas (Verdaderos) y el número total de predicciones.

\(Accuracy= \frac{TP + TN}{TP + TN + FN + FP}\)

1.1.2. Sensitivity

Es la proporción de positivos que son predecidas bien. Es decir, la ratio entre el número de verdaderos positivos y el número positivos.

\(Sensitivity = \frac{TP}{TP + FN}\)

1.1.3. Specificity

Es la proporción de negativos que son predecidas bien. Es decir, la ratio entre el número de verdaderos negativos y el número negativos.

\(Specificity = \frac{TN}{TN + FP}\)

1.1.4. False Positive Rate

Es la proporción de predicciones positivas que son predecidas mal. Es decir, la ratio entre el número de falsos positivos y el número predicciones positivas.

\(False Positive Rate = \frac{FP}{TP + FP}\)

1.1.5. False Negative Rate

Es la proporción de predicciones positivas que son predecidas mal. Es decir, la ratio entre el número de falsos positivos y el número predicciones positivas.

\(False Negative Rate = \frac{FN}{TN + FN}\)

Antes de empezar…

Llamar/instalar las librerías para esta sesión:

## llamar la librería pacman: contiene la función p_load()
require(pacman)

## p_load llama/instala-llama las librerías que se enlistan:
p_load(tidyverse, caret, rio, 
       modelsummary, # tidy, msummary
       gamlr, # cv.gamlr
       class) # knn

2. K-Nearest Neighbors

Vamos a cargar el conjunto de datos de Motor Trend Car Road Tests (mtcars) la cuál contiene información de algunas caracteristicas para 32 marcas de vehículos de 1974: millas por galón (mpg), número de cilindros (cyl), esplazamiento (disp), potencia bruta (hp), relación del eje trasero (drt), peso en miles de libras (wt), 1/4 de milla de tiempo (qseg), motor en forma de V (vs), transmisión manual (am), número de marchas hacia delante (gear) y número de carburadores (carb).

## obtener los datos
?mtcars
db <- tibble(mtcars)
head(db)
## # A tibble: 6 × 11
##     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1  21       6   160   110  3.9   2.62  16.5     0     1     4     4
## 2  21       6   160   110  3.9   2.88  17.0     0     1     4     4
## 3  22.8     4   108    93  3.85  2.32  18.6     1     1     4     1
## 4  21.4     6   258   110  3.08  3.22  19.4     1     0     3     1
## 5  18.7     8   360   175  3.15  3.44  17.0     0     0     3     2
## 6  18.1     6   225   105  2.76  3.46  20.2     1     0     3     1

Intentemos predecir si un automovil tiene transmisión manual (1) o automatica (0):

## recategorizar variable
db = db %>% 
     mutate(am=ifelse(am==1,"manual (1)","automatic (0)") %>% as.factor())
set.seed(210422) ## fijar semilla
test <- sample(x=1:32, size=10) ## generar observaciones aleatorias
x <- scale(db[,-9]) ## reescalar variables (para calcular distancias)
apply(x,2,sd) ## verificar
##  mpg  cyl disp   hp drat   wt qsec   vs gear carb 
##    1    1    1    1    1    1    1    1    1    1
k1 = knn(train=x[-test,], ## base de entrenamiento
         test=x[test,],   ## base de testeo
         cl=db$am[-test], ## outcome
         k=1)        ## vecinos 

Predicción contra datos observados

tibble(db$am[test],k1)
## # A tibble: 10 × 2
##    `db$am[test]` k1           
##    <fct>         <fct>        
##  1 manual (1)    manual (1)   
##  2 manual (1)    manual (1)   
##  3 manual (1)    manual (1)   
##  4 manual (1)    manual (1)   
##  5 automatic (0) automatic (0)
##  6 manual (1)    manual (1)   
##  7 automatic (0) automatic (0)
##  8 automatic (0) automatic (0)
##  9 automatic (0) manual (1)   
## 10 automatic (0) automatic (0)

Obtener la matriz de confusión

confusionMatrix(data=k1 , reference=db$am[test] , mode="sens_spec" , positive="manual (1)")
## Confusion Matrix and Statistics
## 
##                Reference
## Prediction      automatic (0) manual (1)
##   automatic (0)             4          0
##   manual (1)                1          5
##                                          
##                Accuracy : 0.9            
##                  95% CI : (0.555, 0.9975)
##     No Information Rate : 0.5            
##     P-Value [Acc > NIR] : 0.01074        
##                                          
##                   Kappa : 0.8            
##                                          
##  Mcnemar's Test P-Value : 1.00000        
##                                          
##             Sensitivity : 1.0000         
##             Specificity : 0.8000         
##          Pos Pred Value : 0.8333         
##          Neg Pred Value : 1.0000         
##              Prevalence : 0.5000         
##          Detection Rate : 0.5000         
##    Detection Prevalence : 0.6000         
##       Balanced Accuracy : 0.9000         
##                                          
##        'Positive' Class : manual (1)     
## 
cm = confusionMatrix(data=k1 , reference=db$am[test], positive="manual (1)")$table
cm
##                Reference
## Prediction      automatic (0) manual (1)
##   automatic (0)             4          0
##   manual (1)                1          5

Obtener las metricas de clasificación

(cm[1,1]+cm[2,2])/sum(cm) ## Accuracy
## [1] 0.9
cm[2,2]/sum(cm[,2]) ## Sensitivity
## [1] 1
cm[1,1]/sum(cm[,1]) ## Specificity
## [1] 0.8
cm[2,1]/sum(cm[2,]) ## Ratio Falsos Positivos
## [1] 0.1666667
cm[1,2]/sum(cm[1,]) ## Ratio Falsos Negativos
## [1] 0

3. Regresión: Logit y Probit

Importar conjunto de datos:

## obtener datos
geih <- import("https://eduard-martinez.github.io/teaching/meca-4107/geih.rds")
head(geih)
##   directorio ocu age estrato1 sex maxEducLevel dominio mes y_subFamiliar_m
## 1    4514331   0  29        2   0            6  BOGOTA   1              NA
## 2    4514331   1  36        2   1            6  BOGOTA   1           2e+05
## 3    4514332   0   4        2   1            2  BOGOTA   1              NA
## 4    4514332   0   7        2   1           NA  BOGOTA   1              NA
## 5    4514332   0  32        2   0            5  BOGOTA   1              NA
## 6    4514332   0  35        2   1            6  BOGOTA   1              NA

3.1. Estimar el modelo

## modelo a ajustar
model <- as.formula("ocu ~ age + sex + factor(maxEducLevel)")

## estimación logit
logit <- glm(model , family=binomial(link="logit") , data=geih)
tidy(logit)
## # A tibble: 9 × 5
##   term                   estimate std.error statistic  p.value
##   <chr>                     <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)            -2.18      0.338     -6.45   1.09e-10
## 2 age                     0.00613   0.00240    2.56   1.05e- 2
## 3 sex                     0.583     0.0811     7.19   6.50e-13
## 4 factor(maxEducLevel)2 -14.7     236.        -0.0622 9.50e- 1
## 5 factor(maxEducLevel)3   1.47      0.355      4.14   3.53e- 5
## 6 factor(maxEducLevel)4   1.64      0.341      4.82   1.44e- 6
## 7 factor(maxEducLevel)5   1.21      0.331      3.64   2.68e- 4
## 8 factor(maxEducLevel)6   2.26      0.326      6.93   4.22e-12
## 9 factor(maxEducLevel)7   2.40      0.325      7.39   1.46e-13
## estimación probit
probit <- glm(model , family=binomial(link="probit") , data=geih)
tidy(probit)
## # A tibble: 9 × 5
##   term                  estimate std.error statistic  p.value
##   <chr>                    <dbl>     <dbl>     <dbl>    <dbl>
## 1 (Intercept)           -1.31      0.189     -6.93   4.25e-12
## 2 age                    0.00375   0.00146    2.57   1.02e- 2
## 3 sex                    0.356     0.0496     7.19   6.50e-13
## 4 factor(maxEducLevel)2 -4.34     59.5       -0.0730 9.42e- 1
## 5 factor(maxEducLevel)3  0.872     0.202      4.32   1.53e- 5
## 6 factor(maxEducLevel)4  0.978     0.192      5.11   3.30e- 7
## 7 factor(maxEducLevel)5  0.704     0.185      3.82   1.36e- 4
## 8 factor(maxEducLevel)6  1.36      0.181      7.51   5.88e-14
## 9 factor(maxEducLevel)7  1.45      0.181      8.01   1.13e-15
## ratio de los coeficientes
logit$coefficients / probit$coefficients
##           (Intercept)                   age                   sex 
##              1.667585              1.634702              1.636232 
## factor(maxEducLevel)2 factor(maxEducLevel)3 factor(maxEducLevel)4 
##              3.385791              1.684798              1.677680 
## factor(maxEducLevel)5 factor(maxEducLevel)6 factor(maxEducLevel)7 
##              1.711673              1.659732              1.660983

3.2. Predicciones

## preddicción
geih$ocu_log = predict(logit , newdata=geih , type="response")
geih$ocu_prob = predict(probit , newdata=geih , type="response")
head(geih)
##   directorio ocu age estrato1 sex maxEducLevel dominio mes y_subFamiliar_m
## 1    4514331   0  29        2   0            6  BOGOTA   1              NA
## 2    4514331   1  36        2   1            6  BOGOTA   1           2e+05
## 3    4514332   0   4        2   1            2  BOGOTA   1              NA
## 4    4514332   0   7        2   1           NA  BOGOTA   1              NA
## 5    4514332   0  32        2   0            5  BOGOTA   1              NA
## 6    4514332   0  35        2   1            6  BOGOTA   1              NA
##        ocu_log     ocu_prob
## 1 5.634630e-01 5.641918e-01
## 2 7.070746e-01 7.068517e-01
## 3 8.524043e-08 6.475769e-08
## 4           NA           NA
## 5 3.144350e-01 3.143079e-01
## 6 7.058035e-01 7.055604e-01
## definir la regla
rule=0.7
geih$ocu_prob = ifelse(geih$ocu_prob>rule,1,0)
geih$ocu_log = ifelse(geih$ocu_log>rule,1,0)
head(geih)
##   directorio ocu age estrato1 sex maxEducLevel dominio mes y_subFamiliar_m
## 1    4514331   0  29        2   0            6  BOGOTA   1              NA
## 2    4514331   1  36        2   1            6  BOGOTA   1           2e+05
## 3    4514332   0   4        2   1            2  BOGOTA   1              NA
## 4    4514332   0   7        2   1           NA  BOGOTA   1              NA
## 5    4514332   0  32        2   0            5  BOGOTA   1              NA
## 6    4514332   0  35        2   1            6  BOGOTA   1              NA
##   ocu_log ocu_prob
## 1       0        0
## 2       1        1
## 3       0        0
## 4      NA       NA
## 5       0        0
## 6       1        1

3.3. Clasificación

## probit
cm_prob = confusionMatrix(data=factor(geih$ocu_prob) , 
                          reference=factor(geih$ocu) , 
                          mode="sens_spec" , positive="1")
cm_prob
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 1125 1088
##          1  169  477
##                                           
##                Accuracy : 0.5603          
##                  95% CI : (0.5419, 0.5786)
##     No Information Rate : 0.5474          
##     P-Value [Acc > NIR] : 0.08503         
##                                           
##                   Kappa : 0.1641          
##                                           
##  Mcnemar's Test P-Value : < 2e-16         
##                                           
##             Sensitivity : 0.3048          
##             Specificity : 0.8694          
##          Pos Pred Value : 0.7384          
##          Neg Pred Value : 0.5084          
##              Prevalence : 0.5474          
##          Detection Rate : 0.1668          
##    Detection Prevalence : 0.2260          
##       Balanced Accuracy : 0.5871          
##                                           
##        'Positive' Class : 1               
## 
## logit
cm_log = confusionMatrix(data=factor(geih$ocu) , 
                         reference=factor(geih$ocu_log) , 
                         mode="sens_spec" , positive="1")
cm_log
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 1125  169
##          1 1088  477
##                                           
##                Accuracy : 0.5603          
##                  95% CI : (0.5419, 0.5786)
##     No Information Rate : 0.774           
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1641          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7384          
##             Specificity : 0.5084          
##          Pos Pred Value : 0.3048          
##          Neg Pred Value : 0.8694          
##              Prevalence : 0.2260          
##          Detection Rate : 0.1668          
##    Detection Prevalence : 0.5474          
##       Balanced Accuracy : 0.6234          
##                                           
##        'Positive' Class : 1               
## 
cm = cm_log$table
(cm[1,1]+cm[2,2])/sum(cm) ## Accuracy
## [1] 0.5603358
cm[2,2]/sum(cm[,2]) ## Sensitivity
## [1] 0.7383901
cm[1,1]/sum(cm[,1]) ## Specificity
## [1] 0.5083597
cm[2,1]/sum(cm[2,]) ## Ratio Falsos Positivos
## [1] 0.6952077
cm[1,2]/sum(cm[1,]) ## Ratio Falsos Negativos
## [1] 0.1306028