Mathematica 9 is now available
Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2010

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

Search the Archive

Controlling relative scale of graphics objects

  • To: mathgroup at smc.vnet.net
  • Subject: [mg114056] Controlling relative scale of graphics objects
  • From: Yaroslav Bulatov <yaroslavvb at gmail.com>
  • Date: Mon, 22 Nov 2010 07:37:46 -0500 (EST)

Code below breaks graph into pieces and inset GraphPlots of those
piece into another GraphPlot. I use explicit list of coordinates for
all GraphPlots, and would like the scale to be uniform across all of
them. Can anyone suggest a good way to do it? IE, every piece in the
second picture should match precisely a piece in the first picture.

I also asked this question on http://stackoverflow.com/questions/4230823/consistent-size-for-graphplots/4239362


(*Visualize tree decomposition of a 3x3 grid*)
inducedGraph[set_] := Select[edges, # \[Subset] set &];
Subset[a_, b_] := (a \[Intersection] b == a);
graphName = {"Grid", {3, 3}};
edges = GraphData[graphName, "EdgeIndices"];
vars = Range[GraphData[graphName, "VertexCount"]];
vcoords = Thread[vars -> GraphData[graphName, "VertexCoordinates"]];

plotHighlight[verts_, color_] :=
  Module[{vpos, coords},
   vpos = Position[Range[GraphData[graphName, "VertexCount"]],
     Alternatives @@ verts];
   coords = Extract[GraphData[graphName, "VertexCoordinates"], vpos];
   If[coords != {}, AppendTo[coords, First[coords] + .002]];
   Graphics[{color, CapForm["Round"], JoinForm["Round"],
     Thickness[.2], Opacity[.3], Line[coords]}]];

jedges = {{{1, 2, 4}, {2, 4, 5, 6}}, {{2, 3, 6}, {2, 4, 5, 6}}, {{4,
     5, 6}, {2, 4, 5, 6}}, {{4, 5, 6}, {4, 5, 6, 8}}, {{4, 7, 8}, {4,
     5, 6, 8}}, {{6, 8, 9}, {4, 5, 6, 8}}};
jnodes = Union[Flatten[jedges, 1]];

SeedRandom[1]; colors =
 RandomChoice[ColorData["WebSafe", "ColorList"], Length[jnodes]];
bags = MapIndexed[plotHighlight[#, bc[#] = colors[[First[#2]]]] &,
   jnodes];

bagCentroid[bag_] := Mean[bag /. vcoords];
findExtremeBag[vec_] := (vertList = First /@ vcoords;
   coordList = Last /@ vcoords;
   extremePos =
    First[Ordering[jnodes, 1,
      bagCentroid[#1].vec > bagCentroid[#2].vec &]];
   jnodes[[extremePos]]);

extremeDirs = {{1, 1}, {1, -1}, {-1, 1}, {-1, -1}};
extremeBags = findExtremeBag /@ extremeDirs;
extremePoses = bagCentroid /@ extremeBags;

vrfInner =
  Inset[Graphics[{White, EdgeForm[Black], Disk[{0, 0}, .05], Black,
      Text[#2, {0, 0}]}, ImageSize -> 20], #] &;

Show[bags~
  Join~{GraphPlot[Rule @@@ edges, VertexCoordinateRules -> vcoords,
    VertexLabeling -> True, VertexRenderingFunction -> vrfInner]},
 ImageSize -> Small]

vrfOuter =
  Inset[Show[plotHighlight[#2, bc[#2]],
     GraphPlot[Rule @@@ inducedGraph[#2], Frame -> True,
      VertexCoordinateRules -> vcoords, SelfLoopStyle -> None,
      VertexLabeling -> True, VertexRenderingFunction -> vrfInner],
     ImageSize -> 100], #] &;

GraphPlot[Rule @@@ jedges, VertexRenderingFunction -> vrfOuter,
 EdgeRenderingFunction -> ({Red, Arrowheads[0], Arrow[#1, 0]} &),
 ImageSize -> 500,
 VertexCoordinateRules -> Thread[Thread[extremeBags -> extremePoses]]]


  • Prev by Date: Re: Best method to break apart a data set
  • Next by Date: Re: Mathematica 8: first impressions
  • Previous by thread: Re: Finding a function that makes it possible to
  • Next by thread: Comments on CUDA and Compile