Question

我想定义一个管理错误的状态monad（在某种意义上就像Maybe）：如果在“do”计算期间发生错误/问题，它将由>>=引导并传播。该错误还应包含描述它的字符串。之后，我想将此monad应用于mapTreeM，使用for map函数将状态视为数字和包含数字的树，并在每个访问步骤中通过向其添加当前叶的值来更新当前状态;生成的树必须包含一对旧叶值和访问时刻的状态。如果状态在计算期间变为负数，则此访问必须失败，如果状态为正，则必须成功。

e.g。鉴于此树：Branch (Branch (Leaf 7) (Branch (Leaf (-1)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9))

我们获得一棵树（考虑初始状态0）：Branch (Branch (Leaf (7,7)) (Branch (Leaf (-1,6)) (Leaf (3,9)))) (Branch (Leaf (-2,7)) (Leaf (9,16)))

如果我们将-18放在第二片叶子中，我们应该得到一个错误的值，表示我们达到了负状态(-11)。

我做了这样的事情来打印树而没有管理错误......我还不明白该怎么做。以下是我的代码：

module Main where

-- State monad
newtype State st a = State (st -> (st, a))

instance Monad (State state) where

return x = State(\s -> (s,x))

State f >>= g = State(\oldstate -> 
                    let (newstate, val) = f oldstate
                        State newf      = g val
                    in newf newstate)




-- Recursive data structure for representing trees
data Tree a = Leaf a | Branch (Tree a) (Tree a)
          deriving (Show,Eq)


-- Utility methods     
getState :: State state state
getState = State(\state -> (state,state))

putState :: state -> State state ()
putState new = State(\_ -> (new, ()))


mapTreeM :: (Num a) => (a -> State state b) -> Tree a -> State state (Tree b)
mapTreeM f (Leaf a) = 
f a >>= (\b -> return (Leaf b))
mapTreeM f (Branch lhs rhs) = do
 lhs' <- mapTreeM f lhs
 rhs' <- mapTreeM f rhs
 return (Branch lhs' rhs')


numberTree :: (Num a) => Tree a -> State a (Tree (a,a))
numberTree tree = mapTreeM number tree
    where number v = do
        cur <- getState
        putState(cur+v)
        return (v,cur+v)

-- An instance of a tree                         
testTree = (Branch 
              (Branch
                (Leaf 7) (Branch (Leaf (-1)) (Leaf 3)))
           (Branch
                (Leaf (-2)) (Leaf (-20))))


runStateM :: State state a -> state -> a
runStateM (State f) st = snd (f st)


main :: IO()              
main = print $ runStateM (numberTree testTree) 0

Answer 1

我可以为您的问题提出替代解决方案吗？虽然Monads适用于许多事物，但您可以通过一个简单的功能来完成跟踪错误。我的下面的函数transferVal就是这种函数的一个例子。函数transferVal遍历从左到右Tree，同时保持找到的最后一个值。如果发生错误，该函数将返回错误并停止遍历Tree。如果出现问题，最好使用Maybe来获得更明确的错误，而不是使用Either <error_type> <result_type>。在我的示例中，我使用([ChildDir],a)包含[ChildDir] 被控制的节点的“方向”和a是触发错误的错误值。函数printErrorsOrTree是如何使用transferVal的输出的示例，main包含4个示例，其中前三个是正确的，最后一个触发了您期望的错误

module Main where

import Data.List     (intercalate)
import Control.Monad (mapM_)

data Tree a = Leaf a | Branch (Tree a) (Tree a)
  deriving (Show,Eq)

-- given a Branch, in which child the error is?
data ChildDir = LeftChild | RightChild
  deriving Show

-- an error is the direction to get to the error from the root and the
-- value that triggered the error
type Error a = ([ChildDir],a)

-- util to append a direction to an error
appendDir :: ChildDir -> Error a -> Error a
appendDir d (ds,x) = (d:ds,x)

transferVal :: (Ord a,Num a) => Tree a -> Either (Error a) (Tree (a,a))
transferVal = fmap fst . go 0
  where go :: (Ord a,Num a) => a -> Tree a -> Either (Error a) (Tree (a,a),a)
        go c (Leaf x) = let newC = x + c
                        in if newC < 0
                             then Left ([],newC)
                             else Right (Leaf (x,newC),newC)
        go c (Branch t1 t2) = case go c t1 of
            Left e             -> Left $ appendDir LeftChild e
            Right (newT1,newC) -> case go newC t2 of
                Left              e -> Left $ appendDir RightChild e 
                Right (newT2,newC') -> Right (Branch newT1 newT2,newC')

printErrorsOrTree :: (Show a,Show b) => Either (Error a) (Tree b) -> IO ()
printErrorsOrTree (Left (ds,x)) = putStrLn $ "Error in position " ++ (intercalate " -> " $ map show ds) ++ ". Error value is " ++ show x
printErrorsOrTree (Right     t) = putStrLn $ "Result: " ++ show t

main :: IO ()
main = mapM_ runExample
             [(Leaf 1)
             ,(Branch (Leaf 1) (Leaf 2))
             ,(Branch (Branch (Leaf 7) (Branch (Leaf (-1)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9)))
             ,(Branch (Branch (Leaf 7) (Branch (Leaf (-11)) (Leaf 3))) (Branch (Leaf (-2)) (Leaf 9)))]
  where runExample orig = do
          let res = transferVal orig
          print orig
          printErrorsOrTree res

Answer 2

通过将Tree数据类型设为Traversable的实例，您可以使用mapM（来自Data.Traversable）来映射Tree上的操作。您还可以在StateT monad顶部对Either monad变换器进行分层，以提供错误处理。

import Control.Monad.State
import Control.Applicative
import Control.Monad.Error
import Data.Monoid
import Data.Foldable
import Data.Traversable
import qualified Data.Traversable as T

-- our monad which carries state but allows for errors with string message    
type M s = StateT s (Either String)

data Tree a = Leaf a | Branch (Tree a) (Tree a)
          deriving (Show,Eq)

-- Traversable requires Functor
instance Functor Tree where
    fmap f (Leaf a) = Leaf (f a)
    fmap f (Branch lhs rhs) = Branch (fmap f lhs) (fmap f rhs)

-- Traversable requires Foldable
instance Foldable Tree where
    foldMap f (Leaf a) = f a
    foldMap f (Branch lhs rhs) = foldMap f lhs `mappend` foldMap f rhs

-- Finally, we can get to Traversable
instance Traversable Tree where
    traverse f (Leaf a) = Leaf <$> f a
    traverse f (Branch lhs rhs) = Branch <$> traverse f lhs <*> traverse f rhs

testTree = (Branch
              (Branch
                (Leaf 7) (Branch (Leaf (-1)) (Leaf 3)))
           (Branch
                (Leaf (-2)) (Leaf (-20))))

numberTree :: (Num a, Ord a) => Tree a -> M a (Tree (a,a))
numberTree = T.mapM number where
    number v = do
        cur <- get
        let nxt = cur+v
        -- lift the error into the StateT layer
        when (nxt < 0) $ throwError "state went negative"
        put nxt
        return (v, nxt)

main :: IO ()
main =
    case evalStateT (numberTree testTree) 0 of
        Left e -> putStrLn $ "Error: " ++ e
        Right t -> putStrLn $ "Success: " ++ show t

如何定义状态monad？

2 个答案: