( FWT.TXT      1feb91ppz )

( N-point fast Walsh transform converted into FORTH by Carey Witkov, )
( Dept. of Physics, Broward Community College, 5/1/90, from a Fortran )
( algorithm by Tom Beer. )

( Edited by Pete Zawasky, 2/1/91, for NMI MAXFORTH on the 68HC11. )
(           263 W. Warren St.    )
(           Washington, NJ 07882 )
(           908-689-7450         )

DECIMAL

32 CONSTANT N    ( N=32 for sample data )
VARIABLE P
VARIABLE Q
VARIABLE R
VARIABLE S

N ARRAY Z     ( temporary storage array )
N ARRAY X     ( data and output array )

( Insert sample data here )
: DATA>X         ( --- )
( Sample data; 32-point sampled sine wave; scaling factor = 1000 )
  195  0 X !
  383  1 X !
  556  2 X !
  707  3 X !
  831  4 X !
  924  5 X !
  981  6 X !
 1000  7 X !
  981  8 X !
  924  9 X !
  831 10 X !
  707 11 X !
  556 12 X !
  383 13 X !
  195 14 X !
    0 15 X !
 -195 16 X !
 -383 17 X !
 -556 18 X !
 -707 19 X !
 -831 20 X !
 -924 21 X !
 -981 22 X !
-1000 23 X !
 -981 24 X !
 -924 25 X !
 -831 26 X !
 -707 27 X !
 -556 28 X !
 -383 29 X !
 -195 30 X !
    0 31 X !
;

: .X           ( --- )      ( Look at the DATA array X )
CR N 0
DO
  I X @ 5 .R CR
LOOP
;

: **      ( n1 n2 --- n1-to-the-n2-power )
          ( from J.I. Anderson, in STARTING FORTH by Leo Brodie )
1 SWAP ?DUP      ( put 1 on stack in case exponent = 0 )
IF               ( DO...LOOP only if exponent is > 0 )
  0
  DO
    OVER *
  LOOP
THEN
SWAP DROP
;

: INITIALIZE     ( --- )
N 0
DO
  I X @  I 1+ X @  +  I X !
  I X @  I 1+ X @  2 * -  I 1+ X !
2 +LOOP
0 R !
;

: FWT            ( --- )
( Unnormalized fast Walsh transform of the data array X. )
( Transformed values replace data in X. )

INITIALIZE        ( work on array X )
BEGIN
  R 1+!           ( increment counter R )
  2 R @ ** S !
  S @ N - 0<      ( make it readable first )
WHILE             ( make it fast later )
  0 P !  0 Q !
  BEGIN
    S @ 0
    DO
      P @ I +     X @ P @ I + S @ +     X @ + Q @     Z !
      P @ I +     X @ P @ I + S @ +     X @ - Q @ 1 + Z !
      P @ I + 1 + X @ P @ I + S @ + 1 + X @ - Q @ 2 + Z !
      P @ I + 1 + X @ P @ I + S @ + 1 + X @ + Q @ 3 + Z !
      Q @ 4 + Q !
    2 +LOOP
    2 S @ * P @ + P !
    Q @ N - 0<
  WHILE
  REPEAT
  N 0
  DO
    I Z @ I X !   ( move data from array Z to array X )
  LOOP
REPEAT
;

: CHECK-FWT      ( --- )
( Normalizes and prints transformed array )
N 0
DO
  I 8 /MOD DROP 0=
  IF                ( put 8 values per line )
    CR
  THEN
  I X @ N / 6 .R
LOOP CR
;