Solving two dimensional Heat equation PDE in mathematica - wolfram-mathematica

I am trying to solve the following equation in Mathematica but I do not know each time it only returns the equation itself instead of solving it. I tried both Dsolve and NDsolve and it was not helping me. Could anyone help me with the correct syntax?
There is a symmetry boundary condition there and the equation is in cylindrical r and z and depends on time t too.
heat= (1/r)*D[r*T[r, z, t], r] +
D[T[r, z, t], {z, 2}] == (1/(10^-4))*D[T[r, z, t], t]
NDSolve[{heat, T[0.05, z, 0] == 500, D[T[r, z, t], r] == 0},
T, {r, 0.01, 0.05}, {t, 0, 10}, {z, 0, 0.05}]
I did the same with Dsolve and no success.
If this question is not related to here would you guide me where and how to post it before you deactivate it? thank you

Related

2D Heat Equation Mathematica not solving analitically (DSolve) or numerically (NDSolve), what am I doing wrong?

my goal is to solve the following 2d heat conduction equation, along with initial and boundary conditions:
pde = D[u[x, y, t], t] == (c^2)*(D[u[x, y, t], {x, 2}] + D[u[x, y, t], {y, 2}]);
ic = {u[x,y,0] == 0};
bc = {Derivative[1, 0, 0][u][0, y, t] == k, u[x, 0, t] == 0, u[x, b, t] == 0,
u[a, y, t] == 0};
...but something always goes wrong when i input
sol = DSolve[{pde, bc, ic}, u[x, y, t], {x, y, t}]
I tried changing the conditions a bit to see if that is a problem on mathematica, and sometimes it works (example of this guy). I suspect there is something wrong with the derivative, but I tried using D[u[x,y,t],x]./x->0 == k but still it doesnt work. Is it even possible to solve this in Mathematica?

Mathematica: FindFit for NIntegrate of ParametricNDSolve

I`ve seen several answers for quite similar topics with usage of ?NumericQ explained and still can not quite understand what is wrong with my implementation and could my example be evaluated at all the way I want it.
I have solution of differential equation in form of ParametricNDSolve (I believe that exact form of equation is irrelevant):
sol = ParametricNDSolve[{n'[t] == g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2, n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
After that I am trying to construct a function for FindFit or similar procedure, Nintegrating over function n[a,b,c,g,f,y,t] I have got above with some multiplier (I have chosen Log[z] as multiplier for simplicity)
Func[z_, a_, b_, c_, g_, f_] :=
NIntegrate[
Log[z]*(n[a, b, c, g, f, y][t] /. sol), {t, 0, 10}, {y, 0, Log[z]}]
So I have NIntegrate over my function n[params,t] derived from ParametricNDSolve with multiplier introducing new variable (z) wich also present in the limits of integration (in the same form as in multiplier for simplicity of example)
I am able to evaluate the values of my function Func at any point (z) with given values of parameters (a,b,c,g,f): Func(0,1,2,3,4,5) could be evaluated.
But for some reasons I cannot use FindFit like that:
FindFit[data, Func[z, a, b, c, g, f], {a, b, c, g, f}, z]
The error is: NIntegrate::nlim: y = Log[z] is not a valid limit of integration.
I`ve tried a lot of different combinations of ?NumericQ usage and all seems to lead nowhere. Any help would be appreciated!
Thanks in advance and sorry for pure english in the problem explanation.
Here is a way to define your function:
sol = n /.
ParametricNDSolve[{n'[t] ==
g/(1/(y - f*y) + b*t + g*t)^2 - a*n[t] - c*n[t]^2,
n[0] == y*f}, {n}, {t, 0, 10}, {a, b, c, g, f, y}]
Func[z_?NumericQ, a_?NumericQ, b_?NumericQ, c_?NumericQ, g_?NumericQ,
f_?NumericQ] :=
NIntegrate[Log[z]*sol[a, b, c, g, f, y][t],
{t, 0, 10}, {y, 0, Log[z]}]
test: Func[2, .45, .5, .13, .12, .2] -> 0.106107
I'm not optimistic you will get good results from FindFit with a function with so many parameters and which is so computationally expensive.

Using NIntegrate inside NDSolve

