Interactive Graph Editing with Animation

Question

I want to make a simple interactive user interface like this:

Such that when the user clicks on the "Add Edge" button, the edge specified by from and to fiels is added to the graph. The new graph may have a new layout and I want to make an animation between the old and new graphs (see my other question and my answer to the question). Most of the examples I found, change the graph/plot just on change of the inputs without waiting for a click from the user. I know how to add the edge to the graph and generate the frames of the animation, but how can I do the rest?

Answer 1

Finally, I came up with a solution which works but is not as smooth as I expected. Here is the solution:

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

Module[{g, g2 = Graph[Range@5, {}], frames, mapping},
 g = g2;
 frames = AnimateGraphs[g, g2];
 mapping = Table[i -> frames[[i]], {i, 1, Length@frames}];

 Manipulate[
  If[counter < Length@frames, counter = counter + 1];
  PaneSelector[
   mapping,
   Dynamic[counter],
   ImageSize -> {500, 500},
   Alignment -> Center
   ],
  {counter, Range[Length@frames], None},
  {x, Range@5, Setter},
  {y, Range@5, Setter},
  {{val, 0, "operator"}, 
   Row[{Button["Add Edge", counter = 1; g = g2; 
       g2 = EdgeAdd[g, x \[DirectedEdge] y]; 
       frames = AnimateGraphs[g, g2]; 
       mapping = 
        Table[i -> frames[[i]], {i, 1, Length@frames}]]}] &},
  AppearanceElements -> None,
  SynchronousUpdating -> False
  ]
 ]

It uses PaneSelector to make the animation. The way I am using the counter variable, prevents me to have complete control over the timing of the frames. So, I have to play with fps to get the desired speed for the animation. Anyways, any suggestion to make it faster/smoother is appreciated.

Edit

Here is a faster version:

AnimateGraphs[g1_, g2_, highlight_] := Module[
   {gr1, gr2, coord1, coord2, delta, f, fps = 15},
   f = Function[{p, l},
     If[
      MemberQ[highlight, l],
      (*{Red,EdgeForm[Black],Rectangle[p-{.4,.4},p+{.4,.4}],Black,
      Text[l,p]}*)

      Text[Framed[
        l, {Background -> RGBColor[1, .5, 0.5], FrameStyle -> Red, 
         FrameMargins -> Automatic}], p],
      (*{Yellow,EdgeForm[Black],Rectangle[p-{.3,.3},p+{.3,.3}],Black,
      Text[l,p]}*)

      Text[Framed[
        l, {Background -> RGBColor[1, 1, 0.8], 
         FrameStyle -> RGBColor[0.94, 0.85, 0.36] , 
         FrameMargins -> Automatic}], p]
      ]
     ];
   gr1 = LayeredGraphPlot[g1, Bottom, VertexLabeling -> True, 
     PackingMethod -> "NestedGrid", VertexRenderingFunction -> f];
   gr2 = LayeredGraphPlot[g2, Bottom, VertexLabeling -> True, 
     PackingMethod -> "NestedGrid", VertexRenderingFunction -> f];
   coord1 = Last[Last[gr1[[1]]]];
   coord2 = Last[Last[gr2[[1]]]];
   delta = coord2 - coord1;
   Table[GraphPlot[g1, VertexLabeling -> True, 
      VertexRenderingFunction -> f, 
      VertexCoordinateRules -> (coord1 + (i - 1)/fps delta)], {i, 1, 
      fps}]~Append~gr2
   ];

Module[{g, g2 = Graph[Range@10, {}], frames, mapping},
 g = g2;
 frames = AnimateGraphs[g, g2, {}];
 mapping = Table[i -> frames[[i]], {i, 1, Length@frames}];

 Manipulate[
  (*If[counter<Length@frames,counter=counter+1];*)
  PaneSelector[
   mapping,
   Dynamic[
    If[counter == 0,
     counter = If[counter < Length@frames, counter + 1, counter]; 
     Length@frames,
     counter = If[counter < Length@frames, counter + 1, counter]
     ]
    ],
   ImageSize -> {800, 400},
   Alignment -> Center
   ],
  {counter, Range[Length@frames], None},
  {x, Range[Length@VertexList[g]], Setter},
  {y, Range[Length@VertexList[g]], Setter},
  {{val, 0, "operator"}, 
   Row[{Button["Add Edge", g = g2; 
       g2 = EdgeAdd[g, x \[DirectedEdge] y]; 
       frames = AnimateGraphs[g, g2, {x, y}]; 
       mapping = Table[i -> frames[[i]], {i, 1, Length@frames}]; 
       counter = 0]}] &},
  AppearanceElements -> None,
  SynchronousUpdating -> False
  ]
 ]