在 Mathematica 中求解非线性方程组

Question

我正在尝试在 Mathematica 中对 a0-a5 的以下六个方程组 (g0-g5) 进行数值求解。我不是 Mathematica 方面的专家，也不完全确定如何执行此操作。

f[x_, y_] := Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y]
g0[x_, y_] := Integrate[f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g1[x_, y_] := Integrate[x*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]
g2[x_, y_] := Integrate[y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]
g3[x_, y_] := Integrate[x*x*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g4[x_, y_] := Integrate[y*y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g5[x_, y_] := Integrate[x*y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]

然而，我花了相当多的时间试图让 NSolve 和 FindRoot 产生一个解决方案。这是代码：

NSolve[{g0[x, y]==0, g1[x, y]==0, g2[x, y]==0, g3[x, y]==0, g4[x, y]==0, 
 g5[x, y]==0}, {a0, a1, a2, a3, a4, a5}, Reals]

FindRoot[{g0[x, y]==0, g1[x, y]==0, g2[x, y]==0, g3[x, y]==0, g4[x, y]==0,
g5[x, y]==0}, {{a0,1}, {a1,1}, {a2,1}, {a3,1}, {a4,1}, {a5,1}}]

我可以提供的另一条信息是 f(x,y) 的结果解应该等同于二元标准正态密度。任何帮助将非常感激。这是我在 SO 上的第一个 post，所以如果需要任何其他信息，请告诉我。

Answer 1

我很惊讶。我从没想过它会完成。但是如果你一直减去它做积分那么 Reduce 眨眼就完成了。

f[x_, y_] := Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y];
g0[x_, y_] := Integrate[f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g1[x_, y_] := Integrate[x*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
g2[x_, y_] := Integrate[y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
g3[x_, y_] := Integrate[x*x*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g4[x_, y_] := Integrate[y*y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g5[x_, y_] := Integrate[x*y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
Reduce[Simplify[{g0[x,y]==0, g1[x,y]==0, g2[x,y]==0, g3[x,y]==0, g4[x,y]==0, g5[x,y]==0},
 Re[4 a4-a5^2/a3]<0], {a0,a1,a2,a3,a4,a5}]

给你

C[1] \[Element] Integers && a0==1+2I\[Pi] C[1]-Log[2]-Log[\[Pi]] &&
   a1==0 && a2==0 && a3== -(1/2) && a4== -(1/2) && a5==0

注意：这为 Simplify 提供了一个假设，您应该验证该假设是否合理。该假设允许它将您的所有 ConditionalExpression 转换为可能对您的问题有效的表达式。我通过查看从 Integrate 返回的每个结果并看到它们都依赖于结果有效来得出这个假设。

Answer 2

以下是如何用数字表示：

 f[x_, y_, a0_, a1_, a2_, a3_, a4_, a5_] :=
  Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y]
 g0[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
   Integrate[
   f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, Infinity},
      {x, -Infinity, Infinity}] - 1
 g1[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] := 
     Integrate[
     x*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, Infinity},
       {x, -Infinity, Infinity}]
 g2[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] := 
      Integrate[
        y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity,  Infinity},  
          {x, -Infinity, Infinity}]
 g3[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] := 
      Integrate[
       x*x*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, 
         Infinity}, {x, -Infinity, Infinity}] - 1
 g4[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] := 
        Integrate[
         y*y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, 
           Infinity}, {x, -Infinity, Infinity}] - 1
 g5[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] := 
      Integrate[
       x*y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, 
             Infinity}, {x, -Infinity, Infinity}]

 FindRoot[  {
  g0[a0, a1, a2, a3, a4, a5] == 0, 
  g1[a0, a1, a2, a3, a4, a5] == 0,
  g2[a0, a1, a2, a3, a4, a5] == 0,
  g3[a0, a1, a2, a3, a4, a5] == 0,
  g4[a0, a1, a2, a3, a4, a5] == 0,
  g5[a0, a1, a2, a3, a4, a5] == 0}  ,
      {{a0, -.8379}, {a1, 0}, {a2, 0}, {a3, -.501},
       {a4, -.499}, {a5, 0}}]

请注意，我已经输入了一个非常接近已知解决方案的初始猜测（感谢@Bill），但仍然需要很长时间才能找到答案。

{a0 -> -0.837388 - 1.4099*10^-29 I, a1 -> -6.35273*10^-22 + 7.19577*10^-46 I, a2 -> -1.27815*10^-20 + 6.00264*10^-38 I, a3 -> -0.500489 + 1.41128*10^-29 I, a4 -> -0.5 - 7.13595*10^-44 I, a5 -> -5.55356*10^-28 - 9.23563*10^-47 I}

 Chop@%

{a0 -> -0.837388, a1 -> 0, a2 -> 0, a3 -> -0.500489, a4 -> -0.5, a5 -> 0}

在 Mathematica 中求解非线性方程组

Solving system of non-linear equations in Mathematica

wolfram-mathematica