demos/haar.factor

   1 ! Haar wavelet transform -- http://dmr.ath.cx/gfx/haar/
   2 IN: haar
   3 USING: sequences math kernel ;
   4
   5 : averages ( seq -- seq )
   6     [ first2 + 2 / ] map ;
   7
   8 : differences ( seq averages -- differences )
   9     >r 0 <column> r> [ - ] 2map ;
  10
  11 : haar-step ( seq -- differences averages )
  12     2 group dup averages [ differences ] keep ;
  13
  14 : haar ( seq -- seq )
  15     dup length 1 <= [ haar-step haar swap append ] unless ;
  16
  17 PROVIDE: demos/haar ;