-->

Haskell label a binary tree through depth-first in

2020-08-01 07:39发布

问题:

I need to label a binary tree through depth-first in-order traversal and I figured therefore I'd need to first go through the left branches of the tree and label those, then do the same for the right branches. My binary tree only stores values at the internal nodes (not at end nodes / leaves):

label :: MonadState m Int => Tree a -> m (Tree (Int, a))
label (Branch l x r) = do n <- get
                          l' <- label l
                          r' <- label r
                          return (Branch l' (n, x) r')
label (Leaf) = return Leaf

*EDIT: Need to use the State Monad however I'm not really grasping the usage of it. My current code is shown above but is not working properly.

EDIT: The desired result e.g. for:

Branch (Branch Leaf (-2) Leaf) 1 Leaf

should be:

Branch (Branch Leaf (0,-2) Leaf) (1,1) Leaf

Also I'm not sure how I should use the State Monad for it, I'm still quite confused for its use:

instance Monad (State' s) where

    -- return :: a -> State' s a
    return x = State' (\(s,c) -> (x, s, (c <> oneReturn) ))

    -- (>>=) :: State' s a -> (a -> State' s b) -> State' s b
    st >>= k = State' $ \(s,c) -> let (a, s', c') = runState' st (s,c)
                                  in runState' (k a) (s',(c' <> oneBind) )

instance MonadState (State' s) s where

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

    -- put :: s -> State' s ()
    put s = State' $ \(_,c) -> ((),s, (c <> onePut))

回答1:

You don't need label_l, label_r functions. You don't need monads. (You can use this example for learning about the state monad, but you don't have to.)

Just use (the standard trick of) enriching the specification from

Tree a -> Tree (Int, a)

to

f :: Int -> Tree a -> ( Tree (Int, a), Int )

the function gets the start label (first argument) and returns the labelled tree and the next label to use (in the second component of the result).

E.g.,

f 8 (Branch (Branch Leaf (-2) Leaf) 1 Leaf)
   == ( Branch (Branch Leaf (8,-2) Leaf) (9,1) Leaf), 10 )

This can be implemented easily, without any advanced concepts.

f s0 t = case t of
     Branch l k r -> let (l', s1) = f s0 l
                         (r', s2) = f s1 r
                     in  ...

With the state monad, your program would do exactly the same thing (the "next label" is the state), but the notation is different, which may or may not be beneficial (for learning/understanding).



回答2:

I'm afraid that your problem is easier to solve than the answers so far have suggested, if only you see how to take advantage of the structure you identify when you make your type definitions. Here's how it goes.

{-# LANGUAGE DeriveTraversable, FlexibleContexts #-}

module LBT where

import Control.Monad.State

data Tree x
  = Leaf
  | Branch (Tree x) x (Tree x)
  deriving (Functor, Foldable, Traversable)

That much makes the traverse operation work left-to-right, i.e. in order, as you require.

Now explain what to do with a single element.

next :: MonadState Int m => m Int
next = do x <- get ; modify (+ 1) ; return x

labelElt :: MonadState Int m => x -> m (Int, x)
labelElt x = (,) <$> next <*> pure x

The next operation gives you the next value and updates the counter. The labelElt operation then decorates a single value with its counter. And now

label :: MonadState Int m => Tree x -> m (Tree (Int, x))
label = traverse labelElt

you get the program you already paid for when you defined your type. When you know what to do with one element, you can manage a whole structure. For free. No ad hoc recursion is needed here! The structure of your type delivers the structure of your program. Haskell will do that for you if only you let it.



回答3:

One way to structure your function with the State monad is:

label :: MonadState m Int => Tree a -> m (Tree (Int, a))
label t = do
    -- Fetch the next label number from the state monad with "get".
    -- Increase the label number by one and store it back in the state with "put".
    -- Pattern match on "t" and call "label" recursively.

I'm assuming you're already familiar with do-syntax? Try to write the above function and then update the question with your new code if you need more hints.