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.

In the document of FullGraphics, it promise to produce the same graphic result as the input one:

"FullGraphics[g] should display the same as g, though it may have a different internal structure."

but it has problem in the ticks and axes as the follow example, as they are too thin and the ticks position aren't the same as the original one.

g = Plot[Sin[x], {x, 0, 10}]
Show[FullGraphics[g], AspectRatio -> 1/GoldenRatio]

I have two question:

  1. What is the mechanism of axes, tick etc, why they are treated different from the graphics primitives in MMA? Could you explain how MMA convert the axes, ticks etc into the graphics primitives?
  2. Is there any "easy" solution to make FullGraphics to reproduce the same result as the input image, or even write one's own version of FullGraphics? Thanks. Sorry I'm a novice and I can't post the figure.
share|improve this question
2  
Unfortunately FullGraphics has many problems. Also it doesn't work that well with all the new (post version 6) graphics functionality. I don't think there's an easy solution (if there is, I'd like to know). –  Szabolcs Feb 19 '13 at 0:41
2  
@Nasser Thanks for asking. I was trying to produce a 3d plot, which contains several 2d plots oriented differently in the 3d space. The first way to achieve this is to draw Polygons and put 2d plots as textures on them, but this requires rasterize the 2d plot which will produce a less nicer 3d plot than the second way. The second way is to convert the 2d plot directly into 3d by convert the 2d coordinate to 3d. This will work but on the plot content, but not on the axes or ticks in the plot, since they are not graphics primitives. FullGraphics can convert the axes, ticks etc into primitives. –  xslittlegrass Feb 19 '13 at 0:50
    
I think FullGraphics uses the actual coordinates for aspect-ratio, so you may need to stretch the origin graphics before feeding it to FullGraphics. And it seems to generate ticks with PlotRangePadding->0, which will affect the automatic ticks generation if PlotRange is set to Automatic. About the length of ticks, it looks for me like the default style in old MMA versions (like v4), so my personal guess is, maybe it was forgotten to be adjusted to new default style? –  Silvia Feb 19 '13 at 20:27
add comment

1 Answer

up vote 8 down vote accepted

First of all, I'd say thank you very much to bring such an interesting function to me! I played around with it awhile and came up with the following thought, which I hope would be helpful for you.

About your first question, I'm sorry I know nothing concrete but only some guessing.

1. Aspect Ratio

I think FullGraphics uses the actual coordinates to calculate aspect-ratio (like setting AspectRatio->Automatic in Plot), so you may need to stretch the origin graphics g before feeding it to FullGraphics.

g = Plot[Sin[x], {x, 0, 10}]

Mathematica graphics

Setting AspectRatio doesn't really affect the result:

FullGraphics /@ {g, Show[g, AspectRatio -> RandomReal[]]} // Column

Mathematica graphics

2. Position of Ticks

And it seems, if Ticks was set to Automatic in the input g, FullGraphics generates ticks positions with flavor that Plot does with PlotRangePadding->0, which will affect the automatic ticks generation if PlotRange is set to Automatic(i.e. the default setting).

the PlotRange of g:

{xrange, yrange} = PlotRange /. AbsoluteOptions[g, PlotRange]

Compare two kinds of settings, where the right side column merged the original PlotRangePadding space into PlotRange:

Mathematica graphics

3. Length of Tick-marks

About the lengths of tick marks, it looks for me like the default style in old Mathematica versions (like 4.x), so my personal guess would be, maybe it was just forgotten to be adjusted to new default style.

About your second question

So here is my homemade brute-force method:

Clear[labelFmtFunc]
labelFmtFunc[label_] := 
 If[label === "", "", 
  If[FractionalPart[label] == 0, Round[label], label]]

Clear[ticksStretchFunc]
ticksStretchFunc[ticksetting_, xrange_, yrange_, stretchRatio_, 
  factor_: 2] := Module[{xTicksetting, yTicksetting},
  xTicksetting = 
   ticksetting[[
     1]] /. {pos_, label_, {plen_, nlen_}, style_} :> {pos, 
      labelFmtFunc[label], factor {plen, nlen}, style};
  yTicksetting = 
   ticksetting[[
     2]] /. {pos_, label_, {plen_, nlen_}, 
      style_} :> {stretchRatio pos, labelFmtFunc[label], 
      factor {plen, nlen}, style};
  {xTicksetting, yTicksetting}
  ]

Clear[myFullGraphics]
myFullGraphics[g_Graphics, tickLengthFactor_: 2] := 
 Module[{xrange, yrange, stretchRatio, padding, newxrange, newyrange, 
   newg, ticksetting},
  {xrange, yrange} = PlotRange /. AbsoluteOptions[g, PlotRange];
  stretchRatio = 
   AspectRatio {-1, 1}.xrange/{-1, 1}.yrange /. 
    AbsoluteOptions[g, AspectRatio];
  padding = PlotRangePadding /. AbsoluteOptions[g, PlotRangePadding];
  {newxrange, newyrange} = 
   MapThread[#1 + {-1, 1} If[
        Head[#2] === Scaled, #2[[1]] {-1, 1}.#1, #2] &, {{xrange, 
      yrange}, padding}];
  newg = Show[g, PlotRange -> {newxrange, newyrange}];
  ticksetting = Ticks /. AbsoluteOptions[newg, Ticks];
  Show[If[Head[newg[[1]]] === GraphicsComplex,
     newg /. 
      GraphicsComplex[pts_, others__] :> 
       GraphicsComplex[
        pts /. {x_?NumericQ, y_?NumericQ} :> {x, stretchRatio y}, 
        others],
     newg /. 
      Line[pts__] :> 
       Line[pts /. {x_?NumericQ, y_?NumericQ} :> {x, stretchRatio y}]],
    Ticks -> 
     ticksStretchFunc[ticksetting, xrange, yrange, stretchRatio, 
      tickLengthFactor], 
    PlotRange -> {newxrange, stretchRatio newyrange}, 
    PlotRangePadding -> 0] // FullGraphics
  ]

