{-# OPTIONS_GHC -O2 -fasm #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module BreadthFirstSearch where
import BinaryTree
import qualified Control.Monad.Queue.Allison as A
import qualified Control.Monad.Queue.Corec as C
import qualified Control.Monad.Queue.ST as STQ
import qualified CpSt
import qualified SideChannelQ as SCQ
import qualified Data.Queue.TwoStack as Two
import qualified Data.Queue.Okasaki as Oka
import Data.Sequence
import qualified Data.Sequence as Seq
isBranch = labelDisj (const False) (const True)
direct :: Tree a b -> [Tree a b]
direct tree = queue
where
queue | isBranch tree = tree : explore 1 queue
| otherwise = explore 0 queue
explore :: Int -> [Tree a b] -> [Tree a b]
explore 0 _ = []
explore (n+1) (Branch _ l r : head')
= if (isBranch l)
then if (isBranch r)
then l : r : explore ( n+2) head'
else l : explore ( n+1) head'
else if (isBranch r)
then r : explore ( n+1) head'
else explore n head'
allison tree = A.runQueue (handle tree >> explore)
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = A.enQ t
explore = do
branch <- A.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
allison2 tree = A.runQueue (handle tree >> explore)
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = A.enQ t
explore = do
(Branch _ !l !r) <- A.deQ_break
handle l
handle r
explore
stq tree = STQ.runResult (handle tree >> explore)
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = STQ.enQ t
explore = do
branch <- STQ.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
corec1 tree = case C.runResultQueue (handle tree >> explore) of
(_,q) -> q
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = C.enQ t
explore = do
branch <- C.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
corec2 tree = case C.runResultQueue (handle tree >> explore) of
((),q) -> q
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = C.enQ t
explore = do
branch <- C.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
sidechan1 tree
= case SCQ.runResultQueue (handle tree >> explore) of
(_,q) -> q
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = SCQ.enQ t
explore = do
branch <- SCQ.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
sidechan2 tree
= case SCQ.runResultQueue (handle tree >> explore) of
((),q) -> q
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = SCQ.enQ t
explore = do
branch <- SCQ.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
twostack t = loop (handle t Two.empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = Two.enque t q
loop q = case Two.deque q of
(Nothing, q') -> ()
(Just (Branch _ !l !r), q') -> loop (handle r (handle l q'))
twostack_cpst tree = CpSt.runResult (handle tree >> explore)
where
handle t@(Leaf _ ) = return ()
handle t@(Branch _ _ _ ) = CpSt.enQ t
explore = do
branch <- CpSt.deQ
case branch of
Nothing -> return ()
(Just (Branch _ !l !r)) -> handle l >> handle r >> explore
twostack_list t = loop (handle t Two.empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = Two.enque t q
loop q = case Two.deque q of
(Nothing, q') -> []
(Just t@(Branch _ !l !r), q') -> t : loop (handle r (handle l q'))
okasaki t = loop (handle t Oka.empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = Oka.enque t q
loop q = case Oka.deque q of
(Nothing, q') -> ()
(Just (Branch _ !l !r), q') -> loop (handle r (handle l q'))
okasaki_list t = loop (handle t Oka.empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = Oka.enque t q
loop q = case Oka.deque q of
(Nothing, q') -> []
(Just t@(Branch _ !l !r), q') -> t:loop (handle r (handle l q'))
sequence t = loop (handle t empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = q |> t
loop q = case viewl q of
EmptyL -> ()
(Branch _ !l !r) :< q' -> loop (handle r (handle l q'))
sequence_list t = loop (handle t empty)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _) q = q |> t
loop q = case viewl q of
EmptyL -> []
t@(Branch _ !l !r) :< q' -> t:loop (handle r (handle l q'))
sequence2 t = loop (Seq.singleton t)
where
handle t@(Leaf _ ) q = q
handle t@(Branch _ _ _ ) q = q |> t
loop q | Seq.null q = ()
| otherwise = case Seq.index q 0 of
x@(Branch _ l r) -> loop (handle r (handle l (Seq.drop 1 q)))