How to remove unnecessary answers from NSolve without losing speed?

Question

This code:

eqs =
  {Ca/u^2 + 
      r (6 a (c^2 - d^2) + 12 b c d + 6 (a^2 + b^2 + c^2 + d^2) Ca + 
         Ca^3) == 0,
    a (1/u^2 - 1) + 
      r (3 a (a^2 + b^2) + 6 a (c^2 + d^2) + 3 c^2 Ca - 3 d^2 Ca + 
         3 a Ca^2) == 1/2,
    b (1/u^2 - 1) + 
      r (3 b (a^2 + b^2) + 6 b (c^2 + d^2) + 6 c d Ca + 3 b Ca^2) == 0,
    c (1/u^2 - 1/4) + 
      r (6 (a^2 + b^2) c + 3 c (c^2 + d^2) + 6 (a c + b d) Ca + 
         3 c Ca^2) == 0,
    d (1/u^2 - 1/4) + 
      r (6 (a^2 + b^2) d + 3 d (c^2 + d^2) + 6 (-a d + b c) Ca + 
         3 d Ca^2) == 0, c > 0, d >= 0,
QQQ == c^2 + d^2, QQQ != 0
    } // Rationalize[#, 0] &;
NSolve[eqs /. {u -> 5, r -> 0.04}, {a, b, c, d, Ca, QQQ}, Reals]

Gives me this answer:

{{a -> -0.732167, b -> 0, c -> 1.06332, d -> 0, Ca -> 0.443594, 
  QQQ -> 1.13066}, 
 {a -> -0.732167, b -> 0, c -> 1.06332, d -> 0, 
  Ca -> 0.443594, QQQ -> 1.13066}, 
 {a -> -0.732167, b -> 0, 
  c -> 1.06332, d -> 0, Ca -> 0.443594, 
  QQQ -> 1.13066}, {a -> -0.732167, b -> 0, c -> 1.06332, d -> 0, 
  Ca -> 0.443594, QQQ -> 1.13066}, {a -> -0.698614, b -> 0, 
  c -> 0.622043, d -> 0.622043, Ca -> 0, 
  QQQ -> 0.773876}, {a -> -0.698614, b -> 0, c -> 0.622043, 
  d -> 0.622043, Ca -> 0, QQQ -> 0.773876}, {a -> -0.698614, b -> 0, 
  c -> 0.622043, d -> 0.622043, Ca -> 0, 
  QQQ -> 0.773876}, {a -> -0.698614, b -> 0, c -> 0.622043, 
  d -> 0.622043, Ca -> 0, QQQ -> 0.773876}, {a -> -0.698614, b -> 0, 
  c -> 0.622043, d -> 0.622043, Ca -> 0, 
  QQQ -> 0.773876}, {a -> -0.698614, b -> 0, c -> 0.622043, 
  d -> 0.622043, Ca -> 0, QQQ -> 0.773876}, {a -> -0.698614, b -> 0, 
  c -> 0.622043, d -> 0.622043, Ca -> 0, QQQ -> 0.773876}}

But as you see, there are several identical answers. And if a make WorkingPrecision -> 3, for example, this code is slow down. Maybe there is other methods to make this code faster?

"But as you see, there are several identical answers." - that's a sign that those are multiple roots, which might present special considerations. You are fortunate that NSolve[] is telling you this. — J. M.'s missing motivation, Jan 21 '21 at 12:08
J.M. pointed out duplicate zeros, but if only a single solution was wanted, replace NSolve with FindInstance. But be aware that there are other solutions! — rmw, Jan 21 '21 at 13:04

score 1 · Accepted Answer · answered Jan 21 '21 at 15:03

eqs = {Ca/u^2 + 
     r (6 a (c^2 - d^2) + 12 b c d + 6 (a^2 + b^2 + c^2 + d^2) Ca + Ca^3) == 
    0, a (1/u^2 - 1) + 
     r (3 a (a^2 + b^2) + 6 a (c^2 + d^2) + 3 c^2 Ca - 3 d^2 Ca + 3 a Ca^2) ==
     1/2, b (1/u^2 - 1) + 
     r (3 b (a^2 + b^2) + 6 b (c^2 + d^2) + 6 c d Ca + 3 b Ca^2) == 0, 
   c (1/u^2 - 1/4) + 
     r (6 (a^2 + b^2) c + 3 c (c^2 + d^2) + 6 (a c + b d) Ca + 3 c Ca^2) == 0,
    d (1/u^2 - 1/4) + 
     r (6 (a^2 + b^2) d + 3 d (c^2 + d^2) + 6 (-a d + b c) Ca + 3 d Ca^2) == 
    0, c > 0, d >= 0, QQQ == c^2 + d^2, QQQ != 0};

