Nothing
inst/doc/CliquePercolation.R
In CliquePercolation: Clique Percolation for Networks
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
library(Matrix)
library(qgraph)
library(CliquePercolation)
library(colorspace)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Unweighted network with eight nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
W <- matrix(c(0,1,1,1,0,0,0,0,
0,0,1,1,0,0,0,0,
0,0,0,0,0,0,0,0,
0,0,0,0,1,1,1,0,
0,0,0,0,0,1,1,0,
0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0), nrow = 8, ncol = 8, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
qgraph(W, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Six 3-cliques in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color1 <- c("#ff9600","#ff9600","#ff9600","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color2 <- c("#ff9600","#7f7f7f","#7f7f7f","#ff9600","#ff9600","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color3 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600","#ff9600",
"#ff9600","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color4 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600","#7f7f7f",
"#7f7f7f","#ff9600","#ff9600","#7f7f7f","#7f7f7f")
color5 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600",
"#7f7f7f","#ff9600","#7f7f7f","#ff9600","#7f7f7f")
color6 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f",
"#ff9600","#7f7f7f","#ff9600","#ff9600","#7f7f7f")
layout(matrix(c(1,2,3,
4,5,6), ncol = 3, nrow = 2, byrow = TRUE))
qgraph(W, edge.color = color1, edge.width = 4)
qgraph(W, edge.color = color2, edge.width = 4)
qgraph(W, edge.color = color3, edge.width = 4)
qgraph(W, edge.color = color4, edge.width = 4)
qgraph(W, edge.color = color5, edge.width = 4)
qgraph(W, edge.color = color6, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Two communities in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color7 <- c("#00AD9A","#00AD9A","#00AD9A","#00AD9A","#00AD9A","#E16A86","#E16A86",
"#E16A86","#E16A86","#E16A86","#E16A86","#7f7f7f")
qgraph(W, edge.color = color7, edge.width = 4)
## ---- echo = FALSE, results = FALSE, dpi = 300, fig.cap = "**Community partition by node coloring in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cp <- cpAlgorithm(qgraph(W, DoNotPlot = TRUE), k = 3, method = "unweighted")
cpColoredGraph(qgraph(W, DoNotPlot = TRUE), cp$list.of.communities.labels, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Weighted network with eight nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
layout <- qgraph(W, DoNotPlot = TRUE)$layout
W <- matrix(c(0,.1,.3,.3,0,0,0,0,
0,0,.2,.2,0,0,0,0,
0,0,0,0,0,0,0,0,
0,0,0,0,.1,.1,.1,0,
0,0,0,0,0,.1,.1,0,
0,0,0,0,0,0,.1,0,
0,0,0,0,0,0,0,-.2,
0,0,0,0,0,0,0,0), nrow = 8, ncol = 8, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
qgraph(W, theme = "colorblind", cut = 0.02, edge.labels = TRUE, layout = layout)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Surviving cliques in weighted network depending on I.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color8 <- c("#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color9 <- c("#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#ff9600",
"#ff9600","#ff9600","#ff9600","#ff9600","#7f7f7f")
layout(matrix(c(1,2), ncol = 2, nrow = 1, byrow = TRUE))
qgraph(W, edge.color = color8, theme = "colorblind", cut = 0.02, edge.labels = TRUE,
layout = layout, fade = FALSE, title = "k = 3, I = 0.17", title.cex = 0.5)
qgraph(W, edge.color = color9, theme = "colorblind", cut = 0.02, edge.labels = TRUE,
layout = layout, fade = FALSE, title = "k = 3, I = 0.09", title.cex = 0.5)
## ----setup--------------------------------------------------------------------
library(CliquePercolation) #version 0.3.0
library(qgraph) #version 1.6.5
library(Matrix) #version 1.2-18
## ---- echo = TRUE, dpi = 400, fig.cap = "**Weighted network with 150 nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "100%"----
# create qgraph object; 150 nodes with letters as names; 1/7 of edges different from zero
W <- matrix(c(0), nrow = 150, ncol = 150, byrow = TRUE)
name.vector <- paste(letters[rep(seq(from = 1, to = 26), each = 26)],
letters[seq(from = 1, to = 26)], sep = "")[1:nrow(W)]
rownames(W) <- name.vector
colnames(W) <- name.vector
set.seed(4186)
W[upper.tri(W)] <- sample(c(rep(0,6),1), length(W[upper.tri(W)]), replace = TRUE)
rand_w <- stats::rnorm(length(which(W == 1)), mean = 0.3, sd = 0.1)
W[which(W == 1)] <- rand_w
W <- Matrix::forceSymmetric(W)
W <- qgraph::qgraph(W, theme = "colorblind", layout = "spring", cut = 0.4)
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# thresholds <- cpThreshold(W, method = "weighted", k.range = c(3,4),
# I.range = c(seq(0.40, 0.01, by = -0.005)),
# threshold = c("largest.components.ratio","chi"))
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# thresholds
## ---- echo = TRUE-------------------------------------------------------------
cpk3I.35 <- cpAlgorithm(W, k = 3, method = "weighted", I = 0.35)
cpk4I.27 <- cpAlgorithm(W, k = 4, method = "weighted", I = 0.27)
## ---- echo = TRUE-------------------------------------------------------------
cpk3I.35
## ---- echo = TRUE, results = FALSE--------------------------------------------
summary(cpk3I.35)
## ---- echo = TRUE, results = FALSE--------------------------------------------
summary(cpk3I.35, details = "shared.nodes.numbers")
## ---- echo = TRUE, results = FALSE--------------------------------------------
cpk3I.35$list.of.communities.numbers
## ---- echo = TRUE, results = FALSE--------------------------------------------
cpk3I.35$list.of.communities.labels
## ---- echo = TRUE, results = FALSE, dpi = 300, fig.cap = "**Community size distribution with k = 3 and I = 0.35.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers)
## ---- echo = TRUE, results = FALSE, dpi = 300, fig.cap = "**Community size distribution with k = 4 and I = 0.27.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cpCommunitySizeDistribution(cpk4I.27$list.of.communities.numbers)
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# fit_pl_k3I.35 <- cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers, test.power.law = TRUE)
## ---- include = FALSE---------------------------------------------------------
fit_pl_k3I.35 <- cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers, test.power.law = TRUE)
## ---- echo = TRUE-------------------------------------------------------------
fit_pl_k3I.35$fit.power.law
## ---- echo = TRUE, dpi = 400, fig.cap = "**Community network with k = 3 and I = 0.35.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "100%"----
commnetwork <- cpCommunityGraph(cpk3I.35$list.of.communities.numbers,
node.size.method = "proportional",
max.node.size = 20,
theme = "colorblind", layout = "spring", repulsion = 0.4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
commnetwork$community.weights.matrix
## ---- echo = TRUE, dpi = 300, fig.cap = "**Unweighted network with ten nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
W <- matrix(c(0,1,1,1,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,1,1,0,0,0,0,
0,0,0,0,0,1,0,0,0,0,
0,0,0,0,0,0,1,1,1,0,
0,0,0,0,0,0,0,1,1,0,
0,0,0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,0,0), nrow = 10, ncol = 10, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
W <- qgraph(W, edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
thresholds.small <- cpThreshold(W, method = "unweighted", k.range = c(3,4),
threshold = "entropy")
## ---- echo = TRUE-------------------------------------------------------------
thresholds.small
## ---- echo = TRUE, results = FALSE--------------------------------------------
permute <- cpPermuteEntropy(W, cpThreshold.object = thresholds.small,
n = 100, interval = 0.95,
ncores = 2, seed = 4186)
## ---- echo = TRUE-------------------------------------------------------------
permute
## ---- echo = TRUE, results = FALSE--------------------------------------------
permute$Confidence.Interval
permute$Extracted.Rows
## ---- echo = TRUE-------------------------------------------------------------
cpk3 <- cpAlgorithm(W, k = 3, method = "unweighted")
## ---- echo = TRUE-------------------------------------------------------------
cpk3
summary(cpk3)
## ---- echo = TRUE, results = FALSE--------------------------------------------
thresholds.small.fuzzymod <- cpThreshold(W, method = "unweighted", k.range = c(3,4),
threshold = c("entropy","fuzzymod"))
## ---- echo = TRUE-------------------------------------------------------------
thresholds.small.fuzzymod
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring I.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net1 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
colored.net1$colors.communities
colored.net1$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring II.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net2 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
h.cp = c(50, 210), c.cp = 70, l.cp = 70,
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring III.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#define list.of.sets
list.of.sets1 <- list(c("a","b","c","d","e","f"), c("g","h","i","j"))
colored.net3 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets1,
edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
colored.net3$basic.colors.sets
## ---- echo = FALSE, dpi = 300, fig.cap = "**Color patches.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
swatchplot(colored.net3$basic.colors.sets)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring IV.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net4 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets1, set.palettes.size = 5,
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring V.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#define list.of.sets
list.of.sets2 <- list(c("a","d","e","f","g"), c("b","c","h","i","j"))
colored.net5 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets2,
edge.width = 4)
## ---- echo = TRUE-------------------------------------------------------------
colored.net5$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring VI.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
set.seed(4186)
colored.net6 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets2,
avoid.repeated.mixed.colors = TRUE,
edge.width = 4)
## ---- echo = TRUE-------------------------------------------------------------
colored.net6$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring VI.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net6 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
own.colors = c("#FF0000","#00FF00","#0000FF"),
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Large network with 11 communities colored with qualitative_hcl.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#generate network with 11 communities
W <- matrix(c(0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow = 25, ncol = 25, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
W <- qgraph(W, DoNotPlot = TRUE)
#run the clique percolation method
cpk3.large <- cpAlgorithm(W, k = 3, method = "unweighted")
#plot the network colored according to community partition (with qualitative_hcl)
colored.net.large1 <- cpColoredGraph(W, list.of.communities = cpk3.large$list.of.communities.labels, edge.width = 4, layout = "spring", repulsion = 0.9)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Large network with 11 communities colored with createPalette.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
set.seed(4186)
colored.net.large2 <- cpColoredGraph(W, list.of.communities = cpk3.large$list.of.communities.labels,
larger.six = TRUE,
edge.width = 4, layout = "spring", repulsion = 0.9)
Try the CliquePercolation package in your browser
Any scripts or data that you put into this service are public.
CliquePercolation documentation built on Nov. 10, 2022, 6:12 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
## ---- include = FALSE---------------------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
library(Matrix)
library(qgraph)
library(CliquePercolation)
library(colorspace)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Unweighted network with eight nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
W <- matrix(c(0,1,1,1,0,0,0,0,
0,0,1,1,0,0,0,0,
0,0,0,0,0,0,0,0,
0,0,0,0,1,1,1,0,
0,0,0,0,0,1,1,0,
0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0), nrow = 8, ncol = 8, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
qgraph(W, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Six 3-cliques in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color1 <- c("#ff9600","#ff9600","#ff9600","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color2 <- c("#ff9600","#7f7f7f","#7f7f7f","#ff9600","#ff9600","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color3 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600","#ff9600",
"#ff9600","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color4 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600","#7f7f7f",
"#7f7f7f","#ff9600","#ff9600","#7f7f7f","#7f7f7f")
color5 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#ff9600",
"#7f7f7f","#ff9600","#7f7f7f","#ff9600","#7f7f7f")
color6 <- c("#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f",
"#ff9600","#7f7f7f","#ff9600","#ff9600","#7f7f7f")
layout(matrix(c(1,2,3,
4,5,6), ncol = 3, nrow = 2, byrow = TRUE))
qgraph(W, edge.color = color1, edge.width = 4)
qgraph(W, edge.color = color2, edge.width = 4)
qgraph(W, edge.color = color3, edge.width = 4)
qgraph(W, edge.color = color4, edge.width = 4)
qgraph(W, edge.color = color5, edge.width = 4)
qgraph(W, edge.color = color6, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Two communities in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color7 <- c("#00AD9A","#00AD9A","#00AD9A","#00AD9A","#00AD9A","#E16A86","#E16A86",
"#E16A86","#E16A86","#E16A86","#E16A86","#7f7f7f")
qgraph(W, edge.color = color7, edge.width = 4)
## ---- echo = FALSE, results = FALSE, dpi = 300, fig.cap = "**Community partition by node coloring in unweighted network.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cp <- cpAlgorithm(qgraph(W, DoNotPlot = TRUE), k = 3, method = "unweighted")
cpColoredGraph(qgraph(W, DoNotPlot = TRUE), cp$list.of.communities.labels, edge.width = 4)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Weighted network with eight nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
layout <- qgraph(W, DoNotPlot = TRUE)$layout
W <- matrix(c(0,.1,.3,.3,0,0,0,0,
0,0,.2,.2,0,0,0,0,
0,0,0,0,0,0,0,0,
0,0,0,0,.1,.1,.1,0,
0,0,0,0,0,.1,.1,0,
0,0,0,0,0,0,.1,0,
0,0,0,0,0,0,0,-.2,
0,0,0,0,0,0,0,0), nrow = 8, ncol = 8, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
qgraph(W, theme = "colorblind", cut = 0.02, edge.labels = TRUE, layout = layout)
## ---- echo = FALSE, dpi = 300, fig.cap = "**Surviving cliques in weighted network depending on I.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
color8 <- c("#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#7f7f7f","#7f7f7f",
"#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f","#7f7f7f")
color9 <- c("#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#ff9600","#ff9600",
"#ff9600","#ff9600","#ff9600","#ff9600","#7f7f7f")
layout(matrix(c(1,2), ncol = 2, nrow = 1, byrow = TRUE))
qgraph(W, edge.color = color8, theme = "colorblind", cut = 0.02, edge.labels = TRUE,
layout = layout, fade = FALSE, title = "k = 3, I = 0.17", title.cex = 0.5)
qgraph(W, edge.color = color9, theme = "colorblind", cut = 0.02, edge.labels = TRUE,
layout = layout, fade = FALSE, title = "k = 3, I = 0.09", title.cex = 0.5)
## ----setup--------------------------------------------------------------------
library(CliquePercolation) #version 0.3.0
library(qgraph) #version 1.6.5
library(Matrix) #version 1.2-18
## ---- echo = TRUE, dpi = 400, fig.cap = "**Weighted network with 150 nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "100%"----
# create qgraph object; 150 nodes with letters as names; 1/7 of edges different from zero
W <- matrix(c(0), nrow = 150, ncol = 150, byrow = TRUE)
name.vector <- paste(letters[rep(seq(from = 1, to = 26), each = 26)],
letters[seq(from = 1, to = 26)], sep = "")[1:nrow(W)]
rownames(W) <- name.vector
colnames(W) <- name.vector
set.seed(4186)
W[upper.tri(W)] <- sample(c(rep(0,6),1), length(W[upper.tri(W)]), replace = TRUE)
rand_w <- stats::rnorm(length(which(W == 1)), mean = 0.3, sd = 0.1)
W[which(W == 1)] <- rand_w
W <- Matrix::forceSymmetric(W)
W <- qgraph::qgraph(W, theme = "colorblind", layout = "spring", cut = 0.4)
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# thresholds <- cpThreshold(W, method = "weighted", k.range = c(3,4),
# I.range = c(seq(0.40, 0.01, by = -0.005)),
# threshold = c("largest.components.ratio","chi"))
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# thresholds
## ---- echo = TRUE-------------------------------------------------------------
cpk3I.35 <- cpAlgorithm(W, k = 3, method = "weighted", I = 0.35)
cpk4I.27 <- cpAlgorithm(W, k = 4, method = "weighted", I = 0.27)
## ---- echo = TRUE-------------------------------------------------------------
cpk3I.35
## ---- echo = TRUE, results = FALSE--------------------------------------------
summary(cpk3I.35)
## ---- echo = TRUE, results = FALSE--------------------------------------------
summary(cpk3I.35, details = "shared.nodes.numbers")
## ---- echo = TRUE, results = FALSE--------------------------------------------
cpk3I.35$list.of.communities.numbers
## ---- echo = TRUE, results = FALSE--------------------------------------------
cpk3I.35$list.of.communities.labels
## ---- echo = TRUE, results = FALSE, dpi = 300, fig.cap = "**Community size distribution with k = 3 and I = 0.35.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers)
## ---- echo = TRUE, results = FALSE, dpi = 300, fig.cap = "**Community size distribution with k = 4 and I = 0.27.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
cpCommunitySizeDistribution(cpk4I.27$list.of.communities.numbers)
## ---- echo = TRUE, eval = FALSE-----------------------------------------------
# fit_pl_k3I.35 <- cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers, test.power.law = TRUE)
## ---- include = FALSE---------------------------------------------------------
fit_pl_k3I.35 <- cpCommunitySizeDistribution(cpk3I.35$list.of.communities.numbers, test.power.law = TRUE)
## ---- echo = TRUE-------------------------------------------------------------
fit_pl_k3I.35$fit.power.law
## ---- echo = TRUE, dpi = 400, fig.cap = "**Community network with k = 3 and I = 0.35.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "100%"----
commnetwork <- cpCommunityGraph(cpk3I.35$list.of.communities.numbers,
node.size.method = "proportional",
max.node.size = 20,
theme = "colorblind", layout = "spring", repulsion = 0.4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
commnetwork$community.weights.matrix
## ---- echo = TRUE, dpi = 300, fig.cap = "**Unweighted network with ten nodes.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
W <- matrix(c(0,1,1,1,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,1,1,0,0,0,0,
0,0,0,0,0,1,0,0,0,0,
0,0,0,0,0,0,1,1,1,0,
0,0,0,0,0,0,0,1,1,0,
0,0,0,0,0,0,0,0,1,0,
0,0,0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,0,0), nrow = 10, ncol = 10, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
W <- qgraph(W, edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
thresholds.small <- cpThreshold(W, method = "unweighted", k.range = c(3,4),
threshold = "entropy")
## ---- echo = TRUE-------------------------------------------------------------
thresholds.small
## ---- echo = TRUE, results = FALSE--------------------------------------------
permute <- cpPermuteEntropy(W, cpThreshold.object = thresholds.small,
n = 100, interval = 0.95,
ncores = 2, seed = 4186)
## ---- echo = TRUE-------------------------------------------------------------
permute
## ---- echo = TRUE, results = FALSE--------------------------------------------
permute$Confidence.Interval
permute$Extracted.Rows
## ---- echo = TRUE-------------------------------------------------------------
cpk3 <- cpAlgorithm(W, k = 3, method = "unweighted")
## ---- echo = TRUE-------------------------------------------------------------
cpk3
summary(cpk3)
## ---- echo = TRUE, results = FALSE--------------------------------------------
thresholds.small.fuzzymod <- cpThreshold(W, method = "unweighted", k.range = c(3,4),
threshold = c("entropy","fuzzymod"))
## ---- echo = TRUE-------------------------------------------------------------
thresholds.small.fuzzymod
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring I.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net1 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
colored.net1$colors.communities
colored.net1$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring II.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net2 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
h.cp = c(50, 210), c.cp = 70, l.cp = 70,
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring III.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#define list.of.sets
list.of.sets1 <- list(c("a","b","c","d","e","f"), c("g","h","i","j"))
colored.net3 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets1,
edge.width = 4)
## ---- echo = TRUE, results = FALSE--------------------------------------------
colored.net3$basic.colors.sets
## ---- echo = FALSE, dpi = 300, fig.cap = "**Color patches.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
swatchplot(colored.net3$basic.colors.sets)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring IV.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net4 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets1, set.palettes.size = 5,
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring V.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#define list.of.sets
list.of.sets2 <- list(c("a","d","e","f","g"), c("b","c","h","i","j"))
colored.net5 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets2,
edge.width = 4)
## ---- echo = TRUE-------------------------------------------------------------
colored.net5$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring VI.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
set.seed(4186)
colored.net6 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
list.of.sets = list.of.sets2,
avoid.repeated.mixed.colors = TRUE,
edge.width = 4)
## ---- echo = TRUE-------------------------------------------------------------
colored.net6$colors.nodes
## ---- echo = TRUE, dpi = 300, fig.cap = "**Community coloring VI.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
colored.net6 <- cpColoredGraph(W, list.of.communities = cpk3$list.of.communities.labels,
own.colors = c("#FF0000","#00FF00","#0000FF"),
edge.width = 4)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Large network with 11 communities colored with qualitative_hcl.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
#generate network with 11 communities
W <- matrix(c(0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0), nrow = 25, ncol = 25, byrow = TRUE)
W <- forceSymmetric(W)
rownames(W) <- letters[seq(from = 1, to = nrow(W))]
colnames(W) <- letters[seq(from = 1, to = nrow(W))]
W <- qgraph(W, DoNotPlot = TRUE)
#run the clique percolation method
cpk3.large <- cpAlgorithm(W, k = 3, method = "unweighted")
#plot the network colored according to community partition (with qualitative_hcl)
colored.net.large1 <- cpColoredGraph(W, list.of.communities = cpk3.large$list.of.communities.labels, edge.width = 4, layout = "spring", repulsion = 0.9)
## ---- echo = TRUE, dpi = 300, fig.cap = "**Large network with 11 communities colored with createPalette.**", fig.align = "center", out.extra = 'style = "border:none"', out.width = "60%"----
set.seed(4186)
colored.net.large2 <- cpColoredGraph(W, list.of.communities = cpk3.large$list.of.communities.labels,
larger.six = TRUE,
edge.width = 4, layout = "spring", repulsion = 0.9)
Try the CliquePercolation package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.