Context: Two sets of data, one is the radius, r, and the other is the velocity, v. v can be positive and negative. The following code
p1=ListLogLogPlot[Table[{r[[i]],v[[i]]},{i,1,number_of_data}]];
p2=ListLogLogPlot[Table[{r[[i]],-v[[i]]},{i,1,number_of_data}],PlotStyle->{Red}];
Show[p1,p2]
is used to give a curve, with positive and negative v both plotted in log-log coordinates.
Question: How to draw a circular, contour-like plot, with Log[r] as the distance to the center of the circle, and the velocities (Log[v]) shown as different, but continuously varying colors, according to v's sign and magnitude?
You may use a DensityPlot function:
v[r_] := Sin[r]*r^2
DensityPlot[v[Norm[{x, y}]], {x, -5, 5}, {y, -5, 5}]
You can deal with the tabular data in two ways. You can either interpolate and use the interpolating function as above or you may use a ListDensityPlot function:
ListDensityPlot[Table[With[{r = RandomReal[{0, 4}], t = RandomReal[{0, 2 Pi}]},
{r Cos[t], r Sin[t], v[r]}], {10^4}]]
I hope this helps.
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}]]
I am trying to parametrize a 3D geometry for shape optimization. The structure looks like the following. Another real example is here.
Currently I am using BSplines to create the lower part and using symmetry to create the whole down part of the foil. Here is what I get.
Now I have many control points to take care in order to run a shape optimization. I also don't know how to join the upper part with the bottom hydrofoil part in a sensible way. I don't know how to design a good middle part of the foil (fat nose part of the foil) where the upper part is linked to. I also need to accompany a flap with in the geometry.
Please offer some suggestion for parametrization of such a surface so that we can manipulate the geometry from MMA. The less control points are there better the situation is for optimization. May be combination of some analytic function in 3D. But I doubt if that is possible.
BR
I think you have two choices: 1) create the second part of the geometry and then write a face-face intersection algorithm to merge them. 2) create the second part of the geometry and write two functions that return -1 if a query point is inside the geometry and +1 if it is out side (other values will do). Then use RegionPlot3D[ f1[x,y,z]<0 || f2[x,y,z]<0,....]. The idea is the to extract the GraphicsComplex and use that. The question is going to be how well you can approximate the corners with that. Here is an illustration of what I mean.
if1[x_, y_, z_] := If[x^2 + y^2 + z^2 <= 1, -1, 1]
if2[x_, y_, z_] := If[(x - 1)^2 + y^2 <= 1 && -1.5 <= z <= 1.5, -1, 1]
res = RegionPlot3D[
if1[x, y, z] < 0 || if2[x, y, z] < 0, {x, -2, 2}, {y, -2,
2}, {z, -2, 2}, PlotPoints -> 100, Boxed -> False, Axes -> False]
Then extract the coords and the polygons.
coords = res[[1, 1]];
poly = Cases[res[[1]], _Polygon, Infinity];
Graphics3D[GraphicsComplex[coords, poly], Boxed -> False]
Hope this helps.
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.
edit As someone has pointed out, what I'm looking for is actually the point minimizing total geodesic distance between all other points
My map is topographically similar to the ones in Pac Man and Asteroids. Going past the top will warp you to the bottom, and going past the left will warp you to the right.
Say I have two points (of the same mass) on the map and I wanted to find their center of mass. I could use the classical definition, which basically is the midpoint.
However, let's say the two points are on opposite ends of the mass. There is another center of mass, so to speak, formed by wrapping "around". Basically, it is the point equidistant to both other points, but linked by "wrapping around" the edge.
Example
b . O . . a . . O .
Two points O. Their "classical" midpoint/center of mass is the point marked a. However, another midpoint is also at b (b is equidistant to both points, by wrapping around).
In my situation, I want to pick the one that has lower average distance between the two points. In this case, a has an average distance between the two points of three steps. b has an average distance of two steps. So I would pick b.
One way to solve for the two-point situation is to simply test both the classical midpoint and the shortest wrapped-around midpoint, and use the one that has a shorter average distance.
However! This does not easily generalize to 3 points, or 4, or 5, or n points.
Is there a formula or algorithm that I could use to find this?
(Assume that all points will always be of equal mass. I only use "center of mass" because it is the only term I knew to loosely describe what I was trying to do)
If my explanation is unclear, I will try to explain it better.
The notion of center of mass is a notion relevant on affine spaces. The n-dimensional torus has no affine structure.
What you want is a point which minimizes (geodesic) distance to all the other points.
I suggest the following: let x_1...x_n be a collection of points on the d-dimensional torus (or any other metric space for that purpose).
Your problem:
find a point mu such that sum(dist(mu, x_k)^2) is minimal.
In the affine-euclidian case, you get the usual notion of center of mass back.
This is a problem you will be able to solve (for instance, there are probably better options) with the conjugate gradient algorithm, which performs well in this case. Beware that you need moderate n (say n < 10^3) since the algorithm needs n^2 in space and n^3 in time.
Perhaps better suited is the Levenberg-Marquardt algorithm, which is tailored for minimization of sum of squares.
Note that if you have a good initial guess (eg. the usual center of mass of the points seen as points in R^d instead of the torus) the method will converge faster.
Edit:
If (x1...xd) and (y1...yd) are points on the torus, the distance is given by
dist(x, y)^2 = alpha1^2 + ... + alphad^2
where alphai = min((xi - yi) mod 1, (yi - xi) mod 1)
I made a little program to check the goodness of the involved functions and found that you should be very carefull with the minimization process.
Below you can see two sets of plots showing the points distribution, the function to minimize in the euclidean case, and the one corresponding to the "toric metric".
As you may see, the euclidean distance is very well-behaved, while the toric present several local minima that difficult the finding of the global minima. Also, the global minimum in the toric case is not unique.
Just in case, the program in Mathematica is:
Clear["Global`*"];
(*Define non wrapping distance for dimension n*)
nwd[p1_, p2_, n_] := (p1[[n]] - p2[[n]])^2;
(*Define wrapping distance for dimension n *)
wd[p1_, p2_, max_,n_] := (max[[n]] - Max[p1[[n]], p2[[n]]] + Min[p1[[n]], p2[[n]]])^2;
(*Define minimal distance*)
dist[p1_, p2_, max_] :=
Min[nwd[p1, p2, 1], wd[p1, p2, max, 1]] +
Min[nwd[p1, p2, 2], wd[p1, p2, max, 2]];
(*Define Euclidean distance*)
euclDist[p1_, p2_, max_] := nwd[p1, p2, 1] + nwd[p1, p2, 2];
(*Set torus dimensions *)
MaxX = 20;
MaxY = 15;
(*Examples of Points sets *)
lCircle =
Table[{10 Cos[fi] + 10, 5 Sin[fi] + 10}, {fi, 0, 2 Pi - .0001, Pi/20}];
lRect = Join[
Table[{3, y}, {y, MaxY - 1}],
Table[{MaxX - 1, y}, {y, MaxY - 1}],
Table[{x, MaxY/2}, {x, MaxY - 1}],
Table[{x, MaxY - 1}, {x, MaxX - 1}],
Table[{x, 1}, {x, MaxX - 1}]];
(*Find Euclidean Center of mass *)
feucl = FindMinimum[{Total[
euclDist[#, {a, b}, {MaxX, MaxY}] & /# lRect], 0 <= a <= MaxX,
0 <= b <= MaxY}, {{a, 10}, {b, 10}}]
(*Find Toric Center of mass *)
ftoric = FindMinimum[{Total[dist[#, {a, b}, {MaxX, MaxY}] & /# lRect],
0 <= a <= MaxX, 0 <= b <= MaxY}, {{a, 10}, {b, 10}}]
In the 1 dimensional case, your problem would be analagous to finding a mean angle.
The mean of angles a and b can be computed by
mean = remainder( a + remainder( b-a, C)/2.0, C)
where C is the measure of a whole circle (ie 2*PI if you're using radians).
If you have n angles a[], the mean can be computed by
mean = a[0];
for i=1..n mean=remainder( mean + remainder( a[i]-mean, C)/(i+1), C)
So I reckon
meanX = X[0]; meanY = Y[0]
for i=1..n
meanX = remainder( meanX + remainder( X[i]-meanX, W)/(i+1), W)
meanY = remainder( meanY + remainder( Y[i]-meanY, H)/(i+1), H)
might do the job.
But note that this will result in -W/2<=meanX
IANATopologist, and I don't know how clear I'm making myself in this, but for what it's worth, these are some thoughts on the matter:
Using mass and gravity to calculate this sort of thing might indeed be elegant -- ISTR that there are a number of libraries and efficient algorithms to find the gravity vectors for any number of masses.
If you were using a spherical map, I'd suggest finding within the sphere the actual center of gravity for your N mass points. You then draw a line from the center outward through this inner center of gravity to find the point on the sphere's surface where your mass points wish to congregate.
However, a toroidal map makes this difficult.
My suggestion, then, is to flatten and copy your map to give you a 3 x 3 quilt of maps (using an infinite field of maps will give better results, but might be overkill). I'll assign coordinates (0, 0) to (2, 2) to them, with (1, 1) being your source map. Find the point(s) to which the mass points of your inner map (1, 1) are attracted -- if they all go towards the middle of your map, fine: you found your center of gravity. If not, if one of the points close to the edge is going towards some mass accumulation outside of your inner map, say into map (2, 1), then discard this mass point when calculating your center of gravity. Instead you use the mass point from the opposite map ((0, 1) in this case) that wants to wander over into your middle map.
Adding the acceleration vectors for these mass points gives you the center of gravity on your torus.
Done.