ocaml memoization failed when applied to Fibonacci series - ocaml

I tried to use memoization technique to optimize the caculation of Fibonacci. My code is:
let memo f =
let vtable = ref [] in
let rec match_function x vt=
match vt with
|(x',y)::_ when x=x' -> y
|_::l ->
match_function x l
|[] ->
let y = (f x) in
vtable := (x,y):: !vtable;
y
in
(fun x -> (match_function x !vtable));;
let rec ggfib = function
0|1 as i -> i
|x -> ggfib(x-1) + ggfib(x-2);;
let memoggfib = memo ggfib;;
let running_time f x =
let start_time = Sys.time () in
let y = f x in
let finish_time = Sys.time() in
Printf.printf "Time lapse:%f\n" (finish_time -. start_time);
y;;
running_time ggfib 30;;
running_time memoggfib 30;;
The output is:
Time lapse:0.357187
Time lapse:0.353663
The difference is not that much.. Why?? And even worse, when I tried to calculate Fibonacci at 40 using
running_time ggfib 40;;
running_time memoggfib 40;;
The program appears to run into a infinite loop and stop outputting.
What is wrong here? What problem I did not take care of?
I changed the code above, to introduce a 'static' vtable for memoization.
let rec ggfib = function
0|1 as i -> i
|x -> ggfib(x-1) + ggfib(x-2);;
let running_time x0 =
let vtable = ref [] in
let start_time = Sys.time () in
let x = ref 1 in
let rec match_function ff x vt=
match vt with
|(x',y)::_ when x=x' -> y
|_::l ->
match_function ff x l
|[] ->
let y = (ff x) in
vtable := (x,y):: !vtable;
y
in
let y=ref 1 in
while !x<x0 do
y:= match_function ggfib !x !vtable;
x:=!x+1;
done;
let finish_time = Sys.time() in
Printf.printf "Time lapse:%f\n" (finish_time -. start_time);
y;;
let running_time2 x0=
let start_time = Sys.time () in
let x = ref 1 in
while !x<x0 do
ggfib !x;
x:=!x+1;
done;
let finish_time = Sys.time() in
Printf.printf "Time lapse:%f\n" (finish_time -. start_time);;
running_time 40;;
running_time2 30;;
It still acts as the basically same. I didn't see a significant improvement....
Time lapse:0.581918
Time lapse:0.577813

It looks to me like you're just memoizing the outermost calls. The inner calls are to ggfib, not to (memo ggfib).
When you call memoggfib, the memo function will remember the value of the outermost call. However, the inner calls are handled by ggfib (the function that you passed to memo). If you look at the definition of ggfib, you see that it calls itself. It doesn't call (memo ggfib).
I don't see a way to turn an ordinary (recursive) function into a memoized one. It won't automatically call the memoized version of itself internally.
If you start with a function that's intended to be memoized, I still see problems "tying the knot".

(* a "derecursified" version of fibonacci: recursive calls are
replaced by calls to a function passed as parameter *)
let rec fib_derec f = function
| 0|1 as i -> i
| n -> f (n - 1) + f (n - 2)
(* to get the fibonacci back we need to compute a fixpoint:
fib_derec should get passed 'fib' as parameter,
which we will define in term of fib_derec
*)
let rec fib n = fib_derec fib n
let test = Array.init 10 fib
(* [|0; 1; 1; 2; 3; 5; 8; 13; 21; 34|] *)
(* we can make this construction generic *)
let rec fix derec input = derec (fix derec) input
let fib = fix fib_derec
let test = Array.init 10 fib
(* [|0; 1; 1; 2; 3; 5; 8; 13; 21; 34|] *)
(* Trick: we can use this tying-the-knot operator to insert
memoization "between the recursive calls" of the recursive function *)
let rec memo_fix table derec =
fun input ->
try Hashtbl.find table input with Not_found ->
let result = derec (memo_fix table derec) input in
Hashtbl.add table input result;
result
let fib_table = Hashtbl.create 100
let fib = memo_fix fib_table fib_derec
let test = Array.init 10 fib
(* [|0; 1; 1; 2; 3; 5; 8; 13; 21; 34|] *)
let test2 = fib 1000
(* -591372213: overflow, but quick result *)

Related

Build a sequence from a function

I wrote these function to build a sequence from a function i am having a stack overflow error while testing it
let rec from_fun f ()=
match f () with
| None -> Nil
| Some e -> Cons(e, from_fun f)
from_fun (fun () -> let x = 0 in if x<10 then Some (x+1) else None)
thanks
Your function always returns Some 1. It never returns None. So the sequence is infinitely long and the stack overflows while building it.
If you want a function to return different values when you call it, you can do two things. First, you can pass it different parameters. This isn't possible for your design of from_fun--the parameter to the function is always (). Second, your function can be impure. I.e., the function can maintain some mutable state.
Here is an example of a generator:
let range_generator from below step =
let counter = ref from
in fun () ->
if (!counter < below)
then (let result = (Some !counter) in
counter := !counter + step;
result)
else None
For example, a call to range_generator 0 10 2 returns a closure over an internal counter mutable variable which generates all natural even numbers below 10:
# let gen = range_generator 0 10 2;;
val gen : unit -> int option = <fun>
Each call to gen possibly mutates the internal counter:
# gen();;
- : int option = Some 0
# gen();;
- : int option = Some 2
# gen();;
- : int option = Some 4
# gen();;
- : int option = Some 6
# gen();;
- : int option = Some 8
# gen();;
- : int option = None
# gen();;
- : int option = None
With your function:
# from_fun (range_generator 0 5 1);;
- : int list = [0; 1; 2; 3; 4]
The variable x you are using is local to the anonymous function you are using. As a result the function always return Some 1.
What you probably wanted to do is for the function to take an argument:
let rec from_fun f n =
match f n with
| None -> Nil
| Some e -> Cons(e, from_fun f e)
let seq = from_fun (fun x -> if x<10 then Some (x+1) else None) 0
EDIT:
Here is a solution with the appropriate type signature:
let rec from_fun f () =
match f () with
| None -> Nil
| Some e -> Cons(e, from_fun f ())
let x = ref 0
let seq = from_fun
(fun () ->
let v = !x in
if v < 10
then begin
x := v + 1;
Some v
end
else None)
()
It is worth noting that because of the side effects, you would have to reinitialise x before building a new sequence. The unit argument passed in parameter to from_fun is unnecessary, you could remove it.

Memoization list Ocaml

I have a recursive function and I want the rewriting in the Mémoïsant
My recursive function:
let rec sum_cube l =
match l with
| [] -> 0
| x :: s -> (x * x * x) + sum_cube s
and I tried with this:
let memo = Hashtbl.create 17
let rec sum_cub_memo l =
try
Hashtbl.find memo l
with Not_found ->
let fn = function
| [] -> 0
| x::s -> (x * x * x ) sum_cub_memo s
in
Hashtbl.add memo l fn
fn ;;
I have an error:
This expression has type int list -> int but an expression was expected of type int list!!
You should memoize not the function, but the result of the function, e.g., using your definition of sum_cube:
let sum_cube_memo xs =
try Hashtbl.find memo xs with Not_found ->
let res = sum_cube xs in
Hashtbl.add memo xs res;
res
This will work, however there is a caveat. You're using a list of integers as a key. That means, that first the key is transformed to its hash (basically O(n), and will take basically the same amount of time as computing the power of three), second, if there is a hash collision, then every list in the bucket will be compared with the argument list. As a result, your memoized function has the same complexity as your non-memoized function, it has worse performance, and also consumes unbound amount of memory. Is it worthwhile?
sum_cube without memorization.
let sum_cube l =
let cube x =x*x*x in
List.fold_left ( fun acc x -> acc+cube x) 0 l
sum_cube with memorization and trace.
let sum_cube l =
let memo = Hashtbl.create 17 in
let cube_memo x =
try
let xcube= Hashtbl.find memo x in
Printf.printf "find %d -> %d\n" x xcube;
xcube
with Not_found ->
let xcube=x*x*x in
Printf.printf "add %d -> %d\n" x xcube;
Hashtbl.add memo x xcube;
xcube
in
List.fold_left ( fun acc x -> acc+cube_memo x) 0 l
Test :
# sum_cube [4;4;2;3;4;2];;
add 4 -> 64
find 4 -> 64
add 2 -> 8
add 3 -> 27
find 4 -> 64
find 2 -> 8
- : int = 235

Expecting type unit in OCaml

I want to print the numbers that are not in the hashtable, in this case 1, 3 and 5. I'am getting the following error:
This expression has type int but an expression was expected of type
unit
Why does it expect type unit?
let l = [1; 2; 3; 4; 5];;
let ht = Hashtbl.create 2;;
Hashtbl.add ht 0 2;;
Hashtbl.add ht 1 4;
let n = List.iter (fun a -> if Hashtbl.mem ht a then -1 else a) l in
if n > 0 then print_int a;;
With the line List.iter (fun a -> if Hashtbl.mem ht a then -1 else a) l you call a function for every element in a list.
This function has to have type unit, because it wouldn't make sense to assign the results of n function applications to anything.
What you may want is
let l = [1; 2; 3; 4; 5];;
let ht = Hashtbl.create 2;;
Hashtbl.add ht 0 2;;
Hashtbl.add ht 1 4;
List.iter (fun a -> if not (Hashtbl.mem ht a) then (print_int a; print_newline ())) l
In this solution, you call the print-function for every variable. The expression "print_int (-1)" is again a unit-type (like described above).

Ocaml nested functions

Can someone explain the syntax used for when you have nested functions?
For example I have a outer and an inner recursive function.
let rec func1 list = match list with
[] -> []
|(head::tail) ->
let rec func2 list2 = match list2 with
...
;;
I have spent all day trying to figure this out and I'm getting a ever tiring "Syntax error".
You don't show enough code for the error to be obvious.
Here is a working example:
# let f x =
let g y = y * 5 in
g (x + 1);;
val f : int -> int = <fun>
# f 14;;
- : int = 75
Update
Something that might help until you're used to OCaml syntax is to use lots of extra parentheses:
let rec f y x =
match x with
| h :: t -> (
let incr v = if h = y then 1 + v else v in
incr (f y t)
)
| _ -> (
0
)
It's particularly hard to nest one match inside another without doing this sort of thing. This may be your actual problem rather than nested functions.

Parallel processing in F#

I'm playing around with async in F#. Does this look right, or am I mangling things?
let time f =
let before = System.DateTime.Now
f () |> ignore
let after = System.DateTime.Now
after - before;;
let rec fib = function 0 | 1 -> 1
| n -> fib (n - 1) + fib (n - 2);;
let source = [45; 40; 45; 40]
let synchronous = time <| fun () -> List.map fib source
let para = time <| fun () -> source
|> List.map (fun n -> async {ignore <| fib n})
|> Async.Parallel
|> Async.RunSynchronously
In particular, how do I return results from an async block? Do I have to use mutable state?
Update: here's another approach:
#r "FSharp.PowerPack.Parallel.Seq.dll"
open Microsoft.FSharp.Collections
let pseq = time <| fun () -> source
|> PSeq.map fib
|> PSeq.toList
Firstly, it's a bit of an anti-pattern to use async for parallel CPU processing. See these questions and answers for more information:
Why shouldn't I use F# asynchronous workflows for parallelism?
Task Parallel Library vs Async Workflows
Secondly, your fib function should be re-written to be tail recursive, here's an example from here (including changing to BigInt):
let fib n =
let rec loop acc1 acc2 = function
| n when n = 0I -> acc1
| n -> loop acc2 (acc1 + acc2) (n - 1I)
loop 0I 1I n
Finally, the full code:
let source = [| 45I; 40I; 45I; 40I |]
let sync = time <| fun () -> Array.map fib source
let para = time <| fun () -> Array.Parallel.map fib source
Note that in both cases an Array of the results is returned, you're just throwing it away in your time function. How about a time function that returns both the time and the result?
let time f =
let watch = new System.Diagnostics.Stopwatch()
watch.Start()
let res = f ()
watch.Stop()
(res, watch.ElapsedMilliseconds)
Usage remains the same, but now showing results:
printfn "Sync: %A in %ims" (fst sync) (snd sync)
printfn "Para: %A in %ims" (fst para) (snd para)