Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Numerical Computation sorted by activeSpecifying meshes and boundaries in NDSolveValue
https://community.wolfram.com/groups/-/m/t/1665050
I am trying to solve Laplace's equations in two-dimensions in order obtain the voltage field with specified regions and boundaries. One of the regions in the problem is a half-disk. I wish to specify a voltage on the boundary of that half-disk. I do not think that I know what my problem is, but I suspect that the boundary I am generating for that half-disk is wrong.
Ultimately NDSolveValue appears to work, but does not give a plausible answer. This problem does not require much code. It would be very helpful if someone could examine it and let me know what I am doing wrong.Robert Curl2019-04-20T21:53:54ZVisualizing simultaneous iteration methods for polynomial roots
https://community.wolfram.com/groups/-/m/t/1646447
One of my longstanding research interests in numerical analysis has been the family of "simultaneous iteration" methods for finding polynomial roots. (See e.g. [McNamee's book][1] for a comprehensive survey.) Briefly put, these are modified Newton-Raphson methods that allow one to find the roots of a polynomial all at once, as opposed to finding them one at a time and "deflating".
I had the idea to visualize how these algorithms gradually proceed from initial approximations to the roots, up to convergence. After a number of experiments, I settled on using [domain coloring][2] for visualization. I have found that the logarithmic derivatives of polynomials gave particularly striking plots.
For this post, I have used the scaled [exponential sum][3] of degree 20:
$$\frac{20!}{20^{20}}\sum_{k=0}^{20}\frac{(20z)^k}{k!}$$
as the example polynomial whose roots we want to see. It [is][4] [known][5] that the zeroes of this polynomial asymptotically approach the so-called Szegő curve as the polynomial degree goes to infinity.
![Szegő curve][6]
expPoly[x_] = With[{n = 20}, Sum[(n! (n x)^k)/(k! n^n), {k, 0, n}]]
---
I will now look at two of the most popular simultaneous iteration methods. The first one is the [(Weierstrass-)Durand-Kerner method][7],
$$x_i^{(k+1)}=x_i^{(k)}-\frac{p(x_i^{(k)})}{\prod\limits_{j\neq i} (x_i^{(k)}-x_j^{(k)})},\qquad i=1\dots n;\; k=0,1,\dots$$
which is (typically) quadratically convergent. (Note that in simultaneous iteration methods, the polynomials are always assumed to be monic (i.e., unit leading coefficient).)
Implementing the iteration is easy using `FixedPointList[]`. As is customary with these methods, we use as a starting approximation points equispaced around the unit circle, and slightly rotated:
ptsdk = FixedPointList[# - expPoly[#]/Table[Apply[Times, #[[k]] - Delete[#, k]],
{k, Length[#]}] &,
N[Exp[2 π I Range[0, 19]/20 - I π/40]], 40,
SameTest -> (EuclideanDistance[##] < 1.*^-6 &)];
I use a loose convergence criterion that is good enough for visualization purposes.
For the domain coloring plot, I will use a slightly modified version of the [DLMF color scheme][8], based on an idea of [Quilez][9].
DLMFPhaseColor[u_, s_:1, b_:1] := Module[{rgb},
rgb = Clip[{1, -1, -1} Abs[{8, 4, 8} Mod[u/(2 π), 1] -
{9, 3, 11}/2] + {-3, 3, 5}/2, {0, 1}];
rgb = (3 - 2 rgb) rgb^2;
Apply[RGBColor, b (1 + s (rgb - 1))]]
I then use a simplified version of [code originally written by user Heike][10] on Mathematica Stack Exchange:
dcdk = RegionPlot[True, {x, -9/8, 9/8}, {y, -9/8, 9/8},
ColorFunction ->
Function[{x, y}, DLMFPhaseColor[Arg[Total[1/(x + I y - #)]]]],
ColorFunctionScaling -> False, Frame -> False,
PlotPoints -> 405] & /@ ptsdk;
(This takes some time, due to the high `PlotPoints` setting.)
We can now see an animation:
ListAnimate[dcdk]
![Durand-Kerner][11]
The other method I will be looking at in this post is the (typically) cubically convergent [Ehrlich-Aberth(-Maehly) method][12],
$$x_i^{(k+1)}=x_i^{(k)}-\frac{\tfrac{p(x_i^{(k)})}{p^\prime(x_i^{(k)})}}{1-\tfrac{p(x_i^{(k)})}{p^\prime(x_i^{(k)})}\sum\limits_{j\neq i} \tfrac1{x_i^{(k)}-x_j^{(k)}}},\qquad i=1\dots n;\; k=0,1,\dots$$
which is also one of the methods available in *Mathematica*'s `NSolve[]`/`NRoots[]`.
Unfortunately, I have no way to get the iterates generated by `NSolve[]`, so I had to reimplement the method myself. We can use essentially the same code as was used for Durand-Kerner, with a few changes:
ptsea = FixedPointList[With[{ld = expPoly[#]/expPoly'[#]},
# - ld/(1 - ld Table[Tr[1/(#[[k]] - Delete[#, k])],
{k, Length[#]}])] &,
N[Exp[2 π I Range[0, 19]/20 - I π/40]], 40,
SameTest -> (EuclideanDistance[##] < 1.*^-6 &)];
dcea = RegionPlot[True, {x, -9/8, 9/8}, {y, -9/8, 9/8},
ColorFunction ->
Function[{x, y}, DLMFPhaseColor[Arg[Total[1/(x + I y - #)]]]],
ColorFunctionScaling -> False, Frame -> False,
PlotPoints -> 405] & /@ ptsea;
ListAnimate[dcea]
![Ehrlich-Aberth][13]
It would be interesting to use this visualization technique on other polynomials with interesting root structure, as well as other simultaneous iteration methods.
[1]: https://books.google.com/books?hl=en&id=4PMqxwG-eqQC&pg=PA67
[2]: https://en.wikipedia.org/wiki/Domain_coloring
[3]: http://mathworld.wolfram.com/ExponentialSumFunction.html
[4]: https://doi.org/10.1216/rmjm/1181072998
[5]: https://doi.org/10.1007/BFb0087909
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=vpliw.gif&userId=520181
[7]: https://en.wikipedia.org/wiki/Durand%E2%80%93Kerner_method
[8]: https://dlmf.nist.gov/help/vrml/aboutcolor#S2
[9]: https://www.shadertoy.com/view/MsS3Wc
[10]: https://mathematica.stackexchange.com/a/7293/
[11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=dcdk.gif&userId=520181
[12]: https://en.wikipedia.org/wiki/Aberth_method
[13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=dcea.gif&userId=520181J. M.2019-04-04T04:38:26ZBoundary conditions are not satisfied with NDSolve. Why?
https://community.wolfram.com/groups/-/m/t/1664540
I want to study the time evolution of a small perturbation around the static solution of the following Wave Equation
$ -\partial_t^2 v(t,r) + \partial_r^2v(t,r) + \frac{2}{r}\partial_r v(t,r) = \frac{\partial V(v)}{\partial v}(t,r) $
for some expression of the potential $V(v)$ that is written in the code below. The coordinates $t,r$ run over $[0,+\infty]$.
By definition, the static solution $\hat{v}(r)$ is time-independent and I require the following initial/boundary conditions
$ \partial_r \hat{v}(r)|_{r=0} =0\,,\qquad \hat{v}(r \rightarrow +\infty) = 0. $
Obviously, to perform numerical computations the limit $r\rightarrow+\infty$ is replaced by $r=M$ where $M\gg \ell$ where $\ell$ is the characteristic length of the problem; it turns out to be $\ell \sim 2$ for the static solution.
I want to perturb this solution at $t=0$ and see how it evolves with time. So, now I am interested in the time-dependent solution which satisfies
$ v(t=0,r) = \hat{v}(r)\,\qquad \partial_t v(r,t)|_{t=0}=\delta \cdot 10^{-2}\,,\\
\partial_r v(t,r)|_{r=0}=0\,, \qquad v(r=M) = 0. $
where $\delta\ll 1$.
- While the numerical static solution satisfies $\hat{v}'(r=0)=0$, the time-dependent solution I got does not. I don't understand why. For a specific example with $\delta = 0.001$, I get $\partial_r v(t,r) \sim -0.000701892$ irrespectively of the value of the time variable `t`. In particular, it looks the initial condition $v(t=0,r) = \hat{v}(r)$ is not satisfied. Is this normal?
- Moreover, I get the error [![enter image description here][1]][1], why? Are my boundary conditions really inconsistent?
This is my code.
V[v_] = (-1 + (1/8 (-9 + Sqrt[145]) - v)^2)^2 + 3 (1/8 (-9 + Sqrt[145]) - v)^3;
sol[rmax_, \[Delta]_] := Last@Last@ Last@NDSolve[{+D[v[r], {r, 2}] + 2/r D[v[r], {r, 1}] - (D[V[v], v] /. v -> v[r]) == 0, (D[v[r], r] /. r -> SetPrecision[10^-10, 100]) == 0, v[SetPrecision[10^-10, 100]] == SetPrecision[\[Delta], 100]}, v, {r, 10^-10, rmax}, WorkingPrecision -> 50, Method -> "Extrapolation"]
iTf = sol[30, 1.506400187591933106770472351];
Plot[{iTf[r]}, {r, 0, 30}, PlotRange -> All, Frame -> True]
iTfTime = v /. ParametricNDSolve[{-D[v[t, r], {t, 2}] + D[v[t, r], {r, 2}] + 2/r D[v[t, r], {r, 1}] - (D[V[v], v] /. v -> v[t, r]) == 0, v[0, r] == iTf[r], ((D[v[t, r], t]) /. t -> 0) == +\[Delta] 10^-2, (D[v[t, r], r] /. r -> 10^-10) == 0}, v, {t, 0, 40}, {r, 10^-10, 30}, {\[Delta]}, WorkingPrecision -> MachinePrecision, Method -> {"MethodOfLines", "TemporalVariable" -> t, "SpatialDiscretization" -> {"TensorProductGrid", "MinPoints" -> 200}}, PrecisionGoal -> 15]
iTfTimeToPlot0 = iTfTime[0.001];
(*Checking boundary conditions in generic points*)
((D[iTfTimeToPlot0[t, r], t] /. t -> 0) /. r -> RandomReal[]) == +0.001 10^-2
(*Output: True*)
((D[iTfTimeToPlot0[t, r], r] /. r -> 10^-10) /. t -> RandomReal[]) == 0
(*Output: False*)
[1]: https://i.stack.imgur.com/SPDnN.pngmathPhys User2019-04-19T11:01:29Z