[comp.sys.handhelds] A convenient little set of DFT programs, PART 2

mcgrant@elaine3.stanford.edu (Michael Grant) (11/22/90)

UNCOMMENTED SET OF DFT PROGRAMS

---
<< DHT DUP ARRY-> SZ
   << 2 SZ LIST-> DROP 1 - 
      FOR I I ROLL
      NEXT SZ ->ARRY
   >> DUP2 - (0,1) * - +
   IF DUP IM CNRM NOT
   THEN RE
   END .5 *
>>
'DFT' STO

<< CONJ DFT CONJ DUP SIZE LIST-> DROP / >>
'IDFT' STO

<< DUP SIZE LIST-> DROP RCLF -> L N F
   << RAD PRCSN FIX L ~pi~ ~pi~ + -> S
      << 0 N 1 - 
         FOR J J N / S * DUP SIN SWAP COS + J 1 + SWAP PUT
         NEXT
      >> -> C
      << L 0 N 1 -
         FOR J 0 0 N 1 -
            FOR K J * N MOD 1 + GET 'L' K 1 + GET * +
            NEXT RND J 1 + SWAP PUT
         NEXT
      >> F STOF
   >>
>>
'DHT' STO

<< DHT DUP SIZE LIST-> DROP / >>
'IDHT' STO

<< -> F N
   << 0 N 1 - 
      FOR J J F EVAL
      NEXT { N } ->ARRY
   >>
>>
'SAMP' STO

<< -> L1 L2 PR
   << L1 SIZE LIST-> DROP L2 SIZE LIST-> DROP MIN -> N
      << L1 { N } RDM 1 N
         FOR J 'L1' J GET 'L2' J GET PR EVAL J SWAP PUT
         NEXT
      >>
   >>
>>
'ARO2' STO

<< << * >> ARO2 >>
'PROD' STO

<< -> L PR
   << L SIZE LIST-> DROP -> N
      << L 1 N
         FOR J 'L' J GET PR EVAL J SWAP PUT
         NEXT
      >>
   >>
>>
'AR01' STO

<< (1,0) * << R->P >> ARO1 >>
'C->MP' STO

<< (1,0) * << P->R >> ARO1 >>
'MP->C' STO

<< DUP SIZE LIST-> DROP -> L1 L2 N
   << IF N L1 SIZE LIST-> DROP <>
      THEN [ 1 ] TRN
      ELSE L1 1 N
         FOR J 0 1 N
            FOR K 'L1' K GET 'L2' J K - N MOD 1 + GET * +
            NEXT J SWAP PUT
         NEXT
      END
   >>
>>
'CCNV' STO

<< PAD2 CCNV >>
'LCNV' STO

<< DUP2 SIZE LIST-> DROP SWAP SIZE LIST-> DROP + 1 - 1 ->LIST -> S
   << S RDM SWAP S RDM SWAP >>
>>
'PAD2' STO

<< -> L N
   << L 
      IF L SIZE LIST-> DROP N <
      THEN { N } RDM
      END
   >>
>>
'ZPAD' STO

<< -> L N
   << L SIZE LIST-> DROP -> M
      << L
         IF M N <
         THEN { N } RDM M 1 + N
            FOR J 'L' J M MOD
               IF DUP NOT
               THEN DROP M
               END GET J SWAP PUT
            NEXT
         END
      >>
   >>
>>
'RPAD' STO

10
'PRCSN' STO

{ DFT IDFT DHT IDHT CCNV LCNV PROD MP->C C->MP
  PAD2 RPAD ZPAD SAMP AR01 AR02 PRCSN } ORDER

---
Michael C. Grant              "God does not play dice." Einstein
Information Systems Lab       "Geez, He'd win a lot if he did,
mcgrant@portia.stanford.edu    though..." Mike