0

I have certain systems of equations for which I need ANY solution if one exists. Can I get MMa to just do that?

This doesn't work:

nParticles = 4;
nPow = 2;
m = {0, 1, 0, 1};
soln = Table[Sum[a[i]^n, {i, 1, nParticles}]/nParticles == m[[n]], {n, 1, nPow}];
start = Table[{a[i], RandomReal[1] - .5}, {i, 1, nParticles}];
aa = FindRoot[soln, start]

...because it's underdetermined. It works perfectly if nParticles==nPow.

There's a similar question here: Any solution to system of equations? but the Answer-er gave an elegant MATH solution instead of a MMa solution.

Jerry Guern
  • 4,602
  • 18
  • 47

2 Answers2

4

I used something like the following in Plotting implicitly-defined space curves.

Clear[findPoint, pseudonewton];
pseudonewton[f_List, vars_] := pseudonewton[f, D[f, {vars}]]; 
pseudonewton[f_List, df_?MatrixQ, vars_] := 
 With[{df0 = df /. Thread[vars -> #], f0 = f /. Thread[vars -> #]},
   # - PseudoInverse[df0].f0] &;

findPoint[eqs_List, {vars_, p0_}] := 
  With[{f = eqs /. {Equal -> Subtract}}, 
   Thread[vars -> 
     NestWhile[pseudonewton[f, D[f, {vars}], vars], p0, 
      Norm[f /. Thread[vars -> #]] > 1*^-15 &, 2, 100]]
   ];

findPoint[soln, Transpose@start]
(*  {a[1] -> 0.741866, a[2] -> -0.0513263, a[3] -> -1.61188, a[4] -> 0.921336}  *)

soln /. %
(*  {True, True}  *)
Michael E2
  • 235,386
  • 17
  • 334
  • 747
1

Not hard.

vars = Table[a[i], {i, 1, nParticles}];
FindInstance[soln, vars]

(* {{a[1] -> 0, a[2] -> 0, a[3] -> -Sqrt[2], a[4] -> Sqrt[2]}} *)
John Doty
  • 13,712
  • 1
  • 22
  • 42