сократить систему уравнений, которая недостаточно определена в математике

Question

Я получил следующее уравнение (в качестве примера):

{2 w11 + 3 w21 == 2 w12, w11 == 4 w12 + 3 w22, w11 + 2 w21 + w22 == 0,
  2 w12 + w21 + 2 w22 == 0}

И я хочу определить w11, w12, w21, w22. Однако просто сделайте следующее:

Solve[{3 w11 + 2 w21 == 5 w11 + 3 w12, w11 + w21 == 5 w21 + 3 w22, 
  3 w12 + 2 w22 == -2 w11 - w12, w12 + w22 == -2 w21 - w22}, {w11, 
  w12, w21, w22}]

Потому что система уравнений недостаточно определена. У меня есть одна мысль, то есть использование матричной алгебры. Но мне нужно автоматически сгруппировать эти коэффициенты перед w11, w12, w21, w22 в матрицу (список списков), а затем перейти оттуда. Но я не уверен, как легко манипулировать этими уравнениями для создания такой матрицы. Пожалуйста, помогите, или если у вас есть лучшие идеи, пожалуйста, поделитесь тоже.

Большое спасибо.

Answer 1

Существует встроенная функция CoefficientArrays для преобразования систем линейных (или полиномиальных) уравнений в матричную форму.

Матрица, которую вы хотите, является второй частьюрезультат:

In[7]:= vars = {w11, w12, w21, w22};

In[8]:= CoefficientArrays[{2 w11 + 3 w21 == 2 w12, 
   w11 == 4 w12 + 3 w22, w11 + 2 w21 + w22 == 0, 
   2 w12 + w21 + 2 w22 == 0}, vars] // Normal

Out[8]= {{0, 0, 0, 
  0}, {{2, -2, 3, 0}, {1, -4, 0, -3}, {1, 0, 2, 1}, {0, 2, 1, 2}}}

Неоднородная часть - это первая часть результата, вектор:

In[9]:= CoefficientArrays[{3 w11 + 2 w12 == 5 w11 + 3 w21 + a, 
   w11 + w12 == 5 w12 + 3 w22 - c, 
   3 w21 + 2 w22 + b == a - 2 w11 - w21, 
   w21 + w22 == f - 2 w12 - w22}, vars] // Normal

Out[9]= {{-a, 
  c, -a + b, -f}, {{-2, 2, -3, 0}, {1, -4, 0, -3}, {2, 0, 4, 2}, {0, 
   2, 1, 2}}}

Answer 2

Вот ваши уравнения и переменные:

vars = {w11, w12, w21, w22};
eqs = {2 w11 + 3 w21 == 2 w12, w11 == 4 w12 + 3 w22, 
   w11 + 2 w21 + w22 == 0, 2 w12 + w21 + 2 w22 == 0};

Вот матрица:

In[48]:= matrix =  Transpose[ eqs /. Equal :> Subtract /. 
    Map[Thread[vars -> #] &, IdentityMatrix[Length[vars]]]]

Out[48]= {{2, -2, 3, 0}, {1, -4, 0, -3}, {1, 0, 2, 1}, {0, 2, 1, 2}}

РЕДАКТИРОВАТЬ:

То же самое работает для вашей второй группы уравнений:

In[49]:= eqs = {3 w11 + 2 w21 == 5 w11 + 3 w12,  w11 + w21 == 5 w21 + 3 w22, 
  3 w12 + 2 w22 == -2 w11 - w12,  w12 + w22 == -2 w21 - w22};   

In[50]:= matrix = Transpose[ eqs /. Equal :> Subtract /. 
    Map[Thread[vars -> #] &, IdentityMatrix[Length[vars]]]]

Out[50]= {{-2, -3, 2, 0}, {1, 0, -4, -3}, {2, 4, 0, 2}, {0, 1, 2, 2}}

РЕДАКТИРОВАТЬ:

Расширение решения по запросу.Во-первых, как это работает: идея состоит в том, чтобы сначала перенести все переменные влево, что достигается заменой оператора равенства на вычитание:

In[69]:= eqs = {3 w11 + 2 w21 == 5 w11 + 3 w12,  w11 + w21 == 5 w21 + 3 w22, 
     3 w12 + 2 w22 == -2 w11 - w12,  w12 + w22 == -2 w21 - w22};

В [70]: = eqs /.Равно:> Вычтите

Out [70] = {-2 w11 - 3 w12 + 2 w21, w11 - 4 w21 - 3 w22, 2 w11 + 4 w12 + 2 w22, w12 + 2 w21 + 2 w22}

Правила построены так, что для любой группы правил только одна переменная установлена ​​на 1, а остальные на 0:

 In[71]:= Map[Thread[vars -> #] &, IdentityMatrix[Length[vars]]]

 Out[71]= {{w11 -> 1, w12 -> 0, w21 -> 0, w22 -> 0}, {w11 -> 0, w12 -> 1, w21 -> 0, w22 -> 0}, 
        {w11 -> 0, w12 -> 0, w21 -> 1, w22 -> 0}, {w11 -> 0, w12 -> 0, w21 -> 0, w22 -> 1}}

Это позволяет вычислять коэффициенты:

In[72]:= eqs /. Equal :> Subtract /. Map[Thread[vars -> #] &, IdentityMatrix[Length[vars]]]

Out[72]= {{-2, 1, 2, 0}, {-3, 0, 4, 1}, {2, -4, 0, 2}, {0, -3, 2, 2}}

После проверки работы правил легко понять, что нам нужно применить Transpose к результату.

Теперь ваш второй запрос требует больше работы:

In[53]:= eqs = {3 w11 + 2 w12 == 5 w11 + 3 w21 + a, w11 + w12 == 5 w12 + 3 w22 - c, 
   3 w21 + 2 w22 + b == a - 2 w11 - w21, w21 + w22 == f - 2 w12 - w22};

In[55]:= modifiedEqs = With[{alts = Alternatives @@ vars},
   eqs //. {lhs_ == HoldPattern[Plus[left___, x_, right___]] /; !FreeQ[x, alts] :> 
                    lhs - x == left + right,
            HoldPattern[Plus[left___, x_, right___] == rhs_] /; FreeQ[x, alts] :> 
           (left + right == rhs - x)}]

Out[55]= {-2 w11 + 2 w12 - 3 w21 == a, w11 - 4 w12 - 3 w22 == -c,  
     2 w11 + 4 w21 + 2 w22 == a - b,   2 w12 + w21 + 2 w22 == f}

In[68]:= matrix = {Transpose[# /. (lhs_ == rhs_) :> lhs /. 
    Map[Thread[vars -> #] &, IdentityMatrix[Length[vars]]]], #[[All,2]]} &[modifiedEqs]

Out[68]= {{{-2, 2, -3, 0}, {1, -4, 0, -3}, {2, 0, 4, 2}, {0, 2, 1,  2}}, {a, -c, a - b, f}}

Основное отличие состоит в том, что нам нужен дополнительный шаг для разделения констант и их передачи в правую часть. Вам может оказаться более полезным выяснить подробности того, как это работает самостоятельно.

Править:

Да, я забыл упомянуть: чтобы понять решение, вы должны знать, что происходит, когда вы применяете правила во вложенных списках - в этом случае каждый список правил в больших списках приводит к преобразованной копиивыражение, например:

In[73]:= {a, b, c} /. {{a -> 1}, {b -> 1}, {c -> 1}}

Out[73]= {{1, b, c}, {a, 1, c}, {a, b, 1}}

HTH