# 地球の曲率を調べる

エッフェル塔を出発して，順番に東西南北のそれぞれの方向の測地線に沿って100km移動する経路を定義する．

 In[1]:= Xstart = Entity["Building", "TourEiffel"][ EntityProperty["Building", "Position"]]; d = Quantity[100, "Kilometers"]; path = {GeoDisplacement[{d, "North"}, "Geodesic"], GeoDisplacement[{d, "East"}, "Geodesic"], GeoDisplacement[{d, "South"}, "Geodesic"], GeoDisplacement[{d, "West"}, "Geodesic"]};

4つの部分の経路を描画し，ズームインして，地球の曲率が原因でその経路が閉じないいことを検証する．

 In[2]:= XGraphicsRow[ Apply[GeoGraphics[{Red, PointSize[Large], Point[start], Darker[Green], Thickness[Large], GeoPath[{start, path}]}, ##1] &, {{}, {GeoCenter -> start, GeoRange -> Quantity[3, "Kilometers"]}}, {1}]]
 Out[2]=

 In[3]:= XGeoDistance[start, Last[GeoDestination[start, path]]]
 Out[3]=

 In[4]:= Xd = Quantity[100, "Kilometers"]; path = {GeoDisplacement[{d, "North"}, "Rhumb"], GeoDisplacement[{d, "East"}, "Rhumb"], GeoDisplacement[{d, "South"}, "Rhumb"], GeoDisplacement[{d, "West"}, "Rhumb"]};

 In[5]:= XGraphicsRow[ Apply[GeoGraphics[{Red, PointSize[Large], Point[start], Darker[Green], Thickness[Large], GeoPath[{start, path}]}, ##1] &, {{}, {GeoCenter -> start, GeoRange -> Quantity[3, "Kilometers"]}}, {1}]]
 Out[5]=

 In[6]:= XGeoDistance[start, Last[GeoDestination[start, path]]]
 Out[6]=

## Mathematica

Questions? Comments? Contact a Wolfram expert »