CODEWITHSUNDEEP
haskelltreestatemonads
mr.mindspace
mr.mindspace

Reputation: 109

Modifying monad state

For a programming exercise, I am supposed to take a Tree of data type

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

and label each a with an Int, increasingly, depth-first in-order, using a state monad, and count the number of monadic actions. For example, the expression

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

should evaluate to

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

The type of the state is:

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

Here are my implementations of label and 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)

However, when I run the test case, my result is

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

It seems the Int isn't being updated at all. This is strange because there are seperate test cases for each part of the assignment, and everything except this is correct. In any case, here are the get and put implementations:

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

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

I am really at a loss here. I have no idea why the Ints are not affected at all. Any help is greatly appreciated.

Upvotes: 3

Views: 472

Answers (2)

Benjamin Hodgson
Benjamin Hodgson

Reputation: 44603

I know it's an assignment, but I want to point out that GHC can write almost all of this code for you! The magic words are deriving Traversable.

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

The Traversable class abstracts the notion of performing an action on each element of a structure. traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) takes a function which performs an Applicative effect on elements a and runs it over the whole structure t, sequencing the effects to produce a t in an Applicative context.

So all we have to do is say how to act on a single element,

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

and the Traversable machinery will do the heavy lifting of running the action across the whole tree.

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

The layout of the Node constructor determines the traversal order; in this case traverse will perform an in-order traversal.

Upvotes: 2

effectfully
effectfully

Reputation: 12715

The problem is in

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

Here you're supposed to put x into a state, but it gets shadowed in the (x, counts) pattern. Make it

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

and you should be fine as long as you don't care about monad laws, because your task forces you to violate them:

count the number of monadic actions

One of the laws is (return x >>= f) ~ f x, but the former expression has additional return and (>>=) in it.

Upvotes: 3

Related Questions