Services & ResourcesWolfram ForumsMathGroup Archive

[Date Index] [Thread Index] [Author Index]

Centering LayerGraphPlot output

• To: mathgroup at smc.vnet.net
• Subject: [mg77956] Centering LayerGraphPlot output
• From: Kate Brenneman <k.a.brenneman at gmail.com>
• Date: Wed, 20 Jun 2007 05:39:44 -0400 (EDT)

Dear Mathematica savants,

I am trying to figure out how to center the output of
LayeredGraphPlot[] about the y-axis.  Right now the following code
places the vertices in the correct vertical order but doesn't present
a horizontally symmetric graph.  You'll notice that there are bits
commented out that didn't work, though I thought they might.  I would
also like to know how to control the vertical spacing between the
layers as graphs much larger than the sample provided are difficult to
read.

Thanks,
Kate Brenneman
NCSU

DisplayPosetGraph[IPPL_] := Module[{p, e, max, id, w0, w0y},
  (* DisplayPosetGraph receives an Involution Poset Plot List \
generated by MakePlotList and uses LayeredGraphPlot to illustrate it \
graphically *)

  (* find the number of generators *)
  p = Position[IPPL, _Integer];
  e = Extract[IPPL, p];
  max = Max[e];

  id = IPPL[[1, 1, 1]];
  w0 = IPPL[[-1, 1, 2]];
  w0y = GraphUtilities`GraphDistance[IPPL, id, w0];

  Return[
   LayeredGraphPlot[
    IPPL,
    Bottom,
    VertexLabeling -> True,
    DirectedEdges -> False,
    MultiedgeStyle -> 1/6.,
    EdgeRenderingFunction -> (
      {Darker[Hue[0.75*((#3[[1]] - 1)/max)]],
        If[#3[[2]], {Line[#1]}, {Dashed, Line[#1]}],
        Text[
         If[#3[[2]], OverBar[Subscript["S", #3[[1]]]],
          Subscript["S", #3[[1]]]],
         GraphUtilities`LineScaledCoordinate[#1, .4],
         Background -> White]} &)
    (*VertexCoordinateRules->{id->{0,0},w0->{0,w0y}}*)]

   ]
  ]

Sample input:

g={{{1, 2, 3} -> {-1, 2, 3}, {1, False}}, {{1, 2, 3} -> {2, 1, 3},
{2,
   False}}, {{1, 2, 3} -> {1, 3, 2}, {3,
   False}}, {{-1, 2, 3} -> {1, -2, 3}, {2,
   True}}, {{-1, 2, 3} -> {-1, 3, 2}, {3,
   False}}, {{1, 3, 2} -> {-1, 3, 2}, {1,
   False}}, {{2, 1, 3} -> {-2, -1, 3}, {1,
   True}}, {{2, 1, 3} -> {3, 2, 1}, {3,
   True}}, {{1, 3, 2} -> {3, 2, 1}, {2,
   True}}, {{1, -2, 3} -> {-1, -2, 3}, {1,
   False}}, {{-2, -1, 3} -> {-1, -2, 3}, {2,
   False}}, {{1, -2, 3} -> {1, 2, -3}, {3,
   True}}, {{-1, 3, 2} -> {3, -2, 1}, {2,
   True}}, {{-2, -1, 3} -> {-3, 2, -1}, {3,
   True}}, {{3, 2, 1} -> {-3, 2, -1}, {1,
   True}}, {{-1, -2, 3} -> {-1, 2, -3}, {3,
   True}}, {{1, 2, -3} -> {-1, 2, -3}, {1,
   False}}, {{1, 2, -3} -> {2, 1, -3}, {2,
   False}}, {{3, -2, 1} -> {2, 1, -3}, {3,
   True}}, {{3, -2, 1} -> {-3, -2, -1}, {1,
   True}}, {{-3, 2, -1} -> {1, -3, -2}, {2,
   True}}, {{-1, 2, -3} -> {1, -2, -3}, {2,
   True}}, {{1, -3, -2} -> {1, -2, -3}, {3,
   False}}, {{2, 1, -3} -> {-2, -1, -3}, {1,
   True}}, {{-3, -2, -1} -> {-2, -1, -3}, {3,
   True}}, {{-3, -2, -1} -> {-1, -3, -2}, {2,
   True}}, {{1, -3, -2} -> {-1, -3, -2}, {1,
   False}}, {{1, -2, -3} -> {-1, -2, -3}, {1,
   False}}, {{-2, -1, -3} -> {-1, -2, -3}, {2,
   False}}, {{-1, -3, -2} -> {-1, -2, -3}, {3, False}}};

DisplayPosetGraph[g]