TransWikia.com

How to write a more concise `RowReduce` function that can deal with symbolic matrix?

Mathematica Asked on June 12, 2021

I asked a similar question in this post before and understand the reason why RowReduce function can’t reduce symbolic matrix.

I wrote an RowReduce function that can handle symbolic matrices:

exchanges[v1_, v2_] := 
 Module[{t}, 
  t = InversePermutation[PermutationList[FindPermutation[v1, v2]]]; 
  If[t != {}, 
   Select[MapIndexed[First[#2] -> #1 &, 
     LinearAlgebra`LAPACK`PermutationToPivot[t]], Apply[Unequal]], {}]]

matrixWrapOperation[mat_, rule_] := 
 Module[{B = mat}, 
  If[rule != {}, 
   Do[B[[{Keys[rule[[n]]], Values[rule[[n]]]}, ;;]] = 
     B[[{Values[rule[[n]]], Keys[rule[[n]]]}, ;;]];
    Print["Swap the elements in row", Keys[rule[[n]]], "and row ", 
     Values[rule[[n]]], "->", MatrixForm@B], {n, 1, Length[rule]}]; B,
    B]]

rref[A_?MatrixQ] := 
 Module[{sysa, sysm, sysn, sysi, sysj, sysk, sysl, sysL, sysB},
  {sysm, sysn} = Dimensions[A]; sysB = A;
  Print[MatrixForm@A];
  
  (*Below is the preprocessing sort[DownArrow]*)
  Print["Start preprocessing"];
  sysB = matrixWrapOperation[A, 
    exchanges[
     A[[;; , 1]], (SortBy[A /. {0 -> Infinity}, 
         First] /. {Infinity -> 0})[[All, 1]]]];
  Print["End of preprocessing"];
  (*The above is the preprocessing sort[UpArrow]*)
  
  sysi = 1(*sysi represents the row number*); 
  sysk = 1(*sysk represents the column number*); While[sysi <= sysm,
   While[sysk < sysn && 
     sysB[[sysi ;;, sysk]] == ConstantArray[0, sysm - sysi + 1], sysk++;
     If[sysk == sysn && sysB[[sysi ;;, sysk]] == 0, Return[sysB]; 
     Goto[end]]];
   
   
   (*For[sysl=sysi,sysl[LessEqual]sysm,sysl++,If[(sysa=sysB[[sysl,
   sysk]])[NotEqual]0&&sysk<sysn&&sysB[[
   sysl,(sysk+1);;]][Equal]ConstantArray[0,sysn-sysk],sysB[[sysl,
   sysk]]=1;Print["Divide all elements in row",sysl," by ",sysa,"->",
   MatrixForm@sysB];]];*)
   
   
   sysa = DeleteCases[sysB[[sysi ;;, sysk]], 0]; 
   If[Length[sysa] == 0, sysL = 1, sysL = First[sysa]];
   
   
   
   sysj = sysi; 
   While[sysj < sysm && sysB[[sysj, sysk]] =!= sysL, sysj++;];
   
   If[sysi != sysj, 
    If[sysB[[sysj, sysk]] =!= 0, 
     sysB[[{sysi, sysj}, ;;]] = sysB[[{sysj, sysi}, ;;]];
     Print["Swap the elements in row", sysi, "and row ", sysj, "->", 
      MatrixForm@sysB], Return[sysB]]
    ];
   
   
   
   For[sysl = sysi, sysl <= sysm, sysl++, 
    If[(sysa = sysB[[sysl, sysk]]) =!= 0 && sysl > sysi, 
     sysB[[sysl, ;;]] = 
      sysB[[sysl, ;;]] - 
       sysB[[sysl, sysk]]/sysB[[sysi, sysk]] sysB[[sysi, ;;]];
     
     Print["The ", sysl, " row of elements plus ", -(sysa/sysL), 
      " times the ", sysi, " row of elements", 
      "-> " MatrixForm@sysB]]];
   sysi++(*Outermost row loop count*);]; Label[end];
  
  Return[sysB];]

Examples for testing:

A = RandomInteger[{0, 10}, {4, 4}]; 
rref[A]
rref[{{1, 9, 7, 2}, {0, 2, -(9/2), 
    2}, {0, -(11/2), -(11/2), -t}, 
       {s, 10, 9, 7}, {1, 2, 4, 3}}]

rref[{{8, 0, 0, 1, 3}, {8, 0, 0, 0, 3}, 
       {6, 0, 0, 2, 4}, {7, 0, 0, 8, 9}, 
       {10, 0, 0, 1, 5}}]

rref[{{1, -1, -1}, {2, a, 1}, {-1, 1, a}}]

rref[{{1, -1, -1, 2, 2}, {2, a, 1, 1, a}, {-1, 1, a, -a - 1, -2}}]

But the above code is too cumbersome. Is there a more concise way to realize the function of rref function?

One Answer

Perhaps this, but I'm unsure how safe it is to treat a - 2 as zero:

mat = {{1, a, 2}, {0, 1, 1}, {-1, 1, 1}};
RowReduce[mat,
 ZeroTest -> (Quiet[Length@Solve[# == 0, Reals] > 0] &)]

$$ left( begin{array}{ccc} 1 & 0 & 2-a 0 & 1 & 1 0 & 0 & 2-a end{array} right) $$

There's also

UpperTriangularize@First@LUDecomposition@mat

$$ left( begin{array}{ccc} 1 & a & 2 0 & 1 & 1 0 & 0 & 2-a end{array} right) $$

The columns are not reduced. Also, I suspect LUDecomposition would divide by a - 2 if needed.

Correct answer by Michael E2 on June 12, 2021

Add your own answers!

Ask a Question

Get help from others!

© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP