Metropoli BBS
VIEWER: echelon.src MODE: TEXT (ASCII)
%%HP: T(3)A(D)F(.);
@ ECHELON
@ by Brian Korver.
@ Reduces matrix to "row-reduced echelon form".
@ [See RWRD on this disk for another approach.  -jkh-]
\<< \-> matr
  \<<
    IF 'matr' VTYPE 3 == matr SIZE SIZE 1 > AND
    THEN 1 1 1 matr SIZE LIST\-> DROP \-> det p q m n
      \<<
        WHILE 'p\<=m' \->NUM 'q\<=n' \->NUM AND
        REPEAT 0 p \-> cmax k
          \<< p m
            FOR row matr row q 2 \->LIST GET ABS \-> x
              \<<
                IF 'x>cmax'
                THEN x 'cmax' STO row 'k' STO
                END
              \>>
            NEXT
            IF ' cmax>.00001'
            THEN 1 n
              FOR col matr p col 2 \->LIST GET matr k col 2 \->LIST GET
                \-> tp tk
                \<< matr k col 2 \->LIST tp PUT 'matr' STO matr p col 2
                  \->LIST tk PUT 'matr' STO
                \>>
              NEXT
              IF 'k >p'
              THEN det NEG 'det' STO
              END matr p q 2 \->LIST GET \-> l
              \<< 1 n
                FOR col matr p col 2 \->LIST GET l / \-> tl
                  \<< matr p col 2 \->LIST tl PUT 'matr' STO
                  \>>
                NEXT l det * 'det' STO
              \>> 1 m
              FOR row matr row q 2 \->LIST GET \-> l
                \<< 1 n
                  FOR col
                    IF 'row\=/p'
                    THEN matr row col 2 \->LIST GET matr p col 2 \->LIST GET
                      l * - \-> tv
                      \<< matr row col 2 \->LIST tv PUT 'matr' STO
                      \>>
                    END
                  NEXT
                \>>
              NEXT 'p' INCR DROP 'q' INCR DROP
            ELSE 0 'det' STO 'q' INCR DROP
            END
          \>>
        END
      \>> matr "Reduced Echelon Matrix\010 " 1 DISP 1 FREEZE
    ELSE matr "ECHEL Error:\010Not A Matrix" 1 DISP 1400 .065 BEEP 1 FREEZE
    END
  \>>
\>>

[ RETURN TO DIRECTORY ]