Wolfram mathematica 二次方程组的求解

有人能找到解决下面这个系统的方法吗？我尝试了

Reduce

，但评估需要一段时间，所以我不确定它是否有效

terms = {{g^2, g h, h^2, -o^2, -o p, -p^2}, {g^2, g k, 
    k^2, -o^2, -o q, -q^2}, {g^2, g m, m^2, -o^2, -o r, -r^2}, {g^2, 
    g n, n^2, -o^2, -o s, -s^2}, {h^2, h k, 
    k^2, -p^2, -p q, -q^2}, {h^2, h m, m^2, -p^2, -p r, -r^2}, {h^2, 
    h n, n^2, -p^2, -p s, -s^2}, {k^2, k m, 
    m^2, -q^2, -q r, -r^2}, {k^2, k n, n^2, -q^2, -q s, -s^2}, {m^2, 
    m n, n^2, -r^2, -r s, -s^2}};
vars = Variables@Flatten@terms;
coefs = Array[c, Dimensions[terms]];
eqs = MapThread[#1.#2 == 0 &, {terms, coefs}];
Reduce[eqs, vars, Reals]

---

你可以从最优化的角度来处理你的问题，建立你方程的r.h.s.的平方和

定义矩阵：

mat[{g_, h_, k_, m_, n_, o_, p_, q_, r_, s_}] := {{g^2, g h, 
    h^2, -o^2, -o p, -p^2}, {g^2, g k, k^2, -o^2, -o q, -q^2}, {g^2, 
    g m, m^2, -o^2, -o r, -r^2}, {g^2, g n, 
    n^2, -o^2, -o s, -s^2}, {h^2, h k, k^2, -p^2, -p q, -q^2}, {h^2, 
    h m, m^2, -p^2, -p r, -r^2}, {h^2, h n, 
    n^2, -p^2, -p s, -s^2}, {k^2, k m, m^2, -q^2, -q r, -r^2}, {k^2, 
    k n, n^2, -q^2, -q s, -s^2}, {m^2, m n, n^2, -r^2, -r s, -s^2}};

现在，将求解代数方程的代码定义为约束优化：

Clear[SolveAlgebraic];
SolveAlgebraic[
  coefs_ /; Dimensions[coefs] == {10, 6} && MatrixQ[coefs, NumberQ], 
  opts : OptionsPattern[NMinimize]] := 
 Module[{g, h, k, m, n, o, p, q, r, s, eqs, vars, val, sol},
  eqs = MapThread[#1.#2 &, {mat[
      vars = {g, h, k, m, n, o, p, q, r, s}], coefs}];
  {val, sol} = 
   NMinimize[{Total[eqs^2], 
     vars.vars > 1 && Apply[And, Thread[vars >= 0]]}, vars, opts];
  {val, vars /. sol}
  ]

现在定义一个函数，用给定的解决方案构造一组c[，]：

CoefficientWithSolution[sol_ /; Length[sol] == 10] := 
 Block[{cc, 
   v}, ((Array[
       cc, {10, 6}]) /. (First[
        Quiet@Solve[(MapThread[
              Dot, {mat[Array[v, 10]], Array[cc, {10, 6}]}] == 0 // 
            Thread), Array[cc, {10, 6}] // Flatten]] /. 
       Thread[Array[v, 10] -> (sol)]) /. _cc :> 1)]

生成一个矩阵：

In[188]:= coefs = 
 CoefficientWithSolution[{1, 2, 3, 4, 5, 6, 7, 8, 9, 10}]

Out[188]= {{1, 1, 1, 1, 1, -(71/49)}, {1, 1, 1, 1, 1, -(71/64)}, {1, 
  1, 1, 1, 1, -(23/27)}, {1, 1, 1, 1, 1, -(13/20)}, {1, 1, 1, 1, 
  1, -(43/32)}, {1, 1, 1, 1, 1, -(28/27)}, {1, 1, 1, 1, 
  1, -(4/5)}, {1, 1, 1, 1, 1, -(11/9)}, {1, 1, 1, 1, 1, -(19/20)}, {1,
   1, 1, 1, 1, -(11/10)}}

以更高的工作精度求解方程，并强制使用机器编号：

In[196]:= SolveAlgebraic[coefs, WorkingPrecision -> 30] // N

Out[196]= {1.41177*10^-28, {0.052633, 0.105266, 0.157899, 0.210532, 
  0.263165, 0.315798, 0.368431, 0.421064, 0.473697, 0.52633}}

验证是否找到了预期的解决方案：

In[197]:= Rest[Last[%]]/First[Last[%]]

Out[197]= {2., 3., 4., 5., 6., 7., 8., 9., 10.}

---

希望这能有所帮助。

所有的c[，]都是不相关的？全零是一个解决方案，可能不有趣。对于一个解决方案vars，-vars也是一个解决方案。因此，您可以节省制定问题的工作，以便只找到包含非负面成分的解决方案。如果您只是在寻找通用的解决方案，那么Solve将比Reduce更高效。否则你的问题就很难解决，特别是如果你想找到60个参数的函数的解，并找出它们的限制使解成为现实。c是与问题相关的浮点值，如果将

Real

更改为

Complex

，问题是否可以处理？可能无法用符号系数处理。请看：