My Evolution as a Haskell Programmer: Factorial with Arrows

A couple of years ago Fritz Ruehr wrote a great article about The Evolution of a Haskell Programmer. It was written in 2001, when I was still in high school, some years away from being introduced to the beautiful Haskell programming language.

Currently, I’m following a course on Advanced Functional Programming at the Utrecht University. One of the advanced topics tought in that course is about Arrows. Arrows are an abstraction of computations, just like Monads, but even more general and pretty nice to define stream functions with (useful for defining logical circuits, for example). I’m still trying to get my head fully around it, but so far I understand it enough to add a new part to the evolution (a missing link!): the factorial function defined with arrows.

I will present the code below and sparsely comment on it. Most of the code is actually from the Advanced Functional Programming lecture.

-- We need this library 
import Control.Arrow        

-- Define a type for stream functions, from one list to another 
newtype SF a b = SF { runSF :: [a] -> [b] }      

-- Define the Arrow functions for the SF type.  Once you've 
-- defined these three, you'll get a lot of other functions for 
-- free. 
instance Arrow SF where 
  arr f = SF (map f) 
  SF f >>> SF g = SF (f >>> g) 
  first (SF f) = SF (unzip >>> first f >>> uncurry zip)      

-- arr   lifts a function to the arrow domain 
-- >>>   combines (connects) two arrow functions 
-- first only applies the function to the first part from a 
--       tuple      

-- See the http://www.haskell.org/arrows for more 
-- information and some nice graphics, which will help 
-- understanding.

Okay, so far, so good. By defining the ‘first’ and ‘>>>’ functions, we get an ‘&&&’ combinator for free, which we will use in our final definition. For example: ‘f &&& g’ can be understood as accepting and input x, then applying both f and g to it, resulting in the output of a tuple of the results. In short, the type of ‘&&&’ is ‘Arrow arr => arr a b -> arr a c -> arr a (b, c)’.

-- The type of loop is (ArrowLoop arr) => arr (a, c) (b, c) -> 
-- arr a b.  A loop makes a function from 'a' to 'b', while 
-- 'looping' a 'c'. 
instance ArrowLoop SF where 
  loop (SF f) = SF $ \\as -> 
    let (bs,cs) = unzip (f (zip as (stream cs))) 
    in bs      

-- Note in the definition that cs is defined recursive(!)  This 
-- is really where the usefulness of Haskell's lazyness kicks 
-- in.  Although, because zip and unzip are both strict, we 
-- have to help it a little, by defining a helper function 
-- stream.      

stream :: [a] -> [a] 
stream ~(x:xs) = x:stream xs      

-- The ~ in the pattern makes the pattern matching irrefutable, 
-- which means that the pattern will not be interpreted but 
-- assumed to be correct.

Well, with that out of the way we can get to the good stuff. We just need two simple helpers to modify the stream.

-- 'Delays' a stream by prepending an element.  This can be 
-- used to initialize a stream _before_ the input is read. 
-- We're going to need this to use that nasty loop above. 
-- Remember, the c was defined recursive, without 
-- initialization. 
delay :: a -> SF a a 
delay x = SF (x:)      

-- Takes an input and muliplies it.  It 'simply' lifts an 
-- uncurried (*) to the arrow domain. 
-- Example (try it yourself): mul (6,7) = 42 
mul :: Arrow arr => arr (Integer, Integer) Integer 
mul = arr (uncurry (*))

Okay, now, the basic idea is to supply a stream function with the list of integers and then all we have to do is multiply the result of the first item with the second and multiply that result with the third, etc. Aha, that’s easy, we can just use the loop for that. The only thing we need is in initialization value to start the multiplying with. For this we use the delay. Schematicly, our plan looks like the following picture.

You can clearly see how the loop works while the input and the output of the whole is still a single stream. The dot in the image where the output of ‘mul’ splits is actually the ‘&&&’ combinator. The code then looks like this.

facSF :: SF Integer Integer 
facSF = loop (mul >>> (arr id &&& delay 1))

Pretty clean, eh? Only thing left is a nice wrapper to run this thing.

-- Using Integers so that for large numbers (and factorials 
-- tend to get really large fast) it still produces nice 
-- output.  Try 'fac 420' for example. 
fac :: Integer -> Integer 
fac x = runSF facSF [1..x] !! fromInteger (x - 1)

This concludes our fun with Arrows. Viva la evolucion!