Transition between graphs

I want to visually demonstrate the manipulations made to a graph. For instance, I have a graph g where using the command LayeredGraphPlot[g, Bottom, VertexLabeling -> True] I get this figure as the output: After adding an edge and using the same command I get this one: I want to show a smooth transition between the two figures so that the user can track the addition of the edge. Is there any easy/general way to do such an effect in Mathematica.

• If you place your graphs in a list then you can use ListAnimate. Oct 10 '12 at 7:58
• I only have two graphs. Does it interpolate between the graphs? I mean, does it make the frames in between the two graphs or I need to make the middle frames by hand? Oct 10 '12 at 8:01
• Depending on what you mean by "smooth" 2 graphs might not be enough. In this case you have to make the intermediate frames "by hand". Oct 10 '12 at 8:04
• So, how can I find the vertex positions in the graphs? If it was a Graph object, I could do it easily, but LayeredGraphPlot returns a Graphics object rather than a Graph! Oct 10 '12 at 8:20
• You can use HighlightGraph together with Manipulate or (as b.gatessucks mentioned) ListAnimate. Oct 10 '12 at 8:22

To get the vertex coordinates for graph g, defined below:

PropertyValue[{g, #}, VertexCoordinates] & /@ Range

e.g.

{{2.32379, 0.}, {2.32379, 0.774597}, {1.54919, 1.54919}, {1.54919, 0.}, {0.774597, 0.}, {0.774597, 0.774597}, {0., 0.}}

To Animate, without moving vertices....

Here's a rough overview of how you might approach the problem using highlights. You don't need to move the vertices. You can simply fill in the graph step by step. We'll build the graph in three steps and then play it backwards. You can add the highlights and additional steps that suit you.

Begin by making the graph you want to end with:

edges = {DirectedEdge[7, 6], DirectedEdge[5, 6], DirectedEdge[4, 6], DirectedEdge[6, 3], DirectedEdge[2, 3], DirectedEdge[1, 2]};
g = Graph[edges, GraphStyle -> "VintageDiagram", GraphLayout -> "LayeredDrawing" ] Next, make the next to final drawing of the graph:

g1 = Graph[edges, GraphStyle -> "VintageDiagram", GraphLayout -> "LayeredDrawing",
GraphHighlight -> Join[{3, 6}, {DirectedEdge[6, 3]}], Now let's jump to the first step, where there are two connected components. They need to be in the proper place so they won't have to move later.

g2 = Graph[edges, GraphStyle -> "VintageDiagram", GraphLayout -> "LayeredDrawing",
GraphHighlight -> Join[Range, Complement[edges, {DirectedEdge[6, 3]}]],
GraphHighlightStyle -> "DehighlightHide" ]

Setting the GraphHighlightStyle to DehighlightHide allows you to hide parts of the graph (the edge from vertex 6 to vertex 3). In the animation you will want to display them in reverse order: Here's the ListAnimate code for showing the three frames we made:

ListAnimate[{g2, g1, g}] With additional frames you could assemble the graph, vertex by vertex, edge by edge, using the highlights of your choosing.

• I cannon see any animation in your code. Oct 10 '12 at 9:10
• Hold on, I'm getting to that part Oct 10 '12 at 9:11
• Sure ....... :) Oct 10 '12 at 9:11
• Why is there a downvote for this answer?
– Lou
Oct 10 '12 at 9:41
• @Lou: Downvote was mine. David posted an incomplete/not-functional answer at the beginning, but he completed it later. I just +1ed it. Oct 10 '12 at 9:51

While David's answer is a nice one, it's not actually what I am looking for. As I commented on his answer, I am looking for an answer that:

1. Handles dynamic user inputs, so a fixed final graph does not do the job. You can consider a compelete graph as the final graph, but I don't think this is a good idea.

2. I need to use LayeredGraphPlot to place the vertices correctly.

Based on these requirements, I found this answer:

g1 = Graph[{1, 2, 3, 4, 5, 6, 7, 8}, {1 \[DirectedEdge] 2,
2 \[DirectedEdge] 3, 4 \[DirectedEdge] 6, 5 \[DirectedEdge] 6,
7 \[DirectedEdge] 6}];
g2 = Graph[{1, 2, 3, 4, 5, 6, 7, 8}, {1 \[DirectedEdge] 2,
2 \[DirectedEdge] 3, 4 \[DirectedEdge] 6, 5 \[DirectedEdge] 6,
7 \[DirectedEdge] 6, 8 \[DirectedEdge] 3}];

AnimateGraphs[g1_, g2_] := Module[
{
gr1 = LayeredGraphPlot[g1, Bottom, VertexLabeling -> True],
gr2 = LayeredGraphPlot[g2, Bottom, VertexLabeling -> True],
coord1, coord2, delta, fps = 30
},
coord1 = Last[Last[gr1[]]];
coord2 = Last[Last[gr2[]]];
delta = coord2 - coord1;
Table[GraphPlot[g1, VertexLabeling -> True,
VertexCoordinateRules -> (coord1 + (i - 1)/fps delta)], {i, 1,
fps}]~Append~gr2
];
ListAnimate[AnimateGraphs[g1, g2], AppearanceElements -> None,
DefaultDuration -> 0.5, AnimationRepetitions -> 1]

It uses Last[Last[gr1[]]] to find the vertex coordinates that I think is not a robust way. Please comment if you have a better solution. The rest is simple.