Monday, September 15, 2008

ArrowLoop - finally seeing the light at the end of a long tunnel

Today I achieved something I long lusted to acheive, I made the step from fix to loop.
Basically by going from the applicative order Y combinator:


(define (y f)
((lambda (ff)
(lambda (xx)
(f (ff ff) xx)))
(lambda (ff)
(lambda (xx)
(f (ff ff) xx)))))

(define (fak f n)
(if (= 0 n)
1
(* (f (- n 1)) n)))

((y fak) 5)



to writing the same in lazy haskell:



y f = f $ y f

fak r 0 = 1
fak r n = n * r (n - 1)

-- ghci> y fak 5 ----> 120


someone told me that
 fix = y 

and that fix and loop are closely related.
I found an aspiring blogpost and thought it would be fun to
do the fibonacci recursion instead of the simple factorial.

That resulted in:


data SF a b = SF {runSF :: [a] -> [b]}

instance Arrow SF where
arr f = SF (map f)
(SF f) >>> (SF g) = SF (f >>> g)
first (SF f) = SF $ unzip >>> (first f) >>> zip'

instance ArrowLoop SF where
loop (SF f) = SF (\ins ->
let (outs, rs) = (zip' >>> f >>> unzip) (ins, lazy rs)
in outs)


lazy ~(z:zs) = z : lazy zs
zip' = uncurry zip
delay n = SF (n:)

{-

The Fibonacci device
1 2 3 4

o----x ,->(delay b)-. ,-->(id)------->o
| |=>(uncurry (+))-|
o---------'---(id)-----' `-->(delay a)-->o

(the first input is merely a clock source...)

with the loop around:



-}
fib n = take n (runSF (loop (fib' 0 1)) [1,1..])
fib' :: (Num a) => a -> a -> SF (a, a) (a, a)
fib' a b = arr snd >>> -- 1
(delay b &&& arr id) >>> -- 2
arr (uncurry (+)) >>> -- 3
(arr id &&& delay a) -- 4

{-


The experimental Fibonacci device
1 2 3 4
o-------------------------------------------. ,------(id)----->o
,->(delay b)-. |===> (uncurry (*))-|
| |=>(uncurry (+))-----' `--->(delay a)-->o
o---------'---(id)-----'


-}
fibex' :: (Num a) => a -> a -> SF (a, a) (a, a)
fibex' a b = (second
((delay b &&& arr id) >>> -- 1
arr (uncurry (+)))) -- 2
>>>
(arr (uncurry (*))) >>> -- 3
((arr id) &&& (delay a)) -- 4


fibex n = take n (runSF (loop (fib' 0 1)) [1..])



That was/is really fun. I like haskell.