Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

[Caml-list] More problems with memoization

24 views
Skip to first unread message

Diego Olivier FERNANDEZ PONS

unread,
Sep 30, 2006, 2:23:21 PM9/30/06
to caml...@inria.fr
Bonjour,

I wrote the following (classical) memoized code for the fibonacci
function and I have been unsuccessfully trying to generalize it with a
higher order function.

let rec fib = function
| 0 -> 0
| 1 -> 1
| n -> fib_mem (n - 1) + fib_mem (n - 2)
and fib_mem =
let table = ref [] in
function n ->
try
List.assoc n !table
with Not_found ->
let f_n = fib n in
table := (n, f_n) :: !table;
f_n

# val fib : int -> int = <fun>
# val fib_mem : int -> int = <fun>

It works: fib 35 answers instantaneously.

Now I want to achieve the same result with a higher order function
[make_memo] and apply it to fib

let make_mem = function f ->
let table = ref [] in
function n ->
try
List.assoc n !table
with Not_found ->
let f_n = f n in
table := (n, f_n) :: !table;
f_n

#val make_mem : ('a -> 'b) -> 'a -> 'b

Very well. Notice that it has one less parameter than the code posted
by Andrej Bauer which has type memo_rec : (('a -> 'b) -> 'a -> 'b) ->
'a -> 'b. The only difference is the line

let f_n = f n in ...
with respect to
let f_n = f g n in ... where g is the anonymous function itself

in the same way Bauer's [fib_memo] uses an extra parameter [self]

let fib_memo =
let rec fib self = function
| 0 -> 1
| 1 -> 1
| n -> self (n - 1) + self (n - 2)
in
memo_rec fib


Now I try to apply make_mem to but it does not work

let rec fib = function
| 0 -> 0
| 1 -> 1
| n -> fib_mem (n - 1) + fib_mem (n - 2)
and fib_mem = make_mem fib

# This kind of expression is not allowed as right-hand side of `let rec'

Ok... usually one only need to expand to avoid the problem

let rec fib = function
| 0 -> 0
| 1 -> 1
| n -> fib_mem (n - 1) + fib_mem (n - 2)
and fib_mem = function n ->
let f = make_mem fib in
f n

# val fib : int -> int = <fun>
# val fib_mem : int -> int = <fun>

But know fib 35 takes several minutes to be computed !

I believe I understand why: I am computing a different fib_mem for
each value of n and applying it just after, while I wanted a single
fib_mem to be used for all computations. In the process, the
tabulation vanishes.

The only work around I found is to lift the table argument in [make_mem]

let make_mem = fun table f ->
function n ->
try
List.assoc n !table
with Not_found ->
let f_n = f n in
table := (n, f_n) :: !table;
f_n

# val make_mem : ('a * 'b) list ref -> ('a -> 'b) -> 'a -> 'b = <fun>

And build fib in the following way

let fib_mem = function n ->
let table = ref [] and
fib = function
| 0 -> 0
| 1 -> 1
| n -> fib_mem (n - 1) + fib_mem (n - 2)
in make_mem table fib n

# fib_mem 35: instantaneous

The problem is that the memoization is much more intrusive, which is
what I was trying to avoid.

Diego Olivier

_______________________________________________
Caml-list mailing list. Subscription management:
http://yquem.inria.fr/cgi-bin/mailman/listinfo/caml-list
Archives: http://caml.inria.fr
Beginner's list: http://groups.yahoo.com/group/ocaml_beginners
Bug reports: http://caml.inria.fr/bin/caml-bugs

Tom

unread,
Sep 30, 2006, 3:21:43 PM9/30/06
to Diego Olivier FERNANDEZ PONS
In case you know me, you probably know what kind of solution I am going to
tell you...

Well, in case you don't... my solution is going to be dirty, is going to use
the undocumented Obj module (Obj.magic lets you change an ocaml value into
another ocaml value of any type).

-----------

The solution is to memoize the very make_mem function!

let make_mem' = function f ->
let table = ref [] in
function n ->
try
List.assoc n !table
with Not_found ->
let f_n = f n in
table := (n, f_n) :: !table;

f_n;;

let make_mem = make_mem' make_mem'

Well, the problem is, that the ocaml type inference forbids a function to
return a polymorphic value, so the type of make_mem' is only ('_a -> '_b) ->
'_a -> '_b. So the right thing to do here (as this type is, obviously,
incorrect) is to use Obj.magic:

let make_mem'' = Obj.magic make_mem'

let make_mem = (make_mem'' : ('a -> 'b) -> 'a -> 'b)

