Haar in Factor

So the journey went on today. Tried to implement the Haar transformation. Slava already wrote it but I wanted to do it on my own. Slava's version is much more condense whereas mine looks like real beginner's code. I must apologize again but I'm a rookie if it comes to stackbased programming.

Here we go:


IN: haarwavelet
USING: sequences math kernel ;

: sdup ( x y -- y x x )
swap dup ;

: get-avgs-diffs ( avg-diff -- diff avg avg )
first2 sdup ;

: mean ( avg -- avg-next )
get-avgs-diffs 2 group [ first2 + 2 / ] map ;

: append-diffs ( diff avg diff-next -- avg diff )
rot append ;

: make-avg-diff ( avg diff -- avg-diff )
{ } swap add swap add* ;

: diffs ( avg avg-next -- avg-next diff )
dup rot 2 group 1 [ - ] 2map
append-diffs make-avg-diff ;

: concat-first2 ( avg-diff -- haar-result )
first2 append ;

: haar-finished? ( avg-diff -- avg-diff bool )
dup first length 1 <= ;

: mean&diffs
mean diffs ;

: haar-wavelet ( avg-diff -- avg-diff )
haar-finished?
[ mean&diffs haar-wavelet ] unless ;

: haar ( avg-diff -- haar-result )
haar-wavelet concat-first2 ;

: rev-diffs
sdup first2 length dup rot length + swap - swap
second swap tail make-avg-diff ;

: frame-x-with-y ( x y -- y x x y )
dup rot dup rot ;

: -rswap ( x y z -- y x z )
-rot swap ;

: rev-mean
frame-x-with-y + -rswap - make-avg-diff ;

: rev-means
dup first2 [ rev-mean ] 2map flatten ;

: rev-means&diffs
rev-means rev-diffs ;

: haar-inv-finished?
dup second length zero? ;

: haar-wavelet-inv ( avg-diff -- avg-diff )
haar-inv-finished?
[ rev-means&diffs haar-wavelet-inv ] unless ;

PROVIDE: demos/haarwavelet ;


You can use it like this:

{ { 56 40 8 24 48 48 40 16 } { } } haar-wavelet haar-wavelet-inv






In Ocaml it would look like this:


let rec haar ?(s=[]) ?(d=[]) l = match l, s with
| ([] | [_] as s), [] -> s @ d
| [], s -> haar ~s:[] ~d s
| h1::h2::t, s -> haar ~s:(h1+h2::s) ~d:(h1-h2::d) t
| _ -> invalid_arg "haar";;


Not bad either!

I'd say the actual core lines of my Factor code is this:

: haar-wavelet ( avg-diff -- avg-diff )
haar-finished?
[ mean&diffs haar-wavelet ] unless ;

This is very terse, too.

I can't really say why I am so thrilled by Factor. I think it's the interactivity. It doesn't really feel like programming. It feels more like talking to Factor.

Haar code is of course not finished. It would need some polishing. Next things I wanna try is the help and unit testing facility of Factor. Stay tuned!