1 Introduction

Кластеризация - довольно субъективная задача. При решении одной задачи может существовать несколько правильных алгоритмов кластеризации. К сожалению для решения конкретной задачи подбирать наиболее подходящий алгоритм приходится экспериментально. За исключением случая когда существуют предпосылки отдать предпочтение какому-то конкретному алгоритму.

Высока вероятность того, что алгоритм может хорошо работать с одним набором данных и не работать с другим.

1.1 Initial data

Для иллюстрации ряда видов кластеризации будут использоваться набор данных Uber, который содержить сгенерированные Uber данные для Нью-Йорка. Эти данные находятся в свободном доступе на Kaggle. Набор данных содержит необработанную информацию Uber о поездках в Нью-Йорке.

1.2 Problem Understanding

Транспортный поток вообще и любого города в частности несет в себе огромное количество информации. При обработке этих данных они могут дать информацию о структуре и строении города, выделить различные городские зоны и т.д. Это позволит принимать решения по развитию и улучшению городской инфраструктуры и т.п.

Данные получаемые в течение длительного времени, позволяют определить часы пик, влияние погодных факторов, сезона года и т.д. Они могут быть использованы для улучшения планирования и управления движением, что приведет к увеличению пропускной способности дорог и эффективности их использования. Позволит снизить аварийность на дорогах, ускорить и усовершенствовать перенаправление транспортных потоков после аварий. В целом все это представляет достаточно большую и многогранную проблему. Поэтому мы сосредоточимся на проблеме идентификации пяти районов Нью-Йорка с применением некоторых алгоритмов кластеризации.

1.3 Understanding The Data

Используем данные Uber за 2014 год, в виде csv-файлов.

1.4 Data Loading

# loas csv. files
apr14 <- read.csv('uber-raw-data-apr14.csv', header = TRUE, sep = ",")

may14 <- read.csv('uber-raw-data-may14.csv', header = TRUE, sep = ",")

jun14 <- read.csv('uber-raw-data-jun14.csv', header = TRUE, sep = ",")

jul14 <- read.csv('uber-raw-data-jul14.csv', header = TRUE, sep = ",")

aug14 <- read.csv('uber-raw-data-aug14.csv', header = TRUE, sep = ",")

sep14 <- read.csv('uber-raw-data-sep14.csv', header = TRUE, sep = ",")

Объединим все загруженные файлы в один, используя функцию bind_rows() из библиотеки dplyr в R.

library(dplyr)
data14 <- bind_rows(apr14, may14, jun14, jul14, aug14, sep14)

Просмотрим основные сведения о данных.

summary(data14)
##               Date.Time            Lat             Lon             Base        
##  4/7/2014 20:21:00 :     97   Min.   :39.66   Min.   :-74.93   B02512: 205673  
##  6/13/2014 18:03:00:     88   1st Qu.:40.72   1st Qu.:-74.00   B02598:1393113  
##  4/7/2014 20:22:00 :     87   Median :40.74   Median :-73.98   B02617:1458853  
##  9/13/2014 18:44:00:     82   Mean   :40.74   Mean   :-73.97   B02682:1212789  
##  9/13/2014 18:41:00:     80   3rd Qu.:40.76   3rd Qu.:-73.97   B02764: 263899  
##  7/15/2014 19:30:00:     79   Max.   :42.12   Max.   :-72.07                   
##  (Other)           :4533814

Набор данных содержит следующие столбцы:

  • Data.Time - дата и время заказа Uber,
  • Lat - широта заказа Uber,
  • Lon - долгота заказа Uber,
  • Base - базовая балансовая единица TLC связанная с Uber.

1.5 Data Preparation

Подготовка данных заключается в очистке и организации данных, а также в проверке уникальности набора данных и пропущенных значениях.

# VIM library for using 'aggr'
# 'aggr' plots the amount of missing/imputed values in each column
require(colorspace)
require(grid)
require(data.table)
require(VIM)
aggr(data14)
Fig. 1. Наличие пропущенных значений

Fig. 1. Наличие пропущенных значений

Как видно из рисунка 1, в наборе нет пропущенных значений. Однако такое встречается редко, поэтому может потребоваться применять методы для работы с пропущенными данными. Например, удаление конкретного столбца или строки, либо замену пропуска на среднее значение.

