The opening ceremony of the delayed 2020 Summer Olympics took place on 23 July 2021 at Olympic Stadium, Tokyo . 1, 824 drones made a 3 D rendition of the Tokyo Olympic Games emblem over the stadium and then the globe of Earth with its continents . I tried to recreate these with spheres using Mathematica .
Init
Init
Points of the Tokyo 2020 Olympic Emblem
Points of the Tokyo 2020 Olympic Emblem
Please refer to my post
Tokyo 2020 Olympic and Paralympic Emblems
https://community.wolfram.com/groups/-/m/t/1758435
from two years ago about the points that represent the Tokyo 2020 Olympic Emblem.
Tokyo 2020 Olympic and Paralympic Emblems
https://community.wolfram.com/groups/-/m/t/1758435
from two years ago about the points that represent the Tokyo 2020 Olympic Emblem.
In[]:=
pts=;
(*display*)Graphics3D[{White,Sphere[pts,r]},g3Dopt]
Out[]=
Points of the Earth
Points of the Earth
In[]:=
continents=,,,,,,;
In[]:=
(*combinationoflatitudeandlongitude*)latitude=Range[-87,87,3];longitude=Range[-180,177,3];t=Tuples[{latitude,longitude}];
In[]:=
(*extractpointsinsidecontinents*)gps=GeoPosition/@t;tf=(Position[GeoWithinQ[#,gps],True]&/@continents)//Flatten//DeleteDuplicates;geo=Table[Sequence@@GeoPositionXYZ[pos],{pos,gps[[tf]]}];
In[]:=
(*rescalegeotorunfrom-prtoprovertherangemaxgeotomaxgeo*)maxgeo=geo//Max;earthpts=Rescale[#,{-maxgeo,maxgeo},{-pr,pr}]&/@geo;
(*display*)Graphics3D[{White,Sphere[earthpts,r]},g3Dopt]
Out[]=
Paths from pts to earthpts
Paths from pts to earthpts
In[]:=
(*expandptstomatchthenumberofearthpts*)ptsx=Join[pts,pts,pts,RandomSample[pts,Length[earthpts]-Length[pts]*3]];
In[]:=
(*pathsfromptsxtoearthpts*)interpolation[s_,e_,i_,n_]:=s+i(e-s)/ninterpolation2[i_,n_]:=(interpolation[ptsx[[#]],earthpts[[#]],i,n]&/@Range[Length[earthpts]])n=50;path=interpolation2[#,n]&/@Range[0,n];
In[]:=
(*3Dgraphicalimagesofpaths*)graph[i_]:=Graphics3D[{White,Sphere[#,r]&/@((#.RotationMatrix[-23.4Degree,{0,1,0}])&/@path[[i]])},g3Dopt]graphs=graph/@Range[n+1];frame1=ImageResize[#,imgsize]&/@graphs;
(*display*)GraphicsRow[{frame1[[1]],frame1[[-1]]}]
Out[]=
Rotate the Earth
Rotate the Earth
In[]:=
(*theearth,theendofpaths*)e234=(#.RotationMatrix[-23.4Degree,{0,1,0}])&/@path[[-1]];
In[]:=
(*vectoroftheearth'saxis*)axisvec={0,0,1}.RotationMatrix[-23.4Degree,{0,1,0}];(*rotateoftheearth*)graphs2=Table[Graphics3D[{White,Sphere[#,r]&/@((#.RotationMatrix[i,axisvec])&/@e234)},g3Dopt],{i,2Pi,0,-2Pi/n}];frame2=ImageResize[#,imgsize]&/@graphs2;
(*display*)GraphicsRow[{frame2[[1]],frame2[[25]]}]
Out[]=
Make frames
Make frames
Make frames starting with displaying the emblem, then displaying the earth, rotating, and turning off the lights .
In[]:=
blackframe=Image@ConstantArray[0.,{imgsize,imgsize,3}];frame3=Join[Table[blackframe,{fr/2}],(*blackbackground*)Table[Darker[frame1[[1]],(fr-i)/fr],{i,1,fr}],(*turningonthelights*)Table[frame1[[1]],2fr],(*theemblem*)frame1,(*convertingfromtheemblemtotheearth*)Table[frame1[[-1]],fr],(*theearth*)frame2,(*rotatingtheearth*)Table[Darker[frame2[[i]],i/(Length@frame2/2)],{i,2,Length@frame2/2}](*turningoffthelights*)];(*cropframes*)frame4=ImageCrop[#,160]&/@frame3;
Generate animation
Generate animation
Generate the animation using frames with added background.