4
$\begingroup$

Is it possible do a similar graphic (and animation) with Mathematica? (Please see the example of dataset on a sphere in this link). To see the rotating sphere, click on the "View the Interactive Sphere" button.

$\endgroup$
  • $\begingroup$ To see the rotating sphere, click on: View the Interactive Sphere button. $\endgroup$ – locometro Dec 4 '16 at 11:58
  • $\begingroup$ Might be doable with EarthquakeData[]. $\endgroup$ – J. M. is away Dec 10 '16 at 2:48
3
$\begingroup$

This is just to illustrate some ways utilizing resources from this site.

In the following I have just plotted earthquakes from December 2015 to earley 2016 with magnitude between 2.5 and 4 (for no particular reason).

Make Sphere

Code from here:

img = With[{\[CapitalDelta] = 30}, 
  Row[Table[
    GeoGraphics[GeoBackground -> GeoStyling["ReliefMap"], 
     GeoRange -> {{-90, 
        90}, {\[Lambda], \[Lambda] + \[CapitalDelta]}}, 
     GeoProjection -> {"Equirectangular", 
       "Centering" -> {0, \[Lambda] + \[CapitalDelta]/2}}, 
     ImageSize -> Small, 
     GeoGridLines -> Quantity[10, "AngularDegrees"], 
     GeoGridLinesStyle -> GrayLevel[0.4, 0.5]], {\[Lambda], -180, 
     180 - \[CapitalDelta], \[CapitalDelta]}]]]
pp = ParametricPlot3D[{Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}, {u, 0, 
   2 \[Pi]}, {v, 0, \[Pi]}, Mesh -> None, PlotPoints -> 100, 
  TextureCoordinateFunction -> ({#4, 1 - #5} &), Boxed -> False, 
  PlotStyle -> Texture[img], Lighting -> "Neutral", Axes -> False, 
  RotationAction -> "Clip", 
  ViewPoint -> {-2.026774, 2.07922, 1.73753418}, ImageSize -> 300]

Autorotate

Code from here:

autoRotate[gr_Graphics3D, rate_: 5] := 
 DynamicModule[{vp, va, vv, vc}, {vp, va, vv, vc} = 
   gr~AbsoluteOptions~#~OptionValue~# &@{ViewPoint, ViewAngle, 
     ViewVertical, ViewCenter};
  Overlay[{Show[gr, SphericalRegion -> True, ViewPoint -> Dynamic[vp],
      ViewAngle -> Dynamic[va], ViewVertical -> Dynamic[vv], 
     ViewCenter -> Dynamic[vc]], 
    Show[gr, Background -> Black, Boxed -> False, 
     SphericalRegion -> True, 
     ViewPoint -> 
      Dynamic[RotationMatrix[Clock[2 \[Pi], rate], vv].vp], 
     ViewAngle -> Dynamic[va], ViewVertical -> Dynamic[vv], 
     ViewCenter -> Dynamic[vc]]}, All, 1]]

Data The data is irrelevant as my point is to illustrate feasibility and one way.

ds = {DateList@#1, f[#2, #3], #4} & @@@ dat[[All, {1, 2, 3, 5}]];
ds = Reverse[ds];
gth = GatherBy[ds, {#[[1, 1]], #[[1, 2]]} &];
vp[a_, b_, c_] := 
{Text[Style[DateString[a, {"MonthName", "  ", "Year"}],White, 20], 
{0,0,1.5}],Red, PointSize[rs[c]], Point[b]};
gra = vp @@@ # & /@ gth;
anim = Show[Graphics3D[#], ppl] & /@ gra;

The data is grouped into earthquake locations and magnitudes by month and gra just makes a point at location with size scaled by magnitude.

An example visualization:

Manipulate[
 autoRotate[anim[[month]], period],
 {month, Range[13]}, {period, {5, 10}}]

enter image description here

$\endgroup$
  • $\begingroup$ Awesome! I will try the code. Thank you. $\endgroup$ – locometro Dec 11 '16 at 20:20

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.