Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

Is it possible to have "Tufte" style figure axes? That is so that the axes do not need to connect or span the entire data range?

For an example of what I mean from the R's default histogram style:

enter image description here

I know how to get the ticks out etc ... but not how to break the axes at the origin or only draw the axes/frame for a subset of the graphic range.

share|improve this question
up vote 15 down vote accepted

You can generate the axes separately using an "empty" Plot.

As you said you know how to specify the ticks, so I'll not bother to do it, but just show a simple example about what I mean:

hsgm = Histogram[RandomVariate[NormalDistribution[0, 1], 1000]]

axes = Plot[I, {x, 0, 1}, (* the range of x is not important *)
    AxesOrigin -> {-4, -10},
    PlotRange -> {{-3, 3}, {0, 200}}
    ] // FullGraphics;

Then combine them:

Show[{hsgm /. (Axes -> _) :> (Axes -> False), axes}, PlotRange -> All]

disconnected axes graphics

Note: FullGraphics is well-known to be a buggy function, but if you find it usable, I'll glad to mention my more detailed and interesting post on it.

Update

To add labels like FrameLabel, we can't use Frame or we'll break the "disconnected" appearence. Thus we have to add them manually.

Here we use the completePlotRange function invented by @AlexeyPopkov to detect the plot range of the histogram, and automatically generate the final plot.