Первый столбец Date.Time необходимо разделить, чтобы иметь возможность работать с датами и временем. Для этого используем библиотеку lubridate.

require(lubridate)
# separate or mutate data/time columns
data14$Date.Time <- mdy_hms(data14$Date.Time)
data14$Year <- factor(year(data14$Date.Time))
data14$Month <- factor(month(data14$Date.Time))
data14$Day <- factor(day(data14$Date.Time))
data14$Weekday <- factor(wday(data14$Date.Time))
data14$Hour <- factor(hour(data14$Date.Time))
data14$Minute <- factor(minute(data14$Date.Time))
data14$Second <- factor(second(data14$Date.Time))

Проверим первые 10 строк.

results_head <- head(data14, n=10)
knitr::kable(results_head, caption = "Table results head")
Table results head
Date.Time Lat Lon Base Year Month Day Weekday Hour Minute Second
2014-04-01 00:11:00 40.7690 -73.9549 B02512 2014 4 1 3 0 11 0
2014-04-01 00:17:00 40.7267 -74.0345 B02512 2014 4 1 3 0 17 0
2014-04-01 00:21:00 40.7316 -73.9873 B02512 2014 4 1 3 0 21 0
2014-04-01 00:28:00 40.7588 -73.9776 B02512 2014 4 1 3 0 28 0
2014-04-01 00:33:00 40.7594 -73.9722 B02512 2014 4 1 3 0 33 0
2014-04-01 00:33:00 40.7383 -74.0403 B02512 2014 4 1 3 0 33 0
2014-04-01 00:39:00 40.7223 -73.9887 B02512 2014 4 1 3 0 39 0
2014-04-01 00:45:00 40.7620 -73.9790 B02512 2014 4 1 3 0 45 0
2014-04-01 00:55:00 40.7524 -73.9960 B02512 2014 4 1 3 0 55 0
2014-04-01 01:01:00 40.7575 -73.9846 B02512 2014 4 1 3 1 1 0

Проверим последние 10 строк.

results_tail <- tail(data14, n=10)
knitr::kable(results_tail, caption = "Table results tail")
Table results tail
Date.Time Lat Lon Base Year Month Day Weekday Hour Minute Second
4534318 2014-09-30 22:56:00 40.7371 -74.0289 B02764 2014 9 30 3 22 56 0
4534319 2014-09-30 22:56:00 40.6446 -73.7823 B02764 2014 9 30 3 22 56 0
4534320 2014-09-30 22:56:00 40.7163 -73.9623 B02764 2014 9 30 3 22 56 0
4534321 2014-09-30 22:57:00 40.6979 -73.9365 B02764 2014 9 30 3 22 57 0
4534322 2014-09-30 22:57:00 40.7300 -73.9565 B02764 2014 9 30 3 22 57 0
4534323 2014-09-30 22:57:00 40.7668 -73.9845 B02764 2014 9 30 3 22 57 0
4534324 2014-09-30 22:57:00 40.6911 -74.1773 B02764 2014 9 30 3 22 57 0
4534325 2014-09-30 22:58:00 40.8519 -73.9319 B02764 2014 9 30 3 22 58 0
4534326 2014-09-30 22:58:00 40.7081 -74.0066 B02764 2014 9 30 3 22 58 0
4534327 2014-09-30 22:58:00 40.7140 -73.9496 B02764 2014 9 30 3 22 58 0

1.6 Implementation of the algorithm k-means

Реализуем алгоритм и посмотрим на результаты. Используем функцию kmeans() в R. Значение k установим на 5 - по числу районов в Нью-Йорке.

set.seed(20)
clusters <- kmeans(data14[,2:3], 5)
# save the clusters number in the dataset as column 'Borough'
data14$Borough <- as.factor(clusters$cluster)
# inspect 'clusters'
str(clusters)
## List of 9
##  $ cluster     : int [1:4534327] 2 4 4 2 2 4 4 2 4 2 ...
##  $ centers     : num [1:5, 1:2] 40.7 40.8 40.7 40.7 40.7 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$ : chr [1:5] "1" "2" "3" "4" ...
##   .. ..$ : chr [1:2] "Lat" "Lon"
##  $ totss       : num 22107
##  $ withinss    : num [1:5] 471 1650 997 719 3524
##  $ tot.withinss: num 7361
##  $ betweenss   : num 14746
##  $ size        : int [1:5] 45366 1502128 581266 2128911 276656
##  $ iter        : int 4
##  $ ifault      : int 0
##  - attr(*, "class")= chr "kmeans"

