How to put solutions of mutiple DEs with NDSolve in table

Question

I have $N$ differential equation for each $s \in {1,2,...,N}$ on the domain $x \in [1,2]$ of the form (e.g.)

$xf_s'(x) + \log(xs) f_s(x)+1 = 0$, with the boundary condition $f_s(1) = e^{-s}$

Now I want to solve this equation with NDSolve. Put the values for the solutions at $x = 2$, i.e. $f_s(2)$ in a table enumerated by the index $s$. Then I want to interpolate between these values in the table to get a function $g(s) = f_s(2)$.

However, since I am new to mathematica, I have no Idea how to do this. I can solve the equation for some $s$ with NDSolve:

NDSolve[{x*D[f[x], x] + Log[x*s]*f[x] + 1 == 0, f[1] == Exp[-s]}, f, {x, 1, 2}]

and this seems to work. However my main issue right now is putting the values of the output function in the table. How can I do this?

Answer 1

n = 100(* the number of equation,N*);
sols = {};(*table*)
 Do[
  AppendTo[sols, 
   f[2] /. Last@
     NDSolve[{x*D[f[x], x] + Log[x*s]*f[x] + 1 == 0, f[1] == Exp[-s]},
       f, {x, 1, 2}]],
  {s, 1, n}]; // AbsoluteTiming

=>

{0.144813, Null}

sols // ListLinePlot

Answer 2

Try this

Clear[s, f, sol];
sol = DSolve[{x*D[f[x], x] + Log[x*s]*f[x] + 1 == 0, f[1] == Exp[-s]},f, x][[1, 1, 2, 2]]

Then make the table and interpolate it:

f = Interpolation[Table[{s, sol /. x -> 2}, {s, 0.01, 1, 0.01}], InterpolationOrder -> 2]

and plot it:

Plot[f[x], {x, 0.01, 1}]

Have fun!

Answer 3

eqn = {x*D[f[x], x] + Log[x*s]*f[x] + 1 == 0, f[1] == Exp[-s]};

The example can be solved exactly with DSolve

sol = DSolve[eqn, f, x][[1]]

(* {f -> Function[{x}, 
   1/2 E^(-s - 
     1/2 Log[s x]^2) (2 E^(Log[s]^2/2) + 
      E^s Sqrt[2 π] Erfi[Log[s]/Sqrt[2]] - 
      E^s Sqrt[2 π] Erfi[Log[s x]/Sqrt[2]])]} *)

Verifying the solution,

And @@ eqn /. sol // Simplify

(* True *)

For a table of the exact solutions for integer values of s:

Grid[
 Prepend[
  {#, f[x] /. sol /. s -> #} & /@ Range[4] // FullSimplify,
  Style[#, 12, Bold] & /@ {s, f[x]}],
 Frame -> All]

For a Plot for integer values of s

Plot[
 Evaluate@
  Table[Tooltip[f[x] /. sol, s], {s, 1, 5}],
 {x, 1, 2},
 PlotLegends -> Range[5]]

Or plot in 3D

Show[
 Plot3D[f[x] /. sol, {x, 1, 2}, {s, 1, 5},
  PlotStyle -> Opacity[0.25]],
 ParametricPlot3D[
  Evaluate@
   Table[{x, s, f[x] /. sol}, {s, 1, 5}],
  {x, 1, 2}],
 AxesLabel -> (Style[#, 12, Bold] & /@ {x, s, f}),
 BoxRatios -> {1, 1, 1/2}]

For a numeric approach use ParametricNDSolve or ParametricNDSolveValue

fp = ParametricNDSolveValue[eqn, f, {x, 1, 2}, {s}];

In 2 D

Plot[
 Evaluate@
  Table[Tooltip[fp[s][x], s], {s, 1, 5}],
 {x, 1, 2},
 PlotLegends -> Range[5]]

Or in 3D

Show[
 Plot3D[
  fp[s][x], {x, 1, 2}, {s, 1, 5},
  PlotStyle -> Opacity[0.25]],
 ParametricPlot3D[
  Evaluate@Table[{x, s, fp[s][x]}, {s, 1, 5}],
  {x, 1, 2}],
 AxesLabel -> (Style[#, 12, Bold] & /@ {x, s, f}),
 BoxRatios -> {1, 1, 1/2}]

Answer 4

Try ParametricNDSolve

F = ParametricNDSolveValue[{x*D[f[x], x] +Log[x*s]*f[x] + 1 == 0,f[1] == Exp[-s]}, f, {x, 1, 2}, s]

which returns a function F[s][x] .

F[s]}[2] is the function you're looking for

Plot[F[s][2], {s, 1, 100}]