dwrfielder@dahlia.waterloo.edu (Dave Fielder (DWaRF)) (06/12/91)
Hi. I know I asked for this a couple of weeks ago, and I know someone posted this to the newsgroup and even mailed it to me after I requested it, but due to connectivity problems I couldn't find a Mac to download the program to my 48sx, and now I don't have access to the account that that I had the program stored on. Now, with a new account, and an available mac, I'll request it again. To the kind soul who wrote the symbolic row reduction and other misc. routines, could you mail them to me again? I've got an algebra midterm that specifically **needs** these routines, on Thursday at 4:00. --Dave Hubert. Thanks.
blair@en.ecn.purdue.edu (Marc E Blair) (06/13/91)
This is a newer version which allows symbolics in solving simeq and also
simplifies answers further than the old program.
->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.
symbolic row reduction is supported.
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.
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---
%%HP: T(3)A(R)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
\>>
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
\>>
\>>
det
\<< Dec DROP MNN
\>>
EC
\<< EVAL
DO DUP EXPAN
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
DO DUP COLCT
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
\>>
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 ZRO? SWAP
DROP NOT
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
\>>
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 - EXPAN
COLCT 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 / COLCT
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 / COLCT
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
\>>
\>>
QR 0
END