Алгоритм \(K-means\) один із найпростіших і найбільш часто використовуваний метод для розбиття даних на \(K\) груп (кластерів).
Як правило, під кластеризацією розуміється групування даних так, щоб об’єкти в кластері були максимально схожі між собою, тоді як об’єкти із різних кластерів максимально відрізнялись.
Отже, ідея методу \(K-means\) полягає у розділенні на \(K\) груп (кластерів) \(S = \{S_1, S_2, ..., S_K\}\) \(N\) об’єктів (\(K \leq N\)) так, щоб мінімізувати загальну внутрішньокластерну варіацію \(tot.withinss\) (суму внутрішньокластерних варіацій (\(withinss\)) усіх кластерів) : \[tot.withinss = \sum_{k=1}^K(withinss(k)) = \sum_{k=1}^K \sum_{x_i \in S_k} \| x_i - \mu_k \|^2 \rightarrow min, \]
де \(x_i\) - \(i\)-ий об’єкт даних,
\(\mu_k\) - центр кластера (центроїд), якому присвоєний об’єкт \(x_i\),
\(\| x_i - \mu_k \|\) - у даному випадку евклідова відстань від центру кластера до об’єкту:
\[d_{euc}(x,y) = \| x-y \| = \sqrt{\sum_{i=1}^{n}{(x_i - y_i)^2}},\]
\(withinss(k) = \sum_{x_i \in S_k} \| x_i - \mu_k \|^2\) - внутрішньокластерна варіація кластера \(k\).
Сформуємо вибірку із двома змінними із нормального розподілу і випадковим чином початкові центри кластерів (будемо вважати для простоти, що їх два):
library(ggplot2)
library(dplyr)
library(tibble)
library(purrr)
library(magrittr)
# library(ggthemes)
library(gridExtra)
set.seed(123)
dataForCluster <- tibble(
x1 = c(rnorm(n = 100, mean = 10, sd = 2), rnorm(n = 100, mean = 2, sd = 2)),
x2 = c(rnorm(n = 100, mean = 10, sd = 2), rnorm(n = 100, mean = 2, sd = 2))
)
dataForCluster # таблиця із змінними
## # A tibble: 200 x 2
## x1 x2
## <dbl> <dbl>
## 1 8.879049 14.397621
## 2 9.539645 12.624826
## 3 13.117417 9.469710
## 4 10.141017 11.086388
## 5 10.258575 9.171320
## 6 13.430130 9.047506
## 7 10.921832 8.422794
## 8 7.469878 8.810765
## 9 8.626294 13.301815
## 10 9.108676 9.891944
## # ... with 190 more rows
set.seed(123)
startClusterCenter <- tibble(
clusterCenterX1 = c(rnorm(1, 3), rnorm(1, 10)),
clusterCenterX2 = c(rnorm(1, 10), rnorm(1, 3)),
clusterNumber = factor(c(1, 2))
)
startClusterCenter # таблиця із початковими центрами
## # A tibble: 2 x 3
## clusterCenterX1 clusterCenterX2 clusterNumber
## <dbl> <dbl> <fctr>
## 1 2.439524 11.558708 1
## 2 9.769823 3.070508 2
Зобразимо їх на графіку:
ggplot(data = startClusterCenter, aes(x = clusterCenterX1, y = clusterCenterX2, col = clusterNumber)) +
geom_point(size = 5, shape = 17) +
geom_point(data = dataForCluster, aes(x = x1, y = x2),
size = 4, color = "#000080", alpha = 0.5) +
scale_color_manual(values = c("#800000", "#008000"), labels = c("1", "2"), name = "Кластери") +
theme(legend.position = "bottom",
legend.key = element_rect(fill = "white")) +
labs(x = "x1", y = "x2",
title = "Графік із даними і початковими центрами кластерів")
Напишемо допоміжні функції розрахунку відстані між точками, формування кластерів і їх відображення:
# функція розрахунку евклідової відстанні для двух змінних
# dfData - координати точки, dfCenter - координати центру кластера
distCalculation <- function(dfData, dfCenter) {
sqrt( (dfData$x1 - dfCenter$clusterCenterX1)^2 + (dfData$x2 - dfCenter$clusterCenterX2)^2)
}
# функція розрахунку відстаней від центроїдів до об'єктів і формування нових кластерів
# oldData - координати точок, oldCentersClusters - координати центрів кластерів
createNewData <- function(oldData, oldCentersClusters) {
# відстань до центрів кластерів
newData <- oldData %>%
dplyr::mutate(
distClust1 = distCalculation(oldData, oldCentersClusters[1, ]), # перший кластер
distClust2 = distCalculation(oldData, oldCentersClusters[2, ]) # другий кластер
)
# присвоння об'єкту до відповідного кластера
newData %<>%
dplyr::mutate(
clusterNumberNew = factor(if_else(distClust1 >= distClust2, 2, 1))
)
# withinss <- apply(select(newData, distClust1, distClust2), 1, min)
# перерахунок центрів кластерів - нові центри
newCentersClusters <- newData %>%
group_by(clusterNumberNew) %>%
summarise(
clusterCenterX1 = mean(x1),
clusterCenterX2 = mean(x2)
)
result <- list(
newData = newData, # таблиця із даними і присвоєними кластерами
newCentersClusters = newCentersClusters # таблиця із центрами кластерів
)
return(result)
}
# функція для малювання графіків із відображенням переходу центрів в нові точки
createPlot <- function(dataPoint, dataCentersNew,
dataClusterOld, clusterONewStatus = T,
clusterOldStatus = T, segmentStatus = T) {
# відобразити точки, позначити приналежність до кластеру
p <- ggplot(data = dataPoint, aes(x = x1, y = x2)) +
geom_point(aes(col = clusterNumberNew),size = 4, alpha = 0.5) +
# scale_color_manual(values = c("#800000", "#008000")) +
scale_color_manual(values = c("#800000", "#008000"), labels = c("1", "2"), name = "Кластери") +
# theme_solarized() +
theme(legend.position = "bottom")
# показати центри старих кластерів
if (clusterOldStatus) {
p <- p +
geom_point(data = dataClusterOld[1, ],
aes(x = clusterCenterX1, y = clusterCenterX2),
col = "#800000", size = 5, shape = 17) +
geom_point(data = dataClusterOld[2, ],
aes(x = clusterCenterX1, y = clusterCenterX2),
col = "#008000", size = 5, shape = 17)
}
# показати центри нових кластерів
if (clusterONewStatus) {
p <- p +
geom_point(data = dataCentersNew[1, ],
aes(x = clusterCenterX1, y = clusterCenterX2),
col = "#800000", size = 5, shape = 2) +
geom_point(data = dataCentersNew[2, ],
aes(x = clusterCenterX1, y = clusterCenterX2),
col = "#008000", size = 5, shape = 2)
}
# показати стрілочки
if (segmentStatus) {
p <- p +
geom_curve(
aes(x = dataClusterOld[1, ]$clusterCenterX1, y = dataClusterOld[1, ]$clusterCenterX2,
xend = dataCentersNew[1, ]$clusterCenterX1, yend = dataCentersNew[1, ]$clusterCenterX2),
curvature = -0.2, col = "#800000", arrow = arrow(length = unit(0.03, "npc"))
) +
geom_curve(
aes(x = dataClusterOld[2, ]$clusterCenterX1, y = dataClusterOld[2, ]$clusterCenterX2,
xend = dataCentersNew[2, ]$clusterCenterX1, yend = dataCentersNew[2, ]$clusterCenterX2),
curvature = -0.2, col = "#008000", arrow = arrow(length = unit(0.03, "npc"))
)
}
return(p)
}
Зробимо 6 ітерацій. Розрахуємо відстань від початкових центрів, покажемо приналежність точок до кластерам і перерахуємо центри кластерів за допомогою допоміжних функцій:
listSize <- 6 # кількість ітерацій
dataWithClusters <- list() # список із таблицями, де дані із присвоєними кластерами
dataClusterCenters <- list() # центри кластерів із новими точками
length(dataWithClusters) <- listSize
length(dataClusterCenters) <- listSize
# перша ітерація будуть початкові точки (для зручності)
dataWithClusters[[1]] <- dataForCluster
dataClusterCenters[[1]] <- startClusterCenter
for (i in 2:listSize) {
dataWithClusters[[i]] <-
createNewData(oldData = dataWithClusters[[i-1]], oldCentersClusters = dataClusterCenters[[i-1]])$newData
dataClusterCenters[[i]] <-
createNewData(oldData = dataWithClusters[[i-1]], oldCentersClusters = dataClusterCenters[[i-1]])$newCentersClusters
}
Відобразимо першу ітерацію:
1. Розрахуємо відстань від центрів кластерів до точок. Поставимо точкам у відповідність номер кластера, центр якого ближче - точки позначені відповідним кольором.
2. Перерахуємо центри кластерів. Замальовані трикутники старі центри, незамальовані - нові, перехід позначений стрілками.
i <- 2
p1 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], F, T, F) +
labs(title = "Крок 1", subtitle = "Присвоїли точкам кластери")
p2 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], T, T, T) +
labs(title = "Крок 2", subtitle = "Оновили центри кластерів")
grid.arrange(p1,p2, ncol = 2, nrow = 1)
Відобразимо другу ітерацію із аналогічними діями (старі центри на даному кроці були новими на попереньому):
i <- 3
p1 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], F, T, F) +
labs(title = "Крок 1", subtitle = "Присвоїли точкам кластери")
p2 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], T, T, T) +
labs(title = "Крок 2", subtitle = "Оновили центри кластерів")
grid.arrange(p1,p2, ncol = 2, nrow = 1)
Відобразимо третю ітерацію із аналогічними діями (старі центри на даному кроці були новими на попереньому):
i <- 4
p1 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], F, T, F) +
labs(title = "Крок 1", subtitle = "Присвоїли точкам кластери")
p2 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], T, T, T) +
labs(title = "Крок 2", subtitle = "Оновили центри кластерів")
grid.arrange(p1,p2, ncol = 2, nrow = 1)
Відобразимо четверту ітерацію із аналогічними діями (старі центри на даному кроці були новими на попереньому):
i <- 5
p1 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], F, T, F) +
labs(title = "Крок 1", subtitle = "Присвоїли точкам кластери")
p2 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], T, T, T) +
labs(title = "Крок 2", subtitle = "Оновили центри кластерів")
grid.arrange(p1,p2, ncol = 2, nrow = 1)
Відобразимо п’яту ітерацію із аналогічними діями (старі центри на даному кроці були новими на попереньому):
i <- 6
p1 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], F, T, F) +
labs(title = "Крок 1", subtitle = "Присвоїли точкам кластери")
p2 <- createPlot(dataWithClusters[[i]], dataClusterCenters[[i]], dataClusterCenters[[i-1]], T, T, F) +
labs(title = "Крок 2", subtitle = "Оновили центри кластерів")
grid.arrange(p1,p2, ncol = 2, nrow = 1)
# df <- dataWithClusters[[i]]
# glimpse(df)
# df %>% group_by(clusterNumberNew) %>% sum()
Як бачимо центри стабілізувались і точки не змінюють кластери - можна зупинятись!
Для застосування методу \(K-means\) в R існує стандартна функція kmeans(). Основні аргументи функції:
x - матриця із даними або data frame із числовими змінними.
centers - кількість кластерів \(K\) або центри кластерів. Якщо задана кількість кластерів, то випадковим чимон вибираєтсья відповідна кількість точок із x.
iter.max - максимальна кількість ітерацій.
nstart - якщо в centers задана кількість кластерів, то скільки разів випадковим чином вибрати центри кластерів. В результаті вибирається найкращий варіант.
Основне, що повертає функція:
cluster - вектор цілих чисел із номерами кластерів для кожного об’єкту.
centers - матриця із центрами кластерів.
withinss - вектор із внутрішньокластерними варіаціями, один елемент на кластер.
tot.withinss - загальна внутрішньокластерна варіація (sum(withinss)).
size - кількість об’єктів у кожному кластері.
iter - кількість ітерацій.
Використаємо дану функцію на раніше сформованих даних:
# glimpse(dataForCluster)
set.seed(1)
clusterModel <- kmeans(
x = dataForCluster,
centers = 2,
nstart = 25
)
print(clusterModel)
## K-means clustering with 2 clusters of sizes 101, 99
##
## Cluster means:
## x1 x2
## 1 10.163993 10.179627
## 2 1.717258 1.906122
##
## Clustering vector:
## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [71] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2
## [106] 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 2 2 2 2 2
## [141] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2
## [176] 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] 728.0724 747.7426
## (between_SS / total_SS = 82.6 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss"
## [5] "tot.withinss" "betweenss" "size" "iter"
## [9] "ifault"
Відобразимо результати роботи функції:
# додамо номер кластеру (номери мождуть відрізнятись, якщо перезапускти функцію декілька разів)
dataForCluster %<>% dplyr::mutate(clusterNumber = clusterModel$cluster)
# центри кластерів
dataCenters <- as_tibble(clusterModel$centers)
dataCenters$clusterNumber <- c(1,2)
ggplot(data = dataCenters, aes(x = x1, y = x2, col = factor(clusterNumber))) +
geom_point(size = 5, shape = 17) +
geom_point(data = dataForCluster, aes(x = x1, y = x2, col = factor(clusterNumber)), size = 4, alpha = 0.5) +
scale_color_manual(values = c("#800000", "#008000"), labels = c("1", "2"), name = "Кластери") +
theme(legend.position = "bottom", legend.key = element_rect(fill = "white")) +
labs(x = "x1", y = "x2", title = "Графік із розміченими даними", subtitle = "Результат роботи функції kmeans")
Як бачимо, все зійшлося (здається).