I gave up trying to understand Mathematica 3D axes configuration.
When I make 3D plot, and label the 3 axes to identify which axes is which, and then make points on these axes, the points appear on different axes than what I expect them to show at using the Point command, which takes {x,y,z} coordinates.
Here is an example
g=Graphics3D[
{
{PointSize[0],Point[{0,0,0}]}
},
AxesOrigin->{0,0,0}, PlotRange->{{-3,3},{-3,3},{-3,3}},
Axes->True, AxesLabel->{"X","Y","Z"},
LabelStyle->Directive[Bold,Red,16],
PreserveImageOptions->False, Ticks->None,Boxed->False]
The above results in
So, now I added a point at at end of the x-axis, and at the end of the y-axis, and at the end of the z-axis. I make each point different color to help identify them on the plot.
g=Graphics3D[
{
{Red,PointSize[.03],Point[{3,0,0}]},
{Black,PointSize[.03],Point[{0,3,0}]},
{Blue,PointSize[.03],Point[{0,0,3}]}
},
AxesOrigin->{0,0,0},PlotRange->{{-3,3},{-3,3},{-3,3}},
Axes->True,AxesLabel->{"X","Y","Z"},
LabelStyle->Directive[Bold,Red,16],PreserveImageOptions->False,
Ticks->None,Boxed->False]
The result is this:
You can see, the RED point, which I expected it to go to end of the x-axis, shows up at the end of the Z axis. And the Black point, instead of showing up at the end of the Y-axis, shows up at X-axis, and the blue point, instead of showing at the end of the Z axis, shows up at the end of the Y-axis.
May be the labels are wrong? May be I am looking at the image in wrong way?
I am really confused, as I am clearly not understanding something. I looked at documentation, and I could not find something to help me see what I am doing wrong. I am just starting to learn Mathematica 3D graphics.
EDIT:
add image with Ticks on it, reply to Simon, I did not know how to do it the comment box:
g=Graphics3D[
{
Cuboid[{-.1,-.1,-.1},{.1,.1,.1}],
{Red,PointSize[.03],Point[{2,0,0}]},
{Black,PointSize[.03],Point[{0,2,0}]},
{Blue,PointSize[.03],Point[{0,0,2}]}
},
AxesOrigin->{0,0,0},
PlotRange->{{-2,2},{-2,2},{-2,2}},
Axes->True,
AxesLabel->{"X","Y","Z"},
LabelStyle->Directive[Bold,Red,16],
PreserveImageOptions->False,
Ticks->True, TicksStyle->Directive[Black,8],
Boxed->False
]
here is the result:
EDIT: OK, I decided to forget about using AxesLabels, and I put them myself . Much more clear now
m=3;
labels={Text[Style["X",16],{1.2 m,0,0}],Text[Style["Y",16],{0,1.2 m,0}],
Text[Style["Z",16],{0,0,1.2 m}]};
g=Graphics3D[
{
{Red,PointSize[.03],Point[{m,0,0}]},
{Black,PointSize[.03],Point[{0,m,0}]},
{Blue,PointSize[.03],Point[{0,0,m}]},
labels
},
AxesOrigin->{0,0,0},
PlotRange->{{-m,m},{-m,m},{-m,m}},
Axes->True,
AxesLabel->None,
LabelStyle->Directive[Bold,Red,16],
PreserveImageOptions->False,
Ticks->True, TicksStyle->Directive[Black,8],
Boxed->False
]
I agree with you that AxesLabel for 3D graphics is next to worthless. Look at the effects of a small interactive viewpoint change on your figure:
IMHO WRI should really improve the operation of this option, and preferably provide some more placement control too (end/mid of axes etc.).
I believe the labels are being placed in unintuitive spots. Replacing your dots with colored lines of different length is clearer to me. I've also removed the explicit plot range which helps Mathematica put the labels in much clearer places.
g=Graphics3D[
{
{Red,Thick, Line[{{0, 0, 0}, {1, 0, 0}}]},
{Black,Thick, Line[{{0, 0, 0}, {0, 2, 0}}]},
{Blue,Thick, Line[{{0, 0, 0}, {0, 0, 3}}]}
},
AxesOrigin->{0,0,0},
Axes->True,AxesLabel->{"X","Y","Z"},
LabelStyle->Directive[Bold,Red,16],PreserveImageOptions->False,
Ticks->None,Boxed->False]
Related
Is there a way in Mathematica to check whether a plot is empty or not?
By empty, I mean it is only showing the axes and not any data points.
I have a function that, depending on its inputs, gives some data points (to be plotted later) or none, but i won't know whether it will produce any valid data points unless i plot it.
And if it doesn't, when i plot it, it will return an empty plot.
I would like to differentiate between the empty plot and a plot with data points.
I'll generate an empty Plot to explore the form.
empty = Plot[{}, {x, 0, 1}];
FullForm[%]
shows that Plot[] returns a Graphics object with two parts - 1.) the content, and 2.) the options. In this case the first is an empty List, so setting a condition like
empty[[1]] == {}
should return True for this particular type of emptiness. It'll work for other Plots
Plot3D[{}, {x, -3, 3}, {y, -2, 2}][[1]] == {}
True
but you might have to pick apart the FullForm of your example to be sure.
(Mathematica version: 8.0.4, on Windows 7)
Could someone please remind me how to tell M not to change the ImageSize in the following case:
I have a Manipulate, where I make a grid, and inside the grid, I either show one plot, or 2 plots, depending on a control choice.
To keep the overall displayed image the same, then if I am displaying one plot I use one size, and if I am displaying 2 plots, I use half the length for each plot. Easy enough so far.
The strange thing is that when I use the mouse to rotate the one plot case, and then switch back to 2 plots, the plot size now does not use the ImageSize I specified.
It seems by using the mouse to rotate one plot, it affected the next plot shown on the same screen location.
Using SphericalRegion -> True or not, has no effect. Using RotationAction -> "Fit" has no effect.
Here is a small example of what I mean, and then I show how I currently solve this problem. But I solve it by using GraphicsGrid in place of Grid. I wanted to keep using Grid if possible.
Manipulate[
Module[{opt = {Spacings -> {0, 0}, Frame -> All}, p,
size, data = Table[RandomReal[], {10}, {10}], wid = 300, len = 300},
size = If[choice == 1, {wid, len}, {wid, len/2}];
Print[size];
p = ListPlot3D[data,SphericalRegion->True,ImagePadding -> 10,ImageSize ->size];
If[choice == 1,
Grid[{{p}}, Sequence#opt], Grid[{{p}, {p}}, Sequence#opt]
]
],
Row[{SetterBar[Dynamic[choice], {1, 2}]}],
{{choice, 2}, None}
]
To reproduce the problem, is simple: first I note the size, this is how I want to keep it. Now I click on choice 1, now using the mouse I rotate the one plot. Now I click on choice 2 to go back, then I see the plot size is not what I expected it to be.
I am sure it is an option I need to use. Just have not found it yet.
ps. Actually what seems to happen, is that the SAME plot that was rotated, stays on the content area, and was used in place of one of the 2 plots in the second case. Very strange. I must be doing something silly somewhere, as this is too strange.
Update 2:48 am
This is in response to using Dynamic in the Manipulate expression as shown below by MrWizard. On V 8.04, it does not work. Here is the code:
Manipulate[
Module[{p, size, data = Table[RandomReal[], {10}, {10}], wid = 300,
len = 300},
size = If[choice == 1, {wid, len}, {wid, len/2}];
p = ListPlot3D[data, SphericalRegion -> True, ImagePadding -> 10,
ImageSize -> size];
If[choice == 1,
Grid[{{p}}],
Dynamic#Grid[{{p}, {p}}]
]
],
Row[{SetterBar[Dynamic[choice], {1, 2}]}],
{{choice, 2}, None}
]
Update 3:03 am
This below works by keeping the Grid. Adding a Frame around the grid makes it works.
(Thanks to Mike answer showing that using Frame instead of Grid made it work, I figured let me try to add a Frame around the Grid)
One of the strangest things I've seen using Mathematica for long time :)
Manipulate[
Module[{p, size, data = Table[RandomReal[], {10}, {10}], wid = 300,
len = 300},
size = If[choice == 1, {wid, len}, {wid, len/2}];
p = ListPlot3D[data, SphericalRegion -> True, ImagePadding -> 10,
ImageSize -> size];
If[choice == 1,
Framed#Grid[{{p}}],
Grid[{{p}, {p}}]
]
],
Row[{SetterBar[Dynamic[choice], {1, 2}]}],
{{choice, 2}, None}
]
Thanks
This is related to another puzzle re how//why Plot3D remembers image options why does Plot3D remember.... The solution happens to be the same in this case too: that is, add PreserveImageOptions -> False as an option to Plot3D. Somehow, the hacks like the ones suggested by MrW and Mike force Plot3D to "forget".
I haven't got long but the use of Grid seems to be the main thing messing this up, though I haven't had time to identify how/why. If you replace the If statement with this:
If[choice == 1, Framed#p, Grid[{{p}, {p}}, Sequence#opt]]
then it works fine. There are some other things going on in the code that don't seem optimal at first glance but I have just focussed on the graphics sizing due to time constraints. This is not intended as an explanation but might help you or someone else figure out why this is behaving like this. Sorry but short on time but thought it was worth posting the observation about Grid.
Without doing any actual analysis, here is my conjecture.
I believe this may the result of an optimization technique which observes that the apparent content of the displayed graphic did not change. I suppose that the key is therefore to make the apparent content different between each graphic that is displayed in each position of the Grid. Using something like Identity will not work as it vanishes from the expression. However if this conjecture is correct I expect any persistent change to result in an updated graphic.
I have had success using each of these for the first Grid expression:
Grid[{{ Framed#p }}, opt]
Grid[{{ Panel#p }}, opt]
Grid[{{ Pane#p }}, opt]
Grid[{{ {p} }}, opt]
Grid[{{ Item#p }}, opt]
Grid[{{ Style#p }}, opt]
Continuing with the project I previously described I am currently building an animation showing movement between a list of cities. My current code renders a list of cities and makes a set of great circle arcs connecting the cities. The list of cities are part of a timeline so after visiting one city the animation will transition to be centered upon the next.
To my mind this means the ViewVector should be adjusted to show points between a starting city and an ending city. The resulting would probably look like an in-flight map for a long-haul flight sped up considerably. A single frame might look like the following manually produced still:
I now understand how to position the ViewVector above the most recent city but I am quite unsure about how to move the camera smoothly between two spherical coordinate points. My current code is below:
SC[{lat_, lon_}] := {Cos[lon \[Degree]] Cos[lat \[Degree]],
Sin[lon \[Degree]] Cos[lat \[Degree]], Sin[lat \[Degree]]};
GreatCircleArc[{lat1_, lon1_}, {lat2_, lon2_}] :=
Module[{u = SC[{lat1, lon1}], v = SC[{lat2, lon2}], a},
a = VectorAngle[u, v];
Table[Evaluate[RotationTransform[\[Theta], {u, v}][u]], {\[Theta],
0, a, a/Ceiling[10 a]}]]
CityGraphic[name_] := {Opacity[0.85], Black, PointSize[Medium], White,
PointSize[0.045], Point[1.01 SC[CityData[name, "Coordinates"]]]}
CityGraph[places_, age_] :=
Graphics3D[{
Opacity[0.75],
Sphere[{0, 0, 0}, 0.99 ],
Map[Line[
Map[SC,
CountryData[#, "SchematicCoordinates"], {-2}]] &,
CountryData["Countries"]],
Map[CityGraphic, places],
Text[Style[age, FontFamily -> "Helvetica"],
1.02 SC[CityData[First[places], "Coordinates"]]],
White, Line
[Apply[GreatCircleArc,
Partition[Map[CityData[#, "Coordinates"] &, places], 2, 1], {1}]]
},
ViewVector -> {
4 SC[CityData[First[places], "Coordinates"]], {0, 0, 0}},
Boxed -> False,
SphericalRegion -> True,
ImageSize -> {640, 480}
];
CityGraph[{"Tokyo", "Dublin", "Cape Town", "Seattle", "Denver"}, "04"]
In computer graphics people often use Quaternions to smoothly interpolate between various camera viewing directions. Mathematica has a Quaternion package which you could use for basic Quaternion arithmetic. A conversion between Quaternions and Euler angles is described here.
The interpolation process is described here.
As a little project I've been thinking to create a little Google Earth-like animation. I want to play back a timeline while rotating the globe to center over various cities. At present I can use the default view settings to render a globe with the cities indicated by points.
When I try to orient the camera with a view vector looking down on a city (for example Denver), I end up with the following:
The ViewVector needs to be computed for some point out in space above the globe. However my trial and error has not arrived on any sort of coherent viewpoint with most looking like they're "inside" the globe.
What I need help with is a function which given the latitude and longitude of a city choses a ViewVector placing the city at the "center" of the camera view. The code which produced the "inside the globe" view follows:
SC[{lat_, lon_}] := {Cos[lon \[Degree]] Cos[lat \[Degree]],
Sin[lon \[Degree]] Cos[lat \[Degree]], Sin[lat \[Degree]]};
Graphics3D[{
Opacity[0.75],
Sphere[{0, 0, 0}, 0.99 ],
Map[Line[
Map[SC,
CountryData[#, "SchematicCoordinates"], {-2}]] &,
CountryData["Countries"]], {Yellow, PointSize[Medium],
Point[SC[CityData["Denver", "Coordinates"]]]
}
},
Boxed -> False,
SphericalRegion -> True,
ViewVector -> {{0, 0, 0}, SC[CityData["Denver", "Coordinates"]]}
]
When using ViewVector in the form ViewVector->{v1, v2}, the camera is sitting in point v1 and is pointed in the direction of v2. So in your example, the camera would be sitting in the origin and is pointed in the direction of Denver, which produces the "inside globe" view. To have the camera looking down at Denver the camera should be sitting in a point directly above the city, e.g. in 2 SC[CityData["Denver", "Coordinates"] and be pointed at the origin, so ViewVector would be something like
ViewVector -> {2 SC[CityData["Denver", "Coordinates"]], {0, 0, 0}}
With this setting for ViewVector the view becomes something like
I posted at this post before, but I still could not solve the following problem completely. As an example:
{pA, pB, pC, pD} = {{0, 0, Sqrt[61/3]}, {Sqrt[7], 4*Sqrt[2/3], 0}, {0, -5*Sqrt[2/3], 0}, {-Sqrt[71], 4*Sqrt[2/3], 0}};
axis={1,0,0};pt={0,1,0};
plotPolygon[{a_, b_, c_}] := {Opacity[.4], Polygon[{a, b, c}]};
graph=Graphics3D[{plotPolygon[{pA, pB, pC}], plotPolygon[{pA, pB, pD}],
plotPolygon[{pB, pC, pD}], plotPolygon[{pA, pC, pD}]},
Axes -> True, AxesOrigin->pt];
Animate[graph/.gg : Graphics3D[___] :> Rotate[gg, theta, axis], {theta, 0., 2.*Pi}]
I want to rotate along an axis axis={1,0,0} which passes the point pt={0,1,0}. But I don't know how to specify the point information. Also the rotation animation seems very chaotic in the sense that I would expect at least one point (in this case, the origin?) is not rotating.
You need to first change the origin of vertices of your polygon, rotate, and translate back. You can do this by hand
(RotationMatrix[theta,axis].(#-pt) + pt)& /# {pA, pB, pC, pD}
Or, you can combine the transformations using Composition
Composition[
AffineTransform[{RotationMatrix[theta,axis],pt}],TranslationTransform[-pt]
] /# {pA, pB, pC, pD}
Or, you can take the previous composition and apply it directly to your Graphics object
GeometricTransformation[ <graphics>, Composition[ ... ]]
This documentation gives a thorough list of what can be done.
Edit: Here's a working animation script
Animate[
graph /. Graphics3D[prims__, opts : OptionsPattern[]] :>
Graphics3D[
GeometricTransformation[prims,
Composition[
AffineTransform[{RotationMatrix[theta, axis], pt}],
TranslationTransform[-pt]
]
],
opts
],
{theta, 0., 2.*Pi}
]
There's a couple of things to note here. First, GeometricTransformation only appears to work on the primitives themselves, so I had to split out the primitives from the options in Graphics3D via the rule Graphics3D[prims__, opts : OptionsPattern[]]. Also, the transformation itself needs to be within Animate to use the local version of theta.