-
Notifications
You must be signed in to change notification settings - Fork 19
/
2020_11_24_hiking.R
71 lines (64 loc) · 3.78 KB
/
2020_11_24_hiking.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
library(tidytuesdayR)
library(tidyverse)
library(stringr)
library(widyr)
library(tidygraph)
library(ggraph)
tuesdata <- tidytuesdayR::tt_load('2020-11-24')
data = tuesdata$hike_data %>%
mutate(across(gain:rating, as.numeric),
length = parse_number(length)) %>%
unnest(cols = c(features)) %>%
filter(features != "Dogs not allowed")
inits = data.frame(name = (data %>% pull(features) %>% unique())) %>%
mutate(init = case_when(name == "Dogs allowed on leash" ~ "DA",
name == "Wildlife" ~ "Wl",
name == "Good for kids" ~ "GK",
name == "Lakes" ~ "Lk",
name == "Fall foliage" ~ "FF",
name == "Ridges/passes" ~ "RP",
name == "Established campsites" ~ "EC",
name == "Mountain views" ~ "MV",
name == "Old growth" ~ "OG",
name == "Waterfalls" ~ "Wf",
name == "Wildflowers/Meadows" ~ "WM",
name == "Rivers" ~ "Ri",
name == "Coast" ~ "Co",
name == "Summits" ~ "Su"),
type = if_else(init %in% c("DA","DN","GK"), "Companion", "Feature"))
correlation = data %>%
pairwise_cor(item = features, feature = name, upper = T) %>%
filter(abs(correlation) > 0.1) %>%
as_tbl_graph() %>%
activate(nodes) %>%
left_join(inits) %>%
arrange(name)
ggraph(correlation, "stress") +
# geoms
geom_edge_link(aes(color = correlation, width = abs(correlation))) +
geom_node_point(aes(color = type), size = 10) +
geom_node_text(aes(label = init), color = "#2a2a2aff") +
# scales
scale_edge_color_gradient2(high = "#8aab37ff", low = "#00557bff", name = "CORR.") +
scale_edge_width(range = c(1,3), guide = F) +
scale_color_manual(values = c("#8a8a8a","#bdbdbdff"), name = "CATEGORY") +
scale_discrete_identity(aesthetics = "label",
name = "KEY",
breaks = activate(correlation, "nodes") %>% pull(init),
labels = paste0("— ", activate(correlation, "nodes") %>% pull(name)),
guide = "legend") +
# themes
guides(edge_color = guide_edge_colorbar(direction = "horizontal")) +
theme_graph() +
theme(plot.background = element_rect(fill = "#f3f3f3ff"),
text = element_text(color = "#2a2a2aff", family = "Berlin Sans FB"),
legend.title = element_text(face = "bold", family = "Berlin Sans FB Demi"),
plot.title = element_text(face = "bold", family = "Berlin Sans FB Demi", size = 30),
plot.subtitle = element_text(family = "Berlin Sans FB"),
plot.caption = element_text(hjust = 0, color = "#8a8a8a"),
legend.box.background = element_rect(fill = "white", color = NA),
legend.box.margin = margin(.5,.5,.5,.5,"cm")) +
# labels
labs(title = "HIKING IN WASHINGTON:\nWHAT YOU'LL SEE AND WHO YOU'LL SEE IT WITH",
subtitle = "The Washington Trails Association helpfully provides a hiking guide written by local experts. Each trail is flagged with different features one will encounter\n- rivers, mountains, waterfalls - and the companions you can bring - children and/or dogs.\n\nThis graph explores the underlying relationship between these two categories. It is seen that child-friendly routes are also commonly dog-friendly, and that\nthe Trails Association discourages bringing children to mountainous routes with features like summits, ridges and passes. Kids are more than welcome to\nenjoy wildlife and coastal routes, however, and your dog will be happy to romp in the fall foliage!",
caption = "Data from the Washington Trails Association (www.wta.org) | Visualisation by Jack Davison (Twitter @JDavison_ | Github jack-davison)")