(* Content-type: application/mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 7.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       145,          7]
NotebookDataLength[     34825,        744]
NotebookOptionsPosition[     34033,        712]
NotebookOutlinePosition[     34533,        733]
CellTagsIndexPosition[     34490,        730]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell["Exploding Equation and High Precision Numbers", "Title",
 CellChangeTimes->{{3.47158560890625*^9, 3.471585639140625*^9}, {
  3.4722809098125*^9, 3.472280940921875*^9}}],

Cell["Ulrich Mutze ,www.ulrichmutze.de, 2010-01-14", "Subtitle",
 CellChangeTimes->{{3.4715857355625*^9, 3.4715857678125*^9}, {
   3.47158590925*^9, 3.471585928984375*^9}, 3.472051425796875*^9, {
   3.4721935681875*^9, 3.472193568375*^9}, 3.472280947734375*^9, 
   3.47248492759375*^9}],

Cell[TextData[{
 StyleBox["We consider the differential equation ",
  FontSize->14],
 Cell[BoxData[
  FormBox[
   FractionBox["\[DifferentialD]", 
    RowBox[{"\[DifferentialD]", "t"}]], TraditionalForm]],
  FontSize->14],
 StyleBox["h(t)",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox[" = ",
  FontSize->14],
 Cell[BoxData[
  FormBox[
   SuperscriptBox[
    RowBox[{"h", "(", "t", ")"}], "2"], TraditionalForm]],
  FontSize->14],
 StyleBox[" with the initial condition ",
  FontSize->14],
 StyleBox["h(0)=1",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox[". The solution obviously is ",
  FontSize->14],
 StyleBox["h(t) ",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["= ",
  FontSize->14],
 Cell[BoxData[
  FormBox[
   FractionBox["1", 
    RowBox[{"1", "-", "t"}]], TraditionalForm]],
  FontSize->14],
 StyleBox[" and thus tends to infinity as ",
  FontSize->14],
 StyleBox["t",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox[" tends to 1. We now consider the discrete approximation to this \
solution as provided by the asynchronous leap-frog method. Since the \
evolution step does not involve potentially undefined operations, any such \
discrete approximation is well-defined for all its ",
  FontSize->14],
 StyleBox["t",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["-value (which we assume here to form an equidistant chain ",
  FontSize->14],
 Cell[BoxData[
  FormBox[
   SubscriptBox["t", "n"], TraditionalForm]]],
 " = ",
 StyleBox["n dt",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox[" ",
  FontSlant->"Italic"],
 StyleBox["). Of course, these values will grow dramatically and will soon \
transcend what can be represented even with ",
  FontSize->14],
 StyleBox["Mathematica",
  FontSize->14,
  FontSlant->"Italic"],
 StyleBox["'s arbitrary precision numbers. Since the asynchronous leap-frog \
method is a reversible integration method, we should be able to go on each \
finite discrete trajectory back to its initial point. If the final point was \
'close to infinity' the computation needs to be done with a large number of \
digits in order to come back to the initial point. This is what the following \
interactive graphics allows to study. \nAs this graphics is set up, it shows \
a reversible trajectory. Switching to using machine precision shows that that \
the trajectory in forward direction is created completely but the reversed \
part consists of a single point (although no overflow is reported). ",
  FontSize->14]
}], "Text",
 CellChangeTimes->{{3.472454446671875*^9, 3.472454499703125*^9}, {
   3.47245454696875*^9, 3.47245462565625*^9}, {3.472454656671875*^9, 
   3.472454821453125*^9}, {3.47245486271875*^9, 3.472454915640625*^9}, {
   3.47245495740625*^9, 3.472454965359375*^9}, {3.472455020546875*^9, 
   3.472455086203125*^9}, 3.4724551264375*^9, {3.47245529725*^9, 
   3.472455297765625*^9}, {3.47245554309375*^9, 3.472455585375*^9}, {
   3.472455682546875*^9, 3.47245572915625*^9}, {3.472455855375*^9, 
   3.472455895859375*^9}, {3.472455938359375*^9, 3.47245605253125*^9}, 
   3.472456208109375*^9, {3.472456241578125*^9, 3.47245628090625*^9}, {
   3.47245631415625*^9, 3.472456367953125*^9}, {3.472456457796875*^9, 
   3.472456461359375*^9}, {3.472457600171875*^9, 3.472457618671875*^9}, {
   3.47245764978125*^9, 3.4724576859375*^9}, {3.472457785203125*^9, 
   3.47245791225*^9}, {3.472457943078125*^9, 3.472457958140625*^9}, {
   3.4724580005625*^9, 3.472458140546875*^9}, {3.4724581919375*^9, 
   3.4724584905*^9}, {3.472458603890625*^9, 3.472458666296875*^9}, {
   3.47245870540625*^9, 3.4724587135625*^9}, {3.472458746328125*^9, 
   3.47245875065625*^9}, {3.47245889628125*^9, 3.472459238984375*^9}, {
   3.4724849581875*^9, 3.47248499371875*^9}, {3.47248530671875*^9, 
   3.472485328109375*^9}, {3.472485372640625*^9, 3.472485404046875*^9}, {
   3.4724854448125*^9, 3.47248550571875*^9}, {3.4724855966875*^9, 
   3.472485624546875*^9}, {3.472485883140625*^9, 3.4724859738125*^9}, {
   3.472486050859375*^9, 3.47248606365625*^9}},
 FontSize->18],

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"f", "[", "y_", "]"}], ":=", 
   RowBox[{"y", "*", "y"}]}], " ", 
  RowBox[{"(*", " ", 
   RowBox[{
    RowBox[{"defines", " ", "the", " ", "right"}], "-", 
    RowBox[{
    "hand", " ", "side", " ", "of", " ", "the", " ", "differential", " ", 
     "equation"}]}], " ", "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"dis", "[", "y_", "]"}], ":=", 
  RowBox[{"Log10", "[", 
   RowBox[{
    RowBox[{"Log10", "[", "y", "]"}], "+", "1"}], "]"}], " ", 
  RowBox[{"(*", " ", 
   RowBox[{
    RowBox[{"quantity", " ", "for", " ", "graphical", " ", "representation"}],
     ",", " ", 
    RowBox[{
     RowBox[{"dis", "[", "1", "]"}], "\[Equal]", "0"}]}], " ", 
   "*)"}]}]}], "Input",
 CellChangeTimes->{{3.471586036234375*^9, 3.471586051921875*^9}, {
   3.471586104078125*^9, 3.47158612084375*^9}, {3.471586255609375*^9, 
   3.471586327921875*^9}, 3.47158723040625*^9, 3.471587266609375*^9, {
   3.471587348953125*^9, 3.47158739890625*^9}, {3.4715889634375*^9, 
   3.47158897921875*^9}, {3.471591371890625*^9, 3.471591384609375*^9}, 
   3.47212626184375*^9, {3.472126605*^9, 3.472126707796875*^9}, {
   3.472126792796875*^9, 3.4721268215*^9}, {3.472126900359375*^9, 
   3.47212690640625*^9}, {3.472127062109375*^9, 3.47212712228125*^9}, 
   3.4721272193125*^9, {3.472127253890625*^9, 3.472127266140625*^9}, 
   3.4721273089375*^9, {3.47212738440625*^9, 3.472127394*^9}, {
   3.472127633046875*^9, 3.472127646703125*^9}, {3.472128904765625*^9, 
   3.472128931796875*^9}, {3.472129142140625*^9, 3.472129150625*^9}, {
   3.4721292209375*^9, 3.4721292335625*^9}, {3.472129293328125*^9, 
   3.472129315578125*^9}, 3.47212935796875*^9, {3.4721295998125*^9, 
   3.472129626328125*^9}, {3.47213130903125*^9, 3.472131367265625*^9}, {
   3.472131414328125*^9, 3.472131418609375*^9}, {3.472131799859375*^9, 
   3.472131878125*^9}, {3.472132669203125*^9, 3.472132682578125*^9}, 
   3.47213466671875*^9, {3.4721349504375*^9, 3.472134957421875*^9}, {
   3.47219418753125*^9, 3.472194200296875*^9}, {3.4721978706875*^9, 
   3.472197898109375*^9}, {3.472197965546875*^9, 3.47219797596875*^9}, {
   3.472198010078125*^9, 3.4721980131875*^9}, {3.472198316359375*^9, 
   3.472198356453125*^9}, {3.472198984640625*^9, 3.472198996203125*^9}, {
   3.472200280484375*^9, 3.472200302921875*^9}, {3.47221848296875*^9, 
   3.472218506171875*^9}, {3.4722185536875*^9, 3.472218554453125*^9}, {
   3.472218940015625*^9, 3.472218949453125*^9}, {3.472219243828125*^9, 
   3.472219271390625*^9}, 3.472219360015625*^9, {3.472219453984375*^9, 
   3.472219496375*^9}, {3.472219616296875*^9, 3.472219619609375*^9}, 
   3.4722196709375*^9, {3.472219947734375*^9, 3.47221995834375*^9}, {
   3.4722200736875*^9, 3.47222012340625*^9}, {3.472220214515625*^9, 
   3.4722202443125*^9}, 3.472220297296875*^9, {3.47222033540625*^9, 
   3.472220460984375*^9}, {3.47222050184375*^9, 3.472220568015625*^9}, {
   3.472220783265625*^9, 3.472220961546875*^9}, {3.472221037515625*^9, 
   3.472221052671875*^9}, {3.472221110625*^9, 3.4722211231875*^9}, {
   3.472221206515625*^9, 3.472221228671875*^9}, 3.472221672765625*^9, {
   3.4722217280625*^9, 3.47222173303125*^9}, {3.472221786765625*^9, 
   3.4722217891875*^9}, {3.472221938046875*^9, 3.472221975296875*^9}, 
   3.47222203284375*^9, {3.4722220819375*^9, 3.472222176515625*^9}, {
   3.47222223471875*^9, 3.472222396390625*^9}, {3.472222428046875*^9, 
   3.472222443296875*^9}, {3.4722225423125*^9, 3.47222254890625*^9}, {
   3.472222713453125*^9, 3.472222716078125*^9}, {3.472222748390625*^9, 
   3.4722228019375*^9}, {3.472222846953125*^9, 3.472222882890625*^9}, {
   3.47222325215625*^9, 3.4722232975*^9}, {3.472223334546875*^9, 
   3.472223351921875*^9}, 3.47222355475*^9, {3.472223613015625*^9, 
   3.472223632*^9}, {3.472223737484375*^9, 3.4722237726875*^9}, {
   3.472223813296875*^9, 3.472223841078125*^9}, {3.472223886234375*^9, 
   3.472223983296875*^9}, {3.472275721109375*^9, 3.47227572428125*^9}, {
   3.47227579334375*^9, 3.47227580765625*^9}, {3.472275874078125*^9, 
   3.4722758859375*^9}, 3.472275965921875*^9, {3.472277844359375*^9, 
   3.472277894390625*^9}, {3.4722781205*^9, 3.472278181578125*^9}, {
   3.472280965546875*^9, 3.47228099709375*^9}, 3.472281047*^9, {
   3.472288781421875*^9, 3.47228881234375*^9}, {3.472289231171875*^9, 
   3.472289237390625*^9}, {3.4722895609375*^9, 3.4722895670625*^9}, {
   3.472289797*^9, 3.472289808234375*^9}, {3.47229787365625*^9, 
   3.472297881765625*^9}, 3.47230126928125*^9, {3.472307122421875*^9, 
   3.47230717746875*^9}, 3.472454432296875*^9, {3.472456081875*^9, 
   3.4724561148125*^9}, {3.472476846703125*^9, 3.472476851484375*^9}, {
   3.4724779014375*^9, 3.472477913671875*^9}, {3.472478655640625*^9, 
   3.472478680109375*^9}, {3.47248625578125*^9, 3.472486310828125*^9}, {
   3.472486352640625*^9, 3.472486361765625*^9}}],

