Блог

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

 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 и put:

 -- 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 это вообще не влияет. Любая помощь приветствуется.

Проблема в

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

Здесь вы должны ввести x в состояние, но оно затеняется в (x, counts) шаблоне. Сделайте это

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

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

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

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

Я знаю, что это задание, но я хочу отметить, что 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 будет выполняться обход по порядку.