1
$\begingroup$

I am seeking advice on how to numerically solve the following differential-difference equation:

sol = NDSolve[{t x'[t] + x[t]/2 + x[t - 1]/2 == 0, 
   x[t /; 0 < t <= 1] == 1/Sqrt[t]}, x, {t, 0, 20}]

The initial condition, which must avoid the singularity at t=0, is perhaps causing the trouble. Or maybe I am missing something else. If this approach is doomed to failure, then I would appreciate learning about a method that might succeed. Thank you!

$\endgroup$
3
  • $\begingroup$ Welcome to Mathematica.SE! I suggest the following: 1) As you receive help, try to give it too, by answering questions in your area of expertise. 2) Take the tour! 3) When you see good questions and answers, vote them up by clicking the gray triangles, because the credibility of the system is based on the reputation gained by users sharing their knowledge. Also, please remember to accept the answer, if any, that solves your problem, by clicking the checkmark sign! $\endgroup$
    – Michael E2
    Mar 10, 2022 at 0:26
  • $\begingroup$ You can format inline code and code blocks by selecting the code and clicking the {} button above the edit window. The edit window help button ? is useful for learning how to format your questions and answers. You may also find the meta Q&A, How to copy code from Mathematica so it looks good on this site, helpful $\endgroup$
    – Michael E2
    Mar 10, 2022 at 0:27
  • 3
    $\begingroup$ Any help?: NDSolveValue[{1/2 x[-1 + t] + x[t]/2 + t Derivative[1][x][t] == 0, x[t /; t <= 1 + 1*^-12] == 1/Sqrt[t]}, x, {t, 1, 20}(*, Method -> "StiffnessSwitching"*)] $\endgroup$
    – Michael E2
    Mar 10, 2022 at 0:35

2 Answers 2

1
$\begingroup$

Found a complete numerical solution by splitting t range into parts 0-1, 1-2 and >2.

For 0<t<1 function has to be 1/Sqrt[t], For 1<t<2 start with variable a as xvalue at t==2 and Findroot a to satisfy x1==1. (You can ignore the error at exacly x==1). You can also use ShootingMethod.

pl0 = Plot[1/Sqrt[t], {t, 0, 1}];

xsol[a_?NumericQ] := 
 x /. Flatten@
   NDSolve[{t x'[t] + x[t]/2 + 1/Sqrt[t - 1]/2 == 0, x[2] == a}, 
    x, {t, 1, 2}]

fr = FindRoot[xsol[a][1] == 1, {a, .1}] // Quiet

(* {a -> 0.0838806}  *)

Use Piecewise for part x[t-1] with the already known function xsol for 1<t<2

    xsol2 = x /. 
   Flatten@NDSolve[{t x'[t] + x[t]/2 + 
        Piecewise[{{1/2 xsol[a /. fr][t - 1], 2 < t <= 3}}, 
         x[t - 1]/2] == 0, x[2] == a /. fr}, x, {t, 2, 4}] // Quiet

Compare with the analytical result found by @MichaelE2

xo[t_] = (1 - ArcTanh[Sqrt[(-1 + t)/t]])/Sqrt[t];

xME = x /. 
  Flatten@NDSolve[{t x'[t] + x[t]/2 + x[t - 1]/2 == 0, 
 x[t /; t <= 2] == xo[t]}, x, {t, 2, 4}]

pl1a = Plot[xo[t], {t, 1, 2}, 
         PlotStyle -> {Opacity[.3], Thickness[.02], Red}]

pl1 = Plot[Evaluate[xsol[a /. fr][t]], {t, 1, 2}, 
        PlotStyle -> Black] // Quiet;

pl2 = Plot[xsol2[t], {t, 2, 4}]

pl2a = Plot[xME[t], {t, 2, 4}, 
        PlotStyle -> {Opacity[.3], Thickness[.02], Red}]

Show[pl0, pl1, pl1a, pl2, pl2a, PlotRange -> All, 
   GridLines -> Automatic]

enter image description here

You can of course generate a piecewise function of this.

$\endgroup$
1
  • $\begingroup$ I wish to acknowledge @Akku14 in an upcoming paper: please email me. Thank you. $\endgroup$
    – S. Finch
    Mar 19, 2022 at 15:37
1
$\begingroup$

Aside from nudging the initial condition slightly off of the singularity with the initial history x[t /; t <= 1 + 1*^-12] == 1/Sqrt[t], DSolve can solve the problem symbolically, sort of — at least far enough to give NDSolve an initial condition away from the singularity. (The time it takes DSolve to finish grows really fast with the length of the interval, but up to t == 2 is quick.)

xf0 = DSolveValue[{t x'[t] + x[t]/2 + x[t - 1]/2 == 0, 
   x[t /; t <= 1] == 1/Sqrt[t]}, x[t], {t, 1, 2}]
xf0 = FullSimplify[FullSimplify[ComplexExpand[xf0]], t > 0]

Mathematica graphics

Then

xsol = NDSolveValue[{t x'[t] + x[t]/2 + x[t - 1]/2 == 0, 
   x[t /; t <= 2] == xf0}, x, {t, 0, 4}];
Plot[xsol[t], Evaluate@Flatten@{t, xsol@"Domain"}]
$\endgroup$
4
  • $\begingroup$ Very nice! I wish to acknowledge @MichaelE2 in an upcoming paper: please email me. Thank you. $\endgroup$
    – S. Finch
    Mar 18, 2022 at 15:32
  • $\begingroup$ @S.Finch Thanks! I just sent you an email, I think. At least, it hasn't bounced yet. :) $\endgroup$
    – Michael E2
    Mar 18, 2022 at 15:56
  • $\begingroup$ I also wish to acknowledge @Akku14 in an upcoming paper: please email me. Thank you. $\endgroup$
    – S. Finch
    Mar 18, 2022 at 17:17
  • $\begingroup$ @S.Finch You probably want to put your last comment under Akku14's answer. They won't get notified of your comment (I believe), even with the @ sign, because they haven't left a comment under this answer. $\endgroup$
    – Michael E2
    Mar 18, 2022 at 23:03

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.