wscott@EN.ECN.PURDUE.EDU (Wayne H Scott) (04/12/90)
This file is set up to be downloaded into a HP48sx but it should work just
fine with a HP28.
%%HP: T(3)A(R)F(.);
@ The following is a set of programs that I developed to find the roots of
@ polynomials. However as a bonus I also created a program to reduce any
@ polynomial into its quadric factors.
@
@ The first program is FCTP. (factor polynomial)
@ When it is passed the cooeficients of a polynomial in a list it returns the
@ factor of that polynomal. ex:
@
@ 1: { 1 -17.8 99.41 -261.218 352.611 -134.106 }
@ FCTP
@ 3: { 1 -4.2 2.1 }
@ 2: { 1 -3.3 6.2 }
@ 1: { 1 -10.3 }
@
@ This tells us that X^5-17.8*X^4+99.41*X^3-261.218*X^2+352.611*X-134.106
@ factors to (X^2-4.2*X+2.1)*(X^2-3.3*X+6.2)*(X-10.3)
@
@ Neat!
@
@ The next program is RT. (Roots)
@ If given a polynmoial it return its roots. ex:
@
@ 1: { 1 -17.8 99.41 -261.218 352.611 -134.106 }
@ RT
@ 5: 3.61986841536
@ 4: .58013158464
@ 3: (1.65, 1.8648056199)
@ 2: (1.65, -1.8648056199)
@ 1: 10.3
@
@ Very Useful!
@
@ These programs use the BAIRS program which performs Bairstow's method of
@ quadratic factors and QUD with does the quadratic equation.
@
@ Have Fun!
@ _____________________________________________________________________________
@ Wayne Scott | INTERNET: wscott@en.ecn.purdue.edu
@ Electrical Engineering | BITNET: wscott%ea.ecn.purdue.edu@purccvm
@ Purdue University | UUCP: {purdue, pur-ee}!en.ecn.purdue.edu!wscott
@ _____________________________________________________________________________
@ "To iterate is human. To recurse, divine."
DIR
FCTP
\<<
IF DUP SIZE 3 > THEN
BAIRS
FCTP
END
\>>
RT
\<< DUP SIZE \-> n
\<<
IF n 3 > THEN
BAIRS
\-> A B \<< A RT B RT \>>
ELSE
IF n 2 > THEN
QUD
ELSE
LIST\-> DROP NEG SWAP DROP
END
END
\>>
\>>
BAIRS
\<< LIST\-> 1 - 1 1 \-> n R S
\<< n 3 + 1 2 \->LIST 0 CON DUP \-> B C
\<<
DO
3 n 3 +
FOR J
'B' J n 6 + J - PICK R 'B' J 1 - GET * + S 'B' J 2 - GET * + PUT
'C' J 'B' J GET R 'C' J 1 - GET * + S 'C' J 2 - GET * + PUT
NEXT
'C' n 1 + GET SQ 'C' n 2 + GET 'C' n GET * - \-> DEN
\<< 'B' n 3 + GET 'C' n GET * 'B' n 2 + GET 'C' n
1 + GET * - DEN / DUP R + 'R' STO
'C' n 2 + GET 'B' n 2 + GET * 'C' n 1 + GET
'B' n 3 + GET * - DEN / DUP S + 'S' STO
\>>
UNTIL ABS .000000001 < SWAP ABS .000000001 < AND
END
n 1 + DROPN
1 R NEG S NEG 3 \->LIST
3 n 1 +
FOR J
'B' J GET
NEXT n 1
- \->LIST
\>>
\>>
\>>
QUD
\<< LIST\-> \->ARRY DUP 1 GET / ARRY\->
DROP ROT DROP SWAP
2 / NEG DUP SQ ROT
- \v/ DUP2 + 3 ROLLD -
\>>
END