How to get arrows for the axes when using the command Plot in Mathematica?
Thanks for any helpful answers.
For 2D plots such as generated by Plot the following works great:
Plot[Sin[x], {x, 0, 10}, AxesStyle -> Arrowheads[0.07]]
or with custom arrow heads:
h = Graphics[Line[{{-1, 1/2}, {0, 0}, {-1, -1/2}}]];
Plot[Sin[x], {x, 0, 10},
AxesStyle -> Arrowheads[{{Automatic, Automatic, h}}]]
Building on Sjoerd's answer,
a plot such as
may be obtained as follows (for example):
Plot[Sin[x], {x, -2\[Pi], 2 \[Pi]},
AxesStyle-> {
Directive[{Red,
Arrowheads[{{-0.06,0(*Xleft*),{Graphics[{
Polygon[
{{-1,0.5`},{0,0},{-1,-0.5`}}]}],0.98`}},
{0.03,.9(*Xright*),{Graphics[{
Polygon[
{{-1,0.5`},{0,0},{-1,-0.5`}}]}],0.98`}}}]}],
Directive[{Blue,
Arrowheads[{{-0.05,0(*Ydown*),{Graphics[{
Polygon[
{{-1,0.5`},{0,0},{-1,-0.5`}}]}],0.98`}},{0.03,.8(*Yup*),{Graphics[{
Polygon[
{{-1,0.5`},{0,0},{-1,-0.5`}}]}],0.98`}}}]}
]}]
There are nice examples of arrowheads given in Drawings Tools and Graphics Inspector. There are probably much better ways of getting the info but I annotate a plot with an arrow that I like and then abstract (using a suggestion from Simon):
Cases["Paste-Graphic_Here", Arrowheads[___], Infinity]
To give another example:
The code is as follows
Plot[Sin[x], {x, -2\[Pi],2 \[Pi]},
AxesStyle-> { Directive[{Red,
Arrowheads[{{-0.06,0.1(*Xleft*),
{Graphics[{arrowhead}]/.arrowhead-> arrowhead2,0.98`}},
{0.05,0.95(*Xright*),
{Graphics[{arrowhead}],0.98`}}}]/.arrowhead-> arrowhead4}],
Directive[{Blue,
Arrowheads[{{-0.05,0(*Ydown*),
{Graphics[{arrowhead}]/.arrowhead-> arrowhead3,0.98`}},{0.03,.8(*Yup*),
{Graphics[{arrowhead}]/.arrowhead-> arrowhead1,0.98`}}}]}
]}]
where
arrowhead1=Polygon[{{-1,0.5`},{0,0},{-1,-0.5`}}];
arrowhead2=Polygon[{{-1.5833333333333333`,0.4166666666666667`},{-1.5410500000000003`,0.369283333333333`},{-1.448333333333333`,0.255583333333333`},{-1.3991000000000005`,0.18721666666666673`},{-1.3564666666666663`,0.11826666666666673`},{-1.3268499999999999`,0.05408333333333341`},{-1.3166666666666667`,0.`},{-1.3268499999999999`,-0.048950000000000195`},{-1.3564666666666663`,-0.11228333333333372`},{-1.3991000000000005`,-0.18353333333333333`},{-1.448333333333333`,-0.2562833333333335`},{-1.5410500000000003`,-0.38048333333333345`},{-1.5833333333333333`,-0.43333333333333335`},{0.`,0.`},{-1.5833333333333333`,0.4166666666666667`},{-1.5833333333333333`,0.4166666666666667`}}];
arrowhead3=Polygon[{{-1,0.5`},{0,0},{-1,-0.5`},{-0.6`,0},{-1,0.5`}}];
arrowhead4={{FaceForm[GrayLevel[1]],Polygon[{{-0.6`,0},{-1.`,0.5`},{0.`,0},{-1.`,-0.5`},{-0.6`,0}}],Line[{{-0.6`,0},{-1.`,0.5`},{0.`,0},{-1.`,-0.5`},{-0.6`,0}}]}};
arrowhead5=Polygon[{{-0.6582278481012658`,-0.43037974683544306`},{0.`,0.`},{0.`,0.`},{0.`,0.`},{0.`,0.`},{0.`,0.`},{-0.6455696202531646`,0.43037974683544306`},{-0.4810126582278481`,0.`},{-0.6582278481012658`,-0.43037974683544306`},{-0.6582278481012658`,-0.43037974683544306`}}];
A list of arrowheads 1 to 5:
Here you have a solution posted in https://math.stackexchange.com/
As the solution in the reference is for Plot3D, here I modified (but not improved) it for Plot[ ]:
axes[x_, y_, f_, a_] :=
Graphics[Join[{Arrowheads[a]},
Arrow[{{0, 0}, #}] & /# {{x, 0}, {0, y}},
{Text[Style["x", FontSize -> Scaled[f]], {0.9*x, 0.1*y}],
Text[Style["y", FontSize -> Scaled[f]], {0.1 x, 0.95*y}]
}]]
Show[Plot[Exp[-x^2], {x, -2, 2},
Axes -> None,
PlotRange -> {{-2.1, 2.1}, {-.1, 1.1}}],
axes[2, 1, 0.05, 0.02]
]
Related
I get this error for the Show method, why? :/
sol = First#
NDSolve[{eq1ad, eq2ad, eqrad} U CondizioniIniziali, {q1, q2,
qr}, {t, 0, T}]
p1 = ParametricPlot3D[
{xE, yE, zE} /. sol,
{t, 0, T},
AxesLabel -> {"x[t]", "y[t]", "z[t]"},
BoxRatios -> {1, 1, 1},
PlotStyle -> Red
]
Manipulate[
Show[
p1,
ListLinePlot[
{{0, 0, 0}, {xB, yB, zB}, {xE, yE, zE}} /. sol /. t -> time,
PlotStyle -> {Thick, Red}
]
],
{time, 0, T}
]
Is it maybe because I can't combine a ParametricPlot3d with Show?
I think you are trying to combine a 2D ListLinePlot with a 3D ParametricPlot3D. Reading the documentation for ListLinePlot seems to show that it only accepts 2D points, not 3D points.
You might be able to adapt something like this
T=2;
p1 = ParametricPlot3D[{Sin[t],Cos[t],t^2}, {t,0,T}];
Show[p1, Graphics3D[ Line[{{0, 0, 0}, {1/2,1/2,2}, {1/3, 1/3,3}}]]]
which can turn a list of 3D points into a Line into a Graphics3D and then combine that your ParametricPlot3D
In the accepted answer of question " Mathematica and MouseListener - developing interactive graphics with Mma " Sjoerd C de Vries demonstrates that it is possible to select an object in a 3D graphic and change its color.
I would like to know if it is possible (in a similar fashion as above) in a Graphics3D with two or more objects (e.g. two cuboids) to select one and change its coordinates (by moving or otherwise)?
I'm partly reusing Sjoerd's code here, but maybe something like this
DynamicModule[{pos10, pos11 = {0, 0, 0},
pos12 = {0, 0, 0}, pos20, pos21 = {0, 0, 0}, pos22 = {0, 0, 0}},
Graphics3D[{EventHandler[
Dynamic[{Translate[Cuboid[], pos11]}, ImageSize -> Tiny],
{"MouseDown" :> (pos10 = Mean#MousePosition["Graphics3DBoxIntercepts"]),
"MouseDragged" :> (pos11 =
pos12 + Mean#MousePosition["Graphics3DBoxIntercepts"] - pos10),
"MouseUp" :> (pos12 = pos11)}],
EventHandler[
Dynamic[{Translate[Cuboid[{1, 1, 1}], pos21]}, ImageSize -> Tiny],
{"MouseDown" :> (pos20 = Mean#MousePosition["Graphics3DBoxIntercepts"]),
"MouseDragged" :> (pos21 =
pos22 + Mean#MousePosition["Graphics3DBoxIntercepts"] - pos20),
"MouseUp" :> (pos22 = pos21)}]},
PlotRange -> {{-3, 3}, {-3, 3}, {-3, 3}}]]
Note that this just moves the cuboids in a plane so you would have to rotate the bounding box to move them perpendicular to that plane, but it shouldn't be too hard to introduce a third dimensions by adding modifier keys.
Edit
Thanks for the comments. Here's an updated version of the code above. In this version the cubes jump back to within the bounding box if they happen to move outside so that should solve the problem of the disappearing cubes.
DynamicModule[{init, cube, bb, restrict, generate},
init = {{0, 0, 0}, {2, 1, 0}};
bb = {{-3, 3}, {-3, 3}, {-3, 3}};
cube[pt_, scale_] :=
Translate[Scale[Cuboid[{-1/2, -1/2, -1/2}, {1/2, 1/2, 1/2}], scale], pt];
restrict[pt_] := MapThread[Min[Max[#1[[1]], #2], #1[[2]]] &, {bb, pt}];
generate[pos_, scale_] := Module[{mp, pos0, pos1, pos2},
mp := MousePosition["Graphics3DBoxIntercepts"];
pos1 = pos;
EventHandler[
Dynamic[{cube[pos1, scale]}, ImageSize -> Tiny],
{"MouseDown" :> (pos0 = LeastSquares[Transpose[mp], pos1].mp),
"MouseDragged" :>
((pos1 = #[[2]] + Projection[pos0 - #[[2]], #[[1]] - #[[2]]]) &#mp),
"MouseUp" :> (pos1 = restrict[pos1])}]];
Graphics3D[generate[#, 1] & /# init, PlotRange -> bb, PlotRangePadding -> .5]
]
I'm trying to combine 3 functions graphed on a Plot[] and 1 function graphed on a ParametricPlot[]. My equations are as follows:
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1}, PlotLegend -> {"-2 x", "-2 \!\(\*SqrtBox[\(x\)]\)", "-2 \!\(\*SuperscriptBox[\(x\), \(3/5\)]\)"}]
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,0, 1.40138}, PlotLegend -> {"Problem 3"}]
Show[plota, plotb]
This is the image it gives:
As yoda said, PlotLegends is terrible. However, if you don't mind setting the plot styles manually and repeating them lateron, ShowLegend can help.
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1},
PlotStyle -> {{Red}, {Blue}, {Orange}}];
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u, 0, 1.40138},
PlotStyle -> {{Black}}];
And now
ShowLegend[Show[plota, plotb],
{{{Graphics[{Red, Line[{{0, 0}, {1, 0}}]}], Label1},
{Graphics[{Blue, Line[{{0, 0}, {1, 0}}]}], Label2},
{Graphics[{Orange, Line[{{0, 0}, {1, 0}}]}], Label3},
{Graphics[{Black, Line[{{0, 0}, {1, 0}}]}], Label4}},
LegendSize -> {0.5, 0.5}, LegendPosition -> {0.5, -0.2}}]
which will give you this:
You can also write some simple functions to make this a little less cumbersome, if you deal with this problem often.
Well, the root cause of the error is the PlotLegends package, which is a terrible, buggy package. Removing that, Show combines them correctly:
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1}]
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,
0, 1.40138}]
Show[plota, plotb]
You can see Simon's solution here for ideas to label your different curves without using PlotLegends. This answer by James also demonstrates why PlotLegends has the reputation it has...
You can still salvage something with the PlotLegends package. Here's an example using ShowLegends that you can modify to your tastes
colors = {Red, Green, Blue, Pink};
legends = {-2 x, -2 Sqrt[x], -2 x^(3/5), "Problem 3"};
plota = Plot[{-2 x, -2 Sqrt[x], -2 x^(3/5)}, {x, 0, 1},
PlotStyle -> colors[[1 ;; 3]]];
plotb = ParametricPlot[{2.4056 (u - Sin[u]), 2.4056 (Cos[u] - 1)}, {u,
0, 1.40138}, PlotStyle -> colors[[4]]];
ShowLegend[
Show[plota,
plotb], {Table[{Graphics[{colors[[i]], Thick,
Line[{{0, 0}, {1, 0}}]}], legends[[i]]}, {i, 4}],
LegendPosition -> {0.4, -0.15}, LegendSpacing -> 0,
LegendShadow -> None, LegendSize -> 0.6}]
As the other answers pointed out, the culprit is PlotLegend. So, sometimes is useful to be able to roll your own plot legends:
plotStyle = {Red, Green, Blue};
labls = {"a", "b", "Let's go"};
f[i_, s_] := {Graphics[{plotStyle[[i]], Line[{{0, 0}, {1, 0}}]},
ImageSize -> {15, 10}], Style[labls[[i]], s]};
Plot[{Sin[x], Sin[2 x], Sin[3 x]}, {x, 0, 2 Pi},
PlotStyle -> plotStyle,
Epilog ->
Inset[Framed[Style#Column[{Grid[Table[f[i, 15], {i, 1, 3}]]}]],
Offset[{-2, -2}, Scaled[{1, 1}]], {Right, Top}],
PlotRangePadding -> 1
]
I have a graphical object which is moving along a trajectory. How can I make the camera follow the object?
Let's draw a planet and its satellite, with the camera following the moon from a view directed toward the Earth. For example:
a = {-3.5, 3.5};
Animate[
Show[
Graphics3D[
Sphere[3 {Cos#t, Sin#t, 0}, .5],
ViewPoint -> 3.5 {Cos#t, Sin#t, 0},
SphericalRegion -> True,
PlotRange -> {a, a, a}, Axes -> False, Boxed -> False],
myEarth],
{t, 0, 2 Pi}]
Where myEarth is another 3D Graphics (for reference).
Static vertical view:
a = {-3.5, 3.5};
Animate[
Show[
Graphics3D[
Sphere[3 {Cos#t, Sin#t, 0}, .5],
ViewPoint -> 3.5 {0,0,1},
SphericalRegion -> True,
PlotRange -> {a, a, a}, Axes -> False, Boxed -> False],
myEarth],
{t, 0, 2 Pi}]
The trick is SphericalRegion -> True, without it the image perspective "moves" from frame to frame.
Edit
With two static objects:
Since the question asks about 2D, here's how you can emulate a camera in 2D Graphics.
First, let's get the stackoverflow favicon.ico:
so = First#Import["http://sstatic.net/stackoverflow/img/favicon.ico"]
Well put this on top of some overlapping circles and make the "camera" follow the icon around by adjusting the PlotRange
Manipulate[Graphics[{
Table[Circle[{j, 0}, i], {i, 0, 1, .1}, {j, {-.5, .5}}],
Inset[so, pos, {0, 0}, .2]},
PlotRange -> {{-.5, .5}, {-.5, .5}} + pos],
{{pos, {0, 0}, ""}, {-1.4, -1}, {1.4, 1}, ControlPlacement -> Left}]
To show how it works (with out putting the above into Mathematica), we need to animate it.
Originally I chose a variable step random walk drunk = Accumulate[RandomReal[{-.1, .1}, {200, 2}]] but it was a unpredictable! So instead, we'll make the icon follow the ABC logo
drunk = Table[{1.5 Sin[t], Cos[3 t]}, {t, 0, 2 Pi, .1}];
Animate[Graphics[{
Table[Circle[{j, 0}, i], {i, 0, 1, .1}, {j, {-.5, .5}}],
Inset[so, drunk[[pos]], {0, 0}, .2]},
PlotRange -> {{-.5, .5}, {-.5, .5}} + drunk[[pos]]],
{pos, 1, Length[drunk], 1}]
How can I make it such that plotting the following function
ListPointPlot3D[points, PlotStyle -> PointSize[0.05]];
the points I see are green or yellow, for instance, instead of the typical dark blue ones?
Thanks
Use Directive to combine styles, ie
ListPointPlot3D[points, PlotStyle -> Directive[{PointSize[0.05], Green}]]
Edit I give you below two possible solutions in a context related to your previous question. Nevertheless, please note that #Yaroslav's code is much better.
f[x_, y_] := x^2 + y^2;
t = Graphics3D[{PointSize[Large], Red, Point#
Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}], 1]}];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, t}]
Or
f[x_, y_] := x^2 + y^2;
points = Flatten[Table[{x, y, f[x, y]}, {x, 0, 10, 1}, {y, 1, 2, 1}],
1];
a = ListPointPlot3D[points,
PlotStyle -> Table[{Red, PointSize[0.05]}, {Length#t}]];
b = Plot3D[f[x, y], {x, -10, 10}, {y, -10, 10},
ColorFunction -> "MintColors"];
Show[{b, a}]
Sometimes I find the following approach useful, as it allows me to
manipulate the plot symbol (PlotMarkers does not seem to work with ListPointPlot3D,
at least in Mathematica 7) [originally suggested by Jens-Peer Kuska]:
ListPointPlot3D[{{1,1,1},{2,2,2},{3,3,3}}]/.Point[xy_]:>(Style[Text["\[FilledUpTriangle]",#],Red,FontSize-> 20]&/#xy)