Diagonal Tick Marks

Question

I would like to draw diagonal tick marks around a plot, and simultaneously rotate the tick labels as well. I've mocked up what this would look like:

Is there an easy way to do this in Mathematica? I believe this is beyond the capabilities of the CustomTicks package.

Edit: I would like this to be general enough to work for arbitrary plot ranges, and perhaps it would be easiest to generate the plot first with the normal tick marks, and then apply a replacement to the final graphics object?

Answer 1

This was a bit harder -- and turned out more complicated -- than I thought it would be at first, mainly because at first I didn't think ahead to what would be required: To do the ticks and rotate them, you need to know the full plot range, including the padding, and the aspect ratio. Moreover, AbsoluteOptions does not work the way that would make it easy to figure these things out (unless I'm missing something).

In any case, this seems to work. The shared variables are localized in a Module containing the definitions.

Module[{
   plotrange0,          (* PlotRange *)
   plotrangepadding0,   (* PlotRangePadding *)
   aspectratio,         (* aspect ratio as a pair {x, y} *)
   xticks, yticks,      (* ranges for ticks (full plotrange) *)
   dplotrange,          (* width, height of full plotrange *)
   ticks,
   ticklen = 0.025,     (* length of ticks (const parameter) *)
   textoffset = 0.005}, (* how far from ticks to end of label (const parameter) *)

   (* convert PlotRangePadding setting to coordinate offsets *)
 paddingcvt[range_, {padX_, padY_}] := {{-1, 1} padX /. 
    Scaled[s_] :> s (range[[1, 2]] - range[[1, 1]]), {-1, 1} padY /. 
    Scaled[s_] :> s (range[[2, 2]] - range[[2, 1]])};
 paddingcvt[range_, padding_] := {{-1, 1} padding /. 
    Scaled[s_] :> s (range[[1, 2]] - range[[1, 1]]), {-1, 1} padding /. 
    Scaled[s_] :> s (range[[2, 2]] - range[[2, 1]])};
   (* calculate the plot range plus padding *)
 fullplotrange[] := plotrange0 + paddingcvt[plotrange0, plotrangepadding0];
   (* returns rotated ticks along side : tickposfn = {#, y0} or {x0, #} *)
 tickGraphics[tickrange_, Function[tickposfn_]] := GeometricTransformation[
     {Text[N@#, Scaled[{-ticklen - textoffset, 0}, tickposfn], {1, 0}], 
      Line[{Scaled[{-ticklen, 0}, tickposfn], tickposfn}]},
     rotate[\[Pi]/4, tickposfn]] & /@ 
   Select[FindDivisions[tickrange, 5], tickrange[[1]] < # < tickrange[[2]] &];
   (* returns transformation to rotate graphics, adjusting for aspect ratio distortion *)
 rotate[\[Theta]_, {a_, b_}] := Composition[
     ScalingTransform[dplotrange/aspectratio, #],
     RotationTransform[\[Theta], #],
     ScalingTransform[aspectratio/dplotrange, #]] &[{a, b}];

 slantTicks[g_] := ( (* calculate parameters *)
   plotrange0 = PlotRange /. AbsoluteOptions[g, PlotRange];
   plotrangepadding0 = If[# === Automatic, 
       AspectRatio /. AbsoluteOptions[g, PlotRangePadding], #] &[
     PlotRangePadding /. Options[g, PlotRangePadding]];
   {xticks, yticks} = fullplotrange[];
   dplotrange = -Subtract @@@ {xticks, yticks};
   aspectratio = If[# === Automatic, dplotrange, {1, #}] &[
     AspectRatio /. Options[g, AspectRatio]];
     (* the graphics *)
   ticks = Graphics[{AbsoluteThickness[0.5], 
      Line@Tuples[{xticks, yticks}][[{1, 3, 4, 2, 1}]], 
      tickGraphics[xticks, {#, yticks[[1]]} &],
      tickGraphics[yticks, {xticks[[1]], #} &]}, PlotRange -> All];
   Show[g, ticks, Axes -> False, Frame -> None, PlotRangeClipping -> False, 
    ImagePadding -> {{20, 5}, {20, 5}}])
 ]

It works with Plot:

slantTicks[Plot[Sin[Pi x] + Cos[Pi x]^2, {x, 0, 10}]]

It works with Graphics:

slantTicks[Graphics[{Red, Thick, Line[{{-0.5, 1.5}, {2.5, 0.55}}]}, 
  PlotRange -> {{-1, 3}, {0, 2}}, PlotRangePadding -> Scaled[0.05]]]

It's not perfect. Note PlotRangeClipping is set to False since ticks are plotted outside the PlotRange of g. There seem to be issues whatever order of ticks and g is used in Show, since the options of the first override the second.

I did try to use Ticks, with which one can rotate the labels with dealing with the aspect ratio. I failed, however, to figure out how to get rotated tick marks in the right places.

Answer 2

It's easy enough, if you like fiddling with values:

p = Plot[Sin[x], {x, 0, 10}];
r = Graphics[{
     FaceForm[None],
     EdgeForm[{Black}],
     Rectangle[{0, -1}, {10, 1}],
     Table[
      {
       Line[{{x - .2, -1.1}, {x, -1}}],
       Text[Style[x, 12], {x - .2, -1.2}, {0, 0}, {1, 1}]
      }, {x, 0, 10}],
     Table[
      {
       Line[{{-.25, y - .1}, {0, y}}],
       Text[Style[y, 12], {-0.5, y - .2}, {0, 0}, {1, 1}]
      }, {y, -1, 1, .5}] 
     }, AspectRatio -> 1/GoldenRatio];
Show[r, p]

If you were going to do a lot of these, it would be worth 'parameterizing' it, to save you fiddling with offsets and values. The problem of the two ticks at {0,0} is interesting, too.