22 people like it.

Memoization and Tail Recursive Function

Hi, I expressed Memoization and Memoization Tail Recursive on the functions. I hope something useful.

Memoize Sample

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
let createDic (key:'a) (value:'b) = Dictionary<'a, 'b> ()
let collateArg (arg: 'TArg) (f : 'TArg -> 'TResult) = fun a -> f a

[<CompiledName("Memoize")>]
let memoize0 f = 
  let value = ref defaultof<'TResult>
  let hasValue = ref false
  fun () -> if not !hasValue then  hasValue := true
                                   value := f ()
            !value

[<CompiledName("Memoize")>]
let memoize1 f = 
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  fun x -> match dic.TryGetValue(x) with 
           | true, r -> r
           | _       -> dic.[x] <- f x
                        dic.[x]

type args<'TArg1,'TArg2> = {item1:'TArg1; item2:'TArg2}
[<CompiledName("Memoize")>]
let memoize2 (f : 'TArg1 -> 'TArg2 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2> } (fun a -> f a.item1 a.item2) |> memoize1
  fun a b -> f' { item1 = a 
                  item2 = b}


type args<'TArg1,'TArg2,'TArg3> ={item1:'TArg1; item2:'TArg2; item3:'TArg3}
[<CompiledName("Memoize")>]
let memoize3 (f : 'TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) = 
  let f' = collateArg { item1 = defaultof<'TArg1>
                        item2 = defaultof<'TArg2>
                        item3 = defaultof<'TArg3> } (fun a -> f a.item1 a.item2 a.item3) |> memoize1
  fun a b c -> f' { item1 = a 
                    item2 = b
                    item3 = c}

