How to examine the structure of Graphics objects

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, parser`iparser, parser`directive, parser`primitive]; Options[parser] = {Verbose -> False}; parser[a_, opts:OptionsPattern[]] := Block[{parser`state = {}, parser`primList, parser`unknownfcn}, parser`unknownfcn[_]:= Sequence[]; BlockPrint[!OptionValue[Verbose], Flatten[parser`iparser[a]] /. parser`primList -> List ] ] (* Better isolation*) Begin["parser`"]; (* Note the changes for v10 *) directive := _AbsolutePointSize | _Arrowheads | _CapForm | _Dashing | _EdgeForm | _FaceForm | _Glow | _JoinForm | _Opacity | _PointSize | _Specularity | _Thickness | If[ $VersionNumber < 10, _CMYKColor | _RGBColor | _GrayLevel | _Hue, _?ColorQ ]; primitive := _Arrow | _BezierCurve | _BSplineCurve | _BSplineSurface | _Circle | _Cone | _Cuboid | _Cylinder | _Disk | _FilledCurve | _Inset | _JoinedCurve | _Line | _Point | _Polygon | _Raster | _Raster3D | _Rectangle | _Sphere | _Text | _Tube | If[ $VersionNumber >= 10, _Ball | _Circumsphere | _ConicHullRegion | _HalfLine | _HalfPlane | _Hexahedron | _InfiniteLine | _Parallelepiped | _Parallelogram | _Prism | _Pyramid | _Simplex | _Tetrahedron | _Triangle, ##&[] ] | If[ $VersionNumber >= 10.2, _AffineHalfSpace | _AffineSpace | _Annulus | _CapsuleShape | _Cuboid | _DiskSegment | _HalfSpace | _Hyperplane | _InfinitePlane | _Insphere | _RegularPolygon | _SphericalShell | _StadiumShape, ##&[] ]; (* AASTriangle, ASATriangle, SASTriangle, and SSSTriangle evaluate to Triangle via DownValues, so they'll never show up in Graphics(3D) by themselves. *) iparser[l_Legended] := iparser@First@l iparser[g:(_Graphics|_Graphics3D)]:= iparser @ First @ g iparser[{}]:= Sequence[] iparser[l_List] := Internal`InheritedBlock[{state}, Print["List"]; iparser /@ l ] iparser[Style[a_, b__]]:= Internal`InheritedBlock[{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.

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_] := Module[{h = Head[expr]}, 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.

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. :^)

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