Apply it on g:

myFullGraphics[g]

Mathematica graphics

So it's fairly consistent with the original g obtained by Plot.

Applications

myFullGraphics can be used to convert lots (though not all and not always perfectly) of 2D graphics, including those from ContourPlot, into full graphics. The following demonstrates a simple application.

Here is a Graphics object obtained by myFullGraphics:

fullg = PolarPlot[Sin[2 \[Theta] + 2 10^15], {\[Theta], 0, 8 Pi}, 
   WorkingPrecision -> MachinePrecision, 
   PlotRange -> {{-1.1, 1.1}, {-1.1, 1.1}}, 
   PlotRangePadding -> {Scaled[.02], Scaled[.02]}] // 
  myFullGraphics[#, 30] &

Mathematica graphics

We map it onto the surfaces of several ellipsoids (note the axesRules, I manually converted the axes lines which contains only two endpoints into a line with more points):

Map[With[{range = PlotRange /. AbsoluteOptions[fullg, PlotRange], 
     uShift = 0, vShift = 0, rShift = #},
    Clear[transFunc];
    transFunc[{x_?NumericQ, y_?NumericQ}] := Module[{u, v},
      u = Rescale[x, range[[1]], \[Pi]/9 {-1, 1} + uShift];
      v = Rescale[y, range[[2]], \[Pi]/2 + \[Pi]/9 {-1, 1} + vShift];
      rShift {Sin[u] Sin[v], 1.4 Cos[u] Sin[v], Cos[v]}
      ];
    Module[{graphComplexTemp, axesRules},
     axesRules = {SortBy[
          Cases[fullg, Line[{{_, y_}, {_, y_}}], \[Infinity]], 
          Abs[{-1, 1}.#[[1, All, 1]]] &][[-1]] /.
        Line[{{x1_, y_}, {x2_, y_}}] :> (Line[{{x1, y}, {x2, y}}] -> 
           Line[{#, y} & /@ Range[x1, x2, (x2 - x1)/100]]),
       SortBy[Cases[fullg, Line[{{x_, _}, {x_, _}}], \[Infinity]], 
          Abs[{-1, 1}.#[[1, All, 2]]] &][[-1]] /.
        Line[{{x_, y1_}, {x_, y2_}}] :> (Line[{{x, y1}, {x, y2}}] -> 
           Line[{x, #} & /@ Range[y1, y2, (y2 - y1)/100]])};
     Graphics3D @@ fullg /.
           GraphicsComplex[pts_, 
             others__] :> (graphComplexTemp = 
              GraphicsComplex[transFunc /@ pts, others]; 
             "graphComplexTemp") /.
          axesRules /.
         {Point[pts__] :> 
           Point[pts /. {x_?NumericQ, y_?NumericQ} :> 
              transFunc[{x, y}]],
          Line[pts__] :> 
           Line[pts /. {x_?NumericQ, y_?NumericQ} :> 
              transFunc[{x, y}]],
          Arrow[pts__] :> 
           Arrow[pts /. {x_?NumericQ, y_?NumericQ} :> 
              transFunc[{x, y}]], 
          Polygon[pts__] :> 
           Polygon[
            pts /. {x_?NumericQ, y_?NumericQ} :> transFunc[{x, y}]],
          Text[txt_, pos_, offset_] :> 
           Text[txt, transFunc[pos], offset]} /.
        "graphComplexTemp" -> graphComplexTemp /.
       Hue[__] :> ColorData["Rainbow"][RandomReal[]] /.
      (PlotRange -> _) :> (PlotRange -> All)]
    ] &, Range[1, 2, .3]] // 
 Show[#, Axes -> True,(*AxesOrigin->{0,5,0},*)AxesStyle -> Red, 
   BoxStyle -> Directive[GrayLevel[.8]], ViewPoint -> {2.5, 1.4, 1.5},
    ViewRange -> All, ViewVertical -> {0, 0, 1}, 
   SphericalRegion -> True, RotationAction -> "Clip", 
   ImageSize -> 950] &

enter image description here

share|improve this answer
    
Thank you very much for your answer, it is exactly what I'm trying to do, especially the application part. I'm going through your code right now and I'm sure I can learn a lot from them. Thanks again. –  xslittlegrass Feb 21 '13 at 22:09
    
@xslittlegrass You are welcome. The code in the application part is very rough, you may need to complete it for more general purpose. –  Silvia Feb 22 '13 at 4:04
add comment

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.