Now, the fibb will work as expected (instantaneously) and memoization will
be simple to apply. A bit of thinking is needed, of course, to reckon
whether my implementation is optimal and safe (not yielding unexpected
results, for example when you rename functions, use partial evaluation,
etc.). But it works.

Have fun, Tom

Tom

unread,
Sep 30, 2006, 3:28:58 PM9/30/06
to Diego Olivier FERNANDEZ PONS
>
>
>
> Well, the problem is, that the ocaml type inference forbids a function to
> return a polymorphic value, so the type of make_mem' is only ('_a -> '_b)
> -> '_a -> '_b. So the right thing to do here (as this type is, obviously,
> incorrect) is to use Obj.magic:

I'm sorry, the OCaml type inference is correct to infer the type ('_a ->
'_b) -> '_a -> '_b here, but I believe that there can be no error caused
generalizing it.

Jon Harrop

unread,
Sep 30, 2006, 8:25:45 PM9/30/06
to caml...@yquem.inria.fr
On Saturday 30 September 2006 19:01, Diego Olivier FERNANDEZ PONS wrote:
> I wrote the following (classical) memoized code for the fibonacci
> function and I have been unsuccessfully trying to generalize it with a
> higher order function.
>
> let rec fib = function
>
> | 0 -> 0
> | 1 -> 1
> | n -> fib_mem (n - 1) + fib_mem (n - 2)
>
> and fib_mem =
> let table = ref [] in
> function n ->
> try
> List.assoc n !table
> with Not_found ->
> let f_n = fib n in
> table := (n, f_n) :: !table;
> f_n
>
> # val fib : int -> int = <fun>
> # val fib_mem : int -> int = <fun>
>
> It works: fib 35 answers instantaneously.
>
> Now I want to achieve the same result with a higher order function
> [make_memo] and apply it to fib

I believe you want to "untie the knot" of recursion, creating an higher-order,
auxiliary fibonacci function fib_aux that accepts the recursive call as an
argument:

# let rec fib_aux fib = function
| 0 | 1 as n -> n
| n -> fib(n - 1) + fib(n - 2);;
val fib_aux : (int -> int) -> int -> int = <fun>

You can recover the ordinary fibonacci function using the Y combinator:

# let rec fib n = fib_aux fib n;;


val fib : int -> int = <fun>

You can write a higher-order memoization function that accepts an argument
with the type of fib_aux:

# let memoize f =
let m = Hashtbl.create 0 in
let rec f' n =
try Hashtbl.find m n with Not_found ->
let x = f f' n in
Hashtbl.replace m n x;
x in
f';;
val memoize : (('a -> 'b) -> 'a -> 'b) -> 'a -> 'b = <fun>

Now you can memoize recursive functions easily:

# memoize fib_aux 35;;
- : int = 9227465

--
Dr Jon D Harrop, Flying Frog Consultancy Ltd.
Objective CAML for Scientists
http://www.ffconsultancy.com/products/ocaml_for_scientists

Martin Jambon

unread,
Sep 30, 2006, 8:55:52 PM9/30/06
to Jon Harrop
On Sun, 1 Oct 2006, Jon Harrop wrote:

> I believe you want to "untie the knot" of recursion, creating an higher-order,
> auxiliary fibonacci function fib_aux that accepts the recursive call as an
> argument:
>
> # let rec fib_aux fib = function
> | 0 | 1 as n -> n
> | n -> fib(n - 1) + fib(n - 2);;
> val fib_aux : (int -> int) -> int -> int = <fun>

Since the point is to make the function not recursive, I think you
shouldn't use "let rec" :-)


Martin

--
Martin Jambon, PhD
http://martin.jambon.free.fr

Diego Olivier FERNANDEZ PONS

unread,
Oct 2, 2006, 11:31:34 AM10/2/06
to Jon Harrop
Bonjour,

Quoting Jon Harrop <j...@ffconsultancy.com>:
> I believe you want to "untie the knot" of recursion, creating an
> higher-order, auxiliary fibonacci function fib_aux that accepts the
> recursive call as an argument:
>
> # let rec fib_aux fib = function
> | 0 | 1 as n -> n
> | n -> fib(n - 1) + fib(n - 2);;
> val fib_aux : (int -> int) -> int -> int = <fun>
>

[...]


> You can recover the ordinary fibonacci function using the Y combinator:

[...]


> You can write a higher-order memoization function that accepts an argument
> with the type of fib_aux:

> # memoize fib_aux 35;;
> - : int = 9227465

