Skip to main content

plotting - Axis label shifted in 3D plot


Does anybody know why the axis label is shifted in this plot? Probably because of the different lengths of the labels of the ticks? How can I have the axis label in the middle of the axis?


The code that generates the plot is


Plot3D[master, {l2, 0, 15}, {l3, 0, 15}, PlotRange -> {0, 0.02}, AxesLabel -> {Style[Subscript[\[Lambda], 2], "Text", Background -> White], Style[Subscript[\[Lambda], 3], "Text", Background -> White], Rotate[Text[Style["I(0,1,1,1)\n", 14]], \[Pi]/2]}, Ticks -> {Automatic, Automatic, {0, 0.01, 0.02}}]


The answer given below works for the mentioned plot. However, another problem occurs in another plot when plotting the range PlotRange -> {-11000000, 11000000} and where the labels on the axes ticks should be $−1⋅10^7$ and $1⋅10^7$ such as Ticks -> {Automatic, Automatic, {{-10000000, "-1*\!\(\*SuperscriptBox[\(10\), \(7\)]\)"}, 0, {10000000, "1*\!\(\*SuperscriptBox[\(10\), \(7\)]\)"}}}]. This does not work with the stated answer below.


Moreover, my label on the vertical axis includes subscripts, which is also not compatible with the suggestions in the answer: Text[ Style["B(\[Gamma])\!\(\*SubscriptBox[\(\[Lambda]\), \ \(2\)]\)\!\(\*SubscriptBox[\(\[Lambda]\), \(3\)]\)", 14]]}



enter image description here



Answer



I assume you are referring to the z-axis label, which is badly behaved (it tends to jump to the top or bottom of the axis on my example plot), especially at certain viewpoints:


label1


Although, by the nature of perspective in 3D plots, the axes labels will not always appear to be in the middle the the axis, here the position does seem to move out from the midpoint. My first guess was that this had to do with the interaction of the viewpoint and the Rotate applied to the label, but that doesn't seem to be the case, as an unrotated label does the same thing, so my current thought is that Mathematica's built-in label-placement function is struggling to find a clear view with the long numbers needed for the ticks.


Existing Answers


Positioning the label of the z-axis on 3D plots is a topic that has beed addressed here previously in several ways. As long as all you want is a good image of the plot to export, you could just specify the position of the label manually as a new graphic (as in this question) or via Inset with Epilog (here) or with Framed (here). However, these solutions are "static" and do not play well if you want to view your plot interactively by rotating and zooming, etc. This question shows several methods of dealing with axes labels overlapping crowded axes, but I think that the placement of the label in this instance should be addressed.


Workaround using Ticks


There is a "dynamic" work-around, but it is a bit dirty. Essentially, we can abuse Ticks to manually place a new axis label as a tick mark at the axis midpoint. Going through Ticks has the advantage that the label moves with the axis as it is repositioned when the plot is interacted with. We can define a new function for the ticks on the z-axis that includes a label (thanks to this question for the IntegerChop function):


