# Super Slow Manipulate with Heat Equation - - Assumption, and Interpolate

Aim: solve coupled heat equation with cubic source, use DensityPlot and observe how system will react to changes in parameter(like kand kc (0 for now)) values.

Clear[func, y]
kc = 0;
func[k_] :=
NDSolve[{
D[y[t, x], t] == D[D[y[t, x], x], x] + y[t, x]^3 - z[t, x],
D[z[t, x], t] == D[D[z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
y[0, x] == 0.3, z[0, x] == 0,
y[t, -2] == 0, z[t, -2] == 0,
y[t, 2] == 1, z[t, 2] == 0
},
{y, z}, {t, 0, 5}, {x, -2, 2}]
Manipulate[
DensityPlot[
({y[tt, xx] /. func[l]}),
{tt, 0, 5}, {xx, -2, 2}
],
{l, 0, 3, 1}
]


Manipulate is not functioning well. I think manipulate computes func[k] each step and its super slow due to double derivative terms. Therefore I thought about the following "solutions":

Solution1 Assume k is a real parameter, and solve equation system once for k. So, for each manipulation step plot for a new k value.

Clear[func, y]
kc = 0;
(*func[k_]:=
NDSolve[{
D[ y[t,x],t]\[Equal]D[D[ y[t,x],x],x]+y[t,x]^3-z[t,x],
D[ z[t,x],t]\[Equal]D[D[ z[t,x],x],x]+y[t,x]-k*z[t,x]+kc,
y[0,x]\[Equal]0.3,z[0,x]\[Equal]0,
y[t,-2]\[Equal]0,z[t,-2]\[Equal]0,
y[t,2]\[Equal]1,z[t,2]\[Equal]0
},
{y,z},{t,0,5},{x,-2,2}]*)
solfunc[k] := Assuming[k ∈ Reals,
NDSolve[{
D[ y[t, x], t] == z[t, x],
D[ z[t, x], t] ==
D[D[ z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
y[0, x] == 0.3, z[0, x] == 0,
y[t, -2] == 0, z[t, -2] == 0,
y[t, 2] == 1, z[t, 2] == 0
},
{y, z}, {t, 0, 5}, {x, -2, 2}]]
plotme[k_] := y[tt, xx] /. solfunc[k]
Manipulate[
DensityPlot[
({plotme[k]}),
{tt, 0, 5}, {xx, -2, 2}
],
{k, 0, 3, 1}
]


Not worked.

Question1 Does anyone have any thoughts on how to do this?

Solution2

Use Table the solutions of NDSolve. But table-ing a continuous solution in a discrete way should lose of information.

Question2 (I would appreciate if anyone can give a hint.)

Additional Question

Does anyone have any thoughts on how to use interpolate in this set up? (Later it turned out that PlotPoints -> 100 worked fine instead interpolate)

• The issue is not Manipulate, but DensityPlot: If you wrap the first argument in Evaluate, the performance will be a lot better: DensityPlot[Evaluate[{plotme[k]}],...] - if you don't do this, plotme[k] is indeed reevaluated for every point of the plot Commented Oct 1, 2020 at 13:51
• Your initial and boundary condition contradict each other. E.g. y[0, x] == 0.3 and y[t, -2] == 0, and y[t, 2] == 1 Commented Oct 1, 2020 at 14:00
• @DanielHuber yes you are right. Commented Oct 1, 2020 at 14:15

## 2 Answers

With your revised initial and boundary conditions

\$Version

(* "12.1.1 for Mac OS X x86 (64-bit) (June 19, 2020)" *)

Clear["Global*"]

kc = 0;

eqns = {
D[y[t, x], t] == D[D[y[t, x], x], x] + y[t, x]^3 - z[t, x],
D[z[t, x], t] == D[D[z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
y[0, x] == 0.3, z[0, x] == 0.1, y[t, -2] == 0.3, z[t, -2] == 0.1,
y[t, 2] == 0.3, z[t, 2] == 0.1} // Rationalize;

sol = ParametricNDSolve[eqns, {y, z}, {t, 0, 5}, {x, -2, 2}, {k}]


Manipulate[
yl = y[l] /. sol;
DensityPlot[yl[t, x] /. sol, {t, 0, 5}, {x, -2, 2},
FrameLabel -> (Style[#, 14, Bold] & /@ {t, x}),
PlotLegends ->
BarLegend[Automatic, LegendLabel -> "y(t,\[ThinSpace]x)"]],
{{l, 1}, 0, 3, 1, ControlType -> SetterBar}]


This is the well-functioning code due to changes made according to commentators. thank you for your time.

Clear["Global*"]

kc = 0;
func[k_] :=
NDSolve[{
D[ y[t, x], t] == D[D[ y[t, x], x], x] + y[t, x]^3 - z[t, x],
D[ z[t, x], t] == D[D[ z[t, x], x], x] + y[t, x] - k*z[t, x] + kc,
y[0, x] == 0.3, z[0, x] == 0.1,
y[t, -2] == 0.3, z[t, -2] == 0.1,
y[t, 2] == 0.3, z[t, 2] == 0.1
},
{y, z}, {t, 0, 5}, {x, -2, 2}]
plotme[k_] := y[tt, xx] /. func[k]
Manipulate[
DensityPlot[Evaluate[plotme[k]],
{tt, 0, 5}, {xx, -2, 2}],
{k, 0, 3, 1}]$$$$
`