Monadic Memoization

Modular memoization within a pure functional setting that is implemented as a convenient computation builder.

Copy Source
Copy Link
Tools:
 1: // Inspired by http://www.cs.utexas.edu/~wcook/Drafts/2006/MemoMixins.pdf
 2: 
 3: // State Monad combined with Continuation Monad (StateT Monad transformer)
 4: type StateContMonad<'s, 'a, 'r> = StateContMonad of ('s -> ('s -> 'a -> 'r) -> 'r)
 5: 
 6: // Computation Builder
 7: type StateContBuilder() =
 8:     member self.Return value = 
 9:         StateContMonad (fun state k -> k state value)
10:     member self.Bind(StateContMonad contStateMonad, f) = 
11:         StateContMonad (fun state k -> 
12:             contStateMonad state (fun state' value -> 
13:                 let (StateContMonad contMonad') = f value
14:                 contMonad' state' k))
15:     member self.Delay( f : unit -> StateContMonad<'s, 'a, 'r> ) = 
16:         StateContMonad (fun state k -> 
17:             let (StateContMonad contStateMonad) = f ()
18:             contStateMonad state k)
19:  
20: let memo = new StateContBuilder()
21:  
22: // Tell me Y 
23: let rec Y f v = f (Y f) v
24: 
25: // Map functions
26: let check (value : 'a) : StateContMonad<Map<'a, 'r>, option<'r>, 'r> = 
27:     StateContMonad (fun map k -> k map (Map.tryFind value map))
28: 
29: let store (argument : 'a, result : 'r) : StateContMonad<Map<'a, 'r>, unit, 'r> = 
30:     StateContMonad (fun map k -> k (Map.add argument result map) ())
31: 
32: // Memoization Mixin
33: let memoize f argument =
34:     memo {
35:         let! checkResult = check argument
36:         match checkResult with
37:         | Some result -> return result
38:         | None ->
39:             let! result = f argument
40:             do! store (argument, result)
41:             return result
42:     }
43: 
44: 
45: let execute f n = 
46:     let (StateContMonad contStateMonad) = Y (memoize << f) n
47:     contStateMonad Map.empty (fun _ value -> value)
48:  
49: // Example
50: let big (value : int) = new System.Numerics.BigInteger(value)
51: 
52: let fib f n =
53:     if n = big 0 then memo { return big 0 }
54:     elif n = big 1 then memo { return big 1 }
55:     else
56:         memo {
57:             let! nMinus1Fib = f (n - big 1)
58:             let! nMinus2Fib = f (n - big 2)
59:             return nMinus1Fib + nMinus2Fib
60:         }
61:  
62: execute fib (big 100000)
Multiple items
union case StateContMonad.StateContMonad: ('s -> ('s -> 'a -> 'r) -> 'r) -> StateContMonad<'s,'a,'r>

--------------------

type StateContMonad<'s,'a,'r> = | StateContMonad of ('s -> ('s -> 'a -> 'r) -> 'r)

Full name: Snippet.StateContMonad<_,_,_>
type StateContBuilder =
  class
    new : unit -> StateContBuilder
    member Bind : StateContMonad<'a,'b,'c> * f:('b -> StateContMonad<'a,'d,'c>) -> StateContMonad<'a,'d,'c>
    member Delay : f:(unit -> StateContMonad<'s,'a,'r>) -> StateContMonad<'s,'a,'r>
    member Return : value:'e -> StateContMonad<'f,'e,'g>
  end

Full name: Snippet.StateContBuilder
val self : StateContBuilder
member StateContBuilder.Return : value:'e -> StateContMonad<'f,'e,'g>

Full name: Snippet.StateContBuilder.Return
val value : 'e
val state : 'f
val k : ('f -> 'e -> 'g)
member StateContBuilder.Bind : StateContMonad<'a,'b,'c> * f:('b -> StateContMonad<'a,'d,'c>) -> StateContMonad<'a,'d,'c>

Full name: Snippet.StateContBuilder.Bind
val contStateMonad : ('a -> ('a -> 'b -> 'c) -> 'c)
val f : ('b -> StateContMonad<'a,'d,'c>)
val state : 'a
val k : ('a -> 'd -> 'c)
val state' : 'a
val value : 'b
val contMonad' : ('a -> ('a -> 'd -> 'c) -> 'c)
member StateContBuilder.Delay : f:(unit -> StateContMonad<'s,'a,'r>) -> StateContMonad<'s,'a,'r>

Full name: Snippet.StateContBuilder.Delay
val f : (unit -> StateContMonad<'s,'a,'r>)
type unit = Unit

Full name: Microsoft.FSharp.Core.unit

  type: unit
  implements: System.IComparable
val state : 's
val k : ('s -> 'a -> 'r)
val contStateMonad : ('s -> ('s -> 'a -> 'r) -> 'r)
val memo : StateContBuilder

Full name: Snippet.memo
val Y : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b

Full name: Snippet.Y
val f : (('a -> 'b) -> 'a -> 'b)
val v : 'a
val check : 'a -> StateContMonad<Map<'a,'r>,'r option,'r> (requires comparison)

Full name: Snippet.check
val value : 'a (requires comparison)
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------

type Map<'Key,'Value (requires comparison)> =
  class
    interface System.Collections.IEnumerable
    interface System.IComparable
    interface System.Collections.Generic.IEnumerable<System.Collections.Generic.KeyValuePair<'Key,'Value>>
    interface System.Collections.Generic.ICollection<System.Collections.Generic.KeyValuePair<'Key,'Value>>
    interface System.Collections.Generic.IDictionary<'Key,'Value>
    new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
    member Add : key:'Key * value:'Value -> Map<'Key,'Value>
    member ContainsKey : key:'Key -> bool
    override Equals : obj -> bool
    member Remove : key:'Key -> Map<'Key,'Value>
    member TryFind : key:'Key -> 'Value option
    member Count : int
    member IsEmpty : bool
    member Item : key:'Key -> 'Value with get
  end

Full name: Microsoft.FSharp.Collections.Map<_,_>

  type: Map<'Key,'Value>
  implements: System.IComparable
  implements: System.Collections.Generic.IDictionary<'Key,'Value>
  implements: System.Collections.Generic.ICollection<System.Collections.Generic.KeyValuePair<'Key,'Value>>
  implements: seq<System.Collections.Generic.KeyValuePair<'Key,'Value>>
  implements: System.Collections.IEnumerable
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

  type: 'T option
  implements: System.Collections.IStructuralEquatable
  implements: System.IComparable<Option<'T>>
  implements: System.IComparable
  implements: System.Collections.IStructuralComparable
val map : Map<'a,'r> (requires comparison)

  type: Map<'a,'r>
  implements: System.IComparable
  implements: System.Collections.Generic.IDictionary<'a,'r>
  implements: System.Collections.Generic.ICollection<System.Collections.Generic.KeyValuePair<'a,'r>>
  implements: seq<System.Collections.Generic.KeyValuePair<'a,'r>>
  implements: System.Collections.IEnumerable
val k : (Map<'a,'r> -> 'r option -> 'r) (requires comparison)
val tryFind : 'Key -> Map<'Key,'T> -> 'T option (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.tryFind
val store : 'a * 'r -> StateContMonad<Map<'a,'r>,unit,'r> (requires comparison)

Full name: Snippet.store
val argument : 'a (requires comparison)
val result : 'r
val k : (Map<'a,'r> -> unit -> 'r) (requires comparison)
val add : 'Key -> 'T -> Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.add
val memoize : ('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b> (requires comparison)

Full name: Snippet.memoize
val f : ('a -> StateContMonad<Map<'a,'b>,'b,'b>) (requires comparison)
val checkResult : 'b option

  type: 'b option
  implements: System.Collections.IStructuralEquatable
  implements: System.IComparable<Option<'b>>
  implements: System.IComparable
  implements: System.Collections.IStructuralComparable
union case Option.Some: 'T -> Option<'T>
val result : 'b
union case Option.None: Option<'T>
val execute : (('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> 'b (requires comparison)

Full name: Snippet.execute
val f : (('a -> StateContMonad<Map<'a,'b>,'b,'b>) -> 'a -> StateContMonad<Map<'a,'b>,'b,'b>) (requires comparison)
val n : 'a (requires comparison)
val contStateMonad : (Map<'a,'b> -> (Map<'a,'b> -> 'b -> 'b) -> 'b) (requires comparison)
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty
val big : int -> System.Numerics.BigInteger

Full name: Snippet.big
val value : int

  type: int
  implements: System.IComparable
  implements: System.IFormattable
  implements: System.IConvertible
  implements: System.IComparable<int>
  implements: System.IEquatable<int>
  inherits: System.ValueType
Multiple items
val int : 'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------

type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>

  type: int<'Measure>
  implements: System.IComparable
  implements: System.IConvertible
  implements: System.IFormattable
  implements: System.IComparable<int<'Measure>>
  implements: System.IEquatable<int<'Measure>>
  inherits: System.ValueType


--------------------

type int = int32

Full name: Microsoft.FSharp.Core.int

  type: int
  implements: System.IComparable
  implements: System.IFormattable
  implements: System.IConvertible
  implements: System.IComparable<int>
  implements: System.IEquatable<int>
  inherits: System.ValueType
namespace System
namespace System.Numerics
type BigInteger =
  struct
    new : int -> System.Numerics.BigInteger
    new : uint32 -> System.Numerics.BigInteger
    new : int64 -> System.Numerics.BigInteger
    new : uint64 -> System.Numerics.BigInteger
    new : float32 -> System.Numerics.BigInteger
    new : float -> System.Numerics.BigInteger
    new : decimal -> System.Numerics.BigInteger
    new : System.Byte [] -> System.Numerics.BigInteger
    member CompareTo : int64 -> int
    member CompareTo : uint64 -> int
    member CompareTo : System.Numerics.BigInteger -> int
    member CompareTo : obj -> int
    member Equals : obj -> bool
    member Equals : int64 -> bool
    member Equals : uint64 -> bool
    member Equals : System.Numerics.BigInteger -> bool
    member GetHashCode : unit -> int
    member IsEven : bool
    member IsOne : bool
    member IsPowerOfTwo : bool
    member IsZero : bool
    member Sign : int
    member ToByteArray : unit -> System.Byte []
    member ToString : unit -> string
    member ToString : System.IFormatProvider -> string
    member ToString : string -> string
    member ToString : string * System.IFormatProvider -> string
    static member Abs : System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Add : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Compare : System.Numerics.BigInteger * System.Numerics.BigInteger -> int
    static member DivRem : System.Numerics.BigInteger * System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Divide : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member GreatestCommonDivisor : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Log : System.Numerics.BigInteger -> float
    static member Log : System.Numerics.BigInteger * float -> float
    static member Log10 : System.Numerics.BigInteger -> float
    static member Max : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Min : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member MinusOne : System.Numerics.BigInteger
    static member ModPow : System.Numerics.BigInteger * System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Multiply : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Negate : System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member One : System.Numerics.BigInteger
    static member Parse : string -> System.Numerics.BigInteger
    static member Parse : string * System.Globalization.NumberStyles -> System.Numerics.BigInteger
    static member Parse : string * System.IFormatProvider -> System.Numerics.BigInteger
    static member Parse : string * System.Globalization.NumberStyles * System.IFormatProvider -> System.Numerics.BigInteger
    static member Pow : System.Numerics.BigInteger * int -> System.Numerics.BigInteger
    static member Remainder : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member Subtract : System.Numerics.BigInteger * System.Numerics.BigInteger -> System.Numerics.BigInteger
    static member TryParse : string * System.Numerics.BigInteger -> bool
    static member TryParse : string * System.Globalization.NumberStyles * System.IFormatProvider * System.Numerics.BigInteger -> bool
    static member Zero : System.Numerics.BigInteger
  end

Full name: System.Numerics.BigInteger

  type: System.Numerics.BigInteger
  implements: System.IFormattable
  implements: System.IComparable
  implements: System.IComparable<System.Numerics.BigInteger>
  implements: System.IEquatable<System.Numerics.BigInteger>
  inherits: System.ValueType
val fib : (System.Numerics.BigInteger -> StateContMonad<'a,System.Numerics.BigInteger,'b>) -> System.Numerics.BigInteger -> StateContMonad<'a,System.Numerics.BigInteger,'b>

Full name: Snippet.fib
val f : (System.Numerics.BigInteger -> StateContMonad<'a,System.Numerics.BigInteger,'b>)
val n : System.Numerics.BigInteger

  type: System.Numerics.BigInteger
  implements: System.IFormattable
  implements: System.IComparable
  implements: System.IComparable<System.Numerics.BigInteger>
  implements: System.IEquatable<System.Numerics.BigInteger>
  inherits: System.ValueType
val nMinus1Fib : System.Numerics.BigInteger

  type: System.Numerics.BigInteger
  implements: System.IFormattable
  implements: System.IComparable
  implements: System.IComparable<System.Numerics.BigInteger>
  implements: System.IEquatable<System.Numerics.BigInteger>
  inherits: System.ValueType
val nMinus2Fib : System.Numerics.BigInteger

  type: System.Numerics.BigInteger
  implements: System.IFormattable
  implements: System.IComparable
  implements: System.IComparable<System.Numerics.BigInteger>
  implements: System.IEquatable<System.Numerics.BigInteger>
  inherits: System.ValueType

More information

Link: http://fssnip.net/3v
Posted: 3 years ago
Author: Nick Palladinos (website)
Tags: Monads, Memoization