3.8 Small Worlds
set.seed(42)
# the order of the graph
n <- 10
# the dimension of the original grid
dim <- 1
# the number of neighbors in the original grid
nei <- 3
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
# creating an example of G(n, p) model
g <- sample_smallworld(dim, n, nei, p)
plot(g,
layout = layout_in_circle,
vertex.size = 2,
vertex.label = NA,
edge.lty = 3,
main = glue('Watts-Strogatz Graph on ', n, ' Nodes and Rewiring Probability ', p),
sub = glue('Starting with a ', dim ,
'-Dimensional Lattice \n Where Each Node Has ', nei,
' Neighbors Clockwise Originally'))
writeLines('\n')
}
set.seed(42)
n <- 100
dim <- 1
nei <- 3
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
plot(g,
layout = layout_in_circle,
vertex.size = 2,
vertex.label = NA,
edge.lty = 3,
main = glue('Watts-Strogatz Graph on ', n, ' Nodes and Rewiring Probability ', p),
sub = glue('Starting with a ', dim ,
'-Dimensional Lattice \n Where Each Node Has ', nei,
' Neighbors Clockwise Originally'))
writeLines('\n')
}
set.seed(42)
n <- 100
dim <- 1
nei <- 3
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
print(ggraph(g, layout = 'circle') +
geom_edge_arc2(edge_linetype = 3, color = 'dark blue', alpha = 0.25) +
geom_node_point(color = 'dark red', size = 2, alpha = 0.75) +
theme_graph(base_family = 'Helvetica') +
labs(title = glue('Watts-Strogatz Graph on ', n, ' Nodes \n and Rewiring Probability ', p),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice \n Where Each Node Has ', nei,
' Neighbors Clockwise Originally')))
writeLines('\n')
}
set.seed(42)
n <- 50
dim <- 1
nei <- 3
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
df <- enframe(eccentricity(g))
df <- df %>% select(name, value)
names(df) <- c('name', 'eccentricity')
print(df %>%
ggplot(aes(x = eccentricity, y = ..density..)) +
geom_density(fill = 'red', alpha = 0.5, size = 2, color = 'blue') +
labs(title = glue('KDE of Eccentricity for an Example of Watts-Strogatz Model \n on ', n,
' Nodes and Rewiring Probability ', p),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')))
writeLines('\n')
}
set.seed(42)
n <- 50
dim <- 1
nei <- 3
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
df <- enframe(transitivity(g, type = c('local')))
df <- df %>% select(name, value)
names(df) <- c('name', 'clustering')
print(df %>%
ggplot(aes(x = clustering, y = ..density..)) +
geom_density(fill = 'red', alpha = 0.5, size = 2, color = 'blue', na.rm = TRUE) +
labs(title = glue('KDE of Local Clustering Coefficient for an Example of Watts-Strogatz Model \n on ', n,
' Nodes and Rewiring Probability ', p),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')))
writeLines('\n')
}
set.seed(42)
n <- 100
dim <- 1
nei <- 3
p <- 0
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
df <- enframe(eccentricity(g))
df <- df %>% select(name, value)
names(df) <- c('name', 'eccentricity')
print(df %>%
ggplot(aes(x = eccentricity, y = ..density..)) +
geom_density(fill = 'red', alpha = 0.5, size = 2, color = 'blue', na.rm = TRUE) +
labs(title = glue('KDE of Eccentricity for an Example of Watts-Strogatz Model \n on ', n,
' Nodes and Rewiring Probability ', p),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')))
writeLines('\n')
}
set.seed(42)
n <- 100
dim <- 1
nei <- 3
p <- 0
for (p in c(0, 0.05, 0.3, 0.5, 0.7, 0.95, 1)) {
g <- sample_smallworld(dim, n, nei, p)
df <- enframe(transitivity(g, type = c('local')))
df <- df %>% select(name, value)
names(df) <- c('name', 'clustering')
print(df %>%
ggplot(aes(x = clustering, y = ..density..)) +
geom_density(fill = 'red', alpha = 0.5, size = 2, color = 'blue', na.rm = TRUE) +
labs(title = glue('KDE of Local Clustering Coefficient for an Example of Watts-Strogatz Model \n on ', n,
' Nodes and Rewiring Probability ', p),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')))
writeLines('\n')
}
Figure 3.14(d) on p. 97
set.seed(42)
n <- 100
dim <- 1
nei <- 3
g <- sample_smallworld(dim, n, nei, 0.0000001)
d0 <- mean_distance(g, directed = FALSE, unconnected = TRUE)
df <- tibble(p = 0.0000001, avg_deg = mean_distance(g, directed = FALSE, unconnected = TRUE) / d0)
P <- c(0.0001, 0.0002, 0.0005, 0.0007, 0.001,
0.002, 0.005, 0.007, 0.01, 0.02,
0.05, 0.07, 0.1, 0.2, 0.5, 0.7, 1)
for (p in P) {
g <- sample_smallworld(dim, n, nei, p)
DF <- tibble(p = p, avg_deg = mean_distance(g, directed = FALSE, unconnected = TRUE) / d0)
df <- rbind(df, DF)
}
df
df %>%
filter(p != 0.0000001) %>%
ggplot(aes(x = p, y = avg_deg)) +
geom_point(color = 'blue') +
labs(title = glue('Normalized Average Degree for Watts-Strogatz Graphs on \n ', n, ' Nodes'),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')) +
scale_x_log10()
set.seed(42)
n <- 100
dim <- 1
nei <- 3
g <- sample_smallworld(dim, n, nei, 0.0000001)
c0 <- mean(transitivity(g, type = c('local')), na.rm = TRUE)
df <- tibble(p = 0.0000001, avg_cc = mean(transitivity(g, type = c('local')), na.rm = TRUE) / c0)
P <- c(0.0001, 0.0002, 0.0005, 0.0007, 0.001,
0.002, 0.005, 0.007, 0.01, 0.02, 0.05,
0.07, 0.1, 0.2, 0.5, 0.7, 1)
for (p in P) {
g <- sample_smallworld(dim, n, nei, p)
DF <- tibble(p = p, avg_cc = mean(transitivity(g, type = c('local')), na.rm = TRUE) / c0)
df <- rbind(df, DF)
}
df
df %>%
filter(p != 0.0000001) %>%
ggplot(aes(x = p, y = avg_cc)) +
geom_point(color = 'red') +
labs(title = glue('Normalized Average Local Clustering Coefficient for Watts-Strogatz Graphs \n on ', n, ' Nodes'),
subtitle = glue('Starting with a ', dim ,
'-Dimensional Lattice Where Each Node Has ', nei,
' Neighbors Clockwise Originally')) +
scale_x_log10()
