Tarea 04
Caso: Modelos de Machine Learning
Lectura de datos
El conjunto de datos a modelar contiene siete variables predictoras (Genero, Edad, Estatura, Peso, Antecedentes, Fumador, Tipo_de_movilidad) y una variable respuesta (Estado).
data <-
readxl::read_xlsx("datos.xlsx", sheet = 1) %>%
mutate_at(
vars(
Genero, Antecedentes, Fumador,
Tipo_de_movilidad, Estado
),
as.factor
) %>%
mutate_if(
.predicate = function(x) !is.factor(x),
as.numeric
)
data# A tibble: 1,000 x 8
Genero Edad Estatura Peso Antecedentes Fumador Tipo_de_movilidad Estado
<fct> <dbl> <dbl> <dbl> <fct> <fct> <fct> <fct>
1 Femenino 35 1.45 75.5 si si Transporte_priva~ Termin~
2 Masculino 29 1.83 83.8 si si Transporte_públi~ Inicial
3 Femenino 32 1.52 96 no no Transporte_priva~ Termin~
4 Masculino 28 1.38 96.1 si no Transporte_priva~ Grave
5 Femenino 32 1.82 60.2 no si Peatón Grave
6 Masculino 31 1.86 78.1 no si Transporte_públi~ Termin~
7 Femenino 33 1.8 97.1 no si Transporte_públi~ Termin~
8 Masculino 31 1.64 108. si no Peatón Termin~
9 Femenino 31 1.65 80 no no Peatón Grave
10 Masculino 33 1.62 76 no si Transporte_públi~ Inicial
# ... with 990 more rowsDe estas siete variables predictoras se tienen 3 variables numéricas (Edad, Estatura y Peso) y 4 variables de tipo factor (Genero, Antecedentes, Fumador y Tipo_de_movilidad).
Análisis Exploratorio de Datos
Mostramos el porcentaje de observaciones por Diagnóstico (Estado).
A continuación detectamos la cantidad de missing values por variable.
mice::md.pattern(data, rotate.names = TRUE) /\ /\
{ `---' }
{ O O }
==> V <== No need for mice. This data set is completely observed.
\ \|/ /
`-----'
Genero Edad Estatura Peso Antecedentes Fumador Tipo_de_movilidad Estado
1000 1 1 1 1 1 1 1 1 0
0 0 0 0 0 0 0 0 0No hay datos faltantes.
Caracterización de variables en función al diagnóstico de Estado.
Los gráficos exploratorio ratifican lo balanceado que están nuestros nuestros datos.
Particionamiento de Training Data
Para el particionamiento se establece una semilla set.seed con la finalidad de la reproducibilidad del código.
set.seed(2021)
# Particionar el dataset en 70% (entrenamiento) y 30% (prueba)
samples <-
caret::createDataPartition(
data$Estado,
p = .7
)$Resample1Creamos los dataframes de training y testing.
train_data <- dplyr::slice(data, samples)
test_data <- dplyr::slice(data, -samples)01| Análisis de Cluster
El análisis de cluster es una técnica de agrupación de observaciones en función a un conjuntos de características.
El modelo más difundido es k-means por su bajo costo computacinal. Sin embargo, este modelo es sensible a valores atípicos y solo ese aplicable a conjunto de datos con variables numéricas.
Es redundante, pero necesario, mencionar que al ser un modelo no supervisado, este carece de un target o variable respuesta.
En este ejemplo práctico usaremos el modelo k-prototypes que es una variante del k-means, para datos mixtos.
01|01 Preparación de datos
Omitimos la variable Estado.
ACluster_data <- dplyr::select(data, -Estado)Estandarizamos las variables numéricas en función a su rango o amplitud. Creamos la función.
normalize <-
function(x) {
return((x - min(x)) / (max(x) - min(x)))
}Aplicamos la función de estandarización a las variables Edad, Estatura y Peso.
ACluster_data$Edad <- normalize(ACluster_data$Edad)
ACluster_data$Estatura <- normalize(ACluster_data$Estatura)
ACluster_data$Peso <- normalize(ACluster_data$Peso)01|02 Búsqueda del del parámetro lambda
Este parámetro es mayor a 0 para compensar entre la distancia euclidiana de las variables numéricas y el coeficiente de coincidencia simple entre las variables categóricas.
# Determinando el valor de lambda
lambda <- clustMixType::lambdaest(ACluster_data)Numeric variances:
Edad Estatura Peso
0.02155457 0.01941657 0.03159624
Average numeric variance: 0.02418913
Heuristic for categorical variables: (method = 1)
Genero Antecedentes Fumador Tipo_de_movilidad
0.498200 0.499758 0.499550 0.666298
Average categorical variation: 0.5409515
Estimated lambda: 0.04471589 lambda[1] 0.0447158901|03 Búsqueda del K óptimo
Existen distintos indicadores para estimar el K óptimo (calinski-harabasz index, WSS, silueta promedio, Dunn index, Davies-Bouldin, etc). Por temas prácticos, solo usaremos la suma de cuadrados intracluster (WSS) o método del codo (Elbow).
Se establece una semilla para hacer reproducible nuestros resultados ya que los centroides iniciales son seleccionados aleatoriamente.
set.seed(2021)
# valor del k maximo
k.max <- 10
wss <- 0
for (i in 1:k.max) {
model <-
clustMixType::kproto(
ACluster_data,
k = i,
nstart = 5,
lambda = lambda,
verbose = FALSE
)
if (i == 1) {
wss <- model$tot.withinss
} else {
wss <- c(wss, model$tot.withinss)
}
}Ploteamos los valores de WSS.
wss <- data.frame(cluster = c(1:10), wss)
ggplot(wss) +
aes(cluster, wss) +
geom_line(color = "blue") +
geom_point(color = "blue") +
geom_vline(xintercept = 3, linetype = 2, col = "red") +
labs(title = "Método Elbow") +
scale_x_continuous(breaks = 1:10) +
theme_classic()
El K óptimo es igual a 3.
01|04 Ejecución del modelo k-prototypes
modelEnd <-
clustMixType::kproto(
ACluster_data,
k = 3,
lambda = lambda,
nstart = 5,
verbose = FALSE
)Anidando el resultado del análisis de cluster al conjunto de datos original.
ACluster_data2 <-
dplyr::bind_cols(
ACluster_data,
cluster = modelEnd$cluster
)01|05 Caracterización de Cluster resultado
Preparación de datos para el ploteo.
medias <-
dplyr::select_if(
ACluster_data2,
is.numeric
) %>%
group_by(cluster) %>%
summarise_all(list(mean))
general <-
summarise_if(ACluster_data2, is.numeric, mean) %>%
dplyr::select(-cluster) %>%
cbind(cluster = "general")
stackMedias <- rbind(medias, general)
dataPlot <-
tidyr::pivot_longer(
data = stackMedias,
-cluster,
names_to = "variable",
values_to = "valor"
)Gráfico para variables numéricas
ggplot(dataPlot, aes(x = variable, y = valor, group = cluster)) +
geom_point(aes(colour = cluster)) +
geom_line(aes(colour = cluster)) +
theme_bw() +
scale_color_manual(
values = c("blue", "green", "red", "black")
) +
theme(legend.position = "bottom") +
labs(
title = "Diagrama de líneas de Cluster por Variable",
x = "", y = "value"
)
Gráfico para variables categóricas
g1 <-
ggplot(mutate(ACluster_data2, cluster = factor(cluster))) +
aes(Genero, fill = cluster) +
geom_bar(position = position_fill()) +
labs(x = NULL, y = "Proporción") +
theme_bw()
g2 <-
ggplot(mutate(ACluster_data2, cluster = factor(cluster))) +
aes(Antecedentes, fill = cluster) +
geom_bar(position = position_fill()) +
labs(x = NULL, y = "Proporción") +
theme_bw()
g3 <-
ggplot(mutate(ACluster_data2, cluster = factor(cluster))) +
aes(Fumador, fill = cluster) +
geom_bar(position = position_fill()) +
labs(x = NULL, y = "Proporción") +
theme_bw()
g4 <-
ggplot(mutate(ACluster_data2, cluster = factor(cluster))) +
aes(Tipo_de_movilidad, fill = cluster) +
geom_bar(position = position_fill()) +
labs(x = NULL, y = "Proporción") +
theme_bw() +
theme(
axis.text.x = element_text(angle = 45, hjust = 1)
)
(g1 + g2) / (g3 + g4)
02| Modelo de Redes Neuronales
Las redes neuronales son un potente modelo computacional que tiene como objetivo simular/imitar el comportamiento de la mente humana. Una red neuronal artificial (RNA) es un modelo que relaciona un conjunto de señales de entrada y una señal de salida utilizando el conocimiento que se tiene acerca del problema expresado en un conjunto de pesos y obteniendo un resultado final, como se muestra en la siguiente imagen:
01|01 Preparación de datos
Estandarizamos las variables numéricas en función a su rango y amplitud. Creamos la función:
normalize <-
function(x) {
return((x - min(x)) / (max(x) - min(x)))
}Para este ejercicio, modificaremos los nombre de las muestras de train test aplicados a nuestro ejemplo de redes reuronales:
train_data_RNA <- train_data
test_data_RNA <- test_dataAplicamos la función de estandarización a las variables Edad, Estatura y Peso.
train_data_RNA$Edad <- normalize(train_data_RNA$Edad)
train_data_RNA$Estatura <- normalize(train_data_RNA$Estatura)
train_data_RNA$Peso <- normalize(train_data_RNA$Peso)
test_data_RNA$Edad <- normalize(test_data_RNA$Edad)
test_data_RNA$Estatura <- normalize(test_data_RNA$Estatura)
test_data_RNA$Peso <- normalize(test_data_RNA$Peso)01|02 Ejecución del modelo de Redes Neuronales
Utilizaremos los datos de train_data_RNA para generar el mejor modelo que prediga el Estado a partir de las variables predictores, antes de ello utilizaremos One hot encoding para las variables de tipo factor, de esta manera ingresen como flags (0 y 1)
train_data_Model_RNA <-
train_data_RNA %>%
mutate(
Antecedentes = paste("Antecedentes", Antecedentes, sep = "_"),
Antecedentes_Valor = 1,
Fumador = paste("Fumador", Fumador, sep = "_"),
Fumador_Valor = 1,
Tipo_de_movilidad = paste("Tipo_Movilidad", Tipo_de_movilidad, sep = "_"),
Tipo_de_movilidad_Valor = 1,
Genero = paste("Genero", Genero, sep = "_"),
Genero_Valor = 1
) %>%
spread(key = Antecedentes, value = Antecedentes_Valor, fill = 0) %>%
spread(key = Fumador, value = Fumador_Valor, fill = 0) %>%
spread(key = Tipo_de_movilidad, value = Tipo_de_movilidad_Valor, fill = 0) %>%
spread(key = Genero, value = Genero_Valor, fill = 0)
test_data_Model_RNA <-
test_data_RNA %>%
mutate(
Antecedentes = paste("Antecedentes", Antecedentes, sep = "_"),
Antecedentes_Valor = 1,
Fumador = paste("Fumador", Fumador, sep = "_"),
Fumador_Valor = 1,
Tipo_de_movilidad = paste("Tipo_Movilidad", Tipo_de_movilidad, sep = "_"),
Tipo_de_movilidad_Valor = 1,
Genero = paste("Genero", Genero, sep = "_"),
Genero_Valor = 1
) %>%
spread(key = Antecedentes, value = Antecedentes_Valor, fill = 0) %>%
spread(key = Fumador, value = Fumador_Valor, fill = 0) %>%
spread(key = Tipo_de_movilidad, value = Tipo_de_movilidad_Valor, fill = 0) %>%
spread(key = Genero, value = Genero_Valor, fill = 0)Una vez que se trabajo la información, procedemos a realizar el modelo, además teniendo en cuenta que tenemos una clasificación multiple, utilizaremos una función de activación sigmoidal o logistica
RNA_model <- neuralnet::neuralnet(Estado ~ ., data = train_data_Model_RNA, hidden = c(5, 3), threshold = 0.01, act.fct = "logistic")
01|03 Predicción de los valores de tests
Ahora que tenemos el modelo a utilizar, pasaremos a predecir los datos de testing que son el 30% de ña información total, separada para poder observar el testeo del modelo.
RNA_results_test <- compute(RNA_model, test_data_Model_RNA[-4])
predicted_Estado_test <- RNA_results_test$net.result
predicted_Estado_test [,1] [,2] [,3]
[1,] 0.888900073 0.035373565 0.076171523
[2,] 0.266678515 0.337415759 0.395842089
[3,] 0.164603932 0.320720360 0.514352698
[4,] 0.278172464 0.222000591 0.499602347
[5,] 0.457060047 0.165942973 0.376671035
[6,] 0.266678791 0.337414059 0.395843510
[7,] 0.257936068 0.435589338 0.306519780
[8,] 0.278186586 0.222024501 0.499564386
[9,] 0.266678786 0.337414076 0.395843498
[10,] 0.278435371 0.222450913 0.498890446
[11,] 0.278200547 0.222073617 0.499501420
[12,] 0.257943154 0.435585737 0.306516303
[13,] 0.081420174 0.755867379 0.162905616
[14,] 0.266671009 0.337443125 0.395822256
[15,] 0.257602681 0.435747994 0.306694136
[16,] 0.261325657 0.223477676 0.514936123
[17,] 0.280119481 0.231950381 0.487726102
[18,] 0.200432145 0.462867303 0.336682092
[19,] 1.221750847 0.033933669 -0.254468394
[20,] 0.605193677 0.158061127 0.236743598
[21,] 0.266678778 0.337414105 0.395843477
[22,] 0.250715224 0.439049540 0.310272331
[23,] 0.266678791 0.337414059 0.395843510
[24,] 0.278070601 0.222280400 0.499424622
[25,] 0.278216011 0.222074413 0.499485197
[ reached getOption("max.print") -- omitted 274 rows ]Observamos cual es el orden de nuestros levels para poder clasificar la salida.
levels(test_data_Model_RNA$Estado)[1] "Grave" "Inicial" "Terminal"Ahora que conocemos el orden, clasificamos según las probabilidades obtenidas:
Clasificacion_Test <-
predicted_Estado_test %>%
as.data.frame() %>%
mutate(
Estado_Pred = if_else(abs(V1) > abs(V2) & abs(V1) > abs(V3), "Grave",
if_else(abs(V2) > abs(V1) & abs(V2) > abs(V3), "Inicial",
if_else(abs(V3) > abs(V1) & abs(V3) > abs(V2), "Terminal", "Error")
)
),
Estado_Pred = as.factor(Estado_Pred)
)01|04 Obtenemos la matriz de confusión
Una vez que hemos clasificado, realizaremos la matriz de confusión para poder conocer el performance del modelo.
# ESTO ES SOLO UN EJEMPLO
caret::confusionMatrix(Clasificacion_Test$Estado_Pred, test_data_Model_RNA$Estado)Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 26 28 26
Inicial 35 35 38
Terminal 37 42 32
Overall Statistics
Accuracy : 0.311
95% CI : (0.259, 0.3669)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.9361
Kappa : -0.0341
Mcnemar's Test P-Value : 0.4076
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.26531 0.3333 0.3333
Specificity 0.73134 0.6237 0.6108
Pos Pred Value 0.32500 0.3241 0.2883
Neg Pred Value 0.67123 0.6335 0.6596
Prevalence 0.32776 0.3512 0.3211
Detection Rate 0.08696 0.1171 0.1070
Detection Prevalence 0.26756 0.3612 0.3712
Balanced Accuracy 0.49832 0.4785 0.4721Al realizar la matriz de confusión, observamos que tenemos un Accuracy = 62.8%, que podemos clasificarlo como de regular a bueno para la clasificación del estado de enfermedad, además su sensibilidad y especificidad para cada clase es mayor al 50% llegando hasta 88% de especificidad para la clase terminal.
03| Modelo de Máquinas de Soporte Vectorial
Modelo SVM Kernel lineal Con el paquete e1071 se genera el modelo de SVM
A la hora de ajustar un support vector classifier, es importante tener en cuenta que el hiperparámetro C (cost) controla el equilibrio bias-varianza y la capacidad predictiva del modelo, ya que determina la severidad permitida respecto a las violaciones sobre el margen.
En otras palabras, se necesita fijar un margen de separación entre observaciones a priori. Por ello es recomendable evaluar distintos valores del mismo mediante validación cruzada y escoger el valor óptimo.
IMPORTANTE: Estandarizar los predictores cuando no están medidos en la misma escala, para que los de mayor magnitud no tengan mayor influencia que el resto. Un argumento disponible en la función svm() para ello es scale = TRUE).
Para ajustar un support vector classifier, el kernel indicado en la función svm() ha de ser lineal. Se obtiene un valor de coste óptimo mediante validación cruzada utilizando la función tune() del paquete e1071.
03|01 Optimización de hiperparámetros mediante validación cruzada 10-fold
Distribución variable respuesta
library(ggplot2)
ggplot(data = data, aes(x = Estado, y = ..count.., fill = Estado)) +
geom_bar() +
labs(title = "Distribución de 'Estado'") +
scale_fill_manual(
values = c("darkgreen", "orangered2", "Blue"),
labels = c("Inicial", "Grave", "Terminal")
) +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
set.seed(2021)
tuning <- e1071::tune(svm, Estado ~ .,
data = train_data,
kernel = "linear",
ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15, 20)),
scale = TRUE
)
summary(tuning)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost
0.001
- best performance: 0.6476056
- Detailed performance results:
cost error dispersion
1 0.001 0.6476056 0.04132056
2 0.010 0.6476056 0.04132056
3 0.100 0.6547887 0.04836281
4 1.000 0.6590342 0.05074894
5 5.000 0.6604628 0.04814301
6 10.000 0.6576056 0.05232515
7 15.000 0.6547686 0.05467655
8 20.000 0.6547686 0.05467655names(tuning)[1] "best.parameters" "best.performance" "method" "nparcomb"
[5] "train.ind" "sampling" "performances" "best.model" Graficando los costos de tuning
El valor de coste que resulta en el menor error de validación es 0.6476056 con un cost de 0.001
set.seed(2021)
ggplot(data = tuning$performances, aes(x = cost, y = error)) +
geom_line() +
geom_point() +
labs(title = "Error de validaci?n ~ hiperpar?metro C") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5))
Modelo óptimo obtenido
El tuning se utilizo para encontrar el mejor costo para el modelo de SVM
El tuning fue el proceso de optimización del hiperplano para encontar el mejor costo C
set.seed(2021)
modelo_svm <- tuning$best.model
summary(modelo_svm)
Call:
best.tune(method = svm, train.x = Estado ~ ., data = train_data,
ranges = list(cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15, 20)),
kernel = "linear", scale = TRUE)
Parameters:
SVM-Type: C-classification
SVM-Kernel: linear
cost: 0.001
Number of Support Vectors: 697
( 225 243 229 )
Number of Classes: 3
Levels:
Grave Inicial TerminalEl número de vectores soporte es de 697, de donde 225, 243 y 229 son de la clase Grave, Inicial y Terminal respectivamente. Ahora podemos obtener los ?ndices de las observaciones que se corresponden con los vectores soporte:
head(modelo_svm$index)[1] 1 3 5 6 13 14Modelo lineal (linear) SVM igual que óptimo obtenido
El mejor modelo obtenido sería equivalente a ajustar:
con un cost de 0.001
set.seed(2021)
modelo.lin <- e1071::svm(Estado ~ ., data = train_data, kernel = "linear", cost = 0.001, scale = TRUE)
summary(modelo.lin)
Call:
svm(formula = Estado ~ ., data = train_data, kernel = "linear", cost = 0.001,
scale = TRUE)
Parameters:
SVM-Type: C-classification
SVM-Kernel: linear
cost: 0.001
Number of Support Vectors: 697
( 225 243 229 )
Number of Classes: 3
Levels:
Grave Inicial TerminalHemos encontrado que el modelo.lin da lo mismo que modelo_svm. Se verifica con summary(modelo.lin)
03|02 Predicciones del Modelo
Se utiliza el conjunto de datos de entrenamiento. Se puede usar modelo o modelo_svm ya que son similares.
prediccion <- predict(modelo_svm, test_data)Mostramos las predicciones Las primeras y últimas diez de registro del conjunto de validación
kable(head(prediccion, 10))| x |
|---|
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
| Inicial |
kable(tail(prediccion, 10))| x | |
|---|---|
| 290 | Inicial |
| 291 | Inicial |
| 292 | Inicial |
| 293 | Inicial |
| 294 | Inicial |
| 295 | Inicial |
| 296 | Inicial |
| 297 | Inicial |
| 298 | Inicial |
| 299 | Inicial |
length(prediccion)[1] 299nrow(test_data)[1] 29903|03 Matriz de Confusión
caret::confusionMatrix(prediccion, test_data$Estado)Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 0 0 0
Inicial 98 105 96
Terminal 0 0 0
Overall Statistics
Accuracy : 0.3512
95% CI : (0.2971, 0.4082)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.5218
Kappa : 0
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.0000 1.0000 0.0000
Specificity 1.0000 0.0000 1.0000
Pos Pred Value NaN 0.3512 NaN
Neg Pred Value 0.6722 NaN 0.6789
Prevalence 0.3278 0.3512 0.3211
Detection Rate 0.0000 0.3512 0.0000
Detection Prevalence 0.0000 1.0000 0.0000
Balanced Accuracy 0.5000 0.5000 0.5000Conclusiones: Se observa que en la diagonal se tiene valores altos por lo que se estará prediciendo correctamente, pero fuera de la diagonal existe valores por lo que este modelo no sería efectivo al 100%. El modelo acierta en 105 de un total de 299. En términos de exactitud estadística representa un 35.18% Para ello veremos el indicador accuracy: 0.3512 es un 35.12% lo cual es menor que el 50% lo que nos dice que este modelo no es eficaz.
paste(
"Observaciones de test mal clasificadas:",
100 * mean(test_data$Estado != prediccion) %>%
round(digits = 4), "%"
)[1] "Observaciones de test mal clasificadas: 64.88 %"Conclusiones: No es un buen modelo para clasificar.
AJUSTE DEL MODELO Configuración del proceso de selección del modelo
fitControl <- trainControl(
method = "cv",
number = 10,
classProbs = TRUE,
search = "grid"
)
# Parametros del modelo disponibles
getModelInfo(model = "svmLinear")[[2]]$parameters parameter class label
1 C numeric CostValores del hiperparámetro C a evaluar
Entrenamiento del SVM con un kernel lineal y optimización del hiperparámetro C
grid_C <- data.frame(C = c(0.001, 0.01, 0.1, 1, 5, 10, 15, 20))
set.seed(2021)
modelo_svcl <- train(Estado ~ .,
data = train_data,
method = "svmLinear",
trControl = fitControl,
preProc = c("center", "scale"), # estandarizacion de los datos
tuneGrid = grid_C
)
# Resultado del entrenamiento
modelo_svclSupport Vector Machines with Linear Kernel
701 samples
7 predictor
3 classes: 'Grave', 'Inicial', 'Terminal'
Pre-processing: centered (8), scaled (8)
Resampling: Cross-Validated (10 fold)
Summary of sample sizes: 632, 630, 630, 631, 631, 631, ...
Resampling results across tuning parameters:
C Accuracy Kappa
0.001 0.3564593 0.02034791
0.010 0.3692579 0.03643244
0.100 0.3680530 0.04038553
1.000 0.3537655 0.01853501
5.000 0.3538667 0.01554353
10.000 0.3679524 0.03589389
15.000 0.3511515 0.01772205
20.000 0.3524594 0.01152085
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was C = 0.01.Conclusión: El accuracy para el modelo óptimo es con coste=0.01 y un accuracy del 36.93% menor del 50%. No es modelo eficaz.
caret::confusionMatrix(predict(modelo_svcl, test_data), test_data$Estado)Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 12 18 25
Inicial 66 65 58
Terminal 20 22 13
Overall Statistics
Accuracy : 0.301
95% CI : (0.2495, 0.3565)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.971
Kappa : -0.0612
Mcnemar's Test P-Value : 1.379e-09
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.12245 0.6190 0.13542
Specificity 0.78607 0.3608 0.79310
Pos Pred Value 0.21818 0.3439 0.23636
Neg Pred Value 0.64754 0.6364 0.65984
Prevalence 0.32776 0.3512 0.32107
Detection Rate 0.04013 0.2174 0.04348
Detection Prevalence 0.18395 0.6321 0.18395
Balanced Accuracy 0.45426 0.4899 0.46426Conclusiones: Se observa que en la diagonal se tiene valores menores por lo que se estará prediciendo incorrectamente y fuera de la diagonal existe valores por lo que este modelo no sería efectivo. El modelo acierta en 90 del total. En términos de exactitud veremos el indicador accuracy: 0.3512 es un 30.10% lo cual es menor que el 50% lo que nos dice que este modelo no es eficaz.
Support vector machine
Ademáss del hiperparámetro de penalización C, en los modelos SVM es necesario especificar el hiperparámetro gamma (para kernel radial) o el grado de polinomio (para kernel polinómico), los cuales también son importante optimizar mediante validación cruzada. Kernel polinómico.
set.seed(2021)
tuning2 <- tune(svm, Estado ~ .,
data = train_data,
kernel = "polynomial",
ranges = list(
cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15),
degree = c(2, 3)
),
scale = TRUE
)
summary(tuning2)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost degree
0.1 3
- best performance: 0.6461771
- Detailed performance results:
cost degree error dispersion
1 0.001 2 0.6476056 0.04132056
2 0.010 2 0.6476056 0.04132056
3 0.100 2 0.6476056 0.04132056
4 1.000 2 0.6662374 0.05229787
5 5.000 2 0.6549095 0.06456440
6 10.000 2 0.6662575 0.06455712
7 15.000 2 0.6733400 0.06213495
8 0.001 3 0.6476056 0.04132056
9 0.010 3 0.6476056 0.04132056
10 0.100 3 0.6461771 0.04334658
11 1.000 3 0.6561167 0.06620268
12 5.000 3 0.6577264 0.07254143
13 10.000 3 0.6562978 0.07047737
14 15.000 3 0.6591952 0.07044909Conclusión: Con un kernel polinómico, los hiperparámetros óptimos que reducen el error de validación con coste = 0.1, grado = 3.
ggplot(data = tuning2$performances, aes(x = cost, y = error, col = as.factor(degree))) +
geom_line() +
geom_point() +
labs(title = "Error de validación ~ hiperparámetro C y polinomio") +
theme(plot.title = element_text(hjust = 0.5)) +
theme_bw() +
theme(legend.position = "bottom")
Conclusión: En el gráfico del Error de validación VS hiperparámetro C y polinomio encontramos que el error en el grado 3 es superior mayormente que el grado 2. Para ello con los rsultados obtenidos analizaremos en el Modelo siguiente de SVM Kernel Polinómico con grado 3 con cost 0.1
Modelo SVM kernel polinómico
set.seed(2021)
modelo_svmP <- svm(Estado ~ .,
data = train_data,
kernel = "polynomial",
cost = 0.1,
degree = 3,
scale = TRUE
)
summary(modelo_svmP)
Call:
svm(formula = Estado ~ ., data = train_data, kernel = "polynomial",
cost = 0.1, degree = 3, scale = TRUE)
Parameters:
SVM-Type: C-classification
SVM-Kernel: polynomial
cost: 0.1
degree: 3
coef.0: 0
Number of Support Vectors: 697
( 225 243 229 )
Number of Classes: 3
Levels:
Grave Inicial TerminalConclusión: El número de vectores soporte es de 697, de donde 225, 243 y 229 son de la clase Grave, Inicial y Terminal respectivamente.
set.seed(2021)
caret::confusionMatrix(predict(modelo_svmP, test_data), test_data$Estado)Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 0 0 0
Inicial 98 105 95
Terminal 0 0 1
Overall Statistics
Accuracy : 0.3545
95% CI : (0.3003, 0.4116)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.4735
Kappa : 0.0053
Mcnemar's Test P-Value : NA
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.0000 1.000000 0.010417
Specificity 1.0000 0.005155 1.000000
Pos Pred Value NaN 0.352349 1.000000
Neg Pred Value 0.6722 1.000000 0.681208
Prevalence 0.3278 0.351171 0.321070
Detection Rate 0.0000 0.351171 0.003344
Detection Prevalence 0.0000 0.996656 0.003344
Balanced Accuracy 0.5000 0.502577 0.505208Conclusiones: Se observa que en la diagonal se tiene valores mayores por lo que se estará prediciendo correctamente, pero fuera de la diagonal existe valores por lo que este modelo no sería efectivo. Esta prediciendo correctamente 106 de 697, lo cual estad?sticamente es 15.21% esta acertando. En términos de exactitud veremos el indicado accuracy: 35.45% lo cual es menor que el 50% lo que nos dice que este modelo no es eficaz.
Observaciones de test mal clasificadas
set.seed(2021)
paste(
"Observaciones de test mal clasificadas:",
100 * mean(test_data$Estado != predict(modelo_svmP, test_data)) %>%
round(digits = 4), "%"
)[1] "Observaciones de test mal clasificadas: 64.55 %"Kernel radial
set.seed(2021)
tuning3 <- tune(svm, Estado ~ .,
data = train_data,
kernel = "radial",
ranges = list(
cost = c(0.001, 0.01, 0.1, 1, 5, 10, 15),
gamma = c(0.01, 0.1, 1, 5, 10)
),
scale = TRUE
)
summary(tuning3)
Parameter tuning of 'svm':
- sampling method: 10-fold cross validation
- best parameters:
cost gamma
1 5
- best performance: 0.6291751
- Detailed performance results:
cost gamma error dispersion
1 0.001 0.01 0.6476056 0.04132056
2 0.010 0.01 0.6476056 0.04132056
3 0.100 0.01 0.6476056 0.04132056
4 1.000 0.01 0.6533199 0.04690819
5 5.000 0.01 0.6647887 0.05074395
6 10.000 0.01 0.6605030 0.06077103
7 15.000 0.01 0.6490946 0.05899678
8 0.001 0.10 0.6476056 0.04132056
9 0.010 0.10 0.6476056 0.04132056
10 0.100 0.10 0.6476056 0.04132056
11 1.000 0.10 0.6519517 0.06086095
12 5.000 0.10 0.6605433 0.07548728
13 10.000 0.10 0.6705433 0.07064073
14 15.000 0.10 0.6634004 0.07094187
15 0.001 1.00 0.6476056 0.04132056
16 0.010 1.00 0.6476056 0.04132056
17 0.100 1.00 0.6476056 0.04132056
18 1.000 1.00 0.6691348 0.04615710
[ reached 'max' / getOption("max.print") -- omitted 17 rows ]Conclusión: Con un kernel radial, los hiperparámetros que reducen el error de validación con coste = 1, gamma = 5.
ggplot(data = tuning3$performances, aes(x = cost, y = error, color = factor(gamma))) +
geom_line() +
geom_point() +
labs(title = "Error de validaci?n ~ hiperpar?metro C y gamma") +
theme_bw() +
theme(plot.title = element_text(hjust = 0.5)) +
theme(legend.position = "bottom")
Modelo SVM con kernel radial
modelo_svmR <- svm(Estado ~ .,
data = train_data,
kernel = "radial",
cost = 1,
gamma = 5,
scale = TRUE
)
summary(modelo_svmR)
Call:
svm(formula = Estado ~ ., data = train_data, kernel = "radial", cost = 1,
gamma = 5, scale = TRUE)
Parameters:
SVM-Type: C-classification
SVM-Kernel: radial
cost: 1
Number of Support Vectors: 700
( 225 247 228 )
Number of Classes: 3
Levels:
Grave Inicial Terminalcaret::confusionMatrix(predict(modelo_svmR, test_data), test_data$Estado)Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 15 18 11
Inicial 71 77 70
Terminal 12 10 15
Overall Statistics
Accuracy : 0.3579
95% CI : (0.3035, 0.4151)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.4256
Kappa : 0.0211
Mcnemar's Test P-Value : <2e-16
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.15306 0.7333 0.15625
Specificity 0.85572 0.2732 0.89163
Pos Pred Value 0.34091 0.3532 0.40541
Neg Pred Value 0.67451 0.6543 0.69084
Prevalence 0.32776 0.3512 0.32107
Detection Rate 0.05017 0.2575 0.05017
Detection Prevalence 0.14716 0.7291 0.12375
Balanced Accuracy 0.50439 0.5033 0.52394Conclusiones: Se observa que en la diagonal se tiene valores mayores por lo que se estará prediciendo correctamente, pero fuera de la diagonal existe valores por lo que este modelo no sería efectivo. Esta prediciendo correctamente 107 de 700, lo cual estadísticamente es 15.29% esta acertando. En términos de exactitud veremos el indicado accuracy: 35.79% lo cual es menor que el 50% lo que nos dice que este modelo no es eficaz.
Observaciones de test mal clasificadas
paste(
"Observaciones de test mal clasificadas:",
100 * mean(test_data$Estado != predict(modelo_svmR, test_data)) %>%
round(digits = 4), "%"
)[1] "Observaciones de test mal clasificadas: 64.21 %"Conlusión final:
Se crean varios modelos para predecir los Estados pero sus exactitudes estadísticas no pasan del 50%. Lo que siginifica que no se obtiene un buen resultado en el modelo lineal, ni en el polinomico y ni el radial. A modo general dentro de los menos malos podremos mencionar a modelo_svmR como el que mejor predice por tener un bajo porcentaje en observaciones de mal clasificación de 64.21%.
04| Modelo de Árboles de decisión
Los métodos para regresión y clasificación basados en árboles de decisión estratifican o segmentan el espacio del predictor en un número simple de regiones, y para obtener las predicciones se suele usar la media o moda de las observaciones de entrenamiento en la región en la que cada observación a predecir pertenece.
Los árboles de clasificación son muy similares a los de regresión, con la diferencia de que se usan para predecir una variable respuesta cualitativa, asignando la predicción para cada observación como la clase más común (moda) de observaciones de entrenamiento en la región o nodo terminal al que pertenece dicha observación de test.
04|01 Entrenamiento del modelo
Utilizaremos la función rpart para poder entrenar nuestro modelo:
arbol <- rpart(formula = Estado ~ ., data = train_data)
arboln= 701
node), split, n, loss, yval, (yprob)
* denotes terminal node
1) root 701 454 Inicial (0.32667618 0.35235378 0.32097004)
2) Peso< 99.05 684 440 Inicial (0.33040936 0.35672515 0.31286550)
4) Edad>=26.5 654 418 Inicial (0.33639144 0.36085627 0.30275229)
8) Tipo_de_movilidad=Peatón,Transporte_privado 428 259 Inicial (0.32943925 0.39485981 0.27570093)
16) Edad>=31.5 111 64 Grave (0.42342342 0.36036036 0.21621622) *
17) Edad< 31.5 317 188 Inicial (0.29652997 0.40694006 0.29652997)
34) Edad< 29.5 164 103 Grave (0.37195122 0.35975610 0.26829268)
68) Peso< 73.75 43 19 Grave (0.55813953 0.30232558 0.13953488) *
69) Peso>=73.75 121 75 Inicial (0.30578512 0.38016529 0.31404959)
138) Estatura< 1.785 83 51 Inicial (0.36144578 0.38554217 0.25301205)
276) Peso>=79.55 56 31 Grave (0.44642857 0.32142857 0.23214286) *
277) Peso< 79.55 27 13 Inicial (0.18518519 0.51851852 0.29629630) *
139) Estatura>=1.785 38 21 Terminal (0.18421053 0.36842105 0.44736842)
278) Edad>=28.5 20 10 Inicial (0.25000000 0.50000000 0.25000000) *
279) Edad< 28.5 18 6 Terminal (0.11111111 0.22222222 0.66666667) *
35) Edad>=29.5 153 83 Inicial (0.21568627 0.45751634 0.32679739)
70) Peso>=83.1 64 30 Inicial (0.28125000 0.53125000 0.18750000) *
71) Peso< 83.1 89 51 Terminal (0.16853933 0.40449438 0.42696629)
142) Peso< 81.25 77 41 Inicial (0.18181818 0.46753247 0.35064935) *
143) Peso>=81.25 12 1 Terminal (0.08333333 0.00000000 0.91666667) *
9) Tipo_de_movilidad=Transporte_público 226 146 Terminal (0.34955752 0.29646018 0.35398230)
18) Edad< 31.5 180 111 Grave (0.38333333 0.30000000 0.31666667) *
19) Edad>=31.5 46 23 Terminal (0.21739130 0.28260870 0.50000000) *
5) Edad< 26.5 30 14 Terminal (0.20000000 0.26666667 0.53333333) *
3) Peso>=99.05 17 6 Terminal (0.17647059 0.17647059 0.64705882) *En la salida se nos muestra el esquema del árbol de clasificación que hemos diseñado. Cada uno de los incisos nos estan mostrando un nodo la regla de clasificación que le corresponde. Tomando en cuenta estos nodos podemos llegar a la clasificación de nuestros datos que estarian correspondiendo a las hojas del árbol.
04|02 Visualización del arbol
Procederemos a realizar el gráfico del árbol que se ha construido:
rpart.plot(arbol)
04|03 Evaluación del modelo
Para poder realizar la evaluación de nuestro modelo debemos primero evaluar el comportamiento de este utilizando la base de datos que hemos reservado para el testeo de modelos.
prediccion <- predict(arbol, newdata = test_data, type = "class")
summary(prediccion) Grave Inicial Terminal
173 77 49 Podemos observar que tenemos la clasificación de nuestros datos, donde se clasifica 173 como Grave, 77 Inicial y 49 Terminal
04|04 Comparación de los datos predichos y observados
Para poder revisar a mejor detalle construiremos la matriz de confusión correspondiente:
confusionMatrix(prediccion, test_data[["Estado"]])Confusion Matrix and Statistics
Reference
Prediction Grave Inicial Terminal
Grave 47 66 60
Inicial 30 26 21
Terminal 21 13 15
Overall Statistics
Accuracy : 0.2943
95% CI : (0.2433, 0.3495)
No Information Rate : 0.3512
P-Value [Acc > NIR] : 0.984
Kappa : -0.0575
Mcnemar's Test P-Value : 1.833e-07
Statistics by Class:
Class: Grave Class: Inicial Class: Terminal
Sensitivity 0.4796 0.24762 0.15625
Specificity 0.3731 0.73711 0.83251
Pos Pred Value 0.2717 0.33766 0.30612
Neg Pred Value 0.5952 0.64414 0.67600
Prevalence 0.3278 0.35117 0.32107
Detection Rate 0.1572 0.08696 0.05017
Detection Prevalence 0.5786 0.25753 0.16388
Balanced Accuracy 0.4264 0.49237 0.49438Nuestro modelo obtiene un Accuracy igual al 29.4%, es decir la clasificación no esta siendo muy buena para nuestros datos. Por otro lado el coeficiente Kappa es negativo y cercano a cero, por lo que esperado no esta siendo igual a lo observado, lo cual es un problema. La sensibilidad final es muy pequeña y la especificidad muy alta, eso no es un buen idnicador de nuestras clasificaciones, por lo que no se recomienda poder utilizar este modelo para la clasificación del Estado.
05| Mejor Modelo Supervisado
Hemos realizado la estimación del estado del paciente, mediante redes neuronales, Maquina de soporte vectorial y árboles de decisión, utilizando la matriz de confusión para poder realizar las comparaciones de los distintos modelos y elegir al mejor en base a su performance, la siguiente tabla resumen nos ayuda a observar el accuracy de los modelos aplicados:
Modelo Accuracy
1 Red neuronal 0.3110
2 SVM - Modelo Lineal 0.3512
3 SVM - Modelo Polinómico 0.3550
4 SVM - Modelo Radial 0.3580
5 Árbol de decisión 0.2940De esta manera, observamos que el que presenta el mejor accuracy en el modelo de Máquina de soporte vectorial usando kernel radial con un accuracy de 0.3580 para estimar el estado de los pacientes.
Si bien, tenemos a un mejor modelo de entro los observados, el accuracy es bastante bajo, por lo que se recomienda continuar tuneando los hiperparámetros de los modelos de tal forma que logremos mejorar el accuracy y presentar menor error.