-
-
Notifications
You must be signed in to change notification settings - Fork 200
/
community.R
2825 lines (2662 loc) · 108 KB
/
community.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
#' Creates a communities object.
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `create.communities()` was renamed to `make_clusters()` to create a more
#' consistent API.
#' @inheritParams make_clusters
#' @keywords internal
#' @export
create.communities <- function(graph, membership = NULL, algorithm = NULL, merges = NULL, modularity = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "create.communities()", "make_clusters()")
make_clusters(graph = graph, membership = membership, algorithm = algorithm, merges = merges, modularity = modularity)
} # nocov end
#' Community structure via short random walks
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `walktrap.community()` was renamed to `cluster_walktrap()` to create a more
#' consistent API.
#' @inheritParams cluster_walktrap
#' @keywords internal
#' @export
walktrap.community <- function(graph, weights = NULL, steps = 4, merges = TRUE, modularity = TRUE, membership = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "walktrap.community()", "cluster_walktrap()")
cluster_walktrap(graph = graph, weights = weights, steps = steps, merges = merges, modularity = modularity, membership = membership)
} # nocov end
#' Finding communities in graphs based on statistical meachanics
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `spinglass.community()` was renamed to `cluster_spinglass()` to create a more
#' consistent API.
#' @inheritParams cluster_spinglass
#' @keywords internal
#' @export
spinglass.community <- function(graph, weights = NULL, vertex = NULL, spins = 25, parupdate = FALSE, start.temp = 1, stop.temp = 0.01, cool.fact = 0.99, update.rule = c("config", "random", "simple"), gamma = 1.0, implementation = c("orig", "neg"), gamma.minus = 1.0) { # nocov start
lifecycle::deprecate_soft("2.0.0", "spinglass.community()", "cluster_spinglass()")
cluster_spinglass(graph = graph, weights = weights, vertex = vertex, spins = spins, parupdate = parupdate, start.temp = start.temp, stop.temp = stop.temp, cool.fact = cool.fact, update.rule = update.rule, gamma = gamma, implementation = implementation, gamma.minus = gamma.minus)
} # nocov end
#' Functions to deal with the result of network community detection
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `showtrace()` was renamed to `show_trace()` to create a more
#' consistent API.
#' @inheritParams show_trace
#' @keywords internal
#' @export
showtrace <- function(communities) { # nocov start
lifecycle::deprecate_soft("2.0.0", "showtrace()", "show_trace()")
show_trace(communities = communities)
} # nocov end
#' Optimal community structure
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `optimal.community()` was renamed to `cluster_optimal()` to create a more
#' consistent API.
#' @inheritParams cluster_optimal
#' @keywords internal
#' @export
optimal.community <- function(graph, weights = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "optimal.community()", "cluster_optimal()")
cluster_optimal(graph = graph, weights = weights)
} # nocov end
#' Finding community structure by multi-level optimization of modularity
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `multilevel.community()` was renamed to `cluster_louvain()` to create a more
#' consistent API.
#' @inheritParams cluster_louvain
#' @keywords internal
#' @export
multilevel.community <- function(graph, weights = NULL, resolution = 1) { # nocov start
lifecycle::deprecate_soft("2.0.0", "multilevel.community()", "cluster_louvain()")
cluster_louvain(graph = graph, weights = weights, resolution = resolution)
} # nocov end
#' Modularity of a community structure of a graph
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `mod.matrix()` was renamed to `modularity_matrix()` to create a more
#' consistent API.
#' @inheritParams modularity_matrix
#' @keywords internal
#' @export
mod.matrix <- function(graph, membership, weights = NULL, resolution = 1, directed = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "mod.matrix()", "modularity_matrix()")
modularity_matrix(graph = graph, membership = membership, weights = weights, resolution = resolution, directed = directed)
} # nocov end
#' Community structure detecting based on the leading eigenvector of the community matrix
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `leading.eigenvector.community()` was renamed to `cluster_leading_eigen()` to create a more
#' consistent API.
#' @inheritParams cluster_leading_eigen
#' @keywords internal
#' @export
leading.eigenvector.community <- function(graph, steps = -1, weights = NULL, start = NULL, options = arpack_defaults(), callback = NULL, extra = NULL, env = parent.frame()) { # nocov start
lifecycle::deprecate_soft("2.0.0", "leading.eigenvector.community()", "cluster_leading_eigen()")
cluster_leading_eigen(graph = graph, steps = steps, weights = weights, start = start, options = options, callback = callback, extra = extra, env = env)
} # nocov end
#' Finding communities based on propagating labels
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `label.propagation.community()` was renamed to `cluster_label_prop()` to create a more
#' consistent API.
#' @inheritParams cluster_label_prop
#' @keywords internal
#' @export
label.propagation.community <- function(graph, weights = NULL, ..., mode = c("out", "in", "all"), initial = NULL, fixed = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "label.propagation.community()", "cluster_label_prop()")
cluster_label_prop(graph = graph, weights = weights, mode = mode, initial = initial, fixed = fixed, ...)
} # nocov end
#' Functions to deal with the result of network community detection
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `is.hierarchical()` was renamed to `is_hierarchical()` to create a more
#' consistent API.
#' @inheritParams is_hierarchical
#' @keywords internal
#' @export
is.hierarchical <- function(communities) { # nocov start
lifecycle::deprecate_soft("2.0.0", "is.hierarchical()", "is_hierarchical()")
is_hierarchical(communities = communities)
} # nocov end
#' Infomap community finding
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `infomap.community()` was renamed to `cluster_infomap()` to create a more
#' consistent API.
#' @inheritParams cluster_infomap
#' @keywords internal
#' @export
infomap.community <- function(graph, e.weights = NULL, v.weights = NULL, nb.trials = 10, modularity = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "infomap.community()", "cluster_infomap()")
cluster_infomap(graph = graph, e.weights = e.weights, v.weights = v.weights, nb.trials = nb.trials, modularity = modularity)
} # nocov end
#' Community structure via greedy optimization of modularity
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `fastgreedy.community()` was renamed to `cluster_fast_greedy()` to create a more
#' consistent API.
#' @inheritParams cluster_fast_greedy
#' @keywords internal
#' @export
fastgreedy.community <- function(graph, merges = TRUE, modularity = TRUE, membership = TRUE, weights = NULL) { # nocov start
lifecycle::deprecate_soft("2.0.0", "fastgreedy.community()", "cluster_fast_greedy()")
cluster_fast_greedy(graph = graph, merges = merges, modularity = modularity, membership = membership, weights = weights)
} # nocov end
#' Community structure detection based on edge betweenness
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `edge.betweenness.community()` was renamed to `cluster_edge_betweenness()` to create a more
#' consistent API.
#' @inheritParams cluster_edge_betweenness
#' @keywords internal
#' @export
edge.betweenness.community <- function(graph, weights = NULL, directed = TRUE, edge.betweenness = TRUE, merges = TRUE, bridges = TRUE, modularity = TRUE, membership = TRUE) { # nocov start
lifecycle::deprecate_soft("2.0.0", "edge.betweenness.community()", "cluster_edge_betweenness()")
cluster_edge_betweenness(graph = graph, weights = weights, directed = directed, edge.betweenness = edge.betweenness, merges = merges, bridges = bridges, modularity = modularity, membership = membership)
} # nocov end
#' Community structure dendrogram plots
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `dendPlot()` was renamed to `plot_dendrogram()` to create a more
#' consistent API.
#' @inheritParams plot_dendrogram
#' @keywords internal
#' @export
dendPlot <- function(x, mode = igraph_opt("dend.plot.type"), ...) { # nocov start
lifecycle::deprecate_soft("2.0.0", "dendPlot()", "plot_dendrogram()")
plot_dendrogram(x = x, mode = mode, ...)
} # nocov end
#' Functions to deal with the result of network community detection
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `cutat()` was renamed to `cut_at()` to create a more
#' consistent API.
#' @inheritParams cut_at
#' @keywords internal
#' @export
cutat <- function(communities, no, steps) { # nocov start
lifecycle::deprecate_soft("2.0.0", "cutat()", "cut_at()")
cut_at(communities = communities, no = no, steps = steps)
} # nocov end
#' Contract several vertices into a single one
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `contract.vertices()` was renamed to `contract()` to create a more
#' consistent API.
#' @inheritParams contract
#' @keywords internal
#' @export
contract.vertices <- function(graph, mapping, vertex.attr.comb = igraph_opt("vertex.attr.comb")) { # nocov start
lifecycle::deprecate_soft("2.0.0", "contract.vertices()", "contract()")
contract(graph = graph, mapping = mapping, vertex.attr.comb = vertex.attr.comb)
} # nocov end
#' Functions to deal with the result of network community detection
#'
#' @description
#' `r lifecycle::badge("deprecated")`
#'
#' `code.length()` was renamed to `code_len()` to create a more
#' consistent API.
#' @inheritParams code_len
#' @keywords internal
#' @export
code.length <- function(communities) { # nocov start
lifecycle::deprecate_soft("2.0.0", "code.length()", "code_len()")
code_len(communities = communities)
} # nocov end
# IGraph R package
# Copyright (C) 2005-2012 Gabor Csardi <csardi.gabor@gmail.com>
# 334 Harvard street, Cambridge, MA 02139 USA
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 USA
#
###################################################################
###################################################################
# Community structure
###################################################################
#' Functions to deal with the result of network community detection
#'
#' igraph community detection functions return their results as an object from
#' the `communities` class. This manual page describes the operations of
#' this class.
#'
#' Community structure detection algorithms try to find dense subgraphs in
#' directed or undirected graphs, by optimizing some criteria, and usually
#' using heuristics.
#'
#' igraph implements a number of community detection methods (see them below),
#' all of which return an object of the class `communities`. Because the
#' community structure detection algorithms are different, `communities`
#' objects do not always have the same structure. Nevertheless, they have some
#' common operations, these are documented here.
#'
#' The [print()] generic function is defined for `communities`, it
#' prints a short summary.
#'
#' The `length` generic function call be called on `communities` and
#' returns the number of communities.
#'
#' The `sizes()` function returns the community sizes, in the order of their
#' ids.
#'
#' `membership()` gives the division of the vertices, into communities. It
#' returns a numeric vector, one value for each vertex, the id of its
#' community. Community ids start from one. Note that some algorithms calculate
#' the complete (or incomplete) hierarchical structure of the communities, and
#' not just a single partitioning. For these algorithms typically the
#' membership for the highest modularity value is returned, but see also the
#' manual pages of the individual algorithms.
#'
#' `communities()` is also the name of a function, that returns a list of
#' communities, each identified by their vertices. The vertices will have
#' symbolic names if the `add.vertex.names` igraph option is set, and the
#' graph itself was named. Otherwise numeric vertex ids are used.
#'
#' `modularity()` gives the modularity score of the partitioning. (See
#' [modularity.igraph()] for details. For algorithms that do not
#' result a single partitioning, the highest modularity value is returned.
#'
#' `algorithm()` gives the name of the algorithm that was used to calculate
#' the community structure.
#'
#' `crossing()` returns a logical vector, with one value for each edge,
#' ordered according to the edge ids. The value is `TRUE` iff the edge
#' connects two different communities, according to the (best) membership
#' vector, as returned by `membership()`.
#'
#' `is_hierarchical()` checks whether a hierarchical algorithm was used to
#' find the community structure. Some functions only make sense for
#' hierarchical methods (e.g. `merges()`, `cut_at()` and
#' [as.dendrogram()]).
#'
#' `merges()` returns the merge matrix for hierarchical methods. An error
#' message is given, if a non-hierarchical method was used to find the
#' community structure. You can check this by calling `is_hierarchical()` on
#' the `communities` object.
#'
#' `cut_at()` cuts the merge tree of a hierarchical community finding method,
#' at the desired place and returns a membership vector. The desired place can
#' be expressed as the desired number of communities or as the number of merge
#' steps to make. The function gives an error message, if called with a
#' non-hierarchical method.
#'
#' [as.dendrogram()] converts a hierarchical community structure to a
#' `dendrogram` object. It only works for hierarchical methods, and gives
#' an error message to others. See [stats::dendrogram()] for details.
#'
#' [stats::as.hclust()] is similar to [as.dendrogram()], but converts a
#' hierarchical community structure to a `hclust` object.
#'
#' [ape::as.phylo()] converts a hierarchical community structure to a `phylo`
#' object, you will need the `ape` package for this.
#'
#' `show_trace()` works (currently) only for communities found by the leading
#' eigenvector method ([cluster_leading_eigen()]), and
#' returns a character vector that gives the steps performed by the algorithm
#' while finding the communities.
#'
#' `code_len()` is defined for the InfoMAP method
#' ([cluster_infomap()] and returns the code length of the
#' partition.
#'
#' It is possibly to call the [plot()] function on `communities`
#' objects. This will plot the graph (and uses [plot.igraph()]
#' internally), with the communities shown. By default it colores the vertices
#' according to their communities, and also marks the vertex groups
#' corresponding to the communities. It passes additional arguments to
#' [plot.igraph()], please see that and also
#' [igraph.plotting] on how to change the plot.
#'
#' @rdname communities
#' @family community
#' @param communities,x,object A `communities` object, the result of an
#' igraph community detection function.
#' @param graph An igraph graph object, corresponding to `communities`.
#' @param y An igraph graph object, corresponding to the communities in
#' `x`.
#' @param no Integer scalar, the desired number of communities. If too low or
#' two high, then an error message is given. Exactly one of `no` and
#' `steps` must be supplied.
#' @param steps The number of merge operations to perform to produce the
#' communities. Exactly one of `no` and `steps` must be supplied.
#' @param col A vector of colors, in any format that is accepted by the regular
#' R plotting methods. This vector gives the colors of the vertices explicitly.
#' @param mark.groups A list of numeric vectors. The communities can be
#' highlighted using colored polygons. The groups for which the polygons are
#' drawn are given here. The default is to use the groups given by the
#' communities. Supply `NULL` here if you do not want to highlight any
#' groups.
#' @param edge.color The colors of the edges. By default the edges within
#' communities are colored green and other edges are red.
#' @param hang Numeric scalar indicating how the height of leaves should be
#' computed from the heights of their parents; see [plot.hclust()].
#' @param use.modularity Logical scalar, whether to use the modularity values
#' to define the height of the branches.
#' @param \dots Additional arguments. `plot.communities` passes these to
#' [plot.igraph()]. The other functions silently ignore
#' them.
#' @param membership Numeric vector, one value for each vertex, the membership
#' vector of the community structure. Might also be `NULL` if the
#' community structure is given in another way, e.g. by a merge matrix.
#' @param algorithm If not `NULL` (meaning an unknown algorithm), then a
#' character scalar, the name of the algorithm that produced the community
#' structure.
#' @param merges If not `NULL`, then the merge matrix of the hierarchical
#' community structure. See `merges()` below for more information on its
#' format.
#' @param modularity Numeric scalar or vector, the modularity value of the
#' community structure. It can also be `NULL`, if the modularity of the
#' (best) split is not available.
#' @return [print()] returns the `communities` object itself,
#' invisibly.
#'
#' `length` returns an integer scalar.
#'
#' `sizes()` returns a numeric vector.
#'
#' `membership()` returns a numeric vector, one number for each vertex in
#' the graph that was the input of the community detection.
#'
#' `modularity()` returns a numeric scalar.
#'
#' `algorithm()` returns a character scalar.
#'
#' `crossing()` returns a logical vector.
#'
#' `is_hierarchical()` returns a logical scalar.
#'
#' `merges()` returns a two-column numeric matrix.
#'
#' `cut_at()` returns a numeric vector, the membership vector of the
#' vertices.
#'
#' [as.dendrogram()] returns a [dendrogram] object.
#'
#' `show_trace()` returns a character vector.
#'
#' `code_len()` returns a numeric scalar for communities found with the
#' InfoMAP method and `NULL` for other methods.
#'
#' [plot()] for `communities` objects returns `NULL`, invisibly.
#'
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @seealso See [plot_dendrogram()] for plotting community structure
#' dendrograms.
#'
#' See [compare()] for comparing two community structures
#' on the same graph.
#' @keywords graphs
#' @export
#' @examples
#'
#' karate <- make_graph("Zachary")
#' wc <- cluster_walktrap(karate)
#' modularity(wc)
#' membership(wc)
#' plot(wc, karate)
#'
membership <- function(communities) {
if (!is.null(communities$membership)) {
res <- communities$membership
} else if (!is.null(communities$merges) &&
!is.null(communities$modularity)) {
res <- community.to.membership2(
communities$merges, communities$vcount,
which.max(communities$modularity)
)
} else {
stop("Cannot calculate community membership")
}
if (igraph_opt("add.vertex.names") && !is.null(communities$names)) {
names(res) <- communities$names
}
class(res) <- "membership"
res
}
#' @method print membership
#' @family community
#' @export
print.membership <- function(x, ...) print(unclass(x), ...)
#' Declare a numeric vector as a membership vector
#'
#' This is useful if you want to use functions defined on
#' membership vectors, but your membership vector does not
#' come from an igraph clustering method.
#'
#' @param x The input vector.
#' @return The input vector, with the `membership` class added.
#' @family community
#' @export
#' @examples
#' ## Compare to the correct clustering
#' g <- (make_full_graph(10) + make_full_graph(10)) %>%
#' rewire(each_edge(p = 0.2))
#' correct <- rep(1:2, each = 10) %>% as_membership()
#' fc <- cluster_fast_greedy(g)
#' compare(correct, fc)
#' compare(correct, membership(fc))
as_membership <- function(x) add_class(x, "membership")
#' @rdname communities
#' @method print communities
#' @export
print.communities <- function(x, ...) {
noc <- if (!is.null(x$membership)) max(membership(x), 0) else NA
mod <- if (!is.null(x$modularity)) {
modularity(x) %>% format(digits = 2)
} else {
NA_real_
}
alg <- x$algorithm %||% "unknown"
cat("IGRAPH clustering ", alg, ", groups: ", noc, ", mod: ", mod, "\n", sep = "")
if (!is.null(x$membership)) {
grp <- groups(x)
cat("+ groups:\n")
hp <- function(o) {
head_print(o,
max_lines = igraph_opt("auto.print.lines"),
omitted_footer = "+ ... omitted several groups/vertices\n",
)
}
indent_print(grp, .printer = hp, .indent = " ")
} else {
cat(" + groups not available\n")
}
invisible(x)
}
#' Creates a communities object.
#'
#' This is useful to integrate the results of community finding algorithms
#' that are not included in igraph.
#'
#' @param graph The graph of the community structure.
#' @param membership The membership vector of the community structure, a
#' numeric vector denoting the id of the community for each vertex. It
#' might be `NULL` for hierarchical community structures.
#' @param algorithm Character string, the algorithm that generated
#' the community structure, it can be arbitrary.
#' @param merges A merge matrix, for hierarchical community structures (or
#' `NULL` otherwise.
#' @param modularity Modularity value of the community structure. If this
#' is `TRUE` and the membership vector is available, then it the
#' modularity values is calculated automatically.
#' @return A `communities` object.
#'
#'
#' @family community
#' @export
make_clusters <- function(graph, membership = NULL, algorithm = NULL,
merges = NULL, modularity = TRUE) {
stopifnot(is.null(membership) || is.numeric(membership))
stopifnot(is.null(algorithm) ||
(is.character(algorithm) && length(algorithm) == 1))
stopifnot(is.null(merges) ||
(is.matrix(merges) && is.numeric(merges) && ncol(merges) == 2))
stopifnot(is.null(modularity) ||
(is.logical(modularity) && length(modularity) == 1) ||
(is.numeric(modularity) &&
length(modularity) %in% c(1, length(membership))))
if (is.logical(modularity)) {
if (modularity && !is.null(membership)) {
modularity <- modularity(graph, membership)
} else {
modularity <- NULL
}
}
res <- list(
membership = membership,
algorithm = if (is.null(algorithm)) "unknown" else algorithm,
modularity = modularity
)
if (!is.null(merges)) {
res$merges <- merges
}
if (!is.null(membership)) {
res$vcount <- length(membership)
} else if (!is.null(merges)) {
res$vcount <- nrow(merges) + 1
}
class(res) <- "communities"
res
}
#' @family community
#' @export
modularity <- function(x, ...) {
UseMethod("modularity")
}
#' Modularity of a community structure of a graph
#'
#' This function calculates how modular is a given division of a graph into
#' subgraphs.
#'
#' `modularity()` calculates the modularity of a graph with respect to the
#' given `membership` vector.
#'
#' The modularity of a graph with respect to some division (or vertex types)
#' measures how good the division is, or how separated are the different vertex
#' types from each other. It defined as \deqn{Q=\frac{1}{2m} \sum_{i,j}
#' (A_{ij}-\gamma\frac{k_i k_j}{2m})\delta(c_i,c_j),}{Q=1/(2m) * sum( (Aij-gamma*ki*kj/(2m)
#' ) delta(ci,cj),i,j),} here \eqn{m} is the number of edges, \eqn{A_{ij}}{Aij}
#' is the element of the \eqn{A} adjacency matrix in row \eqn{i} and column
#' \eqn{j}, \eqn{k_i}{ki} is the degree of \eqn{i}, \eqn{k_j}{kj} is the degree
#' of \eqn{j}, \eqn{c_i}{ci} is the type (or component) of \eqn{i},
#' \eqn{c_j}{cj} that of \eqn{j}, the sum goes over all \eqn{i} and \eqn{j}
#' pairs of vertices, and \eqn{\delta(x,y)}{delta(x,y)} is 1 if \eqn{x=y} and 0
#' otherwise. For directed graphs, it is defined as
#' \deqn{Q = \frac{1}{m} \sum_{i,j} (A_{ij}-\gamma
#' \frac{k_i^{out} k_j^{in}}{m})\delta(c_i,c_j).}{Q=1/(m) * sum(
#' (Aij-gamma*ki^out*kj^in/(m) ) delta(ci,cj),i,j).}
#'
#' The resolution parameter \eqn{\gamma}{gamma} allows weighting the random
#' null model, which might be useful when finding partitions with a high
#' modularity. Maximizing modularity with higher values of the resolution
#' parameter typically results in more, smaller clusters when finding
#' partitions with a high modularity. Lower values typically results in fewer,
#' larger clusters. The original definition of modularity is retrieved when
#' setting \eqn{\gamma}{gamma} to 1.
#'
#' If edge weights are given, then these are considered as the element of the
#' \eqn{A} adjacency matrix, and \eqn{k_i}{ki} is the sum of weights of
#' adjacent edges for vertex \eqn{i}.
#'
#' `modularity_matrix()` calculates the modularity matrix. This is a dense matrix,
#' and it is defined as the difference of the adjacency matrix and the
#' configuration model null model matrix. In other words element
#' \eqn{M_{ij}}{M[i,j]} is given as \eqn{A_{ij}-d_i
#' d_j/(2m)}{A[i,j]-d[i]d[j]/(2m)}, where \eqn{A_{ij}}{A[i,j]} is the (possibly
#' weighted) adjacency matrix, \eqn{d_i}{d[i]} is the degree of vertex \eqn{i},
#' and \eqn{m} is the number of edges (or the total weights in the graph, if it
#' is weighed).
#'
#' @aliases modularity
#' @param x,graph The input graph.
#' @param membership Numeric vector, one value for each vertex, the membership
#' vector of the community structure.
#' @param weights If not `NULL` then a numeric vector giving edge weights.
#' @param resolution The resolution parameter. Must be greater than or equal to
#' 0. Set it to 1 to use the classical definition of modularity.
#' @param directed Whether to use the directed or undirected version of
#' modularity. Ignored for undirected graphs.
#' @param \dots Additional arguments, none currently.
#' @return For `modularity()` a numeric scalar, the modularity score of the
#' given configuration.
#'
#' For `modularity_matrix()` a numeric square matrix, its order is the number of
#' vertices in the graph.
#' @author Gabor Csardi \email{csardi.gabor@@gmail.com}
#' @seealso [cluster_walktrap()],
#' [cluster_edge_betweenness()],
#' [cluster_fast_greedy()], [cluster_spinglass()],
#' [cluster_louvain()] and [cluster_leiden()] for
#' various community detection methods.
#' @references Clauset, A.; Newman, M. E. J. & Moore, C. Finding community
#' structure in very large networks, *Physical Review E* 2004, 70, 066111
#' @method modularity igraph
#' @family community
#' @export
#' @keywords graphs
#' @examples
#'
#' g <- make_full_graph(5) %du% make_full_graph(5) %du% make_full_graph(5)
#' g <- add_edges(g, c(1, 6, 1, 11, 6, 11))
#' wtc <- cluster_walktrap(g)
#' modularity(wtc)
#' modularity(g, membership(wtc))
#'
modularity.igraph <- function(x, membership, weights = NULL, resolution = 1, directed = TRUE, ...) {
# Argument checks
ensure_igraph(x)
if (is.null(membership) || (!is.numeric(membership) && !is.factor(membership))) {
stop("Membership is not a numerical vector")
}
membership <- as.numeric(membership)
if (!is.null(weights)) weights <- as.numeric(weights)
resolution <- as.numeric(resolution)
directed <- as.logical(directed)
on.exit(.Call(R_igraph_finalizer))
# Function call
res <- .Call(R_igraph_modularity, x, membership - 1, weights, resolution, directed)
res
}
#' @rdname communities
#' @method modularity communities
#' @export
modularity.communities <- function(x, ...) {
if (!is.null(x$modularity)) {
max(x$modularity)
} else {
stop("Modularity was not calculated")
}
}
#' @rdname modularity.igraph
#' @export
modularity_matrix <- function(graph, membership, weights = NULL, resolution = 1, directed = TRUE) {
# Argument checks
ensure_igraph(graph)
if (!missing(membership)) {
warning("The membership argument is deprecated; modularity_matrix does not need it")
}
if (is.null(weights) && "weight" %in% edge_attr_names(graph)) {
weights <- E(graph)$weight
}
if (!is.null(weights) && any(!is.na(weights))) {
weights <- as.numeric(weights)
} else {
weights <- NULL
}
resolution <- as.numeric(resolution)
directed <- as.logical(directed)
on.exit(.Call(R_igraph_finalizer))
# Function call
res <- .Call(R_igraph_modularity_matrix, graph, weights, resolution, directed)
res
}
#' @rdname communities
#' @method length communities
#' @export
length.communities <- function(x) {
m <- membership(x)
max(m, 0)
}
#' @rdname communities
#' @export
sizes <- function(communities) {
m <- membership(communities)
table(`Community sizes` = m)
}
#' @rdname communities
#' @export
algorithm <- function(communities) {
communities$algorithm
}
#' @rdname communities
#' @export
merges <- function(communities) {
if (!is.null(communities$merges)) {
communities$merges
} else {
stop("Not a hierarchical community structure")
}
}
#' @rdname communities
#' @export
crossing <- function(communities, graph) {
m <- membership(communities)
el <- as_edgelist(graph, names = FALSE)
m1 <- m[el[, 1]]
m2 <- m[el[, 2]]
res <- m1 != m2
if (!is.null(names(m1))) {
names(res) <- paste(names(m1), names(m2), sep = "|")
}
res
}
#' @rdname communities
#' @export
code_len <- function(communities) {
communities$codelength
}
#' @rdname communities
#' @export
is_hierarchical <- function(communities) {
!is.null(communities$merges)
}
complete.dend <- function(comm, use.modularity) {
merges <- comm$merges
if (nrow(merges) < comm$vcount - 1) {
if (use.modularity) {
stop(paste(
"`use.modularity' requires a full dendrogram,",
"i.e. a connected graph"
))
}
miss <- seq_len(comm$vcount + nrow(merges))[-as.vector(merges)]
miss <- c(miss, seq_len(length(miss) - 2) + comm$vcount + nrow(merges))
miss <- matrix(miss, byrow = TRUE, ncol = 2)
merges <- rbind(merges, miss)
}
storage.mode(merges) <- "integer"
merges
}
# The following functions were adapted from the stats R package
#' @rdname communities
#' @importFrom stats as.dendrogram
#' @method as.dendrogram communities
#' @export
as.dendrogram.communities <- function(object, hang = -1, use.modularity = FALSE,
...) {
if (!is_hierarchical(object)) {
stop("Not a hierarchical community structure")
}
.memberDend <- function(x) {
r <- attr(x, "x.member")
if (is.null(r)) {
r <- attr(x, "members")
if (is.null(r)) r <- 1:1
}
r
}
## If multiple components, then we merge them in arbitrary order
merges <- complete.dend(object, use.modularity)
storage.mode(merges) <- "integer"
if (is.null(object$names)) {
object$names <- 1:(nrow(merges) + 1)
}
z <- list()
if (!use.modularity || is.null(object$modularity)) {
object$height <- 1:nrow(merges)
} else {
object$height <- object$modularity[-1]
object$height <- cumsum(object$height - min(object$height))
}
nMerge <- length(oHgt <- object$height)
if (nMerge != nrow(merges)) {
stop("'merge' and 'height' do not fit!")
}
hMax <- oHgt[nMerge]
one <- 1L
two <- 2L
leafs <- nrow(merges) + 1
for (k in 1:nMerge) {
x <- merges[k, ] # no sort() anymore!
if (any(neg <- x < leafs + 1)) {
h0 <- if (hang < 0) 0 else max(0, oHgt[k] - hang * hMax)
}
if (all(neg)) { # two leaves
zk <- as.list(x)
attr(zk, "members") <- two
attr(zk, "midpoint") <- 0.5 # mean( c(0,1) )
objlabels <- object$names[x]
attr(zk[[1]], "label") <- objlabels[1]
attr(zk[[2]], "label") <- objlabels[2]
attr(zk[[1]], "members") <- attr(zk[[2]], "members") <- one
attr(zk[[1]], "height") <- attr(zk[[2]], "height") <- h0
attr(zk[[1]], "leaf") <- attr(zk[[2]], "leaf") <- TRUE
} else if (any(neg)) { # one leaf, one node
# as.character(x) is not okay as it starts converting values >= 100000
# to scientific notation
X <- format(x, scientific = FALSE, trim = TRUE)
## Originally had "x <- sort(..) above => leaf always left, x[1];
## don't want to assume this
isL <- x[1] < leafs + 1 ## is leaf left?
zk <-
if (isL) {
list(x[1], z[[X[2]]])
} else {
list(z[[X[1]]], x[2])
}
attr(zk, "members") <- attr(z[[X[1 + isL]]], "members") + one
attr(zk, "midpoint") <-
(.memberDend(zk[[1]]) + attr(z[[X[1 + isL]]], "midpoint")) / 2
attr(zk[[2 - isL]], "members") <- one
attr(zk[[2 - isL]], "height") <- h0
attr(zk[[2 - isL]], "label") <- object$names[x[2 - isL]]
attr(zk[[2 - isL]], "leaf") <- TRUE
} else { # two nodes
# as.character(x) is not okay as it starts converting values >= 100000
# to scientific notation
x <- format(x, scientific = FALSE, trim = TRUE)
zk <- list(z[[x[1]]], z[[x[2]]])
attr(zk, "members") <- attr(z[[x[1]]], "members") +
attr(z[[x[2]]], "members")
attr(zk, "midpoint") <- (attr(z[[x[1]]], "members") +
attr(z[[x[1]]], "midpoint") +
attr(z[[x[2]]], "midpoint")) / 2
}
attr(zk, "height") <- oHgt[k]
z[[k <- format(k + leafs, scientific = FALSE)]] <- zk
}
z <- z[[k]]
class(z) <- "dendrogram"
z
}
#' @rdname communities
#' @importFrom stats as.hclust
#' @method as.hclust communities
#' @export
as.hclust.communities <- function(x, hang = -1, use.modularity = FALSE,
...) {
as.hclust(as.dendrogram(x, hang = hang, use.modularity = use.modularity))
}
as.phylo.communities <- function(x, use.modularity = FALSE, ...) {
if (!is_hierarchical(x)) {
stop("Not a hierarchical community structure")
}
## If multiple components, then we merge them in arbitrary order
merges <- complete.dend(x, use.modularity)
if (!use.modularity || is.null(x$modularity)) {
height <- 1:nrow(merges)
} else {
height <- x$modularity[-1]
height <- cumsum(height - min(height))
}
if (is.null(x$names)) {
labels <- 1:(nrow(merges) + 1)
} else {
labels <- x$names
}
N <- nrow(merges)
edge <- matrix(0L, 2 * N, 2)
edge.length <- numeric(2 * N)
node <- integer(N)
node[N] <- N + 2L
cur.nod <- N + 3L
j <- 1L
for (i in N:1) {
edge[j:(j + 1), 1] <- node[i]
for (l in 1:2) {
k <- j + l - 1L
y <- merges[i, l]
if (y > N + 1) {
edge[k, 2] <- node[y - N - 1] <- cur.nod
cur.nod <- cur.nod + 1L
edge.length[k] <- height[i] - height[y - N - 1]
} else {
edge[k, 2] <- y
edge.length[k] <- height[i]
}
}
j <- j + 2L
}
obj <- list(
edge = edge, edge.length = edge.length / 2, tip.label = labels,
Nnode = N
)
class(obj) <- "phylo"
ape::reorder.phylo(obj)
}
rlang::on_load(s3_register("ape::as.phylo", "communities"))
#' @rdname communities
#' @export
cut_at <- function(communities, no, steps) {
if (!inherits(communities, "communities")) {
stop("Not a community structure")
}
if (!is_hierarchical(communities)) {
stop("Not a hierarchical communitity structure")
}
if ((!missing(no) && !missing(steps)) ||
(missing(no) && missing(steps))) {
stop("Please give either `no' or `steps' (but not both)")
}
if (!missing(steps)) {
mm <- merges(communities)
if (steps > nrow(mm)) {
warning("Cannot make that many steps")
steps <- nrow(mm)
}
community.to.membership2(mm, communities$vcount, steps)
} else {
mm <- merges(communities)
noc <- communities$vcount - nrow(mm) # final number of communities
if (no < noc) {
warning("Cannot have that few communities")
no <- noc