Please help me to find a solution in a Wolfram Mathematica program.
I have several times checked the accuracy of the entered data. They are true. The solution must exist. But a Wolfram provides either the empty graph (for any point in time), or an error "NDSolve::eerr". Here is my code:
solution =
NDSolve[{D[fun[t, x, y], t] ==
Exp[-t]*Cos[Pi*y] + D[fun[t, x, y], {x, 2}] +
D[fun[t, x, y], {y, 2}], fun[t, 0, y] == 0, fun[t, 1, y] == 0,
fun[0, x, y] == 0, (D[fun[t, x, y], y] /. y -> 0) ==
0, (D[fun[t, x, y], y] /. y -> 1) == 0},
fun[t, x, y], {t, 0, 5}, {x, 0, 1}, {y, 0, 1}]
Plot3D[Evaluate[First[fun[5, x, y] /. solution]], {x, 0, 1}, {y, 0,
1}, PlotRange -> All, Mesh -> None, PlotPoints -> 40]
And here is the error code
NDSolve::eerr: Warning: scaled local spatial error estimate of
140.65851971330582at t = 5. in the direction of independent variable x is much greater than the prescribed error tolerance. Grid
spacing with 15 points may be too large to achieve the desired
accuracy or precision. A singularity may have formed or a smaller grid
spacing can be specified using the MaxStepSize or MinPoints method
options.
Please advise what can be done in such a situation. Many thanks in advance!
Related
I need to evaluate a function in 2D but it has three unknowns, the two arguments (x, y) and alpha. I need to evaluate x and y between {0,100}, while alpha between {0,1}.
The function is: f(x, y) = x ^ (a) * y ^ (1-a)
Thank you!
Not sure what "evaluate a function in 2D" means. Some options
f[x_, y_, a_] := x^a y^(1 - a)
Generate plots for different values of a
Table[Plot3D[f[x, y, a], {x, 0, 100}, {y, 0, 100},
PlotLabel -> "a = " <> ToString#a], {a, 0, 1, .1}] //
Partition[#, UpTo[4]] & //
Grid
Generate contours
ContourPlot3D[f[x, y, a], {x, 0, 100}, {y, 0, 100}, {a, 0, 1}, Contours -> 5]
This is a very simple one-dimensional solid-phase heat conduction differential equation, here is my code:
a = NDSolve[{D[721.7013888888889` 0.009129691127380562` tes[t, x],
t] == 2.04988920646734`*^-6 D[tes[t, x], x, x],
tes[t, 0] == 298 + 200 t, tes[t, 0.01] == 298,
tes[0, x] == 298}, {tes[t, x]}, {t, 0, 0.005}, {x, 0, 0.01}]
Plot3D[tes[t, x] /. a, {t, 0, 0.005}, {x, 0, 0.01}, PlotRange -> All]
(Plot[(tes[t, x] /. a) /. t -> 0.0005, {x, 0, 0.01},
PlotRange -> All])
After you run it, you will see: the temperature (in the equation it's named as tes) is lower than 298! It's ridiculous, it's against the second law of thermodynamics…how does this error come out? How can I correct it?
I'll deal only with the numerical aspects of this. First, scale time and space so that your equation becomes $\partial_t f=\partial_{x,x}f$ in the dimensionless units. then, for instance,
a = NDSolve[{D[ tes[t, x], t] == D[tes[t, x], x, x],
tes[t, 0] \[Equal] 1,
tes[t, 1] \[Equal] 1,
tes[0, x] \[Equal] Cos[2 \[Pi]*x/2]^2},
tes[t, x],
{t, 0, 1},
{x, 0, 1}
]
Plot3D[tes[t, x] /. a, {t, 0, .2}, {x, 0, 1}, PlotRange -> All,
AxesLabel \[Rule] {"t", "x"}]
so heat just diffuses inwards (note I changed the boundary and initial conditions).
This problem has been solved here,
I should admit that I haven't catch the nature yet at the time I posted this question…
I ran into this problem when I try to solve a partial differential equation. Here is my code:
dd = NDSolve[{D[tes[t, x], t] ==D[tes[t, x], x, x] + Exp[-1/(tes[t, x])],
tes[t, 0] == 1, tes[t, -1] == 1, tes[0, x] == 1}, {tes[t, x]}, {t, 0, 5}, {x, -1, 0}]
f[t_, x_] = tes[t, x] /. dd
kkk = FunctionInterpolation[Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}], {t, 0, 0.05}]
kkg[t_] = Integrate[Exp[-1.1/( Evaluate[f[t, x]])], {x, -1, 0}]
Plot[Evaluate[kkk[t]] - Evaluate[kkg[t]], {t, 0, 0.05}]
N[kkg[0.01] - kkk[0.01], 1]
It's strange that the deviation showed in the graph reaches up to more than 5*10^-7 around t=0.01, while it's only -3.88578*10^-16 when calculated by N[kkg[0.01] - kkk[0.01], 1], I wonder how this error comes out.
By the way, I feel it strange that the output of N[kkg[0.01] - kkk[0.01], 1] has so many decimal places, I've set the precision as 1, right?
Using Mathematica 7 the plot I get does not show a peak at 0.01:
Plot[kkk[t] - kkg[t], {t, 0, 0.05}, GridLines -> Automatic]
There is a peak at about 0.00754:
kkk[0.00754] - kkg[0.00754] // N
{6.50604*10^-7}
Regarding N, it does not change the precision of machine precision numbers as it does for exact or arbitrary precision ones:
N[{1.23456789, Pi, 1.23456789`50}, 2]
Precision /# %
{1.23457, 3.1, 1.2}
{MachinePrecision, 2., 2.}
Look at SetPrecision if you want to force (fake) a precision, and NumberForm if you want to print a number in a specific format.
I can plot the curve corresponding to an implicit equation:
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
But I cannot find a way to color the contour line depending on the location of the point. More precisely, I want to color the curve in 2 colors, depending on whether x² + y² < k or not.
I looked into ColorFunction but this is only for coloring the region between the contour lines.
And I was not able to get ContourStyle to accept a location-dependent expression.
you could use RegionFunction to split the plot in two:
Show[{
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 < .5],
ContourStyle -> Red],
ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
RegionFunction -> Function[{x, y, z}, x^2 + y^2 >= .5],
ContourStyle -> Green]
}]
Maybe something like this
pl = ContourPlot[x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1}]
points = pl[[1, 1]];
colorf[{x_, y_}] := ColorData["Rainbow"][Rescale[x, {-1, 1}]]
pl /. {Line[a_] :> {Line[a, VertexColors -> colorf /# points[[a]]]}}
which produces
This does not provide a direct solution to your question but I believe it is of interest.
It is possible to color a line progressively from within ContourPlot using what I think is an undocumented format, namely a Function that surrounds the Line object. Internally this is similar to what Heike did, but her solution uses the vertex numbers to then find the matching coordinates allowing styling by spacial position, rather than position along the line.
ContourPlot[
x^2 + (2 y)^2 == 1, {x, -1, 1}, {y, -1, 1},
BaseStyle -> {12, Thickness[0.01]},
ContourStyle ->
(Line[#, VertexColors -> ColorData["DeepSeaColors"] /# Rescale##] & ## # &)
]
For some of the less adept, less information is more. Time was wasted browsing for a way to set the color of contour lines until I chanced onto Roelig's edited answer. I just needed ContourStyle[].
Show[{ContourPlot[
x^2 + 2 x y Tan[2 # ] - y^2 == 1, {x, -3, 3}, {y, -3.2, 3.2},
ContourStyle -> Green] & /# Range[-Pi/4, Pi/4, .1]},
Background -> Black]
I'm working on mapping a temperature gradient in two dimensions and having a lot of trouble. My current approach is to define an Interpolating Function and then try to graph it a lot of times, then animate that table of graphs. Here's what I have so far:
RT = 388.726919
R = 1
FUNC == NDSolve[{D[T[x, y, t], t] ==
RT*(D[T[x, y, t], x, x] + D[T[x, y, t], y, y]),
T[x, y, 0] == 0,
T[0, y, t] == R*t,
T[9, y, t] == R*t,
T[x, 0, t] == R*t,
T[x, 9, t] == R*t},
T, {x, 0, 9}, {y, 0, 9}, {t, 0, 6}]
So the first two variables just control the rate of change. The equation I'm solving is the basic 2D heat equation, where dT/dt=a(d^2T/dx^2+d^2T/dy^2). The initial conditions set everything to 0, then define the edges as the source of the heat change. Right now it sweeps over a 9x9 block from t=0 to t=6.
The second part attempts to animate the function working.
ListAnimate[
Table[
DensityPlot[T[x, y, t] /. FUNC, {x, 0, 9}, {y, 0, 9}, Mesh -> 9]
, {t, 0, 6}]
]
Unfortunately, this doesn't work, and I'm going crazy trying to figure out why. I first thought it had something to do with the Interpolating Function but now I'm not so confident that the animating code works either. Anyone have any ideas?
Just a quick check:
RT = 1
R = 1
FUNC = NDSolve[{D[T[x, y, t], t] ==
RT*(D[T[x, y, t], x, x] + D[T[x, y, t], y, y]), T[x, y, 0] == 0,
T[0, y, t] == R*t,
T[9, y, t] == R*t,
T[x, 0, t] == R*t,
T[x, 9, t] == R*t}, T,
{x, 0, 9}, {y, 0, 9}, {t, 0, 6}];
a = Table[
Plot3D[T[x, y, t] /. FUNC, {x, 0, 9}, {y, 0, 9}, Mesh -> 15,
PlotRange -> {{0, 9}, {0, 9}, {-1, 10}},
ColorFunction -> Function[{x, y, z}, Hue[.3 (1 - z)]]], {t, 0, 6}]
Export["c:\anim.gif", a]
PS: A lot of mistakes are avoided by using a lowercase letter as the first char for your symbols...
I'm with Mark -- there is nothing wrong with your program. The problem is that nothing interesting happens to your function after t=0: Try having a look at
ListAnimate[
Table[Plot3D[T[x, y, t] /. FUNC, {x, 0, 9}, {y, 0, 9}, Mesh -> 9], {t, 0, 6}]]
As you can see, all that happens is a scaling, so that when DensityPlot rescales each frame independently, they end up looking identical :)