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
|
## ---- include=FALSE-----------------------------------------------------------
set.seed(2022)
## ---- message=FALSE-----------------------------------------------------------
library(ggraph)
library(tidygraph)
library(purrr)
library(rlang)
set_graph_style(plot_margin = margin(1,1,1,1))
hierarchy <- as_tbl_graph(hclust(dist(iris[, 1:4]))) %>%
mutate(Class = map_bfs_back_chr(node_is_root(), .f = function(node, path, ...) {
if (leaf[node]) {
as.character(iris$Species[as.integer(label[node])])
} else {
species <- unique(unlist(path$result))
if (length(species) == 1) {
species
} else {
NA_character_
}
}
}))
hairball <- as_tbl_graph(highschool) %>%
mutate(
year_pop = map_local(mode = 'in', .f = function(neighborhood, ...) {
neighborhood %E>% pull(year) %>% table() %>% sort(decreasing = TRUE)
}),
pop_devel = map_chr(year_pop, function(pop) {
if (length(pop) == 0 || length(unique(pop)) == 1) return('unchanged')
switch(names(pop)[which.max(pop)],
'1957' = 'decreased',
'1958' = 'increased')
}),
popularity = map_dbl(year_pop, ~ .[1]) %|% 0
) %>%
activate(edges) %>%
mutate(year = as.character(year))
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'stress') +
geom_edge_link(aes(colour = year))
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'stress') +
geom_edge_fan(aes(colour = year))
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'stress') +
geom_edge_parallel(aes(colour = year))
## -----------------------------------------------------------------------------
# let's make some of the student love themselves
loopy_hairball <- hairball %>%
bind_edges(tibble::tibble(from = 1:5, to = 1:5, year = rep('1957', 5)))
ggraph(loopy_hairball, layout = 'stress') +
geom_edge_link(aes(colour = year), alpha = 0.25) +
geom_edge_loop(aes(colour = year))
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'stress') +
geom_edge_density(aes(fill = year)) +
geom_edge_link(alpha = 0.25)
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'linear') +
geom_edge_arc(aes(colour = year))
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'linear', circular = TRUE) +
geom_edge_arc(aes(colour = year)) +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(hierarchy, layout = 'dendrogram', height = height) +
geom_edge_elbow()
## -----------------------------------------------------------------------------
ggraph(hierarchy, layout = 'dendrogram', height = height) +
geom_edge_diagonal()
## -----------------------------------------------------------------------------
ggraph(hierarchy, layout = 'dendrogram', height = height) +
geom_edge_bend()
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'hive', axis = pop_devel, sort.by = popularity) +
geom_edge_hive(aes(colour = year)) +
geom_axis_hive(label = FALSE) +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'fabric', sort.by = node_rank_fabric()) +
geom_node_range(colour = 'grey') +
geom_edge_span(end_shape = 'circle') +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'matrix', sort.by = bfs_rank()) +
geom_edge_point() +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'matrix', sort.by = bfs_rank()) +
geom_edge_tile() +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(hairball, layout = 'linear') +
geom_edge_arc(aes(colour = year, alpha = after_stat(index))) +
scale_edge_alpha('Edge direction', guide = 'edge_direction')
## -----------------------------------------------------------------------------
ggraph(hierarchy, layout = 'dendrogram', height = height) +
geom_edge_elbow2(aes(colour = node.Class))
## -----------------------------------------------------------------------------
small_tree <- create_tree(5, 2)
ggraph(small_tree, 'dendrogram') +
geom_edge_elbow(strength = 0.75)
## -----------------------------------------------------------------------------
ggraph(small_tree, 'dendrogram') +
geom_edge_diagonal(strength = 0.5)
## -----------------------------------------------------------------------------
# Random names - I swear
simple <- create_notable('bull') %>%
mutate(name = c('Thomas', 'Bob', 'Hadley', 'Winston', 'Baptiste')) %>%
activate(edges) %>%
mutate(type = sample(c('friend', 'foe'), 5, TRUE))
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'graphopt') +
geom_edge_link(arrow = arrow(length = unit(4, 'mm'))) +
geom_node_point(size = 5)
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'graphopt') +
geom_edge_link(arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5)
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'linear', circular = TRUE) +
geom_edge_arc(arrow = arrow(length = unit(4, 'mm')),
start_cap = circle(3, 'mm'),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5) +
coord_fixed()
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'graphopt') +
geom_edge_link(aes(start_cap = label_rect(node1.name),
end_cap = label_rect(node2.name)),
arrow = arrow(length = unit(4, 'mm'))) +
geom_node_text(aes(label = name))
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'graphopt') +
geom_edge_link(aes(label = type),
arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5)
## -----------------------------------------------------------------------------
ggraph(simple, layout = 'graphopt') +
geom_edge_link(aes(label = type),
angle_calc = 'along',
label_dodge = unit(2.5, 'mm'),
arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5)
## -----------------------------------------------------------------------------
flaregraph <- tbl_graph(flare$vertices, flare$edges)
from <- match(flare$imports$from, flare$vertices$name)
to <- match(flare$imports$to, flare$vertices$name)
ggraph(flaregraph, layout = 'dendrogram', circular = TRUE) +
geom_conn_bundle(data = get_con(from = from, to = to), alpha = 0.1) +
coord_fixed()
|
