Search code examples
haskellrecursionbinary-treerecursion-schemes

Is it possible to create efficient recombining trees using (co)recursion?


By co-recursion I mean unfolding a tree, such as with anamorphism from Ed Kmett's recursion-schemes

By re-combining trees I mean graphs that share structure. For example, a binomial option pricing tree, or Pascal's triangle. Both of these have some symmetry, so for efficiency, we would like to avoid re-calculating part of the tree, instead re-using the already-calculated branches.

n.b. this question is not about some clever way to calculate the values in aforementioned examples; it's a general question about recursion.

For example, for options pricing, the tree can be generated like so:

data Tree x = Leaf x | Branch x (Tree x) (Tree x)
ana \(x, depth) ->
  if depth == maxDepth
    then LeafF x
    else BranchF x (p * x, depth + 1) ( (1.0 - p) * x, depth + 1)     -- p < 1.0

So the value in an 'up' branch is p * x and the value in a 'down' branch is (1-p) * x. Because of this symmetry, an 'up' followed by a 'down' node will have the same value as a 'down' followed by an 'up' branch. As will it's entire sub-tree.

I think it may be possible to do this passing along State that contains a hashmap of already calculated nodes somehow.

Or if I could somehow access the already-calculated subtree, I could pass it in as a Left in an apomorphism.

Is there some existing morphism that allows this? Or can I code my own?


Solution

  • ana defines a recursive function x -> Tree a (given a coalgebra alg :: x -> TreeF a x). You can define a memoized version of ana by using a specialized fixpoint operator (whereas the usual definition is more or less equivalent to using fix), for example, as found in the MemoTrie library.

    memoFix :: (...) => ((a -> b) -> (a -> b)) -> (a -> b)
    -- for some constraints "(...)" depending on the implementation.
    
    -- ana': Memoized version of ana
    
    type Memo a b = ((a -> b) -> (a -> b)) -> a -> b
    
    memoAna :: Memo x (Tree a) -> (x -> TreeF a x) -> x -> Tree a
    memoAna memo alg = memo $ \ana_ x ->
      case alg x of
        LeafF a -> Leaf a
        BranchF a x1 x2 -> Branch a (ana_ x1) (ana_ x2)
    
    ana' :: HasTrie x => (x -> TreeF a x) -> x -> Tree a
    ana' = memoAna memoFix
    

    This ensures all trees generated from the same seed x will in fact be the same tree.

    You also have to be a little careful with the type of seed. In your example, with (Double, Int), the imprecision of Double operations makes memoization unreliable. So you also need to modify the algebra. For example, since the price is always of the form p^i (1-p)^(depth-i), you could remember the index i instead.

    optionsAlg' :: Num a => a -> (Int, Int) -> TreeF a (Int, Int)
    optionsAlg' p (ups, depth) =
      if depth >= maxDepth then
        LeafF price
      else
        BranchF price (ups+1, depth+1) (ups, depth+1)
      where
        price = p ^ ups * (1 - p) ^ (depth - ups)
    

    Implementations of memoization have various trade offs. Depending on your particular use case, further optimizations and more adaptation may be necessary.