Рассмотрим список вывода функции kmeans:

  • cluster - вектор целых чисел, обозначающий кластер к которому принадлежит каждая точка;
  • centers - матрица центров кластеров;
  • withinss - вектор суммы квадратов внутри кластера, один на кластер;
  • tot.withinss - общая сумма квадратов внутри кластера;
  • size - размер кластера, количество точек в кластере.

1.7 Size: the number of points in each cluster

Для построения карты применены только первые 10 значений каждого из рассматриваемых месяцев.

library(leaflet)
library(tidyverse)
#data14_10 <- bind_rows(apr14[1:100,], may14[1:100,], jun14[1:100,], #jul14[1:100,], aug14[1:100,], sep14[1:100,])

##

library(caret)
set.seed(1)
usedata <- createDataPartition(data14$Month, p = .001,
                               list = FALSE,
                               times = 1)
head(usedata)
##      Resample1
## [1,]        40
## [2,]       860
## [3,]      2079
## [4,]      2833
## [5,]      3328
## [6,]      8101
dim(usedata)
## [1] 4538    1
data14_10 <- data14[ usedata,]
head(data14_10)
##                Date.Time     Lat      Lon   Base Year Month Day Weekday Hour
## 40   2014-04-01 05:36:00 40.7217 -73.9875 B02512 2014     4   1       3    5
## 860  2014-04-01 20:04:00 40.7146 -74.0101 B02512 2014     4   1       3   20
## 2079 2014-04-02 19:16:00 40.7235 -74.0006 B02512 2014     4   2       4   19
## 2833 2014-04-03 13:41:00 40.7243 -74.0012 B02512 2014     4   3       5   13
## 3328 2014-04-03 18:41:00 40.6946 -74.1778 B02512 2014     4   3       5   18
## 8101 2014-04-07 11:34:00 40.7346 -73.9865 B02512 2014     4   7       2   11
##      Minute Second Borough
## 40       36      0       4
## 860       4      0       4
## 2079     16      0       4
## 2833     41      0       4
## 3328     41      0       1
## 8101     34      0       4
##

my_map <- leaflet() %>% addTiles() %>% addCircleMarkers(data = data14_10, lng = ~ Lon, lat = ~ Lat, radius = 5)
my_map

Полученные кластеры сопоставляются с реальными районами. Номер кластера соответствует следующим районам:

1 Bronx

2 Manhatten

3 Brooklyn

4 Staten Island

5 Queens

library(DT)

data14$Month <- as.double(data14$Month)
month_borough_14 <- count_(data14, vars = c('Month', 'Borough'), sort = TRUE) %>% arrange(Month, Borough)
datatable(month_borough_14)

Представим полученные данные в графическом виде.

library(dplyr)
library(ggplot2)
monthly_growth <- month_borough_14 %>% 
        mutate(Date = paste("04", Month)) %>%
        ggplot(aes(Month, n, colour = Borough)) + geom_line()
monthly_growth
Fig. 2. Uber Monthly Growth - 2014

Fig. 2. Uber Monthly Growth - 2014

k-means хороший алгоритм кластеризации, однако у него есть некоторые недостатки, в том числе то что предварительно требуется указать количество кластеров (k).

2 Self Organizing Maps

2.1 Создание выборки

#apr14 <- apr14[1:100,]
#may14 <- may14[1:100,]
#jun14 <- jun14[1:100,]
#jul14 <- jul14[1:100,]
#aug14 <- aug14[1:100,]
#sep14 <- sep14[1:100,]

2.2 Преобразования набора данных

library(dplyr)
#data14 <- bind_rows(apr14, may14, jun14, jul14, aug14, sep14)

require(data.table)
require(lubridate)
# separate or mutate data/time columns
#data14$Date.Time <- mdy_hms(data14$Date.Time)
#data14$Year <- factor(year(data14$Date.Time))
#data14$Month <- factor(month(data14$Date.Time))
#data14$Day <- factor(day(data14$Date.Time))
#data14$Weekday <- factor(wday(data14$Date.Time))
#data14$Hour <- factor(hour(data14$Date.Time))
#data14$Minute <- factor(minute(data14$Date.Time))
#data14$Second <- factor(second(data14$Date.Time))

