Haskell - depth for each node in a binary tree using monad Reader

Question

I wrote the following code. It works and uses the monad Reader .

Could you give me some tips on code style in Haskell? Basically, I mean monads - I'm a beginner.

 import Control.Monad.Reader data Tree a = Node a (Tree a) (Tree a) | Empty renumberM :: Tree a -> Reader Int (Tree Int) renumberM (Node _ lr) = ask >>= (\x -> return (Node x (runReader (local (+1) (renumberM l)) x) (runReader (local (+1) (renumberM r)) x))) renumberM Empty = return Empty renumber'' :: Tree a -> Tree Int renumber'' t = runReader (renumberM t) 0 

Answer 1

I want to show you that your idea is an example of a more general concept - zipping. Here is the version of your program that uses a simpler and more functional style.

Applicative functors

Here's the Applicative definition:

 class Functor f => Applicative f where pure :: a -> fa (<*>) :: f (a -> b) -> fa -> fb 

We can say that type fx is a structure f containing some values ​​of x . The function <*> takes a structure of functions ( f (a -> b) ) and applies it to the structure of arguments ( fa ) to create a structure of results ( fb ).

Zippy Applications

One way to make Tree applicative functor is to make <*> intersect two trees into a lock, compressing them together in the same way as zip with lists. Each time you come across Node in the function tree and Node in the argument tree, you can pull out this function and apply it to the argument. You must stop moving when you reach the bottom of any of the trees.

 instance Applicative Tree where pure x = let t = Node xtt in t Empty <*> _ = Empty _ <*> Empty = Empty (Node f lf rf) <*> (Node x lx rx) = Node (fx) (lf <*> lx) (rf <*> rx) instance Functor Tree where fmap fx = pure f <*> x -- as usual 

pure x generates an infinite tree x s. This works great because Haskell is a lazy language.

  +-----x-----+ | | +--x--+ +--x--+ | | | | +-x-+ +-x-+ +-x-+ +-x-+ | | | | | | | | etc 

Thus, the shape of the tree t <*> pure x coincides with the shape of t : you stop only when you encounter Empty , but in pure x not. (The same goes for pure x <*> t .)

This is the usual way to make the data structure an Applicative instance. For example, the standard library includes a ZipList , Applicative instance is very similar to our tree:

 newtype ZipList a = ZipList { getZipList :: [a] } instance Applicative ZipList where pure x = ZipList (repeat x) ZipList fs <*> ZipList xs = ZipList (zipWith ($) fs xs) 

Again pure generates an infinite ZipList , and <*> consumes its arguments in the blocking step.

The prototype zippy Applicator, if you will, is the Applicative (->) r reader, which combines functions by applying them all to a fixed argument and collecting the results. Thus, all Representable functors allow (at least) an instance of zippy Applicative .

Using some Applicative machines , we can generalize the Prelude zip to any application functor (although it will behave exactly like zip when Applicative is zippy in nature, for example, with a regular Applicative instance for [] zipA will give you the Cartesian product of its arguments) .

 zipA :: Applicative f => fa -> fb -> f (a, b) zipA = liftA2 (,) 

Marking as Zipping

The plan is to pin an input tree along with an infinite tree containing the depth of each level. The result will be a tree with the same shape as the input tree (since the depth tree is infinite), but each node will be marked with its depth.

 depths :: Tree Integer depths = go 0 where go n = let t = go (n+1) in Node ntt 

Here's what depths looks depths :

  +-----0-----+ | | +--1--+ +--1--+ | | | | +-2-+ +-2-+ +-2-+ +-2-+ | | | | | | | | etc 

Now that we have created the desired structures, labeling the tree is easy.

 labelDepths :: Tree a -> Tree (Integer, a) labelDepths = zipA depths 

Altering the tree by discarding the original labels, as you originally pointed out, is also easy .

 relabelDepths :: Tree a -> Tree Integer relabelDepths t = t *> depths 

Quick test:

 ghci> let myT = Node 'x' (Node 'y' (Node 'z' Empty Empty) (Node 'a' Empty Empty)) (Node 'b' Empty Empty) ghci> labelDepths myT Node (0,'x') (Node (1,'y') (Node (2,'z') Empty Empty) (Node (2,'a') Empty Empty)) (Node (1,'b') Empty Empty) +--'x'-+ +--(0,'x')-+ | | labelDepths | | +-'y'-+ 'b' ~~> +-(1,'y')-+ (1,'b') | | | | 'z' 'a' (2,'z') (2,'a') 

You can develop different marking patterns by changing the tree that you fasten. Here is one that tells you the path you took to reach node:

 data Step = L | R type Path = [Step] paths :: Tree Path paths = go [] where go path = Node path (go (path ++ [L])) (go (path ++ [R])) +--------[ ]--------+ | | +---[L]---+ +---[R]---+ | | | | +-[L,L]-+ +-[L,R]-+ +-[R,L]-+ +-[R,R]-+ | | | | | | | | etc 

(The inefficient nesting of calls in ++ above can be reduced by using lists of differences .)

 labelPath :: Tree a -> Tree (Path, a) labelPath = zipA paths 

---

As you continue to study Haskell, you will better understand when the program will become an example of a deeper concept. Setting up common structures, as I did with the Applicative instance above, quickly pays dividends when reusing code.

Answer 2

There is no need to enter and exit Reader , as you do, using runReader ; instead, you can rewrite it as

 renumberR :: Tree a -> Reader Int (Tree Int) renumberR (Node _ lr) = do x <- ask l' <- local (+1) (renumberR l) r' <- local (+1) (renumberR r) return (Node xl' r') renumberR Empty = return Empty 

However, you can write it even better simply by using the Reader application interface:

 renumberR (Node _ lr) = Node <$> ask <*> local (+1) (renumberR l) <*> local (+1) (renumberR r) renumberR Empty = pure Empty 

Note that I renamed your function to renumberR to emphasize the fact that it works in Reader , but does not necessarily use its monadic interface.