Status Quo
compute_panel_nodes_net <- function(data, scales){
data |>
select(from, to) |>
ggraph::create_layout(layout = data$layout[1])
}
tibble(from = sample(letters, replace = T),
to = sample(letters, replace = T),
layout = "fr") |>
compute_panel_nodes_net() |>
ggplot() +
aes(x = x, y = y) +
geom_point()
library(igraph)
an_edgelist <- tibble(from = sample(letters, replace = T),
to = sample(letters, replace = T))
tibble(from = sample(letters, replace = T),
to = sample(letters, replace = T),
layout = "fr") |>
graph_from_data_frame() |>
layout_with_kk() |>
as_tibble() |>
select(x = V1, y = V2)
an_edgelist |>
graph_from_data_frame() |>
layout_with_kk() |>
as_tibble() |>
select(x = V1, y = V2) |>
mutate(node_id = row_number()) ->
node_placement
an_edgelist |>
mutate(edge_id = row_number()) |>
pivot_longer(cols = 1:2, values_to = "node_id") |>
left_join(node_placement) |>
pivot_wider(names_from = name,
values_from = c(x,y, node_id)) |>
select(x = x_from, xend = x_to, y = y_from, yend = y_to, from = node_id_from, to = node_id_to) ->
node_connections
library(tidyverse)
library(igraph)
##
## Attaching package: 'igraph'
## The following objects are masked from 'package:lubridate':
##
## %--%, union
## The following objects are masked from 'package:dplyr':
##
## as_data_frame, groups, union
## The following objects are masked from 'package:purrr':
##
## compose, simplify
## The following object is masked from 'package:tidyr':
##
## crossing
## The following object is masked from 'package:tibble':
##
## as_data_frame
## The following objects are masked from 'package:stats':
##
## decompose, spectrum
## The following object is masked from 'package:base':
##
## union
# ggplot() +
# geom_segment(data = node_connections,
# aes(x = x, xend = xend, y = y , yend = yend)) +
# geom_point(data = node_placement,
# aes(x = x, y = y))
compute_panel_nodes <- function(data, scales){
edgelist <- data |>
select(from, to)
node_list <- edgelist |>
pivot_longer(cols = from:to) |>
distinct(node_name = value)
# node_list
data |>
select(from, to) |>
graph_from_data_frame() |>
layout_with_kk() |> ## layout
as_tibble() |>
select(x = V1, y = V2) |>
mutate(node_id = row_number()) |>
bind_cols(node_list)
}
tidytitanic::passengers |>
select(from = last_name, to = first_name) |>
remove_missing() |>
compute_panel_nodes()
## Warning: Removed 2 rows containing missing values or values outside the scale
## range.
## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if
## `.name_repair` is omitted as of tibble 2.0.0.
## ℹ Using compatibility `.name_repair`.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## # A tibble: 1,429 × 4
## x y node_id node_name
## <dbl> <dbl> <int> <chr>
## 1 -15.8 3.28 1 Braund
## 2 2.72 8.55 2 Owen
## 3 8.64 -27.8 3 Cumings
## 4 28.1 -19.2 4 Florence
## 5 -2.30 5.86 5 Heikkinen
## 6 -6.19 11.2 6 Laina
## 7 0.666 4.24 7 Futrelle
## 8 -7.63 -26.7 8 Lily
## 9 -0.695 4.88 9 Allen
## 10 27.5 -20.2 10 William
## # ℹ 1,419 more rows
library(tidyverse)
compute_panel_edges <- function(data, scales){
edgelist <- data |>
select(from, to) |>
remove_missing()
node_placement <- data |>
compute_panel_nodes()
edgelist |>
mutate(edge_id = row_number()) |>
pivot_longer(cols = 1:2, values_to = "node_id") |>
mutate(node_id = node_id |> as.character() |> as.numeric()) |>
left_join(node_placement, by = "node_id") |>
arrange(node_id) |>
pivot_wider(names_from = name,
values_from = c(x, y, node_id)) |>
select(x = x_from, xend = x_to, y = y_from, yend = y_to, from = node_id_from, to = node_id_to, edge_id)
}
tidytitanic::passengers |>
select(from = last_name, to = first_name) |>
remove_missing() |>
slice(1:100) |>
compute_panel_edges()
## Warning: Removed 2 rows containing missing values or values outside the scale
## range.
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `node_id = as.numeric(as.character(node_id))`.
## Caused by warning:
## ! NAs introduced by coercion
## # A tibble: 100 × 7
## x xend y yend from to edge_id
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 NA NA NA NA NA NA 1
## 2 NA NA NA NA NA NA 2
## 3 NA NA NA NA NA NA 3
## 4 NA NA NA NA NA NA 4
## 5 NA NA NA NA NA NA 5
## 6 NA NA NA NA NA NA 6
## 7 NA NA NA NA NA NA 7
## 8 NA NA NA NA NA NA 8
## 9 NA NA NA NA NA NA 9
## 10 NA NA NA NA NA NA 10
## # ℹ 90 more rows
library(statexpress)
tidytitanic::passengers |>
select(last_name, first_name) |>
remove_missing() |>
ggplot() +
aes(from = last_name, to = first_name) +
geom_text(stat = qstat_panel(compute_panel_nodes,
default_aes = aes(label = after_stat(node_id)))) +
geom_segment(stat = qstat_panel(compute_panel_edges))
## Warning: Removed 2 rows containing missing values or values outside the scale
## range.
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `node_id = as.numeric(as.character(node_id))`.
## Caused by warning:
## ! NAs introduced by coercion
## Warning: Removed 1307 rows containing missing values or values outside the scale range
## (`geom_segment()`).
