Evidencia 2 - Técnicas predictivas basadas en aprendizaje autónomo

I.- Algoritmo de clasificación que impacte directamente tu vida:

Clustering -

Esta base de datos tiene el propósito específico de llevar a cabo un análisis de conglomerados, y fue adaptada del conjunto de datos de vinos de https://archive.ics.uci.edu/ml/datasets/wine.

La base de datos brinda los resultados del análisis químico de vinos cultivados y contiene información sobre las cantidades de 13 componentes en cada uno de los tipos de vinos. Es importante mencionar que se elimino información sobre los tipos de vino para dar un enfoque de aprendizaje no supervisado en el que se explorarán patrones y similitudes entre las muestras.

library(readr)
library(openxlsx)
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.3.2
## Warning: package 'ggplot2' was built under R version 4.3.2
## Warning: package 'purrr' was built under R version 4.3.2
## Warning: package 'stringr' was built under R version 4.3.2
## Warning: package 'lubridate' was built under R version 4.3.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.2     ✔ purrr     1.0.2
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.4.4     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(factoextra)
## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
library(cowplot)
## 
## Attaching package: 'cowplot'
## 
## The following object is masked from 'package:lubridate':
## 
##     stamp
library(ggpubr)
## 
## Attaching package: 'ggpubr'
## 
## The following object is masked from 'package:cowplot':
## 
##     get_legend
library(cluster)
library(purrr)
library(dplyr)
library(readxl)  
library(openxlsx)  
#file.choose()
#ev2 <- read_excel("/Users/danielnajera/Desktop/Evidencia1/winecls.xlsx", col_names = TRUE)

ev2 <- read_excel("C:\\Users\\danbr\\OneDrive\\Desktop\\Mineria de Datos\\Evidencia 2\\winecls.xlsx", col_names = TRUE)

View(ev2)
evidencia2 = scale(ev2, center = TRUE, scale = TRUE)
summary(evidencia2)
##     Alcohol           Malic_Acid           Ash            Ash_Alcanity      
##  Min.   :-2.42739   Min.   :-1.4290   Min.   :-3.66881   Min.   :-2.663505  
##  1st Qu.:-0.78603   1st Qu.:-0.6569   1st Qu.:-0.57051   1st Qu.:-0.687199  
##  Median : 0.06083   Median :-0.4219   Median :-0.02375   Median : 0.001514  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.000000  
##  3rd Qu.: 0.83378   3rd Qu.: 0.6679   3rd Qu.: 0.69615   3rd Qu.: 0.600395  
##  Max.   : 2.25341   Max.   : 3.1004   Max.   : 3.14745   Max.   : 3.145637  
##    Magnesium       Total_Phenols        Flavanoids      Nonflavanoid_Phenols
##  Min.   :-2.0824   Min.   :-2.10132   Min.   :-1.6912   Min.   :-1.8630     
##  1st Qu.:-0.8221   1st Qu.:-0.88298   1st Qu.:-0.8252   1st Qu.:-0.7381     
##  Median :-0.1219   Median : 0.09569   Median : 0.1059   Median :-0.1756     
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.0000     
##  3rd Qu.: 0.5082   3rd Qu.: 0.80672   3rd Qu.: 0.8467   3rd Qu.: 0.6078     
##  Max.   : 4.3591   Max.   : 2.53237   Max.   : 3.0542   Max.   : 2.3956     
##  Proanthocyanins    Color_Intensity        Hue               OD280        
##  Min.   :-2.06321   Min.   :-1.6297   Min.   :-2.08884   Min.   :-1.8897  
##  1st Qu.:-0.59560   1st Qu.:-0.7929   1st Qu.:-0.76540   1st Qu.:-0.9496  
##  Median :-0.06272   Median :-0.1588   Median : 0.03303   Median : 0.2371  
##  Mean   : 0.00000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.62741   3rd Qu.: 0.4926   3rd Qu.: 0.71116   3rd Qu.: 0.7864  
##  Max.   : 3.47527   Max.   : 3.4258   Max.   : 3.29241   Max.   : 1.9554  
##     Proline       
##  Min.   :-1.4890  
##  1st Qu.:-0.7824  
##  Median :-0.2331  
##  Mean   : 0.0000  
##  3rd Qu.: 0.7561  
##  Max.   : 2.9631
vinos = as.data.frame(evidencia2)
view(evidencia2)

