MCS_clustering
2024-11-14
library(tidyverse)
library(mgsub)
library(psych)
library(reshape2)
library(ggplot2)
library(glasso)
library(qgraph)
library(MPsychoR)
library(smacof)
library(mclust)
library(igraph)
library(cluster)Data prep
MCS4_parent_cm_iv <- read.table("mcs4_parent_cm_interview.tab", sep="\t", header=TRUE)
#selecting SDQ items
SDQ_items <- MCS4_parent_cm_iv %>% select(DPSDPF00, DPSDRO00, DPSDHS00, DPSDSR00, DPSDTT00, DPSDSP00, DPSDOR00, DPSDMW00, DPSDHU00, DPSDFS00, DPSDGF00, DPSDFB00, DPSDUD00, DPSDLC00, DPSDDC00, DPSDNC00, DPSDKY00, DPSDOA00, DPSDPB00, DPSDVH00, DPSDST00, DPSDCS00, DPSDGB00, DPSDFE00, DPSDTE00) %>% mutate(NUM = row_number())
vars_to_recode <- c("DPSDPF00", "DPSDRO00", "DPSDHS00", "DPSDSR00", "DPSDTT00", "DPSDSP00", "DPSDOR00", "DPSDMW00", "DPSDHU00", "DPSDFS00", "DPSDGF00", "DPSDFB00", "DPSDUD00", "DPSDLC00", "DPSDDC00", "DPSDNC00", "DPSDKY00", "DPSDOA00", "DPSDPB00", "DPSDVH00", "DPSDST00", "DPSDCS00", "DPSDGB00", "DPSDFE00", "DPSDTE00")
SDQ_items2 <- SDQ_items %>%
mutate_at(vars(vars_to_recode), ~ case_when(
. == 3 ~ 2,
. == 2 ~ 1,
. == 1 ~ 0,
. == -1 ~ NA_integer_,
FALSE ~ .
))
#0 is not true, 1 is somewhat true, 2 is certainly true, other coding values removed for simplicity
#crude NA omission
SDQ_items2 <- na.omit(SDQ_items2)
table(SDQ_items2$DPSDSP00)#recoding reverse coded variables
SDQ_items2 <- SDQ_items2 %>% mutate(DPSDOR00 = 2 - DPSDOR00,DPSDGF00 = 2 -DPSDGF00, DPSDLC00 = 2 - DPSDLC00, DPSDST00 = 2 - DPSDST00, DPSDTE00 = 2 - DPSDTE00)
#examining individual subscales
Emotional <- SDQ_items2 %>% select(NUM, DPSDHS00,DPSDMW00,DPSDUD00, DPSDNC00, DPSDFE00)
colnames(Emotional) <- c("NUM", "Em1","Em2","Em3", "Em4", "Em5")
Conduct <- SDQ_items2 %>% select(NUM, DPSDTT00, DPSDOR00, DPSDFB00, DPSDOA00, DPSDCS00)
colnames(Conduct) <- c("NUM", "C1","C2","C3", "C4", "C5")
Hyper <- SDQ_items2 %>% select(NUM, DPSDRO00, DPSDFS00, DPSDDC00, DPSDST00, DPSDTE00)
colnames(Hyper) <- c("NUM", "H1","H2","H3", "H4", "H5")
Peer <- SDQ_items2 %>% select(NUM, DPSDSP00, DPSDGF00, DPSDLC00, DPSDPB00, DPSDGB00)
colnames(Peer) <- c("NUM", "P1","P2","P3", "P4", "P5")
Prosocial <- SDQ_items2 %>% select(NUM, DPSDPF00, DPSDSR00, DPSDHU00, DPSDKY00, DPSDVH00)
colnames(Prosocial) <- c("NUM", "Pr1","Pr2","Pr3", "Pr4", "Pr5")
#resulting dataset with prosocial removed and reverse-coded variables recoded
SDQ_nosocial <- Emotional %>% inner_join(Conduct, by = "NUM") %>% inner_join(Hyper, by = "NUM") %>% inner_join(Peer, by = "NUM")#Building graphs MDP and Glasso
#Shepard graphs for SDQ with prosocial removed
SDQ_nosocial <- SDQ_nosocial %>% select(-NUM)
SDQ_zeroorder <- cor(SDQ_nosocial)
dissimilarity_SDQ <- sim2diss(SDQ_zeroorder)
SDQ_MDS <- mds(dissimilarity_SDQ)
head(round(SDQ_MDS$conf, 2)) # top of configuration matrix
#Shepard graphs for data-driven choice of transformation
#ordinal type
SDQ_MDS_ordinal <- mds(dissimilarity_SDQ, type="ordinal")
plot(SDQ_MDS_ordinal, plot.type = "Shepard", main="Ordinal")
text(1.1,0.3, paste("Stress =", round(SDQ_MDS_ordinal$stress,2)))
#ratio type
SDQ_MDS_ratio <- mds(dissimilarity_SDQ, type="ratio")
plot(SDQ_MDS_ratio, plot.type = "Shepard", main="Ratio")
text(1.1,0.3, paste("Stress =", round(SDQ_MDS_ratio$stress,2)))
#interval type
SDQ_MDS_interval <- mds(dissimilarity_SDQ, type="interval")
plot(SDQ_MDS_interval, plot.type = "Shepard", main="Interval")
text(1.1,0.3, paste("Stress =", round(SDQ_MDS_interval$stress,2)))
#spline type
SDQ_MDS_mspline <- mds(dissimilarity_SDQ, type="mspline")
plot(SDQ_MDS_mspline, plot.type = "Shepard", main="Spline")
text(1.1,0.3, paste("Stress =", round(SDQ_MDS_mspline$stress,2)))
network <- qgraph(SDQ_zeroorder, layout=SDQ_MDS_mspline$conf)
#MDP graph
qgraph(SDQ_zeroorder,
layout=SDQ_MDS_mspline$conf,
groups = list("Emotion Symptoms" = c(1,2,3,4,5),
"Conduct problems" = c(6,7,8,9,10),
"Hyperactivity" = c(11,12,13,14,15),
"Peer Problems" = c(16,17,18,19,20)),
color = c("lightblue", "red", "orange", "lightgreen"),
vsize=4)
text(-1,-1, paste("Stress=", round(SDQ_MDS_mspline$stress,2)))
#GLASSO with MDP with "Prosocial" subscale removed (subscale not relevant)
#factor structure
SDQ_nosocial <- data.frame(lapply(SDQ_nosocial, factor))
str(SDQ_nosocial)## 'data.frame': 11096 obs. of 20 variables:
## $ Em1: Factor w/ 3 levels "0","1","2": 1 1 1 1 2 2 2 1 2 1 ...
## $ Em2: Factor w/ 3 levels "0","1","2": 1 1 1 1 2 2 2 2 2 1 ...
## $ Em3: Factor w/ 3 levels "0","1","2": 1 1 1 2 1 1 2 1 2 1 ...
## $ Em4: Factor w/ 3 levels "0","1","2": 3 1 1 1 1 1 3 2 1 1 ...
## $ Em5: Factor w/ 3 levels "0","1","2": 3 2 1 1 2 2 2 2 1 1 ...
## $ C1 : Factor w/ 3 levels "0","1","2": 2 1 1 1 2 3 3 1 3 1 ...
## $ C2 : Factor w/ 3 levels "0","1","2": 3 1 2 2 1 2 1 1 2 1 ...
## $ C3 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ C4 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 2 1 1 1 ...
## $ C5 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ H1 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 3 1 1 1 1 ...
## $ H2 : Factor w/ 3 levels "0","1","2": 2 1 1 1 1 1 1 1 1 1 ...
## $ H3 : Factor w/ 3 levels "0","1","2": 2 1 2 1 1 1 1 2 1 1 ...
## $ H4 : Factor w/ 3 levels "0","1","2": 2 1 3 2 2 1 2 2 2 2 ...
## $ H5 : Factor w/ 3 levels "0","1","2": 1 1 2 1 1 1 1 2 1 1 ...
## $ P1 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 2 1 1 1 1 ...
## $ P2 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ P3 : Factor w/ 3 levels "0","1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ P4 : Factor w/ 3 levels "0","1","2": 2 1 1 1 1 1 2 1 1 1 ...
## $ P5 : Factor w/ 3 levels "0","1","2": 2 1 1 1 1 1 1 1 1 1 ...#polychoric corrs
SDQpolycor <- SDQ_nosocial %>% polychoric()## Converted non-numeric input to numericprint(SDQpolycor$rho)## [,1] [,2] [,3] [,4] [,5] [,6] [,7]
## [1,] 1.00000000 0.3934303 0.3897660 0.2574288 0.3040366 0.3102763 0.1300720
## [2,] 0.39343034 1.0000000 0.6072001 0.4213675 0.5760887 0.3295523 0.1787622
## [3,] 0.38976595 0.6072001 1.0000000 0.3731459 0.4813411 0.3909708 0.2411926
## [4,] 0.25742882 0.4213675 0.3731459 1.0000000 0.5122809 0.2711691 0.1235727
## [5,] 0.30403659 0.5760887 0.4813411 0.5122809 1.0000000 0.2887240 0.1420828
## [6,] 0.31027630 0.3295523 0.3909708 0.2711691 0.2887240 1.0000000 0.4856829
## [7,] 0.13007201 0.1787622 0.2411926 0.1235727 0.1420828 0.4856829 1.0000000
## [8,] 0.25464472 0.3452667 0.4982120 0.2411044 0.2754271 0.5134336 0.4795539
## [9,] 0.23890714 0.2860763 0.3670935 0.2233412 0.2704389 0.4603933 0.3988229
## [10,] 0.24306650 0.3089459 0.3876411 0.1724931 0.2504294 0.3846612 0.3569309
## [11,] 0.22138417 0.2411192 0.3060602 0.2042286 0.2442576 0.5140401 0.4464303
## [12,] 0.24865758 0.2725519 0.3371010 0.2257118 0.2652147 0.4207969 0.3724799
## [13,] 0.18914831 0.2662774 0.3114843 0.2516571 0.2781305 0.4110046 0.4053363
## [14,] 0.07954482 0.1265722 0.1518865 0.1289560 0.1240272 0.3057920 0.4241183
## [15,] 0.12837584 0.1782162 0.2128078 0.1830841 0.1902882 0.3289397 0.4538482
## [16,] 0.22960780 0.3429349 0.3596426 0.3163839 0.2988316 0.2060221 0.1070179
## [17,] 0.15422198 0.2479390 0.2755380 0.1282838 0.1759934 0.1836786 0.2984558
## [18,] 0.16844550 0.3132041 0.3844474 0.2043743 0.2427557 0.3081807 0.4215879
## [19,] 0.24055152 0.3869868 0.4946856 0.2712264 0.3216195 0.2610804 0.1797936
## [20,] 0.21020571 0.2953613 0.3550587 0.2327926 0.3195224 0.2500511 0.1752865
## [,8] [,9] [,10] [,11] [,12] [,13] [,14]
## [1,] 0.2546447 0.2389071 0.2430665 0.2213842 0.2486576 0.1891483 0.07954482
## [2,] 0.3452667 0.2860763 0.3089459 0.2411192 0.2725519 0.2662774 0.12657216
## [3,] 0.4982120 0.3670935 0.3876411 0.3060602 0.3371010 0.3114843 0.15188654
## [4,] 0.2411044 0.2233412 0.1724931 0.2042286 0.2257118 0.2516571 0.12895602
## [5,] 0.2754271 0.2704389 0.2504294 0.2442576 0.2652147 0.2781305 0.12402722
## [6,] 0.5134336 0.4603933 0.3846612 0.5140401 0.4207969 0.4110046 0.30579201
## [7,] 0.4795539 0.3988229 0.3569309 0.4464303 0.3724799 0.4053363 0.42411826
## [8,] 1.0000000 0.5623113 0.5315567 0.4887851 0.4752049 0.4702505 0.35544143
## [9,] 0.5623113 1.0000000 0.5958248 0.4000900 0.3950417 0.4202036 0.32006531
## [10,] 0.5315567 0.5958248 1.0000000 0.3747609 0.3801609 0.3651339 0.26829951
## [11,] 0.4887851 0.4000900 0.3747609 1.0000000 0.7465636 0.6214976 0.37628122
## [12,] 0.4752049 0.3950417 0.3801609 0.7465636 1.0000000 0.5962642 0.36268409
## [13,] 0.4702505 0.4202036 0.3651339 0.6214976 0.5962642 1.0000000 0.47031154
## [14,] 0.3554414 0.3200653 0.2682995 0.3762812 0.3626841 0.4703115 1.00000000
## [15,] 0.3765174 0.3162951 0.2932393 0.4887582 0.4511440 0.7067252 0.55093426
## [16,] 0.2973865 0.1814713 0.2256658 0.2247641 0.2293876 0.2547604 0.09075433
## [17,] 0.2911567 0.1639511 0.2409975 0.2047182 0.1972979 0.2059296 0.25666189
## [18,] 0.4531836 0.2797829 0.3363608 0.3069642 0.2835883 0.2984434 0.32770061
## [19,] 0.4421434 0.2942450 0.3358555 0.2585991 0.2744463 0.3002487 0.13856856
## [20,] 0.3672740 0.2377929 0.2767601 0.3060556 0.2728284 0.2704825 0.08707378
## [,15] [,16] [,17] [,18] [,19] [,20]
## [1,] 0.1283758 0.22960780 0.1542220 0.1684455 0.2405515 0.21020571
## [2,] 0.1782162 0.34293494 0.2479390 0.3132041 0.3869868 0.29536126
## [3,] 0.2128078 0.35964257 0.2755380 0.3844474 0.4946856 0.35505868
## [4,] 0.1830841 0.31638393 0.1282838 0.2043743 0.2712264 0.23279263
## [5,] 0.1902882 0.29883160 0.1759934 0.2427557 0.3216195 0.31952244
## [6,] 0.3289397 0.20602211 0.1836786 0.3081807 0.2610804 0.25005110
## [7,] 0.4538482 0.10701792 0.2984558 0.4215879 0.1797936 0.17528647
## [8,] 0.3765174 0.29738648 0.2911567 0.4531836 0.4421434 0.36727398
## [9,] 0.3162951 0.18147129 0.1639511 0.2797829 0.2942450 0.23779286
## [10,] 0.2932393 0.22566581 0.2409975 0.3363608 0.3358555 0.27676008
## [11,] 0.4887582 0.22476408 0.2047182 0.3069642 0.2585991 0.30605564
## [12,] 0.4511440 0.22938761 0.1972979 0.2835883 0.2744463 0.27282840
## [13,] 0.7067252 0.25476035 0.2059296 0.2984434 0.3002487 0.27048251
## [14,] 0.5509343 0.09075433 0.2566619 0.3277006 0.1385686 0.08707378
## [15,] 1.0000000 0.15938479 0.2904075 0.4049916 0.2187995 0.14410840
## [16,] 0.1593848 1.00000000 0.3200649 0.3638460 0.3296845 0.43704134
## [17,] 0.2904075 0.32006493 1.0000000 0.5751620 0.3003018 0.33474373
## [18,] 0.4049916 0.36384600 0.5751620 1.0000000 0.4177611 0.35681656
## [19,] 0.2187995 0.32968446 0.3003018 0.4177611 1.0000000 0.37182647
## [20,] 0.1441084 0.43704134 0.3347437 0.3568166 0.3718265 1.00000000dim(SDQpolycor$rho)## [1] 20 20#GLASSO network
network <- EBICglasso(SDQpolycor$rho, n=11096)## Note: Network with lowest lambda selected as best network: assumption of sparsity might be violated.## Warning in EBICglassoCore(S = S, n = n, gamma = gamma, penalize.diagonal =
## penalize.diagonal, : A dense regularized network was selected (lambda < 0.1 *
## lambda.max). Recent work indicates a possible drop in specificity. Interpret
## the presence of the smallest edges with care. Setting threshold = TRUE will
## enforce higher specificity, at the cost of sensitivity.qgraph::qgraph(network,
layout=SDQ_MDS_mspline$conf,
groups = list("Emotion Symptoms" = c(1,2,3,4,5),
"Conduct problems" = c(6,7,8,9,10),
"Hyperactivity" = c(11,12,13,14,15),
"Peer Problems" = c(16,17,18,19,20)),
color = c("lightblue", "red", "orange", "lightgreen"),
vsize=3)
text(-1,-1, paste("Stress=",
round(SDQ_MDS_mspline$stress,2)))
#Scaling weights to range between 0 and 1
network_scaled <- (network - min(network)) / (max(network) - min(network))
#Converting to igraph object
graph <- graph_from_adjacency_matrix(network_scaled, mode = "undirected", weighted = TRUE, diag = FALSE)
plot(graph)
#Spin glass with different gammas and spins
spin_clusters <- cluster_spinglass(graph)
spin_clusters1 <- cluster_spinglass(graph, gamma=0.2, spin=5)
spin_clusters2 <- cluster_spinglass(graph, gamma=1, spin=5)
spin_clusters3 <- cluster_spinglass(graph, gamma=1.5, spin=5)
# Get memberships and plot
membership(spin_clusters)## [1] 3 3 3 3 3 4 4 4 4 4 1 1 1 1 1 2 2 2 2 2plot(graph, vertex.color = membership(spin_clusters), main = "Spin Glass Clustering with Shifted Weights")
print(modularity(spin_clusters))## [1] -3.422674print(modularity(spin_clusters1))## [1] 0.7071867print(modularity(spin_clusters2))## [1] -3.492224print(modularity(spin_clusters3))## [1] -4.719144#Louvain, Greedy and Walktrap
#Greedy method
#scaling to remove negative
network_scaled <- (network - min(network)) / (max(network) - min(network))
#igraph
graph <- graph_from_adjacency_matrix(network_scaled, mode = "undirected", weighted = TRUE, diag = FALSE)
#fast greedy alg
cluster_greedy <- cluster_fast_greedy(graph)
#memberships
membership(cluster_greedy)## [1] 4 4 4 4 4 2 2 2 2 2 1 1 1 1 1 3 3 3 3 3plot(graph,layout = layout_with_fr, vertex.color = membership(cluster_greedy), main = "Greedy Clustering with Scaled Weights")
mod_greedy <- modularity(cluster_greedy)
#Louvain
louvain_clusters <- cluster_louvain(graph)
#memberships
membership(louvain_clusters)## [1] 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 4 4 4 1 4#plot
mod_louv <- modularity(louvain_clusters)
plot(graph, vertex.color = membership(louvain_clusters), main = "Louvain Clustering with Scaled Weights")
head(louvain_clusters)## $`1`
## [1] 1 2 3 4 5 19
##
## $`2`
## [1] 6 7 8 9 10
##
## $`3`
## [1] 11 12 13 14 15
##
## $`4`
## [1] 16 17 18 20head(cluster_greedy)## $`1`
## [1] 11 12 13 14 15
##
## $`2`
## [1] 6 7 8 9 10
##
## $`3`
## [1] 16 17 18 19 20
##
## $`4`
## [1] 1 2 3 4 5#Walktrap
walk_clusters <- cluster_walktrap(graph)
#memberships
membership(walk_clusters)## [1] 2 2 2 2 2 4 1 4 4 4 1 1 1 1 1 2 3 3 2 2#plot
mod_walk<- modularity(walk_clusters)
plot(graph, vertex.color = membership(louvain_clusters), main = "Spin Glass Clustering with Scaled Weights")
#print mod values
cat("Modularity (Q-statistic) using fast greedy:", mod_greedy, "\n")## Modularity (Q-statistic) using fast greedy: 0.106846cat("Modularity (Q-statistic) using Louvain:", mod_louv, "\n")## Modularity (Q-statistic) using Louvain: 0.1042863cat("Modularity (Q-statistic) using walktrap:", mod_walk, "\n")## Modularity (Q-statistic) using walktrap: 0.09527666#troubleshooting the spin glass modularity
is_connected <- is_connected(graph)
print(paste("Is the graph connected?", is_connected))## [1] "Is the graph connected? TRUE"summary(E(graph)$weight)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.02393 0.16709 0.19296 0.24111 0.26632 1.00000#investigate what pairing of spins and gamma values optimise modularity
#Range of gamma and spins
gamma_values <- seq(0.1, 2.0, by = 0.1)
spins_values <- seq(3, 10, by = 1)
results2 <- data.frame()
for (gamma in gamma_values) {
for (spins in spins_values) {
aris <- numeric(0)
mods <- numeric(0)
# Run clustering multiple times to calculate stability
membership_list <- list()
for (i in 1:10) {
clusters <- cluster_spinglass(graph, gamma = gamma, spins = spins)
membership_list[[i]] <- membership(clusters)
mods[i] <- modularity(graph, membership(clusters))
}
# Calculate ARI between all pairs of cluster runs
for (j in 1:9) {
for (k in (j+1):10) {
aris <- c(aris, adjustedRandIndex(membership_list[[j]], membership_list[[k]]))
}
}
# Calculate mean ARI and mean modularity
mean_ari <- mean(aris)
mean_mod <- mean(mods)
num_clusters <- length(unique(membership_list[[1]])) # for first run
# Store results
results2 <- rbind(results2, data.frame(gamma, spins, mean_ari, mean_mod, num_clusters))
}
}#checking silhouette scores
#get memberships
mem_greedy <- membership(cluster_greedy)
mem_louvain <- membership(louvain_clusters)
mem_spin <- membership(spin_clusters)
# Convert graph to an adjacency matrix, then to a distance matrix
adjacency_matrix <- as.matrix(as_adjacency_matrix(graph))
distance_matrix <- 1 - adjacency_matrix
#fast greedy
sil_greedy <- silhouette(mem_greedy, dist(distance_matrix))
print(sil_greedy)## cluster neighbor sil_width
## [1,] 4 2 0.00000000
## [2,] 4 2 0.00000000
## [3,] 4 2 0.00000000
## [4,] 4 2 0.00000000
## [5,] 4 2 0.00000000
## [6,] 2 4 0.00000000
## [7,] 2 4 0.00000000
## [8,] 2 4 0.00000000
## [9,] 2 4 0.00000000
## [10,] 2 4 0.00000000
## [11,] 1 2 -0.05319726
## [12,] 1 2 -0.05319726
## [13,] 1 3 -0.20000000
## [14,] 1 2 -0.05319726
## [15,] 1 2 -0.05319726
## [16,] 3 2 -0.05319726
## [17,] 3 2 -0.05319726
## [18,] 3 1 -0.20000000
## [19,] 3 2 -0.05319726
## [20,] 3 2 -0.05319726
## attr(,"Ordered")
## [1] FALSE
## attr(,"call")
## silhouette.default(x = mem_greedy, dist = dist(distance_matrix))
## attr(,"class")
## [1] "silhouette"# Average silhouette width (overall score)
avg_sil_greedy <- mean(sil_greedy[, 3])
print("Greedy")## [1] "Greedy"print(avg_sil_greedy)## [1] -0.04127891#Louvain
sil_louvain <- silhouette(mem_louvain, dist(distance_matrix))
print(sil_louvain)## cluster neighbor sil_width
## [1,] 1 2 0.00000000
## [2,] 1 2 0.00000000
## [3,] 1 2 0.00000000
## [4,] 1 2 0.00000000
## [5,] 1 2 0.00000000
## [6,] 2 1 0.00000000
## [7,] 2 1 0.00000000
## [8,] 2 1 0.00000000
## [9,] 2 1 0.00000000
## [10,] 2 1 0.00000000
## [11,] 3 1 -0.05319726
## [12,] 3 1 -0.05319726
## [13,] 3 4 -0.25000000
## [14,] 3 1 -0.05319726
## [15,] 3 1 -0.05319726
## [16,] 4 1 -0.06969385
## [17,] 4 1 -0.06969385
## [18,] 4 3 -0.20000000
## [19,] 1 2 0.00000000
## [20,] 4 1 -0.06969385
## attr(,"Ordered")
## [1] FALSE
## attr(,"call")
## silhouette.default(x = mem_louvain, dist = dist(distance_matrix))
## attr(,"class")
## [1] "silhouette"# Average silhouette width (overall score)
avg_sil_lv <- mean(sil_louvain[, 3])
print("Louvain")## [1] "Louvain"print(avg_sil_lv)## [1] -0.04359353#spin glass
sil_spin <- silhouette(mem_spin, dist(distance_matrix))
print(sil_spin)## cluster neighbor sil_width
## [1,] 3 4 0.00000000
## [2,] 3 4 0.00000000
## [3,] 3 4 0.00000000
## [4,] 3 4 0.00000000
## [5,] 3 4 0.00000000
## [6,] 4 3 0.00000000
## [7,] 4 3 0.00000000
## [8,] 4 3 0.00000000
## [9,] 4 3 0.00000000
## [10,] 4 3 0.00000000
## [11,] 1 3 -0.05319726
## [12,] 1 3 -0.05319726
## [13,] 1 2 -0.20000000
## [14,] 1 3 -0.05319726
## [15,] 1 3 -0.05319726
## [16,] 2 3 -0.05319726
## [17,] 2 3 -0.05319726
## [18,] 2 1 -0.20000000
## [19,] 2 3 -0.05319726
## [20,] 2 3 -0.05319726
## attr(,"Ordered")
## [1] FALSE
## attr(,"call")
## silhouette.default(x = mem_spin, dist = dist(distance_matrix))
## attr(,"class")
## [1] "silhouette"# Average silhouette width (overall score)
avg_sil_spin <- mean(sil_spin[, 3])
print("Spin Glass")## [1] "Spin Glass"print(avg_sil_spin)## [1] -0.04127891Things I’ve tried - switching between ordered+polychoric correlations and num+Pearson - the questionnaire is ordinal but tried num for certainty, similar modularity values and Spinglass still negative - changing the gamma and spins values - avg modularity remains at 0 in the “best” gamma+spin combos - changing the layout, trying transposed matrix - no change in modularity - comparing algorithms in the literature - papers suggesting Louvain, Greedy and Walktrap performed best, but still want to understand what’s up with the spin glass