# packages
library(tidyverse)
library(GGally)
# data
prostate <- read_tsv('data/prostate_data.txt',
col_select = -1)Regression & Classification
Maestría en Ciencias de la Ingeniería. Estadística Avanzada
Abstract
En este documento aprenderemos a realizar análisis de regresión y a a justar distintos clasificadores usando R. De especial relevancia en este trabajo es el uso del tidyverse para manipular datos sin complicaciones y producir gráficos de alta calidad. El lenguage de fórmulas de R juega también un papel muy importante.
Regresión
En esta sección realizaremos tareas básicas de regresión con la función lm y el lenguaje de fórmulas.
Datos
Usaremos los datos del archivo `prostate_data.txt` que contienen información sobre las siguientes variables
| Columna | Variable | Tipo |
|---|---|---|
| lcavol | Log of Cancer Volume | numeric |
| lweight | Log of Prostate Weight | numeric |
| lpsa | Log of Prostate Specific Antigen | numeric |
| lcp | Log of Capsular Penetration | numeric |
| lbph | Log of Benign Prostatic Hyperplasia | numeric |
| svi | Seminal Vesicle Invasion | factor |
| age | Age | numeric / integer |
| gleason | Gleason Score | factor / integer |
| ppg45 | Percent of Gleason Scores 4 or 5 | numeric |
| train | Use as train data? | factor / logic |
Objetivos
Predecir el logaritmo de PSA (lpsa) con un modelo de regresión lineal.
Primer acercamiento a los datos
Tenemos 97 observaciones de 10 variables. Sus descriptivos básicos son
- 1
-
Tomar los datos del objeto
prostatey aplicarles la función… El signo|>aparece con la combinación de teclas Ctrl (Cmd) + Shift + M y se llama operador pipe y puede verse así%>%según las opciones de tu RStudio - 2
-
select(seleccionar) las columnas distintas detrainylpsa
lcavol lweight age lbph
Min. :-1.3471 Min. :2.375 Min. :41.00 Min. :-1.3863
1st Qu.: 0.5128 1st Qu.:3.376 1st Qu.:60.00 1st Qu.:-1.3863
Median : 1.4469 Median :3.623 Median :65.00 Median : 0.3001
Mean : 1.3500 Mean :3.629 Mean :63.87 Mean : 0.1004
3rd Qu.: 2.1270 3rd Qu.:3.876 3rd Qu.:68.00 3rd Qu.: 1.5581
Max. : 3.8210 Max. :4.780 Max. :79.00 Max. : 2.3263
svi lcp gleason pgg45
Min. :0.0000 Min. :-1.3863 Min. :6.000 Min. : 0.00
1st Qu.:0.0000 1st Qu.:-1.3863 1st Qu.:6.000 1st Qu.: 0.00
Median :0.0000 Median :-0.7985 Median :7.000 Median : 15.00
Mean :0.2165 Mean :-0.1794 Mean :6.753 Mean : 24.38
3rd Qu.:0.0000 3rd Qu.: 1.1787 3rd Qu.:7.000 3rd Qu.: 40.00
Max. :1.0000 Max. : 2.9042 Max. :9.000 Max. :100.00 Se observan escalas muy distintas. Por ello, se estandarizan las variables numéricas. Además, se convierten en factor las variables cuyos valores son discretos.
1y_variable_name = 'lpsa'
df_scaled <- prostate |>
mutate(
4 svi = factor(svi),
5 gleason = factor(gleason, ordered = TRUE)
) |>
mutate(
across(
2 where(is.numeric) & -all_of(y_variable_name),
3 \(x) (x - mean(x)) / sd(x))
)
df_scaled |>
select(-c(train, lpsa)) |>
summary()- 1
-
Seleccionamos la variable
lpsacomo dependiente por su nombre - 2
- Transformamos (mutate) todas las columnas que son numéricas y no son la variable dependiente
- 3
-
Usamos
\(x) (x - mean(x)) / sd(x)como transformación base. Observe la deficinión de la función efímera con\(x) expression. R tiene la funciónscalepero el formato de salida es más limpio haciendo la definición directamente - 4
-
Usamos
svicomo factor (variable categórica) de modo que R genere dummies automáticamente para los modelos de regresión - 5
-
Usamos
gleasoncomo un factor ordenado
lcavol lweight age lbph
Min. :-2.28833 Min. :-2.92718 Min. :-3.0713 Min. :-1.0247
1st Qu.:-0.71031 1st Qu.:-0.59070 1st Qu.:-0.5193 1st Qu.:-1.0247
Median : 0.08222 Median :-0.01386 Median : 0.1523 Median : 0.1377
Mean : 0.00000 Mean : 0.00000 Mean : 0.0000 Mean : 0.0000
3rd Qu.: 0.65927 3rd Qu.: 0.57761 3rd Qu.: 0.5553 3rd Qu.: 1.0048
Max. : 2.09651 Max. : 2.68770 Max. : 2.0327 Max. : 1.5343
svi lcp gleason pgg45
0:76 Min. :-0.8632 6:35 Min. :-0.8645
1:21 1st Qu.:-0.8632 7:56 1st Qu.:-0.8645
Median :-0.4428 8: 1 Median :-0.3326
Mean : 0.0000 9: 5 Mean : 0.0000
3rd Qu.: 0.9712 3rd Qu.: 0.5538
Max. : 2.2053 Max. : 2.6811 df_scaled |>
select(-c(train)) |>
ggpairs(
title = 'Relación entre las variables de estudio: Obsérvense las distintas opciones de la función ggpairs(...) para interpretar este gráfico'
)
Modelos de regresión
Ajustamos primero el modelo completo
\[ y = \beta_0 + \sum_{k=1}^p \beta_k x_k + \varepsilon \]
El código tiene tres argumentos importantes: la fórmula, los datos, y el subconjunto de los datos (establecido por al condición lógica que lo selecciona)
summary(
lm(lpsa ~ . - train,
data = df_scaled,
subset = train == TRUE)
)
Call:
lm(formula = lpsa ~ . - train, data = df_scaled, subset = train ==
TRUE)
Residuals:
Min 1Q Median 3Q Max
-1.63386 -0.29322 -0.08569 0.44765 1.54455
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.32130 0.22602 10.270 1.72e-14 ***
lcavol 0.66959 0.12967 5.164 3.32e-06 ***
lweight 0.27682 0.09569 2.893 0.00543 **
age -0.16515 0.10105 -1.634 0.10780
lbph 0.19140 0.10369 1.846 0.07020 .
svi1 0.70716 0.30509 2.318 0.02413 *
lcp -0.34327 0.16812 -2.042 0.04590 *
gleason.L -0.21194 0.45168 -0.469 0.64074
gleason.Q -0.70358 0.46424 -1.516 0.13526
gleason.C -0.47598 0.58087 -0.819 0.41602
pgg45 0.31176 0.17189 1.814 0.07509 .
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.7031 on 56 degrees of freedom
Multiple R-squared: 0.7124, Adjusted R-squared: 0.6611
F-statistic: 13.87 on 10 and 56 DF, p-value: 6.847e-12Auto-selección de modelos
library(leaps)
best_subsets <- regsubsets(
lpsa ~ .,
data = df_scaled,
subset = train == TRUE,
method = 'exhaustive'
)
subsets_summary <- summary(best_subsets)
plot(subsets_summary$rss,
xlab = "Number of Variables",
ylab = "RSS", type = "l",
ylim = c(0, 50))
subsets_summarySubset selection object
Call: regsubsets.formula(lpsa ~ ., data = df_scaled, subset = train ==
TRUE, method = "exhaustive")
11 Variables (and intercept)
Forced in Forced out
lcavol FALSE FALSE
lweight FALSE FALSE
age FALSE FALSE
lbph FALSE FALSE
svi1 FALSE FALSE
lcp FALSE FALSE
gleason.L FALSE FALSE
gleason.Q FALSE FALSE
gleason.C FALSE FALSE
pgg45 FALSE FALSE
trainTRUE FALSE FALSE
1 subsets of each size up to 8
Selection Algorithm: exhaustive
lcavol lweight age lbph svi1 lcp gleason.L gleason.Q gleason.C pgg45
1 ( 1 ) "*" " " " " " " " " " " " " " " " " " "
2 ( 1 ) "*" "*" " " " " " " " " " " " " " " " "
3 ( 1 ) "*" "*" " " " " " " " " " " " " "*" " "
4 ( 1 ) "*" "*" " " " " "*" " " " " " " "*" " "
5 ( 1 ) "*" "*" " " "*" "*" " " " " "*" " " " "
6 ( 1 ) "*" "*" "*" "*" "*" " " " " "*" " " " "
7 ( 1 ) "*" "*" "*" "*" "*" "*" " " " " " " "*"
8 ( 1 ) "*" "*" "*" "*" "*" "*" " " "*" " " "*"
trainTRUE
1 ( 1 ) " "
2 ( 1 ) " "
3 ( 1 ) " "
4 ( 1 ) " "
5 ( 1 ) " "
6 ( 1 ) " "
7 ( 1 ) " "
8 ( 1 ) " " Ver ?best_subsets. Como esta función no ajusta el modelo óptimo, debemos ajustarlo. El gráfico sugiere que usar \(p = 3\) variables es suficiente y el método nos dice que deben ser lcavol, lweight, gleason`
summary(
prostate_model <- lm(
lpsa ~ lcavol + lweight + gleason,
data = df_scaled,
subset = train == TRUE
)
)
Call:
lm(formula = lpsa ~ lcavol + lweight + gleason, data = df_scaled,
subset = train == TRUE)
Residuals:
Min 1Q Median 3Q Max
-1.53127 -0.45955 -0.04718 0.51205 1.85745
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.30871 0.21984 10.502 2.65e-15 ***
lcavol 0.62368 0.10637 5.863 1.98e-07 ***
lweight 0.33344 0.08687 3.838 0.000297 ***
gleason.L -0.07376 0.35861 -0.206 0.837717
gleason.Q -0.17579 0.44028 -0.399 0.691091
gleason.C 0.42212 0.51757 0.816 0.417914
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.7426 on 61 degrees of freedom
Multiple R-squared: 0.6506, Adjusted R-squared: 0.622
F-statistic: 22.72 on 5 and 61 DF, p-value: 8.533e-13Una vez ajustado el modelo
La siguientes funciones son útiles para manipular objetos de tipo lm:
| Función | Descripción |
|---|---|
| print( ) | Impresión simple del objeto |
| summary( ) | Resultado de la estimación |
| coef( ) – o coefficients( ) – | Matriz de coeficientes estimados |
| resid( ) – o residuals( ) – | Vector de residuales |
| fitted( ) – o fitted.values( ) – | Valores ajustados \(\hat{y}\) |
| predict( ) | Predicción para nuevos datos |
| plot( ) | Gráficos diagnósticos |
| confint( ) | Intervalos de confianza para los parámetros de regresión |
| vcov( ) | Matriz estimada de varianzas y covarianzas de los coeficientes de regresión |
Otro elemento común para diagnoisticar el modelo son las medidas de influencia, basadas en el cálculo
\[ \mbox{Var}(\beta) = \sigma^2 (I - H) \]
con \(H = X(X^\prime X)^{-1}X^{\prime}\) la matriz de proyección sobre las columnas de \(X\). Esto da lugar a la noción de leverage y la medida distancia de Cook que se aprecian en los gráficos siguientes:
Diagnósticos gráficos
for (i in 1:6){
plot(prostate_model, which = i)
}
Clasificación
Datos del mercado financiero
Cargando el paquete ISLR2 en nuestro ambiente de trabajo, tenemos acceso a los datos Smarket que contienen los retornos porcentuales del S&P500 para los años 2001 a 2005.
library(ISLR2)
head(Smarket) |>
knitr::kable()| Year | Lag1 | Lag2 | Lag3 | Lag4 | Lag5 | Volume | Today | Direction |
|---|---|---|---|---|---|---|---|---|
| 2001 | 0.381 | -0.192 | -2.624 | -1.055 | 5.010 | 1.1913 | 0.959 | Up |
| 2001 | 0.959 | 0.381 | -0.192 | -2.624 | -1.055 | 1.2965 | 1.032 | Up |
| 2001 | 1.032 | 0.959 | 0.381 | -0.192 | -2.624 | 1.4112 | -0.623 | Down |
| 2001 | -0.623 | 1.032 | 0.959 | 0.381 | -0.192 | 1.2760 | 0.614 | Up |
| 2001 | 0.614 | -0.623 | 1.032 | 0.959 | 0.381 | 1.2057 | 0.213 | Up |
| 2001 | 0.213 | 0.614 | -0.623 | 1.032 | 0.959 | 1.3491 | 1.392 | Up |
Objetivo
Predecir la variable dicotómica Direction usando el resto de las variables como predictores. Veamos primero la relación entre las variables presentes en los datos:
Smarket |>
ggpairs()
Naive Model: Linear regression (Probability linear model)
Tomando \(y =\) Direction en un modelo de regresión simple, podemos hacer la clasificación deseada porque estaríamos estimando \(E(y\vert X) = P(y = 1\vert X)\) que es el clasificador de Bayes! Usando Volume en vez de Year y despreciando la información del día en la variable Today obtenemos:
linear_classif_model <- lm(Direction == "Up" ~ . - Year - Today, data = Smarket)
summary(linear_classif_model)
Call:
lm(formula = Direction == "Up" ~ . - Year - Today, data = Smarket)
Residuals:
Min 1Q Median 3Q Max
-0.6523 -0.5151 0.4330 0.4809 0.5850
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.468751 0.060019 7.810 1.21e-14 ***
Lag1 -0.018150 0.012474 -1.455 0.146
Lag2 -0.010501 0.012481 -0.841 0.400
Lag3 0.002775 0.012456 0.223 0.824
Lag4 0.002335 0.012458 0.187 0.851
Lag5 0.002570 0.012348 0.208 0.835
Volume 0.033645 0.039453 0.853 0.394
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 0.5003 on 1243 degrees of freedom
Multiple R-squared: 0.002865, Adjusted R-squared: -0.001948
F-statistic: 0.5953 on 6 and 1243 DF, p-value: 0.7343Modelo Logístico
Siguiendo la misma pauta del modelo de clasificación lineal:
logistic_classifier <- glm(Direction ~ . - Year - Today,
data = Smarket ,
family = binomial)
summary(logistic_classifier)
Call:
glm(formula = Direction ~ . - Year - Today, family = binomial,
data = Smarket)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -0.126000 0.240736 -0.523 0.601
Lag1 -0.073074 0.050167 -1.457 0.145
Lag2 -0.042301 0.050086 -0.845 0.398
Lag3 0.011085 0.049939 0.222 0.824
Lag4 0.009359 0.049974 0.187 0.851
Lag5 0.010313 0.049511 0.208 0.835
Volume 0.135441 0.158360 0.855 0.392
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 1731.2 on 1249 degrees of freedom
Residual deviance: 1727.6 on 1243 degrees of freedom
AIC: 1741.6
Number of Fisher Scoring iterations: 3Podemos utiizar el método predict para obtener predicciones. El comando contrasts(Smarket$Direction) nos muestra que Up es la dirección \(y = 1\). Por ello, cuando usamos el argumento type = "response" y obetenemos la predicción de las probabilidades \(P(y = 1\vert X)\), estamos estimando la probabilidad de que el retorno haya subido.
logistic_probas <- predict(logistic_classifier,
type = "response")Ahora, considerando un umbral de \(u = 0.5\) veamos las predicciones de cada modelo:
linear_preds <- fitted(linear_classif_model) >= 0.5
logistic_preds <- logistic_probas >= 0.5
rename_preds <- function(index){
preds = rep("Down", length(index))
preds[index] = "Up"
return(preds)
}
conf_matrix_logistic_basic <- table(rename_preds(logistic_preds), Smarket$Direction)
conf_matrix_linear_basic <- table(rename_preds(linear_preds), Smarket$Direction)
conf_matrix_logistic_basic
Down Up
Down 145 141
Up 457 507conf_matrix_linear_basic
Down Up
Down 145 141
Up 457 507Podemos usar otras librerías para lograr una matriz de confusión distinta
library(caret)
confusion_matrix_caret <- confusionMatrix(
data = as.factor(rename_preds(logistic_preds)),
positive = "Up",
reference = Smarket$Direction)Antes de leerla, consulatmos ?confusionMatrix y vemos, con base en la tabla de confusión general
\[ \begin{array}{ccc} & \text{Reference} & \\ \text{Predicted} & \text{Event} & \text{No Event}\\ \text{Event} & A & B \\ \text{No Event} & C & D \end{array} \]
las fórmulas para cada medida presente en el objeto
\[ \begin{equation*} \begin{split} \text{Sensitivity} =& \frac{A}{A + C}\\ \text{Specificity} =& \frac{D}{B + D}\\ \text{Prevalence} =& \frac{A + C}{A + B + C + D}\\ \text{PPV} =& \frac{\text{Sensitivty}*\text{Prevalence}}{\text{Sensitivty}*\text{Prevalence} + (1 - \text{Specificity}) * (1 - \text{Prevalence})}\\ \text{NPV} =& \frac{\text{Specificity}*(1 - \text{Prevalence})}{(1 - \text{Sensitivty})*\text{Prevalence} + (\text{Specificity}) * (1 - \text{Prevalence})}\\ \text{Detection Rate} =& \frac{A}{A + B + C + D}\\ \text{Detection Prevalence} = &\frac{A + B}{ A + B + C + D}\\ \text{Balanced Accuracy} =& \frac{\text{Sensitivity} + \text{Specificity}}{2}\\ \text{Precision} =& \frac{A}{A + B}\\ \text{Recall} =& \frac{A}{A + C}\\ \text{F}_1 =& \frac{\text{Precision} * {Recall}}{\text{Precision} + \text{Recall}} \end{split} \end{equation*} \]
confusion_matrix_caretConfusion Matrix and Statistics
Reference
Prediction Down Up
Down 145 141
Up 457 507
Accuracy : 0.5216
95% CI : (0.4935, 0.5496)
No Information Rate : 0.5184
P-Value [Acc > NIR] : 0.4216
Kappa : 0.0237
Mcnemar's Test P-Value : <2e-16
Sensitivity : 0.7824
Specificity : 0.2409
Pos Pred Value : 0.5259
Neg Pred Value : 0.5070
Prevalence : 0.5184
Detection Rate : 0.4056
Detection Prevalence : 0.7712
Balanced Accuracy : 0.5116
'Positive' Class : Up
También podemos representar esta matriz en un diagrama de calor (heatmap)
conf_matrix_df <- as.data.frame(confusion_matrix_caret$table)
# Create the ggplot
conf_matrix_df |>
ggplot(
aes(x = Reference, y = Prediction, fill = Freq)
) +
geom_tile(color = "black") + # Añade los bordes negros
geom_text(
aes(label = Freq),
vjust = 1,
size = 6,
color = "white") +
scale_fill_gradient(low = "#fee8c8", high = "#e34a33") + # Estos colores pueden cambiar
labs(
title = "Matriz de Confusión Gráfica",
x = "Valor de Referencia",
y = "Predicción"
) +
theme_minimal() +
theme(
legend.position = "none", # Ocultamos la legend correspondiente a fill
axis.text = element_text(size = 12),
plot.title = element_text(hjust = 0.5, size = 16)
)
Corrección de la estimación
Esta estimación no utiliza datos de entrenamiento y de prueba, sino toda la muestra como entrenamiento. Esto puede dar ajustes demasiado optimistas. Para corregir este problema, utilicemos el año 2005 como prueba y los años 2001 a 2004 como entrenamiento.
train <- Smarket$Year < 2005
logistic_classifier_train <- update(logistic_classifier,
subset = train)
summary(logistic_classifier_train)
Call:
glm(formula = Direction ~ . - Year - Today, family = binomial,
data = Smarket, subset = train)
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.191213 0.333690 0.573 0.567
Lag1 -0.054178 0.051785 -1.046 0.295
Lag2 -0.045805 0.051797 -0.884 0.377
Lag3 0.007200 0.051644 0.139 0.889
Lag4 0.006441 0.051706 0.125 0.901
Lag5 -0.004223 0.051138 -0.083 0.934
Volume -0.116257 0.239618 -0.485 0.628
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 1383.3 on 997 degrees of freedom
Residual deviance: 1381.1 on 991 degrees of freedom
AIC: 1395.1
Number of Fisher Scoring iterations: 3Con este nuevo modelo obtenemos la matriz de confusión:
logistic_preds_train <- predict(logistic_classifier_train,
type = "response") >= 0.5
predicted <- factor(rename_preds(logistic_preds_train))
reference <- Smarket |>
filter(train == TRUE) |>
pull(Direction)
confusionMatrix(predicted, reference)Confusion Matrix and Statistics
Reference
Prediction Down Up
Down 175 156
Up 316 351
Accuracy : 0.5271
95% CI : (0.4955, 0.5584)
No Information Rate : 0.508
P-Value [Acc > NIR] : 0.1207
Kappa : 0.049
Mcnemar's Test P-Value : 2.506e-13
Sensitivity : 0.3564
Specificity : 0.6923
Pos Pred Value : 0.5287
Neg Pred Value : 0.5262
Prevalence : 0.4920
Detection Rate : 0.1754
Detection Prevalence : 0.3317
Balanced Accuracy : 0.5244
'Positive' Class : Down
Aplicando ahora la clasificación al año 2005, tenemos
Smarket_2005 <- Smarket |>
filter(train == FALSE)
logistic_preds_test <- predict(logistic_classifier_train,
type = "response",
newdata = Smarket_2005
)
logistic_preds_test <- logistic_preds_test >= 0.5
predicted <- factor(rename_preds(logistic_preds_test))
reference <- Smarket |>
filter(train == FALSE) |>
pull(Direction)
confusionMatrix(predicted, reference)Confusion Matrix and Statistics
Reference
Prediction Down Up
Down 77 97
Up 34 44
Accuracy : 0.4802
95% CI : (0.417, 0.5437)
No Information Rate : 0.5595
P-Value [Acc > NIR] : 0.9952
Kappa : 0.0054
Mcnemar's Test P-Value : 6.062e-08
Sensitivity : 0.6937
Specificity : 0.3121
Pos Pred Value : 0.4425
Neg Pred Value : 0.5641
Prevalence : 0.4405
Detection Rate : 0.3056
Detection Prevalence : 0.6905
Balanced Accuracy : 0.5029
'Positive' Class : Down
Ejercicio
Repita el ajuste usando únicamente las variables explicativas Lag1 y Lag2
Confusion Matrix and Statistics
Reference
Prediction Down Up
Down 35 35
Up 76 106
Accuracy : 0.5595
95% CI : (0.4959, 0.6218)
No Information Rate : 0.5595
P-Value [Acc > NIR] : 0.5262856
Kappa : 0.0698
Mcnemar's Test P-Value : 0.0001467
Sensitivity : 0.7518
Specificity : 0.3153
Pos Pred Value : 0.5824
Neg Pred Value : 0.5000
Prevalence : 0.5595
Detection Rate : 0.4206
Detection Prevalence : 0.7222
Balanced Accuracy : 0.5335
'Positive' Class : Up
Discriminante Lineal y Cuadrático
El LDA se encuentra dentro de la librería MASS. La función es lda y su sintáxis es como la de lm o glm (sin opción de familiy). Siguiendo la temática del ejercicio, ajustemos el modelo de discriminante lineal a los datos previos a 2005 con variables explicagivas Lag1 y Lag2
library(MASS)
lda_market <- lda(Direction ~ Lag1 + Lag2, data = Smarket, subset = train)
print(lda_market, 3)Call:
lda(Direction ~ Lag1 + Lag2, data = Smarket, subset = train)
Prior probabilities of groups:
Down Up
0.492 0.508
Group means:
Lag1 Lag2
Down 0.0428 0.0339
Up -0.0395 -0.0313
Coefficients of linear discriminants:
LD1
Lag1 -0.642
Lag2 -0.514La clase lda también tiene un método predict
lda_preds <- predict(lda_market, Smarket_2005)
str(lda_preds)List of 3
$ class : Factor w/ 2 levels "Down","Up": 2 2 2 2 2 2 2 2 2 2 ...
$ posterior: num [1:252, 1:2] 0.49 0.479 0.467 0.474 0.493 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:252] "1" "2" "3" "4" ...
.. ..$ : chr [1:2] "Down" "Up"
$ x : num [1:252, 1] 0.0829 0.5911 1.1672 0.8334 -0.0379 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:252] "1" "2" "3" "4" ...
.. ..$ : chr "LD1"El elemento $class contiene la clasificación, el elemento $posterior contiene las probabilidades de cada clase según el modelo y el elemento $x contiene el valor del primer discriminante.
lda_preds <- lda_preds$class
confusion_matrix_lda <- confusionMatrix(lda_preds, reference, positive = "Up")Ejercicio
- El discriminante cuadrático se encuentra en
qda. Repetir el ejercicio con esta función
Confusion Matrix and Statistics
Reference
Prediction Down Up
Down 30 20
Up 81 121
Accuracy : 0.5992
95% CI : (0.5358, 0.6602)
No Information Rate : 0.5595
P-Value [Acc > NIR] : 0.1138
Kappa : 0.1364
Mcnemar's Test P-Value : 2.369e-09
Sensitivity : 0.8582
Specificity : 0.2703
Pos Pred Value : 0.5990
Neg Pred Value : 0.6000
Prevalence : 0.5595
Detection Rate : 0.4802
Detection Prevalence : 0.8016
Balanced Accuracy : 0.5642
'Positive' Class : Up
- El método Naive Bayes se encuentra en la función
naiveBayesde la libreríae1071. Repita el análisis usando Naive Bayes. Analice los outputs para verificar que comprende cada número de la salida
Confusion Matrix and Statistics
Reference
Prediction Down Up
Down 28 20
Up 83 121
Accuracy : 0.5913
95% CI : (0.5278, 0.6526)
No Information Rate : 0.5595
P-Value [Acc > NIR] : 0.1707
Kappa : 0.1175
Mcnemar's Test P-Value : 1.002e-09
Sensitivity : 0.8582
Specificity : 0.2523
Pos Pred Value : 0.5931
Neg Pred Value : 0.5833
Prevalence : 0.5595
Detection Rate : 0.4802
Detection Prevalence : 0.8095
Balanced Accuracy : 0.5552
'Positive' Class : Up
ROC y AUC
Las mediciones de ROC y AUC se encuentran en la librería pROC
library(pROC)
pred_proba_logistic <- predict(logistic_classifier_train, type='response', newdata = Smarket_2005)
pred_proba_lda <- predict(lda_market, Smarket_2005)$posterior[,'Up']
pred_proba_qda <- predict(qda_market, Smarket_2005)$posterior[,'Up']
roc_logistic <- roc(reference, pred_proba_logistic)
roc_lda <- roc(reference, pred_proba_lda)
roc_qda <- roc(reference, pred_proba_qda)
ggroc(list(GLM = roc_logistic, LDA = roc_lda, QDA = roc_qda)) +
labs(
title = "ROC Curve Comparison: Logistic vs. LDA vs. QDA",
x = "False Positive Rate",
y = "True Positive Rate",
color = "Model"
) +
theme_minimal() +
geom_abline(slope = 1, intercept = 1, linetype = "dashed", color = "grey")