(* Memoization *)
(* O(2^n) via naturally recursive algorithm. *)
fun fibexp 0 = 1
| fibexp 1 = 1
| fibexp n = fibexp (n-2) + fibexp (n-1)
(* O(n) via double-accumulator tail-recursive algorithm. *)
fun fibn 0 = 1
| fibn 1 = 1
| fibn x =
let fun f (acc1, acc2, y) =
if y=x
then acc1 + acc2
else f (acc1 + acc2, acc1, y + 1)
in f (1,1,3) end
(* Association lists. *)
fun assoc x [] = NONE
| assoc x ((k,v)::rest) =
if k=x then SOME v else assoc x rest
(* Memoize any function, but INEFFICIENTLY -- only top-level calls
(not recursive calls) use the memo table. Recursive calls do
not. *)
fun memotop f =
let
(* Mutable reference to memo table, hidden in closure. We will
ignore the fact that association list lookup is an O(|list|)
operation. We should replace association lists with hash
tables or other structures with faster lookups, but our focus
is not on the data structure.
*)
val mem = ref []
in
fn x =>
case assoc x (!mem) of
SOME y => y
| NONE => let val y = f x
val _ = mem := ((x,y)::(!mem))
in y end
end
val fibtop = memotop fibexp
(* Memoized fib. *)
val fibm =
let
(* Reference to a memo table, available in closure for fib,
but invisible elsewhere. *)
val memo = ref []
fun fib x =
case assoc x (!memo) of
SOME y => y
| NONE => let val y = (case x of
0 => 1
| 1 => 1
| n => fib (n-2) + fib (n-1))
val _ = memo := ((x,y)::(!memo))
in y end
in fib end
(* OPTIONAL beyond here, but really cool!
The above fibm implementation is quite efficient (assume we replace
association lists with a hash table), but it is a bit ugly. It
mixes up what we are computing with how we are doing it
efficiently.
With a relatively non-intrusive change to the function we define,
we can apply memoization orthogonally to fib itself and then
compose them. We call this form "open recursion." It has close
ties to the way that method dispatch is defined in object-oriented
languages.
fibopen takes 2 arguments instead of 1. Its second argument is the
usual n. Its first argument is a function to call in order to make
recursive calls. This adds a little extra baggage, but much less
than in fibm, and, with a well-chosen names, it is fairly clear.
*)
fun fibopen fib 0 = 1
| fibopen fib 1 = 1
| fibopen fib n = fib (n-2) + fib (n-1)
(* fix takes a function in open recursive form and makes a closed
recursive function from it. It implements recursion via a
fixpoint.
Does it look familiar? Think back to recursion in the lambda
calculus. It is tempting to rewrite it to remove the x argument
and its use (remove the function wrapping) and take advantage of
currying and partial application, but something unfortunate
happens. What? Why? (Hint: it works fine in Haskell.)
*)
fun fix f x = f (fix f) x
(* fibfix implements fib in O(2^n), equivalent to the naturally
recursive implementation. *)
val fibfix = fix fibopen
(* Make a memoizer function in open recursive form. *)
fun make_memo () =
let val mem = ref []
(* In open recursive form: *)
fun memf f x =
case assoc x (!mem) of
SOME v => v
| NONE => let val v = f x
val _ = mem := ((x,v)::(!mem))
in v end
in memf end
(* Memoized fib implementation equivalent to fibm. *)
val fibmemo = fix (make_memo () o fibopen)
(* Or, by reimplementing fix within the memoizer: *)
fun memoize f = (* diff: f as arg to memo construction *)
let val mem = ref []
fun memf x = (* diff: capture f in closure *)
case assoc x (!mem) of
SOME v => v
| NONE => let val v = f memf x (* diff: explicitly fix *)
val _ = mem := ((x,v)::(!mem))
in v end
in f memf end
val fibmemo' = memoize fibopen
(* In fact, this form supports arbitrary "shim" functions between
recursive levels. Neither has to know about the other at
definition time. They are combined later via application. *)
fun log name atos rtos f =
let fun wrap indent x =
let val _ = print (indent ^ name ^ " " ^ atos x ^ "\n")
val v = f (wrap (" " ^ indent)) x
val _ = print (indent ^ "=> " ^ rtos v ^ "\n")
in v end
in wrap "" end
val fiblog = log "fib" Int.toString Int.toString fibopen
(* We need a bit more machinery to make log fully composable like
fibopen and the memoizers created by make_memo. It is possible,
interesting and even pretty clean, but we will stop here. If you
are curious about this come chat! Check out:
https://www.cs.utexas.edu/~wcook/Drafts/2006/MemoMixins.pdf.
Sections 1 - 2.2 should be accessible to a motivated 251-level
reader. Reading beyond will require some extra background. As
always, come chat if you are curious. Related topics could make a
great final project...
*)