Your solution is similar to Andrej Brauer's one which is exactly what
I was trying to avoid because it is too much intrusive. When you break
the recursion in two functions you change the type of [fib] from
[fib : int -> int] to [fib : (int -> int) -> int -> int)].

In my first example you keep the type of [fib] and add a second
function [fib_mem]. You can use anyone indifferently and hide the
latter with the .mli


val fib : int -> int = <fun>

val fib_mem : int -> int = <fun>

When you compare your solution with what I am trying to do you see
there is a big difference in locality and transparency

let rec fib = function
| 0 -> 0
| 1 -> 1

| n -> fib (n - 1) + fib (n - 2)

transformed into

let rec fib = function
| 0 -> 0
| 1 -> 1
| n -> fib_mem (n - 1) + fib_mem (n - 2)

and fib_mem = make_mem fib

The latter could even be done automatically by a source to source
transformation (if it worked).

Diego Olivier

Andrej Bauer

unread,
Oct 2, 2006, 7:03:23 PM10/2/06
to Diego Olivier FERNANDEZ PONS, caml...@inria.fr
Diego Olivier FERNANDEZ PONS wrote:
> In my first example you keep the type of [fib] and add a second function
> [fib_mem]. You can use anyone indifferently and hide the latter with the
> .mli
> val fib : int -> int = <fun>
> val fib_mem : int -> int = <fun>

If you want to keep the same type for fib, and have the memoized one, as
well as to have locality you can do something like this:

let make_memo f = ...

let rec make_rec f x = f (make_rec f) x

let fib, fib_mem =
let fib' self = function


| 0 -> 0
| 1 -> 1

| n -> self (n - 1) + self (n - 2)
in

make_rec fib', make_mem fib

(You will notice that make_rec is just the Y combinator.)

> When you compare your solution with what I am trying to do you see there
> is a big difference in locality and transparency

I fail to see this big difference, frankly, since all you're doing is
just a beta-reduction of what Jon and I suggested.

A recursive function _is_ the fixed point of a non-recursive one with an
"extra" argument. You may hide this fact if you wish, but I think it's
more honest to admit it to yourself. The "untied" version of fib has the
advantage that you can do many cool things to it: memoizing is just one
possibility.

Andrej

Andrej Bauer

unread,
Oct 2, 2006, 7:08:47 PM10/2/06
to Diego Olivier FERNANDEZ PONS, caml...@inria.fr
Andrej Bauer wrote:
> let fib, fib_mem =
> let fib' self = function
> | 0 -> 0
> | 1 -> 1
> | n -> self (n - 1) + self (n - 2)
> in
> make_rec fib', make_mem fib

I apologize, the last line should read

make_rec fib', make_mem fib'

An apostrophe is missing.

Don Syme

unread,
Oct 2, 2006, 7:40:51 PM10/2/06
to Diego Olivier FERNANDEZ PONS, Jon Harrop

Hi Diego,

You may be interested in the approach to this kind of problem discussed
in http://dx.doi.org/10.1016/j.entcs.2005.11.038 (see also tech report
at http://research.microsoft.com/users/dsyme/papers/valrec-tr.pdf).
Under that approach you get to write the code in a natural way as shown
below: fib_mem is defined recursively, but the "cache" function has the
natural "(a -> b) -> (a -> b)" type and is abstract and reusable (no
details as to the nature of the internal table are revealed).

let cache f =


let table = ref [] in

fun n ->


try
List.assoc n !table
with Not_found ->

let f_n = f n in


table := (n, f_n) :: !table;
f_n

let rec fib_mem =
cache (function

| 0 -> 0
| 1 -> 1

| n -> fib_mem (n - 1) + fib_mem (n - 2))


The use of a computation on the right of a "let rec" is allowed by
systematically introducing initialization holes using lazy values and
forces. There are disadvantages to this approach, as it introduces a
potential for initialization unsoundness somewhat similar to those in
most designs and implementations of recursive modules. However the
paper argues that in the balance it is not unreasonable for a strict
language to accept this in order to gain modularity and localize the
potential for unsoundness. It is even more compelling when often
working with abstract APIs such as Java and .NET GUI libraries.

While this isn't OCaml, and may not ever be the right design for OCaml,
I've found it a useful technique to know even when doing C#, C++ and
OCaml programming, as a broad range of recursion puzzles can be
addressed by modelling the problem the "natural" way (e.g. more like
Haskell) and then using a translation that introduces initialization
holes systematically. The translation of your sample into OCaml using
"lazy" initialization holes is shown below (for single recursion you can
also just use a "option ref"). Note "cache" does not change,
maintaining the property that the caching function is abstract and
reusable.

