Плавные переходы между разными макетами одной сети в ggraph - PullRequest
2 голосов
/ 19 мая 2019

Я хотел бы анимировать одну и ту же сеть, используя разные макеты и имея плавный переход между макетами.Я хотел бы сделать это в рамках gganimate.

library(igraph)
library(ggraph)
library(gganimate)

set.seed(1)
g <- erdos.renyi.game(10, .5, "gnp")
V(g)$name <- letters[1:vcount(g)]
l1 <- create_layout(g, "kk")
l2 <- create_layout(g, "circle")
l3 <- create_layout(g, "nicely")
long <- rbind(l1,l2,l3)
long$frame <- rep(1:3, each =10)

Следуя подходу ggplot, я сохраняю позиции узлов в длинном формате (long) и добавляю frameпеременная для каждого макета.Я попытался заставить его работать со следующим кодом, который работает нормально и почти то, что я хочу.Однако я не могу найти способ включить ребра:

ggplot(long, aes(x, y, label = name, color = as.factor(name), frame = frame)) +
  geom_point(size = 3, show.legend = F) +
  geom_text(show.legend = F) +
  transition_components(frame)

Я также попытался добавить ребра как geom_segment, но в итоге они были статическими, пока узлы продолжали двигаться.Вот почему я использую пакет ggraph и терплю неудачу:

ggraph(g, layout = "manual", node.position = long) +
  geom_node_point() +
  geom_edge_link() +
  transition_components(frame)

Я хотел бы иметь анимацию одной сети с изменением положения узлов, которое отображает как узлы, так и ребра.

Любая помощь очень ценится!

Редактировать: Я узнал, что можно включать макет непосредственно в ggraph (и даже манипулировать атрибутами).Это то, что я сделал в следующем GIF.Дополнительно используется geom_edge_link0' вместо geom_edge_link.

ggraph(long) +
          geom_edge_link0() +
          geom_node_point() +
          transition_states(frame)

enter image description here

Обратите внимание, что края не движутся.

1 Ответ

4 голосов
/ 22 мая 2019

Я не уверен, что это в настоящее время готово в gganimate как есть.По состоянию на май 2019 года возникает проблема, связанная с: https://github.com/thomasp85/gganimate/issues/139


РЕДАКТИРОВАТЬ Я заменил рабочее решение.Честное предупреждение, я новичок с сетевыми манипуляциями, и я ожидаю, что кто-то с большим опытом может реорганизовать код, чтобы он был намного короче.

Мой общий подход состоял в том, чтобы создать макеты, поместить узлы в таблицу long2, а затем создайте еще одну таблицу со всеми ребрами.gganimate затем вызывает соответствующий источник данных, необходимый каждому слою.

1.Создайте таблицу узлов для трех макетов:

set.seed(1)
g <- erdos.renyi.game(10, .5, "gnp")
V(g)$name <- letters[1:vcount(g)]

layouts <- c("kk", "circle", "nicely")
long2 <- lapply(layouts, create_layout, graph = g) %>%
  enframe(name = "frame") %>%
  unnest()

> head(long2)
# A tibble: 6 x 7
  frame       x      y name  ggraph.orig_index circular ggraph.index
  <int>   <dbl>  <dbl> <fct>             <int> <lgl>           <int>
1     1 -1.07    0.363 a                     1 FALSE               1
2     1  1.06    0.160 b                     2 FALSE               2
3     1 -1.69   -0.310 c                     3 FALSE               3
4     1 -0.481   0.135 d                     4 FALSE               4
5     1 -0.0603 -0.496 e                     5 FALSE               5
6     1  0.0373  1.02  f                     6 FALSE               6

2.Преобразуйте края из исходного макета в таблицу.

Здесь я извлекаю края из g и преобразую в формат, который geom_segment может использовать, со столбцами для x, y, xend и yend.Это созрели для рефакторинга, но это работает.

edges_df <- igraph::as_data_frame(g, "edges") %>% 
  tibble::rowid_to_column() %>%
  gather(end, name, -rowid) %>%
  # Here we get the coordinates for each node from `long2`.
  left_join(long2 %>% select(frame, name, x, y)) %>%
  gather(coord, val, x:y) %>%
  # create xend and yend when at the "to" end, for geom_segment use later
  mutate(col = paste0(coord, if_else(end == "to", "end", ""))) %>%
  select(frame, rowid, col, val) %>%
  arrange(frame, rowid) %>%
  spread(col, val) %>%
  # Get the node names for the coordinates we're using, so that we
  #   can name the edge from a to b as "a_b" and gganimate can tween
  #   correctly between frames. 
  left_join(long2 %>% select(frame, x, y, start_name = name)) %>%
  left_join(long2 %>% select(frame, xend = x, yend = y, end_name = name)) %>%
  unite(edge_name, c("start_name", "end_name"))

> head(edges_df)
  frame rowid          x        xend          y       yend edge_name
1     1     1 -1.0709480 -1.69252646  0.3630563 -0.3095612       a_c
2     1     2 -1.0709480 -0.48086213  0.3630563  0.1353664       a_d
3     1     3 -1.6925265 -0.48086213 -0.3095612  0.1353664       c_d
4     1     4 -1.0709480 -0.06032354  0.3630563 -0.4957609       a_e
5     1     5  1.0571895 -0.06032354  0.1596417 -0.4957609       b_e
6     1     6 -0.4808621 -0.06032354  0.1353664 -0.4957609       d_e

3.Сюжет!

ggplot() +
  geom_segment(data = edges_df, 
               aes(x = x, xend = xend, y = y, yend = yend, color = edge_name)) +
  geom_point(data = long2, aes(x, y, color = name), size = 4) +
  geom_text(data = long2, aes(x, y, label = name)) +
  guides(color = F) +
  ease_aes("quadratic-in-out") +
  transition_states(frame, state_length = 0.5) -> a

animate(a, nframes = 400, fps = 30, width = 700, height = 300)

enter image description here

...