d89-mlt@sm.luth.se (Morgan Lindqvist) (05/21/91)
Hello World!
Here is PART Ver 1.10, a program for partial fraction decomposition.
-------------------------------------------------------------------------
How to use:
3: numerator P(x)
2: denominator Q(x)
1: variable x => 1: Partial fraction decomposition
Examples:
3: 1
2: '(x^2+1)*(x+1)^2'
1: 'x' => '.5/(x+1)+.5/(x^2+2*x+1)-.5*x/(x^2+1)'
3: '(x+1)*(x+2)*(x+3)'
2: '(x+3)*(x+4)'
1: 'x' => 'x-1 + 6/(x+4)'
NOTE: degree(numerator) can be bigger than degree(denominator).
3: 1
2: 'z*(z+1)^3'
1: 'z' => '-1/(z+1)+1/z+-1/(z^2+2*z+1)+
-1/(z^3+3*z^2+3*z+1)'
-------------------------------------------------------------------------
Note:
The program ROUN that we use was posted in this group a while ago,
we have made some minor changes in it.
Unfortunately we have forgotten who wrote it, but many thanks to
Her/Him.
The polynomials program POLY ver 3.2 by Wahne H Scott
(wscott@en.ecn.purdue.edu) was also posted here a while ago.
PCOEF is written by William C Wickes (billw@hpcvra.CV.HP.COM)
-------------------------------------------------------------------------
%%HP: T(3)A(D)F(.);
DIR
PART
\<< 0 \-> t n var term
\<< DEPTH \->LIST \-> stack
\<< t var 6 PCOEF TRIM 't' STO
n var 6 PCOEF TRIM DUP 'n' STO
t 2 PICK PDIV
IF DUP SIZE THEN
't' STO 'term' STO FCTP DEPTH \->LIST ROUN MAXFACT MGRAD PRULES
t n PCALC RTL var FIXPOLY
ELSE
DROP 'term' STO DROP 0
END
0 term + var L2P SWAP +
\>>
\>>
\>>
MAXFACT
\<< DUP SIZE \-> n s
\<< 1 s
FOR x
'n' x GET
IF DUP SIZE 3 SAME THEN
DUP QUD DUP2 + TYPE
IF NOT THEN
{ 1 } SWAP NEG + { 1 } ROT NEG + ROT DROP
ELSE
DROP2
END
END
NEXT
DEPTH \->LIST
\>>
\>>
MGRAD
\<< DUP DUP SIZE \-> n s
\<< { } 1 s
FOR x
'n' x GET SIZE 1 - +
NEXT s
\>>
\>>
PRULES
\<< 0 \-> n tgrad s ant
\<< IF s 1 > THEN
s 2
FOR x
0 'ant' STO 'n' x GET x 1 - 1
FOR y DUP 'n' y GET
IF SAME THEN
'ant' 1 STO+
END
-1
STEP
IF ant THEN DUP
1 ant
START
OVER PMUL
NEXT SWAP DROP
END
'n' x ROT PUT -1
STEP
END
n tgrad s
\>>
\>>
PCALC
\<< \-> n tgrad s t mgn
\<< { } 1 s
FOR x
'tgrad' x GET 1 - 0
FOR z
mgn 'n' x GET PDIV DROP
IF z THEN
1 z
START
0 +
NEXT
END
1 \->LIST + -1
STEP
NEXT
t 1 \->LIST + TRIML LIST\-> SWAP LIST\-> 1 2 \->LIST \->ARRY 't' STO
1 - \->LIST LL\->M TRN 'mgn' STO n tgrad t mgn / ROUN s
\>>
\>>
RTL
\<< 1 \-> n tgrad t s pek
\<< {} 1 s
FOR x
{} pek DUP 'tgrad' x GET 1 - +
FOR pos
't' pos GET + 'pek' 1 STO+
NEXT
'n' x GET 2 \->LIST +
NEXT
\>>
\>>
FIXPOLY
\<< 2 PICK SIZE \-> l var s
\<< 0 1 s
FOR x
'l' x GET var L2P 'l' x 1 + GET var L2P / + 2
STEP
\>>
\>>
L2P
\<< 2 PICK SIZE \-> l var s
\<< 0 1 s
FOR x
'l' x GET var s x - ^ * +
NEXT
\>>
\>>
TRIML
\<< DUP SIZE 0 \-> l s ma
\<< 0 1 s
FOR x
'l' x GET SIZE MAX
NEXT
'ma' STO 1 s
FOR x
'l' x GET SIZE DUP
WHILE ma < REPEAT
'l' x 0 'l' x GET + PUT 1 + DUP
END
DROP
NEXT
l
\>>
\>>
LL\->M
\<< DUP DUP SIZE SWAP 1 GET SIZE \-> m r k
\<< 1 r
FOR a
m a GET OBJ\-> DROP
NEXT
r k 2 \->LIST \->ARRY
\>>
\>>
ROUN
\<< DUP TYPE \-> t
\<<
CASE
t NOT THEN
ROUN.MAI
END
t 1 SAME THEN
C\->R ROUN.MAI SWAP ROUN.MAI SWAP
IF DUP THEN
R\->C
ELSE
DROP
END
END
t 3 SAME t 4 SAME OR THEN
ARRY\->
IF DUP SIZE 1 SAME THEN
1 GET DUP
ELSE
DUP LIST\-> DROP *
END \-> d s
\<< 1 s
START ROUN s ROLL
NEXT d \->ARRY
\>>
END
t 5 SAME THEN
LIST\-> \-> s
\<< 1 s
START s ROLL ROUN
NEXT s \->LIST
\>>
END
t 9 SAME THEN
EQ.SPL ROUN EVAL
END
t 12 SAME THEN
OBJ\-> SWAP ROUN SWAP \->TAG
END
END
\>>
\>>
ROUN.MAI
\<< DUP SIGN SWAP ABS DUP IP SWAP FP 0 \-> m
\<<
WHILE DUP FP m 10 < AND REPEAT
IF DUP FP .0009 \<= THEN
FLOOR
ELSE
IF DUP FP .999 \>= THEN
CEIL
END
END
10 * m 1 + 'm' STO
END
m ALOG / + *
\>>
\>>
EQ.SPL
\<<
IF DUP TYPE 9 == THEN OBJ\-> \-> H O
\<< { } 1 H
START
SWAP EQ.SPL SWAP +
NEXT
O +
\>>
END
\>>
@ PCOEF by William C Wickes
PCOEF
\<< ROT '1-1' + 3 ROLLD
3 DUPN TYPE SWAP TYPE ROT
TYPE 3 \->LIST { 0 6 9 }
IF ==
THEN DUP 1 + \-> n
\<< #18CEAh SYSEVAL
SWAP
#549CCh SYSEVAL
#74D0h SYSEVAL
#59373h SYSEVAL
DROP #7497h SYSEVAL
1 n
FOR m m ROLL COLCT
NEXT
n \->LIST
\>>
END
\>>
@ NOTE! ************************ NOTE! ****************************** NOTE!
@ If you don't have POLY ver 3.2 by Wahne H Scott,
@ you must include following.
@ If you have POLY ver 3.2 don't forget to move the "directory END".
PDIV
\<< DUP SIZE 3 ROLLD OBJ\-> \->ARRY SWAP OBJ\-> \->ARRY \-> c b a
\<< a b
IF c 1 SAME THEN
OBJ\-> DROP / OBJ\-> 1 GET \->LIST { 0 }
ELSE
WHILE
OVER SIZE 1 GET c \>=
REPEAT DIVV
END
DROP \-> d
\<< a SIZE 1 GET c 1 - - IF DUP NOT THEN
1 END \->LIST d OBJ\-> OBJ\-> DROP \->LIST
\>>
END
\>>
\>>
TRIM
\<< OBJ\-> \-> n
\<< n
WHILE ROLL DUP ABS NOT n 1 - AND
REPEAT DROP 'n' DECR
END n ROLLD
n \->LIST
\>>
\>>
FCTP
\<<
IF DUP SIZE 3 > THEN
DUP BAIRS SWAP OVER PDIV DROP FCTP
END
\>>
RT
\<< TRIM DUP SIZE \-> n
\<<
IF n 3 > THEN
DUP BAIRS SWAP OVER PDIV DROP \-> A B
\<< A RT B RT \>>
ELSE
IF n 2 > THEN
QUD
ELSE
LIST\-> DROP NEG SWAP /
END
END
\>>
\>>
PMUL
\<< DUP2 SIZE SWAP SIZE \-> X Y ny nx
\<< 1 nx ny + 1 -
FOR I 0
NEXT 1 nx
FOR I
1 ny
FOR J
I J + 1 - ROLL X I GET Y J GET * + I J + 1 - ROLLD
NEXT
NEXT
{ } 1 nx ny + 1 -
START
SWAP +
NEXT
\>>
\>>
DIVV
\<< DUP 1 GET \-> a b c
\<< a 1 GET c / DUP b * a SIZE RDM a SWAP -
OBJ\-> 1 GETI 1 - PUT \->ARRY SWAP DROP b
\>>
\>>
QUD
\<< LIST\-> \->ARRY DUP 1 GET / ARRY\-> DROP ROT DROP SWAP 2
/ NEG DUP SQ ROT - \v/ DUP2 + 3 ROLLD -
\>>
BAIRS
\<< OBJ\-> 1 1 \-> n R S
\<< DO 0 n 1 + PICK 0 0 0 4 PICK 5 n + 7
FOR J J PICK R 7 PICK * + S 8 PICK * + 7 ROLL
DROP DUP 6 ROLLD R 3 PICK * + S 4 PICK * + 5 ROLL DROP -1
STEP
3 PICK SQ 3 PICK 6 PICK * -
IF DUP 0 == THEN
DROP 1 1
ELSE
6 PICK 6 PICK * 5 PICK 9 PICK * - OVER / 4 PICK 9 PICK * 8 PICK 7
PICK * - ROT / END DUP 'S' STO+ SWAP DUP 'R' STO+
UNTIL (0,1) * + ABS .000000001 < 7 ROLLD 6 DROPN END
n DROPN 1 R NEG S NEG 3 \->LIST
\>>
\>>
END
------------------------------------------------------------------------
Bug report and opinions are welcome.
-------------------------------------------------------------------------
Mattias Dahl & Morgan Lindvqist
d89-mdl@sm.luth.se d89-mlt@sm.luth.se
University of Lulea, SWEDEN
-------------------------------------------------------------------------
_ __ _ _ _ __
/ \ / \ / \ / \ / \
| | | | | | | | | |
| \ _ / | | | | \ _ / |
| |_| | \ / | |_| |
| | \ / | |
| | / \ | |
| | / \ | |
| | | \ / | |
/ | | | X / | |
\ _ / \_ \ _ _ _ / \ \ _ / \ _
---------------------------------------------------------------------------