library(igraph)
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
library(igraphdata)
## Warning: package 'igraphdata' was built under R version 4.4.3
library(knitr)
data("karate")
karate <- upgrade_graph(karate)
edges <- as_data_frame(karate)
head(edges)
## from to weight
## 1 Mr Hi Actor 2 4
## 2 Mr Hi Actor 3 5
## 3 Mr Hi Actor 4 3
## 4 Mr Hi Actor 5 3
## 5 Mr Hi Actor 6 3
## 6 Mr Hi Actor 7 3
summary(edges)
## from to weight
## Length:78 Length:78 Min. :1.000
## Class :character Class :character 1st Qu.:2.000
## Mode :character Mode :character Median :3.000
## Mean :2.962
## 3rd Qu.:4.000
## Max. :7.000
summary(edges$weight)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 2.962 4.000 7.000
edges
## from to weight
## 1 Mr Hi Actor 2 4
## 2 Mr Hi Actor 3 5
## 3 Mr Hi Actor 4 3
## 4 Mr Hi Actor 5 3
## 5 Mr Hi Actor 6 3
## 6 Mr Hi Actor 7 3
## 7 Mr Hi Actor 8 2
## 8 Mr Hi Actor 9 2
## 9 Mr Hi Actor 11 2
## 10 Mr Hi Actor 12 3
## 11 Mr Hi Actor 13 1
## 12 Mr Hi Actor 14 3
## 13 Mr Hi Actor 18 2
## 14 Mr Hi Actor 20 2
## 15 Mr Hi Actor 22 2
## 16 Mr Hi Actor 32 2
## 17 Actor 2 Actor 3 6
## 18 Actor 2 Actor 4 3
## 19 Actor 2 Actor 8 4
## 20 Actor 2 Actor 14 5
## 21 Actor 2 Actor 18 1
## 22 Actor 2 Actor 20 2
## 23 Actor 2 Actor 22 2
## 24 Actor 2 Actor 31 2
## 25 Actor 3 Actor 4 3
## 26 Actor 3 Actor 8 4
## 27 Actor 3 Actor 9 5
## 28 Actor 3 Actor 10 1
## 29 Actor 3 Actor 14 3
## 30 Actor 3 Actor 28 2
## 31 Actor 3 Actor 29 2
## 32 Actor 3 Actor 33 2
## 33 Actor 4 Actor 8 3
## 34 Actor 4 Actor 13 3
## 35 Actor 4 Actor 14 3
## 36 Actor 5 Actor 7 2
## 37 Actor 5 Actor 11 3
## 38 Actor 6 Actor 7 5
## 39 Actor 6 Actor 11 3
## 40 Actor 6 Actor 17 3
## 41 Actor 7 Actor 17 3
## 42 Actor 9 Actor 31 3
## 43 Actor 9 Actor 33 3
## 44 Actor 9 John A 4
## 45 Actor 10 John A 2
## 46 Actor 14 John A 3
## 47 Actor 15 Actor 33 3
## 48 Actor 15 John A 2
## 49 Actor 16 Actor 33 3
## 50 Actor 16 John A 4
## 51 Actor 19 Actor 33 1
## 52 Actor 19 John A 2
## 53 Actor 20 John A 1
## 54 Actor 21 Actor 33 3
## 55 Actor 21 John A 1
## 56 Actor 23 Actor 33 2
## 57 Actor 23 John A 3
## 58 Actor 24 Actor 26 5
## 59 Actor 24 Actor 28 4
## 60 Actor 24 Actor 30 3
## 61 Actor 24 Actor 33 5
## 62 Actor 24 John A 4
## 63 Actor 25 Actor 26 2
## 64 Actor 25 Actor 28 3
## 65 Actor 25 Actor 32 2
## 66 Actor 26 Actor 32 7
## 67 Actor 27 Actor 30 4
## 68 Actor 27 John A 2
## 69 Actor 28 John A 4
## 70 Actor 29 Actor 32 2
## 71 Actor 29 John A 2
## 72 Actor 30 Actor 33 4
## 73 Actor 30 John A 2
## 74 Actor 31 Actor 33 3
## 75 Actor 31 John A 3
## 76 Actor 32 Actor 33 4
## 77 Actor 32 John A 4
## 78 Actor 33 John A 5
###### Pake fungi igraph #######
set.seed(6)
lv <- cluster_louvain(karate, weights = edges$weight, resolution = 1)
mem_igraph <- lv$memberships[nrow(lv$memberships), ]
mem <- lv$memberships
modularity(karate, mem[1, ], weights = E(karate)$weight)
## [1] 0.3993366
fase1 <- data.frame(node = V(karate)$name, komunitas = mem[1, ])
fase_1 <- data.frame(komunitas = sort(unique(mem[1, ])),
jumlah = as.integer(table(mem[1, ])))
fase_1
## komunitas jumlah
## 1 1 11
## 2 2 2
## 3 3 3
## 4 4 10
## 5 5 2
## 6 6 4
## 7 7 2
fase_2 <- data.frame(komunitas = sort(unique(mem[2, ])),
jumlah = as.integer(table(mem[2, ])))
fase_2
## komunitas jumlah
## 1 1 11
## 2 2 5
## 3 3 12
## 4 4 6
modularity(karate, mem[2, ], weights = E(karate)$weight)
## [1] 0.4449036
lv$memberships
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,] 1 1 1 1 2 3 3 1 4 4 2 1 1 1
## [2,] 1 1 1 1 2 2 2 1 3 3 2 1 1 1
## [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [,25] [,26]
## [1,] 4 4 3 1 4 1 4 1 4 5 6 6
## [2,] 3 3 2 1 3 1 3 1 3 4 4 4
## [,27] [,28] [,29] [,30] [,31] [,32] [,33] [,34]
## [1,] 7 5 6 7 4 6 4 4
## [2,] 3 4 4 3 3 4 3 3
lv$modularity
## [1] 0.3993366 0.4449036
###### Plot #######
set.seed(6)
plot(lv, karate, vertex.size = 8, vertex.label.cex = 0.6,
main = "Clustering dengan Algoritma Louvain")
###### Ekperimen mengganti parameter #######
resolusi <- c(0.19, 0.20, 0.5, 0.75, 1, 1.25, 1.5)
hasil_eksperimen <- data.frame()
for (r in resolusi) {
set.seed(6)
lv <- cluster_louvain(karate, weights = E(karate)$weight, resolution = r)
mem <- lv$memberships[nrow(lv$memberships), ]
Q <- modularity(karate, mem, weights = E(karate)$weight, resolution = r)
hasil_eksperimen <- rbind(hasil_eksperimen,
data.frame(Resolution = r,
Jumlah_Klaster = length(unique(mem)),
Modularitas = Q))
}
hasil_eksperimen
## Resolution Jumlah_Klaster Modularitas
## 1 0.19 1 0.8100000
## 2 0.20 2 0.8045351
## 3 0.50 2 0.6541950
## 4 0.75 2 0.5289116
## 5 1.00 4 0.4449036
## 6 1.25 4 0.3699823
## 7 1.50 4 0.2951875
resolusi_buat_plot <- c(0.19, 0.20, 0.75, 1.5)
par(mfrow = c(2, 2))
for (r in resolusi_buat_plot) {
set.seed(6)
lv <- cluster_louvain(karate, weights = E(karate)$weight, resolution = r)
plot(lv, karate, vertex.size = 8, vertex.label.cex = 0.6,
main = paste("Louvain - Resolusi", r))
}
############################### MANUAL R #####################################
A <- as.matrix(as_adjacency_matrix(karate, attr = "weight", sparse = FALSE))
dim(A)
## [1] 34 34
A[1:5, 1:5]
## Mr Hi Actor 2 Actor 3 Actor 4 Actor 5
## Mr Hi 0 4 5 3 3
## Actor 2 4 0 6 3 0
## Actor 3 5 6 0 3 0
## Actor 4 3 3 3 0 0
## Actor 5 3 0 0 0 0
# Fungsi menghitung modularitas
modularity_manual <- function(A, community, resolution = 1) {
# Total bobot seluruh edge (2m)
two_m <- sum(A)
# Weighted degree setiap vertex
degree <- rowSums(A)
# Mengambil komunitas
communities <- unique(community)
# Inisialisasi modularitas
Q <- 0
for (c in communities) {
# Mengambil indeks vertex dalam komunitas
idx <- which(community == c)
# Menghitung bobot edge internal
internal <- sum(A[idx, idx, drop = FALSE])
# Menghitung total weighted degree komunitas
total_degree <- sum(degree[idx])
# Menghitung modularitas
Q <- Q + (internal / two_m) - resolution * (total_degree / two_m)^2
}
return(Q)
}
# STEP 1: LOCAL MOVING
local_moving <- function(A, resolution = 1, max_iter = 100, tol = 1e-12) {
n <- nrow(A)
# Setiap vertex menjadi komunitas tersendiri
community <- seq_len(n)
# Menghitung weighted degree
degree <- rowSums(A)
# Total bobot edge
m <- sum(A) / 2
# Iterasi
for (iter in seq_len(max_iter)) {
berubah <- FALSE
# Mengacak urutan vertex
urutan <- sample.int(n)
for (i in urutan) {
# Komunitas asal
asal <- community[i]
# Mencari tetangga vertex
tetangga <- which(A[i, ] > 0)
tetangga <- setdiff(tetangga, i)
# Kandidat komunitas tetangga
kandidat <- unique(community[tetangga])
# Menghitung weighted degree komunitas asal
idx_asal <- which(community == asal)
d_asal <- sum(degree[idx_asal])
# Bobot hubungan vertex dengan komunitas asal
k_asal <- sum(A[i, setdiff(idx_asal, i)])
# Inisialisasi perpindahan terbaik
gain_terbaik <- 0
komunitas_terbaik <- asal
# Menguji setiap komunitas tetangga
for (c in setdiff(kandidat, asal)) {
# Indeks anggota komunitas tujuan
idx_tujuan <- which(community == c)
# Weighted degree komunitas tujuan
d_tujuan <- sum(degree[idx_tujuan])
# Bobot hubungan vertex dengan komunitas tujuan
k_tujuan <- sum(A[i, idx_tujuan])
# Menghitung perubahan modularitas
delta_Q <- (k_tujuan - k_asal) / m - resolution * degree[i] *
(d_tujuan - d_asal + degree[i]) / (2 * m^2)
# Memilih perpindahan dengan gain terbesar
if (delta_Q > gain_terbaik + tol) {
gain_terbaik <- delta_Q
komunitas_terbaik <- c
}
}
# Memperbarui komunitas
if (komunitas_terbaik != asal) {
community[i] <- komunitas_terbaik
berubah <- TRUE
}
}
# Menyederhanakan nomor komunitas
community <- match(community, unique(community))
# Berhenti jika tidak ada perubahan
if (!berubah) {
break
}
}
return(community)
}
# Menjalankan Step 1
set.seed(2)
komunitas_step1 <- local_moving(A)
# Melihat hasil komunitas
table(komunitas_step1)
## komunitas_step1
## 1 2 3 4 5 6 7 8
## 5 6 2 3 10 2 4 2
# Menghitung modularitas
modularity_manual(A, komunitas_step1)
## [1] 0.3606567
# STEP 2: COMMUNITY AGGREGATION
aggregate_community <- function(A, community) {
# Mengambil komunitas yang terbentuk
communities <- sort(unique(community))
# Jumlah komunitas
k <- length(communities)
# Membuat matriks adjacency baru
A_new <- matrix(0, nrow = k, ncol = k)
# Menggabungkan hubungan antarvertex
for (i in seq_len(nrow(A))) {
for (j in seq_len(ncol(A))) {
ci <- community[i]
cj <- community[j]
A_new[ci, cj] <- A_new[ci, cj] + A[i, j]
}
}
# Memberikan nama supernode
rownames(A_new) <- paste0("C", seq_len(k))
colnames(A_new) <- paste0("C", seq_len(k))
return(A_new)
}
# Menggabungkan komunitas hasil Step 1
A_step2 <- aggregate_community(A, komunitas_step1)
A_step2
## C1 C2 C3 C4 C5 C6 C7 C8
## C1 18 23 5 6 3 0 2 0
## C2 23 74 0 0 13 2 2 0
## C3 5 0 6 5 0 0 0 0
## C4 6 0 5 22 0 0 0 0
## C5 3 13 0 0 94 13 10 8
## C6 0 2 0 0 13 8 8 3
## C7 2 2 0 0 10 8 26 0
## C8 0 0 0 0 8 3 0 8
dim(A_step2)
## [1] 8 8
# Fungsi utama Louvain manual
louvain_manual <- function(A, resolution = 1, max_iter = 100, max_levels = 20) {
A_original <- A
n_original <- nrow(A)
# Menyimpan anggota asli setiap vertex
members <- as.list(seq_len(n_original))
# Menyimpan hasil setiap level
memberships <- list()
modularities <- numeric()
# Proses Louvain bertingkat
for (level in seq_len(max_levels)) {
# STEP 1: Local Moving
community <- local_moving(A, resolution, max_iter)
# Jumlah komunitas
k <- length(unique(community))
# Menyimpan anggota asli setiap komunitas
new_members <- lapply(seq_len(k), function(c) {
unlist(members[which(community == c)],use.names = FALSE)
}
)
# Mengembalikan keanggotaan ke vertex awal
mem_original <- integer(n_original)
for (c in seq_len(k)) {
mem_original[new_members[[c]]] <- c
}
memberships[[level]] <- mem_original
# Menghitung modularitas pada graf awal
modularities[level] <- modularity_manual(A_original, mem_original, resolution)
# Berhenti jika tidak ada penggabungan
if (k == nrow(A)) {
break
}
# STEP 2: Community Aggregation
A <- aggregate_community(A, community)
# Memperbarui anggota supernode
members <- new_members
}
# Menggabungkan membership setiap level
membership_matrix <- do.call(rbind, memberships)
rownames(membership_matrix) <- paste0("Level_", seq_along(memberships))
colnames(membership_matrix) <- rownames(A_original)
return(list(
memberships = membership_matrix,
modularity = modularities,
levels = length(memberships)
))
}
set.seed(2)
hasil_manual <- louvain_manual(A, resolution = 1)
hasil_manual$memberships
## Mr Hi Actor 2 Actor 3 Actor 4 Actor 5 Actor 6 Actor 7 Actor 8 Actor 9
## Level_1 1 2 2 2 3 4 4 2 5
## Level_2 1 1 1 1 2 2 2 1 3
## Level_3 1 1 1 1 2 2 2 1 3
## Actor 10 Actor 11 Actor 12 Actor 13 Actor 14 Actor 15 Actor 16 Actor 17
## Level_1 5 3 1 2 2 5 5 4
## Level_2 3 2 1 1 1 3 3 2
## Level_3 3 2 1 1 1 3 3 2
## Actor 18 Actor 19 Actor 20 Actor 21 Actor 22 Actor 23 Actor 24 Actor 25
## Level_1 1 5 1 5 1 5 6 7
## Level_2 1 3 1 3 1 3 4 4
## Level_3 1 3 1 3 1 3 4 4
## Actor 26 Actor 27 Actor 28 Actor 29 Actor 30 Actor 31 Actor 32 Actor 33
## Level_1 7 8 6 7 8 5 7 5
## Level_2 4 3 4 4 3 3 4 3
## Level_3 4 3 4 4 3 3 4 3
## John A
## Level_1 5
## Level_2 3
## Level_3 3
hasil_manual$modularity
## [1] 0.3606567 0.4449036 0.4449036
hasil_manual$levels
## [1] 3
mem <- hasil_manual$memberships
mem_manual <- hasil_manual$memberships[nrow(hasil_manual$memberships), ]
for (i in seq_len(nrow(mem))) {
cat("\nLEVEL", i, "\n")
hasil <- data.frame(
Node = V(karate)$name,
Komunitas = mem[i, ]
)
print(kable(hasil))
# Jumlah anggota setiap komunitas
ringkasan <- data.frame(
Komunitas = sort(unique(mem[i, ])),
Jumlah = as.integer(table(mem[i, ]))
)
print(kable(ringkasan))
# Modularitas
cat(
"Modularitas:",
hasil_manual$modularity[i],
"\n"
)
}
##
## LEVEL 1
##
##
## | |Node | Komunitas|
## |:--------|:--------|---------:|
## |Mr Hi |Mr Hi | 1|
## |Actor 2 |Actor 2 | 2|
## |Actor 3 |Actor 3 | 2|
## |Actor 4 |Actor 4 | 2|
## |Actor 5 |Actor 5 | 3|
## |Actor 6 |Actor 6 | 4|
## |Actor 7 |Actor 7 | 4|
## |Actor 8 |Actor 8 | 2|
## |Actor 9 |Actor 9 | 5|
## |Actor 10 |Actor 10 | 5|
## |Actor 11 |Actor 11 | 3|
## |Actor 12 |Actor 12 | 1|
## |Actor 13 |Actor 13 | 2|
## |Actor 14 |Actor 14 | 2|
## |Actor 15 |Actor 15 | 5|
## |Actor 16 |Actor 16 | 5|
## |Actor 17 |Actor 17 | 4|
## |Actor 18 |Actor 18 | 1|
## |Actor 19 |Actor 19 | 5|
## |Actor 20 |Actor 20 | 1|
## |Actor 21 |Actor 21 | 5|
## |Actor 22 |Actor 22 | 1|
## |Actor 23 |Actor 23 | 5|
## |Actor 24 |Actor 24 | 6|
## |Actor 25 |Actor 25 | 7|
## |Actor 26 |Actor 26 | 7|
## |Actor 27 |Actor 27 | 8|
## |Actor 28 |Actor 28 | 6|
## |Actor 29 |Actor 29 | 7|
## |Actor 30 |Actor 30 | 8|
## |Actor 31 |Actor 31 | 5|
## |Actor 32 |Actor 32 | 7|
## |Actor 33 |Actor 33 | 5|
## |John A |John A | 5|
##
##
## | Komunitas| Jumlah|
## |---------:|------:|
## | 1| 5|
## | 2| 6|
## | 3| 2|
## | 4| 3|
## | 5| 10|
## | 6| 2|
## | 7| 4|
## | 8| 2|
## Modularitas: 0.3606567
##
## LEVEL 2
##
##
## | |Node | Komunitas|
## |:--------|:--------|---------:|
## |Mr Hi |Mr Hi | 1|
## |Actor 2 |Actor 2 | 1|
## |Actor 3 |Actor 3 | 1|
## |Actor 4 |Actor 4 | 1|
## |Actor 5 |Actor 5 | 2|
## |Actor 6 |Actor 6 | 2|
## |Actor 7 |Actor 7 | 2|
## |Actor 8 |Actor 8 | 1|
## |Actor 9 |Actor 9 | 3|
## |Actor 10 |Actor 10 | 3|
## |Actor 11 |Actor 11 | 2|
## |Actor 12 |Actor 12 | 1|
## |Actor 13 |Actor 13 | 1|
## |Actor 14 |Actor 14 | 1|
## |Actor 15 |Actor 15 | 3|
## |Actor 16 |Actor 16 | 3|
## |Actor 17 |Actor 17 | 2|
## |Actor 18 |Actor 18 | 1|
## |Actor 19 |Actor 19 | 3|
## |Actor 20 |Actor 20 | 1|
## |Actor 21 |Actor 21 | 3|
## |Actor 22 |Actor 22 | 1|
## |Actor 23 |Actor 23 | 3|
## |Actor 24 |Actor 24 | 4|
## |Actor 25 |Actor 25 | 4|
## |Actor 26 |Actor 26 | 4|
## |Actor 27 |Actor 27 | 3|
## |Actor 28 |Actor 28 | 4|
## |Actor 29 |Actor 29 | 4|
## |Actor 30 |Actor 30 | 3|
## |Actor 31 |Actor 31 | 3|
## |Actor 32 |Actor 32 | 4|
## |Actor 33 |Actor 33 | 3|
## |John A |John A | 3|
##
##
## | Komunitas| Jumlah|
## |---------:|------:|
## | 1| 11|
## | 2| 5|
## | 3| 12|
## | 4| 6|
## Modularitas: 0.4449036
##
## LEVEL 3
##
##
## | |Node | Komunitas|
## |:--------|:--------|---------:|
## |Mr Hi |Mr Hi | 1|
## |Actor 2 |Actor 2 | 1|
## |Actor 3 |Actor 3 | 1|
## |Actor 4 |Actor 4 | 1|
## |Actor 5 |Actor 5 | 2|
## |Actor 6 |Actor 6 | 2|
## |Actor 7 |Actor 7 | 2|
## |Actor 8 |Actor 8 | 1|
## |Actor 9 |Actor 9 | 3|
## |Actor 10 |Actor 10 | 3|
## |Actor 11 |Actor 11 | 2|
## |Actor 12 |Actor 12 | 1|
## |Actor 13 |Actor 13 | 1|
## |Actor 14 |Actor 14 | 1|
## |Actor 15 |Actor 15 | 3|
## |Actor 16 |Actor 16 | 3|
## |Actor 17 |Actor 17 | 2|
## |Actor 18 |Actor 18 | 1|
## |Actor 19 |Actor 19 | 3|
## |Actor 20 |Actor 20 | 1|
## |Actor 21 |Actor 21 | 3|
## |Actor 22 |Actor 22 | 1|
## |Actor 23 |Actor 23 | 3|
## |Actor 24 |Actor 24 | 4|
## |Actor 25 |Actor 25 | 4|
## |Actor 26 |Actor 26 | 4|
## |Actor 27 |Actor 27 | 3|
## |Actor 28 |Actor 28 | 4|
## |Actor 29 |Actor 29 | 4|
## |Actor 30 |Actor 30 | 3|
## |Actor 31 |Actor 31 | 3|
## |Actor 32 |Actor 32 | 4|
## |Actor 33 |Actor 33 | 3|
## |John A |John A | 3|
##
##
## | Komunitas| Jumlah|
## |---------:|------:|
## | 1| 11|
## | 2| 5|
## | 3| 12|
## | 4| 6|
## Modularitas: 0.4449036
# Membandingkan hasil
perbandingan <- data.frame(
Metode = c("Louvain igraph", "Louvain Manual"),
Jumlah_Klaster = c(
length(unique(mem_igraph)),
length(unique(mem_manual))
),
Modularitas = c(
modularity(
karate,
mem_igraph,
weights = E(karate)$weight
),
hasil_manual$modularity[
length(hasil_manual$modularity)
]
)
)
kable(perbandingan)
| Louvain igraph |
4 |
0.4449036 |
| Louvain Manual |
4 |
0.4449036 |
par(mfrow = c(1, 1))
set.seed(2)
komunitas_manual <- make_clusters(membership = mem_manual, graph = karate)
plot(komunitas_manual, karate, vertex.size = 8, vertex.label.cex = 0.6,
main = "Clustering dengan Algoritma Louvain Manual")
