Support for nodes and edges in geographical space #275
Description
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 onGeomSfto 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(), thegeom_node_sf()option includes the CoordSf automatically with no need to callcoord_sf(crs).
- A
geom_edge_sf()function which also indirecly relies onGeomSfthrough aGeomEdgeSfggproto.- 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
ggprotoobjects and have a bit of difficulty following the workflow from the othergeom_edge_*()functions available.
- I created this basicallly to be able to pass the mapping variables which include the prefix
- 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_colourggraph(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_linetypeAnd 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!