The Polar Game in Haskell, Day 5 3/4: a Bug Fix and liftM

Jeff Licquia has been playing further with the code and so have I. He discovered a bug in the version I posted in yesterday's installment (my bad). In slide' I neglected to call slide' in the recursive version of slide' but called the existing non-monadic slide. In other words, I had:

slide' ( t : Empty : ts ) = noscore ( Empty : ( slide ( t : ts ) ) )

The problem here is that we'll add nothing to the accumulated score, and proceed into a chain of function invocations that handle ordinary lists. So the score increase that should happen at that point never happens:

*Main> runWriter $ collide' [Heart, House]
([Empty,House],Sum {getSum = 1})
*Main> runWriter $ collide' [Heart, Empty, House]
([Empty,Empty,House],Sum {getSum = 0})

Oops. Yeah, that's a bug. Note that the compiler can't catch this because it's doing what I've asked; there are not actually any type conflicts. The monadic slide' returns the type it is supposed to return, but in building up the "payload, the [ Tile ] part of ScoreTracker [ Tile ], the code fails to continue to build up the state. Let this be a lesson to me -- leaving around the previous version of a function, when I'm testing a new one can be hazardous!

So, we can just fix that by calling slide', right?

slide' ( t : Empty : ts ) = noscore ( Empty : ( slide' ( t : ts ) ) )

Um, not so much:

arctic-slide.hs:52:49:
    Couldn't match expected type `[Tile]'
                with actual type `ScoreTracker [Tile]'
    In the return type of a call of slide'
    In the second argument of `(:)', namely `(slide' (t : ts))'
    In the first argument of `noscore', namely
      `(Empty : (slide' (t : ts)))'

Oh... yeah. There's that. We want to continue building up the monadic version of the list, but the (:) just takes a regular list. Now it's all complicated! But really there's a simple solution. I'll quote Jeff for a while, since he explained it so well to me. I have not quoted his code exactly, but the ideas are the same:

...the straightforward fix fails, because slide' returns a ScoreTracker, not a [ Tile ]. So the fix is a little more complicated. Since slide' returns pretty much exactly what we need, we can start with just that:

slide' ( t : Empty : ts ) = slide' ( t : ts )

That's not quite right; we just dropped a tile. To get it back, remember that everything is a function, including the : operator [and so it is easily composed with other functions -- PRP]. That means we can create a function that prepends an Empty element to a list...

prefix_empty :: [ Tile ] -> [ Tile ] 
prefix_empty ts = Empty : ts

So why would we do this? Because we need to take ScoreTracker into account. Here Haskell provides a function called "liftM", which takes a normal function and "lifts" it into a monad. So:

prefix_empty_st :: ScoreTracker [ Tile ] -> ScoreTracker [ Tile ]
prefix_empty_st = liftM prefix_empty

will give us a function with the type ScoreTracker [ Tile ] -> ScoreTracker [ Tile ], which is what we want. (Technically, that's not true; it gives us Monad m => m [ Tile ] -> m [ Tile ]. But that's just a generic version of what we want, which works with ScoreTracker, Maybe, or lots of other monads).

So now we have this:

slide' ( t : Empty : ts ) = prefix_empty_st $ slide' ( t : ts )

Which doesn't use score or noscore -- it just builds up the list, still in a monadic context, preserving whatever score changes might be applied by the function invocations it makes. And actually since we're not going to use the prefix functions elsewhere, they don't really earn their keep, and we can just write:

slide' ( t : Empty : ts ) = liftM ( Empty : ) $ slide' ( t : ts )

Note the partial application of (:) by binding it to only one parameter before we pass it to liftM -- we're creating a new version of (:) that only takes one argument instead of two.

Jeff went on to identify a second bug, basically caused by the same problem in a collide' function also calling slide instead of slide'. A quick fix is to make that collide' function look like the slide' function we just fixed. But then, why not define one in terms of the other?

collide' ( t : Empty : ts ) | movable t = slide' ( t : Empty : ts )

Let's go back a bit and reconsider -- when I was using a special value for Edge, the logic for slide and collide was considerably simpler (although it did not work right). Here it is today:

slide' :: [ Tile ] -> ScoreTracker [ Tile ]
slide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Ice_Block : ts )
slide' ( t : Empty : ts ) = liftM ( Empty : ) $ slide' ( t : ts )
slide' ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide' ( t : ts )

collide' :: [ Tile ] -> ScoreTracker [ Tile ]
collide' [] = noscore []
collide' ( t : ts ) | fixed t = noscore ( t : ts )
collide' ( Bomb : Mountain : ts) = noscore ( [ Empty, Empty ] ++ ts )
collide' ( Heart : House : ts ) = score ( [ Empty, House ] ++ ts )
collide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Empty : ts )
collide' ( t : ts ) | ( movable t ) && ( ( null ts ) ||
    ( blocking $ head ts ) ) = noscore ( t : ts )
