Disconnected Frame/Axes in Plots

Question

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:

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.

Answer 1

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]

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

Answer 2

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

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]

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]

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

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

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

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]

Voilà!