Note that since your equations are exact, there is no benefit to using Rationalize.

Solve can rapidly find the exact real solutions and show that there are only two.

sol = Solve[eqs /. {u -> 5, r -> 1/25}, {a, b, c, d, Ca, QQQ}, Reals] // 
  RootReduce

Use N to convert the Root expressions to their approximate numeric values.

soln = sol /. x_Root :> N[x]
(* {{a -> -0.698614, b -> 0, c -> 0.622043, d -> 0.622043, Ca -> 0, 
  QQQ -> 0.773876}, {a -> -0.732167, b -> 0, c -> 1.06332, d -> 0, 
  Ca -> 0.443594, QQQ -> 1.13066}} *)

Thank you very much, your answer was very helpful! – Філіпп Сікорський Jan 21 '21 at 17:07 — Філіпп Сікорський, Jan 21 '21 at 17:07

Michael E2 · Answer 2 · 2021-01-21T15:33:12.250

1

Compare solutions with lower precision after NSolve is done:

NSolve[eqs /. {u -> 5, r -> 0.04}, {a, b, c, d, Ca, QQQ}, Reals] // 
 DeleteDuplicatesBy[SetPrecision[#, 6] &]
(*
{{a -> -0.732167, b -> 0, c -> 1.06332,
  d -> 0, Ca -> 0.443594, QQQ -> 1.13066},
 {a -> -0.698614, b -> 0, c -> 0.622043, 
  d -> 0.622043, Ca -> 0, QQQ -> 0.773876}}
*)

Aside: The following hardly seems an answer, but it gets the job done. Set Method to something other than Automatic or "Homotopy", even bogus settings, and NSolve returns solutions without multiplicities:

NSolve[eqs /. {u -> 5, r -> 0.04}, {a, b, c, d, Ca, QQQ}, Reals, 
 Method -> "Foo"]
(*
{{a -> -0.732167, b -> 0., c -> 1.06332,
  d -> 0., Ca -> 0.443594, QQQ -> 1.13066},
 {a -> -0.698614, b -> 0., c -> 0.622043, 
  d -> 0.622043, Ca -> 0., QQQ -> 0.773876}}
*)

edited Jan 21 '21 at 15:33

answered Jan 21 '21 at 15:12

Michael E2

235,386
17
334
747

Can you check if Method -> "EndomorphismMatrix" yields a solution without multiplicities? – J. M.'s missing motivation Jan 21 '21 at 15:36
@J.M. I checked all the methods list here, including "EndomorphismMatrix", plus a few others I made up. – Michael E2 Jan 21 '21 at 15:38
I also considered these method suboptions Internal`NSolveOptions[] --> {"ComplexEquationMethod" -> Automatic, "MonomialOrder" -> Automatic, "ReorderVariables" -> True, "SelectCriterion" -> (True &), "Tolerance" -> 0, "UseSlicingHyperplanes" -> True}. Couldn't figure out how to get any them to help. – Michael E2 Jan 21 '21 at 15:41

score 0 · Answer 3 · answered Jan 21 '21 at 14:02

If you really are sure that you can ignore the root multiplicities, then you can rationalize your results with an appropriately chosen rounding threshold, then use DeleteDuplicates to remove the multiple roots:

solns = NSolve[
          eqs /. {u -> 5, r -> 0.04}, 
          {a, b, c, d, Ca, QQQ}, 
          Reals
        ];
DeleteDuplicates@ Rationalize[solns, 0.0001] // N
(*Out:
{{a -> -0.732143, b -> 0., c -> 1.06329,
  d -> 0., Ca -> 0.443548, QQQ -> 1.13072},
{a -> -0.69863, b->0., c -> 0.621951,
  d -> 0.621951, Ca -> 0., QQQ -> 0.77381}}
*)

How to remove unnecessary answers from NSolve without losing speed?

3 Answers3