Haskell adds author to work

Question

Here is a snippet to calculate if a knight can move to a desired position within x moves:

import Control.Monad (guard) import Control.Monad.Writer type KnightPos = (Int,Int) -- function returning array of all possible kinght moves from desired position moveKnight :: KnightPos -> [KnightPos] moveKnight (c,r) = do (c',r') <- [ (c+2,r-1),(c+2,r+1),(c-2,r-1),(c-2,r+1) ,(c+1,r-2),(c+1,r+2),(c-1,r-2),(c-1,r+2) ] guard (c' `elem` [1..8] && r' `elem` [1..8]) return (c',r') -- nice little function tells us -- whether knight can move to desired position within x moves reaches :: KnightPos -> KnightPos -> Int -> Bool reaches _ _ 0 = False reaches from pos n = any (\p -> p == pos || reaches p pos (n-1)) $ moveKnight from -- the result is True or False -- does knight can move from cell 6,2 to cell 6,3 within 3 moves main = print $ reachesm (6,2) (6,1) 3 

Now I want to add the Writer monad to the “achievement” funsction, but completely lost here I came to something like:

 -- not so nice and little yet reachesm :: KnightPos -> KnightPos -> Int -> Writer [String] [Bool] reachesm _ _ 0 = return [False] reachesm from pos n = do tell [ "-->" ++ (show pos) ] p <- moveKnight from -- ??? np <- reachesm p pos (n-1) return(p == pos || any np) 

but it doesn't even compile. I suspect it's time for monastic persecutors here?

UPD: So, finally, we have come to the next rewrite, but I'm still not satisfied with this, beacuse reachm works differently from the clean version, it recurses all n steps deeply, but I expect it to stop iterating as soon as it finds answer. Is it hard to change? And one more question concerns laziness, it seems that in block computing it is not lazy, is that true?

 reachesm :: KnightPos -> KnightPos -> Int -> Writer [String] Bool reachesm _ _ 0 = return False reachesm from pos n = do tell [ "-->" ++ (show from) ] let moves = moveKnight from np <- forM moves (\p -> reachesm p pos (n-1)) return (any (pos ==) moves || or np) 

Answer 1

Well, it sounds like you are truly committed to using a monad writer for this. So here is the solution:

 reachesm :: KnightPos -> KnightPos -> Int -> [Writer [String] Bool] reachesm from pos n | from == pos = return (return True) reachesm _ _ 0 = return (return False) reachesm from pos n = do p <- moveKnight from map (tell [show from ++ "-->" ++ show p] >>) $ reachesm p pos (n-1) main = print . filter fst . map runWriter $ reachesm (6,2) (6,3) 3 

This is silly. The writer monad is used only as a baroque interface for lists. Writer not a solution to your problem, no matter how explicitly you want it. Here is how I would write this algorithm:

 -- returns all paths of length at most n to get to target paths :: Int -> KnightPos -> KnightPos -> [[KnightPos]] paths 0 _ _ = [] paths n target p | p == target = return [p] | otherwise = map (p:) . paths (n-1) target =<< moveKnight p main = print $ paths 4 (6,3) (6,2) 

There is no writer monad, just a friendly old operator (:) .

Answer 2

Well, our goal is to put this function in Votier's monad.

 reaches :: KnightPos -> KnightPos -> Int -> Bool reaches _ _ 0 = False reaches from pos n = any (\p -> p == pos || reaches p pos (n-1)) $ moveKnight from 

So, let's start with a type signature. Just add Writer around the result type:

 reaches :: KnightPos -> KnightPos -> Int -> Writer [String] Bool 

The original function did not return [Bool] , so there is no reason for the new function to return Writer [String] [Bool] . Raise the return value of the base case:

 reaches _ _ 0 = return False 

As you suspected, for a recursive case it gets a little harder. Start by tell current pos , which you did correctly.

 reaches from pos n = do tell ["-->" ++ show pos] 

moveKnight not in the writer's monad, so we don’t need to bind it with <- to invoke it. Just use let (i.e. we can substitute moveKnight pos whenever we use our new variable if we want):

  let moves = moveKnight from 

Now let's get a list of recursive results. This time we need to bind, since we get the Bool from the Writer [String] Bool . We will use the monadic version of map , mapM :: (a -> mb) -> [a] -> m [b] :

  np <- mapM (\p -> reachesm p pos (n-1)) ps 

Now np :: [Bool] . So, we just finish your logic:

  return (any (pos ==) moves || or np) 

or :: [Bool] -> Bool is just any id .

So remember to bind the variable when you want to get a from ma , use <- , otherwise use let .

To use it from main , you can use runWriter :: Writer wa -> (w,a) :

 main = print $ runWriter (reachesm (6,2) (6,1) 3) 

This code still has an error, but it compiles and gives what you told him on the write channel, so it should be enough so that you can easily debug the remaining problem. Hope this helps.

Answer 3

Here is the version that works:

 main = print $ runWriterT (reachesm (6,2) (6,5) 4) reachesm :: KnightPos -> KnightPos -> Int -> WriterT [String] [] Bool reachesm _ _ (-1) = return False reachesm from pos n | from == pos = tell [ "-->" ++ (show from) ] >> return True | otherwise = do p <- lift (moveKnight from) t <- reachesm p pos (n-1) guard t tell [ "-->" ++ (show from) ] return True 

Also, your moveKnight function can be written as follows:

 moveKnight :: KnightPos -> [KnightPos] moveKnight (c,r) = filter legal possible where possible = [ (c+2,r-1),(c+2,r+1),(c-2,r-1),(c-2,r+1) ,(c+1,r-2),(c+1,r+2),(c-1,r-2),(c-1,r+2)] legal (c',r') = (c' `elem` [1..8] && r' `elem` [1..8]) 

Answer 4

It's a little easier (at least for me) to think of it as finding a path in a tree.

First we import a couple of functions from Data.Tree :

 import Data.Tree (levels, unfoldTree) 

Now we will write a function to expand the tree with the story, take the top n + 1 levels of the tree and see if they contain the desired position:

 reaches :: KnightPos -> KnightPos -> Int -> Maybe [KnightPos] reaches from pos n = lookup pos . concat . take (n + 1) $ levels tree where tree = unfoldTree unfolder (from, []) unfolder (p, hist) = ((p, hist'), map (flip (,) hist') $ moveKnight p) where hist' = p : hist 

This gives us a path from the final position to the beginning in a given number of steps, if it exists:

 *Main> reaches (6,2) (6,1) 3 Just [(6,1),(7,3),(8,1),(6,2)] 

(We could, of course, change this if we needed a path from start to finish.)

This is a quick fix from my head, and it is not necessarily very effective, but I find it conceptually simple.

Answer 5

Here is my late attempt:

 import Control.Monad type KnightPos = (Int,Int) moveKnight :: KnightPos -> [KnightPos] moveKnight (c,r) = do (c',r') <- [(c+2,r-1),(c+2,r+1),(c-2,r-1),(c-2,r+1) ,(c+1,r-2),(c+1,r+2),(c-1,r-2),(c-1,r+2)] guard (c' `elem` [1..8] && r' `elem` [1..8]) return (c',r') findpath :: KnightPos -> KnightPos -> Int -> [[KnightPos]] findpath start end steps = trail [start] steps where trail curtrail steps = do nextstep <- moveKnight $ last curtrail if steps == 1 then do guard (nextstep == end) return (curtrail ++ [nextstep]) else trail (curtrail ++ [nextstep]) (steps - 1)