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!
1 comment:
Yup, the do notation takes some getting used to. It's unfortunate that you have to learn it right away just to get things done, because it's easy to get the concepts wrong in the beginning and then have to "unlearn" them.
We can convert those out of do notation. The first block in slide would look like this:
| otherwise = slide ( t1 : ts ) >>= \ts' -> return ( Empty : ts' )
Or, we could do this:
| otherwise = liftM ( Empty : ) $ slide ( t1 : ts )
Look familiar? :-)
The first form is a direct translation from the do block, just how it's implemented internally. Thinking about how that works is a good way to start breaking out of the "do notation is for IO and main" rut. In particular, the idea that:
do
x <- foo
bar x
is just another way to say:
foo >>= \x ->
bar x
Essentially, that <- is creating a little anonymous function to be inserted into the chain of binds. Even though it looks like variable assignment in other languages, it's not.
Post a Comment