zTicksLabel[ticks__, label_, style_: Null] := Module[

{IntegerChop, nform, nlength, zmin, zmax, t, longest},

IntegerChop = With[{r = Round[#]}, r + Chop[# - r]] &;
nform[n_] := Which[
n == 0, n,
10^-5 <= Abs[n] <= 10^5, n,
IntegerQ[Log10[Abs[n]]],
ScientificForm[N@n, NumberFormat -> (Row[{If[n < 0, "-"], 10^#3}] &)],
Divisible[n, 10^Floor@Log10@Abs[n]], ScientificForm[N@n, NumberPoint -> ""],
True, ScientificForm[n]

];
nlength = First[ImageSize /. Options[Rasterize@Invisible@nform@#]] &;

If[Length@{ticks} == 1,
t = IntegerChop@ticks;
{zmin, zmax} = {Min@t, Max@t},
{zmin, zmax} = First@{ticks};
t = IntegerChop[N@FindDivisions[{zmin, zmax}, Last@{ticks}]]
];


longest = First@MaximalBy[t, nlength];

Join[
{#, nform@#} & /@ t,
{{
Mean[{zmax, zmin}],
Row[
{Invisible@nform@longest,
If[style === Null, l, Style[l, style]] /.
{l -> Rotate[Row[{Invisible["M"], label, Invisible["M"]}], Pi/2]},

Invisible@nform@longest}, Invisible["M"]
]
}}
]
];

In response to the comments, I have made this function more sophisticated. The argument ticks, takes either:



  1. an explicit list of tick positions like {tick1, tick2, ...}, in which case only those ticks will be drawn;

  2. or the sequence {zmin, zmax}, n, in which case the function draws about n z-axis ticks between zmin and zmax according to the function FindDivisions (rather than the mysterious Mathematica default).



The argument label takes an expression (which can be anything that can be rotated and given a Style, but in most cases should be a string) and places it somewhat outside a tick in the middle. However, because the label is made with Ticks, it inherits the TickStyle options if they are specified, rather than LabelStyle, so I have left room for style options to be specified explicitly with the style argument. Also, this just rotates the label into a vertical position, rather than aligning it to the z-axis, as has been noted in the comments.


Apply it as so:


Plot3D[master, {l2, 0, 15}, {l3, 0, 15},
AxesLabel -> {Subscript[\[Lambda], 2], Subscript[\[Lambda], 3], Null},
LabelStyle -> Blue,
TicksStyle -> Red,
PlotRange -> {0, 0.02},
Ticks -> {Automatic, Automatic, zTicksLabel[{#1, #2}, 3, "I(0,1,1,1)", Orange] &}
]


label3


As a further example, to make all axes labels a larger size, we just pass FontSize -> 14 to LabelStyle and the style argument of zTicksLabel (keeping TicksStyle at size 10):


Plot3D[master, {l2, 0, 15}, {l3, 0, 15},
AxesLabel -> {Subscript[\[Lambda], 2], Subscript[\[Lambda], 3], Null},
LabelStyle -> 14,
TicksStyle -> 10,
PlotRange -> {0, 0.02},
Ticks -> {Automatic, Automatic, zTicksLabel[{#1, #2}, 3, "I(0,1,1,1)", 14] &}
]


label2


And lastly, if you only want two z-axis ticks at particular locations, do something like


Plot3D[master, {l2, 0, 15}, {l3, 0, 15},
AxesLabel -> {Subscript[\[Lambda], 2], Subscript[\[Lambda], 3], Null},
LabelStyle -> 14,
TicksStyle -> 10,
PlotRange -> {-1.1*^7, 1.1*^7},
Ticks -> {
Automatic,

Automatic,
zTicksLabel[{-10^7, 10^7},
"B(\[Gamma])\!\(\*SubscriptBox[\(\[Lambda]\), \(2\)]\)\!(\*SubscriptBox[\(\[Lambda]\), \(3\)]\)", 14] &
}
]

label4


Comments

Popular posts from this blog

front end - keyboard shortcut to invoke Insert new matrix

I frequently need to type in some matrices, and the menu command Insert > Table/Matrix > New... allows matrices with lines drawn between columns and rows, which is very helpful. I would like to make a keyboard shortcut for it, but cannot find the relevant frontend token command (4209405) for it. Since the FullForm[] and InputForm[] of matrices with lines drawn between rows and columns is the same as those without lines, it's hard to do this via 3rd party system-wide text expanders (e.g. autohotkey or atext on mac). How does one assign a keyboard shortcut for the menu item Insert > Table/Matrix > New... , preferably using only mathematica? Thanks! Answer In the MenuSetup.tr (for linux located in the $InstallationDirectory/SystemFiles/FrontEnd/TextResources/X/ directory), I changed the line MenuItem["&New...", "CreateGridBoxDialog"] to read MenuItem["&New...", "CreateGridBoxDialog", MenuKey["m", Modifiers-...

How to thread a list

I have data in format data = {{a1, a2}, {b1, b2}, {c1, c2}, {d1, d2}} Tableform: I want to thread it to : tdata = {{{a1, b1}, {a2, b2}}, {{a1, c1}, {a2, c2}}, {{a1, d1}, {a2, d2}}} Tableform: And I would like to do better then pseudofunction[n_] := Transpose[{data2[[1]], data2[[n]]}]; SetAttributes[pseudofunction, Listable]; Range[2, 4] // pseudofunction Here is my benchmark data, where data3 is normal sample of real data. data3 = Drop[ExcelWorkBook[[Column1 ;; Column4]], None, 1]; data2 = {a #, b #, c #, d #} & /@ Range[1, 10^5]; data = RandomReal[{0, 1}, {10^6, 4}]; Here is my benchmark code kptnw[list_] := Transpose[{Table[First@#, {Length@# - 1}], Rest@#}, {3, 1, 2}] &@list kptnw2[list_] := Transpose[{ConstantArray[First@#, Length@# - 1], Rest@#}, {3, 1, 2}] &@list OleksandrR[list_] := Flatten[Outer[List, List@First[list], Rest[list], 1], {{2}, {1, 4}}] paradox2[list_] := Partition[Riffle[list[[1]], #], 2] & /@ Drop[list, 1] RM[list_] := FoldList[Transpose[{First@li...

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...