rysuj wiele dyskretnych sieci w R używając igraph

Question

Mam prosty zestaw kierunkowych relacji (rodzic-> dziecko), które chcę narysować. Moje dane są skonstruowane tak, że istnieje wiele dyskretnych podsieci. Oto kilka fałszywych danych, które wyglądają jak moje.

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) 

Istnieją dwie odrębne podsieci w fałszywych danych, z których każda jest ściśle linii rodowodem rodziców. Muszę narysować obie linie jako drzewa sieci w tym samym oknie (najlepiej ten sam układ współrzędnych wierzchołków). Próbowałem użyć layout.reingold.tilford(), ale w najlepszym razie wszystko, co mogę narysować, to jeden z drzew, z wszystkimi innymi wierzchołkami kreślonymi na wierzchołku wierzchołka, tak jak to.

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

Jakieś pomysły na zrobienie tego dla dowolnej liczby dyskretnych linii?

Answer 1

Tak, jak wspomniałem w powyższym komentarzu, jednym z rozwiązań jest obliczenie układu osobno dla każdego komponentu. Jest to dość proste, nawet jeśli wymaga trochę kodu, aby zrobić to poprawnie. Poniższy kod powinien działać dla dowolnej liczby składników. Pierwszy wierzchołek w porządku topologicznym jest używany jako węzeł główny dla każdego drzewa.

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)