Recursion schemes, Stockholm Haskell User Group, 2014-11-27

recursion-schemes.ipynb

{
 "metadata": {
  "language": "haskell",
  "name": "",
  "signature": "sha256:aef28447c9aa4685d609004ade81aaa922bf3e4961ef0fb3f6516d15405929e5"
 },
 "nbformat": 3,
 "nbformat_minor": 0,
 "worksheets": [
  {
   "cells": [
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# Recursion schemes\n",
      "\n",
      "**Johan Lies\u00e9n**\n",
      "\n",
      "[email protected]\n",
      "\n",
      "Stockholm Haskell User Group, 2014-11-27."
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      ":extension DeriveFoldable\n",
      ":extension DeriveFunctor\n",
      ":extension DeriveTraversable\n",
      "\n",
      "import Control.Applicative hiding (Const)\n",
      "import Control.Monad\n",
      "import Data.Bool\n",
      "import Data.Foldable hiding (foldr)\n",
      "import Data.Maybe\n",
      "import Data.Traversable"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 46
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# Example: a simple expression language"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "data Expr\n",
      "  = Var String\n",
      "  | Const Int\n",
      "  | Add Expr Expr\n",
      "  | Mul Expr Expr\n",
      "  | IfNeg Expr Expr Expr\n",
      "  deriving (Eq, Show)"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 5
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Recursive function to evaluate an expression with a global environment"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "This is what we would like to write using a recursion scheme, an evaluator for `Expr`:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "type Env = [(String, Int)]"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 6
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "eval :: Env -> Expr -> Maybe Int\n",
      "eval env (Var s)       = lookup s env\n",
      "eval env (Const x)     = pure x\n",
      "eval env (Add x y)     = (+) <$> eval env x <*> eval env y\n",
      "eval env (Mul x y)     = (*) <$> eval env x <*> eval env y\n",
      "eval env (IfNeg t x y) = \n",
      "    eval env t >>= bool (eval env x) (eval env y) . not . (< 0)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 7
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "-- (if a < 0 then 0 else a) * b\n",
      "expr1 = Mul (IfNeg (Var \"a\") (Const 0) (Var \"a\")) (Var \"b\")"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 8
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "eval [(\"a\", 5), (\"b\", 10)] expr1"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "Just 50"
       ]
      }
     ],
     "prompt_number": 9
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "The recursion is **explicit** and not data-type generic: it can not be applied to any other data-type but `Expr`.\n",
      "\n",
      "**Recursion schemes** is all about data-type generic programming, and extracting the explicit recursion into a combinator that can be applied to any (recursive) data type."
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# Unfixed representation of `Expr`\n",
      "\n",
      "First we parameterize our type, `Expr`, in terms of its subexpressions:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "data ExprF r =\n",
      "    Var String\n",
      "  | Const Int\n",
      "  | Add r r\n",
      "  | Mul r r\n",
      "  | IfNeg r r r\n",
      "  deriving (Eq, Foldable, Functor, Show, Traversable)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 10
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "`ExprF` is just the shape of `Expr`, and is no longer recursive. \n",
      "\n",
      "`ExprF` can't express arbitrary nested expressions (which `Expr` can/could!):\n",
      "\n",
      "* `ExprF Int` is an expression with no subexpressions\n",
      "* `ExprF (ExprF Int)` can contain on level of subexpressions\n",
      "* `ExprF (ExprF (ExprF Int)))` can contain two levels of subexpressions\n",
      "* ...\n",
      "\n",
      "We want `ExprF (ExprF (ExprF (...`."
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# Fixpoints of functors\n",
      "\n",
      "We define a type-level Y-combinator to capture the recursion:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "newtype Fix f = Fix { unFix :: f (Fix f) }"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 11
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "type Expr = Fix ExprF"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 12
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "`Fix ExprF` is isomorphic to (our previous) `Expr`."
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      ":extension FlexibleContexts\n",
      ":extension StandaloneDeriving\n",
      ":extension UndecidableInstances\n",
      "\n",
      "deriving instance Show (f (Fix f)) => Show (Fix f)\n",
      "deriving instance Eq (f (Fix f)) => Eq (Fix f)\n",
      "deriving instance Ord (f (Fix f)) => Ord (Fix f)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 13
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# `cata`, a general `foldr`\n",
      "\n",
      "Our `eval` function is a right fold (or bottom-up traversal), our beloved `foldr`. And it turns out, using data-type generic programming and ideas from category theory, we can define a combinator that captures the computation performed by a right fold. This is a `cata`-morphism:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "cata :: Functor f => (f a -> a) -> Fix f -> a\n",
      "cata alg = alg . fmap (cata alg) . unFix"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 14
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "`alg` is an F-algebra: `f a -> a` for any functor `f`.\n",
      "\n",
      "It's useful to think about the types involved in `cata`:\n",
      "\n",
      "1. `unFix` removes the outer `Fix`, so we have `f (Fix f)` where `f` is a functor\n",
      "2. `fmap (cata alg)` captures the recursion and applies our catamorphism to the value with the result being `f a`\n",
      "3. finally, `alg` is applied to the value leaving us with an `a`"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## `eval` using `cata`\n",
      "\n",
      "The explicit recursive calls are now gone!"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "eval :: Env -> Expr -> Maybe Int\n",
      "eval env = cata (evalAlg env)\n",
      "\n",
      "evalAlg :: Env -> ExprF (Maybe Int) -> Maybe Int\n",
      "evalAlg env = alg\n",
      "  where\n",
      "    alg :: ExprF (Maybe Int) -> Maybe Int\n",
      "    alg (Var s)       = lookup s env\n",
      "    alg (Const n)     = pure n\n",
      "    alg (Add x y)     = (+) <$> x <*> y\n",
      "    alg (Mul x y)     = (*) <$> x <*> y\n",
      "    alg (IfNeg t x y) = t >>= bool x y . not . (< 0)"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 15
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "var = Fix . Var\n",
      "konst = Fix . Const\n",
      "mul x y = Fix (Mul x y)\n",
      "add x y = Fix (Add x y)\n",
      "ifNeg t x y = Fix (IfNeg t x y)\n",
      "\n",
      "expr2 = mul (ifNeg (var \"a\") (konst 0) (var \"a\")) (var \"b\")"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 16
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "The expression unfortunately needs `Fix` for all constructors which looks a bit ugly, but smart constructors help to remove the cruft."
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "eval [(\"a\", 5), (\"b\", 10)] expr2"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "Just 50"
       ]
      }
     ],
     "prompt_number": 17
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Find all free variables"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "import qualified Data.Set as Set\n",
      "import Data.Set (Set)\n",
      "\n",
      "freeVars :: Expr -> Set String\n",
      "freeVars = cata alg\n",
      "  where\n",
      "    alg :: ExprF (Set String) -> Set String\n",
      "    alg (Var s) = Set.singleton s\n",
      "    alg e       = fold e"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 18
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "freeVars expr2"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "fromList [\"a\",\"b\"]"
       ]
      }
     ],
     "prompt_number": 19
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Find the depth of an expression"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "depth :: Expr -> Int\n",
      "depth = cata alg\n",
      "  where\n",
      "    alg :: ExprF Int -> Int\n",
      "    alg (Const n)     = 1\n",
      "    alg (Var s)       = 1\n",
      "    alg (Add x y)     = 1 + max x y\n",
      "    alg (Mul x y)     = 1 + max x y\n",
      "    alg (IfNeg t x y) = 1 + Data.Foldable.maximum [t, x, y]"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 20
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "depth expr2"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "3"
       ]
      }
     ],
     "prompt_number": 21
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Count the number of nodes in an expression"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "count :: Expr -> Int\n",
      "count = cata alg\n",
      "  where\n",
      "    alg (Const n)     = 1\n",
      "    alg (Var s)       = 1\n",
      "    alg (Add x y)     = 1 + x + y\n",
      "    alg (Mul x y)     = 1 + x + y\n",
      "    alg (IfNeg t x y) = 1 + t + x + y"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 22
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "count expr2"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "6"
       ]
      }
     ],
     "prompt_number": 23
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## A general `unfoldr`"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "A general `unfoldr` (a combinator that *builds up* a structure) is called an `ana`-morphism:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "ana :: Functor f => (a -> f a) -> a -> Fix f\n",
      "ana coalg = Fix . fmap (ana coalg) . coalg"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 24
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "It's a more general `unfoldr`:\n",
      "\n",
      "    :t Data.List.unfoldr :: (b -> Maybe (a, b)) -> b -> [a]"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "### Unfold a list of ints\n",
      "\n",
      "Use a list as an intermediate structure to generate a sequence of numbers:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "data ListF a r = Nil | Cons a r deriving (Functor)"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 25
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "intsFrom :: Int -> Fix (ListF Int)\n",
      "intsFrom = ana (\\n -> Cons n (n + 1))  -- [1..n] is an anamorphism!\n",
      "\n",
      ":extension ViewPatterns\n",
      "\n",
      "takeS :: Int -> Fix (ListF a) -> [a]\n",
      "takeS 0 _                   = []\n",
      "takeS n (unFix -> Cons x xs) = x : takeS (n - 1) xs"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 26
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "takeS 5 $ intsFrom 5"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "[5,6,7,8,9]"
       ]
      }
     ],
     "prompt_number": 27
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Folding and unfolding with hylomorphisms\n",
      "\n",
      "Hylomorphism (a \"refold\") is the composition of a catamorphism and an anamorphism:\n",
      "\n",
      "```\n",
      "hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b\n",
      "hylo f g = cata g . ana f\n",
      "```\n",
      "\n",
      "The `cata` and `ana` can be fused:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b\n",
      "hylo f g = f . fmap (hylo f g) . g"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 28
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "`cata` and `ana` written in terms of `hylo`.\n",
      "\n",
      "```\n",
      "cata f = hylo f unFix\n",
      "ana g = hylo Fix g\n",
      "```"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# Conclusion\n",
      "\n",
      "* Recursion schemes is an instance of data-type generic programming; a programming pattern\n",
      "\n",
      "* Combinators that traverses and through nested data structures\n",
      "\n",
      "* Useful if you have a large data structure, for example a representation of a computer program in a compiler, and do many small operations on that structure\n",
      "\n",
      "* Code reuse\n",
      "\n",
      "* Better reasoning about our programs since the recursion schemes can be reasoned about in isolation\n",
      "\n",
      "* Exploit parallelism"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Resources\n",
      "\n",
      "* Bananas, Lenses, Envelopes and Barbed Wire by Meijer, Fokkinga and Paterson\n",
      "\n",
      "  * Paper: http://eprints.eemcs.utwente.nl/7281/01/db-utwente-40501F46.pdf\n",
      "\n",
      "  * Translation guide to Haskell: http://blog.ezyang.com/2010/05/bananas-lenses-envelopes-and-barbed-wire-a-translation-guide/\n",
      "\n",
      "\n",
      "\n",
      "* Tim Williams talk on recursion schemes\n",
      "\n",
      "  * Code and slides: https://github.com/willtim/recursion-schemes\n",
      "  * Video: https://www.youtube.com/watch?v=Zw9KeP3OzpU\n",
      "  \n",
      "\n",
      "* Recursion Schemes: A Field Guide (Redux): http://comonad.com/reader/2009/recursion-schemes/\n",
      "\n",
      "\n",
      "* Blog posts\n",
      "\n",
      "  * Grokking recursion-scheme: Part 1: http://jozefg.bitbucket.org/posts/2014-05-19-like-recursion-but-cooler.html\n",
      "  * An Introduction to Recursion Schemes and Codata: http://patrickthomson.ghost.io/an-introduction-to-recursion-schemes/\n",
      "\n",
      "\n",
      "* `recursion-schemes` on Hackage: https://hackage.haskell.org/package/recursion-schemes"
     ]
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "# More examples\n",
      "\n",
      "## Merge sort using a hylomorphism\n",
      "\n",
      "Using a tree as an intermediate structure we can program merge sort using a hylomorphism:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "import Data.List (unfoldr)\n",
      "\n",
      "data TreeF a r = Leaf a | Node r r deriving (Functor)\n",
      "\n",
      "merge :: Ord a => TreeF a [a] -> [a]\n",
      "merge (Leaf x)     = [x]\n",
      "merge (Node xs ys) = mergeLists xs ys\n",
      "  where\n",
      "    mergeLists :: Ord a => [a] -> [a] -> [a]\n",
      "    mergeLists = curry (unfoldr f)\n",
      "    f ([],   [])   = Nothing\n",
      "    f (x:xs, [])   = Just (x, (xs, []))\n",
      "    f ([],   y:ys) = Just (y, ([], ys))\n",
      "    f (x:xs, y:ys)\n",
      "      | x <= y    = Just (x, (xs, y:ys))\n",
      "      | otherwise = Just (y, (x:xs, ys))"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 29
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "split [x] = Leaf x\n",
      "split xs  = uncurry Node $ splitAt (length xs `div` 2) xs"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 30
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "mergesort :: Ord a => [a] -> [a]\n",
      "mergesort = hylo merge split"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 31
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "mergesort [1, 6, 2, 5, 3, 4]"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "[1,2,3,4,5,6]"
       ]
      }
     ],
     "prompt_number": 32
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Factorial using a hylomorphism\n",
      "\n",
      "We specialize `cata` and `ana` to be list-morphisms (as in *Functional Programming with Bananas, Lenses, Envelopes and Barbed Wire*)"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "listCata :: (a -> b -> b) -> b -> ListF a b -> b\n",
      "listCata f z Nil        = z\n",
      "listCata f z (Cons x y) = f x y"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 33
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "listAna :: (b -> Bool) -> (b -> (a, b)) -> b -> ListF a b\n",
      "listAna p g b\n",
      "    | p b       = Nil\n",
      "    | otherwise = Cons a b' where (a, b') = g b"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 34
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "p = listCata (*) 1\n",
      "g = listAna (== 0) (\\n -> (n, n - 1))\n",
      "\n",
      "fac = hylo p g"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 35
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "fac 5"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "120"
       ]
      }
     ],
     "prompt_number": 36
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "Same thing but using `Data.List.unfoldr`:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "import Data.List (unfoldr)\n",
      "\n",
      "fac' :: (Eq a, Num a) => a -> a\n",
      "fac' = foldr (*) 1 . unfoldr (\\n -> if n == 0 then Nothing else Just (n, n - 1))\n",
      "\n",
      "fac' 5"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [
      {
       "html": [
        " <div class=\"suggestion-name\" style=\"clear:both;\">Use product</div>  <div class=\"suggestion-row\" style=\"float: left;\"> <div class=\"suggestion-error\">Found:</div>  <div class=\"highlight-code\" id=\"haskell\">foldr (*) 1</div> </div>  <div class=\"suggestion-row\" style=\"float: left;\"> <div class=\"suggestion-error\">Why Not:</div>  <div class=\"highlight-code\" id=\"haskell\">product</div> </div> "
       ],
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "Line 2: Use product\n",
        "Found:\n",
        "foldr (*) 1\n",
        "Why not:\n",
        "product"
       ]
      },
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "120"
       ]
      }
     ],
     "prompt_number": 44
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## Monadic `cata`, `cataM`"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "cataM :: (Monad m, Traversable f) => (f a -> m a) -> Fix f -> m a\n",
      "cataM algM = algM <=< (Data.Traversable.mapM (cataM algM) . unFix)"
     ],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 38
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "Monadic evaluation function:"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "import Control.Monad.Reader\n",
      "\n",
      "evalM :: Env -> Expr -> Maybe Int\n",
      "evalM env = (`runReaderT` env) . cataM algM\n",
      "  where\n",
      "    algM :: ExprF Int -> ReaderT Env Maybe Int\n",
      "    algM (Const n)     = return n\n",
      "    algM (Var s)       = ask >>= lift . lookup s\n",
      "    algM (Add x y)     = return $ x + y\n",
      "    algM (Mul x y)     = return $ x * y\n",
      "    algM (IfNeg t x y) = return $ bool x y (t >= 0)"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [],
     "prompt_number": 39
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [
      "evalM [(\"a\", 5), (\"b\", 10)] expr2"
     ],
     "language": "python",
     "metadata": {
      "hidden": false
     },
     "outputs": [
      {
       "metadata": {},
       "output_type": "display_data",
       "text": [
        "Just 50"
       ]
      }
     ],
     "prompt_number": 42
    },
    {
     "cell_type": "markdown",
     "metadata": {
      "hidden": false
     },
     "source": [
      "## The duality of `foldr` and `unfoldr`\n",
      "\n",
      "`foldr`, as defined in the Prelude, is specialized for lists and not as generic as it could be:\n",
      "\n",
      "```\n",
      "foldr :: (a -> b -> b) -> b -> [a] -> b\n",
      "foldr f z []     = z  -- Base case\n",
      "foldr f z (x:xs) = f x (foldr z xs)\n",
      "```\n",
      "\n",
      "```\n",
      "foldr :: (Maybe (a, b) -> b) -> [a] -> b\n",
      "foldr alg []     = alg Nothing  -- Base case\n",
      "foldr alg (x:xs) = alg (Just (x, foldr alg xs))\n",
      "```\n",
      "\n",
      "```\n",
      "foldr :: (Maybe (a, b) -> b) -> [a] -> b\n",
      "foldr alg = alg . fmap (\\(x, xs) -> (x, foldr alg xs)) . unList\n",
      "  where\n",
      "    unList []     = Nothing\n",
      "    unList (x:xs) = Just (x, xs)\n",
      "```\n",
      "\n",
      "The last definition of `foldr` looks very much like the definition of `cata` and also mirrors the definition of `unfoldr`:\n",
      "\n",
      "```\n",
      "unfoldr :: (b -> Maybe (a, b)) -> b -> [a]\n",
      "```"
     ]
    },
    {
     "cell_type": "code",
     "collapsed": false,
     "input": [],
     "language": "python",
     "metadata": {},
     "outputs": [],
     "prompt_number": 41
    }
   ],
   "metadata": {}
  }
 ]
}