None of the NMinimize methods leads to the answers of the equation

Question

The following 10 equations has one set of exact answer using NSolve in Mathematica 9.0.0.0 (for positive c2, alpha1, alpha3, beta1, beta3, A1 and A3):

eq1[mpionp_] := -2 c2 + 2 d2 + 4 c4a alpha1^2 + 4 e3a beta3 == 
   0.018769 + mpionp^2;
eq2[mpionp_] := -4 c2 d2 + 8 c4a d2 alpha1^2 - 16 e3a^2 alpha3^2 + 
    8 e3a d2 beta3 == 0.018769 mpionp^2;
 eq3 = -2 c2 + 2 d2 + 12 c4a alpha1^2 - 4 e3a beta3 == 3.133076`;
eq4 = -4 c2 d2 + 24 c4a d2 alpha1^2 - 16 e3a^2 alpha3^2 - 
    8 e3a d2 beta3 == 2.0866380304`;
eq5 = -2 A1 - 2 c2 alpha1 + 4 c4a alpha1^3 + 4 e3a alpha3 beta1 + 
    4 e3a alpha1 beta3 == 0;
eq6 = -2 A3 - 2 c2 alpha3 + 4 c4a alpha3^3 + 8 e3a alpha1 beta1 == 0;
eq7 = 4 e3a alpha1 alpha3 + 2 d2 beta1 == 0;
eq8 = 4 e3a alpha1^2 + 2 d2 beta3 == 0;
eq9 = (0.09263098833543772` alpha1)/(
   beta1 Sqrt[
     1 - (2 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3)))/Sqrt[
      64 e3a^2 alpha3^2 + 
       4 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3))^2]] + 
    alpha1 Sqrt[
     1 + (2 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3)))/Sqrt[
      64 e3a^2 alpha3^2 + 
       4 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3))^2]]) == alpha1;
eq10[t_] := A3/A1 == t;

   Eqs[mpionp_, t_] := 
  eq1[mpionp] && eq2[mpionp] && eq3 && eq4 && eq5 && eq6 && eq7 && 
   eq8 && eq9 && eq10[t] && alpha1 >= 0 && c2 \[Element] Reals && 
   beta1 > 0;
parameters = {c2, d2, e3a, c4a, alpha1, alpha3, beta1, beta3, A1, A3};

solexact=NSolve[Eqs[1.2, 20], parameters]

{{c2 -> 0.158201, d2 -> 0.615064, e3a -> -1.74843, c4a -> 47.036,
alpha1 -> 0.0606073, alpha3 -> 0.0720951, beta1 -> 0.0248421, beta3 -> 0.0208837, A1 -> 0.000665807, A3 -> 0.0133161}}

First: The NSolve doesn't have any answers in Mathematica 10.0.1.0.

EDIT 1: As Daniel said, it is possible to get the same answers as in Mathematica 9, by adding Method -> "EndomorphismMatrix" to the NSolve code, i.e.,

solexact=NSolve[Eqs[1.2, 20], parameters, Method -> "EndomorphismMatrix"]

Second: If instead of NSolve, I use NMinimize function to find the parameters:

eq1a[mpionp_] := -2 c2 + 2 d2 + 4 c4a alpha1^2 + 
   4 e3a beta3 - (0.018769 + mpionp^2);
eq2a[mpionp_] := -4 c2 d2 + 8 c4a d2 alpha1^2 - 16 e3a^2 alpha3^2 + 
   8 e3a d2 beta3 - (0.018769 mpionp^2);
 eq3a = -2 c2 + 2 d2 + 12 c4a alpha1^2 - 4 e3a beta3 - 3.133076`;
eq4a = -4 c2 d2 + 24 c4a d2 alpha1^2 - 16 e3a^2 alpha3^2 - 
   8 e3a d2 beta3 - 2.0866380304`;
eq5a = -2 A1 - 2 c2 alpha1 + 4 c4a alpha1^3 + 4 e3a alpha3 beta1 + 
   4 e3a alpha1 beta3;
eq6a = -2 A3 - 2 c2 alpha3 + 4 c4a alpha3^3 + 8 e3a alpha1 beta1;
eq7a = 4 e3a alpha1 alpha3 + 2 d2 beta1;
eq8a = 4 e3a alpha1^2 + 2 d2 beta3;
eq9a = (0.09263098833543772` alpha1)/(
   beta1 Sqrt[
     1 - (2 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3)))/Sqrt[
      64 e3a^2 alpha3^2 + 
       4 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3))^2]] + 
    alpha1 Sqrt[
     1 + (2 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3)))/Sqrt[
      64 e3a^2 alpha3^2 + 
       4 (c2 + d2 - 2 (c4a alpha1^2 + e3a beta3))^2]]) - alpha1;
