[comp.sys.handhelds] Polynomial routines Version 3

wscott@en.ecn.purdue.edu (Wayne H Scott) (09/03/90)

Alright everyone, 

When I first released my polynomial routines I was suprised at the
number of people who responded and said that I was just what they
were looking for.  

Well...

Here it is, my polynomial routines version 3.

This package include the following programs.

TRIM	Strip leading zeros from polynomial object.
IRT	Invert root program.  Given n roots it return a nth degree polynomial.
PDER	Derivative of a polynomial.
RDER	Derivative of a rational function.
PF	Partial Fractions.  (Handles multiple roots!)
FCTP	Factor polynomial
RT	Find roots of any polynomial
L2A	Convert a list to an array and back.
PADD	Add two polynomials
PMUL	Multiply two polynomials.
PDIV	Divide two polynomials.
EVPLY	Evalulate a polynomial at a point.
COEF	Given an equation return a polynomial list.

These programs should work on a 28s, but I might have use the HP-48 only
routines.  When someone gets it working on a 28 send me any changes you
have to make.

I think people will find these very useful and work as I say, but if you
find any bugs please send me E-Mail.  Comments are also welcome.

Some of these routines could be faster (PF, PMUL, ...) tell me if you know
how to speed them up.

_______________________________________________________________________________
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
_______________________________________________________________________________


These programs all work on polynomials in the follows form:

3*X^3-7*X^2+5 is entered as  { 3 -7 0 5 }

so going down the list...

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.

TRIM  is used to strip the leading zeros from a polynomial list.

{0 0 3 0 7 } TRIM => { 3 0 7 }

RDER  will give the derivative of a rational function.

ie. d        x + 4                   -X^2 - 8*x + 31
    --   -------------  =   --------------------------------
    dx   x^2 - 7*x + 3      x^4 - 14*x^3 + 55*x^2 - 42*x + 9

2: { 1 4 }
1: { 1 -7 3 }
RDER
2: { -1 -8 31 }
1: { 1 -14 55 -42 9 }

I don't know about you but I think it's useful.

IRT will return a polynomial whose roots you specify.

ie.  If a transfer function has zeros at -1, 1 and 5 the function
     is x^3 - 5*x^2 - x + 5

1: { -1 1 5 }
IRT
1: { 1 -5 -1 5 }

PDER will return the derivtive of a polynomial.

.ie   The  d/dx (x^3 - 5*x^2 - x + 5) = 3*x^2 - 10*x - 1

1: { 1 -5 -1 5 }
PDER
1: { 3 -10 -1 }

PF will do a partial fraction expansion on a transfer function.

.ie       s + 5	         1/18    5/270    2/3      1/9       2/27
     ----------------- = ----- + ----- - ------- - ------- - -----
     (s-4)(s+2)(s-1)^3   (s-4)   (s+2)   (s-1)^3   (s-1)^2   (s-1) 

2: { 1 5 }
1: { 4 -2 1 1 1 }
PF
1: { 5.5555e-2 1.85185e-2 -.6666 -.11111 -.074074 }

This program expects the polynomial of the numerator to be on level 2 and
a list with the poles to be on level 1.  Repeated poles are suported but
they must be listed in order.  The output is a list of the values of the 
fraction in the same order as the poles were entered.

PADD, PMUL, and PDIV are all obvious, they take two polynomial lists off
the stack and perform the operation on them.

PDIV returns the polynomial and the remainder polynomial.

L2A converts a list to and array. (and back)

1: { 1 2 3 }
L2A
1: [ 1 2 3 ]
L2A
1: { 1 2 3 }

EVPLY evalutates and polynomial at a point.

x^3 - 3*x^2 +10*x - 5 | x=2.5   = 16.875

2: { 1 -3 10 -5 }
1: 2.5
EVPLY
1: 16.875

%%HP: T(3)A(R)F(.);
DIR
      TRIM
        \<< OBJ\-> \-> n
          \<< n
            WHILE
ROLL DUP 0 ==
            REPEAT
DROP 'n' DECR
            END n
ROLLD
            IF n 0
==
            THEN {
0 }
            ELSE n
\->LIST
            END
          \>>
        \>>
      RDER
        \<< \-> F G
          \<< G F
PDER PMUL G PDER {
-1 } PMUL F PMUL
PADD G G PMUL
          \>>
        \>>
      IRT
        \<< OBJ\-> \-> n
          \<<
            IF n 0
