Code from the Appendix

Supporting Interval Functions

mid[X_] := (Min[X] + Max[X])/2;
diam[X_] := Max[X] - Min[X];
diam[{X__Interval}]  :=  
        Max[diam  /@  {X}];
MidRad[x_, r_] := 
        x + Interval[{-1, 1} ] r;
IntervalMin[{Interval[{a_,  b_}],  
            Interval[{c_,  d_}]}]   :=   Interval[{Min[a, c],  
            Min[b, d]}];
IntervalMin[{}]   :=  ∞;

Count of Digits Agreement and Interval Pretty Printer

DigitsAgreeCount[a_, 
          b_] := (prec = 
            Ceiling@Min[Precision /@ {a, b}]; {{ad, ae}, {bd, 
                be}} = RealDigits[#, 10, prec] & /@ {a, b}; 
          If[ae ≠ be ∨ a b ≤ 0, Return[0]]; 
          If[ad == bd, Return@Length[ad]]; {{com}} = 
            Position[MapThread[Equal, {ad, bd}], False, 1, 1] - 1; 
          com);
DigitsAgreeCount[Interval[{a_, b_}]] := DigitsAgreeCount[a, b]; 
    IntervalForm[
        Interval[{a_, 
            b_}]] := (If[(com = DigitsAgreeCount[a, b]) == 0, 
          Return@Interval[{a, b}]]; 
        start = Sign[a] N[
              FromDigits@{ad[[
                    Range@com]], 1}, com]; {low, 
            up} = SequenceForm @@ Take[#, {com + 1, prec}] & /@ {ad, bd}; 
        If[ae == 0, start /= 10; ae++]; 
        SequenceForm[
          DisplayForm@SubsuperscriptBox[NumberForm@start, low, up], 
          If[ae ≠ 1, 
            Sequence @@ {" × ", 
                DisplayForm@
                  SuperscriptBox[10, ae - 1]}, ""]])

Reliable Photon Trajectory (Chapter 2)

Options[
          ReliableTrajectory]  :=  {StartIntervalPrecision  -> 
            Automatic, 
          AccuracyGoal  ->  12};
\(\(ReliableTrajectory[p_, v_, tMax_, \ opts___Rule] := 
        Module[{error = ∞, ϵ, s0, \ s, P, V, t, Trem, 
            path, S, 
            T}, 
{ϵ, s, 
              s0}\  = \({10. ^\((\(-AccuracyGoal\))\), AccuracyGoal, \ 
                  StartIntervalPrecision} /. {opts}\) /. 
              Options[ReliableTrajectory]; 
If[
            s0 === Automatic, \ s0\  = \ s]; 
s = s0; 
          wp = Max[17, s + 2]; 
While[
            error > ϵ, 
P = 
              N[\((MidRad[#, 10\^\(-s\)] &)\) /@ p, 
                wp]; 
V = 
              N[\((MidRad[#, 10\^\(-s\)] &)\) /@ v, 
                wp]; 
path = {P}; 
Trem = 
              Interval[tMax]; 
While[Trem > 0, 
              M = Round[P + 2  V/3\ ]; 
S = 
                t /. \((Solve[\((P + t\ V - M)\) . \((P + 
                              t\ V - M)\) == 1/9, 
                      t])\); 
If[
                FreeQ[S, 
                  Power[Interval[{_?Negative, \ _?
                          Positive}], _]], 
\ \ \ \ \ \ \ \ \ \ \ T = IntervalMin[Cases[S, _?Positive]], 
                Break[]]; 
Which[
T ≤ Trem, P += T\ V; V = H[P - M] . V; \ 
                Trem -= T, 
T > 
                    Trem\  && \ \ Trem ≥ 2/3, P += 2  V/3; \ 
                Trem -= 2/3, 
T > Trem\  && \ Trem < 2/3, 
                P += Trem\ V; Trem = 0, 
True, \ 
                Break[]]; 
AppendTo[path, 
                P]; 
If[
                Precision\ [\ {Trem, \ P, \ V, \ T}] < \ ag, \ 
                Break[]]]; 
wp\  = 
              Max[17, \((\(++s\))\) + 2]; 
error = 
              diam[P + 
                  Table[MidRad[\(-Max[Abs[Trem]]\), 
                      Max[Abs[Trem]]], {2}]]]; 
Print[
            StringForm[\*""Initial condition interval radius is (10^(-``))."", s]]; 
path];\)\)

Session p. 42/43

Norm[
        Last@ReliableTrajectory[{(1/2), (1/10)}, {1, 0}, 10, 
            AccuracyGoal -> 12]] // IntervalForm

Norm[
        Last@ReliableTrajectory[{(1/2), (1/10)}, {1, 0}, 10, 
            AccuracyGoal -> 100, StartIntervalPrecision -> 127]] // 
      IntervalForm