data14_10$Month <- as.double(data14_10$Month)

2.3 Отбор переменных для обучения SOM

var_name = c("Lat", "Lon", "Month")
data_train <- data14_10[, var_name]
data_train_matrix <- as.matrix(scale(data_train))

2.4 Создание проекционного экрана

Укажем для функции somgrid() создать для проекционного экрана гексагональную решетку 6х9, т.е. 4538 записей будут самоорганизовываться на 54 нейрона выходного слоя.

library(kohonen)
set.seed(123)
som_grid <- somgrid(xdim = 9, ydim = 6, topo = "hexagonal")
som_model <- som(data_train_matrix, grid = som_grid, rlen = 100,
                 alpha = c(0.05, 0.01),  keep.data = FALSE)
plot(som_model, type = "changes", main = "")
Fig. 3. Training progress

Fig. 3. Training progress

Снижение среднего расстояния до ближайших нейронов в ходе 100 итераций (rlen) обучения сети SOM при заданных значениях гипер-параметра alpha.

Задаем палитру цветов.

coolBlueHotRed <- function(n, alpha = 1) {
        rainbow(n, end = 4/6, alpha = alpha)[n:1]
}

Показывает распределение по решетке соотношений долей участия отдельных исходных переменных.

plot(som_model, type = "codes", shape = "straight", palette.name = coolBlueHotRed, main = "")
Fig. 4. Codes plot

Fig. 4. Codes plot

Покажем сумму расстояний до всех ближайших соседей. Этот вид визуализации известен как график U-матрицы. Можно ожидать, что группы вблизи границы классов будут иметь более высокие средние расстояния до своих соседей.

plot(som_model, type = "dist.neighbours", shape = "straight", palette.name = coolBlueHotRed)
Fig. 5. Shows the sum of the distances to all immediate neighbours

Fig. 5. Shows the sum of the distances to all immediate neighbours

Свойства каждой единицы могут быть расчитаны и показаны в кодовом цвете. Его можно использовать для визуализации сходства одного конкретного объекта со всеми единицами на карте, чтобы показать среднее сходство всех единиц и сопоставленных с ними объектов, и так далее.

plot(som_model, type = "property",
     shape = "straight",
     property = som_model$codes[[1]][,1],
     main = "Lat",
     palette.name = coolBlueHotRed)
Fig. 6. Properties of each unit can be calculated and shown in colour code

Fig. 6. Properties of each unit can be calculated and shown in colour code 

plot(som_model, type = "property",
     shape = "straight",
     property = som_model$codes[[1]][,2],
     main = "Lon",
     palette.name = coolBlueHotRed)
Fig. 7. Properties of each unit can be calculated and shown in colour code

Fig. 7. Properties of each unit can be calculated and shown in colour code 

plot(som_model, type = "property",
     shape = "straight",
     property = som_model$codes[[1]][,3],
     main = "Month",
     palette.name = coolBlueHotRed)
Fig. 8. Properties of each unit can be calculated and shown in colour code

Fig. 8. Properties of each unit can be calculated and shown in colour code

Выполним иерархическую классификацию. Формируем матрицу узлы - переменные. Зададимся числом кластеров - 5.

mydata <- as.matrix(som_model$codes[[1]])
som_cluster <- cutree(hclust(dist(mydata)), 5)
# определяем палитру цветов
pretty_palette <- c('#1f77b4', '#ff7f0e', '#2ca02c',
                    '#d62728', '#9467bd', '#8c564b', '#e377c2')

Показываем разными цветами кластеры узлов и переменные. Показывает распределение по решетке соотношение долей участия отдельных исходных переменных и кластеры. Отдельно выделяется Манхеттен.

plot(som_model, type = "codes",
     bgcol = pretty_palette[som_cluster])
add.cluster.boundaries(som_model, som_cluster)
Fig. 9. Кластеризация узлов карты SOM

Fig. 9. Кластеризация узлов карты SOM

Построим дендрограмму кластеров

library(cluster)
data(mydata)
d <- dist(scale(mydata), method = "euclidean")

