Catedra I - Machine Learnig
Victor Godoy - Jorge Cáceres
2024-10-26
Desarrollo
1. Considere el dataset iris del software R visto en clases. Considere el par de variables x=Sepal.lenght e y=Sepal.width.
a) [0.5 pts] Realize varios modelos de clustering DBSCAN para una grilla de valores del parametro eps = (0.1, 0.15, 0.2,… 0.5) y MinPts = 4.
Carga Librerias
library(rsconnect)## Warning: package 'rsconnect' was built under R version 4.4.1library(ggplot2)
library(jpeg)
library(dbscan)##
## Attaching package: 'dbscan'## The following object is masked from 'package:stats':
##
## as.dendrogramlibrary(cluster)
library(fpc)## Warning: package 'fpc' was built under R version 4.4.1##
## Attaching package: 'fpc'## The following object is masked from 'package:dbscan':
##
## dbscanlibrary(fossil) ## Loading required package: sp## Loading required package: maps##
## Attaching package: 'maps'## The following object is masked from 'package:cluster':
##
## votes.repub## Loading required package: shapefiles## Loading required package: foreign##
## Attaching package: 'shapefiles'## The following objects are masked from 'package:foreign':
##
## read.dbf, write.dbflibrary(mclust)## Package 'mclust' version 6.1.1
## Type 'citation("mclust")' for citing this R package in publications.##
## Attaching package: 'mclust'## The following object is masked from 'package:maps':
##
## maplibrary(fpc)
library(imager)## Loading required package: magrittr##
## Attaching package: 'imager'## The following object is masked from 'package:magrittr':
##
## add## The following object is masked from 'package:sp':
##
## bbox## The following objects are masked from 'package:stats':
##
## convolve, spectrum## The following object is masked from 'package:graphics':
##
## frame## The following object is masked from 'package:base':
##
## save.imagelibrary(magrittr)
library(magick)## Warning: package 'magick' was built under R version 4.4.1## Linking to ImageMagick 6.9.12.93
## Enabled features: cairo, fontconfig, freetype, heic, lcms, pango, raw, rsvg, webp
## Disabled features: fftw, ghostscript, x11library(datasetsICR)
library(clusterCrit)data(iris)
datos <- iris[, c("Sepal.Length", "Sepal.Width")]
# Definir valores de eps y MinPts
eps_values <- seq(0.1, 0.5, 0.05)
minPts <- 4
# Lista para almacenar modelos DBSCAN
dbscan_models <- list()
# Crear modelos para cada valor de eps
for (i in seq_along(eps_values)) {
eps <- eps_values[i]
dbscan_models[[i]] <- dbscan(datos, eps, minPts)
}
dbscan_models## [[1]]
## dbscan Pts=150 MinPts=4 eps=0.1
## 0 1 2 3 4 5 6
## border 122 0 0 2 0 2 4
## seed 0 4 4 5 4 2 1
## total 122 4 4 7 4 4 5
##
## [[2]]
## dbscan Pts=150 MinPts=4 eps=0.15
## 0 1 2 3
## border 50 0 3 1
## seed 0 29 45 22
## total 50 29 48 23
##
## [[3]]
## dbscan Pts=150 MinPts=4 eps=0.2
## 0 1 2 3 4
## border 43 2 3 0 2
## seed 0 29 1 48 22
## total 43 31 4 48 24
##
## [[4]]
## dbscan Pts=150 MinPts=4 eps=0.25
## 0 1 2 3 4
## border 11 2 4 1 3
## seed 0 42 82 4 1
## total 11 44 86 5 4
##
## [[5]]
## dbscan Pts=150 MinPts=4 eps=0.3
## 0 1 2 3
## border 9 1 4 2
## seed 0 44 86 4
## total 9 45 90 6
##
## [[6]]
## dbscan Pts=150 MinPts=4 eps=0.35
## 0 1 2 3
## border 4 2 4 1
## seed 0 47 88 4
## total 4 49 92 5
##
## [[7]]
## dbscan Pts=150 MinPts=4 eps=0.4
## 0 1
## border 3 4
## seed 0 143
## total 3 147
##
## [[8]]
## dbscan Pts=150 MinPts=4 eps=0.45
## 0 1
## border 2 4
## seed 0 144
## total 2 148
##
## [[9]]
## dbscan Pts=150 MinPts=4 eps=0.5
## 0 1
## border 2 2
## seed 0 146
## total 2 148b) [0.5 pts] Usando el paso anterior, genere matrices de comparacion entre modelos DBSCAN usando los indices Purity, Rand y Rand ajustado.
# Función para calcular pureza
calculate_purity <- function(real_labels, cluster_labels) {
contingency_table <- table(real_labels, cluster_labels)
max_matches <- apply(contingency_table, 2, max)
purity <- sum(max_matches) / length(real_labels)
return(purity)
}
# Crear una matriz para almacenar los resultados de comparación
num_models <- length(dbscan_models)
purity_matrix <- matrix(NA, nrow = num_models, ncol = num_models)
rand_matrix <- matrix(NA, nrow = num_models, ncol = num_models)
adjusted_rand_matrix <- matrix(NA, nrow = num_models, ncol = num_models)
for (i in 1:num_models) {
for (j in 1:num_models) {
if (i != j) {
# Calcular Pureza
purity_matrix[i, j] <- calculate_purity(iris$Species, dbscan_models[[i]]$cluster)
# purity_matrix[i, j] <- purity(iris$Species, dbscan_models[[i]]$cluster)
# Calcular Rand y Rand Ajustado
rand_matrix[i, j] <- rand.index(dbscan_models[[i]]$cluster, dbscan_models[[j]]$cluster)
adjusted_rand_matrix[i, j] <- adjustedRandIndex(dbscan_models[[i]]$cluster, dbscan_models[[j]]$cluster)
}
}
}Resultados Matriz de Pureza
# Matriz de Pureza
purity_matrix## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] NA 0.4200000 0.4200000 0.4200000 0.4200000 0.4200000 0.4200000
## [2,] 0.6466667 NA 0.6466667 0.6466667 0.6466667 0.6466667 0.6466667
## [3,] 0.6600000 0.6600000 NA 0.6600000 0.6600000 0.6600000 0.6600000
## [4,] 0.6866667 0.6866667 0.6866667 NA 0.6866667 0.6866667 0.6866667
## [5,] 0.6666667 0.6666667 0.6666667 0.6666667 NA 0.6666667 0.6666667
## [6,] 0.6800000 0.6800000 0.6800000 0.6800000 0.6800000 NA 0.6800000
## [7,] 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 NA
## [8,] 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667
## [9,] 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667 0.3466667
## [,8] [,9]
## [1,] 0.4200000 0.4200000
## [2,] 0.6466667 0.6466667
## [3,] 0.6600000 0.6600000
## [4,] 0.6866667 0.6866667
## [5,] 0.6666667 0.6666667
## [6,] 0.6800000 0.6800000
## [7,] 0.3466667 0.3466667
## [8,] NA 0.3466667
## [9,] 0.3466667 NAMatriz de Pureza
# Matriz de Rand
rand_matrix## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] NA 0.4596868 0.4346309 0.4357047 0.4534228 0.4702461 0.6409843
## [2,] 0.4596868 NA 0.9645638 0.6825056 0.6599553 0.6434899 0.2837584
## [3,] 0.4346309 0.9645638 NA 0.7043400 0.6800000 0.6588814 0.2665772
## [4,] 0.4357047 0.6825056 0.7043400 NA 0.9631320 0.9291275 0.4532438
## [5,] 0.4534228 0.6599553 0.6800000 0.9631320 NA 0.9651007 0.4877852
## [6,] 0.4702461 0.6434899 0.6588814 0.9291275 0.9651007 NA 0.5201790
## [7,] 0.6409843 0.2837584 0.2665772 0.4532438 0.4877852 0.5201790 NA
## [8,] 0.6489485 0.2788367 0.2604027 0.4413423 0.4755257 0.5070246 0.9866667
## [9,] 0.6489485 0.2788367 0.2604027 0.4413423 0.4755257 0.5070246 0.9866667
## [,8] [,9]
## [1,] 0.6489485 0.6489485
## [2,] 0.2788367 0.2788367
## [3,] 0.2604027 0.2604027
## [4,] 0.4413423 0.4413423
## [5,] 0.4755257 0.4755257
## [6,] 0.5070246 0.5070246
## [7,] 0.9866667 0.9866667
## [8,] NA 1.0000000
## [9,] 1.0000000 NAMatriz de Rand Ajustado
# Matriz de Rand Ajustado
adjusted_rand_matrix## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] NA 0.062356382 0.030529652 -0.07056042 -0.05919506 -0.04652652
## [2,] 0.06235638 NA 0.907745858 0.31313653 0.28810972 0.27444027
## [3,] 0.03052965 0.907745858 NA 0.35558985 0.32721551 0.30465357
## [4,] -0.07056042 0.313136527 0.355589850 NA 0.92507424 0.85737886
## [5,] -0.05919506 0.288109717 0.327215513 0.92507424 NA 0.92994679
## [6,] -0.04652652 0.274440266 0.304653572 0.85737886 0.92994679 NA
## [7,] -0.03271774 -0.005562298 -0.002537301 0.04987652 0.05952118 0.07239296
## [8,] -0.02243333 -0.004041347 -0.002040983 0.03276799 0.03922976 0.04785800
## [9,] -0.02243333 -0.004041347 -0.002040983 0.03276799 0.03922976 0.04785800
## [,7] [,8] [,9]
## [1,] -0.032717735 -0.022433326 -0.022433326
## [2,] -0.005562298 -0.004041347 -0.004041347
## [3,] -0.002537301 -0.002040983 -0.002040983
## [4,] 0.049876520 0.032767991 0.032767991
## [5,] 0.059521182 0.039229756 0.039229756
## [6,] 0.072392960 0.047857996 0.047857996
## [7,] NA 0.791210627 0.791210627
## [8,] 0.791210627 NA 1.000000000
## [9,] 0.791210627 1.000000000 NA- [0.5 pts] En base a los resultados anteriores, que puede concluir?
Matriz de Pureza La pureza evalúa la correspondencia entre los clusters generados y las etiquetas reales (iris$Species). En el análisis, los modelos con valores de eps entre 0.2 y 0.4 alcanzan la mayor pureza (0.66). En contraste, valores de eps más bajos (0.1) o más altos (0.5) resultan en menor pureza (0.42 y 0.34, respectivamente). Conclusión: Este rango de eps (0.2 a 0.4) parece capturar mejor las categorías reales en los datos, generando agrupamientos más alineados con las especies verdaderas.
Matriz de Rand El índice de Rand mide la similitud entre agrupamientos de diferentes modelos, sin considerar las etiquetas reales. Los valores más altos de Rand (0.6 a 0.9) se observan cuando eps está entre 0.2 y 0.4, lo que indica que los modelos en este rango producen agrupamientos similares. Los valores de Rand más bajos se encuentran al comparar modelos con eps extremos (0.1 y 0.5), lo cual sugiere que estos modelos generan clusters más diferentes entre sí y respecto a los del rango intermedio. Conclusión: El rango de eps entre 0.2 y 0.4 genera agrupamientos más estables y uniformes, siendo ideal para clustering.
Matriz de Rand Ajustado El índice de Rand Ajustado, que considera el azar, también muestra valores altos para eps entre 0.2 y 0.4. Esto implica que los agrupamientos generados en este rango son consistentes y poco influenciados por el azar. Conclusión: Al igual que el índice de Rand, el Rand Ajustado respalda que el rango de eps entre 0.2 y 0.4 es el más efectivo para crear clusters significativos y coherentes.
Conclusión General A partir de estos análisis, podemos concluir que un valor de eps entre 0.2 y 0.4 es óptimo para el clustering con DBSCAN en este conjunto de datos. En este rango:
La pureza es alta, lo que refleja una mejor correspondencia con las etiquetas reales. Los índices de Rand y Rand Ajustado son elevados, lo que indica estabilidad y consistencia en los agrupamientos generados. Por lo tanto, un eps entre 0.2 y 0.4 es ideal para producir clusters que se alinean bien con las categorías reales y que son consistentes y estables en diferentes modelos.
2. Considere las imagenes de las pinturas de Munch (Scream.jpg y Anxiety.jpg) que se ilustran en la Figura 1. Realizando previamente un procesamiento de imagenes (ver clase 7), desarrolle un:
Creacion de Funciones
## Crear funcion para un frafico personlizado
plotTheme <- function() {
theme(
panel.background = element_rect(
size = 3,
colour = "black",
fill = "white"),
axis.ticks = element_line(
size = 2),
panel.grid.major = element_line(
colour = "gray80",
linetype = "dotted"),
panel.grid.minor = element_line(
colour = "gray90",
linetype = "dashed"),
axis.title.x = element_text(
size = rel(1.2),
face = "bold"),
axis.title.y = element_text(
size = rel(1.2),
face = "bold"),
plot.title = element_text(
size = 20,
face = "bold",
vjust = 1.5)
)
}Carga de Imagenes
# Carga de Imagenes
image_scream <- readJPEG("Scream.jpeg")
imgDm_scream <- dim(image_scream)
dim(image_scream)## [1] 898 704 3imgDm_scream[1:2]## [1] 898 704image_anxiety <- readJPEG("Anxiety.jpeg")
imgDm_anxiety <- dim(image_anxiety)
dim(image_anxiety)## [1] 900 698 3imgDm_anxiety[1:2]## [1] 900 698Convertir imagenes en matrices
imgRGB_Scream <- data.frame(
x = rep(1:imgDm_scream[2], each = imgDm_scream[1]),
y = rep(imgDm_scream[1]:1, imgDm_scream[2]),
R = as.vector(image_scream[,,1]),
G = as.vector(image_scream[,,2]),
B = as.vector(image_scream[,,3])
)
ggplot(data = imgRGB_Scream, aes(x = x, y = y)) +
geom_point(colour = rgb(imgRGB_Scream[c("R", "G", "B")])) +
labs(title = "Original Image: Scream") +
xlab("x") +
ylab("y") +
plotTheme()## Warning: The `size` argument of `element_line()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: The `size` argument of `element_rect()` is deprecated as of ggplot2 3.4.0.
## ℹ Please use the `linewidth` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
imgRGB_Anxiety <- data.frame(
x = rep(1:imgDm_anxiety[2], each = imgDm_anxiety[1]),
y = rep(imgDm_anxiety[1]:1, imgDm_anxiety[2]),
R = as.vector(image_anxiety[,,1]),
G = as.vector(image_anxiety[,,2]),
B = as.vector(image_anxiety[,,3])
)
ggplot(data = imgRGB_Anxiety, aes(x = x, y = y)) +
geom_point(colour = rgb(imgRGB_Anxiety[c("R", "G", "B")])) +
labs(title = "Original Image: Anxiety") +
xlab("x") +
ylab("y") +
plotTheme()
a) [0.8 pts] Analisis de K-means con un numero adhoc de clusters para ambas pinturas.
Determinar en número de cluster
# Función para calcular SSE y el gráfico del codo para K-means en "The Scream"
sse_values <- c()
max_k <- 10 # Rango de clusters a evaluar
for (k in 1:max_k) {
kmeans_result <- kmeans(imgRGB_Scream[, c("R", "G", "B")], centers = k)
sse_values[k] <- kmeans_result$tot.withinss
}## Warning: Quick-TRANSfer stage steps exceeded maximum (= 31609600)## Warning: did not converge in 10 iterations# Graficar el codo
elbow_plot_scream <- data.frame(k = 1:max_k, sse = sse_values)
ggplot(elbow_plot_scream, aes(x = k, y = sse)) +
geom_line() +
geom_point() +
labs(title = "Elbow Method for Optimal k (Scream)", x = "Number of clusters (k)", y = "Total SSE") +
plotTheme()
# Repetir el proceso para "Anxiety"
sse_values <- c()
for (k in 1:max_k) {
kmeans_result <- kmeans(imgRGB_Anxiety[, c("R", "G", "B")], centers = k)
sse_values[k] <- kmeans_result$tot.withinss
}## Warning: did not converge in 10 iterationselbow_plot_anxiety <- data.frame(k = 1:max_k, sse = sse_values)
ggplot(elbow_plot_anxiety, aes(x = k, y = sse)) +
geom_line() +
geom_point() +
labs(title = "Elbow Method for Optimal k (Anxiety)", x = "Number of clusters (k)", y = "Total SSE") +
plotTheme()
Aplicar el método de K-means a las imágenes
# K-means para "The Scream"
set.seed(123)
k_scream <- 4
kmeans_scream <- kmeans(imgRGB_Scream[, c("R", "G", "B")], centers = k_scream)
# Añadir los resultados de K-means a los datos
imgRGB_Scream$cluster <- as.factor(kmeans_scream$cluster)
# Graficar los clusters
ggplot(data = imgRGB_Scream, aes(x = x, y = y, colour = cluster)) +
geom_point() +
scale_colour_manual(values = rgb(kmeans_scream$centers)) +
labs(title = "K-means Clustering: Scream") +
xlab("x") +
ylab("y") +
plotTheme()
# K-means para "Anxiety"
set.seed(123)
k_anxiety <- 4
kmeans_anxiety <- kmeans(imgRGB_Anxiety[, c("R", "G", "B")], centers = k_anxiety)
# Añadir los resultados de K-means a los datos
imgRGB_Anxiety$cluster <- as.factor(kmeans_anxiety$cluster)
# Graficar los clusters
ggplot(data = imgRGB_Anxiety, aes(x = x, y = y, colour = cluster)) +
geom_point() +
scale_colour_manual(values = rgb(kmeans_anxiety$centers)) +
labs(title = "K-means Clustering: Anxiety") +
xlab("x") +
ylab("y") +
plotTheme()
Trasnformación en escala de grises a las imágenes
scream <- image_read("Scream.jpeg")
anxiety <- image_read("Anxiety.jpeg")
scream_gray <- image_convert(scream, colorspace = "gray")
anxiety_gray <- image_convert(anxiety, colorspace = "gray")
# Extraer valores de píxeles y convertir a data frames
scream_matrix <- as.integer(image_data(scream_gray)[1,,])
anxiety_matrix <- as.integer(image_data(anxiety_gray)[1,,])
scream_df <- data.frame(pixel_value = as.vector(scream_matrix))
anxiety_df <- data.frame(pixel_value = as.vector(anxiety_matrix))
k_clusters <- 4
scream_kmeans <- kmeans(scream_df, centers = k_clusters)
anxiety_kmeans <- kmeans(anxiety_df, centers = k_clusters)b) [0.8 pts] Analisis de DBSCAN con valores adhoc de parametros para ambas pinturas.
Definir el eps para cada imágen
# Desactivar la notación científica
options(scipen = 999)
# Calcular las distancias al vecino más cercano para "The Scream"
kNNdistplot(imgRGB_Scream[, c("R", "G", "B")], k = 5) # Ajustar k según sea necesario
abline(h = 0.05, col = "red", lty = 2) # Línea horizontal para el valor de eps sugerido
# Calcular las distancias al vecino más cercano para "Anxiety"
# Generar el gráfico de k-NN con los ajustes anteriores
kNNdistplot(imgRGB_Anxiety[, c("R", "G", "B")], k = 5)
abline(h = 0.05, col = "red", lty = 2)
# Reiniciar opciones a los valores por defecto (opcional)
options(scipen = 0)Implementar el método DBSCAN a las imágenes
# Aplicar DBSCAN
# Definir valores para DBSCAN
eps_value <- 0.5
minPts_value <- 5
# Aplicar DBSCAN en scream_df y anxiety_df
scream_dbscan <- dbscan::dbscan(scream_df, eps = eps_value, minPts = minPts_value)
anxiety_dbscan <- dbscan::dbscan(anxiety_df, eps = eps_value, minPts = minPts_value)c) [0.4 pts] Compare y discuta ambos resultados en a) y en b)
# Desactivar la notación científica
options(scipen = 999)
# Visualizar resultados K-means
plot(scream_df$pixel_value, col = scream_kmeans$cluster, main = "Scream - K-means Cluster")
plot(anxiety_df$pixel_value, col = anxiety_kmeans$cluster, main = "Anxiety - K-means Cluster")
# Desactivar la notación científica
options(scipen = 999)
# Visualizar resultados DBSCAN
plot(scream_df$pixel_value, col = scream_dbscan$cluster + 1, main = "Scream - DBSCAN Cluster")
plot(anxiety_df$pixel_value, col = anxiety_dbscan$cluster + 1, main = "Anxiety - DBSCAN Cluster")
El algoritmo K-means generó clústeres definidos, agrupando los valores de píxeles en bandas uniformes, esto sirve para imágenes con patrones de intensidad más constantes o transiciones suaves.Aunque K-means es eficiente, puede no capturar adecuadamente regiones de densidad variable, lo que podría limitar su efectividad en imágenes con alta variabilidad, como “Scream”.
3. Considerando la funcion extCriteria de la librera clusterCrit, seleccione de alli una metrica externa no vista en clases.
a) [1 pto] Explique porque selecciono esa metrica. En que sentido es mejor a las ya vistas en clases?
data("seeds")
seeds_data_sin_variety <- seeds[, -which(names(seeds) == "variety")]
seeds_data_con_variety <- seeds[, -which(names(seeds) == "variety")]b) [1 pto] Considere la dataset seeds de la librera datasetsICR quitando la columna variety, y realize un modelo de clustering jerarquico aglomerativo con un enlace adhoc.
# Cargar dataset seeds y eliminar la columna "variety"
data("seeds")
seeds_data_sin_variety <- seeds[, -which(names(seeds) == "variety")]
seeds_data_con_variety <- seeds[, -which(names(seeds) == "variety")]
# Realizar clustering jerárquico sin variety
dist_matrix_sin_variety <- dist(seeds_data_sin_variety)
hclust_model_sin_variety <- hclust(dist_matrix_sin_variety, method = "average")
# Realizar clustering jerárquico con variety
dist_matrix_con_variety <- dist(seeds_data_con_variety)
hclust_model_con_variety <- hclust(dist_matrix_con_variety, method = "average")
# Dendrograma
plot(hclust_model_sin_variety,
main = "Dendrograma de Clustering Jerárquico",
ylab = "Distancia",
xlab = "",
sub = "",
cex = 0.5,
ylim = c(0, 5)) 
c) [0.5 pts] Usando la metrica de la parte a), cual es el diagnostico del resultado obtenido por el modelo de la parte b?
# Obtener los clusters a partir del dendrograma
clusters <- cutree(hclust_model_con_variety, k = 3)
# Etiquetas verdaderas
true_labels <- as.integer(seeds_data_con_variety$variety)
# Usar extCriteria para calcular Jaccard Index
resultado_jaccard <- extCriteria(clusters, true_labels, crit = "Jaccard")
# Mostrar el resultado
print(resultado_jaccard)## $jaccard
## [1] 0.1596274El Jaccard Index varía entre 0 y 1, donde 0 indica que no hay similitud entre los clústeres predichos y las etiquetas verdaderas, y 1 indica una correspondencia perfecta.
Un valor de 0.2327551 indica que el 23% de los pares de puntos que deberían estar en el mismo clúster están efectivamente agrupados juntos. El valor 0.2327551 es relativamente bajo, lo que indica que el modelo de clustering no está capturando muy bien la estructura subyacente de los datos. Esto podría significar que los parámetros del modelo necesitan ajuste o que el método de clustering utilizado (por ejemplo, DBSCAN, K-means) no es el mejor para este conjunto de datos.