Cell[CellGroupData[{

Cell[BoxData[{
 RowBox[{
  RowBox[{
   RowBox[{"step", "[", 
    RowBox[{
     RowBox[{"state", "[", 
      RowBox[{"x_", ",", "v_", ",", "t_"}], "]"}], ",", "dt_"}], "]"}], ":=", 
   " ", 
   RowBox[{"(*", " ", 
    RowBox[{
     RowBox[{
     "evolution", " ", "step", " ", "for", " ", "the", " ", "asynchronous", 
      " ", "leap"}], "-", 
     RowBox[{"frog", " ", "integrator"}]}], " ", "*)"}], 
   "\[IndentingNewLine]", 
   RowBox[{"Module", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
       RowBox[{"\[Tau]", "=", " ", 
        RowBox[{"dt", "/", "2"}]}], ",", 
       RowBox[{"ta", "=", "t"}], ",", 
       RowBox[{"xa", "=", "x"}], ",", 
       RowBox[{"va", "=", "v"}]}], "}"}], ",", "\[IndentingNewLine]", 
     RowBox[{"(*", " ", 
      RowBox[{"Replacing", " ", 
       RowBox[{"dt", "/", "2"}], " ", "by", " ", "dt", "*", "0.5", " ", 
       "lets", " ", "the", " ", "following", "\[IndentingNewLine]", 
       "computation", " ", "no", " ", "longer", " ", "depend", " ", 
       RowBox[{"on", " ", "'"}], 
       RowBox[{"precision", "'"}], " ", 
       RowBox[{
        RowBox[{"(", 
         RowBox[{
         "what", " ", "is", "  ", "n", " ", "o", " ", "t", "  ", "wanted"}], 
         ")"}], "."}]}], "*)"}], "\[IndentingNewLine]", 
     RowBox[{
      RowBox[{"ta", "+=", "\[Tau]"}], ";", "\[IndentingNewLine]", 
      RowBox[{"xa", "+=", 
       RowBox[{"va", " ", "\[Tau]"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"va", " ", "=", " ", 
       RowBox[{
        RowBox[{"2", " ", 
         RowBox[{"f", "[", "xa", "]"}]}], "-", "va"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"xa", "+=", 
       RowBox[{"va", " ", "\[Tau]"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"(*", 
       RowBox[{"Print", "[", "xa", "]"}], "*)"}], "\[IndentingNewLine]", 
      RowBox[{"(*", " ", 
       RowBox[{
        RowBox[{
         RowBox[{
          RowBox[{
          "The", " ", "last", " ", "value", " ", "before", " ", "overflow", 
           " ", "turned", " ", "out", " ", "to", " ", "be", " ", "1.821048"}],
           "..."}], "*", 
         RowBox[{"10", "^", "174965752"}], " ", "both", " ", "for", 
         "\[IndentingNewLine]", "useMachinePrecision"}], "\[Equal]", 
        RowBox[{"True", " ", "and", " ", "useMachinePrecision"}], "\[Equal]", 
        RowBox[{
         RowBox[{"False", ".", " ", "In"}], " ", "the", " ", "latter", " ", 
         "case", " ", "the", "\[IndentingNewLine]", "number", " ", "of", " ", 
         "the", " ", "further", " ", "digits", " ", "depends", " ", "on", " ",
          "precision"}]}], " ", "*)"}], "  ", "\[IndentingNewLine]", 
      RowBox[{"ta", "+=", "\[Tau]"}], ";", "\[IndentingNewLine]", 
      RowBox[{"state", "[", 
       RowBox[{"xa", ",", "va", ",", "ta"}], "]"}]}]}], " ", 
    RowBox[{"(*", " ", 
     RowBox[{"return", " ", "value"}], " ", "*)"}], "\[IndentingNewLine]", 
    "]"}]}], " ", "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"time", "[", 
    RowBox[{"state", "[", 
     RowBox[{"x_", ",", "v_", ",", "t_"}], "]"}], "]"}], ":=", "t"}], "  ", 
  RowBox[{"(*", " ", 
   RowBox[{"access", " ", "to", " ", "state", " ", "data"}], " ", 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"h", "[", 
    RowBox[{"state", "[", 
     RowBox[{"x_", ",", "v_", ",", "t_"}], "]"}], "]"}], ":=", " ", "x"}], 
  "   ", 
  RowBox[{"(*", " ", 
   RowBox[{"access", " ", "to", " ", "state", " ", "data"}], " ", "*)"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{"Manipulate", "[", 
  RowBox[{
   RowBox[{"Module", "[", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{
      "i", ",", "c0", ",", "c1", ",", "rangeStep", ",", "tMax", ",", "dt", 
       ",", "x0", ",", "t0", ",", "v0", ",", "h0", ",", "s0", ",", "val", ",",
        "valr", ",", "lp", ",", "lpr"}], "}"}], ",", "\[IndentingNewLine]", 
     RowBox[{"(*", " ", 
      RowBox[{
      "The", " ", "basic", " ", "interactive", " ", "functionality", " ", 
       "of", " ", "the", " ", "notebook"}], " ", "*)"}], 
     "\[IndentingNewLine]", 
     RowBox[{
      RowBox[{"c0", "=", 
       RowBox[{"If", "[", 
        RowBox[{"useMachinePrecision", ",", 
         RowBox[{"N", "[", "0", "]"}], ",", 
         RowBox[{"N", "[", 
          RowBox[{"0", ",", "precision"}], "]"}]}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"c1", "=", 
       RowBox[{"If", "[", 
        RowBox[{"useMachinePrecision", ",", 
         RowBox[{"N", "[", "1", "]"}], ",", 
         RowBox[{"N", "[", 
          RowBox[{"1", ",", "precision"}], "]"}]}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"(*", " ", 
       RowBox[{
       "should", " ", "make", " ", "all", " ", "the", " ", "following", " ", 
        "computation", " ", "to", " ", "be", " ", "done", " ", "with", " ", 
        "that", " ", "precision"}], " ", "*)"}], "\[IndentingNewLine]", 
      RowBox[{"t0", "=", "c0"}], ";", "\[IndentingNewLine]", 
      RowBox[{"x0", "=", "c1"}], ";", "\[IndentingNewLine]", 
      RowBox[{"rangeStep", "=", 
       RowBox[{"c1", "/", "100"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"(*", 
       RowBox[{
        RowBox[{"rangeStep", "=", 
         RowBox[{"c1", "*", "0.01"}]}], ";"}], "*)"}], 
      RowBox[{"(*", " ", 
       RowBox[{
        RowBox[{
        "Replacing", " ", "the", " ", "previous", " ", "definition", " ", 
         "by", " ", "the", " ", "present", " ", "one", " ", "lets", " ", 
         "the", " ", "following", "\[IndentingNewLine]", "computation", " ", 
         "no", " ", "longer", " ", "depend", " ", 
         RowBox[{"on", " ", "'"}], 
         RowBox[{"precision", "'"}], " ", 
         RowBox[{
          RowBox[{"(", 
           RowBox[{
           "what", " ", "is", "  ", "n", " ", "o", " ", "t", "  ", "wanted"}],
            ")"}], ".", " ", "The"}], " ", "general", " ", "rule", " ", 
         "seems", " ", "to", "\[IndentingNewLine]", "be", " ", "that", " ", 
         "floating", " ", "point", " ", "numbers"}], ",", " ", 
        RowBox[{
        "written", " ", "with", " ", "a", " ", "decimal", " ", "point", " ", 
         "enforce", " ", "using", " ", "machine", " ", "precision", " ", 
         "\[IndentingNewLine]", "computation", " ", "in", " ", "all", " ", 
         "expressions", " ", "which", " ", "depend", " ", "on", " ", "that", 
         " ", "floating", " ", "point", " ", "number"}]}], " ", "*)"}], 
      "\[IndentingNewLine]", 
      RowBox[{"tMax", "=", 
       RowBox[{"c1", "+", 
        RowBox[{"rangeStep", "*", "range"}]}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"dt", "=", 
       RowBox[{"tMax", "/", "nSteps"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"v0", "=", 
       RowBox[{"f", "[", "x0", "]"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"s0", "=", 
       RowBox[{"state", "[", 
        RowBox[{"x0", ",", "v0", ",", "t0"}], "]"}]}], ";", 
      "\[IndentingNewLine]", 
      RowBox[{"h0", "=", "x0"}], ";", 
      RowBox[{"val", "=", 
       RowBox[{"{", 
        RowBox[{"{", 
         RowBox[{"t0", ",", 
          RowBox[{"dis", "[", "h0", "]"}]}], "}"}], "}"}]}], ";", 
      RowBox[{"i", "=", "0"}], ";", "\[IndentingNewLine]", 
      RowBox[{"While", "[", 
       RowBox[{
        RowBox[{"i", "<", "nSteps"}], ",", 
        RowBox[{
         RowBox[{"s0", "=", 
          RowBox[{"step", "[", 
           RowBox[{"s0", ",", "dt"}], "]"}]}], ";", " ", 
         RowBox[{"t0", "=", 
          RowBox[{"time", "[", "s0", "]"}]}], ";", " ", 
         RowBox[{"h0", "=", 
          RowBox[{"h", "[", "s0", "]"}]}], ";", 
         RowBox[{"val", "=", 
          RowBox[{"Append", "[", 
           RowBox[{"val", ",", 
            RowBox[{"{", 
             RowBox[{"t0", ",", 
              RowBox[{"dis", "[", "h0", "]"}]}], "}"}]}], "]"}]}], ";", 
         RowBox[{"i", "++"}]}]}], "]"}], ";", "\[IndentingNewLine]", 
      RowBox[{"lp", "=", 
       RowBox[{"ListLinePlot", "[", 
        RowBox[{"val", ",", 
         RowBox[{"PlotStyle", "\[Rule]", "Green"}], ",", " ", 
         RowBox[{"PlotRange", "\[Rule]", "All"}], ",", 
         RowBox[{"AxesLabel", "\[Rule]", 
          RowBox[{"{", 
           RowBox[{"t", ",", 
            RowBox[{"log", "[", 
             RowBox[{"1", "+", 
              RowBox[{"log", "[", 
               RowBox[{"h", "[", "t", "]"}], "]"}]}], "]"}]}], "}"}]}], ",", 
         "\[IndentingNewLine]", 
         RowBox[{
         "PlotLabel", "\[Rule]", " ", 
          "\"\<Approximative solution of the exploding equation. \n        \
Red dots mark the reversed trajectory.\n\t\tTry the useMachinePrecision-box ! \
\>\""}]}], "]"}]}], ";", "\[IndentingNewLine]", 
      RowBox[{"valr", "=", 
       RowBox[{"{", 
        RowBox[{"{", 
         RowBox[{"t0", ",", 
          RowBox[{"dis", "[", "h0", "]"}]}], "}"}], "}"}]}], ";", 
      RowBox[{"i", "=", "0"}], ";", "\[IndentingNewLine]", 
      RowBox[{"While", "[", 
       RowBox[{
        RowBox[{"i", "<", "nSteps"}], ",", " ", 
        RowBox[{
         RowBox[{"s0", "=", 
          RowBox[{"step", "[", 
           RowBox[{"s0", ",", 
            RowBox[{"-", "dt"}]}], "]"}]}], ";", " ", 
         RowBox[{"t0", "=", 
          RowBox[{"time", "[", "s0", "]"}]}], ";", 
         RowBox[{"h0", "=", 
          RowBox[{"h", "[", "s0", "]"}]}], ";", 
         RowBox[{"valr", "=", 
          RowBox[{"Append", "[", 
           RowBox[{"valr", ",", 
            RowBox[{"{", 
             RowBox[{"t0", ",", 
              RowBox[{"dis", "[", "h0", "]"}]}], "}"}]}], "]"}]}], ";", 
         RowBox[{"i", "++"}]}]}], "]"}], ";", "\[IndentingNewLine]", 
      RowBox[{"lpr", "=", 
       RowBox[{"ListPlot", "[", 
        RowBox[{"valr", ",", 
         RowBox[{"PlotStyle", "\[Rule]", "Red"}], ",", 
         RowBox[{"PlotRange", "\[Rule]", "All"}]}], "]"}]}], ";", " ", 
      RowBox[{"(*", 
       RowBox[{
       "doing", " ", "a", " ", "list", " ", "plot", " ", "of", " ", "the", 
        " ", "reverse", " ", "motion"}], " ", "*)"}], "\[IndentingNewLine]", 
      RowBox[{"Show", "[", 
       RowBox[{"{", 
        RowBox[{"lp", ",", "lpr"}], "}"}], "]"}]}]}], "]"}], ",", 
   "\[IndentingNewLine]", " ", 
   RowBox[{"{", 
    RowBox[{"useMachinePrecision", ",", 
     RowBox[{"{", 
      RowBox[{"False", ",", "True"}], "}"}]}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"precision", ",", "1400"}], "}"}], ",", "10", ",", "2000"}], 
    "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"range", ",", "1"}], "}"}], ",", 
     RowBox[{"-", "10"}], ",", "2"}], "}"}], ",", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"{", 
      RowBox[{"nSteps", ",", "1000"}], "}"}], ",", "1", ",", "1000", ",", 
     "1"}], "}"}]}], "\[IndentingNewLine]", "]"}]}], "Input",
 CellChangeTimes->{{3.47228127934375*^9, 3.4722812808125*^9}, {
   3.472281457703125*^9, 3.472281465046875*^9}, 3.472282068890625*^9, {
   3.47228213878125*^9, 3.47228215115625*^9}, {3.47228867590625*^9, 
   3.47228873371875*^9}, {3.4722895828125*^9, 3.47228958959375*^9}, {
   3.4722898615*^9, 3.47228987484375*^9}, 3.472297935875*^9, {
   3.47230077003125*^9, 3.472300786984375*^9}, {3.47230134209375*^9, 
   3.47230142075*^9}, {3.472301471046875*^9, 3.47230148403125*^9}, {
   3.4723015439375*^9, 3.472301560625*^9}, 3.472301616453125*^9, 
   3.47230168228125*^9, {3.472301734921875*^9, 3.472301757046875*^9}, 
   3.472301792171875*^9, 3.472301865953125*^9, {3.4723019089375*^9, 
   3.472301932640625*^9}, {3.472301979*^9, 3.472301995828125*^9}, 
   3.47230229521875*^9, 3.47230258134375*^9, {3.472302627890625*^9, 
   3.47230264175*^9}, {3.4723034715*^9, 3.472303492671875*^9}, {
   3.472303655125*^9, 3.47230368115625*^9}, {3.472303866125*^9, 
   3.47230388925*^9}, {3.47230396209375*^9, 3.4723039743125*^9}, {
   3.47230408425*^9, 3.4723040848125*^9}, 3.4723041230625*^9, {
   3.472304427296875*^9, 3.472304428328125*^9}, {3.472304469671875*^9, 
   3.472304501515625*^9}, {3.472304814078125*^9, 3.472304866359375*^9}, 
   3.47230493203125*^9, {3.472304964234375*^9, 3.472304997515625*^9}, 
   3.47230504075*^9, 3.472305071671875*^9, 3.472305105453125*^9, 
   3.472305276609375*^9, {3.47230556621875*^9, 3.47230559609375*^9}, {
   3.4723057789375*^9, 3.472305817765625*^9}, 3.47230587084375*^9, 
   3.472305914921875*^9, {3.472305954625*^9, 3.472305960546875*^9}, {
   3.472306070609375*^9, 3.472306076203125*^9}, 3.4723061728125*^9, 
   3.472306228640625*^9, 3.472306269625*^9, 3.472306596953125*^9, {
   3.47230664609375*^9, 3.472306660671875*^9}, 3.47230688896875*^9, {
   3.472306921875*^9, 3.47230693521875*^9}, {3.472307089765625*^9, 
   3.472307109328125*^9}, {3.47230719553125*^9, 3.472307221984375*^9}, {
   3.47230733484375*^9, 3.472307371390625*^9}, {3.472307409671875*^9, 
   3.472307410828125*^9}, {3.47230747696875*^9, 3.472307500625*^9}, 
   3.4723075889375*^9, {3.47230762746875*^9, 3.472307652703125*^9}, {
   3.47230774971875*^9, 3.472307882328125*^9}, {3.472307918125*^9, 
   3.4723081120625*^9}, {3.4723094690625*^9, 3.47230957921875*^9}, 
   3.47230963909375*^9, {3.472309669203125*^9, 3.4723097671875*^9}, {
   3.47230979809375*^9, 3.472310041578125*^9}, 3.472310345875*^9, {
   3.4723103775*^9, 3.4723104340625*^9}, {3.472310464609375*^9, 
   3.47231047228125*^9}, {3.472310703015625*^9, 3.47231070734375*^9}, 
   3.472311276640625*^9, {3.47231131559375*^9, 3.472311339140625*^9}, {
   3.4723698803125*^9, 3.4723698913125*^9}, {3.472369921640625*^9, 
   3.472369955625*^9}, {3.47237328790625*^9, 3.472373489921875*^9}, {
   3.47237366865625*^9, 3.472373682859375*^9}, {3.472373762453125*^9, 
   3.47237377090625*^9}, {3.472373801203125*^9, 3.472373814734375*^9}, {
   3.472373925890625*^9, 3.47237393025*^9}, {3.47237445528125*^9, 
   3.472374465734375*^9}, {3.472374791375*^9, 3.472374822609375*^9}, {
   3.472375039859375*^9, 3.472375210921875*^9}, {3.472375278015625*^9, 
   3.472375311734375*^9}, {3.4723753441875*^9, 3.472375378171875*^9}, {
   3.472376759390625*^9, 3.472376777765625*^9}, {3.472377692125*^9, 
   3.4723778483125*^9}, {3.4723779700625*^9, 3.472377994609375*^9}, {
   3.4723780915*^9, 3.47237809328125*^9}, {3.47237844990625*^9, 
   3.4723784548125*^9}, {3.472380277140625*^9, 3.47238028646875*^9}, {
   3.472380446640625*^9, 3.47238045240625*^9}, {3.4723807000625*^9, 
   3.472380702328125*^9}, {3.47238074334375*^9, 3.472380767546875*^9}, {
   3.472380861734375*^9, 3.47238086275*^9}, {3.472394328125*^9, 
   3.472394336640625*^9}, 3.472394381859375*^9, {3.472394483390625*^9, 
   3.47239448478125*^9}, {3.472394638546875*^9, 3.47239464490625*^9}, 
   3.472394905234375*^9, {3.472395186703125*^9, 3.472395275953125*^9}, {
   3.47239536115625*^9, 3.472395395375*^9}, {3.472395458796875*^9, 
   3.472395470734375*^9}, {3.47239553465625*^9, 3.472395535453125*^9}, {
   3.47239562128125*^9, 3.47239568359375*^9}, {3.472395725390625*^9, 
   3.472395728234375*^9}, 3.47239579928125*^9, 3.472455663*^9, {
   3.472456136015625*^9, 3.472456173609375*^9}, {3.472459373796875*^9, 
   3.472459383265625*^9}, {3.472459460109375*^9, 3.472459527234375*^9}, 
   3.47245956684375*^9, {3.47245963125*^9, 3.4724596666875*^9}, {
   3.472459891984375*^9, 3.472459895625*^9}, {3.472460151734375*^9, 
   3.472460153890625*^9}, {3.472460198921875*^9, 3.472460213265625*^9}, 
   3.472463274671875*^9, {3.472463601234375*^9, 3.47246360609375*^9}, {
   3.47246378678125*^9, 3.4724637920625*^9}, {3.472463827078125*^9, 
   3.47246384146875*^9}, {3.472463907203125*^9, 3.47246399015625*^9}, {
   3.472464045828125*^9, 3.472464052140625*^9}, 3.472464169421875*^9, {
   3.472464729*^9, 3.4724647610625*^9}, {3.472464813421875*^9, 
   3.472464839140625*^9}, {3.472464904328125*^9, 3.472464923953125*^9}, {
   3.472464970609375*^9, 3.472465129390625*^9}, {3.472465266109375*^9, 
   3.4724652828125*^9}, {3.4724653915*^9, 3.4724654155625*^9}, 
   3.472465541703125*^9, {3.47246600975*^9, 3.47246601109375*^9}, 
   3.47246611896875*^9, {3.47246625928125*^9, 3.47246626653125*^9}, {
   3.47246638684375*^9, 3.472466427609375*^9}, 3.4724665603125*^9, {
   3.472466647703125*^9, 3.472466650578125*^9}, {3.472468614171875*^9, 
   3.472468640859375*^9}, {3.472468681640625*^9, 3.472468686234375*^9}, {
   3.472468787171875*^9, 3.47246892165625*^9}, {3.472468951765625*^9, 
   3.47246895675*^9}, {3.4724689905*^9, 3.4724689951875*^9}, {
   3.4724691769375*^9, 3.472469187109375*^9}, {3.472469255734375*^9, 
   3.47246927928125*^9}, 3.47247739471875*^9, 3.4724775956875*^9, {
   3.472477998734375*^9, 3.472478000625*^9}, 3.472478942078125*^9, {
   3.47247926496875*^9, 3.4724792709375*^9}, {3.4724796144375*^9, 
   3.47247962290625*^9}, 3.47247977265625*^9, {3.47247982121875*^9, 
   3.472479861109375*^9}, {3.472480026625*^9, 3.472480028890625*^9}, {
   3.4724801294375*^9, 3.472480164328125*^9}, {3.472480332171875*^9, 
   3.47248034565625*^9}, {3.472481117*^9, 3.4724811594375*^9}, {
   3.4724813323125*^9, 3.472481355171875*^9}, {3.47248140403125*^9, 
   3.472481438546875*^9}, {3.472481583890625*^9, 3.47248159959375*^9}, {
   3.472481741203125*^9, 3.4724817690625*^9}, {3.472482003703125*^9, 
   3.4724820341875*^9}, {3.472482320203125*^9, 3.472482352359375*^9}, {
   3.472482382515625*^9, 3.4724823953125*^9}, {3.47248247171875*^9, 
   3.4724825835625*^9}, {3.472482613890625*^9, 3.47248277890625*^9}, {
   3.472483005859375*^9, 3.47248300675*^9}, {3.472483214859375*^9, 
   3.472483216109375*^9}, {3.47248361321875*^9, 3.47248362221875*^9}, {
   3.47248365575*^9, 3.47248365640625*^9}, {3.472483707453125*^9, 
   3.47248375165625*^9}, {3.472484074703125*^9, 3.472484104109375*^9}, {
   3.472484209484375*^9, 3.472484248*^9}, {3.47248430134375*^9, 
   3.472484358890625*^9}, {3.47248439784375*^9, 3.472484433*^9}, {
   3.472484488640625*^9, 3.4724845003125*^9}, {3.472484575734375*^9, 
   3.4724846299375*^9}, {3.47248466275*^9, 3.472484683890625*^9}, {
   3.4724864056875*^9, 3.472486465640625*^9}, {3.472486518671875*^9, 
   3.472486523875*^9}, {3.472486573734375*^9, 3.4724865786875*^9}, {
   3.47248663384375*^9, 3.47248663928125*^9}, {3.47248674271875*^9, 
   3.4724867671875*^9}}],