Clear[myHistogram]
Options[myHistogram] = {"axesLabels" -> {}};
myHistogram[data_, OptionsPattern[]] := 
 Module[{axesLabels, axesOriginFunc, hsgm, range, axes, labels, aspr = 1/GoldenRatio},
        axesLabels = OptionValue["axesLabels"];
        axesOriginFunc[{min_, max_}, p_: 0.1] := min - p (max - min);
        hsgm = Histogram[data, Axes -> False, PlotRangePadding -> None];
        range = Through[{Min, Max}@FindDivisions[#, 10]] & /@ completePlotRange[hsgm];
        axes = Plot[I, {x, 0, 1},
                    AxesOrigin -> MapThread[axesOriginFunc, {range, {0.1 aspr, 0.1}}],
                    PlotRange -> range
                   ] /. {HoldPattern[Frame -> _] -> Frame -> False} //
               FullGraphics// (*disable Antialiasing to make the axes and ticks un-blur*)
               # /. Line[pts__] :> Style[Line[pts], Antialiasing -> False] &;
        If[axesLabels =!= {},

           labels = Graphics[{
                              Text[axesLabels[[1]],
                                   {Mean[range[[1]]], axesOriginFunc[range[[2]]]},
                                   {0, 5}],
                              Text[axesLabels[[2]],
                                   {axesOriginFunc[range[[1]], 0.1 aspr], Mean[range[[2]]]},
                                   {0, -5}, {0, 1}]
                             }];
           Show[{hsgm, axes, labels}, AspectRatio -> aspr, PlotRange -> All],

           Show[{hsgm, axes}, AspectRatio -> aspr, PlotRange -> All]
         ]
  ]

Usage:

myHistogram[
            RandomVariate[NormalDistribution[0, 1], 1000],
            "axesLabels" -> (Style[#, Bold, 14, Darker[Red]] & /@ {"x", "Frequency"})
           ]

disconnected frame example 2

share|improve this answer
    
So great! Thank you – Gabriel Dec 10 '13 at 13:36
    
@Gabriel Glad I can help! – Silvia Dec 10 '13 at 13:36
    
@Silva I am working through the details of this answer and I wonder if you could give an example that uses Frame instead of Axes ... as labeling the axes puts the label in the "wrong" place (at the end, not under). I worry that the AxesOrigin is key to getting the broken effect I want ... but then I don't know how to label the axes! – Gabriel Dec 10 '13 at 16:27
    
also does your other post cover all/most of the ways in which FullGraphics is buggy, or are there more? – Gabriel Dec 10 '13 at 23:10
    
@Gabriel Yes the AxesOrigin is the key, so there is no way to realize this by Frame. I think you'll have to place the labels manually, say by Text[ ]. I'll update the answer after breackfast. About the FullGraphics, I suggest you search it over this site to have a more general sight. – Silvia Dec 11 '13 at 8:36

Based on the findings from this and this answers, I can suggest the following approach.

Let us make a histogram:

SeedRandom[10];
hist = Histogram[RandomVariate[NormalDistribution[0, 1], 1000]]

histogram

It has AspectRatio -> 1/GoldenRatio (the default):

Options[hist, AspectRatio]
{AspectRatio -> 1/GoldenRatio}

Now we can place this histogram as Inset inside of another Graphics keeping both coordinate systems exactly aligned with each other. According to the linked answer we must specify explicit values for ImageSize, ImagePadding, AspectRatio and PlotRange (and set PlotRangePadding -> 0 for simplicity).

Suppose we want the horizontal ImageSize of the histogram to be

width = 350.;

A suitable value of ImagePadding can be taken as ImagePadding -> {{20, 5}, {15, 5}}. Then with the default AspectRatio the vertical ImageSize can be calculated as follows (this mathematics not only undocumented: it directly contradicts the Documentation - but it is how this actually works):

height = (width - (20 + 5))/GoldenRatio + (15 + 5)
220.861

So the explicit ImageSize is ImageSize -> {width, height}. Of course it is a shame that Mathematica still can't calculate the height unassisted, and we must do this massage in order to get options like ImagePadding working properly!

The explicit value of PlotRange we may set as PlotRange -> {{-5, 5}, {0, 250}}.

Now everything is ready:

g1 = Graphics[{Inset[
    Show[hist, ImageSize -> {width, height}, PlotRange -> {{-5, 5}, {0, 250}},
      FrameStyle -> Bold, ImagePadding -> iIP, PlotRangePadding -> 0, 
     Frame -> True, GridLines -> Automatic], {0, 0}, {0, 0}, Automatic]}, 
  Frame -> True, PlotRange -> {{-5, 5}, {0, 250}}, 
  AspectRatio -> 1/GoldenRatio, PlotRangePadding -> Scaled[.1], 
  FrameStyle -> Red, ImagePadding -> iIP/.8, GridLines -> Automatic, 
  GridLinesStyle -> Directive[Gray, Dashed], ImageSize -> {width, height}/.8]

plot

As one can see, the coordinate systems of the inset and the enclosing graphics are exactly aligned to each other. Now we may remove the Frame and GridLines from the inset:

g1 = Graphics[{Inset[
    Show[hist, ImageSize -> {width, height}, PlotRange -> {{-5, 5}, {0, 250}},
      ImagePadding -> {{20, 5}, {15, 5}}, PlotRangePadding -> 0, 
     Frame -> False, Axes -> False], {0, 0}, {0, 0}, Automatic]}, 
  Frame -> True, PlotRange -> {{-5, 5}, {0, 250}}, 
  AspectRatio -> 1/GoldenRatio, PlotRangePadding -> Scaled[.1], 
  FrameStyle -> Red, ImagePadding -> {{20, 5}, {15, 5}}/.8, 
  GridLines -> Automatic, GridLinesStyle -> Directive[Gray, Dashed], 
  ImageSize -> {width, height}/.8]

plot

Let us add another Inset containing only Frame with intrinsic coordinate system exactly aligned to the coordinate system of the enclosing graphics:

stretching = (3 + 3)/(5 + 5);
additionalPadding = (1 - stretching)*(350 - (20 + 5));
Show[g1, Graphics[
  Inset[Graphics[{}, ImageSize -> {width, height}, 
    PlotRange -> {{-3, 3}, {0, 250}}, FrameStyle -> Blue, 
    ImagePadding -> {{20, 5 + additionalPadding}, {15, 5}}, 
    PlotRangePadding -> 0, Frame -> True, GridLines -> Automatic, 
    AspectRatio -> 1/GoldenRatio/stretching], {0, 0}, {0, 0}, Automatic]]]

plot

Now we can keep only the bottom frame and move it a little lower putting Offset as the second argument of Inset:

g2 = Show[g1, 
  Graphics[Inset[
    Graphics[{}, ImageSize -> {width, height}, 
     PlotRange -> {{-3, 3}, {0, 250}}, FrameStyle -> Blue, 
     ImagePadding -> {{20, 5 + additionalPadding}, {15, 5}}, 
     PlotRangePadding -> 0, Frame -> {{False, False}, {True, False}}, 
     AspectRatio -> 1/GoldenRatio/stretching], 
    Offset[{0, -10}, {0, 0}], {0, 0}, Automatic]]]

plot

In the same way we can add left frame:

stretching = (200 + 0)/(250 + 0);
additionalPadding = (1 - stretching)*(350 - (20 + 5))/GoldenRatio;

g3 = Show[g2, 
  Graphics[Inset[
    Graphics[{}, ImageSize -> {width, height}, 
     PlotRange -> {{-5, 5}, {0, 200}}, FrameStyle -> Brown, 
     ImagePadding -> {{20, 5}, {15, 5 + additionalPadding}}, 
     PlotRangePadding -> 0, Frame -> True, GridLines -> Automatic, 
     AspectRatio -> stretching/GoldenRatio], {0, 0}, {0, 0}, Automatic]]]

plot

Removing unnecessary elements and adding Offset:

g3 = Show[g2, 
  Graphics[Inset[
    Graphics[{}, ImageSize -> {width, height}, 
     PlotRange -> {{-5, 5}, {0, 200}}, FrameStyle -> Brown, 
     ImagePadding -> {{20, 5}, {15, 5 + additionalPadding}}, 
     PlotRangePadding -> 0, Frame -> {{True, False}, {False, False}}, 
     AspectRatio -> stretching/GoldenRatio], Offset[{25, 0}, {0, 0}], {0, 0}, 
    Automatic]], GridLines -> None, Frame -> None]

plot

Voilà!

share|improve this answer
    
Very interesting approach and linked posts! I cant help thinking if only we have a handy function to generate arbitrary axis (including curved ones). – Silvia Jun 29 at 3:38
    
Not to mention the easy ability to invert, say, the y-axis like we do in neuroscience all the time... Grr. – flip Jul 2 at 22:59

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.