# How to examine the structure of Graphics objects

One difficulty I'm encountering in studying the structure of Graphics objects is that I have not yet found a way to print or display such structures that are sufficiently general.

The FullForm of Graphics objects can be huge and extremely difficult to take in visually. I have tried to deal with this using Shallow, but with only limited success, because I find that "the interesting bits" in a Graphics not always occur at the same depth.

It's a chicken-and-egg problem: to write a function that displays such structure in a useful way, I need to understand what such structure could be. But gaining this understanding is precisely what I'm trying to do here!

In case it matters, I'm primarily interested in examining the structure of Graphics objects generated, directly or indirectly, by plotting commands such as Plot, ListPlot, etc.

-
LOoking for things like this? Plot[{Cos[x], Sin[x]}, {x, 0, 4 Pi}][[1]] /. l_List /; Length[l] > 5 :> Short[l] –  ssch Sep 20 at 16:51
This answer by MichaelE2 is very educational too. –  cormullion Sep 20 at 16:59
(plot // First) /. List[(_?NumericQ) ..] :> Sequence[] used there - reducing quality... –  Kuba Sep 20 at 18:27
You could also addapt the tools provided in (29339) –  Mr.Wizard Sep 21 at 13:11

Finally, the following code gives you an interactive tree. You might want to enlarge the area of the tree if the nodes are too small.

structureOfGraph[gr_] := Module[{xx = gr /. Rule[a_, _] :> a /.
x_ /; And @@ NumericQ /@ x :> x[[0]] /. {List ..} :>
ListOfLists}, Manipulate[TreeForm[xx, n], {n, 1, Depth[xx] - 1, 1}]];

structureOfGraph[Show[Plot[{Cos[x], Sin[x]}, {x, 0, 4 Pi}], Graphics[{Circle[]}]]]


Second iteration

This second attempt makes an even shorter tree by getting rid of the terminal List:

TreeForm[Graphics[{Blue, {EdgeForm[{Red, Thick}], Disk[]},
Disk[{1, 0}]}] /. x_ /; And @@ NumericQ /@ x :> x[[0]] /. x_[List] :> x]


First iteration

TreeForm[Graphics[{Blue, {EdgeForm[{Red, Thick}], Disk[]},
Disk[{1, 0}]}] /. x_ /; And @@ NumericQ /@ x :> x[[0]]]


produces

-
Extremely cool, many thanks! –  kjo Sep 20 at 18:41

In light of the structure of Graphics, the best bet is to write a parser. Here is one I wrote. It is not complete, as I keep discovering directives I've missed, but it is close.

(* Utility for turning printing on/off. *)
(* --- Mr.Wizard's version of BlockPrint --- *)
ClearAll[BlockPrint];
SetAttributes[BlockPrint, HoldRest];
BlockPrint[True , body_] := Block[{Print}, body]
BlockPrint[False, body_] := body

(* Parser proper. Invoked by: parser@Graphics[...] *)
ClearAll[parser, parseriparser, parserdirective, parserprimitive];

Options[parser] = {Verbose -> False};
parser[a_, opts:OptionsPattern[]] :=
Block[{parserstate = {}, parserprimList, parserunknownfcn},
parserunknownfcn[_]:= Sequence[];
BlockPrint[!OptionValue[Verbose],
Flatten[parseriparser[a]] /. parserprimList -> List
]
]

(* Better isolation*)
Begin["parser"];

directive := _AbsolutePointSize | _Arrowheads | _CapForm | _CMYKColor | _Dashing |
_EdgeForm | _FaceForm | _Glow | _GrayLevel | _Hue | _JoinForm |
_Opacity | _PointSize | _RGBColor | _Specularity | _Thickness;

primitive := _Arrow | _BezierCurve | _BSplineCurve | _BSplineSurface | _Circle |
_Cone | _Cuboid | _Cylinder | _Disk | _FilledCurve | _Inset |
_JoinedCurve | _Line | _Point | _Polygon | _Raster | _Raster3D |
_Rectangle | _Sphere | _Text | _Tube;

iparser[l_Legended] := iparser@First@l
iparser[g:(_Graphics|_Graphics3D)]:= iparser @ First @ g

iparser[{}]:= Sequence[]

iparser[l_List] :=
InternalInheritedBlock[{state},
Print["List"];
iparser /@ l
]

iparser[Style[a_, b__]]:=
InternalInheritedBlock[{state,unknownfcn},
(* augment unknown function to work with strings *)
unknownfcn[str_String]:= (state = {state, str}; ##&[]);
Print["Style"];
iparser /@ {b};
iparser @ a
]

iparser[GraphicsGroup[a_List]] :=
(Print["GraphicsGroup - List"]; iparser @ a)
iparser[GraphicsGroup[a_]]:=
(Print["GraphicsGroup - NoList"]; iparser @ {a})

iparser[g_GraphicsComplex]:=
(Print["GraphicsComplex - Normalizing."]; iparser @ Normal @ g);

iparser[Directive[a___]] :=
(Print["Directive: ", Directive[a]]; iparser /@ Flatten[{a}])

iparser[m:directive] :=
(Print["directive: ", m]; state = {state, m}; ##&[])

iparser[p:primitive] :=
(
Print["primitive: ", p, "; state: ", state];
(* Prevents flattening later *)
primList[Flatten[state], p]
)

iparser[a_] := (Print["unknown: ", a]; unknownfcn[a])
End[]; (* parser *)


This returns a list of the form

{{{directives__}, primitive_} .. }


So, it can not be immediately used again in a Graphics object, but that can be sidestepped if need be. Applying parser to the example from the previous question

parser@Graphics[{Blue, {EdgeForm[{Red, Thick}], Disk[]}, Disk[{1,0}]}]


returns

{
{{RGBColor[0, 0, 1], EdgeForm[{RGBColor[1, 0, 0], Thickness[Large]}]}, Disk[{0, 0}]},
{{RGBColor[0, 0, 1]}, Disk[{1, 0}]}
}


as I described.

-
Heavy duty. This could be very useful. Have you tested it much? I take it you wrote this before this question was asked? –  Mr.Wizard Sep 23 at 12:14
@Mr.Wizard I've been tinkering with it on and off for a little bit with the main changes being the primitive/directive lists. It has two flaws. First, I'm not handling Style right, but I don't know what to do with named styles. Second, it doesn't recurse into Inset, so it only goes so deep. –  rcollyer Sep 23 at 12:38
@Mr.Wizard looking at it, I don't think I'm treating GraphicsGroup entirely correctly. For instance, GraphicsGroup[Red] would leak in my parser, yet it is fully contained in Graphics. I have not encountered that form in live code, so I don't think it is an issue, but should be fixed. There is an apparent flaw like it for GraphicsComplex, but Normal@GraphicsComplex[...] returns a list. So, that processing takes over. –  rcollyer Sep 23 at 12:44
I added a simpler version of BlockPrint in an answer below. I think it would be more typical to handle "verbose" with Messages. Is there a reason you Print instead? –  Mr.Wizard Sep 23 at 12:45
Your implementation of BlockPrint is a little cleaner. As to why Print: debugging. Messages are a pain. Sure, q could be localized like that, but more simply, it should be in a package. My general use for it is very simple, and I usually don't have to worry about invalidating user code when working with it. –  rcollyer Sep 23 at 12:51

Here is a Graphics explorer that enables you to see the hierarchy of the Graphics statement while allowing you to open and close parts for clarity. Large graphics primitives (with 'large' I mean with lots of coordinates) are replaced with their graphical equivalents to make it a bit more compact and recognizable.

Test graphics:

plot =
Show[
Plot[{Cos[x], Sin[x]}, {x, 0, 4 Pi}],
Graphics[{Circle[]}],
Graphics@GraphicsComplex[{{10, 0}, {10, 1}, {9, 0}, {10, -1}}, Polygon[{1, 2, 3, 4}]]
]


There we go:

graphicsExplorer[plot]


A part of the Graphics structure can now be easily indexed using the printed level indications. For instance, the Hue statement in the picture above is:

plot[[1, 1, 1, 3, 1]]


Hue[0.67, 0.6, 0.6]

The code:

ClearAll[graphicsExplorer];
graphicsExplorer[expr_] := graphicsExplorer[expr, 0, False];
graphicsExplorer[expr_, d_, gc_] :=
If[AtomQ[expr],
Row[{d, "\[Rule]", expr}, " "],
If[MatchQ[h,
Line | Polygon | Point | Arrow | Tube | BezierCurve | BSplineCurve | BSplineSurface] &&
StringLength[ToString@expr] > 50,
Row[{d, "\[Rule]", h,
Graphics[If[gc === False, expr, GraphicsComplex[gc, expr]], AspectRatio -> 1/5]}, " "],
Framed@
OpenerView[{Row[{d, "\[Rule]", Tooltip[h, expr]}, " "],
Column[MapIndexed[
graphicsExplorer[#1, #2[[1]],
If[h === GraphicsComplex, expr[[1]], gc]] &, (expr /. h -> List)]]}]
]
]
]


A Tooltip provides a bit of context at every level.

For 3D graphics define a graphics3DExplorer in which every Graphics in the code is replaced by Graphics3D.

-
Wonderful! Thank you so much for posting this! –  kjo Sep 23 at 16:13
It's a situation that happens to me often in Mathematica SE, and more generally, cases in which I would like to accept more than one answer... –  kjo Sep 25 at 15:26

A streamlined version of Hector's "Second iteration" method:

simple = TreeForm[# //. h_[List | __?NumericQ] :> h] &;


Use:

Graphics[{Blue, {EdgeForm[{Red, Thick}], Disk[]}, Disk[{1, 0}]}] // simple


rcollyer's BlockPrint can be simplified:

SetAttributes[BlockPrint, HoldRest];
BlockPrint[False , body_] := Block[{Print}, body]
BlockPrint[True, body_] := body


I'll try to streamline the rest of his parser, once I understand it. :^)

-
Thanks! Trees are definitely an appealing for this task. It turns out, however, that for the Graphics objects I need most help with (namely, those generated by plotting commands like Plot), the standard TreeForm layout doesn't work: these trees have too many nodes at the same level, hence many node labels get obscured by the other ones. A conceptually simple fix would be to rotate the layout of the nodes (while keeping labels horizontal), but this is surprisingly difficult to do (at least for me). I posted a question about it,... –  kjo Sep 23 at 16:56
...and got several replies, but it was the same problem all over again: these solutions work fine with simple examples but fail with the trees I want to visualize. What's worse, they all fail in utterly baffling ways, and this bizarreness of behavior greatly cooled my enthusiasm for this line of attack. –  kjo Sep 23 at 16:57
@Mr.Wizard: "A streamlined version of Hector's …" what do you have against quick and dirty? You've been "streamlining" my answers for some time now! … Thank you. Your post taught me about the ? for patterns. –  Hector Sep 24 at 8:02
@Hector I sort of obsessively optimize syntax; I can't help myself. I figure I might as well share the results. I take it from "Thank you" that you don't mind; I hope this is the case. If you are learning about ? (PatternTest) be sure to read these: (1835), (1699), (30425) –  Mr.Wizard Sep 24 at 8:07
You've got the conditions in BlockPrint backwards, when True, Print should not be blocked, and vice verse. Fixing ... –  rcollyer Sep 24 at 19:23

When just looking for the structure all data is mostly noise, here is a way to strip out all lists that just contains numbers:

plot = Show[Plot[{Cos[x], Sin[x]}, {x, 0, 4 Pi}], Graphics[{Circle[]}]]
DeleteCases[
plot[[1]],
_List?(VectorQ[Flatten[#], NumericQ] &),
Infinity]
(* {{{
{Hue[0.67, 0.6, 0.6], Line[]},
{Hue[0.906068, 0.6, 0.6], Line[]}
}}, {Circle[{0, 0}]}} *)


VectorQ[Flatten[#], NumericQ] matches all lists of all shapes that contains only numbers unlike ArrayQ[#, _, NumericQ] it is True also for {{1},2} etc.

Circle[{0,0}] is in the output because after {0,0} is taken away Circle[] automatically evaluates back to Circle[{0,0}]`

-