Higher-Order Ordinary Differential Equations

Background: Another example of for Forward Differencing

Recall how we used forward finite differencing to simulate the behavior of a function that changed proportional to its current size in Lecture 19.  Consider now a function that changes "how fast it changes" proportional to its current change and its current value--in other words its current acceleration is proportional to its velocity and to its size:

Let's work out how to find a finite differencing function:

This is the current change or approximation to velocity

CurrentChangePerDelta[F_,  
        i_,  Δ_]  :=  ((F[i + 1]  -  F[i])/Δ)

This is the current change in change or approximation to acceleration

CurrentChangeinCurrentChangeperDelta[F_,  
        i_,  Δ_]  :=  
Simplify[((CurrentChangePerDelta[F, i + 1, Δ]  -  CurrentChangePerDelta[F, i, Δ])/Δ)]

Our model is that the acceleration is proportional to  size of the current function and its velocity, let these proportions be: -α and -β

DifferenceRelation  =  
      CurrentChangeinCurrentChangeperDelta[F, 
            i, Δ]  +  β  CurrentChangePerDelta[F, 
              i, Δ] +  α F[i] == 0

Solve this for the "latest" values

ForDiffSol  =  
      Solve[DifferenceRelation, F[i + 2]] // Flatten

Replace to find the form of the solution

ForDiffSolV2  =  ForDiffSol /. i ->  j - 2

Notice that this forward differnce needs TWO consectutive past values before it can calculate the current value, create a function to Appends the current value to a list by using the last two values:

The fact that TWO consecutive values are needed is not surprising. Because this iteration procedure is giving an approximation to the solution of a second-order ODE, we need to make a numerical approximation to a second derivative. THREE points—the two consecutive ones and the current one—are needed to do this. (If only two points were used, you could only compute the slope of the straight line connecting the points; if three points are used, a circle can be fit to the three points and the inverse of its radius gives the curvature.)

GrowListGeneral[
        ValuesList_List,  Δ_ ,  α_ ,  β_]  := 
      Module[{Minus1 = ValuesList[[-1]],  
          Minus2  =  ValuesList[[-2]]}, 
Append[
          ValuesList, 
2*Minus1  -  
            Minus2  +  Δ *(β*(Minus2  -  
                        Minus1)  - α*Δ*
                    Minus2)]]

result  =  GrowListGeneral[{1, 1},  .001, 1,  .1]

result  =  GrowListGeneral[result,  .001, 1,  .1]

Define a function for specific parameters of the General case, and use it to generate a sequence of length 20

GrowListSpecific[InitialList_List]   :=  
      GrowListGeneral[InitialList,  .001, 1,  .1]

Nest[GrowListSpecific, {1, 1}, 20]

Visualize results (it takes about 45 seconds to visualize 20000 iterations)

ListPlot[Nest[GrowListSpecific, {1, 1}, 20000]]

Change parameters for Growth Function:

GrowListSpecific[InitialList_List]  :=  
      GrowListGeneral[InitialList,  .001, 1, 0]

ListPlot[Nest[GrowListSpecific, {1, 1}, 20000]]

Second-Order Linear Homogeneous ODEs with Constant Coefficients, Analysis of the Solution Basis

Analysis of basis solutions to  y'' + βy' + γy = 0 in terms of constant coefficients β and γ

First write a general expression for this homogeneous ODE:

TheODE[function_,  var_]  :=  
      D[function[var], {var, 2}]  +  β D[function[var], 
            var]  +  γ function[var]

TheODE[y, x]

Guess a solution and substitute it into the left-hand side of the ODE:

TheGuess[x_]  :=  Exp[λ x]

TheODE[TheGuess, x]

This will be a solution when the resulting quadratic expression in λ is equal to 0:

LambaSolution  =  
      Solve[TheODE[TheGuess, x] == 0, λ]

The two roots λ+ and λ+ are:

LambdaPlus =  λ /. Flatten[
            LambaSolution][[2]]

LambdaMinus =  λ /. Flatten[
            LambaSolution][[1]]

Assuming that β and γ are real, the solutions can be characterized by the roots of the quadratic equation. That is, our solution is known to be (e^λ)t:  the solution monotonically grows or shrinks in time if the roots are real-positive or real-negative. The condition that the roots are real is γ <(( (β^2))/4)

If the roots have an imaginary part, the solutions can oscillate. Whether the oscillation amplitudes grow or shrink depends on whether the real part of λ is positive or negative.

We now do some calculations to make an annotated map on the β–γ plane of solution scenarios for the λ values:

ComplexReal  =  
      Plot[β^2/4, {β, -1, 1}, 
        AxesLabel -> {"β", "γ"}]

ComplexRealAnnote  = 
      Show[ComplexReal, 
        Graphics[
          Text["Complex\nCongugate\nRoots", {0.25, 0.25}, {-1, 1}]], 
        Graphics[Text["Real Roots", {0.75, 0.05}]]]

If the roots complex, then the sign of the real part is determined only by the sign of β; i.e., λ = ((-β)/2)± (Sqrt[((((β/2)))^2)- γ])

ComplexPosNeg  = 
      ParametricPlot[{0, t}, {t, 0,  .25}, 
        PlotStyle -> {Thickness[0.015], Hue[0]}, 
        DisplayFunction -> Identity]

ComplexPosNegAnnote  =  
      Show[ComplexPosNeg, 
        Graphics[
          Text[StyleForm["Positive\nReal\nPart", 
              FontColor -> Hue[0]], {- .5, 0.15}, {-1, 1}]], 
        Graphics[
          Text[StyleForm["Negative\nReal\nPart", 
              FontColor -> Hue[0]], { .5, 0.15}, {1, 1}]], 
        DisplayFunction -> $DisplayFunction]

