Matriz de Confusion Presencia plaga

library(readxl)
invisible(Sys.setlocale("LC_ALL", "Spanish_Spain.1252"))  # Oculta el mensaje
aguacate <- read_excel("~/aguacate.xlsx")
library(knitr)
library(kableExtra)
temperatura=aguacate$Temperature
humedad=aguacate$`Relative Humidity`
viento=aguacate$`Wind Speed`
frutos_afectados=aguacate$Frutos_Afectados_Heilipus+aguacate$Frutos_Afectados_Stenoma
y=as.numeric(frutos_afectados>0)

df_frutos=data.frame(y,temperatura,humedad,viento)
df_frutos=na.omit(df_frutos)

modelo=glm(y~temperatura+humedad+viento,data=df_frutos,family = "binomial")

probas=modelo$fitted.values
presencia_plaga_modelo=probas>0.15
presencia_plaga_real=df_frutos$y

# Crear la tabla de confusión
tabla <- table(Real = presencia_plaga_real, Modelo = presencia_plaga_modelo)

# Mostrar con títulos bien formateados
kable(tabla, format = "html", caption = "Matriz de Confusión") %>%
  kable_styling(full_width = FALSE, bootstrap_options = c("striped", "hover"))
Matriz de Confusión
FALSE TRUE
0 1796 355
1 105 107

Analisis Matriz de confusion:

  • El modelo tiene una alta cantidad de verdaderos negativos (1796 casos), lo que indica que identifica bien los frutos sin plaga.
  • Sin embargo, hay 355 falsos positivos, lo que significa que el modelo clasifica erróneamente algunos frutos sanos como afectados por plaga.
  • También hay 105 falsos negativos, lo que sugiere que el modelo no detecta correctamente todos los frutos con plaga.
  • Los verdaderos positivos (107) son relativamente bajos, lo que puede indicar que el modelo tiene dificultades para identificar correctamente la presencia de plaga.

Grafico Desempeño

calc_metricas=function(umbral){
presencia_plaga_modelo=probas>umbral
presencia_plaga_real=df_frutos$y

#matriz de confusión
tabla=table(presencia_plaga_real,presencia_plaga_modelo)
desempeño=(tabla[1,1]+tabla[2,2])/sum(tabla)
return(desempeño)

}
umbrales=seq(0.05,0.24,0.01)
desempeños=sapply(umbrales, calc_metricas)


# Calcular desempeño asegurando que el resultado tenga la misma longitud que umbrales
desempeños <- sapply(umbrales, function(u) calc_metricas(u)[1])  # Extrae solo el desempeño



# Graficar Desempeño vs Umbral
plot(umbrales, desempeños, type = "b", col = "blue", pch = 16, lty = 2,
     xlab = "Umbral", ylab = "Desempeño", main = "Desempeño vs Umbral")

Analisis Grafico Desempeño:

  • A medida que aumenta el umbral, el desempeño del modelo mejora progresivamente, acercándose a 0.9. Esto sugiere que establecer umbrales más altos ayuda a reducir errores en la clasificación, posiblemente disminuyendo falsos positivos, pero podría aumentar falsos negativos. Es clave encontrar un balance óptimo según la aplicación.

Grafico de Sensibilidad

# Definir función para calcular las métricas (desempeño, sensibilidad, especificidad)
calc_metricas <- function(umbral) {
  presencia_plaga_modelo <- probas > umbral
  presencia_plaga_real <- df_frutos$y
  
  tabla <- table(presencia_plaga_real, presencia_plaga_modelo)
  
  # Evitar errores si hay clases vacías en la tabla de contingencia
  if (nrow(tabla) < 2 || ncol(tabla) < 2) {
    return(c(NA, NA, NA))  # Retorna NA si hay problemas en la matriz
  }
  
  # Extraer valores de la matriz de confusión
  VP <- tabla[2, 2]  # Verdaderos positivos
  FN <- tabla[2, 1]  # Falsos negativos
  TN <- tabla[1, 1]  # Verdaderos negativos
  FP <- tabla[1, 2]  # Falsos positivos
  
  # Calcular métricas
  desempeño <- (VP + TN) / sum(tabla)  # Exactitud global
  sensibilidad <- VP / (VP + FN)  # Tasa de verdaderos positivos
  especificidad <- TN / (TN + FP)  # Tasa de verdaderos negativos
  
  return(c(desempeño, sensibilidad, especificidad))
}

# Definir umbrales
umbrales <- seq(0.05, 0.24, 0.01)

# Calcular todas las métricas para cada umbral
metricas <- sapply(umbrales, calc_metricas)

# Extraer sensibilidad
sensibilidades <- metricas[2, ]  # Segunda fila contiene la sensibilidad

# Graficar Sensibilidad vs Umbral
plot(umbrales, sensibilidades, type = "b", col = "red", pch = 16, lty = 2,
     xlab = "Umbral", ylab = "Sensibilidad", main = "Sensibilidad vs Umbral")

Analisis grafico de sensibilidad:

  • A medida que el umbral aumenta, la sensibilidad disminuye. Esto indica que, al establecer umbrales más altos, el modelo se vuelve más estricto al clasificar positivos, lo que reduce los verdaderos positivos y aumenta los falsos negativos. En otras palabras, el modelo detecta menos casos de plaga, aunque los que detecta son más confiables.

Grafico de especificidad

# Extraer la especificidad desde la matriz de métricas
especificidades <- metricas[3, ]  # Tercera fila contiene la especificidad

# Graficar Especificidad vs Umbral
plot(umbrales, especificidades, type = "b", col = "green", pch = 16, lty = 2,
     xlab = "Umbral", ylab = "Especificidad", main = "Especificidad vs Umbral")

