(*^ ::[ frontEndVersion = "Microsoft Windows Mathematica Notebook Front End Version 2.2"; microsoftWindowsStandardFontEncoding; fontset = title, "Times", 24, L0, center, nohscroll, bold; fontset = subtitle, "Times", 18, L0, center, nohscroll, bold; fontset = subsubtitle, "Times", 14, L0, center, nohscroll, italic; fontset = section, "Times", 18, L0, nohscroll, bold, grayBox; fontset = subsection, "Times", 14, L0, nohscroll, bold, blackBox; fontset = subsubsection, "Times", 13, L0, nohscroll, B65535; fontset = text, "Times", 12, L0, nohscroll, cellOutline; fontset = smalltext, "Times", 10, L0, nohscroll; fontset = input, "Courier", 12, L-5, nowordwrap, bold; fontset = output, "Courier", 12, L-5, nowordwrap; fontset = message, "Courier", 12, L-5, nowordwrap, R65535; fontset = print, "Courier", 12, L-5, nowordwrap; fontset = info, "Courier", 12, L-5, nowordwrap, B65535; fontset = postscript, "Courier", 12, L0, nowordwrap; fontset = name, "Geneva", 10, L0, nohscroll, italic; fontset = header, "Times", 12, L0; fontset = footer, "Times", 12, L0, center; fontset = help, "Times", 10, L0, nohscroll; fontset = clipboard, "Times", 12, L0, nohscroll; fontset = completions, "Times", 12, L0, nohscroll; fontset = graphics, "Courier New", 10, L0, nowordwrap, nohscroll; fontset = special1, "Times", 12, L0, nohscroll; fontset = special2, "Times", 12, L0, nohscroll; fontset = special3, "Times", 12, L0, nohscroll; fontset = special4, "Times", 12, L0, nohscroll; fontset = special5, "Times", 12, L0, nohscroll; fontset = leftheader, "Times", 12, L2; fontset = leftfooter, "Times", 12, L2; fontset = reserved1, "Courier New", 10, L0, nowordwrap, nohscroll;] :[font = title; inactive; preserveAspect; nohscroll; center; ] MathLive Professional :[font = subsubtitle; inactive; preserveAspect; startGroup; nohscroll; center; ] Lorenz example Original by W.Shaw1995 Last Revision: 20/4/96 :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] Introductory Notes :[font = subsubsection; inactive; preserveAspect; nohscroll; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 65535; plain; fontName = "Times"; fontSize = 13; ] This notebook looks at the real time trajectory of the Lorenz Attractor. The evolution is shown as a static blue path and dynamically using spheres at equally spaced time intervals. This approach allows the visualisation of the evolution speed at different parts of the path. :[font = subsubsection; inactive; preserveAspect; nohscroll; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 65535; plain; fontName = "Times"; fontSize = 13; ] The initialisation cells create the graphics in MathLive but do not run the animations. The amount of memory required is dependent upon the length of path considered (set by 'tMax'). For tMax = 16, at least 4 Mb of free Kernel memory is required. :[font = subsubsection; inactive; preserveAspect; endGroup; nohscroll; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 65535; plain; fontName = "Times"; fontSize = 13; ] Additionally, we would suggest that you give MathLive as much memory as you can afford, the default preferred partition size of 5120K is just sufficient for most systems. :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create the graphics (initialisation) :[font = input; initialization; preserveAspect; nowordwrap; ] *) General::spell1 //Off; Needs["MathLive`MathLive`"] LaunchLive[]; ResetLive[]; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Chaotic Equation solver :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) tMax = 16; (* You will need at least 4 Mb free for the Kernel *) LorenzCurve = NDSolve[ {x'[t] == -3 (x[t] - y[t]), y'[t] == -x[t] z[t] + 26.5 x[t] - y[t], z'[t] == x[t] y[t] - z[t], x[0] == z[0] == 0, y[0] ==2}, {x, y, z}, {t, 0, tMax}, MaxSteps -> 100 tMax]; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create ball graphics :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) SetDisplay[ NoteBook->Off, Live->Off]; gBall = ParametricPlot3D[{Sin[u]*Cos[t], Sin[u]*Sin[t], Cos[u]} , {u, 0, Pi}, {t, 0, 2 Pi} , PlotPoints ->{10,10}]; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Create line graphics :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) gTrajectoryLine = Graphics3D[ Line[Table[Flatten[Evaluate[{x[t],y[t],z[t]}/. LorenzCurve]], {t, 0, tMax, 1/40}]] ]; (* :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Create the objects in MathLive (initialisation) :[font = input; initialization; preserveAspect; nowordwrap; ] *) Live[ Change[ Model3D["Default`"] , BoundingBox -> Off , ModelRange -> {{-50,-50,-50},{50,50,50}} , Scale -> 2 ]]; (* :[font = input; initialization; preserveAspect; nowordwrap; ] *) Live[ Create[ Object3D["Trajectory"], gTrajectoryLine]]; (* :[font = input; initialization; preserveAspect; nowordwrap; ] *) Live[ Change[ Object3D["Trajectory"] , Opacity -> 1 , RenderMode -> SmoothShaded , Color -> RGBColor[0,0,1] , MouseMovement -> False ]]; (* :[font = input; initialization; preserveAspect; endGroup; nowordwrap; ] *) nBalls = 4; Do[ Live[ gBall ]; ball[i] = LastObjectCreated[]; Live[ Change[ ball[i] , Color -> Hue[0] , Scale -> 2 , Opacity -> 1 - (i-1) / nBalls , RenderMode -> SmoothShaded , MouseMovement -> False ]]; , {i,nBalls} ]; (* :[font = section; inactive; initialization; preserveAspect; startGroup; Cclosed; nohscroll; ] Animation Dynamics :[font = input; initialization; preserveAspect; nowordwrap; ] *) ballLocations = Table[ Flatten[Evaluate[{x[t],y[t],z[t]}/. LorenzCurve]], {t, 0, tMax, 1/20}]; (* :[font = input; initialization; preserveAspect; nowordwrap; ] *) ballAnim = Table[ Change[ ball[i] , Location -> ballLocations[[Max[frame-(i-1),1]]]] , {frame, 1, Length[ballLocations]} , { i , nBalls} ]; AppendTo[ ballAnim , First[ ballAnim ] ]; (* :[font = input; initialization; preserveAspect; nowordwrap; ] *) Live[ballAnim]; (* :[font = subsection; inactive; initialization; preserveAspect; startGroup; nohscroll; ] Adding a Rotation to the above Animation :[font = input; initialization; preserveAspect; endGroup; endGroup; nowordwrap; ] *) angleStep = N[4 Pi/Length[ballAnim]]; anim2 = MapIndexed[ { # , Change[ Model3D["Default`"] , Euler -> {0,0,#2[[1]] angleStep }] } & , ballAnim]; Live[anim2]; (* :[font = section; inactive; preserveAspect; startGroup; Cclosed; nohscroll; ] Example - move to specific animation frame :[font = input; preserveAspect; endGroup; nowordwrap; ] Live[ ballAnim[[{20}]] ]; :[font = section; inactive; preserveAspect; startGroup; Cclosed; nohscroll; ] Example - Make a Movie (mac only) :[font = input; preserveAspect; endGroup; nowordwrap; ] (* Ensure that anim2 has been correctly defined *) (* Dont forget to uncomment the next line... *) (* Live[ RecordMovie["Chaos.qt",anim2] ] *) :[font = section; inactive; preserveAspect; startGroup; nohscroll; ] For further information, advice or suggestions please contact- :[font = text; inactive; preserveAspect; endGroup; endGroup; nohscroll; cellOutline; backColorRed = 65535; backColorGreen = 65535; backColorBlue = 65535; fontColorRed = 0; fontColorGreen = 0; fontColorBlue = 0; plain; fontName = "Times"; fontSize = 12; ] Email: support@milohedge.com Post: Milo Hedge Ltd, The Oxford Centre for Innovation, Mill Street, Oxford, OX2 0JX WWW: http://www.milohedge.com/mathlive/ ^*)