Deducing code from types: filterM

The other day in #haskell a few people were trying to figure out how to generate the list of all sublists of a given list. Various people tried various kludgy things involving inits and tails and concatMap, none of which quite worked correctly, until:

13:26:10  > filterM (const [True,False]) "123"
13:26:11   ["123","12","13","1","23","2","3",""]
13:26:29  o_O

(lambdabot wasn’t working so Baughn had temporarily run another one under the nick Baughnie.) Anyway, this was sort of like that moment from Monty Python’s Holy Grail when the townspeople are trying to guess “what also floats in water”, and King Arthur suddenly says, “a duck”. To someone more well-versed in the ways of Haskell, Cale’s code is probably unremarkable; to me, it seemed like magic: although I’m quite comfortable with monads I had never seen filterM before, and had no idea how this worked (although clearly, it did). So, I looked up filterM using hoogle:

filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
--This generalizes the list-based filter function.

Here’s where I did something interesting, and I’m glad I did: instead of just clicking on “Source” to see the implementation, I decided to see if I could deduce the implementation of filterM, given only this information. I’d like to take you on a journey through my thought process: I learned a lot from this exercise and I think that anyone at about the same level of Haskell-fu as me (i.e. comfortable with the type system and monads, but still picking up idioms and bits and pieces of useful library functions, etc.) probably can too. Ready?

First, let’s recall the implementation of filter:

filter :: (a -> Bool) -> [a] -> [a]
filter _ []     = []
filter p (x:xs)
     | p x       = x : filter p xs
     | otherwise = filter p xs

Pretty straightforward: recursively take each element of the list, and prepend it to the result if and only if applying the predicate p to it returns True.

So now let’s write filterM. Note the type is almost the same as the type of filter, except that the predicate returns a Bool value inside a monad, and the resulting list is supposed to be inside the same monad. The first case is easy, and follows directly from the type:

filterM' p [] = return []

If the second argument (of type [a]) is an empty list, this is the only possible implementation (other than undefined): first of all, we know nothing about the type a, so there’s no way we can generate anything other than an empty list if we’re not given any values of type a in the first place; second, we want the result to be a list inside a monad, but we don’t know anything specific about the monad, so all we can do is return.

Now, for the recursive case. Since this is supposed to be similar to filter, we’ll first assume that we should do something with the first element, recurse on the rest, and combine them somehow. First things first:

filterM' p (x:xs) =
    let rest = filterM' p xs in ...

Of course, rest has type m [a]. OK, now what should we do with the first element, x? Let’s look at the types: x is of type a, and the other thing we have (p) is of type (a -> m Bool). It’s pretty obvious what we should do: apply p to a, and get something of type m Bool. Then we can pull out a Bool value using do-notation and call it b:

filterM' p (x:xs) =
    let rest = filterM' p xs in
      do b  p x ...

Now, what to do with b? Well, by analogy with filter, we should probably use it to decide whether to prepend x to rest! The only difference is that rest is of type m [a] so we can’t just prepend x like x : rest. We’ll have to use liftM to apply (x:) inside the monad:

filterM' p (x:xs) =
    let rest = filterM' p xs in
      do b  p x
         if b then liftM (x:) rest
              else            rest

And we’re done! Here’s the whole implementation, for reference:

import Control.Monad  -- for liftM

filterM' :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
filterM' p [] = return []
filterM' p (x:xs) =
    let rest = filterM' p xs in
      do b  p x
         if b then liftM (x:) rest
              else            rest

Does it work?

*Main> filterM' (const [False,True]) [1,2,3]
[[],[3],[2],[2,3],[1],[1,3],[1,2],[1,2,3]]
*Main> filterM' (x -> if even x then Just True else Nothing) [2,4..8]
Just [2,4,6,8]
*Main> filterM' (x -> if even x then Just True else Nothing) [2,4,6,7,8]
Nothing

Sure seems to! A quick look at the actual library code shows that we did things a little differently, but filterM’ is essentially the same as filterM (I leave a formal proof as an exercise =). All with nothing more than the type and a vague statement of purpose! Of course, this is not the only implementation that fits the type — and I’m not just talking about things like filterM’ = undefined; there are other implementations whose most general type is the same as filterM. But it’s still amazing to me how much information is to be found just in types.

And now I understand how filterM (const [True,False]) works… do you? (Hint: how does (const [True,False]) match the type a -> m Bool? How does sequencing work in the list monad?)

Solving an arithmetic puzzle with Haskell

[EDIT: since this post still seems to get a good deal of traffic, I should note that (as you can see if you read the comments) the code I gave here is not quite correct. Still, it's interesting enough that I'll leave it up.]

