Support for nodes and edges in geographical space

[loreabad6]

Hi Thomas, Lorena here from the sfnetworks package. As we talked about during the hackathon back in June I have been trying to implement support for sfnetworks with ggraph.

As a recap, sfnetworks bridges tidygraph and sf, generating objects of class sfnetwork which are accepted both for sf and tidygraph functions. It subclasses tbl_graph and hence already possible to use with ggraph. However, support to create a ggraph that corresponds to sfs geographical space is missing.

I have been trying to implement support for this within my own forked branch. I now have:

• An sf layout, which will place the nodes in their geographical space.
• A geom_node_sf() function which relies on GeomSf to graph the nodes.
  • As far as I could test this works very well with aesthetics.
  • Although this can also be achieved with geom_node_point(), the geom_node_sf() option includes the CoordSf automatically with no need to call coord_sf(crs).
• A geom_edge_sf() function which also indirecly relies on GeomSf through a GeomEdgeSf ggproto.
  • I created this basicallly to be able to pass the mapping variables which include the prefix edge_*
  • However, this is where I bump into problems. Plotting the edges and passing aesthetics works, but the legends do not get rendered giving me the warning Ignoring unknown parameters
  • I am a bit stucked in this last one since I am not so familiar with ggproto objects and have a bit of difficulty following the workflow from the other geom_edge_*() functions available.
• Still to work on: facet_*() gives problems sometimes.

Here is what I have so far, the changes can be compared here.

## Layout for sf objects, name might need to change (?)
layout_tbl_graph_sf <- function(graph, circular = FALSE) {
  # Check the presence of sf.
  if (!requireNamespace("sf", quietly = TRUE)) {
    stop("Package sf required, please install it first.", call. = FALSE)
  }
  # Extract X and Y coordinates from the nodes
  graph <- activate(graph, "nodes")
  x <- sf::st_coordinates(graph)[,"X"]
  y <- sf::st_coordinates(graph)[,"Y"]
  # Create layout data frame
  nodes <- new_data_frame(list(x = x, y = y))
  extra_data <- sf::st_drop_geometry(as_tibble(graph, active = "nodes"))
  warn_dropped_vars(nodes, extra_data)
  nodes <- cbind(nodes, extra_data[, !names(extra_data) %in% names(nodes), drop = FALSE])
  nodes$circular <- FALSE
  attr(nodes, 'graph') <- graph
  nodes
}

## Functions to plot sf nodes
geom_node_sf <- function(mapping = NULL, data = get_sf_nodes(), stat = 'sf',
                         position = 'identity', show.legend = NA, ...) {
  c(
    layer_sf(
      geom = GeomSf, data = data, mapping = mapping, stat = stat,
      position = position, show.legend = show.legend, inherit.aes = FALSE,
      params = list(na.rm = FALSE, ...)
    ),
    coord_sf(default = TRUE)
  )
}

get_sf_nodes <- function(){
  function(layout) {
    nodes <- sf::st_as_sf(attr(layout, "graph"), "nodes")
    attr(nodes, 'type_ggraph') <- 'node_ggraph'
    nodes
  }
}

## Functions to plot sf edges
geom_edge_sf <- function(mapping = NULL, data = get_sf_edges(), stat = 'sf',
                         position = 'identity', show.legend = NA, ...) {
  mapping <- complete_edge_aes(mapping)
  c(
    layer_sf(
      geom = GeomEdgeSf, data = data, mapping = mapping, stat = stat,
      position = position, show.legend = show.legend, inherit.aes = FALSE,
      params = list(na.rm = FALSE, ...)
    ),
    coord_sf(default = TRUE)
  )
}

get_sf_edges <- function(){
  function(layout) {
    edges <- sf::st_as_sf(attr(layout, "graph"), "edges")
    attr(edges, 'type_ggraph') <- 'edge_ggraph'
    edges
  }
}

GeomEdgeSf = ggproto("GeomEdgeSf", GeomSf,
     draw_panel = function(data, panel_params, coords) {
        names(data) <- sub('edge_', '', names(data))
        names(data)[names(data) == 'width'] <- 'size'
        GeomSf$draw_panel(data, panel_params, coords)
     }
)

I also tweaked tbl_graph.R to support sfnetwork objects.

These are examples of how it works currently:

# remotes::install_github("luukvdmeer/sfnetworks")
library(sfnetworks)
library(tidygraph)
library(ggraph)

net = roxel %>% 
  as_sfnetwork() %>% 
  mutate(centrality = centrality_betweenness()) %>% 
  mutate(central = ifelse(centrality > 1000, T, F)) %>% 
  activate('edges') %>% 
  mutate(azimuth = edge_azimuth(), length = edge_length())

ggraph(net, 'sf') +
  geom_node_sf(aes(color = central)) +
  geom_edge_sf(color = 'grey')

ggraph(net, 'sf') +
  geom_node_point(aes(color = centrality)) +
  geom_edge_link(aes(color = type)) +
  coord_sf(crs = 4326)

