extra/math/transforms/haar/haar.factor

   1 ! Copyright (c) 2008 Slava Pestov, Aaron Schaefer.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs columns grouping kernel math math.statistics math.vectors
   4     sequences ;
   5 IN: math.transforms.haar
   6
   7 ! Haar Wavelet Transform -- http://dmr.ath.cx/gfx/haar/
   8
   9 <PRIVATE
  10
  11 : averages ( seq -- seq' )
  12     [ mean ] map ;
  13
  14 : differences ( seq averages -- differences )
  15     [ 0 <column> ] dip v- ;
  16
  17 : haar-step ( seq -- differences averages )
  18     2 group dup averages [ differences ] keep ;
  19
  20 : rev-haar-step ( seq -- seq )
  21     halves [ v+ ] [ v- ] 2bi zip concat ;
  22
  23 PRIVATE>
  24
  25 : haar ( seq -- seq' )
  26     dup length 1 <= [ haar-step haar prepend ] unless ;
  27
  28 : rev-haar ( seq -- seq' )
  29     dup length 2 > [ halves swap rev-haar prepend ] when rev-haar-step ;