Haskell добавляет писателя к функции

Question

здесь приведен фрагмент, позволяющий вычислить, может ли рыцарь перейти в нужную позицию в пределах x ходов:

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

Теперь я хочу добавить монаду Writer в функцию «достигает», но полностью потерянная здесь я пришел к чему-токак,

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

, но он даже не компилируется.Я подозреваю, что пришло время для монадных трансормеров здесь?

UPD: Итак, наконец-то мы пришли к следующему переписыванию, но я все еще недоволен этим, потому что досягаемость работает иначе, чем в чистом варианте, она повторяет n шаги глубоко, но я ожидаю, что он остановит итерацию, как только найдет ответ.Сложно ли это так изменить?И еще один вопрос - о лени, кажется, что в do вычислениях блоков не лень, это правда?

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

Похоже, вы действительно решили использовать для этого монаду писателя.Итак, вот решение:

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

Это глупо, хотя.Монада писателя используется только как барочный интерфейс для списков.Writer не является решением вашей проблемы, несмотря на то, насколько сильно вы этого хотите.Вот как бы я написал этот алгоритм:

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

Нет монады писателя, только дружелюбный старый оператор (:).

Answer 2

Хорошо, наша цель - поместить эту функцию в монаду Wrtier.

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

Итак, начнем с подписи типа. Просто добавьте Writer вокруг типа результата:

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

Исходная функция не вернула [Bool], поэтому у новой функции нет причин возвращать Writer [String] [Bool]. Поднимите возвращаемое значение базового случая:

reaches _ _ 0 = return False

Как вы и подозревали, рекурсивный случай становится немного сложнее. Давайте начнем, как вы, с tell текущего pos, который вы сделали правильно.

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

moveKnight нет в монаде писателя, поэтому нам не нужно связывать его, используя <- для его вызова. Просто используйте let (т. Е. Мы можем заменить moveKnight pos всякий раз, когда мы используем нашу новую переменную, если мы хотим):

    let moves = moveKnight from

Теперь давайте получим список рекурсивных результатов. На этот раз мы do должны связать, так как мы получаем Bool из Writer [String] Bool. Мы будем использовать монадический вариант map, mapM :: (a -> m b) -> [a] -> m [b]:

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

Сейчас np :: [Bool]. Итак, мы просто заканчиваем вашу логику:

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

or :: [Bool] -> Bool это просто any id.

Помните, чтобы связать переменную, когда вы хотите получить a из m a, используйте <-, в противном случае используйте let.

Для использования с main вы можете использовать runWriter :: Writer w a -> (w,a):

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

В этом коде все еще есть ошибка, но он компилирует и выдает то, что вы сказали ему по каналу записи, поэтому должно быть достаточно, чтобы вы могли легко отладить оставшуюся проблему. Надеюсь, это помогло.

Answer 3

Вот версия, которая работает:

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

Также ваша функция moveKnight может быть написана так:

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

Немного проще (по крайней мере для меня) думать об этом как о поиске пути в дереве.

Сначала мы импортируем пару функций из Data.Tree:

import Data.Tree (levels, unfoldTree)

Теперь мы напишем функцию для разворачивания дерева с историей, возьмем верхние n + 1 уровни дерева и посмотрим, содержат ли они требуемую позицию:

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

Это дает нам путь от конечной позиции к началу за заданное количество шагов, если оно существует:

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

(Конечно, мы могли бы изменить это, если бы мы хотели путь от начала до конца.)

Это быстрое решение на макушке головы, и оно не обязательно очень эффективно, но я считаю его концептуально простым.

Answer 5

Вот моя поздняя попытка:

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)