3
$\begingroup$

What directive within the LayeredGraphPlot command specifies where the edges attach to vertices? For example, instead of the left output below, I'd like to have the right one.

enter image description here enter image description here

gph = {{
\!\(\*SubscriptBox[\("\<e\>"\), \("\<13\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<36\>"\)]\)} -> {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}, {\!\(\*SubscriptBox[\("\<e\>"\), \("\<13\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), 
\!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<34\>"\)]\)} -> {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), 
\!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}, {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<15\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<56\>"\)]\)} -> {
\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}, {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<23\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<36\>"\)]\)} -> {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), 
\!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}, {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\),   \!\(\*SubscriptBox[\("\<e\>"\), \("\<23\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<34\>"\)]\)} -> {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\),     \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}, {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\),     \!\(\*SubscriptBox[\("\<e\>"\), \("\<25\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<56\>"\)]\)} -> {\!\(\*SubscriptBox[\("\<e\>"\), \("\<14\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<16\>"\)]\), \!\(\*SubscriptBox[\("\<e\>"\), \("\<24\>"\)]\),    \!\(\*SubscriptBox[\("\<e\>"\), \("\<26\>"\)]\)}};
LayeredGraphPlot[gph, Right, VertexLabeling->True, DirectedEdges->False, SelfLoopStyle->False, PlotRangePadding->0]

Edit: The following Mathematica code (answer below)

