太陽の年間経路をプロットする 

夏至と冬至，春分における太陽の1日の経路を求め，完全なアナレンマの点を見付ける．

In[1]:=

X summerpath = SunPosition[ DateRange[DateObject[{2014, 6, 21, 5, 0}], DateObject[{2014, 6, 21, 20, 0}], {10, "Minute"}]]; winterpath = SunPosition[ DateRange[DateObject[{2014, 12, 21, 5, 0}], DateObject[{2014, 12, 21, 20, 0}], {10, "Minute"}]]; equinoxpath = SunPosition[ DateRange[DateObject[{2014, 3, 20, 5, 0}], DateObject[{2014, 3, 20, 20, 0}], {10, "Minute"}]]; analemmaPoints = Map[QuantityMagnitude, SunPosition[ DateRange[DateObject[{2014, 1, 1, 9, 0}], DateObject[{2014, 12, 31, 9, 0}], 10]]["Values"], {2}];

スタイル付けのための色を定義する．

In[2]:=

X skyTopColor = RGBColor[0.27, 0.2, 0.75]; skyBottomColor = RGBColor[ 0.25, 0.43, 0.82]; groundColor = RGBColor[0.1, 0.1, 0.1]; sunColor = RGBColor[ 0.8588235294117647, 0.788235294117647, 0.5411764705882353];

関心のある日付における太陽の特定の位置を選ぶ．

In[3]:=

X disksOfSpecialInterest = Disk[QuantityMagnitude /@ #, 1] & /@ { summerpath[DateObject[{2014, 6, 21, 9, 0}]], winterpath[DateObject[{2014, 12, 21, 9, 0}]], equinoxpath[DateObject[{2014, 3, 20, 9, 0}]], SunPosition[DateObject[{2014, 9, 22, 9, 0}]]};

夏至，冬至，春分における太陽の1日の経路を示す線を生成する．

In[4]:=

X linesOfSpecialInterest = Line[Map[QuantityMagnitude, #, {2}]] & /@ {summerpath["Values"], winterpath["Values"], equinoxpath["Values"]};

注釈を作成し，いくつかの特徴にラベルを付ける．

In[5]:=

X labels = {sunColor, Rotate[Text["summer solstice", {86, 42}], 45 Degree], Rotate[Text[DateString[{2014, 6, 21}, {"DayShort", " ", "MonthNameShort", " ", "Year"}], {88, 40}], 45 Degree], Rotate[Text["equinox", {120, 28}], 40 Degree], Rotate[Text["winter solstice", {130, 5}], 45 Degree], Rotate[Text[DateString[{2014, 12, 21}, {"DayShort", " ", "MonthNameShort", " ", "Year"}], {133, 4}], 45 Degree], Rotate[Text[DateString[{2014, 9, 22, 9, 0}, {"DayShort", " ", "MonthNameShort", " ", "Year"}], {116.5, 30.5}], 41 Degree], Rotate[Text[DateString[{2014, 3, 20, 9, 0}, {"DayShort", " ", "MonthNameShort", " ", "Year"}], {104, 19}], 46 Degree]};

自分のいる場所における太陽の年間経路を示す画像を作成する．

In[6]:=

X SunPlot[] := Block[{xMin, xMax, yMin, yMax}, {{xMin, xMax}, {yMin, yMax}} = ({Min[#], Max[#]} + 10 {-1, 1}) & /@ Transpose[analemmaPoints]; Graphics[{Blue, Polygon[ {{xMin, yMin}, {xMin, yMax}, {xMax, yMax}, {xMax, yMin}}, VertexColors -> {skyBottomColor, skyTopColor, skyTopColor, skyBottomColor}], {sunColor, Disk[#, .5] & /@ analemmaPoints, EdgeForm[Red], disksOfSpecialInterest}, {sunColor, Opacity[.5], linesOfSpecialInterest}, {groundColor, Rectangle[{xMin, yMin}, {xMax, 0}]}, labels}, Frame -> True, FrameLabel -> {"azimuth", "altitude"}, PlotRange -> {{xMin, xMax}, {yMin, yMax}}, PlotRangeClipping -> True, PlotLabel -> "Yearly path of the Sun at 9:00 in " <> CommonName[First[GeoIdentify["City", $GeoLocation]]]] ]

In[7]:=

X SunPlot[]

Out[7]=