\$\begingroup\$

I am working on a code where I represent a MonadPlus using a Tree data structure and then explore it, summing over all of the leaves (whose type must be an instance of Monoid ); I need to use a Tree representation to do this (rather than using the List representation) because as I explore the tree I want to manually keep track of things like my position in the Tree for checkpointing and workload balancing purposes.

My problem is that using a Tree data structure is slower than using the List data structure by a factor of ~ 4 for small depths (~ 1-10) and ~ 2.5 for higher depths (~15), and I am having trouble understanding exactly why this is; in particular I am wondering if there are tricks that I can employ to make my code faster.

The remainder of this question will be some code that I wrote to benchmark Tree versus List. I will present my code in sections. First, the prelude:

{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} import Control.DeepSeq import Control.Monad import Control.Monad.Operational import Criterion.Main import Data.Functor.Identity import Data.Monoid

My Tree type is defined using functionality in the operational package by specifying the type of instructions and then use operational to obtain a Program monad from this.

data TreeTInstruction m α where Choice :: TreeT m α -> TreeT m α -> TreeTInstruction m α Null :: TreeTInstruction m α newtype TreeT m α = TreeT { unwrapTreeT :: ProgramT (TreeTInstruction m) m α } deriving (Monad) type Tree = TreeT Identity instance Monad m => MonadPlus (TreeT m) where mzero = TreeT . singleton $ Null left `mplus` right = TreeT . singleton $ Choice left right

The following two functions respectively build a perfect binary tree with Sum Int at all the leaves (which can be any type that is an instance MonadPlus ) and explore a given Tree .

makeTree :: MonadPlus m => Int -> m (Sum Int) makeTree 0 = return (Sum 1) makeTree d = makeTree (d-1) `mplus` makeTree (d-1) exploreTree :: Tree (Sum Int) -> Sum Int exploreTree v = case view (unwrapTreeT v) of Return x -> x Choice left right :>>= k -> let x = exploreTree $ left >>= TreeT . k y = exploreTree $ right >>= TreeT . k xy = mappend x y in xy

As a technicality we need to write an instance of NFData for Sum Int for the benchmarking code.

instance NFData (Sum Int) where rnf s@(Sum x) = x `seq` s `seq` ()

Finally, we have the benchmarking code. First, it benchmarks using makeTree to construct a tree using the List monad and then using mconcat to sum over all the results, and second, it benchmarks using makeTree using the Tree monad and sums over all the leaves using the exploreTree function.

main = defaultMain [bench "list" $ nf (mconcat . makeTree) depth ,bench "tree" $ nf (exploreTree . makeTree) depth ] where depth = 1 -- this is a knob that controls the tree size

For benchmarks, the list and tree times were as follows on my machine:

List Tree Tree/List 1: 140ns 460ns 3.3x 2: 330ns 1300ns 4.0x 4: 1600ns 6300ns 3.9x 8: 32us 130us 4.0x 10: 150us 600us 4.0x 12: 990us 2900us 2.9x 14: 4.6ms 12ms 2.6x 16: 24ms 55ms 2.3x 17: 50ms 110ms 2.2x

(17 is the largest depth because after that exploring the list causes a stack overflow.)

If anyone has advice on exactly what the cause is of this slow down and if anything can be done about it then I would greatly appreciate it.