2
$\begingroup$

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?

Improve this question
$\endgroup$
2
  • 3
    $\begingroup$ "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. $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jan 21, 2021 at 12:08
  • $\begingroup$ 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! $\endgroup$
    – rmw
    Commented Jan 21, 2021 at 13:04

3 Answers 3

Reset to default
1
$\begingroup$ 
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

enter image description here

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}} *)
Improve this answer
$\endgroup$
1
1
$\begingroup$

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}}
*)
Improve this answer
$\endgroup$
3
  • $\begingroup$ Can you check if Method -> "EndomorphismMatrix" yields a solution without multiplicities? $\endgroup$
    – J. M.'s missing motivation ♦
    Commented Jan 21, 2021 at 15:36
  • $\begingroup$ @J.M. I checked all the methods list here, including "EndomorphismMatrix", plus a few others I made up. $\endgroup$
    – Michael E2
    Commented Jan 21, 2021 at 15:38
  • $\begingroup$ 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. $\endgroup$
    – Michael E2
    Commented Jan 21, 2021 at 15:41
0
$\begingroup$

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}}
*)
Improve this answer
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.