ggraph(net, 'sf') +
  geom_edge_sf(color = 'red') +
  geom_node_point(aes(color = centrality)) +
  facet_nodes('central')

ggraph(net, 'sf') +
  geom_edge_sf(color = 'red') +
  facet_edges('type')

But when trying to pass aesthetics from variables, the rendering works good but the legend does not recognize the aesthetic names.

ggraph(net, 'sf') +
  geom_edge_sf(aes(color = as.numeric(azimuth)))
#> Warning: Ignoring unknown aesthetics: edge_colour

ggraph(net, 'sf') +
  geom_edge_sf(aes(color = as.numeric(azimuth), linetype = type)) +
  facet_graph(central ~ type, row_type = 'node', col_type = 'edge')
#> Warning: Ignoring unknown aesthetics: edge_colour, edge_linetype

And sometimes facetting fails:

ggraph(net, 'sf') +
  geom_node_sf(color = 'red') +
  geom_edge_link(aes(color = type)) +
  facet_graph(type ~ central)
#> Warning: Unknown or uninitialised column: `.ggraph.index`.
#> Error: Must subset rows with a valid subscript vector.
#> i Logical subscripts must match the size of the indexed input.
#> x Input has size 701 but subscript `i` has size 0.

I would like to open a PR when these issues are fixed, but so far I think I am approaching the GeomEdgeSf wrong. I would really appreciate some help, not at all urgent. Also, considering that I am unsure how to handle sfnetworks and sf in the Namespace yet and the checks keep failing. Thank you for your time!

[oousmane]

Nice integration (profane point of view), i'm new to sfnetwork and ggraph too, but searching a convenient way to plot sfnetwork object bring me to your blog post and then here. Hope Thomas will accept this PR. Nice work.

[thomasp85]

So sorry for the massive delay on coming back to this @loreabad6 — are you still interested in getting this worked in? If so I'll have time to prioritise it now

[loreabad6]

Hi @thomasp85, I have not looked at it in years but will be happy if wwe can make it work. I'll take a look again at the current state and check if there are any other problems besides the ones I explained or if something needs to be updated from my implementation. Thanks for the time!

[thomasp85]

Well, thank you. Sorry it took so long 🙈

[loreabad6]

Hi again @thomasp85, and no worries at all! I checked my fork and synced to the latest ggraph. I unfortunately don't know yet how to figure the ggproto issue, but I will create the PR and maybe you can help me figure it out? I would really appreciate it!

[loreabad6]

Thank you for the help! Happy to see this implemented 😄 Ping @luukvdmeer @RobinLovelace @agila5

[Robinlovelace]

By coincidence I've just been using {sfnetworks} + {tidygraph} to group edges. Currently I'm doing the following:

grouped_net = net |>
  sfnetworks::as_sfnetwork(directed = FALSE) |>
  morph(to_linegraph) |>
  mutate(group = group_edge_betweenness(n_groups = 4)) |>
  unmorph() |>
  activate(edges) |>
  sf::st_as_sf() |>
  select(group) |>
  sf::st_transform("EPSG:4326")
plot(grouped_net, lwd = 3)
sf::st_write(grouped_net, "example_cohesive.geojson", delete_dsn = TRUE)

Resulting in this with minimal example dataset

Probably not the best place for it, could put in an {sfnetwork} discussion, but wanted to flag that things seem to be working, although most {tidygraph} grouping functions seem to work only on nodes...

[agila5]

Congratulations @loreabad6 and @thomasp85 👏 👏 👏 I don't understand all the details, but you did a great job and the integration of ggraph and sfnetworks will be very useful for my research.

[Robinlovelace]

Update on this: I'm hitting a bug when trying to install the dev version to test this new functionality.

remotes::install_dev("ggraph")

Resulting in this:

installing to /home/robin/R/x86_64-pc-linux-gnu-library/4.3/00LOCK-ggraph/00new/ggraph/libs
** R
** data
*** moving datasets to lazyload DB
** byte-compile and prepare package for lazy loading
Error in eval(`_inherit`, env, NULL) : object 'GuideLegend' not found
Error: unable to load R code in package ‘ggraph’
Execution halted
ERROR: lazy loading failed for package ‘ggraph’
* removing ‘/home/robin/R/x86_64-pc-linux-gnu-library/4.3/ggraph’
Warning message:
In i.p(...) :
  installation of package ‘/tmp/Rtmpk6D8oL/file7ca1a673b8393/ggraph_2.1.0.9000.tar.gz’ had non-zero exit status

[thomasp85]

You'll need the dev version of ggplot2

[Robinlovelace]

Aha makes sense. Thanks!

[Robinlovelace]

Works great, thanks guys!

[Robinlovelace]

From the docs on #357

ggraph(largest_component_92, 'sf') +
  geom_node_sf() +
  geom_edge_sf(aes(colour = Quietness)) +
  theme_void()