1 网络图

https://igraph.org/

https://r.igraph.org/

https://ggraph.data-imaginist.com/

https://tidygraph.data-imaginist.com/index.html

https://yufree.cn/cn/2020/06/24/r-network-analysis/

https://kateto.net/network-visualization

1.1 tbl_graph

Code
library(tidygraph)
library(ggraph)
rstat_nodes <- data.frame(name = c("Hadley", "David", "Romain", "Julia"))
rstat_edges <- data.frame(from = c(1, 1, 1, 2, 3, 3, 4, 4, 4),
                            to = c(2, 3, 4, 1, 1, 2, 1, 2, 3))
tbl_graph(nodes = rstat_nodes, edges = rstat_edges)
#> # A tbl_graph: 4 nodes and 9 edges
#> #
#> # A directed simple graph with 1 component
#> #
#> # Node Data: 4 × 1 (active)
#>   name  
#>   <chr> 
#> 1 Hadley
#> 2 David 
#> 3 Romain
#> 4 Julia 
#> #
#> # Edge Data: 9 × 2
#>    from    to
#>   <int> <int>
#> 1     1     2
#> 2     1     3
#> 3     1     4
#> # ℹ 6 more rows

1.2 节点

Code

highschool %>% as_tibble()
#> # A tibble: 506 × 3
#>     from    to  year
#>    <dbl> <dbl> <dbl>
#>  1     1    14  1957
#>  2     1    15  1957
#>  3     1    21  1957
#>  4     1    54  1957
#>  5     1    55  1957
#>  6     2    21  1957
#>  7     2    22  1957
#>  8     3     9  1957
#>  9     3    15  1957
#> 10     4     5  1957
#> # ℹ 496 more rows


gr <- as_tbl_graph(highschool)
gr
#> # A tbl_graph: 70 nodes and 506 edges
#> #
#> # A directed multigraph with 1 component
#> #
#> # Node Data: 70 × 0 (active)
#> #
#> # Edge Data: 506 × 3
#>    from    to  year
#>   <int> <int> <dbl>
#> 1     1    13  1957
#> 2     1    14  1957
#> 3     1    20  1957
#> # ℹ 503 more rows

create_layout(gr,layout = "kk") %>% 
    ggplot()+
    theme(
        axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
    )+
    geom_point(aes(x = x, y = y))

Code


ggraph(gr, layout = "kk") + 
  geom_point(aes(x = x, y = y))

Code

ggraph(gr, layout = 'kk') + 
  geom_node_point()

Code
gr2 <- tbl_graph(flare$vertices, flare$edges)
gr2
#> # A tbl_graph: 252 nodes and 251 edges
#> #
#> # A rooted tree
#> #
#> # Node Data: 252 × 3 (active)
#>    name                                            size shortName            
#>    <chr>                                          <dbl> <chr>                
#>  1 flare.analytics.cluster.AgglomerativeCluster    3938 AgglomerativeCluster 
#>  2 flare.analytics.cluster.CommunityStructure      3812 CommunityStructure   
#>  3 flare.analytics.cluster.HierarchicalCluster     6714 HierarchicalCluster  
#>  4 flare.analytics.cluster.MergeEdge                743 MergeEdge            
#>  5 flare.analytics.graph.BetweennessCentrality     3534 BetweennessCentrality
#>  6 flare.analytics.graph.LinkDistance              5731 LinkDistance         
#>  7 flare.analytics.graph.MaxFlowMinCut             7840 MaxFlowMinCut        
#>  8 flare.analytics.graph.ShortestPaths             5914 ShortestPaths        
#>  9 flare.analytics.graph.SpanningTree              3416 SpanningTree         
#> 10 flare.analytics.optimization.AspectRatioBanker  7074 AspectRatioBanker    
#> # ℹ 242 more rows
#> #
#> # Edge Data: 251 × 2
#>    from    to
#>   <int> <int>
#> 1   221     1
#> 2   221     2
#> 3   221     3
#> # ℹ 248 more rows


