Powerset Animation/Invisible Vertices/Graph Layout

Question

I wanted to visualize the cumulative powerset construction process and came up with two functions:

PowerGraph[l_] := Module[
   {count = 1, treelist, vmaplist, t, label, ncolor},
   treelist =
    Reap[
     Fold[#1~Join~(#1 /. (x_ \[DirectedEdge] y_) :> (y \[DirectedEdge] (Sow[{count, #2}]; count++))) &,
     {0 \[DirectedEdge] {}},
     l
   ] // Rest
 ];
 vmaplist = treelist[[2, 1]];
 t = TreeGraph[treelist[[1]], VertexLabels -> "Name"];
 Fold[SetProperty[{#1, #2[[1]]},
  {
   label = #2[[2]];
   ncolor = Position[l, label][[1, 1]]/Length[l];
   VertexStyle -> Hue[ncolor],
   VertexLabels -> Placed[
     {
      Style[label, Hue[ncolor, 1, 0.6]],          
      Rest@FindShortestPath[t, {}, #2[[1]]] /. x_ :> vmaplist[[x, 2]]}, {Below, Tooltip}]
     }
  ] &, t, vmaplist]  
]; 

TreeAnimate[g_Graph] := Module[{
  tempg = SetProperty[g,
  {
    VertexShape -> Graphics[Circle[{0, 0}, 0]],
    EdgeStyle -> Opacity[0],
    VertexLabels ->Table[VertexList[g][[i]] -> "", {i,Length[VertexList[g]]}],
   ImageSize -> Large
  }],
len = Length[VertexList[g]],
el, vl
},
ListAnimate[
  FoldList[
   SetProperty[#1,
   {
    el = EdgeList[g];
    vl = VertexList[g];
    If[#2 > 1, EdgeStyle -> (el[[#2 - 1]] -> {Opacity[1], PropertyValue[{g, el[[#2 - 1]]}, EdgeStyle]}), ## &[]],
      VertexShape -> (vl[[#2]] -> (PropertyValue[{g, vl[[#2]]},   VertexShape] /. $Failed -> Automatic)),
  pv = PropertyValue[{g, vl[[#2]]}, VertexLabels] /. $Failed -> "";
      VertexLabels -> (vl[[#2]] -> pv)
    }
   ] &, tempg, Range[len]], AnimationRepetitions -> 1, SaveDefinitions -> True]
];

TreeAnimate[PowerGraph[{a,b,c,d,e}]]

PowerSet

Maybe someone has use for it, the animation follows declaration order and should work for arbitrary graphs. The individual sets are shown as Tooltips. The remaining gripe is the layout ungainly 'dithering' as the only way I found to hide vertices was declaring them as zero-sized circles. Anyone got a better idea?

halmir · Accepted Answer · 2015-06-06 18:00:42Z

You can try HighlightGraph with "DehighlightHide" highlight style. One thing I modify in PowerGraph is changing vertex {} to string vertex "{}".

PowerGraph[l_] := Module[
   {count = 1, treelist, vmaplist, t, label, ncolor},
   treelist =
    Reap[
     Fold[#1~Join~(#1 /. (x_ \[DirectedEdge] y_) :> (y \[DirectedEdge] (Sow[{count, #2}]; count++))) &,
     {0 \[DirectedEdge] "{}"},
     l
   ] // Rest
 ];
 vmaplist = treelist[[2, 1]];
 t = TreeGraph[treelist[[1]], VertexLabels -> "Name"];
 Fold[SetProperty[{#1, #2[[1]]},
  {
   label = #2[[2]];
   ncolor = Position[l, label][[1, 1]]/Length[l];
   VertexStyle -> Hue[ncolor],
   VertexLabels -> Placed[
     {
      Style[label, Hue[ncolor, 1, 0.6]],          
      Rest@FindShortestPath[t, "{}", #2[[1]]] /. x_ :> vmaplist[[x, 2]]}, {Below, Tooltip}]
     }
  ] &, t, vmaplist]  
]; 

g = PowerGraph[{a,b,c,d,e}];
vlist = VertexList[g]; elist = EdgeList[g]; Animate[
 HighlightGraph[g, Join[vlist[[;; i]], elist[[;; i - 1]]], 
  GraphHighlightStyle -> "DehighlightHide"], {i, 1, 
  Length[VertexList[g]], 1}, AnimationRepetitions -> 1, 
 SaveDefinitions -> True]

Much simpler and cleaner. The shaking seems to be a Mathematica issue. — LogicBreaker
– LogicBreaker, Commented Jun 7, 2015 at 15:52

Stack Exchange Network

Powerset Animation/Invisible Vertices/Graph Layout

1 Answer 1

Your Answer

Hot Network Questions

Powerset Animation/Invisible Vertices/Graph Layout

1 Answer 1

Your Answer

Sign up or log in

Post as a guest

Related

Hot Network Questions