Cell[BoxData[
 TagBox[
  StyleBox[
   DynamicModuleBox[{$CellContext`nSteps$$ = 1000, $CellContext`precision$$ = 
    1400, $CellContext`range$$ = 1, $CellContext`useMachinePrecision$$ = 
    False, Typeset`show$$ = True, Typeset`bookmarkList$$ = {}, 
    Typeset`bookmarkMode$$ = "Menu", Typeset`animator$$, Typeset`animvar$$ = 
    1, Typeset`name$$ = "\"untitled\"", Typeset`specs$$ = {{
      Hold[$CellContext`useMachinePrecision$$], {False, True}}, {{
       Hold[$CellContext`precision$$], 1400}, 10, 2000}, {{
       Hold[$CellContext`range$$], 1}, -10, 2}, {{
       Hold[$CellContext`nSteps$$], 1000}, 1, 1000, 1}}, Typeset`size$$ = {
    360., {138., 142.}}, Typeset`update$$ = 0, Typeset`initDone$$, 
    Typeset`skipInitDone$$ = True, $CellContext`useMachinePrecision$585$$ = 
    False, $CellContext`precision$590$$ = 0, $CellContext`range$591$$ = 
    0, $CellContext`nSteps$592$$ = 0}, 
    DynamicBox[Manipulate`ManipulateBoxes[
     1, StandardForm, 
      "Variables" :> {$CellContext`nSteps$$ = 1000, $CellContext`precision$$ = 
        1400, $CellContext`range$$ = 1, $CellContext`useMachinePrecision$$ = 
        False}, "ControllerVariables" :> {
        Hold[$CellContext`useMachinePrecision$$, \
$CellContext`useMachinePrecision$585$$, False], 
        Hold[$CellContext`precision$$, $CellContext`precision$590$$, 0], 
        Hold[$CellContext`range$$, $CellContext`range$591$$, 0], 
        Hold[$CellContext`nSteps$$, $CellContext`nSteps$592$$, 0]}, 
      "OtherVariables" :> {
       Typeset`show$$, Typeset`bookmarkList$$, Typeset`bookmarkMode$$, 
        Typeset`animator$$, Typeset`animvar$$, Typeset`name$$, 
        Typeset`specs$$, Typeset`size$$, Typeset`update$$, Typeset`initDone$$,
         Typeset`skipInitDone$$}, "Body" :> 
      Module[{$CellContext`i$, $CellContext`c0$, $CellContext`c1$, \
$CellContext`rangeStep$, $CellContext`tMax$, $CellContext`dt$, \
$CellContext`x0$, $CellContext`t0$, $CellContext`v0$, $CellContext`h0$, \
$CellContext`s0$, $CellContext`val$, $CellContext`valr$, $CellContext`lp$, \
$CellContext`lpr$}, $CellContext`c0$ = If[$CellContext`useMachinePrecision$$, 
           N[0], 
           N[0, $CellContext`precision$$]]; $CellContext`c1$ = 
         If[$CellContext`useMachinePrecision$$, 
           N[1], 
           N[
           1, $CellContext`precision$$]]; $CellContext`t0$ = $CellContext`c0$; \
$CellContext`x0$ = $CellContext`c1$; $CellContext`rangeStep$ = \
$CellContext`c1$/
          100; $CellContext`tMax$ = $CellContext`c1$ + \
$CellContext`rangeStep$ $CellContext`range$$; $CellContext`dt$ = \
$CellContext`tMax$/$CellContext`nSteps$$; $CellContext`v0$ = \
$CellContext`f[$CellContext`x0$]; $CellContext`s0$ = \
$CellContext`state[$CellContext`x0$, $CellContext`v0$, $CellContext`t0$]; \
$CellContext`h0$ = $CellContext`x0$; $CellContext`val$ = {{$CellContext`t0$, 
            $CellContext`dis[$CellContext`h0$]}}; $CellContext`i$ = 0; 
        While[$CellContext`i$ < $CellContext`nSteps$$, $CellContext`s0$ = \
$CellContext`step[$CellContext`s0$, $CellContext`dt$]; $CellContext`t0$ = \
$CellContext`time[$CellContext`s0$]; $CellContext`h0$ = \
$CellContext`h[$CellContext`s0$]; $CellContext`val$ = 
           Append[$CellContext`val$, {$CellContext`t0$, 
              $CellContext`dis[$CellContext`h0$]}]; 
          Increment[$CellContext`i$]]; $CellContext`lp$ = 
         ListLinePlot[$CellContext`val$, PlotStyle -> Green, PlotRange -> All,
            AxesLabel -> {$CellContext`t, 
             $CellContext`log[1 + $CellContext`log[
                $CellContext`h[$CellContext`t]]]}, PlotLabel -> 
           "Approximative solution of the exploding equation. \n        Red \
dots mark the reversed trajectory.\n\t\tTry the useMachinePrecision-box ! "]; \
$CellContext`valr$ = {{$CellContext`t0$, 
            $CellContext`dis[$CellContext`h0$]}}; $CellContext`i$ = 0; 
        While[$CellContext`i$ < $CellContext`nSteps$$, $CellContext`s0$ = \
$CellContext`step[$CellContext`s0$, -$CellContext`dt$]; $CellContext`t0$ = \
$CellContext`time[$CellContext`s0$]; $CellContext`h0$ = \
$CellContext`h[$CellContext`s0$]; $CellContext`valr$ = 
           Append[$CellContext`valr$, {$CellContext`t0$, 
              $CellContext`dis[$CellContext`h0$]}]; 
          Increment[$CellContext`i$]]; $CellContext`lpr$ = 
         ListPlot[$CellContext`valr$, PlotStyle -> Red, PlotRange -> All]; 
        Show[{$CellContext`lp$, $CellContext`lpr$}]], 
      "Specifications" :> {{$CellContext`useMachinePrecision$$, {
         False, True}}, {{$CellContext`precision$$, 1400}, 10, 
         2000}, {{$CellContext`range$$, 1}, -10, 
         2}, {{$CellContext`nSteps$$, 1000}, 1, 1000, 1}}, "Options" :> {}, 
      "DefaultOptions" :> {}],
     ImageSizeCache->{407., {219., 224.}},
     SingleEvaluation->True],
    Deinitialization:>None,
    DynamicModuleValues:>{},
    SynchronousInitialization->True,
    UnsavedVariables:>{Typeset`initDone$$},
    UntrackedVariables:>{Typeset`size$$}], "Manipulate",
   Deployed->True,
   StripOnInput->False],
  Manipulate`InterpretManipulate[1]]], "Output",
 CellChangeTimes->{3.472487216546875*^9}]
}, Open  ]],

Cell[CellGroupData[{

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{
  "\"\<Case where machine precision is superior\>\"", "\[RuleDelayed]", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"nSteps", "=", "49"}], ",", 
     RowBox[{"precision", "=", "20.`"}], ",", 
     RowBox[{"range", "=", "1"}], ",", 
     RowBox[{"useMachinePrecision", "=", "False"}]}], "}"}]}], "}"}]], "Input",
 GeneratedCell->False,
 CellAutoOverwrite->False,
 CellChangeTimes->{3.472483481265625*^9}],

Cell[BoxData[
 RowBox[{"{", 
  RowBox[{"\<\"Case where machine precision is superior\"\>", 
   "\[RuleDelayed]", 
   RowBox[{"{", 
    RowBox[{
     RowBox[{"nSteps", "=", "49"}], ",", 
     RowBox[{"precision", "=", "20.`"}], ",", 
     RowBox[{"range", "=", "1"}], ",", 
     RowBox[{"useMachinePrecision", "=", "False"}]}], "}"}]}], 
  "}"}]], "Output",
 CellChangeTimes->{3.472487216625*^9}]
}, Open  ]]
}, Open  ]]
},
WindowToolbars->"EditBar",
WindowSize->{1086, 779},
WindowMargins->{{0, Automatic}, {Automatic, 0}},
PrintingCopies->1,
PrintingPageRange->{Automatic, Automatic},
ShowSelection->True,
CellLabelAutoDelete->True,
ShowCellTags->True,
FrontEndVersion->"7.0 for Microsoft Windows (32-bit) (January 30, 2009)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[567, 22, 174, 2, 83, "Title"],
Cell[744, 26, 286, 4, 49, "Subtitle"],
Cell[1033, 32, 4021, 98, 176, "Text"],
Cell[5057, 132, 4847, 81, 52, "Input"],
Cell[CellGroupData[{
Cell[9929, 217, 18065, 369, 952, "Input"],
Cell[27997, 588, 5130, 90, 460, "Output"]
}, Open  ]],
Cell[CellGroupData[{
Cell[33164, 683, 443, 12, 31, "Input"],
Cell[33610, 697, 395, 11, 30, "Output"]
}, Open  ]]
}, Open  ]]
}
]
*)

(* End of internal cache information *)