JD2718 posted a puzzle the other day: the idea is to count how many possible results you can get by combining the numbers 4,3,2,1 (in that order) with the four arithmetic operators and parentheses. Naturally I decided to write some Haskell code to solve this one.

First, instead of thinking in terms of possibly using parentheses, I just generate all possible postfix expressions. But instead of creating some sort of algebraic data type to represent expressions, generating all possible expressions, and evaluating, I sort of interleaved the processes. First, I generate the list 4,3,2,1 with operations optionally applied along the way in all possible ways, then reduce them in all possible ways to a single result, discarding duplicates the whole time. Here’s the code:

import Data.Ratio
import Data.List

type Op = (Rational -> Rational -> Rational)
type Stack = [Rational]

-- make a special kind of division to ignore division by zero. This
-- doesn't give any spurious results since if we can get zero as one
-- of the arguments, we can legitimately create another zero by
-- multiplying.
(//) :: Rational -> Rational -> Rational
a // 0 = 0
a // b = a / b

-- turn a normal binary operator into a function which operates 
-- on the top two elements of a stack.
mkStackOp :: Op -> Stack -> Stack
mkStackOp op (x1:x2:xs) = (x2 `op` x1) : xs
mkStackOp op s = s

negateTop :: Stack -> Stack
negateTop (x:xs) = (negate x) : xs

-- operations that reduce a stack (i.e. binary operations)
stackReducers :: [Stack -> Stack]
stackReducers = map mkStackOp [(+), (-), (*), (//)]

-- operations that transform a stack without reducing it (unary
-- operations).  to allow unary negation, just add negateTop to the
-- list.
stackTransformers :: [Stack -> Stack]
stackTransformers = [id]

allStackOps = stackReducers ++ stackTransformers

-- build up a stack by adding one more element (applying all possible
-- stack transformers), while applying all possible operations to the
-- previous elements.
build :: Rational -> Stack -> [Stack]
build n []  =     [ f [n]             | f  <- stackTransformers ]
build n stk = nub [ f [n] ++ (f' stk) | f  <- stackTransformers,
                                        f' <- allStackOps       ]

-- perform one reduction on a stack in all possible ways.
reduce1 :: Stack -> [Stack]
reduce1 [x] = [[x]]
reduce1 stk = [ f stk | f <- stackReducers ]

-- like >>=, but discarding duplicates.  Ideally we would
--   do this with a Monad instance of Data.Set, but that's
--   currently not possible without doing some contortions
--   to redefine the Monad class (since currently there's no
--   way to define a monad over a subcategory of Haskell types,
--   like we would need to define a Data.Set monad over only
--   Eq types).  See http://www.randomhacks.net/articles/
--   2007/03/15/data-set-monad-haskell-macros.
l >>- f = nub $ concatMap f l

-- completely reduce a stack to a single number in all possible ways.
reduce :: Stack -> [Stack]
reduce [x] = [[x]]
reduce stk = reduce1 stk >>- reduce

-- build up stacks with the given rationals, then reduce.
buildAndReduce :: [Rational] -> Stack -> [Stack]
buildAndReduce [] = reduce
buildAndReduce (r:rs) = s -> (build r s >>- buildAndReduce rs)

-- given a list of starting numbers, return the list of all possible
-- results using arithmetic operators and parentheses on the numbers
-- in the given order.
results :: [Rational] -> [Rational]
results rs = sort $ concat $ buildAndReduce rs []

There’s a little ambiguity in the description of the problem: are we allowed to use – as prefix negation, or just as binary subtraction? The code above treats it only as binary subtraction. In that case we get 52 distinct results ranging from -5 = 4 – 3 * (2+1) to 36 = 4 * 3 * (2+1). 8 are negative, 28 are integers:

Prelude> :l fours
[1 of 1] Compiling Main             ( fours.hs, interpreted )
Ok, modules loaded: Main.
*Main> results [4,3,2,1]
[(-5)%1,(-3)%1,(-2)%1,(-5)%3,(-1)%1,(-2)%3,(-1)%2,(-1)%3,
0%1,1%3,4%9,1%2,4%7,2%3,4%5,1%1,4%3,3%2,8%5,5%3,
2%1,7%3,5%2,8%3,3%1,10%3,7%2,11%3,4%1,13%3,9%2,
5%1,11%2,6%1,13%2,7%1,8%1,9%1,10%1,11%1,12%1,13%1,
14%1,15%1,16%1,20%1,21%1,23%1,24%1,25%1,28%1,36%1]
*Main> length it
52
*Main> length $ filter ((1==) . denominator) $ results [4,3,2,1]
28
*Main> length $ filter (<0) $ results [4,3,2,1]
8

If we allow unary negation, then we get 87 distinct possibilities, 47 of which are integers (and, of course, exactly half of the nonzero possibilities are negative, since they are just the negations of the positive possibilities).