[comp.sys.handhelds] STATE-SPACE SYSTEM manipulation programs, PART 2

mcgrant@elaine2.stanford.edu (Michael Grant) (12/02/90)

UNCOMMENTED SET OF STATE-SPACE SYSTEM PROGRAMS

---
[[-2 -3 -4]
 [ 1  0  0]
 [ 0  1  0]]
'A' STO
[1 0 0 0]
'B' STO
[[3 5 7]]
'C' STO
0
'D' STO

<<
   << IF DUP TYPE 1 <=
      THEN DROP 1 1
      ELSE SIZE LIST-> 1 == 1 IFT
      END 
   >> -> P
   << A P EVAL B P EVAL C P EVAL D P EVAL -> AR AC BR BC CR CC DR DC
      << ""
         IF AR AC <>
         THEN "AS" +
         END
         IF BR BC <>
         THEN "AB" +
         END
         IF AC CC <>
         THEN "AC" +
         END
         IF BC DC <>
         THEN "BD" +
         END
         IF CR DR <>
         THEN "CD"
         END
         IF DUP SIZE 0 ==
         THEN OK + AR 'ns' STO DC 'ni' STO DR 'no' STO
              { ns ns } 0 CON 'tmp' STO ns IDN 'idt' STO
         END
      >>
   >>
>>
'INITIALIZE' STO

<< IF D ABS
   THEN D 1
   ELSE 0
   END ->LIST { 1 } 'tmp' 0 CON 1 -> ai 
   << 1 ns
      FOR J ai idt * 'tmp' STO+ SWAP C tmp B * *
         IF 1 no == 1 ni == AND
         THEN 1 GET
         END D 'tmp' A STO* 0 1 ns
            FOR K 'tmp' { K K } GET +
            NEXT J NEG / DUP 'ai' STO * + + SWAP ai +
      NEXT
   >>
>>
'TFNCAL' STO

<< {} { 1 } 'tmp' 0 CON 1 -> ai
   << 1 ns
      FOR J ai idt * 'tmp' STO+ SWAP tmp 'tmp' A STO* 0 1 ns
         FOR K 'tmp' { K K } GET +
         NEXT J NEG / 'ai' STO + SWAP ai +
      NEXT
   >>
>>
'ADJ' STO

<< C -> X
   << X ARRY-> DROP 2 ns
      START X A * DUP 'X' STO ARRY-> DROP
      NEXT ns no * ns 2 ->LIST ->ARRY
   >>
>>
'OBSR' STO

<< B { ns ni } RDM -> X
   << X TRN ARRY-> DROP 2 ns
      START A X * DUP 'X' STO TRN ARRY-> DROP
      NEXT ns ni * ns 2 ->LIST ->ARRY TRN
   >>
>>
'CNTR' STO

<< -> np
   << { 1 ns } 0 CON ns 1 PUT CNTR INV * np A EPOLY *
   >>
>>
'FBGN' STO

<< -> L R
   << L SIZE -> N
      << 0 -> K
         << 1 N
            FOR I 'L' I GET R K * + DUP 'K' STO
            NEXT
         >> -> RM
         << N 1 - ->LIST RM
         >>
      >>
   >>
>>
'SNDV' STO

<< -> L V
   << L SIZE -> N
      << 0 1 N
         FOR I 'L' I GET V N I - ^ * +
         NEXT
      >>
   >>
>>
'POLY' STO

<< -> L M
   << L SIZE
      IF M TYPE DUP 3 == SWAP 4 == OR
      THEN M IDM
      ELSE 1
      END -> N I
      << 0 1 N
         FOR J M * 'L' J GET I * +
         NEXT
      >>
   >>
>>
'EPOLY' STO

<< -> L N
   << L 1 L SIZE
      FOR J 'L' J GET N GET J SWAP PUT
      NEXT
   >>
>>
'POLCH' STO

<< -> L M
   << L 1 L SIZE
      FOR J M 'L' J GET *
         IFERR DUP SIZE
         THEN
         ELSE
            IF DUP { 1 } == SWAP { 1 1 } == OR
            THEN 1 GET
            END
         END J SWAP PUT
      NEXT
   >>
>>
'PREM' STO

<< -> L M
   << L 1 L SIZE
      FOR J 'L' J GET M *
         IFERR DUP SIZE
         THEN
         ELSE
            IF DUP { 1 } == SWAP { 1 1 } == OR
            THEN 1 GET
            END
         END J SWAP PUT
      NEXT
    >>
>>
'POSTM' STO

[[0]]
'tmp' STO
[[1]]
'idt' STO
1
'ns' STO
1
'no' STO
1
'ni' STO
---