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.
Related
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.
Encouraged by this question, I dare to ask something similar.
I am trying to plot with mathematica a cone which is intersected by a line. The start point of the line is on the lateral surface of the cone and its endpoint inside of the cone.
As long as the endpoint of the line is far away from the tip of the cone, everything looks quite nice (use e.g. endpointOfLine = 0.007 in my example). But if the endpoint approaches the tip (endpointOfLine < 0.007 in my example), it seems that a big part of the line would be on the surface of the cone.
Sure, for endpoint values which are very close to the cone tip, the line is almost parallel to the surface so that this effect has probably to appear. But the effect appears also if the endpoint is not so close to cone tip.
Here the example:
totalLength = 10^-2;(*length of the cone*)
theta = 17*10^-3;(*half opening angle of the cone*)
radius[theta_, l_] := Tan[theta]*l;(*radius of the cone as function of its length*)
endpointOfLine = 0.0015;(*endpoint of the test line, to be varied*)
testLine = Line[{{radius[theta, totalLength], 0, totalLength},{0, 0, endpointOfLine}},
VertexColors -> {Orange, Orange}
];
Graphics3D[
{
{
RevolutionPlot3D[{radius[theta, l], 0, l}, {l, 0, totalLength},
Mesh -> None,
PlotStyle -> Directive[Opacity[0.5], Gray],
PlotPoints -> 60][[1]]
},
{testLine}
},
Boxed -> True,BoxRatios -> {1, 1, 3},
Lighting -> None(*ugly, but makes the problem well visible*)
]
Is there any way to reduce this effect? Increasing the PlotPoints to 60 has reduced the effect a bit, but I would be happy if I could reduce it more. Any ideas?
Try to place the endpoint at the base of the cone close but not on the radius like:
testLine =
Line[{{0.97 radius[theta, totalLength], 0, totalLength}, {0, 0, endpointOfLine}},
VertexColors -> {Orange, Orange}
];
I feel this is not a problem fundamentally different from the one you were referring to.
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
If I understood the Mathematica documentation correct ( haven't found examples either ) Graphics3D does not produce shadows of 3D objects, although Graphics3D has a Lighting-> option.
Question: Have you ever tried to produce Mathematica 3D objects with shadows? If so have you solved this in Mathematica? Or have you exported the graphics to other 3D ( scene-graph ) viewers like for example J-Reality?
The shading model used by MMA, the so-called Phong shading, determines the pixel intensities based on a simple relationship between local surface orientation, light source direction(s), camera direction and diffuse and specular properties of the surface. No other aspect of the geometry is taken into account, which means that objects do not influence the pixel values of other objects even if they are between the object and the light source.
This means that the model doesn't generates shadows. It is not able to.
You could simulate shadows yourself by projecting your object's polygons on the ground plane or wall planes as applicable. That shouldn't be too difficult, but shadows on non-planar surfaces will be pretty hard.
Example:
polys = (PolyhedronData["GreatRhombicTriacontahedron", "Faces"] //
Normal // N) /. {x_, y_, z_}?VectorQ -> {x, y, z + 6};
(* raise it slightly above ground plane*)
shadow = polys /. {x_, y_, z_}?VectorQ -> {x - z, y, 0};
(* projection from a directional light source at 45 deg elevation *)
Graphics3D[{polys, EdgeForm[], FaceForm[Darker#Gray], shadow},
Lighting -> {{"Directional", White, {{1, 0, 1}, {0, 0, 0}}}},
Boxed -> False]
Of course, you need to make sure that the lighting sources (point, spot, directional...) and your shadow projection are consistent.
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.