Plotting RealExponent with respect to delay?

Questions
, ,
1

I have obtained the following equations from Wolfram documentation.

sol = First[ 
   NDSolve[{x'[t] == (1/4) x[t - \[Tau]]/ (1 + x[t - \[Tau]]^10) - 
       x[t]/10, x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, 
    MaxSteps -> \[Infinity]]];

solrk = First[ 
   NDSolve[{x'[t] == (1/4) x[t - \[Tau]]/ (1 + x[t - \[Tau]]^10) - 
       x[t]/10, x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, 
    MaxSteps -> \[Infinity], 
    Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 3}]];
ListPlot[Table[{t, RealExponent[(x[t] /. sol) - (x[t] /. solrk)]}, {t,
    17, 5000, 17}]]

The same equation has been solved twice using two different methods and RealExponent[d] has been plotted with respect to time.Here d is the difference between x(t) computed by the different methods.

How to plot RealExponent[d] with respect to [Tau]. Where [Tau] can be varied from 14 to 40

2

I would try with ParametricNDSolveValue:

sol = ParametricNDSolveValue[{x'[
     t] == (1/4) x[t - \[Tau]]/(1 + x[t - \[Tau]]^10) - x[t]/10, 
   x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, {\[Tau]}, 
  MaxSteps -> \[Infinity]]
solrk = ParametricNDSolveValue[{x'[
     t] == (1/4) x[t - \[Tau]]/(1 + x[t - \[Tau]]^10) - x[t]/10, 
   x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, {\[Tau]}, 
  MaxSteps -> \[Infinity], 
  Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 3}]
With[{\[Tau] = 14, t = 2}, {sol[\[Tau]][t], solrk[\[Tau]][t]}]

It takes a lot to compute the numeric values.

3

Either use ParametricNDSolveValue like Gianluca proposed or use the regular NDSolve, but note that it needs tau to be specified!

\[Tau]s = {14, 20, 30, 40};
sols = Table[
   sol = x /. 
     First[NDSolve[{x'[
          t] == (1/4) x[t - \[Tau]]/(1 + x[t - \[Tau]]^10) - x[t]/10, 
        x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, 
       MaxSteps -> \[Infinity]]];
   solrk = 
    x /. First[
      NDSolve[{x'[t] == (1/4) x[t - \[Tau]]/(1 + x[t - \[Tau]]^10) - 
          x[t]/10, x[t /; t <= 0] == 1/2}, x, {t, 0, 5000}, 
       MaxSteps -> \[Infinity], 
       Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 3}]];
   {sol, solrk}
   ,
   {\[Tau], \[Tau]s}
   ];
diffx = RealExponent[#1[x] - #2[x]] & @@@ sols;
Plot[Evaluate[diffx], {x, 0, 500}, PlotLegends -> \[Tau]s]
4

Thank you for your help. Actually I wanted to plot delay i.e [Tau] in x axis and RealExponent in y axis

5

The output is not a ‘number’ but a function, so I’m not sure how you want it…