I am attempting to solve the linear biharmonic equation in mathematica using DSolve. I think this issue is not just limited to the biharmonic equation but MATHEMATICA just spits out the equation when I attempt to solve it.
I've tried solving other partial differential equations and there was no trouble.
The biharmonic equation is just:
Laplacian^2[f]=0
Here is my equation:
DSolve[
D[f[x, y], {x, 4}] + 2 D[D[f[x, y], {x, 2}, {y, 2}]] +
D[f[x, y], {y, 4}] == 0,
f,
{x, y}]
The solution is spit out as
DSolve[(f^(0,4))[x,y]+2 (f^(2,2))[x,y]+(f^(4,0))[x,y]==0,f,{x,y}]
That is obviously not the solution. What gives? What am I missing? I've solved other PDEs without boundary conditions.
How about try it in polar coordinates? If f(r, \[Theta]) is symmetric with respect to azimuth \[Theta], the biharmonic equation reduces to something Mathematca can solve symbolically (c.f. http://mathworld.wolfram.com/BiharmonicEquation.html):
In[22]:= eq = D[r D[D[r D[f[r],r],r]/r,r],r]/r;
eq//FullSimplify//TraditionalForm
Out[23]//TraditionalForm= f^(4)(r) + (2 r^2 f^(3)(r) - r f''(r)
+ f'(r))/r^3
In[24]:= DSolve[eq==0,f,r]
Out[24]= {{f -> Function[{r},
1/2 r^2 C[2] - 1/4 r^2 C[3] + C[4] + C[1] Log[r]
+ 1/2 r^2 C[3] Log[r]
]}}
In[25]:= ReplaceAll[
1/2 r^2 C[2]-1/4 r^2 C[3]+C[4]+C[1] Log[r]+1/2 r^2 C[3] Log[r],
r->Sqrt[x^2+y^2]
]
Out[25]= 1/2 (x^2+y^2) C[2]-1/4 (x^2+y^2) C[3]+C[4]+C[1] Log[Sqrt[x^2+y^2]]+
1/2 (x^2+y^2) C[3] Log[Sqrt[x^2+y^2]]
DSolve[D[f[x, y], {x, 4}] + 2 D[f[x, y], {x, 2}, {y, 2}] +
D[f[x, y], {y, 4}] == 0, f, {x, y}]
This ought to be the actual syntax
Related
Using ParametricPlot I can plot a lemniscate expressed in parametric coordinates:
ParametricPlot[1/(1 + Sin[t]^2) {Cos[t], Cos[t] Sin[t]}, {t, 0, 2 [Pi]}]
I want to find using Mathematica the equivalent cartesian expression and plot it using ContourPlot that I know to be:
ContourPlot[(x^2 + y^2)^2 == (x^2 \[Minus] y^2), {x, -1, 1}, {y,-1,1}]
Looking up among the MMA functions I wondered if CoordinateTransformData or TransformedField could help me but none of them has the appropriate coordinate transformation :"Parametric" -> "Cartesian" which had me baffled.
How can this be done ?
It depends how much automatic solution you want.
eq = Thread[{x, y} == 1/(1 + Sin[t]^2) {Cos[t], Cos[t] Sin[t]}];
cont = Eliminate[eq, t] // Simplify
y != 0 && x^4 + y^2 + 2 x^2 y^2 + y^4 == x^2
ContourPlot[Evaluate#Last#cont, {x, -1, 1}, {y, -1, 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]
When I try to calculate the following integral in Mathematica 8, I get this strange result:
In[1]:= Integrate[y/((1 + x^2 + y^2)^(3/2)), {y, 0, 1}]
Maple 14 can solve this one easily:
Why is Mathematica giving me a different result?
Try this
r = Integrate[y/((1 + x^2 + y^2)^(3/2)), {y, 0, 1}]
r = Assuming[Element[x, Reals], Simplify[r]];
Together[r]
which gives
(-Sqrt[1+x^2]+Sqrt[2+x^2])/(Sqrt[1+x^2] Sqrt[2+x^2])
Which is the same as Maple's :
I have a function f(x,y) of two variables, of which I need to know the location of the curves at which it crosses zero. ContourPlot does that very efficiently (that is: it uses clever multi-grid methods, not just a brute force fine-grained scan) but just gives me a plot. I would like to have a set of values {x,y} (with some specified resolution) or perhaps some interpolating function which allows me to get access to the location of these contours.
Have thought of extracting this from the FullForm of ContourPlot but this seems to be a bit of a hack. Any better way to do this?
If you end up extracting points from ContourPlot, this is one easy way to do it:
points = Cases[
Normal#ContourPlot[Sin[x] Sin[y] == 1/2, {x, -3, 3}, {y, -3, 3}],
Line[pts_] -> pts,
Infinity
]
Join ## points (* if you don't want disjoint components to be separate *)
EDIT
It appears that ContourPlot does not produce very precise contours. They're of course meant for plotting and are good enough for that, but the points don't lie precisely on the contours:
In[78]:= Take[Join ## points /. {x_, y_} -> Sin[x] Sin[y] - 1/2, 10]
Out[78]= {0.000163608, 0.0000781187, 0.000522698, 0.000516078,
0.000282781, 0.000659909, 0.000626086, 0.0000917416, 0.000470424,
0.0000545409}
We can try to come up with our own method to trace the contour, but it's a lot of trouble to do it in a general way. Here's a concept that works for smoothly varying functions that have smooth contours:
Start from some point (pt0), and find the intersection with the contour along the gradient of f.
Now we have a point on the contour. Move along the tangent of the contour by a fixed step (resolution), then repeat from step 1.
Here's a basic implementation that only works with functions that can be differentiated symbolically:
rot90[{x_, y_}] := {y, -x}
step[f_, pt : {x_, y_}, pt0 : {x0_, y0_}, resolution_] :=
Module[
{grad, grad0, t, contourPoint},
grad = D[f, {pt}];
grad0 = grad /. Thread[pt -> pt0];
contourPoint =
grad0 t + pt0 /. First#FindRoot[f /. Thread[pt -> grad0 t + pt0], {t, 0}];
Sow[contourPoint];
grad = grad /. Thread[pt -> contourPoint];
contourPoint + rot90[grad] resolution
]
result = Reap[
NestList[step[Sin[x] Sin[y] - 1/2, {x, y}, #, .5] &, {1, 1}, 20]
];
ListPlot[{result[[1]], result[[-1, 1]]}, PlotStyle -> {Red, Black},
Joined -> True, AspectRatio -> Automatic, PlotMarkers -> Automatic]
The red points are the "starting points", while the black points are the trace of the contour.
EDIT 2
Perhaps it's an easier and better solution to use a similar technique to make the points that we get from ContourPlot more precise. Start from the initial point, then move along the gradient until we intersect the contour.
Note that this implementation will also work with functions that can't be differentiated symbolically. Just define the function as f[x_?NumericQ, y_?NumericQ] := ... if this is the case.
f[x_, y_] := Sin[x] Sin[y] - 1/2
refine[f_, pt0 : {x_, y_}] :=
Module[{grad, t},
grad = N[{Derivative[1, 0][f][x, y], Derivative[0, 1][f][x, y]}];
pt0 + grad*t /. FindRoot[f ## (pt0 + grad*t), {t, 0}]
]
points = Join ## Cases[
Normal#ContourPlot[f[x, y] == 0, {x, -3, 3}, {y, -3, 3}],
Line[pts_] -> pts,
Infinity
]
refine[f, #] & /# points
A slight variation for extracting points from ContourPlot (possibly due to David Park):
pts = Cases[
ContourPlot[Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}],
x_GraphicsComplex :> First#x, Infinity];
or (as a list of {x,y} points)
ptsXY = Cases[
Cases[ContourPlot[
Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}],
x_GraphicsComplex :> First#x, Infinity], {x_, y_}, Infinity];
Edit
As discussed here, an article by Paul Abbott in the Mathematica Journal (Finding Roots in an Interval) gives the following two alternative methods for obtaining a list of {x,y} values from ContourPlot, including (!)
ContourPlot[...][[1, 1]]
For the above example
ptsXY2 = ContourPlot[
Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}][[1, 1]];
and
ptsXY3 = Cases[
Normal#ContourPlot[
Cos[x] + Cos[y] == 1/2, {x, 0, 4 Pi}, {y, 0, 4 Pi}],
Line[{x__}] :> x, Infinity];
where
ptsXY2 == ptsXY == ptsXY3
What's the best way of getting Mathematica 7 or 8 to do the integral
NIntegrate[Exp[-x]/Sin[Pi x], {x, 0, 50}]
There are poles at every integer - and we want the Cauchy principle value.
The idea is to get a good approximation for the integral from 0 to infinity.
With Integrate there is the option PrincipleValue -> True.
With NIntegrate I can give it the option Exclusions -> (Sin[Pi x] == 0), or manually give it the poles by
NIntegrate[Exp[-x]/Sin[Pi x], Evaluate[{x, 0, Sequence##Range[50], 50}]]
The original command and the above two NIntegrate tricks give the result 60980 +/- 10. But they all spit out errors. What is the best way of getting a quick reliable result for this integral without Mathematica wanting to give errors?
Simon, is there reason to believe your integral is convergent ?
In[52]:= f[k_Integer, eps_Real] :=
NIntegrate[Exp[-x]/Sin[Pi x], {x, k + eps, k + 1 - eps}]
In[53]:= Sum[f[k, 1.0*10^-4], {k, 0, 50}]
Out[53]= 2.72613
In[54]:= Sum[f[k, 1.0*10^-5], {k, 0, 50}]
Out[54]= 3.45906
In[55]:= Sum[f[k, 1.0*10^-6], {k, 0, 50}]
Out[55]= 4.19199
It looks like the problem is at x==0. Splitting integrand k+eps to k+1-eps for integer values of k:
In[65]:= int =
Sum[(-1)^k Exp[-k ], {k, 0, Infinity}] Integrate[
Exp[-x]/Sin[Pi x], {x, eps, 1 - eps}, Assumptions -> 0 < eps < 1/2]
Out[65]= (1/((1 +
E) (I + \[Pi])))E (2 E^(-1 + eps - I eps \[Pi])
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(-2 I eps \[Pi])] +
2 E^(I eps (I + \[Pi]))
Hypergeometric2F1[1, (I + \[Pi])/(2 \[Pi]), 3/2 + I/(2 \[Pi]),
E^(2 I eps \[Pi])])
In[73]:= N[int /. eps -> 10^-6, 20]
Out[73]= 4.1919897038160855098 + 0.*10^-20 I
In[74]:= N[int /. eps -> 10^-4, 20]
Out[74]= 2.7261330651934049862 + 0.*10^-20 I
In[75]:= N[int /. eps -> 10^-5, 20]
Out[75]= 3.4590554287709991277 + 0.*10^-20 I
As you see there is a logarithmic singularity.
In[79]:= ser =
Assuming[0 < eps < 1/32, FullSimplify[Series[int, {eps, 0, 1}]]]
Out[79]= SeriesData[eps, 0, {(I*(-1 + E)*Pi -
2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1]
In[80]:= Normal[
ser] /. {{eps -> 1.*^-6}, {eps -> 0.00001}, {eps -> 0.0001}}
Out[80]= {4.191989703816426 - 7.603403526913691*^-17*I,
3.459055428805136 -
7.603403526913691*^-17*I,
2.726133068607085 - 7.603403526913691*^-17*I}
EDIT
Out[79] of the code above gives the series expansion for eps->0, and if these two logarithmic terms get combined, we get
In[7]:= ser = SeriesData[eps, 0,
{(I*(-1 + E)*Pi - 2*(1 + E)*HarmonicNumber[-(-I + Pi)/(2*Pi)] +
Log[1/(4*eps^2*Pi^2)] - 2*E*Log[2*eps*Pi])/(2*(1 + E)*
Pi),
(-1 + E)/((1 + E)*Pi)}, 0, 2, 1];
In[8]:= Collect[Normal[PowerExpand //# (ser + O[eps])],
Log[eps], FullSimplify]
Out[8]= -(Log[eps]/\[Pi]) + (
I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
Clearly the -Log[eps]/Pi came from the pole at x==0. So if one subtracts this, just like principle value method does this for other poles you end up with a finitely value:
In[9]:= % /. Log[eps] -> 0
Out[9]= (I (-1 + E) \[Pi] -
2 (1 + E) (HarmonicNumber[-((-I + \[Pi])/(2 \[Pi]))] +
Log[2 \[Pi]]))/(2 (1 + E) \[Pi])
In[10]:= N[%, 20]
Out[10]= -0.20562403655659928968 + 0.*10^-21 I
Of course, this result is difficult to verify numerically, but you might know more that I do about your problem.
EDIT 2
This edit is to justify In[65] input that computes the original regularized integral. We are computing
Sum[ Integrate[ Exp[-x]/Sin[Pi*x], {x, k+eps, k+1-eps}], {k, 0, Infinity}] ==
Sum[ Integrate[ Exp[-x-k]/Sin[Pi*(k+x)], {x, eps, 1-eps}], {k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k]*Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}],
{k, 0, Infinity}] ==
Sum[ (-1)^k*Exp[-k], {k, 0, Infinity}] *
Integrate[ Exp[-x]/Sin[Pi*x], {x, eps, 1-eps}]
In the third line Sin[Pi*(k+x)] == (-1)^k*Sin[Pi*x] for integer k was used.
Simon, I haven't spent much time with your integral, but you should try looking at stationary phase approximation. What you have is a smooth function (exp), and a highly oscillatory function (sine). The work involved is now in brow-beating the 1/sin(x) into the form exp(if(x))
Alternatively, you could use the series expansion of the cosecant (not valid at poles):
In[1]:=Series[Csc[x], {x, 0, 5}]
(formatted) Out[1]=1/x + x/6 + 7/360 x^3 + 31/15120 x^5 +O[x]^6
Note that for all m>-1, you have the following:
In[2]:=Integrate[x^m Exp[-x], {x, 0, Infinity}, Assumptions -> m > -1]
Out[2]=Gamma[1+m]
However, summing the series with the coefficients of cosecant (from wikipedia), not including 1/x Exp[-x] case, which doesn't converge on [0,Infinity].
c[m_] := (-1)^(m + 1) 2 (2^(2 m - 1) - 1) BernoulliB[2 m]/Factorial[2 m];
Sum[c[m] Gamma[1 + 2 m - 1], {m, 1, Infinity}]
does not converge either...
So, I'm not sure that you can work out an approximation for the integral to infinity, but I if you're satisfied with a solution upto some large N, I hope these help.
I have to agree with Sasha, the integral does not appear to be convergent. However, if you exclude x == 0 and break the integral into pieces
Integrate[Exp[-x]/Sin[Pi x], {x, n + 1/2, n + 3/2}, PrincipalValue -> True]
where n >= 0 && Element[n, Integers], then it seems you may get an alternating series
I Sum[ (-1/E)^n, {n, 1, Infinity}] == - I / (1 + E )
Now, I only took it out to n == 4, but it looks reasonable. However, for the integral above with Assumptions -> Element[n, Integers] && n >= 0 Mathematica gives
If[ 2 n >= 1, - I / E, Integrate[ ... ] ]
which just doesn't conform to the individual cases. As an additional note, if the pole lies at the boundary of the integration region, i.e. your limits are {x, n, n + 1}, you only get DirectedInfinitys. A quick look at the plot implies that you with the limits {x, n, n + 1} you only have a strictly positive or negative integrand, so the infinite value may be due to the lack of compensation which {x, n + 1/2, n + 3/2} gives you. Checking with {x, n, n + 2}, however it only spits out the unevaluated integral.