collide' ( t : Empty : ts ) | movable t =
    slide' ( t : Empty : ts )

Erm. I'd no longer call that elegant, beautiful code. For one thing, I have to wrap it brutally to fit into my Blogger text window. That's not just annoying when dealing with Blogger -- it suggests that the lines are too long for easy reading even if they aren't wrapped. And here's what Jeff's version looks like today -- he's implemented his own way to structure the code with guards:

slide :: [ Tile ] -> ScoreTracker [ Tile ]
slide [] = noscore []
slide ( t1 : t2 : ts )
  | t1 == Ice_Block && blocking t2 = noscore ( t1 : t2 : ts )
  | blocking t2 = collide ( t1 : t2 : ts )
  | otherwise = do
                  ts' <- slide ( t1 : ts )
                  return ( Empty : ts' )
slide ( t : ts )
  | t == Ice_Block = noscore ( t : ts )
  | otherwise = collide ( t : ts )

collide :: [ Tile ] -> ScoreTracker [ Tile ]
collide [] = noscore []
collide ( t1 : t2 : ts )
  | ( t1, t2 ) == ( Bomb, Mountain ) = noscore ( Empty : Empty : ts )
  | ( t1, t2 ) == ( Heart, House ) = score ( Empty : House : ts )
  | t1 == Ice_Block && blocking t2 = noscore ( Empty : t2 : ts )
  | movable t1 && blocking t2 = noscore ( t1 : t2 : ts )
  | movable t1 = do
                   ts' <- slide ( t1 : ts )
                   return ( Empty : ts' )
  | otherwise = noscore ( t1 : t2 : ts )
collide ( t : ts )
  | t == Ice_Block = noscore ( Empty : ts )
  | otherwise = noscore ( t : ts )

And I like that -- using the separate functions for both slide and collide only to handle the structurally different versions -- empty list, list with at least two items, list with at least one item -- and the guards to handle when we differ by value. It is, I think, more readable than mine. I was a little freaked out by the use of do and <- in the middle of a function outside of main, but I'll think on that some more. I have not quite satisfied myself that it is perfectly correct, but then, I haven't really convinced myself that mine is correct either. So I have more to do on that front!

The Polar Game in Haskell, Day 5 1/2: Refactoring with a Monad

The job search has eaten my brain for the last few days -- have I mentioned yet that I need a job? Oh, yes, I believe I may have -- but I'm taking some time to press on with my Haskell larnin', especially since I've been getting great, helpful feedback.

The first thing I did was make some minor fixes to the list implementation, as suggested by Jeff. It's working now and my version looks like this:

next_board_list :: BoardList -> Pos -> Dir ->
    ( Bool, BoardList )
next_board_list board pos dir =
    let ( penguin_moved, updated_view_list ) =
        step_list $ view_list board pos dir
    in ( penguin_moved, update_board_from_view_list 
         board pos dir updated_view_list )

apply_view_list_to_row :: [ Tile ] -> Int -> Bool -> [ Tile ] -> [Tile]
apply_view_list_to_row orig pos True update =
    take ( pos + 1 ) orig ++ update
apply_view_list_to_row orig pos False update =
    ( reverse update ) ++ ( drop pos orig )

apply_view_list_to_rows :: BoardList -> Int -> Int -> Bool -> [ Tile ]
    -> BoardList
apply_view_list_to_rows orig row pos is_forward update =
    take row orig ++
    nest ( apply_view_list_to_row ( orig !! row ) pos
           is_forward update ) ++
    drop ( row + 1 ) orig
    where nest xs = [xs]

update_board_from_view_list :: BoardList -> Pos -> Dir -> [ Tile ]
    -> BoardList
update_board_from_view_list board pos dir updated_view_list
    | is_eastwest = apply_view_list_to_rows board
                        ( posY pos ) ( posX pos )
                        is_forward updated_view_list
    | otherwise = transpose ( apply_view_list_to_rows ( transpose board )
                         ( posX pos ) ( posY pos ) 
                         is_forward updated_view_list )
    where is_forward = elem dir [ East, South ]
          is_eastwest = elem dir [ East, West ]

This code is on GitHub here.

Now, it turns out that Jeff did more than suggest a refactoring -- he actually did something I haven't quite gotten my head around yet, which is to refactor my code to use a monad for managing some of this task. He forked my code in his own GitHub repo here and sent me some notes to share on my blog. Here's part of what he said:

The way I got my head wrapped around monads was to think of them as "important stuff to do, but not the point". You need to do some housekeeping that's important, but it's not the reason you're writing this function. The classic example is division. You're writing a math library, and you need to implement division. Division by zero is something you need to deal with sanely, but it's not the point; you're writing the function because you want to divide by things that aren't zero. So, to handle the zero case, you return a Maybe instead of a simple number. Only now you can't just add numbers together with division, because you're dealing with Maybes, not numbers. So you end up implementing addition with Maybes, except that makes no sense, as adding never fails, and people using your math library get annoyed because now *they* have to deal with division-by-zero errors even when they're not dividing, and it's a mess. Except -- Maybe is a monad. So you skip all that mess, implement division with a Maybe, everything else without, and use the cool monad and functor features of the language to bridge the gaps. The same pattern exists with scorekeeping. A lot of the functions in your code need to keep track of the score and occasionally award points, but scores aren't "the point" of, say, collide. And when you start thinking about all the places you need to worry about scores, you start seeing scorekeeping infect all kinds of weird places in your code. I think you even mentioned having to "uglify" your code with scorekeeping in your blog post.

Yes, yes, yes -- mainly the chain of function invocations that handle generating the next board, down to the collide calls. Because it's only at the point where a heart disappears that we can decrement the heart count. Without state, I can't make this a global state. In a purely function form, I have to "thread" the indication that the heart count should be decreased through the whole chain of function signatures, which now all have to return an extra thing.

So, minimize the ugly with monads. Just do what you need to do to pass around the score, and deal with it when it's appropriate. (In my implementation, that was in next_world). The Writer monad is perfect for the job. It uses a monoid, which is a fancy ways of saying "something that knows how to grow". Lists are monoids, because you can append to them. Numbers are monoids, because you can add and multiply them. And so on. What the Writer monad does is take care of the adding part. You just return the thing you're working with, and the monad tacks it on using the monoid. Specifically, with scorekeeping, you just note how many points each individual action takes, and the monad does the adding together. When you finally deal with the score in next_world, you get all the accumulated points in one tidy variable.

OK, cool... let's see what he came up with!

import Control.Monad.Writer

...

-- Keep track of the score with a writer monad
type ScoreTracker = Writer ( Sum Int )

OK, let me pause there and see if I can make sense of that. Learn You a Haskell says

Whereas Maybe is for values with an added context of failure and the list is for non-deterministic values, the Writer monad is for values that have another value attached that acts as a sort of log value. Writer allows us to do computations while making sure that all the log values are combined into one log value that then gets attached to the result.

OK, I think I get that -- in Learn You it is used for implementing logging, not scoring of a game, but it seems like it could be generalizable. The example given does this just kind of thing I was mentioning -- makes a simple function return a tuple to pass both the actual interesting return value and the log string, or in our case I think we want a score. Learn You continues:

When we were exploring the Maybe monad, we made a function applyMaybe, which took a Maybe a value and a function of type a -> Maybe b and fed that Maybe a value into the function, even though the function takes a normal a instead of a Maybe a. It did this by minding the context that comes with Maybe a values, which is that they are values with possible failure. But inside the a -> Maybe b function, we were able to treat that value as just a normal value, because applyMaybe (which later became >>=) took care of checking if it was a Nothing or a Just value. In the same vein, let's make a function that takes a value with an attached log, that is, an (a,String) value and a function of type a -> (b,String) and feeds that value into the function. We'll call it applyLog. But because an (a,String) value doesn't carry with it a context of possible failure, but rather a context of an additional log value, applyLog is going to make sure that the log of the original value isn't lost, but is joined together with the log of the value that results from the function.

Oooh, again, that sounds very promising. So I'm convinced that Writer is the right abstraction here. The values that Writer gets are Sum and Int -- Sum is our monoid, Int is a type we're going to use to accumulate the updated score. (To go along with the Polar game logic, I think there really should ultimately be two scores -- one should be the heart count for a given board, which decrements, and gets tested against zero to indicate board completion, and the other should be a level, which increments as the player moves through the levels, but never mind that for now).

Jeff then came up with:

noscore :: a -> ScoreTracker a
noscore x = writer (x, Sum 0)

score :: a -> ScoreTracker a
score x = writer (x, Sum 1)

Two functions, noscore and score. I think these are both monadic return -- injecting a value, passing it to the next step while applying the sum operation. So let's see how he uses it. here's my slide function:

slide :: [ Tile ] -> [ Tile ]
slide ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) = 
    ( Ice_Block : ts )
slide ( t : Empty : ts ) =
    ( Empty : ( slide ( t : ts ) ) )
slide ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide ( t : ts )

I'm not going to take Jeff's current version, because he's restructured it a bit using guards, which obscures just the differences due to the use of the ScoreTracker, but here's a version that does the same thing. We don't have to explictly construct the return tuples:

slide' :: [ Tile ] -> ScoreTracker [ Tile ]
slide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) =
    noscore ( Ice_Block : ts )