Memoize Tail Recursion Sample

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion f =
  let dic = createDic  defaultof<'TArg1> defaultof<'TResult>
  let rec f' a k = 
    match dic.TryGetValue(a) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[a] <- r
                          k r) f'
  (fun a -> f' a id)

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion2 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>) defaultof<'TResult>
  let rec f' a b k = 
    match dic.TryGetValue((a,b)) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[(a,b)] <- r
                          k r) f'
  (fun a b -> f' a b id)

[<CompiledName("MemoizeTailRecursion")>]
let memoizeTailRecursion3 f =
  let dic = createDic (defaultof<'TArg1> 
                     , defaultof<'TArg2>
                     , defaultof<'TArg3>) defaultof<'TResult>
  let rec f' a b c k = 
    match dic.TryGetValue((a,b,c)) with
    | true, r -> k r
    | _ ->  f a (fun r -> dic.[(a,b,c)] <- r
                          k r) f'
  (fun a b c -> f' a b c id)

Main

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
let fibtrc n k m =
    if n = 0 then k 1
    else m (n - 1) (fun r1 -> let r = r1 * n in k r) 

let Heviy0 () =
  Thread.Sleep 3000
  1

let Heviy i = 
  Thread.Sleep 1000
  i + 1

let Heviy2 i j = 
  Thread.Sleep 1000
  i + j + 1

let Heviy3 i j k = 
  Thread.Sleep 1000
  i + j + k + 1
 
let Main =
  printfn "%s" "memoize0"
  let memofunc0 = memoize0 (fun () -> Heviy0 ())
  for i=0 to 4 do Console.WriteLine(memofunc0 ())
  for i=0 to 4 do Console.WriteLine(memofunc0 ())
  printfn "%s" "memoize1"
  let memofunc1 = memoize1 (fun x -> Heviy x)
  for i=0 to 4 do Console.WriteLine(memofunc1 i)
  for i=0 to 4 do Console.WriteLine(memofunc1 i)
  printfn "%s" "memoize2"
  let memofunc2 = memoize2 (fun a b -> Heviy2 a b)
  for i=0 to 4 do Console.WriteLine(memofunc2 i i)
  for i=0 to 4 do Console.WriteLine(memofunc2 i i)
  printfn "%s" "memoize3"
  let memofunc3 = memoize3 (fun a b c -> Heviy3 a b c)
  for i=0 to 4 do Console.WriteLine(memofunc3 i i i)
  for i=0 to 4 do Console.WriteLine(memofunc3 i i i)

let fibtrcmem = memoizeTailRecursion fibtrc
fibtrcmem 5 |> printfn "%d" 

Console.WriteLine ()
  |> fun _ -> Console.ReadLine () |> ignore
val createDic : key:'a -> value:'b -> Dictionary<'a,'b> (requires equality)

Full name: Script.createDic
val key : 'a (requires equality)
val value : 'b
Multiple items
type Dictionary<'TKey,'TValue> =
  new : unit -> Dictionary<'TKey, 'TValue> + 5 overloads
  member Add : key:'TKey * value:'TValue -> unit
  member Clear : unit -> unit
  member Comparer : IEqualityComparer<'TKey>
  member ContainsKey : key:'TKey -> bool
  member ContainsValue : value:'TValue -> bool
  member Count : int
  member GetEnumerator : unit -> Enumerator<'TKey, 'TValue>
  member GetObjectData : info:SerializationInfo * context:StreamingContext -> unit
  member Item : 'TKey -> 'TValue with get, set
  ...
  nested type Enumerator
  nested type KeyCollection
  nested type ValueCollection

Full name: System.Collections.Generic.Dictionary<_,_>

--------------------
Dictionary() : unit
Dictionary(capacity: int) : unit
Dictionary(comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>) : unit
Dictionary(capacity: int, comparer: IEqualityComparer<'TKey>) : unit
Dictionary(dictionary: IDictionary<'TKey,'TValue>, comparer: IEqualityComparer<'TKey>) : unit
val collateArg : arg:'TArg -> f:('TArg -> 'TResult) -> a:'TArg -> 'TResult

Full name: Script.collateArg
val arg : 'TArg
val f : ('TArg -> 'TResult)
val a : 'TArg
Multiple items
type CompiledNameAttribute =
  inherit Attribute
  new : compiledName:string -> CompiledNameAttribute
  member CompiledName : string

Full name: Microsoft.FSharp.Core.CompiledNameAttribute

--------------------
new : compiledName:string -> CompiledNameAttribute
val memoize0 : f:(unit -> 'TResult) -> (unit -> 'TResult)

Full name: Script.memoize0
val f : (unit -> 'TResult)
val value : 'TResult ref
Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val defaultof<'T> : 'T

Full name: Microsoft.FSharp.Core.Operators.Unchecked.defaultof
val hasValue : bool ref
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val memoize1 : f:('TArg1 -> 'TResult) -> ('TArg1 -> 'TResult) (requires equality)

Full name: Script.memoize1
val f : ('TArg1 -> 'TResult) (requires equality)
val dic : Dictionary<'TArg1,'TResult> (requires equality)
val x : 'TArg1 (requires equality)
Dictionary.TryGetValue(key: 'TArg1, value: byref<'TResult>) : bool
val r : 'TResult
type args<'TArg1,'TArg2> =
  {item1: 'TArg1;
   item2: 'TArg2;}

Full name: Script.args<_,_>
args.item1: 'TArg1
args.item2: 'TArg2
val memoize2 : f:('TArg1 -> 'TArg2 -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TResult) (requires equality and equality)

Full name: Script.memoize2
val f : ('TArg1 -> 'TArg2 -> 'TResult) (requires equality and equality)
val f' : (args<'TArg1,'TArg2> -> 'TResult) (requires equality and equality)
val a : args<'TArg1,'TArg2> (requires equality and equality)
val a : 'TArg1 (requires equality)
val b : 'TArg2 (requires equality)
Multiple items
type args<'TArg1,'TArg2> =
  {item1: 'TArg1;
   item2: 'TArg2;}

Full name: Script.args<_,_>

--------------------
type args<'TArg1,'TArg2,'TArg3> =
  {item1: 'TArg1;
   item2: 'TArg2;
   item3: 'TArg3;}

Full name: Script.args<_,_,_>
args.item3: 'TArg3
val memoize3 : f:('TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) (requires equality and equality and equality)

Full name: Script.memoize3
val f : ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) (requires equality and equality and equality)
val f' : (args<'TArg1,'TArg2,'TArg3> -> 'TResult) (requires equality and equality and equality)
val a : args<'TArg1,'TArg2,'TArg3> (requires equality and equality and equality)
val c : 'TArg3 (requires equality)
val memoizeTailRecursion : f:('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) -> ('TArg1 -> 'TResult) (requires equality)

Full name: Script.memoizeTailRecursion
val f : ('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) (requires equality)
val f' : ('TArg1 -> ('TResult -> 'TResult) -> 'TResult) (requires equality)
val k : ('TResult -> 'TResult)
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val memoizeTailRecursion2 : f:('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> 'TArg2 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TResult) (requires equality and equality)

Full name: Script.memoizeTailRecursion2
val f : ('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> 'TArg2 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) (requires equality and equality)
val dic : Dictionary<('TArg1 * 'TArg2),'TResult> (requires equality and equality)
val f' : ('TArg1 -> 'TArg2 -> ('TResult -> 'TResult) -> 'TResult) (requires equality and equality)
Dictionary.TryGetValue(key: 'TArg1 * 'TArg2, value: byref<'TResult>) : bool
val memoizeTailRecursion3 : f:('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TArg3 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TArg3 -> 'TResult) (requires equality and equality and equality)

Full name: Script.memoizeTailRecursion3
val f : ('TArg1 -> ('TResult -> 'TResult) -> ('TArg1 -> 'TArg2 -> 'TArg3 -> ('TResult -> 'TResult) -> 'TResult) -> 'TResult) (requires equality and equality and equality)
val dic : Dictionary<('TArg1 * 'TArg2 * 'TArg3),'TResult> (requires equality and equality and equality)
val f' : ('TArg1 -> 'TArg2 -> 'TArg3 -> ('TResult -> 'TResult) -> 'TResult) (requires equality and equality and equality)
Dictionary.TryGetValue(key: 'TArg1 * 'TArg2 * 'TArg3, value: byref<'TResult>) : bool
val fibtrc : n:int -> k:(int -> 'a) -> m:(int -> (int -> 'a) -> 'a) -> 'a

Full name: Script.fibtrc
val n : int
val k : (int -> 'a)
val m : (int -> (int -> 'a) -> 'a)
val r1 : int
val r : int
val Heviy0 : unit -> int

Full name: Script.Heviy0
Multiple items
type Thread =
  inherit CriticalFinalizerObject
  new : start:ThreadStart -> Thread + 3 overloads
  member Abort : unit -> unit + 1 overload
  member ApartmentState : ApartmentState with get, set
  member CurrentCulture : CultureInfo with get, set
  member CurrentUICulture : CultureInfo with get, set
  member DisableComObjectEagerCleanup : unit -> unit
  member ExecutionContext : ExecutionContext
  member GetApartmentState : unit -> ApartmentState
  member GetCompressedStack : unit -> CompressedStack
  member GetHashCode : unit -> int
  ...

Full name: System.Threading.Thread

--------------------
Thread(start: ThreadStart) : unit
Thread(start: ParameterizedThreadStart) : unit
Thread(start: ThreadStart, maxStackSize: int) : unit
Thread(start: ParameterizedThreadStart, maxStackSize: int) : unit
Thread.Sleep(timeout: TimeSpan) : unit
Thread.Sleep(millisecondsTimeout: int) : unit
val Heviy : i:int -> int

Full name: Script.Heviy
val i : int
val Heviy2 : i:int -> j:int -> int

Full name: Script.Heviy2
val j : int
val Heviy3 : i:int -> j:int -> k:int -> int

Full name: Script.Heviy3
val k : int
val Main : unit

Full name: Script.Main
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val memofunc0 : (unit -> int)
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.WriteLine() : unit
   (+0 other overloads)
Console.WriteLine(value: string) : unit
   (+0 other overloads)
Console.WriteLine(value: obj) : unit
   (+0 other overloads)
Console.WriteLine(value: uint64) : unit
   (+0 other overloads)
Console.WriteLine(value: int64) : unit
   (+0 other overloads)
Console.WriteLine(value: uint32) : unit
   (+0 other overloads)
Console.WriteLine(value: int) : unit
   (+0 other overloads)
Console.WriteLine(value: float32) : unit
   (+0 other overloads)
Console.WriteLine(value: float) : unit
   (+0 other overloads)
Console.WriteLine(value: decimal) : unit
   (+0 other overloads)
val memofunc1 : (int -> int)
val x : int
val memofunc2 : (int -> int -> int)
val a : int
val b : int
val memofunc3 : (int -> int -> int -> int)
val c : int
val fibtrcmem : (int -> int)

Full name: Script.fibtrcmem
Console.ReadLine() : string
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
Raw view Test code New version

More information

Link:http://fssnip.net/1q
Posted:14 years ago
Author:zecl
Tags: memoize , memoization , recursion , tail recursive