2
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ Try Rationalizing all the real values in your input and then use WorkingPrecision-> 20 say. See what happens. For example: Rationalize[0.018769,0] $\endgroup$ – Lotus Nov 13 '15 at 12:59
  • $\begingroup$ Something fishy seems to be going on here when I substituted the NSolve solution that you have posted into the equations, I get {False,False}. In[14]:= Eqs[1.2, 20] /. {{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}, {c2 -> 0.158201, d2 -> 0.615064, e3a -> 1.23878, c4a -> 23.6114, alpha1 -> 0.0855419, alpha3 -> 0.101756, beta1 -> -0.0350625, beta3 -> -0.0294756, A1 -> 0.000939729, A3 -> 0.0187946}} Out[14]= {False, False} $\endgroup$ – Lotus Nov 13 '15 at 13:09
  • $\begingroup$ @ Lotus For all the equations except eq5, eq6 and eq7, Eqs[1.2, 20][[1]] /. sol[[1]] is True. For eq5, eq6 and eq7, Eqs[1.2, 20][[7]] /. sol[[1]] is False but For example: Eqs[1.2, 20][[7, 1]] /. sol[[1]] is of the order 10^-18 which is not exactly zero but very close to it. $\endgroup$ – Soodeh Z. Nov 13 '15 at 13:22
  • 1
    $\begingroup$ @Lotus One should not try to verify equality by substituting an approximate value into an equation. What can work well, with some modifications I won't go into, is to substitute into an expression and assess whether the residual (that is, the evaluation) is "sufficiently" small. $\endgroup$ – Daniel Lichtblau Nov 13 '15 at 15:45
  • $\begingroup$ In version 10 there is now a documented way to get the behavior of prior versions for NSolve. Set Method->"EndomorphismMatrix". This does not address your question but might at least get you to where there is no degradation in behavior. $\endgroup$ – Daniel Lichtblau Nov 13 '15 at 15:47
1
$\begingroup$

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 {}.

|improve this answer|||||
$\endgroup$
  • $\begingroup$ Thanks for the answer, but I need the equations to be very close to zero (at least of the order of 10^-16) or to be more precise my wish is to find parameters very close to what I found from NSolve with minimization. Just to remind, A1, A3, alpha1, alpha3, beta1 and beta3 are positive. $\endgroup$ – Soodeh Z. Nov 13 '15 at 13:28
0
$\begingroup$

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}

|improve this answer|||||
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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