Skip to content

Instantly share code, notes, and snippets.

@hyone
Last active December 20, 2015 12:09
Show Gist options
  • Save hyone/6128565 to your computer and use it in GitHub Desktop.
Save hyone/6128565 to your computer and use it in GitHub Desktop.
Number of binary trees have N leaves with logging by Writer Monad #2 ( see: http://hyone.hatenablog.com/entry/20120803/1343996582 )
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.List
import Control.Monad.Trans (lift)
import Control.Monad.Writer
splites :: Int -> [(Int, Int)]
splites n = [ (x, n - x) | x <- [1..n-1] ]
liftList :: Monad m => [a] -> ListT m a
liftList = ListT . return
countW :: MonadWriter [String] m => Int -> m Int
countW 1 = return 1
countW n = liftM sum . runListT $ do
(i, j) <- liftList $ splites n
cnt <- lift $ liftM2 (*) (countW i) (countW j)
lift $ tell ["(" ++ show i ++ ", " ++ show j ++ ") = " ++ show cnt]
return cnt
-- ghci> runWriter $ countW 4
-- (5,["(1, 1) = 1","(1, 2) = 1","(1, 1) = 1","(2, 1) = 1","(1, 3) = 2","(1, 1) = 1","(1, 1) = 1","(2, 2) = 1","(1, 1) = 1","(1, 2) = 1","(1, 1) = 1","(2, 1) = 1","(3, 1) = 2"])
-- ghci> mapM_ putStrLn . execWriter $ countW 4
-- (1, 1) = 1
-- (1, 2) = 1
-- (1, 1) = 1
-- (2, 1) = 1
-- (1, 3) = 2
-- (1, 1) = 1
-- (1, 1) = 1
-- (2, 2) = 1
-- (1, 1) = 1
-- (1, 2) = 1
-- (1, 1) = 1
-- (2, 1) = 1
-- (3, 1) = 2
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment