First-Order Ordinary Differential Equations

Background--simple iteration

Suppose a function,  F[i], changes proportional to its current size, i.e.,  F[i+1] = F[i] + αF[i],

ExampleFunction[i_,  alpha_]  :=  
      ExampleFunction[i - 1, alpha]  +  
        alpha*ExampleFunction[i - 1, alpha]

What would happen if the following functions were evaluated? (Note: if you execute the next step you may have to abort the calculation.)

ExampleFunction[25, 0.25] 

    ExampleFunction[25, -0.125]

It is clear that the function needs some value at some time (an initial condition) from which it obtains all its other values:

ExampleFunction[0, 0.25]  =  π/4

ExampleFunction[18, 0.25]

This function is fairly inefficient, it calculates the first value about 18 times before it returns the answer, the following function sets the initial value and remembers what "trajectory" it is on--i,e., the trajectory is determined from the start

GrowsPropToSize[i_ ,  alpha_ ,  F0_]  :=  
      If[i == 0, GrowsPropToSize[0, alpha, F0] = F0, 
        GrowsPropToSize[i, alpha, F0]  =  
          GrowsPropToSize[i - 1, alpha, F0]  +  
            alpha*GrowsPropToSize[i - 1, alpha, F0]  ]

For example:

Table[GrowsPropToSize[i,  .01, 1], {i, 18}]

Might as well write a function to calculate a vector representing trajectory, here is an implementation to compute a trajectory vector of length 300

Trajectory[alpha_,  F0_]  :=  
      Table[GrowsPropToSize[i, alpha, F0], {i, 300}]

ListPlot[Trajectory[0.01, 1], PlotJoined -> True]

<< Graphics`MultipleListPlot`

Trajectory[alpha_,  F0_]  :=  
      Table[GrowsPropToSize[i, alpha, F0], {i, 300}]

Plotting a bunch of curves for the same α value, but each corresponding to a different initial value, demonstrates that a point in space "belongs" to a curve.

MultipleListPlot[Trajectory[ .01, - .5], Trajectory[ .01,  .5], 
      Trajectory[ .01, 1], Trajectory[ .01, 1.5], 
      PlotJoined -> True]

Making a similar plot for a family of curves corresponding to a negative α value gives

MultipleListPlot[Trajectory[- .01, - .5], 
      Trajectory[- .01,  .5], Trajectory[- .01, 1], 
      Trajectory[- .01, 1.5], PlotJoined -> True]

Background- Forward Differencing

Create a function to return a list of values by forward differencing with a function (these examples were modified from those found in ``Computer Science with Mathematica'' by Roman E. Maeder, Cambridge University Press, (2000).)

The Module function makes the variables inside local variables.

ForwardDifferenceListV1[AFunction_ ,  InitialValue_ ,  delta_,  
        ListLength_Integer]  := 
Module[{TheResultList  =  {InitialValue}, TheValue = InitialValue}, 
Do[
          TheValue  =  TheValue  +  delta AFunction[TheValue];  
          AppendTo[TheResultList, TheValue], {ListLength}]; 
        TheResultList]

exampleFunction[x_]  :=  0.1 x

result  =  
        ForwardDifferenceListV1[exampleFunction,  1,  0.01,  
          500];

result // Short

ListPlot[result, PlotJoined -> True]

Write another version of this forward difference function that returns a list of values
and the "x" value for subsequent use in ListPlot, this one will take (Subscript[x, o]) and y((Subscript[x, o])) as an argument in a list

Clear[ForwardDifferenceListV2]

ForwardDifferenceListV2[AFunction_ , x0_ ,  fx0_ ,  delta_,  
        Xlast_]  := 
Module[{TheResultList  =  {{x0, 
                fx0}}, TheValue = fx0, 
          CurrentX   =  x0}, 
While[
          CurrentX  <  Xlast, 
CurrentX  = 
            CurrentX  +  delta; 
 
          TheValue =  TheValue  +  delta AFunction[TheValue];  
          AppendTo[
            TheResultList, {CurrentX, 
              TheValue}]]; 
TheResultList]

result  =  
        ForwardDifferenceListV2[exampleFunction, 0, 1,  0.01, 
          4];

result // Short

ListPlot[result]

Background-Repeated Operations on a Function

Because each iteration is the same, the iteration can be considered a functional operation, for the case considered above,
{(Subscript[x, i + 1]), (Subscript[y, i + 1])} = {(Subscript[x, i])+ δ, (Subscript[y, i])+ δ f((Subscript[y, i]))}.  Therefore a "Incrementing Operator" can be obtained that updates the values:

StepOnce[{x_, y_},  AFunction_,  delta_]  :=  {x +  delta,  
        y  +  delta AFunction[y]}

Then, the trajectory should be obtained from:
    {{xo,yo},StepOnce[{xo,yo}], StepOnce[StepOnce[{xo,yo}]], ⃛⃛⃛}
    This is what the built-in Mathematica function NestList[function, initialvalue,depth] does:

OurStepOnce[{x_ ,  y_}]  :=  
      StepOnce[{x, y}, exampleFunction,  0.01]

result  =  NestList[OurStepOnce, {0, 1}, 400];

ListPlot[result]

Using a Mathematica trick of a ``pure function'' one can eliminate the intervening function (OurStepOnce) definition:

ListPlot[
      NestList[StepOnce[#, exampleFunction, 0.01] &, {0, 1}, 400]]

DisplayLater  =  
        DisplayFunction -> Identity;
DisplayNow  =  
        DisplayFunction -> $DisplayFunction;

lp[i_]  := 
        ListPlot[NestList[StepOnce[#, exampleFunction, 0.01] &, {0, i}, 400], 
          DisplayLater];

This will plot a family of related curves, each for a different starting value of the iterated function:

Show[Table[lp[i], {i, -4, 4,  .5}], DisplayNow]

To summarize what was done up to now, we've seen how a given function can be changed incrementally by stepping forward the independent variables and calculating a corresponding change in the function's value. By doing so, we trace out trajectories in space, the paths of which depend on the starting values of the independent variables.

Visualizing Geometry of First-Order ODEs

Newton's law of cooling (dT/dt)= -k(T - (Subscript[T, o])) can be written in the non-dimensional form  d(Θ/d)τ= 1-Θ

In the general case, d(Θ/d)τ will depend on both Θ and t, i.e., d(Θ/d)τ = d(Θ/d)τ(Θ,t). This the equation of a surface in three dimensions, as shown in the following plot (in this specific case there is no t dependence):

\(Plot3D[
      1 - Θ, \ {tau, \ \(-1\), 
        1}, \ {Θ, \ \(-2\), 3}, 
      AxesLabel -> {"τ", "Θ", \*""d(Θ/d)τ""}]\)

Plot the vector (dτ,dΘ) = dτ(1, d(Θ/d)τ) at each point:
We want to make a plot ofd(Θ/d)τin the Θ-τ plane. We can do so by plotting vectors of the form {dτ, dΘ} = dτ{1, d(Θ/d)τ} which will be proportional to the vector {1, 1-Θ}. This is done as follows:

<< Graphics`PlotField`

PlotVectorField[{1, 1 - Θ}, {tau,  0, 
        4},  {Θ, -2, 4}, Axes -> True, 
      AxesLabel -> {"τ", "Θ"}]

Note in the equations and the plot thatd(Θ/d)τis independent of τ.

Slightly more complicated example: (dy/dt)= y sin((yt/(1  +  t  + y))),
(dt,dy) = dt(1,ysin(yt/(1  +  t  + y))))

As in the simpler example above we first plot the derivative's value as a surface using Plot3D, then we represent the behavior as a vector field

\(Plot3D[y\ \ Sin[\ \(y\ t\)\/\(t + y + 1\)], {t, 0, 10}, {y, 0, 10}, 
      AxesLabel -> {"t", "y", \*""\!\(dy\/dt\)""}, 
      PlotPoints -> 40]\)

PlotVectorField[{1, y  Sin[ ((y t)/(t + y + 1))]}, {t,  0, 
        10},  {y, 0, 10}, Axes -> True, 
      AxesLabel -> {"t", "y"}]

To summarize this part, we have seen how first-order differential equations have associated trajectories in the plane of the dependent variables, analogous to what we simulated above by incrementing a certain functional relationship. Numerical differential equation solvers use similar techniques.

Using Mathematica's DSolve function

Mathematica's DSolve function finds closed-form expressions for solutions to differential equations, when possible. There is a related function called NDSolve that finds numerical solutions that can be used when DSolve gives up. Here are some examples of using DSolve:

dsol  =  
      DSolve[ y'[x]   + x *y[x]  == 0, y[x], x]

Note that the solution is given as a rule, just like for the function Solve. Because no initial condition was specified, the solution involves an unknown constant, C[1].

dsol  =  
      DSolve[ {y'[x]   +  Sin[x] *y[x]  == 0, 
          y[0] == 1}, y[x], x]

In this case an initial condition was specified for the differential equation, so there is no undetermined constant in the solution. The next statement extracts y(x) for plotting...

exactplot  = Plot[y[x] /. Flatten[dsol], {x, 0, 10}]

Compare this to the forward differencing scheme:
Recall how
exampleFunction[x_]  :=  0.1 x
StepOnce[{x_, y_},  AFunction_,  delta_]  :=  {x +  delta,  
          y  +  delta AFunction[y]}
OurStepOnce[{x_ ,  y_}]  :=  
        StepOnce[{x, y}, exampleFunction,  0.01]
result  =  NestList[OurStepOnce, {0, 1}, 400];
ListPlot[result]
were used to create a plot for a function that grew at a rate that was 0.1 times its current size, try this for the ODE that was solved for above, let the new function be y':

NewExampleFunction[x_ ,  y_]  :=  -Sin[x] y

NewStepOnce[{x_,  y_},  AFunctionXY_ ,  
        delta_]  :=  {x  +  delta,  
        y  +  delta AFunctionXY[x, y]}

NewOurStepOnce[{x_,  y_}]  :=  
      NewStepOnce[{x, y}, NewExampleFunction, 0.01]

result  =  NestList[NewOurStepOnce, {0, 1}, 1000];

result // Short

forwarddifferenceplot  = 
      ListPlot[result, PlotStyle -> {Hue[1]}]

Now we superpose the exact solution with that obtained by the forward-differencing approximation.

Show[forwarddifferenceplot, exactplot]