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]]]