User Tools

Site Tools


Action disabled: source
monads

Thinking about Monads

The simplest algorithm motivating monads:

import Control.Monad.State
import Control.Applicative
 
-- a simple datatype for a binary tree with values at the nodes
data Tree = Empty | Node Int Tree Tree
 
-- a "nice" way to print such trees
instance Show Tree where
  show Empty = "-"
  show (Node n Empty Empty) = show n
  show (Node n a b) = "(" ++ show a ++ " / " ++ show n ++ " \\ " ++ show b ++ ")"
 
-- convenience constructor for leaf nodes
leaf :: Int -> Tree
leaf n = Node n Empty Empty
 
-- a value to test with
example :: Tree
example =
  Node 4
    ( Node 7
      ( leaf 10 )
      ( leaf  5 )
    )
    ( Node 42
      ( Node 0
        ( leaf  3 )
        ( leaf 12 )
      )
      ( leaf 8 )
    )
 
-- main program to test implementations
main :: IO ()
main = do
  print example
  print $ mark 1 example               -- Version 1
  print $ snd $ markE 1 example        -- Version 2
  print $ evalState (markM example) 1  -- Version 3
  print $ evalState (markN example) 1  -- Version 4
 
-- The specification for the mark functions is very simple:
--   "Relabel all nodes with different, but consecutive, marks."
 
 
---------------
-- Version 1 --
---------------
 
-- the usual size function for such trees
size :: Tree -> Int
size Empty = 0
size (Node _ a b) = 1 + size a + size b
 
-- inefficient functional version of a marking algorithm using size
mark :: Int -> Tree -> Tree
mark _ Empty = Empty
mark n (Node _ a b) = Node n (mark (n + 1) a) (mark (n + size a + 1) b)
 
 
---------------
-- Version 2 --
---------------
 
-- efficient functional version with explicit state
markE :: Int -> Tree -> (Int, Tree)
markE n Empty = (n, Empty)
markE n (Node _ a b) =
  let (n' , a') = markE n  a
      (n'', b') = markE n' b
  in  (n'' + 1, Node n'' a' b')
 
 
---------------
-- Version 3 --
---------------
 
-- efficient monadic version with implicit state
markM :: Tree -> State Int Tree
markM Empty = return Empty
markM (Node _ a b) = do
  a' <- markM a
  n <- get
  put $ n + 1
  b' <- markM b
  return $ Node n a' b'
 
 
---------------
-- Version 4 --
---------------
 
-- convenient next operator for integer states
next :: State Int Int
next = do
  n <- get
  put $ n + 1
  return n
 
-- "nerdy" monadic variant avoiding a lengthy do-notation
markN :: Tree -> State Int Tree
markN Empty = return Empty
markN (Node _ a b) = Node <$> next <*> markN a <*> markN b

Output:

((10 / 7 \ 5) / 4 \ ((3 / 0 \ 12) / 42 \ 8))
((3 / 2 \ 4) / 1 \ ((7 / 6 \ 8) / 5 \ 9))
((1 / 3 \ 2) / 9 \ ((4 / 6 \ 5) / 8 \ 7))
((1 / 2 \ 3) / 4 \ ((5 / 6 \ 7) / 8 \ 9))
((3 / 2 \ 4) / 1 \ ((7 / 6 \ 8) / 5 \ 9))
monads.txt · Last modified: 09-08-2013 22:46 by paddy