Related
I have an arbitrary function of f(x) with each discrete x value. The value of the function is circularly symmetrical. I want to plot those circles in mathematica using x as radius and values of f(x) as the height of this plot. Can you help me with that please? Also I don't know how to use lists of numbers as an input to plot discrete circles in 3D.
I tried
Plot3D[f*Exp[I*phi], {x, 0, 10}, {phi, 0, 2*Pi}]
or
ContourPlot[f*Exp[I*phi], {x, 0, 10}, {phi, 0, 2*Pi}]
Nothing shows up!
Try this
f[x_]:=x^2;
Show[
Map[(x=#;ParametricPlot3D[{x*Cos[phi],x*Sin[phi],f[x]},{phi,0,2Pi}])&,Range[1,10]],
PlotRange->All
]
where I arbitrarily picked an f[x] and used a list of {1,2,3,...10} for discrete x values. You could replace that Range[1,10] with something like {5,7,3/2,1.8} if you had a specific list of numbers that you wanted to use for x.
The Map function created a ParametricPlot3D for each of the discrete values of x and then the Show combined all those into a single plot.
This question might seem a little strange but for my purposes is not that crazy.
Its easy but I need you to follow me.
The aim
My aim is plotting a tridimensional graph.
The problem
The problem is the material I have in my hands to start building this graph. Actually I have a collection of points in the 2D space (thus tuples of two real ordered values). Consider a moment to have these collection of points stored into an array and now consider to plot them on a 2D diagram. You will just have a nice sparse view of these points.
Well, the second step is this: consider the surface with these points and create a third axis orthogonal to the plane where those points are drawn. The aim is assigning to every point a numerical scalar value (using a function that accepts the couple and returns a numerical value). So the graph should show bars starting from every point and having a specific value according to the assignment function.
How can I achieve this in Mathematica?
A little note
Basically my points in the 2d space are also connected by a graph. Is it possible to connect the top of the bars to the top of other bars whose base point are connected together in the 2d graph?
Some other notes
My graph doesn`t have to be a surface but just a collection of bars placed on a plane in the exact place where the correspondent point they refer to is located. But if you have a good hint how to draw a surface other than bars, it will be gladly accepted.
I hope I was clear. I would like to point that I have Mathematica 8 so all functionalities are available. Thank you.
This can be done using Graphics3D primitives. Lets start with some data
(* a list of 2D coordinates *)
points2D = RandomReal[{0, Pi}, {50, 2}];
(* some edges as a list of pairs of vertex indices *)
edges = Union[Flatten[MapIndexed[Sort /# Thread[{#2[[1]],
Nearest[points2D -> Automatic, #, 4]}] &, points2D], 1]];
(* constructing list of 3D coordinates *)
f[{x_, y_}] := 2 + Sin[x y]
points3D = {##, f[{##}]} & ### points2D;
The actual plot can then be constructed as follows (width is half the width of the bars)
With[{width = .02},
Graphics3D[{{LightBlue, EdgeForm[None],
Cuboid[{#1, #2, 0} - width {1, 1, 0}, {##} + width {1, 1, 0}] & ### points3D},
{Orange,
GraphicsComplex[points3D, Line[edges]]}},
Lighting -> "Neutral",
BoxRatios -> {1, 1, .6}]]
(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]
I am doing this:
ClearAll[matrix];
matrix[p_,q_,nu_:0]:=Module[{sigma},
sigma=p/q;
N#SparseArray[
{{m_,m_}\[Rule]2Cos[2\[Pi]*m*p/q+nu],{i_,j_}/;
Abs[i-j]\[Equal]1\[Rule]1},{q,q}]]
ClearAll[attachsigma]
attachsigma[sigma_,lst_]:={sigma,#}&/#lst
and then execute
fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates;
pq = {Numerator##, Denominator##} & /# fracs;
(ens = Eigenvalues[#] & /#
Normal /# (matrix[#[[1]], #[[2]]] & /# pq);) // Timing
pts = Flatten[#, 1] &#MapThread[attachsigma, {fracs, ens}];
and finally I plot the points as follows (here is the real point of the question):
plot = ListPlot[pts,
PlotMarkers \[Rule] Graphics[{PointSize[Tiny], Point[{0, 0}]}]]
Calculating all the points takes around around 2.6s on my machine, but the plot takes around 25s. If, on the other hand, I plot it like this
ListPlot[pts]
then it is almost instantaneous, as it should (it's just 5256 points). So, it seems PlotMarkers slows things down immensely.
Could anybody
a) explain why (this much I vaguely understand, in analogy with what happens to Sort if you give it custom ordering function) and, more importantly,
b) explain how to avoid this slowdown? I am trying to create plots with quite a bit more points than this so they're really slow; in addition, I am creating lots of them (a movie actually).
One solution would be to not plot all of them, but as I vary parameters it becomes nontrivial to find out which I should include and which not (this would of course work if I only needed this one frame). So, I'd like to speed up the plot creation without removing points.
EDIT: Answered after hints from Sjoerd:
ListPlot[pts] /. Point[List[x___]] \[RuleDelayed] {PointSize[Tiny], Point[List[x]]}
produces the right thing instantaneously. This simply replaces the Points inside the Graphics structure by smaller points by hand.
Now one can increase the upper limit in the table in fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates to 80 or so to get many more points (this thing is the Hofstadter butterfly, and it's a fractal):
PlotMarkers is meant for data plots that contain relatively few points. It is very useful in plots in which you use the markers to identify various conditions. Each individual marker is an Inset as follows:
Inset[Graphics[List[Hue[0.67`,0.6,0.6`],PointSize[Tiny],Point[List[0, 0]]]],10512].
You can imagine this takes up some time and memory.
I also found what seems to be a bug. The plot with PlotMarkers is structured as GraphicsComplex[pointlist,graphicsinstructions]. This point list seems to contain the points in the plot twice!
In[69]:= pts // Length
Out[69]= 5256
In[66]:= plot[[1, 1]] // Length
Out[66]= 10512
In[64]:= Union[plot[[1, 1]]] == Union[pts]
Out[64]= True
In[68]:= Tally[plot[[1, 1]]][[All, 2]] // Mean (*the average number each point occurs*)
Out[68]= 2
Personally, I prefer Graphics to ListPlot, especially when the number of points is large.
Graphics[{Hue[{2/3, 1, 1, .5}], AbsolutePointSize[1.5], Point#pts},
PlotRange -> {{0, 1}, {-4, 4}}, Axes -> False,
AspectRatio -> 1/GoldenRatio]
gives, for example:
Length#pts
102969
I believe the solution you appended to your question can be simplified:
ListPlot[pts] /. x_Point :> {PointSize[Tiny], x}
I voted for both prior answers, but I agree with TomD on the direct use of Graphics.
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]