{tidygraph}と{ggraph}によるモダンなネットワーク分析
11 likes5,672 views
This document analyzes correlations between characteristics of different whiskies. It creates a correlation matrix between 12 whisky characteristics for 67 distilleries. It then transforms this into a graph with distilleries as nodes and correlations above 0.8 as edges. Various graph metrics and visualizations are calculated and displayed, including communities detected within the graph.
![#
colnames(cor.mat) <- whiskies$Distillery
rownames(cor.mat) <- whiskies$Distillery
#
cor.mat[upper.tri(cor.mat, diag = TRUE)] <- NA
cor.mat[1:5, 1:5]
Aberfeldy Aberlour AnCnoc Ardbeg Ardmore
Aberfeldy NA NA NA NA NA
Aberlour 0.7086322 NA NA NA NA
AnCnoc 0.6973541 0.5030737 NA NA NA
Ardbeg -0.1473114 -0.2285909 -0.1404355 NA NA
Ardmore 0.7319024 0.5118338 0.5570195 0.2316174 NA](https://image.slidesharecdn.com/20180421tokyor69-180421074728/85/tidygraph-ggraph-17-320.jpg)
![#
g %>% igraph::graph.density()
[1] 0.06105834
#
g %>% igraph::transitivity()
[1] 0.2797927
# ( 1)
g %>% igraph::reciprocity()
[1] 1](https://image.slidesharecdn.com/20180421tokyor69-180421074728/85/tidygraph-ggraph-24-320.jpg)
{tidygraph}と{ggraph}によるモダンなネットワーク分析
- 9. 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 A B B C C E D B E D E F
- 16. # whiskies <- data.table::fread("http:// outreach.mathstat.strath.ac.uk/outreach/nessie/datasets/ whiskies.txt", header = TRUE) # cor.mat <- whiskies %>% select(Body, Sweetness, Smoky, Medicinal, Tobacco, Honey, Spicy, Winey, Nutty, Malty, Fruity, Floral) %>% t() %>% cor()
- 17. # colnames(cor.mat) <- whiskies$Distillery rownames(cor.mat) <- whiskies$Distillery # cor.mat[upper.tri(cor.mat, diag = TRUE)] <- NA cor.mat[1:5, 1:5] Aberfeldy Aberlour AnCnoc Ardbeg Ardmore Aberfeldy NA NA NA NA NA Aberlour 0.7086322 NA NA NA NA AnCnoc 0.6973541 0.5030737 NA NA NA Ardbeg -0.1473114 -0.2285909 -0.1404355 NA NA Ardmore 0.7319024 0.5118338 0.5570195 0.2316174 NA
- 18. # Long-Format 0.8 d <- cor.mat %>% as.data.frame() %>% mutate(distillerry1 = whiskies$Distillery) %>% gather(key = distillerry2, value = cor, -distillerry1) %>% select(distillerry1, distillerry2, cor) %>% filter(!is.na(cor) & cor >= 0.80) head(d) distillerry1 distillerry2 cor 1 Auchroisk Aberfeldy 0.8238415 2 Benrinnes Aberfeldy 0.8419479 3 Benromach Aberfeldy 0.8554217
- 20. # tbl_graph g <- as_tbl_graph(d, directed = FALSE) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Node Data: 67 x 1 (active) name <chr> 1 Auchroisk 2 Benrinnes
- 21. # tbl_graph g <- as_tbl_graph(d, directed = FALSE) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Node Data: 67 x 1 (active) name <chr> 1 Auchroisk 2 Benrinnes
- 22. 3 Benromach 4 BlairAthol 5 RoyalLochnagar 6 Speyside # ... with 61 more rows # # Edge Data: 135 x 3 from to cor <int> <int> <dbl> 1 1 54 0.824 2 2 54 0.842 3 3 54 0.855 # ... with 132 more rows
- 23. 3 Benromach 4 BlairAthol 5 RoyalLochnagar 6 Speyside # ... with 61 more rows # # Edge Data: 135 x 3 from to cor <int> <int> <dbl> 1 1 54 0.824 2 2 54 0.842 3 3 54 0.855 # ... with 132 more rows
- 24. # g %>% igraph::graph.density() [1] 0.06105834 # g %>% igraph::transitivity() [1] 0.2797927 # ( 1) g %>% igraph::reciprocity() [1] 1
- 25. # g <- g %>% mutate(centrality = centrality_betweenness()) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Node Data: 67 x 2 (active) name centrality <chr> <dbl> 1 Auchroisk 174. 2 Benrinnes 122. 3 Benromach 411.
- 26. # g <- g %E>% mutate(centrality = centrality_edge_betweenness()) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Edge Data: 135 x 4 (active) from to cor centrality <int> <int> <dbl> <dbl> 1 1 54 0.824 79.3 2 2 54 0.842 42.9 3 3 54 0.855 54.2
- 27. # g <- g %E>% mutate(centrality = centrality_edge_betweenness()) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Edge Data: 135 x 4 (active) from to cor centrality <int> <int> <dbl> <dbl> 1 1 54 0.824 79.3 2 2 54 0.842 42.9 3 3 54 0.855 54.2
- 28. # g <- g %>% mutate(community = as.factor(group_fast_greedy(weights = cor))) g # A tbl_graph: 67 nodes and 135 edges # # An undirected simple graph with 1 component # # Node Data: 67 x 2 (active) name community <chr> <fct> 1 Auchroisk 2 2 Benrinnes 3 3 Benromach 2
- 30. g %>% ggraph(layout = "kk")
- 32. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray")
- 34. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1))
- 36. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree))
- 38. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE)
- 40. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()
- 42. g %>% ggraph(layout = "kk") + geom_edge_arc(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + theme_graph(background = "grey20", text_colour = "white")
- 45. g %>% mutate(degree = centrality_degree(), community = as.factor(group_fast_greedy(weights = cor))) %>% filter(degree >= 6) %E>% filter(cor > 0.85) %>% ggraph(layout = "lgl") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()
- 46. g %>% ggraph(layout = "kk") + geom_edge_fan(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()
- 47. g %>% ggraph(layout = "linear") + geom_edge_arc(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()
- 49. g %>% ggraph(layout = "linear", circular = TRUE) + geom_edge_arc(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()
- 51. # d <- whiskies %>% select(Body, Sweetness, Smoky, Medicinal, Tobacco, Honey, Spicy, Winey, Nutty, Malty, Fruity, Floral) %>% dist() # hc <- hclust(d, method="ward.D2") # tbl_graph g <- as_tbl_graph(hc)
- 52. g %>% ggraph(layout = "kk") + geom_edge_link(aes(width = cor), alpha = 0.8, colour = "lightgray") + scale_edge_width(range = c(0.1, 1)) + geom_node_point(aes(colour = community, size = degree)) + geom_node_text(aes(label = name), repel = TRUE) + theme_graph()