draw multiple discrete networks in R using igraph

Question

I have a simple set of directional relationships (parent->child) that I want to draw. My data is structured such that there are many discrete sub-networks. Here is some fake data that looks like mine.

require(igraph)
parents<-c("A","A","C","C","F","F","H","I")
children<-c("B","C","D","E","G","H","I","J")
begats<-data.frame(parents=parents,children=children)
graph_begats<-graph.data.frame(begats)
plot(graph_begats)

There are two distinct sub networks in the fake data, each of which is strictly a parent-children lineage. I need to draw both the lineages as tree networks in the same window (ideally same vertex coordinate system). I have tried using layout.reingold.tilford(), but at best all I can draw is one of the trees, with all other vertices plotting on top of the root vertex, like this.

lo<-layout.reingold.tilford(graph_begats,root=1)
plot(graph_begats,layout=lo)

Any ideas for doing this for an arbitrary number of discrete lineages?

Answer 1

So, as I mentioned in the comment above, one solution is to calculate the layout separately for each component. It is fairly straightforward, even it is takes some code to do it properly. The code below should work for arbitrary number of components. The first vertex in the topological ordering is used as the root node for each tree.

require(igraph)

## Some data
parents <- c("A", "A", "C", "C", "F", "F", "H", "I")
children <- c("B", "C", "D", "E", "G", "H", "I", "J")
begats <- data.frame(parents=parents, children=children)
graph_begats <- graph.data.frame(begats)

## Decompose the graph, individual layouts
comp <- decompose.graph(graph_begats)
roots <- sapply(lapply(comp, topological.sort), head, n=1)
coords <- mapply(FUN=layout.reingold.tilford, comp,
                 root=roots, SIMPLIFY=FALSE)

## Put the graphs side by side, roots on the top
width <- sapply(coords, function(x) { r <- range(x[, 1]); r[2] - r[1] })
gap <- 0.5
shift <- c(0, cumsum(width[-length(width)] + gap))
ncoords <- mapply(FUN=function(mat, shift) {
  mat[,1] <- mat[,1] - min(mat[,1]) + shift
  mat[,2] <- mat[,2] - max(mat[,2])
  mat
}, coords, shift, SIMPLIFY=FALSE)

## Put together the coordinates for the original graph,
## based on the names of the vertices
lay <- matrix(0, ncol=2, nrow=vcount(graph_begats))
for (i in seq_along(comp)) {
  lay[match(V(comp[[i]])$name, V(graph_begats)$name),] <- ncoords[[i]]
}

## Plot everything
par(mar=c(0,0,0,0))
plot(graph_begats, layout=lay)