Analisis grafico de especificidad:

  • A medida que el umbral aumenta, la especificidad también aumenta. Esto significa que el modelo mejora en identificar correctamente los casos negativos (sin plaga), reduciendo los falsos positivos. Sin embargo, esto ocurre a costa de una menor sensibilidad, es decir, detecta menos casos positivos de plaga.

Grafico Metrica promedio

# Calcular las tres métricas desde la matriz de resultados
desempeño <- metricas[1, ]     # Primera fila: Desempeño
sensibilidad <- metricas[2, ]  # Segunda fila: Sensibilidad
especificidad <- metricas[3, ] # Tercera fila: Especificidad

# Calcular la métrica promedio
metrica_promedio <- (desempeño + sensibilidad + especificidad) / 3


# Graficar Métrica Promedio vs Umbral
plot(umbrales, metrica_promedio, type = "b", col = "purple", pch = 16, lty = 2,
     xlab = "Umbral", ylab = "Métrica Promedio", main = "Métrica Promedio vs Umbral")

Analisis grafico metrica promedio:

  • La métrica promedio alcanza su punto máximo alrededor de un umbral de 0.15 y luego empieza a disminuir. Esto sugiere que dicho umbral es el valor óptimo para equilibrar sensibilidad y especificidad, maximizando el desempeño del modelo.

Graficos Juntos

## Definir función para calcular métricas
calc_metricas = function(umbral) {
    # Generar predicciones con el umbral dado
    presencia_plaga_modelo = probas > umbral
    presencia_plaga_real = df_frutos$y

    # Crear la matriz de confusión
    tabla = table(presencia_plaga_real, presencia_plaga_modelo)

    # Extraer valores de la matriz de confusión
    VP = ifelse("1" %in% rownames(tabla) & "TRUE" %in% colnames(tabla), tabla["1", "TRUE"], 0)  # Verdaderos positivos
    VN = ifelse("0" %in% rownames(tabla) & "FALSE" %in% colnames(tabla), tabla["0", "FALSE"], 0)  # Verdaderos negativos
    FP = ifelse("0" %in% rownames(tabla) & "TRUE" %in% colnames(tabla), tabla["0", "TRUE"], 0)  # Falsos positivos
    FN = ifelse("1" %in% rownames(tabla) & "FALSE" %in% colnames(tabla), tabla["1", "FALSE"], 0)  # Falsos negativos

    # Calcular métricas
    desempeño = (VP + VN) / sum(tabla)  # Precisión general
    sensibilidad = ifelse((VP + FN) > 0, VP / (VP + FN), NA)  # Tasa de verdaderos positivos
    especificidad = ifelse((VN + FP) > 0, VN / (VN + FP), NA)  # Tasa de verdaderos negativos

    # Nueva métrica: promedio de las tres
    metrica_promedio = mean(c(desempeño, sensibilidad, especificidad), na.rm = TRUE)

    return(c(Desempeño = desempeño, Sensibilidad = sensibilidad, Especificidad = especificidad, Métrica_Promedio = metrica_promedio))
}

## Aplicar la función a distintos umbrales
umbrales = seq(0.05, 0.24, 0.01)
metricas = sapply(umbrales, calc_metricas)

## Graficar las métricas
plot(umbrales, metricas["Desempeño", ], type = "b", col = "blue", pch = 19, ylim = c(0, 1), ylab = "Métricas", xlab = "Umbral")
lines(umbrales, metricas["Sensibilidad", ], type = "b", col = "red", pch = 19)
lines(umbrales, metricas["Especificidad", ], type = "b", col = "green", pch = 19)
lines(umbrales, metricas["Métrica_Promedio", ], type = "b", col = "purple", pch = 19)
legend("bottomright", legend = c("Desempeño", "Sensibilidad", "Especificidad", "Métrica Promedio"), col = c("blue", "red", "green", "purple"), pch = 19, bty = "n")

Analisis:

  1. Relación entre sensibilidad y especificidad Se observa una relación inversa entre sensibilidad y especificidad:

  • A umbrales bajos (~0.05), la sensibilidad es alta (~0.8-0.9), lo que significa que el modelo clasifica la mayoría de los casos positivos correctamente. Sin embargo, la especificidad es baja (~0.4), indicando que hay muchos falsos positivos.

  • A umbrales altos (~0.20), la sensibilidad cae (~0.2), lo que indica que el modelo detecta menos positivos, pero la especificidad aumenta (~0.9), lo que significa que hay menos falsos positivos.

  1. Tendencia del desempeño
  • La métrica de desempeño general (azul) se mantiene relativamente estable y mejora ligeramente con umbrales más altos, indicando que la precisión del modelo se optimiza cuando el umbral no es demasiado bajo.
  1. Métrica promedio

  • La métrica promedio (morado) captura el balance entre sensibilidad, especificidad y desempeño.

  • Se mantiene relativamente estable, aunque tiene un leve decrecimiento a umbrales muy altos, lo que indica que un umbral excesivo sacrifica demasiado la detección de casos positivos.

  1. Elección del umbral óptimo

  • Un umbral entre 0.08 y 0.12 parece ser el mejor compromiso entre sensibilidad y especificidad, ya que evita que una métrica sea demasiado baja sin afectar demasiado a la otra.

  • Si el objetivo es minimizar falsos negativos (detectar la mayor cantidad de casos de plaga posible), se debe usar un umbral bajo (~0.05-0.08).

  • Si el objetivo es minimizar falsos positivos (evitar alarmas innecesarias), se debe usar un umbral alto (~0.18-0.20).

Conclusión

El análisis indica que ajustar el umbral es clave para equilibrar la sensibilidad y la especificidad del modelo. Un umbral intermedio (~0.1) podría ser el más adecuado para mantener un buen balance entre detectar casos de plaga y evitar falsos positivos.