ComplexPlot  = Show[ComplexRealAnnote, ComplexPosNegAnnote]

Find the conditions where the real roots are positive and/or negative

Reduce[{LambdaPlus  > 0, LambdaMinus > 0}]

AnnotePosRealRoots  = 
      Graphics[Text[
          StyleForm["Positive Roots", 
            FontColor -> Hue[ .6]], {-1.0, 0.025}, {-1, 
            0}]]

Reduce[{LambdaPlus  > 0, LambdaMinus < 0}]

MixedRealRoots  =  
      Plot[0, {t, -1, 1}, PlotStyle -> {Hue[0.6], Thickness[0.015]}, 
        DisplayFunction -> Identity]
AnnoteMixedRealRoots  = 
      Show[MixedRealRoots, 
        Graphics[
          Text[StyleForm["Mixed Real Roots", 
              FontColor -> Hue[ .6]], {0.2, -0.1}, {-1, 0}]], 
        DisplayFunction -> $DisplayFunction]

Reduce[{LambdaPlus  < 0, LambdaMinus < 0}]

AnnoteNegRealRoots  = 
      Graphics[Text[
          StyleForm["Negative Roots", FontColor -> Hue[ .6]], {1.0, 
            0.025}, {1, 0}]]

Show[ComplexPlot, AnnotePosRealRoots, AnnoteMixedRealRoots, 
      AnnoteNegRealRoots]

Determination of Specific Solution using Boundary Values

Second order ODEs require that two conditions  be specified to generate a particular solution.

Example of y(0) = 0 and y(L)=1
The general solution will have the form:

GeneralSolution[x_]  :=  
      CPlus Exp[LambdaPlus x]  +  CMinus Exp[LambdaMinus x]

Apply the two boundary conditions and solve the resulting equations for constants CPlus and CMinus:

SolutionOne  =  
      Solve[{GeneralSolution[0] == 0, GeneralSolution[L] == 1}, {CPlus, 
          CMinus}]

Write the resulting solution:

SpecificSolutionOne  =  
      Simplify[GeneralSolution[x] /. Flatten[SolutionOne]]

Second example with different form of boundary condition:  y(0) = 1 and y'(0)=0

DGen  =  D[GeneralSolution[x], x]

Now the constants CPlus and CMinus are found by solving:

SolutionTwo  =  
      Solve[{GeneralSolution[0] == 
            1, (DGen /. x -> 0) == 0}, {CPlus, 
          CMinus}]

{{CPlus -> (1/2) + (β/(2 (Sqrt[(β^2) - 4 γ]))), 
        CMinus -> -((β - (Sqrt[(β^2) - 4 γ]))/(2 (Sqrt[(β^2) - 4 γ])))}}

And the new solution is:

SpecificSolutionTwo  =  
      Simplify[GeneralSolution[x] /. Flatten[SolutionTwo]]

Example of Higher-Order equation and Visualization of Solutions:
The Beam Equation

Visualizing Beam Deflections:

Set up the ODE solution (we will specify a unit beam stiffness) EI = 1

BeamEquation[y_ , x_ ,  w_,  BC1_ ,  BC2_]  :=  
      DSolve[Flatten[{y''''[x]  ==  w[x],  BC1,  BC2}], y[x], x] // 
        Flatten

Set up some typical boundary conditions:

Clamped[y_ ,  x_ ,  position_,  
        slope_]  :=  {y[x]  ==  position,  y'[x]  ==  
          slope}
PointLoad[y_,  x_,  position_,  
        moment_]  :=  {y[x] ==  position,  y''[x]  ==  
          moment}
FreeEnd[y_ ,  
        x_]  :=  {y''[x] == 0,  y'''[x] == 
          0}

noload[x_]  :=  0

BeamEquation[y, x, noload, Clamped[y, 0, 0, 0], 
      PointLoad[y, 1, - .1, 0]]

Clamped Beam, loaded at the end

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, noload, Clamped[y, 0, 0, 0], 
                PointLoad[y, 1, - .25, 0]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]

Clamped Beam, Free end, unit applied load

unitload[x_]  :=  1

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, unitload, Clamped[y, 0, 0, 0], 
                FreeEnd[y, 1]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]

Clamped Beam, Point load at end, Point load at Middle

midload[x_]  :=  -10 DiracDelta[x  -  1/2]

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, midload, Clamped[y, 0, 0, 0], 
                PointLoad[y, 1, 0, 0]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]

Point Loaded on both ends, loaded in the middle as above

midload[x_]  :=  -10 DiracDelta[x  -  1/2]

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, midload, PointLoad[y, 0, 0, 0], 
                PointLoad[y, 1, 0, 0]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]

Point Loaded on both ends, with linear distributed load positive at left and negative at right

testload[x_]  := 100*(1/2  -  x)

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, testload, PointLoad[y, 0, 0, 0], 
                PointLoad[y, 1, 0, 0]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]

Clamped on both ends, with a "box" placed at x = 3/4

boxload[
        x_]  := -100*(UnitStep[x - (3/4 - 1/8)]  -  
            UnitStep[x - (3/4 + 1/8)])

Plot[boxload[x], {x, 0, 1}]

Plot[Evaluate[
y[x] /. 
              BeamEquation[y, x, boxload, Clamped[y, 0, 0, 0], 
                Clamped[y, 1, 0, 0]]
],{x, 0, 1},PlotRange -> {-0.5, 0.5},AspectRatio -> 1]