hypertidy / scgraph

A silicate common form for igraph in R

scgraph

The goal of scgraph is to convert anything expressible in silicate form to igraph, and anything in igraph form to silicate form.

In silicate general form the data can be offloaded or transmitted via any standard table-based data system.

Installation

You can install scgraph from github with:

# install.packages("devtools")
devtools::install_github("hypertidy/scgraph")

Example

This is a basic example which shows you how to create graphs, from non-graph data that has connectivity understood by the ‘sc’ framework.

First generate some line data.

library(silicate)
library(raster)
r <- aggregate(raster(volcano), fact = 10)
line <- sf::st_as_sf(rasterToContour(r, levels = c(130, 165)))
plot(line)

Convert to graph, the first is a bit of a mess since we are plotting it in “space”-space. The second does more work to show the topology more clearly with two disconnected lines and the single ring.

(That’s the idea.)

library(scgraph)
plot(as.igraph(line), vertex.size = 5)

plot(as.igraph(line, layout = FALSE), vertex.size = 5)

Another example. Here the “hole” in the spatial polygon is seen as a disconnected island, and the two polygons that share an edge running in two different path directions are together.

data("minimal_mesh", package = "silicate")
set.seed(10)  ## WIP will currently always have new UIDs for the same data
sc_model <- SC(minimal_mesh)
ggeog <- as.igraph(sc_model, layout = TRUE)
gtopo <- as.igraph(sc_model, layout = FALSE)

## can't see how else to easily remove the geographic layout?
#igraph::V(gtopo)$name <- igraph::V(ggeog)$name
## drop IDs and use an integer
#igraph::V(gtopo)$name <- igraph::V(ggeog)$name <- seq_along(igraph::V(ggeog)$name)
#p <- par(mfrow = c(1, 2))
library(igraph)
#> 
#> Attaching package: 'igraph'
#> The following objects are masked from 'package:dplyr':
#> 
#>     as_data_frame, groups, union
#> The following object is masked from 'package:raster':
#> 
#>     union
#> The following objects are masked from 'package:stats':
#> 
#>     decompose, spectrum
#> The following object is masked from 'package:base':
#> 
#>     union
plot(ggeog, vertex.size = 9, main = "layout as geography", vertex.label.dist= .7, vertex.label.cex = 1)

plot(gtopo, vertex.size = 9, main = "layout as topology", vertex.label.dist= .7, vertex.label.cex = 1)

Example with DiagrammeR.

library(DiagrammeR)
library(silicate)
op <- options(warn = -1)  ## ugly warning from rlang
g <-
  create_graph() %>%
  add_nodes_from_table(
    table = sc_model$vertex,
    label_col = vertex_) %>% 
  add_edges_from_table(
    table = sc_model$edge,
    from_col = .vx0,
    to_col = .vx1, 
    from_to_map = label)

render_graph(g)

options(op)

library(ggraph)
#> 
#> Attaching package: 'ggraph'
#> The following object is masked from 'package:DiagrammeR':
#> 
#>     get_edges
#> The following object is masked from 'package:sp':
#> 
#>     geometry
g <- as.igraph(line)
ggraph(g) + geom_edge_arc()
#> Using `nicely` as default layout

ggraph(g) + geom_edge_link() 
#> Using `nicely` as default layout

The geom edge link is essentially the same as the map data.

library(ggraph)
ggraph(ggeog) + geom_edge_arc()
#> Using `nicely` as default layout

ggraph(ggeog) + geom_edge_link() 
#> Using `nicely` as default layout

## reconstruct the sf object as a ggplot
## using the sc decomposition forms that scgraph uses
library(dplyr)
## a kind of db-fortify
tab <- with(sc_model, 
     object %>% inner_join(object_link_edge) %>% inner_join(edge))
#> Joining, by = "object_"
#> Joining, by = "edge_"
## this used to be PATH based, so was join-able, need a tidier way to express this
## cascade
tab$x1 <-sc_model$vertex$x_[ match(tab$.vx0, sc_model$vertex$vertex_)]
tab$y1 <-sc_model$vertex$y_[ match(tab$.vx0, sc_model$vertex$vertex_)]
tab$x2 <-sc_model$vertex$x_[ match(tab$.vx1, sc_model$vertex$vertex_)]
tab$y2 <-sc_model$vertex$y_[ match(tab$.vx1, sc_model$vertex$vertex_)]

library(ggplot2)
ggplot(tab, aes(x1, y1, xend = x2, yend = y2, col = object_)) + geom_segment()

scgraph's Issues

handle variety of models

• SC0
• SC
• PATH0
• PATH
• TRI0
• TRI
• ARC0
• ARC

performance, accuracy benchmark

A good example for double checking everything

https://github.com/odeleongt/gt-service-distance

build_topo <- function(lines) {
  
  g <- gIntersection(lines, lines)
  edges <- do.call(rbind, lapply(g@lines[[1]]@Lines, function(ls) {
    as.vector(t(ls@coords))
  }))
  lengths <- sqrt((edges[, 1] - edges[, 3])^2 + (edges[, 2] - edges[, 4])^2)
  
  froms <- paste(edges[, 1], edges[, 2])
  tos <- paste(edges[, 3], edges[, 4])
  
  graph <- graph.edgelist(cbind(froms, tos), directed = FALSE)
  E(graph)$weight = lengths
  
  xy <- do.call(rbind, strsplit(V(graph)$name, " "))
  
  V(graph)$x <- as.numeric(xy[, 1])
  V(graph)$y <- as.numeric(xy[, 2])
  return(graph)
}


## not true to the full workflow, I'm detouring around the cluster setup...
roads0 <- sf::read_sf("data/shapefiles/roads/gt_roads.shp")
roads_sp <- as(roads0, "Spatial")

library(scgraph) ## devtools::install_github(c("mdsumner/scgraph", "mdsumner/sc", "mdsumner/scsf"))
library(scsf)
library(sc)

system.time(roads_graph <- as.igraph(roads0))
library(rgeos)
library(igraph)
system.time(roads_graph_sp <- build_topo(roads_sp))


roads_graph
#IGRAPH DN-- 1425483 1502497 -- 
#  + attr: name (v/c), x (v/n), y (v/n), path_ (e/c), segment_ (e/c)
#+ edges (vertex names):

roads_graph_sp
#IGRAPH UNW- 1426138 1440694 -- 
#  + attr: name (v/c), x (v/n), y (v/n), weight (e/n)
#+ edges (vertex names):

general TODO/explore laundry list

https://cran.r-project.org/web/packages/spatgraphs/index.html