Re: I have A Problem
- To: mathgroup at smc.vnet.net
- Subject: [mg14671] Re: I have A Problem
- From: Daniel Lichtblau <danl>
- Date: Sat, 7 Nov 1998 02:10:27 -0500
- Organization: Wolfram Research, Inc.
- References: <71q7j9$iu0@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
'Kale Oyedeji wrote:
>
> The problem below continues for ever. What am I doing wrong?
>
> 'Kale Oyedeji
>
> > NSolve[{u^2-.75*x*(1+y+2*y^2+(1/3)*u*z+2*z^2)==0,
> > .775*x*z+u-.25*u*x*(1+y+2*y^2+2*z^2)==0,
> > 9*u^2*y+3*u*z-.25*x*(1+6*y+3*y^3+3*y*z^2)-
> > 1.5*u*x*z*(1+.5*y^2+.5*z^2)==0,
> > 9*u^2*z-3*u*y-1.5*x*(1+.5*y^2+.5*z^2)+.25*u*x*(1+6*y+3*y^3+3*y*z^2)==0},{u,
> > x,y,z}]
> >
NSolve will not have any chance with this one as it is now posed. The
solution set is not zero dimensional, that is, there are not finitely
many distinct solutions, and NSolve cannot do anything useful in this
situation. To get specific solutions I first tried FindMinimum. Doing
this gave the obvious one where all variables are zero. I then added a
new variable and equation to force u away from zero. This ploy
succeeded in finding another solution.
Here is the code that forced u away from zero.
In[64]:= polys = {u^2-3/4*x*(1+y+2*y^2+(1/3)*u*z+2*z^2),
31/40*x*z+u-1/4*u*x*(1+y+2*y^2+2*z^2),
9*u^2*y+3*u*z-1/4*x*(1+6*y+3*y^3+3*y*z^2)-
3/2*u*x*z*(1+1/2*y^2+1/2*z^2),
9*u^2*z-3*u*y-3/2*x*(1+1/2*y^2+1/2*z^2)+
1/4*u*x*(1+6*y+3*y^3+3*y*z^2), u*new-10};
In[65]:= norm = polys.polys;
In[66]:= vars = {u,x,y,z,new};
In[67]:= start = Apply[Sequence,
Transpose[{vars,Table[Random[], {Length[vars]}]}]]
Out[67]= Sequence[{u, 0.0353295}, {x, 0.695102}, {y, 0.883116},
{z, 0.450263}, {new, 0.632137}]
In[68]:= Timing[{min, rts} =
FindMinimum[norm, Evaluate[start],
Method->LevenbergMarquardt,
MaxIterations->100]]
-29 Out[68]= {0.08 Second, {4.08236 10
,
{u -> 1.9589, x -> 4.34226, y -> 0.0675919, z -> 0.11501,
new -> 5.10489}}}
Paul Abbott (private e-mail) sent to the poster and myself a result
obtained quite readily with FindRoot and a starting value away from
u=0. This made me suspect that there is a zero-dimensional subset of
solutions obtained by insisting u!=0 because otherwise I think FindRoot
would have given a "vanishing gradient" message and quit.
Extracting this zero-dimensional subset of solutions can be done, at
least in our development version, using NSolve. I show the code below;
we simply augment the original system by a polynomial that forces u
away from zero and them we eliminate the extra variable used in that
equation.
In[75]:= Timing[sol = NSolve[polys, {u,x,y,z}, new];] Out[75]= {48.61
Second, Null}
I get 20 solutions this way, though two other candidates were lost due
to insufficient precision (I suppressed the warning messages that show
this). We now see another advantage to exact input; we can up the
WorkingPrecision. When I do this with WorkingPrecision->200 I get 22
solutions; it takse about twice as long. Among them is the one given
by:
eqns = Thread[polys==0];
FindRoot[eqns, {u, 1}, {x, 1}, {y, 1}, {z, 1},
WorkingPrecision -> 30, MaxIterations -> 50]
which is how Paul found an isolated one.
This NSolve is not yet avaliable so for now FindRoot or FindMinimum
would be the best functions to use.
Daniel Lichtblau
Wolfram Research