En el siguiente chunk, buscamos cuál es el mejor número de clusters para el análisis.

total_within = function(n_clusters, data, iter.max=1000, nstart=50){
  
  cluster_means = kmeans(data,centers = n_clusters,
                         iter.max = iter.max,
                         nstart = nstart)
  return(cluster_means$tot.withinss)
}

total_withinss <- map_dbl(.x = 1:15,
                          .f = total_within,
                          data = vinos)
total_withinss
##  [1] 2301.0000 1649.4400 1270.7491 1168.6143 1095.1529 1032.7952  970.7864
##  [8]  920.4641  876.3307  835.4019  796.7484  772.6873  746.4476  715.6393
## [15]  694.2293
data.frame(n_clusters = 1:15, suma_cuadrados_internos = total_withinss) %>%
  ggplot(aes(x = n_clusters, y = suma_cuadrados_internos)) +
  geom_line() +
  geom_point() +
  scale_x_continuous(breaks = 1:15) +
  labs(title = "Suma total de cuadrados intra-cluster") +
  theme_bw()

Se seleccionaron 3 clusters, ya que la gráfica anterior demuestra que la tendencia empieza a caer en el cluster n3. Se seleccionaron las variables “Alcohol” y “Color_Intensity”, se utilizaron estas variables porque son las más relevantes para la percepción del vino por parte del consumidor.

  • La intensidad de color es un indicador de la variedad de uva utilizada y del método de elaboración.

  • El contenido de alcohol afecta el sabor y la textura del vino.

kmcluster = kmeans(vinos,centers=3,nstart = 50)

kmcluster
## K-means clustering with 3 clusters of sizes 65, 51, 62
## 
## Cluster means:
##      Alcohol Malic_Acid        Ash Ash_Alcanity   Magnesium Total_Phenols
## 1 -0.9234669 -0.3929331 -0.4931257    0.1701220 -0.49032869   -0.07576891
## 2  0.1644436  0.8690954  0.1863726    0.5228924 -0.07526047   -0.97657548
## 3  0.8328826 -0.3029551  0.3636801   -0.6084749  0.57596208    0.88274724
##    Flavanoids Nonflavanoid_Phenols Proanthocyanins Color_Intensity        Hue
## 1  0.02075402          -0.03343924      0.05810161      -0.8993770  0.4605046
## 2 -1.21182921           0.72402116     -0.77751312       0.9388902 -1.1615122
## 3  0.97506900          -0.56050853      0.57865427       0.1705823  0.4726504
##        OD280    Proline
## 1  0.2700025 -0.7517257
## 2 -1.2887761 -0.4059428
## 3  0.7770551  1.1220202
## 
## Clustering vector:
##   [1] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
##  [38] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 2 1 1 1 1 1 1 1 1 1 1 1 3
##  [75] 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [112] 1 1 1 1 1 1 1 2 1 1 3 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## 
## Within cluster sum of squares by cluster:
## [1] 558.6971 326.3537 385.6983
##  (between_SS / total_SS =  44.8 %)
## 
## Available components:
## 
## [1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
## [6] "betweenss"    "size"         "iter"         "ifault"
vinos2 = vinos %>% mutate(cluster = kmcluster$cluster)  

  (g1=ggplot(vinos2, aes(x = Alcohol, y = Color_Intensity)) +     
      geom_point(aes(color=as.factor(cluster)), size=4)+     
      geom_text(aes(label = cluster), size = 4) +     
      theme_bw() +  
      theme(legend.position = "none")+     
      labs(title = "Vinos")  
    )

La gráfica se dividen en 3 clusters

  • Grupo 1: El que cuenta con menos alcohol y menos intensidad en el color.

  • Grupo 2: El cuenta con menor cantidad de alcohol y menor intensidad de color.

  • Grupo 3: El cuenta con mayor cantidad de alcohol y menor intensidad de color.

