Haskell add writer to function

here is the snippet to calculate whether knight can move to 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 w开发者_运维知识库ithin 3 moves
main = print $ reachesm (6,2) (6,1) 3

Now i want to add Writer monad to 'reaches' funsction, but completely lost here i come 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 does not even compile. I suspect its time for monad transormers here ?

UPD: So, finally we came to following rewrite, but i still unsatisfied with it, beacuse reachesm runs differently from pure variant, it recurses all n steps deep, but i expect it to stop iteration once it found the answer. Is it hard to modify it that way ? And another question is about laziness, it seem that in do block calculations are not lazy is it 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)

---

Well it sounds like you are really committed to using the writer monad for this. So here's a 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 though. The writer monad is only being used as a baroque interface to lists. Writer is not the solution to your problem, despite how much you clearly want it to be. 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) 

No writer monad, just the friendly old (:) operator.

---

Okay, our goal is to put this function into the Wrtier 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 the type signature. Just add Writer around the result type:

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

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

reaches _ _ 0 = return False

As you suspected, it gets a little trickier to do the recursive case. Let's start out like you did by telling the current pos, which you did right.

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

moveKnight is not in the writer monad so we don't have to bind it using <- to call it. Just use let (i.e. we could substitute moveKnight pos whenever we use our new variable if we wanted):

    let moves = moveKnight from

Now let's get the list of recursive results. This time we do have to bind, since we are getting the Bool out of a Writer [String] Bool. We will use the monadic variant of map, mapM :: (a -> m b) -> [a] -> m [b]:

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

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

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

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

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

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

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

This code still has an error, but it compiles and yields what you told it to over the writer channel, so it should be enough that you can debug the remaining issue easily. Hope this helped.

---

Here is a 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 like this:

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])

---

It's a bit easier (for me at least) to think of this as looking for a path in a tree.

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

import Data.Tree (levels, unfoldTree)

Now we write a function for unfolding the tree with history, 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 end position to the beginning in the 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 reverse this if we wanted a path from start to finish.)

This is a quick solution off the top of my head, and it's not necessarily very efficient, but I find it conceptually straightforward.

---

Here's 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)