res.hc <- hclust(d, method = "complete")
grp <- cutree(res.hc, k = 5)
plot(res.hc, cex = 0.7)
rect.hclust(res.hc, k = 5, border = 2:5)
Fig. 9. Cluster Dendrogram

Fig. 9. Cluster Dendrogram

3 Partitioning Cluster Analysis Using Fuzzy C-Means

3.1 Load the required packages

#install.packages("ppclust")
library(ppclust)
#install.packages("factoexra")
library(factoextra)
#install.packages("cluster")
library(cluster)
#install.packages("fclust")
library(fclust)

3.2 Загружаем данные

load("data14_100.rda")

Создаем выборку для анализа, выбирая требуемые столбцы.

var_name = c("Lat", "Lon", "Month", "Day", "Hour")
d_t <- data14_100[, var_name]
x = d_t[,-6]
head(x)
##       Lat      Lon Month Day Hour
## 1 40.7690 -73.9549     1   1    1
## 2 40.7267 -74.0345     1   1    1
## 3 40.7316 -73.9873     1   1    1
## 4 40.7588 -73.9776     1   1    1
## 5 40.7594 -73.9722     1   1    1
## 6 40.7383 -74.0403     1   1    1

Графическое представление данных.

pairs(x, col = d_t[,5])
Fig. 10. Графическое представление данных

Fig. 10. Графическое представление данных

3.3 Clustering Results

Fuzzy Membership Matrix.

##    Cluster 1 Cluster 2 Cluster 3  Cluster 4 Cluster 5
## 1 0.05170952 0.5343991 0.1096509 0.07433026 0.2299103
## 2 0.05171004 0.5344029 0.1096502 0.07433067 0.2299062
## 3 0.05170785 0.5344119 0.1096477 0.07432785 0.2299047
## 4 0.05170772 0.5344117 0.1096473 0.07432779 0.2299055
## 5 0.05170798 0.5344097 0.1096479 0.07432814 0.2299063
## 6 0.05171013 0.5344028 0.1096499 0.07433081 0.2299063

Summary of Clustering Results.

