El algoritmo de es un método de clustering particional que divide los datos en \(k\) grupos (clusters) minimizando la suma de distancias al cuadrado entre los puntos y el centroide de su cluster. Es iterativo y sensible a la inicialización, pero muy popular por su simplicidad y eficiencia.
En este documento aplicamos k-medias con \(k = 3\) (número de especies conocidas en Iris) sobre cada par de características del conjunto de datos . Para cada combinación de dos variables:Observaremos cómo el algoritmo logra separar o mezclar las especies dependiendo de la separabilidad natural de las variables.
Cargamos el dataset y estandarizamos cada característica (media 0, desviación 1) para que todas tengan la misma escala. Esto evita que características con valores grandes dominen la distancia.
El código R completo, que genera todas las figuras, se incluye a continuación. Las figuras resultantes se muestran en la Sección~\(\ref{sec:figuras}\).
# Fijar semilla para reproducibilidad
set.seed(123)
# Cargar librerías
library(ggplot2)
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Cargar datos
data(iris)
# Estandarizar las cuatro variables numéricas
iris_scaled <- iris %>%
mutate(across(where(is.numeric), scale))
# Lista de pares de variables
pairs <- combn(names(iris_scaled)[1:4], 2, simplify = FALSE)
# Función para aplicar k-means y mostrar el gráfico
plot_kmeans_pair <- function(var1, var2) {
data_pair <- iris_scaled[, c(var1, var2)]
km <- kmeans(data_pair, centers = 3, nstart = 25)
plot_df <- iris_scaled %>%
select(all_of(c(var1, var2)), Species) %>%
mutate(cluster = as.factor(km$cluster))
centers <- as.data.frame(km$centers)
colnames(centers) <- c(var1, var2)
centers$cluster <- as.factor(1:3)
p <- ggplot(plot_df, aes(x = .data[[var1]], y = .data[[var2]])) +
geom_point(aes(color = cluster, shape = Species), size = 2, alpha = 0.8) +
geom_point(data = centers, aes(color = cluster), size = 4, shape = 4, stroke = 1.5) +
scale_shape_manual(values = c(16, 17, 15)) +
labs(title = paste(var1, "vs", var2),
x = var1, y = var2,
color = "Cluster k-means", shape = "Especie real") +
theme_minimal() +
theme(legend.position = "bottom")
# Mostrar el gráfico (sin guardar)
print(p)
}
# Generar los 6 gráficos (aparecerán en la ventana de gráficos)
for (i in seq_along(pairs)) {
plot_kmeans_pair(pairs[[i]][1], pairs[[i]][2])
}
# Para el mejor par (Petal.Length vs Petal.Width), mostrar tabla de contingencia
data_pair_best <- iris_scaled[, c("Petal.Length", "Petal.Width")]
km_best <- kmeans(data_pair_best, centers = 3, nstart = 25)
tabla <- table(iris$Species, km_best$cluster)
print(tabla)
##
## 1 2 3
## setosa 0 0 50
## versicolor 2 48 0
## virginica 46 4 0
Al ejecutar el código anterior se generan seis archivos PDF, uno por cada par de variables. Las figuras se muestran en las páginas siguientes (agrupadas en dos filas de tres).
Observando los gráficos , notamos:
La siguiente tabla muestra la asignación de clusters frente a la especie real cuando se usan únicamente las dos variables de pétalo:
Vemos que la asignación es casi perfecta (solo unos pocos errores entre versicolor y virginica). Esto coincide con la conocida capacidad de las medidas de pétalo para separar las especies de Iris.
En este documento generamos dos conjuntos de puntos:
Combinamos ambos conjuntos (olvidamos de qué círculo proviene cada
punto).
Aplicamos el algoritmo de con \(k =
2\), \(k = 5\) y \(k = 50\) para ver cómo clasifica los
puntos.
Graficamos los resultados y observamos que para separar anillos
concéntricos, ya que asume clusters de forma esférica y tamaños
similares.
El siguiente código R genera los puntos y produce las gráficas. Se asume que se tienen instalados los paquetes y .
set.seed(123)
# Función para generar puntos uniformes dentro de un círculo de radio R
gen_circle_points <- function(R, n) {
pts <- data.frame(x = numeric(n), y = numeric(n))
count <- 0
while(count < n) {
x_candidate <- runif(1, -R, R)
y_candidate <- runif(1, -R, R)
if (x_candidate^2 + y_candidate^2 <= R^2) {
count <- count + 1
pts[count, ] <- c(x_candidate, y_candidate)
}
}
return(pts)
}
# Generar 1000 puntos en cada círculo
N <- 1000
puntos_r1 <- gen_circle_points(1, N)
puntos_r2 <- gen_circle_points(2, N)
# Etiquetamos originalmente solo para referencia visual
puntos_r1$origen <- 1 # radio = 1
puntos_r2$origen <- 2 # radio = 2
# Combinamos
datos_combinados <- rbind(puntos_r1, puntos_r2)
datos_sin_origen <- datos_combinados[, c("x", "y")]
# --- Gráfico de los datos originales (colores por origen real) ---
plot(datos_combinados$x, datos_combinados$y,
col = c("red", "blue")[datos_combinados$origen],
pch = 16, cex = 0.6, asp = 1,
main = "Datos originales: círculo radio 1 (rojo) y radio 2 (azul)",
xlab = "x", ylab = "y")
legend("topright", legend = c("radio = 1", "radio = 2"),
col = c("red", "blue"), pch = 16)
# --- k-medias con k = 2 ---
set.seed(456)
km2 <- kmeans(datos_sin_origen, centers = 2, nstart = 25)
plot(datos_sin_origen$x, datos_sin_origen$y,
col = km2$cluster, pch = 16, cex = 0.6, asp = 1,
main = "k-medias con k = 2",
xlab = "x", ylab = "y")
points(km2$centers, col = "black", pch = 8, cex = 1.5)
# --- k-medias con k = 5 ---
set.seed(789)
km5 <- kmeans(datos_sin_origen, centers = 5, nstart = 25)
plot(datos_sin_origen$x, datos_sin_origen$y,
col = km5$cluster, pch = 16, cex = 0.6, asp = 1,
main = "k-medias con k = 5",
xlab = "x", ylab = "y")
points(km5$centers, col = "black", pch = 8, cex = 1.5)
# --- k-medias con k = 50 ---
set.seed(101112)
km50 <- kmeans(datos_sin_origen, centers = 50, nstart = 25)
# Usamos una paleta de colores con suficientes tonos
library(RColorBrewer)
colores50 <- brewer.pal(12, "Set3")
colores50 <- rep(colores50, length.out = 50)
plot(datos_sin_origen$x, datos_sin_origen$y,
col = colores50[km50$cluster], pch = 16, cex = 0.6, asp = 1,
main = "k-medias con k = 50",
xlab = "x", ylab = "y")
points(km50$centers, col = "black", pch = 8, cex = 1.5)
Al ejecutar el código anterior se obtienen las siguientes gráficas.