>
            THEN 1
n
              START
n ROLL { 1 } SWAP
NEG +
              NEXT
            ELSE {
1 }
            END
            IF n 1
>
            THEN 2
n
              START
PMUL
              NEXT
            END
          \>>
        \>>
      PDER
        \<< OBJ\-> \-> n
          \<< 1 n
            FOR i n
ROLL n i - *
            NEXT
DROP
            IF n 1
==
            THEN {
0 }
            ELSE n
1 - \->LIST
            END
          \>>
        \>>
      PF
        \<< MAXR { }
\-> Z P OLD LAST
          \<< 1 P
SIZE
            FOR I P
I GET \-> p1
              \<<
IF p1 OLD \=/
THEN Z p1 EVPLY 1 P
SIZE
  FOR J
    IF P J GET P I
GET \=/
    THEN p1 P J GET
- /
    END
  NEXT p1 'OLD' STO
{ } 'LAST' STO
ELSE
  IF { } LAST SAME
  THEN 1 { } 1 P
SIZE
    FOR K P K GET
      IF DUP p1 ==
      THEN DROP
      ELSE +
      END
    NEXT IRT Z SWAP
  ELSE LAST OBJ\->
DROP
  END RDER DUP2 5
PICK 1 + 3 ROLLD 3
\->LIST 'LAST' STO p1
EVPLY SWAP p1 EVPLY
SWAP / SWAP ! /
END
              \>>
            NEXT P
SIZE \->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 
          \>>
        \>>
      L\178A
        \<<
          IF DUP
TYPE 5 ==
          THEN OBJ\->
\->ARRY
          ELSE OBJ\->
1 GET \->LIST
          END
        \>>
      PADD
        \<< DUP2 SIZE
SWAP SIZE \-> A B nB
nA
          \<< A L\178A B
L\178A
            IF nA
nB <
            THEN
SWAP
            END
            IF nA
nB \=/
            THEN 1
nA nB - ABS
              START
0
              NEXT
            END nA
nB - ABS 1 + ROLL
OBJ\-> 1 GET nA nB -
ABS + \->ARRY + L\178A
          \>>
        \>>
      PMUL
        \<< DUP2 SIZE
SWAP SIZE \-> A B nB
nA
          \<< { }
            IF nB 1
>
            THEN 2
nB
              START
0 +
              NEXT
            END DUP
'A' STO+ 'A' SWAP
STO+ A OBJ\-> \->ARRY B
OBJ\-> DROP
            IF nB 1
>
            THEN 2
nB
              FOR J
J ROLL
              NEXT
            END
            IF 3 nA
nB + \<=
            THEN 3
nA nB +
              START
0
              NEXT
            END nA
nB 1 - 2 * + \->ARRY
2 nA nB +
            START
DUP2 DOT 3 ROLLD
OBJ\-> SWAP nA nB 1 -
2 * + 1 + ROLLD
\->ARRY
            NEXT
DROP2 nA nB + 1 -
\->LIST
          \>>
        \>>
      PDIV
        \<< DUP SIZE
3 ROLLD OBJ\-> \->ARRY
SWAP OBJ\-> \->ARRY \-> c
b a
          \<< a b
            WHILE
OVER SIZE 1 GET c \>=
            REPEAT
DIVV
            END
DROP \-> d
            \<< a
SIZE 1 GET c 1 - -
\->LIST d OBJ\-> OBJ\->
DROP \->LIST
            \>>
          \>>
        \>>
      EVPLY
        \<< OVER
          IF DUP
TYPE 5 ==
          THEN SIZE
          ELSE SIZE
1 GET
          END \-> a r
n
          \<< a 1 GET
            IF n 1
>
            THEN 2
n
              FOR i
r * a i GET +
              NEXT
            END
          \>>
        \>>
      COEF
        \<< \-> E n
          \<< 0 n
            FOR I 0
'X' STO E EVAL 'X'
PURGE E 'X' \.d 'E'
STO I ! /
            NEXT 2
n 1 +
            FOR I I
ROLL
            NEXT n
1 + \->LIST
          \>>
        \>>
      EQ 1
  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 R\->C
ABS .000000001 < 7
ROLLD 6 DROPN
        END n DROPN
1 R NEG S NEG 3
\->LIST
      \>>
    \>>
END