I am trying to numerically solve a partial differential equation, where the inhomogeneous term is an integral of another function. Something like this:
NDSolve[{D[f[x, y], x] == NIntegrate[h[x,y+y2],{y2, x, y}],f[0,y] == 0}, f, {x, 0, 1}, {y,0,1}]
where h[x,y] is a well known function previously defined.
But it seems that Mathematica does not know how to evaluate the integral.
I do not use Mathematica too often, so I am sure there is a simple solution to this.
Could someone tell me what I am doing wrong?
Thanks.
It is not really clear from the question, but I had a similar problem and the solution in my case was to follow the advice from the wolfram forums to put the integral in an extra function and force real input.
So in your case this would be
integral[x_Real,y_Real] := NIntegrate[h[x,y+y2],{y2, x, y}];
NDSolve[{D[f[x, y], x] == integral[x,y], f[0,y] == 0}, f, {x, 0, 1}, {y,0,1}]

Mathematica: FindRoot for common tangent

I asked this question a little while back that did help in reaching a solution. I've arrived at a somewhat acceptable approach but still not fully where I want it. Suppose there are two functions f1[x] and g1[y] that I want to determine the value of x and y for the common tangent(s). I can at least determine x and y for one of the tangents for example with the following:
f1[x_]:=(5513.12-39931.8x+23307.5x^2+(-32426.6+75662.x-43235.4x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-10808.9+10808.9x)Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87y-51143.6y^2+y(-10808.9+10808.9y)Log[y/(1.-1.y)]+(-10808.9+32426.6y-21617.7y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
Show[
Plot[f1[x],{x,0,.75},PlotRange->All],
Plot[g1[y],{y,0,.75},PlotRange->All]
]
Chop[FindRoot[
{
(f1[x]-g1[y])/(x-y)==D[f1[x],x]==D[g1[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
However, you'll notice from the plot that there exists another common tangent at slightly larger values of x and y (say x ~ 4 and y ~ 5). Now, interestingly if I slightly change the above expressions for f1[x] and g1[y] to something like the following:
f2[x_]:=(7968.08-59377.8x+40298.7x^2+(-39909.6+93122.4x-53212.8x^2)Log[(1.-1.33333x)/(1.-1.x)]+x(-13303.2+13303.2x)Log[x/(1.-1.x)])/(-1.+x)
g2[y_]:=(5805.16-27866.2y-21643.y^2+y(-13303.2+13303.2y)Log[y/(1.-1.y)]+(-13303.2+39909.6y-26606.4y^2)Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
Show[
Plot[f2[x],{x,0,.75},PlotRange->All],
Plot[g2[y],{y,0,.75},PlotRange->All]
]
Chop[FindRoot[
{
(f2[x]-g2[y])/(x-y)==D[f2[x],x]==D[g2[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
And use the same method to determine the common tangent, Mathematica chooses to find the larger values of x and y for the positive sloping tangent.
Finally, my question: is it possible to have Mathematica find both the high and low x and y values for the common tangent and store these values in a similar way that allows me to make a list plot? The functions f and g above are all complex functions of another variable, z, and I am currently using something like the following to plot the tangent points (should be two x and two y) as a function of z.
ex[z_]:=Chop[FindRoot[
{
(f[x,z]-g[y,z])/(x-y)==D[f[x],x]==D[g[y],y]
},
{x,0.0000001},{y,.00000001}
]
[[All,2]]
]
ListLinePlot[
Table[{ex[z][[i]],z},{i,1,2},{z,1300,1800,10}]
]
To find estimates for {x, y} that would solve your equations, you could plot them in ContourPlot and look for intersection points. For example
f1[x_]:=(5513.12-39931.8 x+23307.5 x^2+(-32426.6+75662. x-
43235.4 x^2)Log[(1.-1.33333 x)/(1.-1.x)]+
x(-10808.9+10808.9 x) Log[x/(1.-1.x)])/(-1.+x)
g1[y_]:=(3632.71+3806.87 y-51143.6 y^2+y (-10808.9+10808.9y) Log[y/(1.-1.y)]+
(-10808.9+32426.6 y-21617.7 y^2) Log[1.-(1.y)/(1.-1.y)])/(-1.+y)
plot = ContourPlot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]},
{x, 0, 1}, {y, 0, 1}, PlotPoints -> 40]
As you can see there are 2 intersection points in the interval (0,1). You could then read off the points from the graph and use these as starting values for FindRoot:
seeds = {{.6,.4}, {.05, .1}};
sol = FindRoot[{f1'[x] == g1'[y], f1[x] + f1'[x] (y - x) == g1[y]},
{x, #1}, {y, #2}] & ### seeds
To get the pairs of points from sol you can use ReplaceAll:
points = {{x, f1[x]}, {y, g1[y]}} /. sol
(*
==> {{{0.572412, 19969.9}, {0.432651, 4206.74}},
{{0.00840489, -5747.15}, {0.105801, -7386.68}}}
*)
To show that these are the correct points:
Show[Plot[{f1[x], g1[x]}, {x, 0, 1}],
{ParametricPlot[#1 t + (1 - t) #2, {t, -5, 5}, PlotStyle -> {Gray, Dashed}],
Graphics[{PointSize[Medium], Point[{##}]}]} & ### points]
OK, so let's quickly rewrite what you've done so far:
Using your f1 and g1, we have the plot
plot = Plot[{f1[x], g1[x]}, {x, 0, .75}]
and the first shared tangent at
sol1 = Chop[FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, 0.0000001}, {y, .00000001}]]
(* {x -> 0.00840489, y -> 0.105801} *)
Define the function
l1[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol1
then, you can plot the tangents using
Show[plot, Graphics[Point[{l1[0], l1[1]}]],
ParametricPlot[l1[t], {t, -1, 2}],
PlotRange -> {{-.2, .4}, {-10000, 10000}}]
I briefly note (for my own sake) that the equations you used
(e.g., to generate sol1 above)
come from requiring that the tangent line for f1 at x
tangentially hits g1 at some point y, i.e.,
LogicalExpand[{x, f[x]} + t {1, f'[x]} == {y, g[y]} && f'[x] == g'[y]]
To investigate where the shared tangents lie, you can use a Manipulate:
Manipulate[Show[plot, ParametricPlot[{x, f1[x]} + t {1, f1'[x]}, {t, -1, 1}]],
{x, 0, .75, Appearance -> "Labeled"}]
which produces something like
Using the eyeballed values for x and y, you can get the actual solutions using
sol = Chop[Table[
FindRoot[{(f1[x] - g1[y])/(x - y) == D[f1[x], x] == D[g1[y], y]},
{x, xy[[1]]}, {y, xy[[2]]}], {xy, {{0.001, 0.01}, {0.577, 0.4}}}]]
define the two tangent lines using
l[t_] = (1 - t) {x, f1[x]} + t {y, g1[y]} /. sol
then
Show[plot, Graphics[Point[Flatten[{l[0], l[1]}, 1]]],
ParametricPlot[l[t], {t, -1, 2}, PlotStyle -> Dotted]]
This process could be automated, but I'm not sure how to do it efficiently.

Force function evaluation on declaration

I have a function f[x_,y_,z_]:=Limit[g[x+eps,y,z],eps->0]; and I plot f[x,y,z] in the next step. Earlier, I used to evaluate the limit and copy the expression in the definition of f. I tried to make it all in one step. However, the evaluation of the Limit is done only when I try to plot f. As a result, every time I change around the variables and replot, the limit is evaluated all over again (it takes about a min to evaluate, so it becomes annoying). I tried evaluating the limit first, and then doing f[x_,y_,z_]:=%. But that doesn't work either. How do I get the function to evaluate the limit upon declaration?
The function you need is logically called Evaluate and you can use it within the Plot command.
Here is a contrived example:
f[x_, y_, z_] := Limit[Multinomial[x, y, z], x -> 0]
Plot3D[ Evaluate[ f[x, y, z] ], {y, 1, 5}, {z, 1, 5}]
Addressing your follow-up question, perhaps all you seek is something like
ff = f[x, y, z]
Plot3D[ff, {y, 1, 5}, {z, 1, 5}]
or possibly merely
ClearAll[f, x, y, z]
f[x_, y_, z_] = Limit[Multinomial[x, y, z], x -> 0]
Plot3D[f[x, y, z], {y, 1, 5}, {z, 1, 5}]
It would be helpful if you would post a more complete version of your code.
An alternative to Mr Wizard's solution is that you can also put the Evaluate in the function's definition:
f[x_, y_, z_] := Evaluate[Limit[Multinomial[x, y, z], x->0]]
Plot3D[f[x, y, z], {y, 1, 5}, {z, 1, 5}]
You can compare the two versions with the one without an Evaluate by Timing the Plot.

Resources