Se divide principalmente en 2 grupos, uno con una intensidad de color baja y un contenido de alcohol bajo, y otro con una intensidad de color alta y un contenido de alcohol alto. El grupo de baja intensidad de color incluye principalmente vinos blancos, mientras que el grupo de alta intensidad de color incluye principalmente vinos tintos.

fviz_cluster(kmcluster, vinos)+
  theme_minimal()

fviz_cluster(kmcluster, vinos, show.clust.cent = T,
             ellipse.type = "euclid", star.plot = T, repel = T) +
  labs(title = "Resultados clustering K-means") +
  theme_bw()

Conclusiones:

El algoritmo de clustering utilizado fue el k-means. Este algoritmo agrupa los datos en k grupos, de modo que los datos dentro de cada grupo sean lo más similares posible y los datos entre grupos sean lo más diferentes posible.

En este caso, se utilizó k=3, de modo que los datos se agruparon en tres clusters.

Los resultados del clustering se pueden ver en la gráfica que se proporcionó. La gráfica muestra que los vinos se pueden clasificar en 3 grupos principales, según su intensidad de color y su contenido de alcohol.

La gráfica también muestra que el grupo 1 es el más pequeño, seguido del grupo 3. El grupo 2 es el más grande.

Esta clasificación es útil para los consumidores de vino, ya que les permite elegir el vino adecuado para sus preferencias y ocasión.

Bibliografia:

vishalyo990. (2018). Prediction of quality of Wine. Kaggle. Recuperado de https://www.kaggle.com/datasets/harrywang/wine-dataset-for-clustering/data

II.- Método que no sea de clasificación para predecir algo:

LDA - Diabetes

Este conjunto de datos proviene inicialmente del Instituto Nacional de Diabetes y Enfermedades Digestivas y del Riñón. Es importante señalar que la base de datos original tenía una amplitud mayor, pero se vio sujeta a restricciones, limitándose exclusivamente a mujeres con una edad mínima de 21 años y de ascendencia india Pima.

Se pretende realizar predicciones diagnósticas a la presencia de diabetes en las pacientes, fundamentado en las variables de diagnóstica que realizadas.

library(MASS) 
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
library(ggplot2)
library(openxlsx)
#file.choose()
#Ev2LDA = read.xlsx("/Users/danielnajera/Desktop/Evidencia1/diabetes.xlsx")

Ev2LDA = read.xlsx("C:\\Users\\danbr\\OneDrive\\Desktop\\Mineria de Datos\\Evidencia 2\\diabetes.xlsx")

View(Ev2LDA)

Se define que la variable dependiente es outcome , ya que es la que nos permite saber si el paciente es Diabetico “1” o si No es Diabetico “0”

Ev2LDA$Outcome<-factor(Ev2LDA$Outcome, levels = c(0,1), labels = c("No Diabetico","Diabetico"))
LDA <- lda(Outcome ~ ., data = Ev2LDA)

LDA
## Call:
## lda(Outcome ~ ., data = Ev2LDA)
## 
## Prior probabilities of groups:
## No Diabetico    Diabetico 
##    0.6510417    0.3489583 
## 
## Group means:
##              Pregnancies  Glucose BloodPressure SkinThickness  Insulin      BMI
## No Diabetico    3.298000 109.9800      68.18400      19.66400  68.7920 30.30420
## Diabetico       4.865672 141.2575      70.82463      22.16418 100.3358 35.14254
##              DiabetesPedigreeFunction      Age
## No Diabetico                 0.429734 31.19000
## Diabetico                    0.550500 37.06716
## 
## Coefficients of linear discriminants:
##                                    LD1
## Pregnancies               0.0938638298
## Glucose                   0.0269863520
## BloodPressure            -0.0106293929
## SkinThickness             0.0007043468
## Insulin                  -0.0008229296
## BMI                       0.0603702056
## DiabetesPedigreeFunction  0.6711517147
## Age                       0.0119490869

Prior probabilities

  • Podemos observar que las probablidades de que la paciente sea Diabetico es de Diabetico .349 y de que No es Diabetico es de .651

Coefficients of linear discriminants:

  • Nos permiten identificar la importancia de cada característica en la formación del LDA. Se identificaron que las mas importantes fueron:

    DiabetesPedigreeFunction -> 0.671

    Pregnancies -> 0.0938

    BMI -> 0.06037

