reduce system of equations which is under-determined in mathematica

问题

I obtained the folloiwng equation (as an example):

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

And I want to determine w11, w12, w21, w22. However, simply do the following:

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}]

Because the system of equations is under-determined. I have one thought, i.e. using matrix algebra. But I need to automatically group those coefficients in front of w11, w12, w21, w22 into a matrix (list of lists) then go from there. But I am not sure how to manipulate these equations easily to generate such a matrix. Please help, or if you have better ideas, please share too.

Many thanks.

回答1:

Here are your equations and variables:

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};

Here is the matrix:

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

EDIT:

The same works for your second group of equations:

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

EDIT:

Expanding on the solution, upon request. First, how it works: the idea is to first bring all variables to the left, which is achieved by replacing the equals operator with subtraction:

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};

In[70]:= eqs /. Equal :> Subtract

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

The rules are constructed so that for any group of rules, only one variable is set to 1, and the rest to 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}}

This allows to compute the coefficients:

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

Upon inspecting how the rules work, it is easy to see that we need to apply Transpose to the result.

Now, your second request requires more work:

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

The main difference is that we need an extra step to separate the constants and bring them to the r.h.s. You may find it more useful to figure out the details of how this works yourself.

Edit:

Yes, I forgot to mention: to understand the solution, you should know what happens when you apply rules in nested lists - in this case, each list of rules inside a larger lists results in a transformed copy of an expression, for example:

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

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

HTH

回答2:

There is a built-in function CoefficientArrays for converting systems of linear (or polynomial) equations into a matrix form.

The matrix you want is the second part of the result:

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

The inhomogeneous part is the first part of the result, a vector:

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

来源：https://stackoverflow.com/questions/4998144/reduce-system-of-equations-which-is-under-determined-in-mathematica

标签

wolfram-mathematica