let (!!) x = Lazy.force x
let rec fib_mem' = lazy
cache (function

| 0 -> 0
| 1 -> 1

| n -> !!fib_mem' (n - 1) + !!fib_mem' (n - 2))

let fib_mem = !!fib_mem'

FWIW it is well known that laziness can be used in essentially this way,
e.g. see Michel Mauny's early papers on laziness in OCaml. However I've
not seen a paper that argues the case for making this the default
interpretation of "let rec" in a strict language.

Cheers
Don

skaller

unread,
Oct 2, 2006, 8:54:09 PM10/2/06
to Andrej...@andrej.com
On Tue, 2006-10-03 at 01:00 +0200, Andrej Bauer wrote:

> A recursive function _is_ the fixed point of a non-recursive one with an
> "extra" argument. You may hide this fact if you wish, but I think it's
> more honest to admit it to yourself. The "untied" version of fib has the
> advantage that you can do many cool things to it: memoizing is just one
> possibility.

There is, however, a good reason this is not practical in general:
for a recursion of N entities (either functions or polymorphic
variants in Ocaml can be 'open-recursioned') you need an
extra N arguments .. and the result is unreadable, as well
as possibly incurring a performance hit.

I wonder if one can add compiler support: for example given

let rec fib x = match x with


| 0 -> 0
| 1 -> 1

| n -> fib (n - 1) + fib (n - 2)

The compiler silently generates:

let @fib fib' x = match x with


| 0 -> 0
| 1 -> 1

| n -> fib' (n - 1) + fib' (n - 2)

let fib = make_rec @fib

and now you have fib as written .. but you ALSO can do:

let fib = make_mem @fib

to create a memoised version.

That's for one argument and can clearly be done easily
by the compiler (in fact, camlp4).

However the extension to multiple arguments is not clear.
Maybe labelled arguments would help, perhaps using
a record.

Andrei said:

"You may hide this fact if you wish, but I think it's
more honest to admit it to yourself."

but I think this is misleading: there's a good
reason NOT to open the recursions. There's a fundamental
principle of software design: the open/closed principle (OOSC)
which is not obeyed by either the closed or open form.

We need a form that is simultaneously closed and ready to
use but which is also open and amenable to extension.

FYI: the case that most interests me at the moment is neither
type recursion nor functional recursion -- I'm interested
in whether it is possible to design an open-recursive grammar,
this seems to need both recursive data types *and* recursive
functions in open/closed form.

Interestingly in this case I have actually implemented one
already, allowing Felix to extend it's own parser by combining
an Ocamlyacc parser with an executable RD parser .. but
this really isn't the same as systematic static extension
where, for example you write a basic grammar, and then
extensions to it.

--
John Skaller <skaller at users dot sf dot net>
Felix, successor to C++: http://felix.sf.net

ol...@pobox.com

unread,
Oct 3, 2006, 1:12:30 AM10/3/06
to diego.fern...@etu.upmc.fr

Diego Olivier wrote:

> When you compare your solution with what I am trying to do you see
> there is a big difference in locality and transparency
>
> let rec fib = function

> | 0 -> 0
> | 1 -> 1
> | n -> fib (n - 1) + fib (n - 2)
>

> transformed into
>
> let rec fib = function

> | 0 -> 0
> | 1 -> 1

> | n -> fib_mem (n - 1) + fib_mem (n - 2)
> and fib_mem = make_mem fib
>
> The latter could even be done automatically by a source to source
> transformation (if it worked).

But it almost does:

let make_mem = fun table f ->

function n ->


try
List.assoc n !table
with Not_found ->
let f_n = f n in
table := (n, f_n) :: !table;
f_n
;;

let rec fib = function


| 0 -> 0
| 1 -> 1

| n -> mem fib (n - 1) + mem fib (n - 2)
and mem = make_mem (ref [])
;;

fib 35;;
- : int = 9227465
instantaneous.

The biggest difference is replacing "fib_mem" in your code with
"mem fib" in mine. The same number of characters in either case...
And yes, this can be done via camlp4... OTH, with camlp4 it is quite
trivial to convert a let rec expression to the one involving open
recursion. So, we can write something like

let fib n = funM MyModule n -> let rec fib function 0 -> 1 ... in fib n;;

and, depending on what MyModule actually implements, obtain either the usual
or the memoized Fibonacci (or even partially unrolled to any desired degree).

0 new messages