ClearAll[n, k, g, \[Mu], \[Mu]\[Mu], \[CapitalGamma]0, 
\[CapitalGamma]1]; n = 4; 
multiComplement = Join@@(ConstantArray[First@#,Max[Last@#,0]]& /@ (Tally[#1]/.(Tally[#2]/.{e_,c_Integer} :> {e,k_Integer}->{e,k-c})))&;
g = Flatten[Table[{a, b}, {a, 1, n}, {b, a, n}], 1]; dim = Length@g;
\[Mu][{a_, a_}, {b_, b_}] := 0; \[Mu][{a_, a_}, {b_, c_}] := If[a == b || a == c, {b, c}, 0]; \[Mu][{a_, b_}, {c_, c_}] := If[a == c || b == c, {a, b}, 0]; 
\[Mu][{a_, b_}, {c_, d_}] := Which[b == c, {a, d}, a == d, {c, b}, True, 0]; lft={1,1}; rgt={4,4};
\[CapitalGamma]0 = Select[Subsets[g,{1}], Sort[multiComplement[First/@#, Last/@#]] == lft && Sort[multiComplement[Last/@ #,First/@#]] == rgt &]; \[CapitalGamma]1={}; 
For[k=2, k<=dim, k++, TT=Select[Subsets[g,{k}], Sort[multiComplement[First/@#, Last/@#]]==lft && Sort[multiComplement[Last/@#,First/@#]]==rgt&]; \[CapitalGamma]0=Join[\[CapitalGamma]0, TT]; 
 For[l = 1, l <= Length@TT, l++, tt = TT[[l]]; 
  For[i = 1, i <= k, i++,
   For[j = i + 1, j <= k, j++, \[Mu]\[Mu]=\[Mu][tt[[i]],tt[[j]]]; 
    If[\[Mu]\[Mu] == 0, Continue[]];
    t = Join[tt[[1;;i-1]], tt[[i+1;;j-1]], tt[[j+1;;k]]]; 
    If[MemberQ[t, \[Mu]\[Mu]], Continue[]];  ii=1;  
    For[jj = 1;, ii <= Length@t, jj++, If[g[[jj]] == t[[ii]], ii++]; 
     If[g[[jj]]==\[Mu]\[Mu], Break[]]];
    t = Join[t[[1;;ii-1]], {\[Mu]\[Mu]}, t[[ii;;-1]]]; 
    \[CapitalGamma]1 = Append[\[CapitalGamma]1, tt->t];]]]]
gph = Join[\[CapitalGamma]1, #->#&/@ \[CapitalGamma]0] /. {a_Integer, b_Integer} :> Subscript["e", ToString[a] <> ToString[b]];
LayeredGraphPlot[gph, Right, VertexLabeling->True, DirectedEdges->False, SelfLoopStyle->False, MultiedgeStyle->None, PlotRangePadding->0] /.
 Text[Framed[x_,z___],y_] :> With[{ap=Switch[x,gph[[1,2]],{Right,Center},_,{Left,Center}]}, Text[Framed[x,z],y,ap]]

produces enter image description here which is not the desired effect.

$\endgroup$
1
  • 1
    $\begingroup$ Please post your code. $\endgroup$ Feb 9, 2015 at 22:42

1 Answer 1

5
$\begingroup$

Update: The offset trick in the original answer works only for two-layer graphs. For more than two layers, we need to take into account the sizes of the vertex labels to translate the lines by appropriate amounts. This is achieved in several steps with the end result:

enter image description here

Step 0: Using the update version of gph and deleting duplicates:

lgp = LayeredGraphPlot[DeleteDuplicates @ gph, Right, ImageSize -> 1200, 
   VertexLabeling -> True, DirectedEdges -> False, 
   SelfLoopStyle -> False, MultiedgeStyle -> None, ImageSize -> 1000, 
   AspectRatio -> 1/2];

Step 1: Extract labels and vertices from lgp:

labels = Cases[lgp, Text[f_, a__] :> f, {0, Infinity}];
vertices = labels[[All, 1]];

Step 2: Extract plot range and image dimensions:

rs = Rasterize[lgp, "RasterSize"];
prF1 = Charting`CommonDump`getplotrange[#, AxesOrigin /. Options[#, AxesOrigin]] &;
ps = -Subtract @@@ prF1[lgp];

Step 3: Rescale the coordinates:

rescaledlgp = lgp /. GraphicsComplex[c : {__}, p__] :> 
    GraphicsComplex[Transpose[{Round @ Rescale[#, {0, ps[[1]]}, {0, rs[[1]]}], 
         Round @ Rescale[#2, {0, ps[[2]]}, {0, rs[[2]]}]} & @@ Transpose[c]], p];

vcoords = rescaledlgp[[1, 1, 1]];

Step 4: Compute the amounts by which to translate the edges based on label sizes:

hlength = -Subtract @@ (prF1[rescaledlgp][[1]]);
ClearAll[vCoordRule, hOffset]
vCoordRule = Thread[vertices -> vcoords];
Table[hOffset[ll[[1]] /. vCoordRule] = Rescale[Rasterize[Style[ll, "Graphics"], 
 "RasterSize"][[1]]/2, {0, rs[[1]]}, {0, hlength}], {ll, labels}];

Step 5: Post-process to modify the lines:

Show[rescaledlgp /. {Text[t_, b_] :> Text[t, Scaled@vcoords[[b]]], 
 Line[p : {{_, _} ..}] :> 
   (Line[{Scaled[(# - {hOffset[#], 0}) &@ vcoords[[#[[1]]]]], 
         Scaled[(# + {hOffset[#], 0}) &@ vcoords[[#[[2]]]]]}] & /@ (# & /@ p))} , 
  AspectRatio -> 1,  ImageSize -> 1500] // Magnify[#, 1/2] &

gives the picture above.

Note: You might need to resize to avoid overlaps.

Original answer:

lgp1 = LayeredGraphPlot[gph, Right, VertexLabeling -> True, DirectedEdges -> False, 
   SelfLoopStyle -> False, PlotRangePadding -> 0, AspectRatio -> 1, ImageSize -> 400];

Post-process lgp1 to add the appropriate alignment point ({Right, Center} for the root vertex and {Left, Center} for the leaves) to the Text primitives representing the vertex labels:

lgp2 = lgp1 /. Text[Framed[x_, z___], y_] :>
   With[{ap = Switch[x, gph[[1, 2]], {Right, Center}, _, {Left, Center}]}, 
        Text[Framed[x, z], y, ap]]

Row[{lgp1, lgp2}, Spacer[20]]

enter image description here

$\endgroup$
3
  • $\begingroup$ ... not sure if the same trick can be made to work for more than two layers. $\endgroup$
    – kglr
    Feb 10, 2015 at 0:53
  • $\begingroup$ Doesn't work as it should; see my edit above. $\endgroup$
    – Leo
    Feb 14, 2015 at 0:31
  • 1
    $\begingroup$ @Leon, right, it doesn't; as is it works for only two-layer graphs as in your original example. Hence my comment just above yours -- i should have had "I seriously doubt..." instead of "not sure...":) Good question btw. I think constructing a EdgeRenderingFunction that takes into account the sizes/shapes of vertex labels might be possible but i can't think of an easy way to do that. $\endgroup$
    – kglr
    Feb 14, 2015 at 1:01

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.