{-
Copyright 2010 Leon P Smith
This file is provided under the Creative Commons Attribution Only license
This file demonstrates how to combine continuations with Jones and Gibbon's
breadth-first labelling algorithm. This file is described at the following
locations:
http://blog.melding-monads.com/2009/12/30/fun-with-the-lazy-state-monad
http://blog.melding-monads.com/2010/08/25/fun-with-the-lazy-state-monad-part-2
-}
{-# LANGUAGE PackageImports #-}
import "mtl" Control.Monad.State
import "mtl" Control.Monad.Cont
import Data.Ratio(Ratio, (%), numerator, denominator)
data Tree a b
= Leaf a
| Branch b (Tree a b) (Tree a b)
deriving (Eq,Show)
fib n = fibs !! (n - 1)
where
fibs = Leaf 0 : Leaf 0 : zipWith3 Branch [1..] fibs (tail fibs)
sternBrocot :: Tree a (Ratio Integer)
sternBrocot = loop 0 1 1 0
where
loop a b x y
= Branch (m%n) (loop a b m n) (loop m n x y)
where
m = a + x
n = b + y
lower :: Monad m => ContT a m a -> m a
lower m = runContT m return
type FreshCC r n = ContT r (State [n])
fresh :: Num n => FreshCC r n n
fresh = lift $ do
(n:ns) <- get
put (n+1 : ns)
return n
down :: FreshCC a n a -> FreshCC r n a
down m = lift $ do
(n:ns) <- get
put ns
a <- lower m
ns' <- get
put (n:ns')
return a
runFreshCC :: n -> FreshCC a n a -> a
runFreshCC n m = a
where (a, ns) = runState (lower m) (n:ns)
renum :: Num n => Tree a b -> Tree n n
renum = runFreshCC 0 . loop
where
loop (Leaf _) = do
n <- fresh
return (Leaf n)
loop (Branch _ a b) = do
n <- fresh
a' <- down (loop a)
b' <- down (loop b)
return (Branch n a' b')