This is basically what I think you're looking for. The RealExponent
of the difference is stored in red
as a list of triples {τ, t, d}
.
Clear[x, t, τ, sol, solrk]
sol[τ_] := Block[{t, x}, (* so Table[] doesn't overwrite t *)
sol[τ] = (* remember the solution so that it won't be recomputed *)
First[NDSolve[{x'[t] == (1/4) x[t - τ]/(1 + x[t - τ]^10) - x[t]/10,
x[t /; t <= 0] == 1/2}, x, {t, 0, 5000},
MaxSteps -> ∞]]
];
solrk[τ_] := Block[{t, x},
solrk[τ] =
First[NDSolve[{x'[t] == (1/4) x[t - τ]/(1 + x[t - τ]^10) - x[t]/10,
x[t /; t <= 0] == 1/2}, x, {t, 0, 5000},
MaxSteps -> ∞,
Method -> {"ExplicitRungeKutta", "DifferenceOrder" -> 3}]]
];
red = Table[{τ, t, RealExponent[(x[t] /. sol[τ]) - (x[t] /. solrk[τ])]},
{τ, 14, 40, 4}, {t, 17, 5000, 17}];
ListPointPlot3D[red, Filling -> Bottom]
The right plot is with a Δτ
in Table[]
of 2
.