eq10a[t_] := A3/A1 - t;

Eqsa[mpionp_, t_] := 
 eq1a[mpionp]^2 + eq2a[mpionp]^2 + eq3a^2 + eq4a^2 + eq5a^2 + eq6a^2 +
   eq7a^2 + eq8a^2 + eq9a^2 + eq10a[t]^2
imax = 10;

Table[
 NMinimize[{Eqsa[1.2, 20], alpha1 >= 0 && c2 \[Element] Reals}, 
  parameters, Method -> {"RandomSearch", "RandomSeed" -> i}], {i, 
  imax}]

Then none of the sets are close to the exact solutions of NSolve. I've tried "DifferentialEvolution", "NelderMead" and "SimulatedAnnealing" methods and none of them is good to minimize this function.

I know that A1, A3, alpha1, alpha3, beta1 and beta3 are positive. If I use these conditions in NMinimize

Table[
 NMinimize[{Eqsa[1.2, 20], 
   alpha1 >= 0 && c2 \[Element] Reals && beta1 > 0 && A1 > 0 && 
    A3 > 0 && alpha3 > 0}, parameters, 
  Method -> {"RandomSearch", "RandomSeed" -> i}], {i, imax}]

Still the answers are too far from the exact answers. My question is that how can I get better answers from NMinimize? (Here NSolve works, but I have some equations which do not have answers using NSolve and so I should use NMinimize. Therefore this is a test for future works.)

Thanks.

Answer 1

Here is what I get after increasing precision and using the default NMinimize function:

    In[64]:= mins = 
 NMinimize[{Eqsa[12/10, 20], alpha1 >= 0 && c2 \[Element] Reals}, 
  parameters, WorkingPrecision -> 40]

Out[64]= {1.247337986088467518479435174601049848950*10^-7, {c2 -> \
-0.3374784431690519041004266735008459511493, 
  d2 -> 0.6150685584037689231127591408182094568580, 
  e3a -> 3.668159527211596411791957403610172667566, 
  c4a -> 13.32025714981507468024853784490265246855, 
  alpha1 -> 0.06056083312827593567309553866879351793355, 
  alpha3 -> -0.03436463042452369256834942170851884137055, 
  beta1 -> 0.02494798118128266335488007235487492980332, 
  beta3 -> -0.04373713725729122089474826761167329077141, 
  A1 -> 0.0004748966135853819208165612666379296917031, 
  A3 -> 0.009497932264556549103136017315180242566578}}

The error is of the order of 10^-8, which I believe can be further reduced by increasing precision further:

In[65]:= (eq1[1.2][[1]] - eq1[1.2][[2]]) /. mins[[2]]

Out[65]= 8.98077*10^-8

As a side note: After using Rationalize for all the real values, NSolve gave me {}.

Answer 2

Adding all the constraints to the NMinimize code will give one set of parameters which is very close to the exact solution from NSolve.

Table[NMinimize[{Eqsa[1.2, 20], 
   alpha1 > 0 && alpha3 > 0 && beta1 > 0 && beta3 > 0 && A1 > 0 && 
    c2 \[Element] Reals && c2 > 0}, parameters, 
  Method -> {"RandomSearch", "RandomSeed" -> i}], {i, imax}]

From 10 sets of parameters, one of them is very close to the NSolve answer:

{1.96697*10^-16, {c2 -> 0.158201, d2 -> 0.615064, e3a -> -1.74843,
c4a -> 47.036, alpha1 -> 0.0606073, alpha3 -> 0.0720952, beta1 -> 0.0248421, beta3 -> 0.0208837, A1 -> 0.000665813, A3 -> 0.0133163}}

and as it is obvious, the sum of squared equations is of the order $10^{-16}$, while for the exact solution it is of the order $10^{-19}$

Eqsa[1.2, 20] /. solexact

{1.47872*10^-19}