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.
Related
While playing with Fourier Integrals, I've noticed my computations taking an excessively long time to calculate. I just have two sets of a Piecewise function, two functions and two integrals. I wouldn't think Mathematica would need to take so long to compute these. What, in particular, is slowly my computations down so much? How can I improve computation time? Will using some combination of memoization help ( :=, for which I don't quite understand)?
Decreasing the Limit on the integrals helps slightly, but not as much as I'd think.
My code is the following:
MM = 50;
qf = 10;
(*First Set*)
f[t_] = Piecewise[{{1, t <= 0.5}, {0, t > 0.5}}];
A[w_] = qf Sin[w/2]/(Pi w);
B[w_] = qf (1 - Cos[w/2])/(Pi w);
f[x_] = Integrate[A[w] Cos[w x], {x, 0, MM}];
g[x_] = Integrate[B[w] Sin[w x], {x, 0, MM}];
Plot[f[x], {x, 0, 1}]
Plot[g[x], {x, 0, 1}]
Plot[f[x] + g[x], {x, 0, 1}]
(*Second Set*)
ff[t_] = Piecewise[{{1, t <= 0.5}, {0, t > 0.5}}];
AA[w_] = qf (Sin[w] - Sin[w/2])/(Pi w);
BB[w_] = -qf (Cos[w] - Cos[w/2])/(Pi w);
ff[x_] = Integrate[AA[w] Cos[w x], {x, 0, MM}];
gg[x_] = Integrate[BB[w] Sin[w x], {x, 0, MM}];
Plot[ff[x], {x, 0, 1}]
Plot[gg[x], {x, 0, 1}]
Plot[ff[x] + gg[x], {x, 0, 1}]
You have several problems with your code as shown:
You haven't defined w so e.g. f[x_] isn't fully evaluated
you define f[t_] then f[x_] which overwrites the first definition
You're misusing Piecewise. It should be something like pw = Piecewise[{{Sin[x]/x, x < 0}, {1, x == 0}}, -x^2/100 + 1]
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!
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 don't use Mathematica in general and I need it to compare with an other program. I want to solve a system of three differential and non linear equations. For this I use Dsolve. Everything goes wrong when I put the nonlinear term (exponential).
Here is my code:
equa = {x'[t] == z[t] - Exp[y[t]],
y'[t] == z[t] - y[t],
z'[t] == x[t] + y[t] - z[t],
x[0] == 0,
y[0] == 0,
z[0] == 0};
slt = DSolve[equa, {x, y, z}, t]
Plot[{x[t] /. slt}, {t, 0, 10}]
And the errors are like this :
DSolve::dsvar: 0.1 cannot be used as a variable.
ReplaceAll::reps:{Dsolve[<<1>>]} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing
Does someone know why the exponential term makes troubles ?
Thanks
You may try
s = NDSolve[equa, {x, y, z}, {t, 0, 10}];
Plot[Evaluate[({x[t], y[t], z[t]} /. s)], {t, 0, 1}]
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]