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.
tick[startx_,starty_,n_] :=Graphics[Text[Style[ToString[n] <> ".0", 30], {startx - 0.8, starty - 0.8}, Automatic, {1, 1}]],Graphics[Line[{{startx,starty}, {startx - 0.5, starty - 0.5}}]]
and add it onto a plot with allTicks
removed? $\endgroup$FullGraphics
function from here, and rotate the ticks. $\endgroup$