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}\)
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}\)
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}\)
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}\)
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}\)
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) # knnVamos 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
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
## 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
## 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
## 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