Haskell маркировка узлов бинарного дерева моей монадой состояния не работает - PullRequest
Новая
       71

Haskell маркировка узлов бинарного дерева моей монадой состояния не работает

0 голосов
/ 19 апреля 2020

Пока я написал следующий код, я протестировал все функции, и они хорошо работают, но тестируя функцию indexNodesM, она просто не работает, я думаю, что метод put не работает правильно.

Ниже приведены примеры тестов: 

execState (indexNodesM exTree1) 0 == 6
evalState (indexNodesM exTree1) 0 == Node (5,3) (Node (3,1) Leaf (Node (2,11) (Node (0,7) Leaf Leaf) (Node (1,5) Leaf Leaf))) (Node (4,13) Leaf Leaf)

Например, выполнение execState (indexNodesM exTree1) 0 дает 0 в качестве результата.

Мой код: 

{-# LANGUAGE InstanceSigs #-}


import Control.Monad (ap)


newtype State s a = S { runState :: s -> (a,s) }

evalState :: State s a -> s -> a
evalState (S f) s = fst (f s)

execState :: State s a -> s -> s
execState (S f) s = snd (f s)

instance Functor (State s) where
 fmap :: (a -> b) -> (State s a) -> (State s b)
 fmap f (S g) = S (\n -> (f (fst (g (n))), n))

instance Applicative (State s) where
  pure  = return
  (<*>) = ap 

instance Monad (State s) where
 return :: a -> (State s a)
 return a = S (\n -> (a, n))
 (>>=) :: (State s a) -> (a -> State s b) -> (State s b)
 (>>=) (S f) g   = S (\n -> runState (g (fst (f n))) (n))

get :: State s s
get = S (\n -> (n, n))

put :: s -> State s ()
put x = S (\n -> ((),x))

modify :: (a -> a) -> State a ()
modify f = S (\n -> ((),  f n))

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

exTree1 :: Tree Int
exTree1 =
  Node 3
    (Node 1
      Leaf
      (Node 11
        (Node 7
          Leaf
          Leaf)
        (Node 5
          Leaf
          Leaf)))
    (Node 13
      Leaf
      Leaf)

indexNodesM :: Tree a -> State Int (Tree (Int, a))
indexNodesM Leaf = return Leaf
indexNodesM (Node x tree1 tree2) = do
 i <- get
 put (i + 1)
 t1 <- indexNodesM tree1
 t2 <- indexNodesM tree2
 return (Node (i, x) t1 t2)

В чем может быть проблема ? Заранее спасибо.

1 Ответ

1 голос
/ 22 апреля 2020

Добро пожаловать в переполнение стека. Если вы исправите определение вашей государственной монады, то она будет работать так, как вы ожидаете. Проблема с вашей текущей реализацией заключается в том, что ни >>=, ни fmap фактически не обновляют состояние, так как вы всегда используете fst, чтобы выбросить состояние, а затем использовать старое состояние. Вот исправленная реализация: 

import Control.Monad (ap, liftM)

...

instance Functor (State s) where
 fmap = liftM

instance Applicative (State s) where
  pure  = return
  (<*>) = ap

instance Monad (State s) where
 return :: a -> (State s a)
 return a = S (\n -> (a, n))
 (>>=) :: (State s a) -> (a -> State s b) -> (State s b)
 (>>=) (S f) g   = S (\n -> let (a, n') = f n in runState (g a) n')

Теперь ваши тесты работают почти так, как ожидалось, за исключением того, что indexNodesM помечает узлы слева направо: 

*Main> execState (indexNodesM exTree1) 0 == 6
True

*Main> evalState (indexNodesM exTree1) 0
Node (0,3) (Node (1,1) Leaf (Node (2,11) (Node (3,7) Leaf Leaf) (Node (4,5) Leaf Leaf))) (Node (5,13) Leaf Leaf)
...