Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
1  
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 '13 at 16:51
1  
This answer by MichaelE2 is very educational too. –  cormullion Sep 20 '13 at 16:59
1  
(plot // First) /. List[(_?NumericQ) ..] :> Sequence[] used there - reducing quality... –  Kuba Sep 20 '13 at 18:27
1  
Related: "Making customized InputForm and ShortInputForm." –  Alexey Popkov Sep 21 '13 at 2:52
1  
You could also addapt the tools provided in (29339) –  Mr.Wizard Sep 21 '13 at 13:11

5 Answers 5

up vote 15 down vote accepted

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]

enter image description here


First iteration

I will send this as an answer because I cannot add comments with graphics to this previous answer.

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

produces

enter image description here

share|improve this answer
    
Extremely cool, many thanks! –  kjo Sep 20 '13 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, 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;

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.

share|improve this answer
    
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 '13 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 '13 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 '13 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 '13 at 12:45
1  
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 '13 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]

Mathematica graphics

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.

share|improve this answer
    
Wonderful! Thank you so much for posting this! –  kjo Sep 23 '13 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 '13 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

enter image description here


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

share|improve this answer
    
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 '13 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 '13 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 '13 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 '13 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 '13 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}]

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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