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 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
    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.

  • \$\begingroup\$ Could you please describe in more detail what task you'd like to solve? This would help to understand the program and offer alternative solutions. \$\endgroup\$ – Petr Pudlák Feb 1 '14 at 14:34
  • \$\begingroup\$ My project involves automatically parallelizing searches through trees; to do this I need an efficient representation for non-deterministic computations as a Monad that I can interpret as a tree, as the branches in the tree give me workloads that I can send to other workers to explore in parallel. For more details, project page is here. \$\endgroup\$ – Gregory Crosswhite Feb 5 '14 at 23:45

A bit late, but perhaps it'll still help someone.

From the benchmark it's not clear if the time difference is caused by producing a tree or consuming it. I'm not very familiar with operational to make a guess.

It seems that what you're looking for is a free MonadPlus. The closest to this is probably FreeT f [] using FreeT, see also this question. I tried to benchmark it with your code with

exploreFreeTree :: FreeT Identity [] (Sum Int) -> Sum Int
exploreFreeTree = mconcat . iterT runIdentity

that flattens a tree into a list and then concatenates it, and it was almost as fast as plain [].

But there is another potential problem. For free monads the bind operation >>= needs to traverse the whole sequence of operations in the left argument, which can cause performance issues. It's similar to appending two lists. I don't know if operational has a similar problem or not. For free monads the solution is to use the Codensity monad, in particular it's enough to just wrap your computation with improve. For this it might be better to use Free [] instead of FreeT [] Identity (although I haven't checked the details), as Codensity works only on Free, not FreeT.

It might be relevant to read Is there a Codensity MonadPlus that asymptotically optimizes a sequence of MonadPlus operations?, although it's somewhat complicated stuff.

An good alternative could be to use logict. You could express your computations using MonadLogic and then run your computation in LogicT to do whatever processing you need to do. The advantage of this is that LogicT is internally build with continuations, which alleviates the problem with >>= performance of Free, and is built exactly to deal with branching computations. If you'd be interested, I could try to work out an example.

| improve this answer | |
  • \$\begingroup\$ I've moved on from that problem, but thank you for the information! :-) \$\endgroup\$ – Gregory Crosswhite Jul 24 '16 at 20:32

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.