slide' ( t : Empty : ts ) =
    noscore ( Empty : ( slide ( t : ts ) ) )
slide' ( t : ts ) | ( null ts ) || ( blocking $ head ts ) =
    collide ( t : ts )

And this doesn't actually compile. Note that collide doesn't handle the monad -- the compiler warns us as Jeff described:

    Couldn't match expected type `ScoreTracker [Tile]'
                with actual type `[Tile]'
    In the return type of a call of `collide'
    In the expression: collide (t : ts)
    In an equation for slide':
        slide' (t : ts)
          | (null ts) || (blocking $ head ts) = collide (t : ts)

That seems pretty clear -- so I have to fix it up the same way:

collide' :: [ Tile ] -> ScoreTracker [ Tile ]
collide' [] = noscore []
collide' ( t : ts ) | fixed t = 
    noscore ( t : ts )
collide' ( Bomb : Mountain : ts) = 
    noscore ( [ Empty, Empty ] ++ ts )
collide' ( Heart : House : ts ) = score ( [ Empty, House ] ++ ts )
collide' ( Ice_Block : ts ) | ( null ts ) || ( blocking $ head ts ) = 
    noscore ( Empty : ts )
collide' ( t : ts ) | ( movable t ) && ( ( null ts ) ||
    ( blocking $ head ts ) ) = noscore ( t : ts )
