(************** Content-type: application/mathematica ************** Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 13735, 449]*) (*NotebookOutlinePosition[ 14463, 474]*) (* CellTagsIndexPosition[ 14419, 470]*) (*WindowFrame->Normal*) Notebook[{ Cell[CellGroupData[{ Cell["Asteroid Resonances", "Title"], Cell["AP1603", "Subsubtitle"], Cell[CellGroupData[{ Cell["Introduction", "Section"], Cell[TextData[{ "About 200 years ago, an interesting relationship was noticed between the \ distances of successive planets. The distance (in A.U.) between the ", StyleBox["N", FontSlant->"Italic"], "th planet and the Sun is given by the approximate formula:\n\t", Cell[BoxData[ \(TraditionalForm\`R\_N\)]], " = 0.4 + 2 (", Cell[BoxData[ \(TraditionalForm\`R\_\(N - 1\)\)]], "- 0.4)\nFor example, initializing the sequence with Mercury = 0.4 and \ Venus = 0.7, then Earth (", StyleBox["N", FontSlant->"Italic"], " = 3) has a radius ", Cell[BoxData[ \(TraditionalForm\`R\_3\)]], "= 1.0." }], "Text"], Cell["We can define this sequence as...", "Text"], Cell[BoxData[{ \(\(rp[1]\ = \ 0.4;\)\), "\n", \(\(rp[2]\ = \ 0.7;\)\), "\n", \(\(rp[n_Integer]\ = \ 0.4\ + \ 2\ \((rp[n\ - \ 1]\ - \ 0.4)\);\)\)}], "Input", CellLabel->"In[1]:="], Cell[BoxData[ \(Table[rp[n], \ {n, \ 1, 10}]\)], "Input", CellLabel->"In[4]:="], Cell[TextData[{ "One consequence of this series was noticed in about 1800. Perhaps there is \ a planet at ", Cell[BoxData[ \(TraditionalForm\`R\_5\)]], "=2.8. Indeed, this is the location of the asteroid belts; however, it took \ some time for astronomers to understand this." }], "Text"], Cell["\<\ I am not sure whether or not the spacing of the planets are well \ understood, but there is reasonably good understanding of the spacing of the \ rings of Saturn and the belts of asteroids located at about 2.8 A.U. For Saturn's rings, the resonant interaction of Saturn's moons destabilize \ particular orbits of dust and ice comprising the rings. For the asteroid \ belts, the resonant interation between the gravitational force of Jupiter \ destabilizes particular orbits of asteroids. \ \>", "Text"], Cell["\<\ In this notebook, I have constructed a relatively simple model for \ the interaction between the orbiting planet Jupiter and an asteroid located \ at a particular circular orbit from the Sun.\ \>", "Text"], Cell["\<\ The key simplifications used in the following calculations are (1) \ assume the asteroids remain in circular orbits, and (2) create an approximate \ model for the integrated torque applied by Jupiter to an asteroid along one \ complete orbit of the asteroid.\ \>", "Text"], Cell["\<\ As seen in other notebooks, use of the computer allows \ investigation of the long-time evolution of very complex (and nonlinear) \ dynamical interations. For the asteroids with resonant orbits, Jupiter \ effectively scatters these asteroids into different orbits.\ \>", "Text"] }, Closed]], Cell[CellGroupData[{ Cell["Orbital Resonances", "Section"], Cell["\<\ Kepler tells us that a planet's orbital frequency is inversely \ proportional to the planet's distance from the the Sun, raised to the 3/2 \ power.\ \>", "Text"], Cell[BoxData[ \(\(Off[General::spell, General::spell1];\)\)], "Input", CellLabel->"In[5]:="], Cell[BoxData[ \(omega[a_]\ := \ 2\ \[Pi]\ /a^\((3/2)\)\)], "Input", CellLabel->"In[6]:="], Cell[BoxData[ \(\(Plot[\(omega[a]/2\)/\[Pi], \ {a, \ 1, \ 6}];\)\)], "Input", CellLabel->"In[7]:="], Cell[BoxData[ \(\(Plot[omega[a]/omega[5.2], \ {a, \ 2, \ 5}, GridLines -> Automatic, PlotRange -> {0, 4}];\)\)], "Input", CellLabel->"In[8]:="], Cell[BoxData[ \(FindRoot[omega[a]/omega[5.2] == 3, \ {a, \ 2.5}]\)], "Input", CellLabel->"In[9]:="], Cell[BoxData[ \(FindRoot[omega[a]/omega[5.2] == 5/2, \ {a, \ 3.0}]\)], "Input", CellLabel->"In[10]:="], Cell[BoxData[ \(FindRoot[omega[a]/omega[5.2] == 7/3, \ {a, \ 3.0}]\)], "Input", CellLabel->"In[11]:="], Cell[BoxData[ \(FindRoot[omega[a]/omega[5.2] == 2, \ {a, \ 3.2}]\)], "Input", CellLabel->"In[12]:="] }, Closed]], Cell[CellGroupData[{ Cell["Jupiter's Torque", "Section"], Cell["Some definitions for Jupiter's orbit", "Text"], Cell[BoxData[{ \(\(aj\ = \ 5.20;\)\), "\n", \(\(wj\ = \ 2 \[Pi]/aj^\((3/2)\);\)\), "\n", \(\(massJS = \ 1/1048. ;\)\)}], "Input", CellLabel->"In[13]:="], Cell[TextData[{ "The location of the asteroid, ", StyleBox["ra", FontWeight->"Bold"], ", and Jupiter, ", StyleBox["rj", FontWeight->"Bold"], "..." }], "Text"], Cell[BoxData[{ \(\(ra\ = \ {a\ Cos[omega[a] t], a\ Sin[omega[a]\ t], 0};\)\), "\n", \(\(rj\ = \ {aj\ Cos[wj\ t\ + \ \[Phi]], \ aj\ Sin[wj\ t\ + \ \[Phi]], \ 0};\)\)}], "Input", CellLabel->"In[16]:="], Cell[BoxData[ \(\(dr\ = \ rj\ - \ ra;\)\)], "Input", CellLabel->"In[18]:="], Cell["The force on the asteroid from Jupiter...", "Text"], Cell[BoxData[ \(\(fj\ = \ \(-\ 4\)\ \(\[Pi]\^2\) massJS\ \ dr/\((dr\ . \ dr)\)^\((3/2)\);\)\)], "Input", CellLabel->"In[19]:="], Cell[BoxData[ \(\(torque\ = \ {0, 0, 1} . \((ra\ \[Cross]\ fj)\);\)\)], "Input", CellLabel->"In[20]:="], Cell["As Jupiter orbits the Sun, the torque changes...", "Text"], Cell[BoxData[ \(\(Plot[ Evaluate[ Table[torque\ /. \ a\ -> \ 2.5, \ {\[Phi], 0, \[Pi], \[Pi]/4}]], \ {t, \ 0, \ 2 \[Pi]/omega[2.5]}, \n\t PlotStyle -> Table[{Hue[\[Phi]/\[Pi]]}, {\[Phi], 0, \[Pi], \[Pi]/4}]]\ ;\)\)], "Input", CellLabel->"In[21]:="], Cell["\<\ These torques are small, but important for \"resonant\" aseteroids \ after a long,long time. For resonant asteroids, the net torques add up. To \ make progess, we need to simplify the calculations. \ \>", "Text"], Cell[CellGroupData[{ Cell["An Approximate \"Net Torque\" once around the orbit...", "Subsubsection"], Cell["\<\ Assuming the orbit remains circular, the net torque is \ approximately the integral around a complete asteroid orbit.\ \>", "Text"], Cell[BoxData[ \(netTorque[r_, p_]\ := \ NIntegrate[ Evaluate[\(2 \[Pi]\ torque/omega[r]\ /. \ a\ -> \ r\)\ /. \ \[Phi]\ -> \ p\ \ // \ N], \ {t, \ 0, \ 2 \[Pi]/omega[r]}]\)], "Input", CellLabel->"In[22]:="], Cell[BoxData[ \(netTorque[2.5, 0.0]\)], "Input", CellLabel->"In[23]:="], Cell[BoxData[ \(\(Plot[{netTorque[a, 0.0], 0.25 \((aj - 3.5)\)^4/\((aj - a)\)^4}, \ {a, \ 2.5, 3.5}, PlotRange -> {0, 0.25}, PlotStyle -> {{}, {RGBColor[0, 1, 0]}}];\)\)], "Input", CellLabel->"In[24]:="], Cell[BoxData[ \(\(Plot[netTorque[a, \[Pi]/2], \ {a, \ 2.5, 3.5}];\)\)], "Input", CellLabel->"In[25]:="], Cell[BoxData[ \(\(Plot[ Evaluate[\n\t\tTable[netTorque[r, p], {r, 2.2, 3.6, 0.2}]\n\t], \ {p, 0, 2 \[Pi]}, \n\t PlotStyle -> Table[{Hue[r/1.4]}, {r, 0, 1.4, 0.2}]];\)\)], "Input", CellLabel->"In[26]:="], Cell["\<\ As least for asteroids closer to Jupiter, the net torque varies \ with the initial phase like Cos[\[Theta]]^3.\ \>", "Text"], Cell[BoxData[ \(\(Plot[Cos[t]^3, \ {t, \ 0, \ 2\ \[Pi]}];\)\)], "Input", CellLabel->"In[27]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["A Mapping", "Section"], Cell["\<\ This approximation is the key that allows rapid computational \ steps...\ \>", "Text"], Cell[BoxData[ \(advance[{p_, r_}] := \ Module[{la, lb, rb, tb, netTor}, \[IndentingNewLine]la\ = \ 2\ \[Pi]\ Sqrt[r]; \[IndentingNewLine]netTor\ = \ Cos[p]^3\ *\ 0.25*\((aj - 3.5)\)^4/\((aj - r)\)^4; \[IndentingNewLine]lb\ = \ la\ + \ netTor; \[IndentingNewLine]rb\ = \ \((\(lb/ 2\)/\[Pi])\)^2; \[IndentingNewLine]tb\ = \ rb^\((3/2)\); \[IndentingNewLine]{Mod[p\ + \ tb\ wj, 2 \[Pi]], rb}]\)], "Input", CellLabel->"In[28]:="], Cell[TextData[{ StyleBox["advance[{p, r}]", FontWeight->"Bold"], " computes the phase of the asteroid's orbit with respect to Jupiter and \ the orbital radius (in A.U.) around the sun. It assumes the asteroid remains \ in an exactly circular orbit (which is obviously not true). As the asteroid \ slows or speeds up due to the net torque from Jupiter, the asteroid simply \ moves to a larger or smaller orbital radius around the sun." }], "Text"], Cell[BoxData[ \(advance[{0.0, 3.0}]\)], "Input", CellLabel->"In[29]:="], Cell[CellGroupData[{ Cell["Plots of asteroid resonances", "Subsubsection"], Cell["\<\ The phase-evolutions of particular asteroids reveal interesting \ behaviors.\ \>", "Text"], Cell[BoxData[ \(\(ast1\ = \ NestList[advance, {0.0, \ 2.95}, 1000];\)\)], "Input", CellLabel->"In[30]:="], Cell[BoxData[ \(\(p1\ = \ ListPlot[ast1, \ PlotStyle \[Rule] {RGBColor[1, 0, 0]}];\)\)], "Input",\ CellLabel->"In[31]:="], Cell[BoxData[ \(\(ast2\ = \ NestList[advance, {0.0, \ 2.5}, 1000];\)\)], "Input", CellLabel->"In[32]:="], Cell[BoxData[ \(\(p2\ = \ ListPlot[ast2, \ PlotStyle \[Rule] {RGBColor[0, 1, 0]}];\)\)], "Input",\ CellLabel->"In[33]:="], Cell[BoxData[ \(\(ast3\ = \ NestList[advance, {0.0, \ 3.27}, 1000];\)\)], "Input", CellLabel->"In[34]:="], Cell[BoxData[ \(\(p3\ = \ ListPlot[ast3, \ PlotStyle \[Rule] {RGBColor[0, 0, 1]}];\)\)], "Input",\ CellLabel->"In[35]:="], Cell[BoxData[ \(\(Show[p1, p2, p3];\)\)], "Input", CellLabel->"In[36]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["A Phase Map", "Section"], Cell[BoxData[ \(\(asteroids\ = \ Table[NestList[advance, {Pi/2, \ a}, 250], {a, 2.2, 3.8, 0.025}]\ // \ Flatten[#, 1] &;\)\)], "Input", CellLabel->"In[37]:="], Cell[BoxData[ \(\(ListPlot[asteroids, \ PlotStyle -> PointSize[0.005]];\)\)], "Input", CellLabel->"In[38]:="], Cell[CellGroupData[{ Cell["Asteroid Statistics", "Subsection"], Cell["\<\ We can form an approximate \"probability distribution function\" \ from the orbit histroies. The likelihood that an asteroid might be found at a \ particular radius is estimated from a large number of asteroid positions. \ \ \>", "Text"], Cell[BoxData[ \(\(Needs["\"];\)\)], "Input", CellLabel->"In[39]:="], Cell[BoxData[ \(\(asteroidsR\ = \ Map[Last, asteroids];\)\)], "Input", CellLabel->"In[40]:="], Cell[BoxData[ \(\(?BinCounts\)\)], "Input", CellLabel->"In[41]:="], Cell[BoxData[ \(\(prob\ = \ BinCounts[asteroidsR, {2.0, 4.0, 0.01}];\)\)], "Input", CellLabel->"In[42]:="], Cell[BoxData[ \(\(ListPlot[prob, \ \n\tPlotJoined\ -> \ True, \ \n\t Frame\ -> \ True, \n\tRotateLabel\ -> \ False, \n\t FrameLabel\ -> \ {"\", \ "\"}];\)\)], "Input", CellLabel->"In[43]:="] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell["Summary", "Section"], Cell[TextData[{ "In this notebook, we derived an ", StyleBox["approximate", FontSlant->"Italic"], " expression for the torque applied to an object due to the gravitational \ attraction of Jupiter. Then, we integrated this torque over an orbit to \ estimate the gain or loss of angular momentum of the (smaller) orbiting \ object.\nFor orbits that ", StyleBox["resonate", FontSlant->"Italic"], " with the orbit of Jupiter, these small changes of angular momentum \ accummulate over time. The object begins to slow down (move out) or speed up \ (move in) because the changes in velocity add up each orbit. For non-resonate \ objects, the motion does not change much ", StyleBox["on average.", FontSlant->"Italic"], " Sometimes these non-resonant objects speed up, sometimes they slow down, \ and on average they the orbits simply don't change much.\nFor the resonant \ orbits, the motion becomes chaotic. This means the orbital phase of the \ object with respect to Jupiter's orbital position becomes un-predictable. We \ computed phase-plots, and we constructed profiles of the distributions of the \ asteroid's positions. These resemble the observed banding of the asteroid \ belts." }], "Text"] }, Closed]] }, Open ]] }, FrontEndVersion->"4.1 for Macintosh", ScreenRectangle->{{0, 1152}, {0, 848}}, WindowSize->{611, 551}, WindowMargins->{{4, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{1, Automatic}, StyleDefinitions -> "TutorialBook.nb" ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[CellGroupData[{ Cell[1727, 52, 36, 0, 68, "Title"], Cell[1766, 54, 29, 0, 32, "Subsubtitle"], Cell[CellGroupData[{ Cell[1820, 58, 31, 0, 92, "Section"], Cell[1854, 60, 646, 19, 132, "Text"], Cell[2503, 81, 49, 0, 28, "Text"], Cell[2555, 83, 209, 5, 69, "Input"], Cell[2767, 90, 85, 2, 29, "Input"], Cell[2855, 94, 300, 7, 48, "Text"], Cell[3158, 103, 512, 8, 140, "Text"], Cell[3673, 113, 215, 4, 48, "Text"], Cell[3891, 119, 282, 5, 68, "Text"], Cell[4176, 126, 288, 5, 68, "Text"] }, Closed]], Cell[CellGroupData[{ Cell[4501, 136, 37, 0, 60, "Section"], Cell[4541, 138, 171, 4, 48, "Text"], Cell[4715, 144, 98, 2, 29, "Input"], Cell[4816, 148, 96, 2, 29, "Input"], Cell[4915, 152, 105, 2, 29, "Input"], Cell[5023, 156, 158, 3, 49, "Input"], Cell[5184, 161, 105, 2, 29, "Input"], Cell[5292, 165, 108, 2, 29, "Input"], Cell[5403, 169, 108, 2, 29, "Input"], Cell[5514, 173, 106, 2, 29, "Input"] }, Closed]], Cell[CellGroupData[{ Cell[5657, 180, 35, 0, 60, "Section"], Cell[5695, 182, 52, 0, 28, "Text"], Cell[5750, 184, 171, 4, 69, "Input"], Cell[5924, 190, 176, 8, 28, "Text"], Cell[6103, 200, 225, 4, 49, "Input"], Cell[6331, 206, 83, 2, 29, "Input"], Cell[6417, 210, 57, 0, 28, "Text"], Cell[6477, 212, 146, 3, 31, "Input"], Cell[6626, 217, 110, 2, 29, "Input"], Cell[6739, 221, 64, 0, 28, "Text"], Cell[6806, 223, 324, 8, 89, "Input"], Cell[7133, 233, 222, 4, 48, "Text"], Cell[CellGroupData[{ Cell[7380, 241, 79, 0, 36, "Subsubsection"], Cell[7462, 243, 141, 3, 48, "Text"], Cell[7606, 248, 263, 6, 109, "Input"], Cell[7872, 256, 77, 2, 29, "Input"], Cell[7952, 260, 238, 5, 89, "Input"], Cell[8193, 267, 109, 2, 29, "Input"], Cell[8305, 271, 236, 5, 129, "Input"], Cell[8544, 278, 134, 3, 28, "Text"], Cell[8681, 283, 101, 2, 29, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[8831, 291, 28, 0, 60, "Section"], Cell[8862, 293, 96, 3, 28, "Text"], Cell[8961, 298, 532, 10, 189, "Input"], Cell[9496, 310, 454, 8, 88, "Text"], Cell[9953, 320, 77, 2, 29, "Input"], Cell[CellGroupData[{ Cell[10055, 326, 53, 0, 36, "Subsubsection"], Cell[10111, 328, 100, 3, 28, "Text"], Cell[10214, 333, 112, 2, 29, "Input"], Cell[10329, 337, 138, 4, 49, "Input"], Cell[10470, 343, 111, 2, 29, "Input"], Cell[10584, 347, 138, 4, 49, "Input"], Cell[10725, 353, 112, 2, 29, "Input"], Cell[10840, 357, 138, 4, 49, "Input"], Cell[10981, 363, 79, 2, 29, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[11109, 371, 30, 0, 60, "Section"], Cell[11142, 373, 190, 4, 69, "Input"], Cell[11335, 379, 115, 2, 29, "Input"], Cell[CellGroupData[{ Cell[11475, 385, 41, 0, 43, "Subsection"], Cell[11519, 387, 247, 5, 68, "Text"], Cell[11769, 394, 104, 2, 29, "Input"], Cell[11876, 398, 100, 2, 29, "Input"], Cell[11979, 402, 72, 2, 29, "Input"], Cell[12054, 406, 113, 2, 29, "Input"], Cell[12170, 410, 237, 4, 109, "Input"] }, Closed]] }, Closed]], Cell[CellGroupData[{ Cell[12456, 420, 26, 0, 60, "Section"], Cell[12485, 422, 1222, 23, 272, "Text"] }, Closed]] }, Open ]] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)