11
$\begingroup$

How can I create a plot with inclined axes? I want to get something like that:

Plot

$\endgroup$
5
$\begingroup$

This is my 2nd answer, which uses Graphics instead of Image. This approach allows us to manipulate individual graphics elements, which is necessary to rotate the grid lines but not the text. Thanks to @LLlAMnYP for GeometricTransformation and to @J.M. for ShearingMatrix. The trick to using GeometricTransformation is to apply FullGraphics first.

So first we generate define 2 shearing matrices. One is the inverse of the other. Then we generate some data and build a plot using Line, Graphics and FullGraphics. The PlotRangeClipping option is not work for me, so I had to select only the data points that fit in the plot range. The baseline graphics is called gfx and the last command in this section extracts all of the text from gfx as the variable glabels.

θ = π/6;
left = ShearingMatrix[-θ, {1, 0}, {0, 1}];
right = ShearingMatrix[θ, {1, 0}, {0, 1}];
data1 = Table[{x, 0.01/x^3.1 + 0.1}, {x, 0.1, 5, .01}];
data1 = Select[data1, #[[2]] < 5 &];
data1[[;; 10]]
data2 = Table[{x, 0.03/x^3 + 0.2}, {x, 0.1, 5, .01}];
data2 = Select[data2, #[[2]] < 5 &];
data3 = Table[{x, 0.05/x^2.9 + 0.3}, {x, 0.1, 5, .01}];
data3 = Select[data3, #[[2]] < 5 &];
gfx = FullGraphics@Graphics[{
    {Blue, Line[data1]},
    {Red, Line[data2]},
    {Green, Line[data3]}
    }, Frame -> True,
   PlotRange -> {{0, 5}, {0, 5}},
   PlotRangeClipping -> True,
   GridLines -> {{0, 1, 2, 3, 4, 5}, {0, 1, 2, 3, 4, 5}}
   ]
glabels = Cases[gfx, Text[___, ___, ___], Infinity];

enter image description here

Okay, now we are ready to shear the plot over to the left. But, we do not want to shear the text. So, we shear the glabels to the right, substitute those in for the original labels, and then shear the whole thing to the left. The substitution is done using a list of rules called grules. The sheared graphics is called sfx. These graphics contain the original gridline labels, but the gridlines are skewed to the left.

grules = Thread[Rule[#, GeometricTransformation[#, right]]] & /@ 
   glabels;
sfx = GeometricTransformation [#, left] & /@ (gfx /. grules)
slabels = Cases[sfx, Text[___, ___, ___], Infinity];

enter image description here

The x-axis labels are okay, but the y-axis labels must be translated, as opposed to sheared, over to the left. We define a function that will take the Text and a ShearingMatrix and produce a rule that translates the text, only if the text is a y-axis label. The 3rd argument of the Text function, called the offset, is used to distinguish the labels. If the offset is {0,1}, it is an x-axis label so do nothing. If the offset is {1,0}, it is a y-axis label, so translate apply the matrix transform to both the text coordinates and the offset. Here is the function definition:

mkRules[t_: Text, mat_] := 
 Block[{x = t[[1]], y = t[[2]], z = t[[3]]},
  Switch[1,
   Round[z.{0, 1}], Nothing[],
   Round[z.{1, 0}], Rule[t, Text[t[[1]], mat.t[[2]], mat.t[[3]]]]
   ]
  ]

We apply the function to make a list of rules for translating the slabels to get a list called srules. Then we apply srules to sfx, which gives the final product.

srules = mkRules[#, left] & /@ slabels;
afx = sfx /. srules

enter image description here

Voilà! The graph is sheared and the text is not. Thanks again to all commenters and other answers that led to this solution.

$\endgroup$
7
$\begingroup$

This approach duplicates some of the features of your example.

plt = Plot[{1/x, 2/x, 5/x}, {x, 0, 20}, 
   PlotRange -> {{-10, 20}, Automatic},
   GridLines -> Automatic, Frame -> False];
img = Image[plt];
ImagePerspectiveTransformation[img, {{1, -Sin[π/6]}, {0, 1}}]

enter image description here

Some of the sheared image is cut off. To fix that, you might be able to pad the image or insert it onto a larger blank canvas. There may be ways to mitigate the other drawbacks of this approach.

$\endgroup$
  • 2
    $\begingroup$ Have a look at ImagePerspectiveTransformation[Plot[{1/x, 2/x, 5/x}, {x, 0, 20}, PlotRange -> {{-10, 20}, Automatic}, GridLines -> Automatic] // Rasterize, ShearingMatrix[-π/6, {1, 0}, {0, 1}], Background -> White, Masking -> All, PlotRange -> All]. $\endgroup$ – J. M. will be back soon Oct 11 '16 at 10:40
  • $\begingroup$ Your solution is good, but axes labels are transformed also =( $\endgroup$ – Aracturat Oct 11 '16 at 17:29
5
$\begingroup$

I am not sure what the ultimate aim is here. I post this for illustration. Perhaps, it will motivate OP.

f[e1_, e2_, p_] := With[{m = Transpose[{e1, e2}]},
  m.p]
vis[e1_, e2_, s_] := 
 Module[{fun = f[e1, e2, #] &, r = Range[-1, 1, 0.1]}, 
  Graphics[{Red, Point[Table[fun@{i, i^2}, {i, -1, 1, s}]], Blue,
    Line[{fun@{-1, #}, fun@{1, #}}] & /@ r,
    Line[{fun@{#, -1}, fun@{#, 1}}] & /@ r}]]
Manipulate[
 Show[vis[v1, v2, 0.01], PlotLabel -> Transpose[{v1, v2}], 
  PlotRange -> 2, GridLines -> gridlines, GridLinesStyle -> Gray],
 {{v1, {1, 0}}, {-1, -1}, {1, 1}}, {{v2, {0, 1}}, {-1, -1}, {1, 1}},
 {gridlines, {None, Table[Range[-1, 1, 0.1], 2]}, 
  ControlType -> Checkbox}, ControlPlacement -> Left]

enter image description here

enter image description here

$\endgroup$
3
$\begingroup$

not exactly the same but perhaps useful

Graphics3D[
 First@Cases[Normal@ContourPlot[y^2 == a*x, {x, 0, 2}, {y, -2, 2}], 
   Line[x_] :> {Line[Append[#, 0] & /@ x]}, Infinity], 
 Axes -> {True, True, False}, AxesOrigin -> {0, 0, 0}, 
 FaceGrids -> {{0, 0, -1}}, Boxed -> False, 
 PlotRange -> {Automatic, Automatic, {0, 1}}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.