create_layout(gr2,layout = "partition") 
#> # A tibble: 252 × 12
#>        x     y width height circular leaf  depth name           size shortName
#>    <dbl> <dbl> <dbl>  <dbl> <lgl>    <lgl> <dbl> <chr>         <dbl> <chr>    
#>  1 110     1.5   220      1 FALSE    FALSE     0 flare             0 flare    
#>  2  10     2.5    20      1 FALSE    FALSE     1 flare.animate     0 animate  
#>  3  25.5   2.5    11      1 FALSE    FALSE     1 flare.data        0 data     
#>  4  33     2.5     4      1 FALSE    FALSE     1 flare.display     0 display  
#>  5  35.5   2.5     1      1 FALSE    FALSE     1 flare.flex        0 flex     
#>  6  40     2.5     8      1 FALSE    FALSE     1 flare.physics     0 physics  
#>  7  74     2.5    60      1 FALSE    FALSE     1 flare.query       0 query    
#>  8 109     2.5    10      1 FALSE    FALSE     1 flare.scale       0 scale    
#>  9 126.    2.5    25      1 FALSE    FALSE     1 flare.util        0 util     
#> 10 174.    2.5    71      1 FALSE    FALSE     1 flare.vis         0 vis      
#> # ℹ 242 more rows
#> # ℹ 2 more variables: .ggraph.orig_index <int>, .ggraph.index <int>

create_layout(gr2,layout = "partition") %>% 
    ggplot()+
    theme(
        axis.text = element_blank(),
        axis.title = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_blank(),
    )+
    geom_tile(aes(x=x,y = -y, fill = depth))

Code

ggraph(gr2, layout = 'partition') + 
  geom_node_tile(aes(y = -y, fill = depth))

1.3 边

Code
library(ggraph)
library(tidygraph)

highschool$year <- factor(highschool$year)

gr <- as_tbl_graph(highschool) %>% 
    activate(edges)

gr
#> # A tbl_graph: 70 nodes and 506 edges
#> #
#> # A directed multigraph with 1 component
#> #
#> # Edge Data: 506 × 3 (active)
#>     from    to year 
#>    <int> <int> <chr>
#>  1     1    13 1957 
#>  2     1    14 1957 
#>  3     1    20 1957 
#>  4     1    52 1957 
#>  5     1    53 1957 
#>  6     2    20 1957 
#>  7     2    21 1957 
#>  8     3     9 1957 
#>  9     3    14 1957 
#> 10     4     5 1957 
#> # ℹ 496 more rows
#> #
#> # Node Data: 70 × 0

# link

ggraph(gr, layout = 'kk') + 
  geom_edge_link(aes(colour = year))

Code


# fan

ggraph(gr, layout = 'kk') + 
  geom_edge_fan(aes(colour = year))

Code

# parallel

ggraph(gr, layout = 'kk') + 
  geom_edge_parallel(aes(colour = year))

Code

# loop  make some of the student love themselves
loopy_gr<- gr |> 
  bind_edges(tibble::tibble(from = 1:5, to = 1:5, year = rep('1957', 5)))
ggraph(loopy_gr, layout = 'stress') + 
  geom_edge_link(aes(colour = year), alpha = 0.25) + 
  geom_edge_loop(aes(colour = year))

Code



# Force directed 力导向

ggraph(gr) + 
  geom_edge_bundle_force(n_cycle = 2, threshold = 0.4)
#> Using "stress" as default layout

Code



# arc
ggraph(gr, layout = 'linear') + 
  geom_edge_arc(aes(colour = year))

Code
# hive 蜂巢图
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 = 'hive', axis = pop_devel, sort.by = popularity) + 
  geom_edge_hive(aes(colour = year)) + 
  geom_axis_hive(label = FALSE) + 
  coord_fixed()

Code
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_
      }
    }
  }))

#  elbow
ggraph(hierarchy, layout = 'dendrogram', height = height) + 
  geom_edge_elbow()

Code
ggraph(hierarchy, layout = 'dendrogram', height = height) + 
  geom_edge_elbow2(aes(colour = node.Class))

Code

ggraph(hierarchy, layout = 'dendrogram', height = height) + 
  geom_edge_diagonal()

Code


ggraph(hierarchy, layout = 'dendrogram', height = height) + 
  geom_edge_bend()

1.3.1 箭头

Code
# 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)

Code


ggraph(simple, layout = 'graphopt') + 
  geom_edge_link(arrow = arrow(length = unit(4, 'mm')), 
                 end_cap = circle(3, 'mm')) + 
  geom_node_point(size = 5)

Code

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))

1.3.2 标签

Code
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)

Code

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)

1.3.3 关联

Code
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()

1.4 布局

Back to top