Изменения монада состояние

Question

Для программирования упражнений, я должны взять дерево типа

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

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

let tree = Branch (Branch Leaf "B" Leaf) "A" Leaf 
in run (label tree) 42 

должен вычисляться

(Branch (Branch Leaf (42, "B") Leaf) (43, "A") Leaf 
, Counts {binds = 10,returns = 5, gets = 4, puts = 2}) 

Тип государства является:

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

Вот мои реализации label и run

label :: MonadState m Int => Tree a -> m (Tree (Int, a)) 
label Leaf      = return Leaf 
label (Branch left value right) = do 
            newLeft <- label left 
            int <- get 
            put (int + 1) 
            newRight <- label right 
            return (Branch newLeft (int, value) newRight) 


run :: State' s a -> s -> (a, Counts) 
run s ns = let (a, _, counts) = runState' s (ns, Counts 0 0 0 0) in (a, counts) 

Однако, когда я запускаю тестовый случай, мой результат

(Branch (Branch Leaf (42,"B") Leaf) (42,"A") Leaf 
, Counts {binds = 12, returns = 5, gets = 6, puts = 2}) 

Кажется Int не обновляется вообще. Это странно, потому что для каждой части задания есть отдельные тестовые примеры, и все, кроме этого, является правильным. В любом случае, вот реализация ввода и вывода:

-- get :: State' s s 
get = State' (\(s, counts) -> (s, s, counts <> oneGet)) 

-- put :: s -> State' s() 
put x = State' (\(x, counts) -> ((), x, counts <> onePut)) 

Я действительно в затруднении здесь. Я не знаю, почему Int s не затронуты вообще. Любая помощь приветствуется.

Answer 1

Проблема заключается в

put x = State' (\(x, counts) -> ((), x, counts <> onePut)) 

Здесь вы должны поставить x в состояние, но он получает слежку в (x, counts) узор. Сделать это

put x = State' (\(_, counts) -> ((), x, counts <> onePut)) 

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

подсчитывают количество монадических действий

Одним из законов является (return x >>= f) ~ f x, но прежнее выражение имеет дополнительные return и (>>=).

Answer 2

Я знаю, что это задание, но я хочу указать, что GHC может написать почти весь этот код для вас! Волшебные слова: deriving Traversable.

{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} 
data Tree a = Leaf 
      | Node (Tree a) a (Tree a) 
      deriving (Functor, Foldable, Traversable) 

Traversable класс абстрагирует понятие выполнения действия по каждому элементу структуры. traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) принимает функцию, которая выполняет эффект Applicative на элементах a и запускает его по всей структуре t, упорядочивая эффекты для создания t в контексте Applicative.

Так что все мы должны сделать, это сказать, как действовать на одном элементе,

inc :: a -> State Int (Int, a) 
inc x = do 
    counter <- get 
    put (counter + 1) 
    return (counter, x) 

и Traversable машины будут делать тяжелую работу запущенных в действие через все дерево.

label :: Tree a -> Tree (Int, a) 
label t = evalState (traverse inc t) 0 

Компоновка Node конструктор определяет порядок обхода; в этом случае traverse выполнит обход в порядке.