Re: FindRoot / Jacobian
- To: mathgroup at smc.vnet.net
- Subject: [mg84410] Re: FindRoot / Jacobian
- From: "Steve Luttrell" <steve at _removemefirst_luttrell.org.uk>
- Date: Fri, 21 Dec 2007 20:42:23 -0500 (EST)
- References: <fk73ub$6el$1@smc.vnet.net> <fk87t2$4f6$1@smc.vnet.net> <fkcst0$1fv$1@smc.vnet.net> <fkfstl$3n$1@smc.vnet.net>
I apologise. That wasn't a very clear (or even correct!) way of explaining
it.
Try this:
Evaluate
Plot3D[solU, {p, 0, 10 \[Pi]}, {q, 0, 10 \[Pi]}]
Plot3D[solV, {p, 0, 10 \[Pi]}, {q, 0, 10 \[Pi]}]
which shows the periodicity (modulo 2Pi) of solU and solV in the (p,q)
plane, which means that each solution of
FindRoot[solU == N[u] && solV == N[v], {{p, 0}, {q, 0}}]
is also modulo 2Pi.
A quick fix to my earlier solution is to constrain the solutions to lie in
[-Pi,Pi]
solutions=Table[FindRoot[solU==N[u]&&solV==N[v],{{p,0,-\[Pi],\[Pi]},{q,0,-\[Pi],\[Pi]}}],{u,-\[Pi],\[Pi],(2\[Pi])/70},{v,-\[Pi],\[Pi],(2\[Pi])/70}];
then the quick graphic to visualise the solutions is
Graphics[{Map[Point,#,{2}],Map[Line,#],Map[Line,Transpose[#]]}&[{p,q}/.solutions//Chop]]
which looks much smoother than the graphic I obtained before without
constraining the solutions, though there are still places where the lines in
the graphic jump about.
I presume that by using a more intelligent choice of initial search point
and constraint range in FindRoot you can make the solution vary smoothly
everywhere.
Stephen Luttrell
West Malvern, UK
"Steve Luttrell" <steve at _removemefirst_luttrell.org.uk> wrote in message
news:fkfstl$3n$1 at smc.vnet.net...
>I don't think the problem is to do with precision issues. If you look at
>the
> plots
>
> Plot3D[solU, {p, 0, 2 \[Pi]}, {q, 0, 2 \[Pi]}]
> Plot3D[solV, {p, 0, 2 \[Pi]}, {q, 0, 2 \[Pi]}]
>
> it is clear that there is a continuum of solutions from which
>
> FindRoot[solU == N[u] && solV == N[v], {{p, 0}, {q, 0}}]
>
> picks a single solution, whilst warning you that it is having difficulty
> finding a unique solution by outputting the following message:
>
> "The line search decreased the step size to within tolerance specified by
> AccuracyGoal and PrecisionGoal but was unable to find a sufficient
> decrease
> in the merit function."
>
> I seem to have I overlooked this warning message earlier.
>
> Stephen Luttrell
> West Malvern, UK
>
> <sigmundv at gmail.com> wrote in message news:fkcst0$1fv$1 at smc.vnet.net...
>> Thank you for the suggestion, Steve. It sure helped me clean up the
>> code and get rid of the complex values (which was expected since I
>> used complex starting points in FindRoot before).
>>
>> Do you know how I can increase the precision in FindRoot, without
>> increasing the computing time dramatically? If you plot p/.solutions
>> and q/.solutions, respectively, using e.g. the ListSurfacePlot3D
>> command, you see some peaks. Ideally those peaks should not be there.
>> Do you have any clever suggestion on how to get rid of those peaks?
>>
>> Sigmund Vestergaard
>> Kongens Lyngby, Denmark
>>
>> On Dec 18, 11:37 am, "Steve Luttrell"
>> <steve at _removemefirst_luttrell.org.uk> wrote:
>>> Here is how you can solve your problem:
>>>
>>> solU=(E^((-I)*p-(2*ArcTan[Tan[q/2]/Sqrt[3]])/Sqrt[3])*(1+E^((2*I)*p)))/2
>>> solV=Sin[p]/E^((2*ArcTan[Tan[q/2]/Sqrt[3]])/Sqrt[3])
>>>
>>> solutions=Table[FindRoot[solU==N[u]&&solV==N[v],{{p,0},{q,0}}],{u,-\[Pi],\[Pi],(2\[Pi])/70},{v,-\[Pi],\[Pi],(2\[Pi])/70}];
>>>
>>> You can do a quick visualisation of the solutions with the following
>>> graphics:
>>>
>>> Graphics[{Map[Point,#,{2}],Map[Line,#],Map[Line,Transpose[#]]}&[{p,q}/.solutions//Chop]]
>>>
>>> Stephen Luttrell
>>> West Malvern, UK
>>>
>>> <sigmu... at gmail.com> wrote in messagenews:fk73ub$6el$1 at smc.vnet.net...
>>> > Dear readers,
>>>
>>> > Consider the following expressions:
>>>
>>> > solU = (E^((-I)*p - (2*ArcTan[Tan[q/2]/Sqrt[3]])/Sqrt[3])*(1 +
>>> > E^((2*I)*p)))/2
>>>
>>> > solV = Sin[p]/E^((2*ArcTan[Tan[q/2]/Sqrt[3]])/Sqrt[3])
>>>
>>> > I then want to solve the system of equations (u = solU, v = solV)
>>> > numerically on a grid (u,v) \in (-pi,pi). For that purpose I use
>>> > FindRoot, and execute the following:
>>>
>>> > u1 = Pi; du = 2*Pi/70;
>>>
>>> > uvPts1 = Flatten[Table[{u, v}, {u, u1 + du, u2 - du, du}, {v, v1 +
>>> > du,
>>> > v2 - du, dv}], 1];
>>>
>>> > uvNew = {p, q} /. Table[FindRoot[{solU == uvPts1[[i, 1]], solV ==
>>> > uvPts1[[i, 2]]}, {p,
>>> > -2}, {q, 1+I}], {i, Length[uvPts1]}];
>>>
>>> > This gives me a p-value and a q-value for each point on the grid, no
>>> > problem. However, I get the wrong solution at some of the grid points.
>>> > Since I get several of the following type of messages, this would be
>>> > expected:
>>>
>>> > FindRoot::jsing:Encountered a singular Jacobian at the point {p,q} = \
>>> > {-10.4516+0.784848 \[ImaginaryI],108.092+104.013 \[ImaginaryI]}. Try \
>>> > perturbing the initial point(s). >>
>>>
>>> > Then I would like to know if there is any 'nice' way to handle these
>>> > 'singular Jacobian' errors? Does there exist any kind of 'event
>>> > handler', as in NDSolve?
>>>
>>> > Kind regards,
>>> > Sigmund Vestergaard
>>
>>
>
>