summary(res.fcm)
## Summary for 'res.fcm'
## 
## Number of data objects:  605 
## 
## Number of clusters:  5 
## 
## Crisp clustering vector:
##   [1] 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 2 2
##  [38] 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 2 2
##  [75] 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 4 4 4 4 4 4 4 4 4 4 4
## [112] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [149] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4
## [186] 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 4 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
## [223] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
## [260] 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5
## [297] 5 5 5 5 5 5 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
## [334] 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 1
## [371] 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 3 3 3 3
## [408] 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
## [445] 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
## [482] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [519] 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 1
## [556] 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 1
## [593] 1 1 1 1 1 1 1 1 1 1 1 1 1
## 
## Initial cluster prototypes:
##               Lat      Lon Month Day Hour
## Cluster 1 40.7653 -73.9529     6   3   16
## Cluster 2 40.7430 -74.0301     1   1    6
## Cluster 3 40.7145 -73.9582     5   2   11
## Cluster 4 40.6889 -73.9750     2   4   13
## Cluster 5 40.7338 -74.0061     3   5    3
## 
## Final cluster prototypes:
##                Lat       Lon    Month      Day      Hour
## Cluster 1 40.74187 -73.97560 4.888273 1.895777 16.540344
## Cluster 2 40.75014 -73.99392 1.045315 1.086497  5.989739
## Cluster 3 40.73680 -73.96883 4.956495 2.062820 11.228023
## Cluster 4 40.74879 -73.97893 2.064826 3.981010 14.002382
## Cluster 5 40.75192 -73.98311 2.968207 4.924955  7.214306
## 
## Distance between the final cluster prototypes
##           Cluster 1 Cluster 2 Cluster 3 Cluster 4
## Cluster 2 126.73893                              
## Cluster 3  28.25338  43.69096                    
## Cluster 4  18.76136  73.62027  19.73851          
## Cluster 5  99.83772  19.93096  28.25547  47.78513
## 
## Difference between the initial and final cluster prototypes
##                    Lat          Lon       Month         Day        Hour
## Cluster 1 -0.023432708 -0.022701833 -1.11172725 -1.10422282  0.54034433
## Cluster 2  0.007140463  0.036177072  0.04531513  0.08649703 -0.01026062
## Cluster 3  0.022299287 -0.010631781 -0.04350483  0.06281962  0.22802318
## Cluster 4  0.059888453 -0.003930027  0.06482633 -0.01899033  1.00238164
## Cluster 5  0.018115039  0.022992639 -0.03179320 -0.07504487  4.21430599
## 
## Root Mean Squared Deviations (RMSD): 2.07839 
## Mean Absolute Deviation (MAD): 8.867366 
## 
## Membership degrees matrix (top and bottom 5 rows): 
##    Cluster 1 Cluster 2 Cluster 3  Cluster 4 Cluster 5
## 1 0.05170952 0.5343991 0.1096509 0.07433026 0.2299103
## 2 0.05171004 0.5344029 0.1096502 0.07433067 0.2299062
## 3 0.05170785 0.5344119 0.1096477 0.07432785 0.2299047
## 4 0.05170772 0.5344117 0.1096473 0.07432779 0.2299055
## 5 0.05170798 0.5344097 0.1096479 0.07432814 0.2299063
## ...
##     Cluster 1  Cluster 2  Cluster 3 Cluster 4  Cluster 5
## 601 0.7707460 0.01649451 0.08561517 0.1036318 0.02351254
## 602 0.7707927 0.01649059 0.08559843 0.1036111 0.02350711
## 603 0.7707415 0.01649486 0.08561828 0.1036323 0.02351301
## 604 0.7706081 0.01650551 0.08567128 0.1036871 0.02352803
## 605 0.7707787 0.01649160 0.08560506 0.1036160 0.02350859
## 
## Descriptive statistics for the membership degrees by clusters
##           Size       Min        Q1      Mean    Median        Q3       Max
## Cluster 1  202 0.7682276 0.7707653 0.8146955 0.8133666 0.8588385 0.8588770
## Cluster 2  100 0.5343991 0.9004048 0.8665370 0.9007504 0.9291820 0.9991059
## Cluster 3  101 0.9087472 0.9141627 0.9706944 0.9916415 0.9918348 0.9919547
## Cluster 4  101 0.8689390 0.9988553 0.9787087 0.9992447 0.9993215 0.9993747
## Cluster 5  101 0.4253967 0.4257818 0.6844500 0.6844563 0.9234117 0.9941552
## 
## Dunn's Fuzziness Coefficients:
## dunn_coeff normalized 
##  0.7676585  0.7095732 
## 
## Within cluster sum of squares by cluster:
##         1         2         3         4         5 
## 454.98345 381.03716  20.14280  17.13422 499.68221 
## (between_SS / total_SS =  90.51%) 
## 
## Available components: 
##  [1] "u"          "v"          "v0"         "d"          "x"         
##  [6] "cluster"    "csize"      "sumsqrs"    "k"          "m"         
## [11] "iter"       "best.start" "func.val"   "comp.time"  "inpargs"   
## [16] "algorithm"  "call"

The objective function values

res.fcm$func.val
## [1] 924.888
res.fcm$comp.time
## [1] 5.647

3.4 Visualization of the clustering results

Pairwise Scatter Plots.

plotcluster(res.fcm, cp=1, trans=TRUE)
Fig. 11. Pairwise scatter plots

Fig. 11. Pairwise scatter plots

3.5 Cluster Plot with clusplot

res.fcm3 <- ppclust2(res.fcm, "fanny")

cluster::clusplot(scale(x), res.fcm3$cluster,  
                  main = "Cluster plot of Iris data set",
                  color=TRUE, labels = 2, lines = 2, cex=1)

3.6 Validation of the clustering results

res.fcm4 <- ppclust2(res.fcm, "fclust")
idxsf <- SIL.F(res.fcm4$Xca, res.fcm4$U, alpha=1)
idxpe <- PE(res.fcm4$U)
idxpc <- PC(res.fcm4$U)
idxmpc <- MPC(res.fcm4$U)

Partition Entropy.

cat("Partition Entropy: ", idxpe)
## Partition Entropy:  0.4973424

Partition Coefficient.

cat("Partition Coefficient: ", idxpc)
## Partition Coefficient:  0.7676585

Modified Partition Coefficient.

cat("Modified Partition Coefficient: ", idxmpc)
## Modified Partition Coefficient:  0.7095732

Fuzzy Silhouette Index.

cat("Fuzzy Silhouette Index: ", idxsf)
## Fuzzy Silhouette Index:  0.852364