Closed henriquesposito closed 1 year ago
henriquesposito
commented
1 year ago 
jhollway
commented
1 year ago I've looked into this, and it seems to work ok, however could get a bit fiddly. I think a autographt() function or similar would be useful to use our network data in expected ways.
jhollway
commented
1 year ago E.g. ison_adolescents %>% activate(edges) %>% mutate(date = 1:10) %>% autographr() + transition_reveal(date)
jhollway
commented
1 year ago Plotly is probably the main alternative
henriquesposito
commented
1 year ago I have been looking into gganimate, plotly, and ndtv for a few days now. While I can get them to work very well for specific networks locally, creating a "good" function for animating network plots in time might require a certain amount of work.
It is easy, for example, to setup a simple network function for plotting networks that rely on gganimate and in which the layout stays static and only edges move. This might not be as easy or straightforward if we want a more complex animation in which both nodes and edges moves (or appear and disappear) and that the plot layout changes in time.
Ideally we want the plot to be compatible with the output of autographr(). That is, however, a ggplot object. This could make it easier to work with plotly, but plotly is a better to make the plots interactive not to animate them...
An alternative would be to develop/modify the ggevolution() function we already have to create frames according to a time variable. These frames could become animations if users chose to.
In the meantime I will keep working on trying to make gganimate and autographr() work in a nice, simple, and more straightfoward way.
henriquesposito
commented
1 year ago After much wrangling, I finally got an animation with gganimate that worked well for network plots (I also had a lot of help http://blog.schochastics.net/post/animating-network-evolutions-with-gganimate/)
The "way" of doing this well is to create separate layouts for each time point (see below). Of course this a rough and convoluted way, but it does work very well!
`
library(migraph) library(dplyr) library(igraph) library(gganimate) library(graphlayouts)
set.seed(4321) object <- ison_adolescents %>% activate(edges) %>% mutate(year = as.factor(sample(1:3, 10, replace = TRUE)))
timevar = "year"
l <- levels(get.edge.attribute(object, timevar)) df <- vector("list", length(l)) for (i in seq_len(length(l))) { df[[i]] <- filter(object, get(timevar) == i) }
s50 <- lapply(df, as_igraph)
xy <- layout_as_dynamic(s50, alpha = 0.2)
nodes_lst <- lapply(1:length(s50), function(i) { cbind(igraph::as_data_frame(s50[[i]], "vertices"), x = xy[[i]][, 1], y = xy[[i]][, 2], frame = i) })
edges_lst <- lapply(1:length(s50), function(i) cbind(igraph::as_data_frame(s50[[i]], "edges"), frame = i)) edges_lst <- lapply(1:length(s50), function(i) { edges_lst[[i]]$x <- nodes_lst[[i]]$x[match(edges_lst[[i]]$from, nodes_lst[[i]]$name)] edges_lst[[i]]$y <- nodes_lst[[i]]$y[match(edges_lst[[i]]$from, nodes_lst[[i]]$name)] edges_lst[[i]]$xend <- nodes_lst[[i]]$x[match(edges_lst[[i]]$to, nodes_lst[[i]]$name)] edges_lst[[i]]$yend <- nodes_lst[[i]]$y[match(edges_lst[[i]]$to, nodes_lst[[i]]$name)] edges_lst[[i]]$id <- paste0(edges_lst[[i]]$from, "-", edges_lst[[i]]$to) edges_lst[[i]]$status <- TRUE edges_lst[[i]] })
all_edges <- do.call("rbind", lapply(s50, get.edgelist)) all_edges <- all_edges[!duplicated(all_edges), ] all_edges <- cbind(all_edges, paste0(all_edges[, 1], "-", all_edges[, 2]))
edges_lst <- lapply(1:length(s50), function(i) { idx <- which(!all_edges[, 3] %in% edges_lst[[i]]$id) if (length(idx != 0)) { tmp <- data.frame(from = all_edges[idx, 1], to = all_edges[idx, 2], id = all_edges[idx, 3]) tmp$x <- nodes_lst[[i]]$x[match(tmp$from, nodes_lst[[i]]$name)] tmp$y <- nodes_lst[[i]]$y[match(tmp$from, nodes_lst[[i]]$name)] tmp$xend <- nodes_lst[[i]]$x[match(tmp$to, nodes_lst[[i]]$name)] tmp$yend <- nodes_lst[[i]]$y[match(tmp$to, nodes_lst[[i]]$name)] tmp$frame <- i tmp[timevar] <- i tmp$status <- FALSE edges_lst[[i]] <- rbind(edges_lst[[i]], tmp) } edges_lst[[i]] })
edges_df <- do.call("rbind", edges_lst) nodes_df <- do.call("rbind", nodes_lst)
ggplot() + geom_segment(data = edges_df, aes(x = x, xend = xend, y = y, yend = yend, group = id, alpha = status), show.legend = FALSE) + geom_point(data = nodes_df, aes(x, y, group = name), shape = 21, size = 4, show.legend = FALSE) + geom_text(data = nodes_df, aes(x, y, label = name), hjust = -0.5, vjust = -0.5) + scale_alpha_manual(values = c(0, 1)) + ease_aes("quadratic-in-out") + transition_states(frame, state_length = 0.75, wrap = FALSE) + labs(title = paste0(timevar, " {closest_state}")) + theme_void()
`
@jhollway I know this is not what we talked about, but using ggplot to plot and gganimate to animate networks is nice and consistent with the package. Of course we can develop our own layout algorithim, but I suspect giving users flexibility to select from various network layouts, as we do already, might be useful.
If you agree, I can work to improve the above code and setup it up as the ´autographt()´ function. Please let me know. Thank you.
henriquesposito
commented
1 year ago The ´autographd()´ function now works with "many" data and builds upon the new split functions in the package.
For example:
`library(dplyr)
manyenviron::memberships$HUGGO_MEM %>% select(manyID, CountryID, Beg, End, Force) %>% filter(Beg < "1899-12-31") %>% as_tidygraph() %>% activate(edges) %>% to_waves(attribute = "Force") %>% autographd(delete.vertices = TRUE)
manyenviron::memberships$HUGGO_MEM %>% select(manyID, CountryID, Beg, End, Force) %>% filter(Beg < "1950-12-31") %>% as_tidygraph() %>% activate(edges) %>% mutate(Beg = lubridate::as_date(Beg), End = lubridate::as_date(End)) %>% to_slices(attributes = c("Beg", "End"), slice = c("1000-01-01:1799-12-31", "1800-01-01:1899-12-31", "1900-01-01:1950-12-31")) %>% autographd(delete.vertices = TRUE)`
There is still work to do as making the function more concise, add extra (...) arguments passed on to to ggplot and gganimate, and maybe add different layout options.