Significado de las variables

  • DiabetesPedigreeFunction se basa en la historia familiar de diabetes y cuantifica la predisposición genética a la enfermedad.

  • Pregnancies indica el número de embarazos, en caso de haber tenido.

  • BMI es una medida que se utiliza para evaluar la relación entre el peso y la altura de una persona.

Pred_LDA <- predict(LDA, newdata = Ev2LDA)

head(Pred_LDA$posterior, n = 10)
##    No Diabetico  Diabetico
## 1     0.2697862 0.73021378
## 2     0.9558454 0.04415456
## 3     0.1781113 0.82188870
## 4     0.9626429 0.03735709
## 5     0.1053718 0.89462817
## 6     0.8562390 0.14376095
## 7     0.9398897 0.06011034
## 8     0.3440858 0.65591418
## 9     0.2531719 0.74682808
## 10    0.9566374 0.04336259
# Matriz de confusión
confusion_matrix <- table(Pred_LDA$class, Ev2LDA$Outcome)

print(confusion_matrix)
##               
##                No Diabetico Diabetico
##   No Diabetico          446       112
##   Diabetico              54       156

Tras haber realizado la evaluación del desempeno del modelo predictivo, se genero una tabla donde Pred_LDA_Con_DPF$class indica los valores de las predicciones del modelo, mientras que Ev2LDA$Outcome indica los valores reales de la bd. Podemos observar que:

  • No Diabético (V Neg): Se clasificaron correctamente como No Diabéticos 446 casos.

  • Diabético (V Pos): Se clasificaron correctamente como Diabéticos: 156 casos.

  • Falsos Negativos (F Neg): Casos Diabéticos pero se clasificaron como No Diabéticos: 54 casos.

  • Falsos Positivos (F Pos): Casos No Diabéticos pero se clasificaron como Diabéticos: 112 casos.

error_rate <- (confusion_matrix[2, 1] + confusion_matrix[1, 2]) / sum(confusion_matrix)
error_rate_percentage <- error_rate * 100

print(paste("Porcentaje de Error:", round(error_rate_percentage, 2), "%"))
## [1] "Porcentaje de Error: 21.61 %"

Después, se calculó la tasa de error para determinar el número de predicciones incorrectas del modelo. Este cálculo reveló que el 21.61% de las predicciones en el conjunto de datos evaluado fueron inexactas.

LDA NUEVA PACIENTE

Añadimos una nueva paciente con datos ficticios para llevar a cabo predicciones y validar la precisión de su diagnóstico.

nueva.paciente=rbind(c(3,120,70,20,33,80,.45,34,0))
colnames(nueva.paciente)=colnames(Ev2LDA)
nuevo.dato=data.frame(nueva.paciente)

View(nueva.paciente)
nueva.paciente <- as.data.frame(nueva.paciente)

predicciones <- predict(LDA, newdata = nueva.paciente)

predicciones
## $class
## [1] Diabetico
## Levels: No Diabetico Diabetico
## 
## $posterior
##   No Diabetico Diabetico
## 1   0.04820788 0.9517921
## 
## $x
##        LD1
## 1 2.817773

Conclusiones:

En este contexto, según las predicciones del LDA, la nueva paciente debió haber sido diagnosticada como diabética. Aunque las predicciones sugirieron un resultado positivo para la nueva paciente, su diagnóstico real indicaba que no era diabética, lo cual contrasta con las predicciones del modelo.

Es relevante tener en cuenta el análisis previo, donde se identificó un porcentaje de error del 21.16% en la clasificación de los resultados. En este caso, esta paciente hubiera entrado dentro de los falsos negativos. Esto demuestra que en ocasiones, las evaluaciones medicas pueden ser incorrectas y afectar el resultado de un diagnostico. Sin embargo, es importante evaluar cuidadosamente el desempeño del modelo y considerar posibles ajustes en los umbrales de decisión para mejorar la precisión en las predicciones.

Bibliografia:

Diabetes Dataset. (2022). Recuperado de https://www.kaggle.com/datasets/akshaydattatraykhare/diabetes-dataset