Skip to main content

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.

Comments

Post a Comment

Popular posts from this blog

The purpose of the MOCK

In response to a much nicer blog entry, that can be found here . There are actually several distinct "tests" that make up usual unit tests, among them two that really do stand out: one kind of testing to test method flows, one to test some sort of computation. Mock objects are for the purpose of testing method flows. A method flow is a series of message transmissions to dependent objects. The control flow logic inside the method(the ifs and whiles) will alter the flow in repsonse to the parameters of the method call parameters passed by calling the method under test, depending on the state of the object that contains the method under test and the return values of the external method calls(aka responses to the messages sent). There should be one test method for every branch of an if statement, and usuale some sort of mock control objects in the mock framework will handle loop checking. BTW: I partly use message transmission instead of method invocation to include other kind...
2 comments
Read more

Erlang mock - erlymock

NOTE THIS POST IS OUTDATED! The project has evolved and can be found here: ErlyMock Some features Easy to use Design based on easymock Works together with otp: can be used even if the clut is called from another process, by invoking mock:verify_after_last_call(Mock,optional: timeout) custom return functions predefined return functions for returning values, receiving message, throwing exceptions, etc.. erlymock automatically purges all modules that were mocked, after verify() Custom argument matchers: %% Orderchecking types: in_order, out_of_order, stub; %% Answering: {return, ...}|{error, ...}|{throw, ...}|{exit, ...}|{rec_msg, Pid}|{function, Fun(Args) -> RetVal} expect(Mock, Type, Module, Function, Arguments, Answer = {AT, _}) when AT==return;AT==error;AT==throw;AT==exit;AT==rec_msg;AT==function -> call(Mock, {expect, Type, Module, Function, length(Arguments), {Arguments, Answer}}). %% this version of expect is suited for useing custom argument matchers expect(Mock, Type, ...
2 comments
Read more

Learning Haskell, functional music

As you might have realized, I started to learn Haskell. One of the most fun things to do in any programming language is creating some kind of audible side effects with a program. Already back in the days when I started programming, I always played around with audio when toying around with a new language. I have found a wonderful set of lecture slides about haskell and multimedia programming, called school of expression. Inspired by the slides about functional music I implemented a little song. Ahh ... and yes it is intended to sound slightly strange . I used the synthesis toolkit to transform the music to real noise, simply by piping skini message to std-out. I used this command line to achieve the results audible in the table: sven@hhi1214a:~/Mukke$ ghc -o test1 test1.hs && ./test1 | stk-demo Plucked -n 16 -or -ip Sound samples: Plucked play Clarinet play Whistle(attention very crazy!) play As always the source... stueck = anfang :+: mitte :+: ende anfang = groovy :+: (Trans ...
2 comments
Read more