How to draw three-dimensional image: Plot3D NDSolve - wolfram-mathematica

Question

m = 10; c = 2; k = 5; F = 12;
NDSolve[{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*f*t])*x[t] == F*Sin[2*Pi*f*t],
x[0] == 0, x'[0] == 0}, x[t], {t, 0, 30}]
{f, 0, 5} ( 0=< f <= 5 )
How to draw three-dimensional image:
x = u(t,f)
............
If f = 0.1,0.2,... 5,
We can solve the equation:
NDSolve[{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*f*t])*x[t] == F*Sin[2*Pi*f*t],
x[0] == 0, x'[0] == 0}, x[t], {t, 0, 30}]
x is a function of t and f
...............
m = 10; c = 2; k = 5; F = 12;
f = 0.1
s = NDSolve[{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*f*t])*x[t] == F*Sin[2*Pi*f*t],
x[0] == 0, x'[0] == 0}, x[t], {t, 0, 30}]
Plot[Evaluate[x[t] /. s], {t, 0, 30}, PlotRange -> All]
f = 0.1
f = 0.2
f = 0.3
f = 5
How to draw three-dimensional image:
x = u(t,f)

Answer 1

Here goes a solution.
m = 10; c = 2; k = 5; F = 12;
NumberOfDiscrit$f = 20;(* Number of points you want to divide 0<=f<=5*)
NumberOfDiscrit$t = 100;(* Number of points you want to divide 0<=t<=30 *)
fValues = Range[0., 5., 5./(NumberOfDiscrit$f - 1)];
tValues = Range[0., 30., 30./(NumberOfDiscrit$t - 1)];
res = Map[(x /.
First#First#
NDSolve[{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*#*t])*x[t] ==
F*Sin[2*Pi*#*t], x[0] == 0, x'[0] == 0}, x, {t, 0, 30}]) &,
fValues];
AllDat = Map[(##tValues) &, res];
InterpolationDat =
Flatten[Table[
Transpose#{tValues,
Table[fValues[[j]], {i, 1, NumberOfDiscrit$t}],
AllDat[[j]]}, {j, 1, NumberOfDiscrit$f}], 1];
Final3DFunction = Interpolation[InterpolationDat];
Plot3D[Final3DFunction[t, f], {t, 0, 30}, {f, 0, 5}, PlotRange -> All,
PlotPoints -> 60, MaxRecursion -> 3, Mesh -> None]
You can use Manipulate to dynamically change some of the parameters. By the way the above 3D picture may be misleading if one takes f as a continuous variable in u(t,f). You should note that the numerical solution seems to blow up for asymptotic values of t>>30. See the picture below.
Hope this helps you out.

Answer 2

You could also do something like this
Clear[f]
m = 10; c = 2; k = 5; F = 12;
s = NDSolve[{m*Derivative[2, 0][x][t, f] +
c*Derivative[1, 0][x][t, f] + (k*Sin[2*Pi*f*t])*x[t, f] == F*Sin[2*Pi*f*t],
x[0, f] == 0,
Derivative[1, 0][x][0, f] == 0}, x, {t, 0, 30}, {f, 0, .2}]
Plot3D[Evaluate[x[t, f] /. s[[1]]], {t, 0, 30}, {f, 0, .2}, PlotRange -> All]

Answer 3

This should do it.
m = 10; c = 2; k = 5; F = 12;
fun[f_?NumericQ] :=
Module[
{x, t},
First[x /.
NDSolve[
{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*f*t])*x[t] == F*Sin[2*Pi*f*t],
x[0] == 0, x'[0] == 0},
x, {t, 0, 30}
]
]
]
ContourPlot[fun[f][t], {f, 0, 5}, {t, 0, 30}]
Important points:
The pattern _?NumericQ prevents fun from being evaluated for symbolc arguments (think fun[a]), and causing NDSolve::nlnum errors.
Since NDSolve doesn't appear to localize its function variable (t), we needed to do this manually using Module to prevent conflict between the t used in NDSolve and the one used in ContourPlot. (You could use a differently named variable in ContourPlot, but I think it was important to point out this caveat.)
For a significant speedup in plotting, you can use memoization, as pointed out by Mr. Wizard.
Clear[funMemo] (* very important!! *)
funMemo[f_?NumericQ] :=
funMemo[f] = Module[{x, t},
First[x /.
NDSolve[{m*x''[t] + c*x'[t] + (k*Sin[2*Pi*f*t])*x[t] ==
F*Sin[2*Pi*f*t], x[0] == 0, x'[0] == 0}, x, {t, 0, 30}]]]
ContourPlot[funMemo[f][t], {f, 0, 5}, {t, 0, 30}] (* much faster than with fun *)
If you're feeling adventurous, and willing to explore Mathematica a bit more deeply, you can further improve this by limiting the amount of memory the cached definitions are allowed to use, as I described here.
Let's define a helper function for enabling memoization:
SetAttributes[memo, HoldAll]
SetAttributes[memoStore, HoldFirst]
SetAttributes[memoVals, HoldFirst]
memoVals[_] = {};
memoStore[f_, x_] :=
With[{vals = memoVals[f]},
If[Length[vals] > 100, f /: memoStore[f, First[vals]] =.;
memoVals[f] ^= Append[Rest[memoVals[f]], x],
memoVals[f] ^= Append[memoVals[f], x]];
f /: memoStore[f, x] = f[x]]
memo[f_Symbol][x_?NumericQ] := memoStore[f, x]
Then using the original, non-memoized fun function, plot as
ContourPlot[memo[fun][f][t], {f, 0, 5}, {t, 0, 30}]