wolfram-mathematica - 二次方程求解系统

Question

任何人都可以看到解决以下系统的方法吗？我试过 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]

Answer 1

您可以从优化的角度来解决您的问题，构建 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.}

希望这可以帮助。