collide' ( t : Empty : ts ) | movable t = 
    noscore ( Empty : ( slide( t : ts ) ) )

And slide' should call collide' instead of collide, of course. So once this is compiled and loaded into GHCI, we can play with it and compare it to the original collide:

*Main> :t collide'
collide' :: [Tile] -> ScoreTracker [Tile]
*Main> :t collide
collide :: [Tile] -> [Tile]
*Main> collide [ Bomb, Mountain ]
[Empty,Empty]
*Main> collide [ Heart, House ]
[Empty,House]
*Main> collide' [ Heart, House ]

:23:1:
    No instance for (Show (ScoreTracker [Tile]))
      arising from a use of `print'
    Possible fix:
      add an instance declaration for (Show (ScoreTracker [Tile]))
    In a stmt of an interactive GHCi command: print it

Er, yeah. The result is not printable, but can we see its type?

*Main> :t ( collide' [ Heart, House ] )
( collide' [ Heart, House ] ) :: ScoreTracker [Tile]

In fact, we can. So there might be an easy way to make the monadic type printable -- deriving ( Show ) doesn't work -- but first, how do we extract the values? Well, we get back the return value of the whole chain from runWriter:

*Main> runWriter $ collide' [Heart, House]
([Empty,House],Sum {getSum = 1})

What's the type? It's just a tuple:

*Main> :t ( runWriter $ collide' [Heart, House] )
( runWriter $ collide' [Heart, House] ) :: ([Tile], Sum Int)
*Main> fst $ runWriter $ collide' [Heart, House]
[Empty,House]
*Main> snd $ runWriter $ collide' [Heart, House]
Sum {getSum = 1}

Anyway, I think my mind is blown enough for today. I'm going to stop there. Jeff has made some other modifications to my code here and there -- modifications that improve the clarity -- but I'll have to get back to those. I'm off to read the monad tutorials again, and maybe understand them better this time!