blair@en.ecn.purdue.edu (Marc E Blair) (05/11/91)
Here are some miscellaneous matrix operations I have written to handle symbolic
matrices. I used stack operations to manipulate the data because I wanted
speed. The data can be entered as either a list of lists or as a normal
numeric array. The operations will return a matrix in list form, with fractions
and symbolics. I also use infinity to represent division by zero, which
sometimes happens in the row reduction when a linearly dependent matrix is
used as input. (I like it better than getting an error) The following is a
list of the programs and what they do.
->Q This program toggles fraction mode (a little block appears to indicate
fraction mode) otherwise straight decimals will be used. Fractions can
eat up memory on lengthy calculations.
det returns a determinant of a matrix. It behaves much like the routine
Eliel Louzouen wrote a while back, although I wrote this with speed
as first priority. The approach I used resulted in a twelvefold
increase in speed with numeric evaluation and a threefold increase in
symbolic evaluation than the original routines.
simeq solves a system of equations in matrix format... i.e. 4x+5y=9 and
3x+2y=10 would be entered { { 4 5 9 } { 3 2 10 } } and evaluated
returning { '32/7' '-(13/7)' } meaning x=32/7 and y=-13/7.
The program uses matrices to solve if there are less than five
variables, >5 results in row reduction. (this way a ten variable
equation takes 5 minutes, matrix methods would take 25 days)
rr row reduction program to reduce matrices into row-echelon form.
although this will work with symbolic matrices, things can get
nasty and out-of-hand quickly.
inv invert a matrix using row reduction techniques
mec expand and collect and evaluate all items in a matrix to their most
simple form
----- All other variables are subprograms.
if you find this program useful, or have suggestions for its improvement,
email blair@en.ecn.purdue.edu. If you really like it a lot and want to help
a starving college student donations are accepted if mailed to Marc Blair
1922 Elva Dr. Kokomo IN 46902
I am not repsonsible for memory loss, hardware trouble, loss of math abilities,
sudden shifts in the space-time continuum, or other problems which might occur
due to the use of this program but in all likelihood will never happen .
enjoy!
---------8<------8<-----8<---------
%%HP: T(3)A(D)F(.);
DIR
\->q\[]
\<<
IF QR
THEN '\->q\[]'
DUP RCL SWAP PURGE
'\->q' STO
ELSE '\->q' DUP
RCL SWAP PURGE
'\->q\[]' STO
END QR NOT
'QR' STO
\>>
det
\<< Dec DROP MNN
\>>
SIMEQ
\<< DUP Dec DUP
IF 6 <
THEN DUP2 1 -
IF ==
THEN DROP \->
Ss
\<< 0 Ss
FOR Aa
Ss DUP * Ss
FOR
Bb Bb Aa + PICK Ss
NEG
STEP
Ss \->LIST Ss Ss 1 +
* 1 + ROLLD
NEXT Ss
Ss 1 + * DROPN Ss 1
+ ROLL \-> Cc
\<< Ss
DUPN Ss \->LIST det \->
Dd
\<<
IF Dd 0 \=/
THEN 1 Ss
FOR Aa Ss DUPN Aa
ROLL DROP Cc Aa
ROLLD Ss \->LIST det
Dd /
IF QR
THEN \->Q
END Ss 1 +
ROLLD
NEXT Ss DROPN Ss
\->LIST
ELSE Ss DROPN
"No Solution"
END
\>>
\>>
\>>
ELSE *
DROPN
"BAD # OF EQS"
END SWAP
DROP
ELSE * DROPN
SM2
END
\>>
Rr
\<< Dec \-> L S
\<< S L \161RR 0 1
S
FOR A A L *
A - 2 + PICK +
NEXT
IF ZRO?
SWAP DROP NOT
THEN S L
\161RR
END 1 L
FOR A S
\->LIST L A - S * A +
ROLLD
NEXT L
\->LIST
\>>
\>>
inv
\<< Dec \-> S L
\<< 0 L 1 -
FOR A 0 S 1
-
FOR B A B
== L S * L - 1 + A
L * - ROLLD
NEXT
NEXT L S
\>> DUP + \-> L S
\<< S L \161RR 1 L
FOR A S 2 /
\->LIST L A - S * A +
S 2 / + ROLLD S 2 /
DROPN
NEXT L
\->LIST
\>>
\>>
MEC
\<< OBJ\-> \-> A
\<< 1 A 1 -
FOR B +
NEXT OBJ\-> \->
S
\<< 1 S
FOR C EC
S ROLLD
NEXT 1 A
FOR D S A
/ \->LIST S S A / D *
- D + ROLLD
NEXT A
\->LIST
\>>
\>>
\>>
SM2
\<< Rr 0 'ER' STO
{ } SWAP OBJ\-> \-> S
\<< 1 S
FOR A OBJ\->
\-> L
\<< L S A -
- ROLL
IF 1 \=/
THEN 1
'ER' STO
END S A
- L + ROLL + S A -
L 1 - + ROLLD 0 1 L
2 -
FOR C +
NEXT
IF 0 \=/
THEN 1
'ER' STO
END
\>>
NEXT
IF ER 1 ==
THEN DROP
"NO SOLUTION"
END 'ER'
PURGE
\>>
\>>
Dec
\<< OBJ\-> DUP TYPE
IF 5 ==
THEN EVAL
ELSE \-> L
\<< 1 L 1 -
FOR A +
NEXT OBJ\->
L / L SWAP
\>>
END
\>>
ZRO?
\<< DUP TYPE 0
IF \=/
THEN 0
ELSE DUP
IF 0 \=/
THEN 0
ELSE 1
END
END
\>>
\161RR
\<< \-> L S
\<< 0 S 1 -
FOR A S L *
A - DUP 1 + PICK \->
F M1
\<< 1 S 1 -
FOR B F
B L * - DUP 1 +
PICK \-> C M2
\<< M2
ZRO?
IF NOT
THEN DROP 0 L 1 -
FOR D C A + D -
ROLL M1 0 'DOIT'
STO ZRO?
IF NOT
THEN *
ELSE DROP 1
'DOIT' STO
END F A + D -
PICK M2 ZRO?
IF NOT
THEN *
ELSE DROP 1
'DOIT' STO
END - C A + D -
ROLLD
NEXT
ELSE DROP
END
\>>
NEXT 1
L
FOR Q S
L * ROLL
NEXT
\>> 'DOIT'
PURGE
NEXT 0 S 1
-
FOR B L S B
- * B - PICK S B -
L * \-> D F
\<< 0 L 1 -
FOR C F
C - ROLL
IF D
TYPE 0 ==
THEN
IF D 0 ==
THEN \oo *
ELSE D /
IF QR
THEN \->Q
END DUP TYPE 9 ==
OVER EVAL DUP IP ==
AND
IF DUP TYPE 0 ==
THEN
IF
THEN EVAL
END
ELSE DROP
END
END
ELSE
D /
END F
C - ROLLD
NEXT
\>>
NEXT
\>>
\>>
MNN
\<< \-> Ss
\<<
IF Ss 3 ==
THEN 6 DUPN
6 DUPN ROT DROP 4
ROLL * 3 ROLLD * -
SWAP DROP 16 PICK *
16 ROLLD SWAP DROP
4 ROLL DROP 4 ROLL
* 3 ROLLD * - 9
PICK * 10 ROLLD
DROP ROT DROP 4
ROLL * 3 ROLLD * -
* ROT DROP SWAP
DROP SWAP - +
ELSE
IF Ss 2
==
THEN 4
ROLL * 3 ROLLD * -
ELSE 1 Ss
FOR Aa
Ss DUP DUP * SWAP -
DUPN Ss DUP * Ss 2
* - 0
FOR
Bb Bb Aa + ROLL
DROP Ss NEG
STEP
Ss 1 - MNN Ss DUP *
Ss - Aa + 1 + PICK
* -1 Aa Ss + ^ * Ss
Ss * 1 + ROLLD
NEXT Ss
Ss * DROPN 1 Ss 1 -
FOR Aa
+
NEXT
END
END
\>>
\>>
EC
\<< EVAL
DO DUP EXPAN
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
DO DUP COLCT
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
\>>
QR 1
END
----------------------->8--------->8---