I'm trying to convert different function from tail recursive to cps (continuation passing style).
I managed to do a sum and factorial function:
Sum function:
Tail recursive:
let sum n =
let rec subSum n acc =
match n with
|0 -> acc
|_ -> subSum (n-1) (n+acc)
in subSum n 0;;
Printf.printf "%u\n" (sum 5);; (*returns 15*)
cps version:
let sum2 n =
let rec sum_cps n acc =
match n with
|0 -> acc 0
|_ -> sum_cps (n-1) (fun r -> acc (n+r))
in sum_cps n (fun n -> n);;
Printf.printf "%u\n" (sum2 5);; (*returns 15*)
factorial (same style as sum):
tail recursive:
let fact n =
let rec subFact n acc =
match n with
|0 -> acc
|1 -> acc
|_ -> subFact (n-1) (n*acc)
in subFact n 1;;
Printf.printf "%u\n" (fact 6);; (*returns 720*)
cps version:
let fact2 n =
let rec fact_cps n acc =
match n with
|0 -> acc 1
|1 -> acc 1
|_ -> fact_cps (n-1) (fun r -> acc (n*r))
in fact_cps n (fun n -> n);;
Printf.printf "%u\n" (fact2 6);; (*returns 720*)
However, in fibonacci, there is another argument in addition to the accumulator and that disturbs me a little bit:
tail recursive version:
let fibo n =
let rec fibon n acc prev =
match n with
|0 -> acc
|_ -> fibon (n-1) (prev+acc) acc
in fibon n 0 1;;
Printf.printf "%u\n" (fibo 6);; (*returns 8*)
cps attempt (not working):
let fibo n =
let rec fibo_cps n acc prev =
match n with
|0 -> 0
|_ -> fibo_cps (n-1) (fun r -> acc (prev+r)) acc
in fibo_cps n (fun n -> n) 1;;
explainations of the problem:
problematic line (according to the interpretor):
|_ -> fibo_cps (n-1) (fun r -> acc (prev+r)) acc
error message:
Line 5, characters 49-52: Error: This expression has type int -> 'a but an expression was expected of type int
I would just like to understand how to make a working cps version of fibonacci.
I think this is what you're looking for -
let fibo n =
let rec fibo_cps n acc =
match n with
|0 -> acc 0
|1 -> acc 1
|_ -> fibo_cps (n-1) (fun x -> fibo_cps (n-2) (fun y -> acc (x+y)))
in fibo_cps n (fun x -> x)
Please note that while the computation above is tail-recursive, it's still a very inefficient way to compute fibonacci numbers. Consider a linear iterative algorithm -
let fibo2 n =
let rec aux n a b =
match n with
|0 -> a
|_ -> aux (n-1) b (a+b)
in aux n 0 1
A direct translation of the tail-recursive version to cps-style would be
let rec fib_cps n k =
if n <= 1 then k
else fib_cps (n-1) (fun (prev,n) -> k (n, prev+n))
let fib n = snd ## fib_cps n Fun.id (0,1)
Related
I have this quite simple function which takes an int and adds it to the head of the list and is recursively called with i multiplied with itself:
let rec f i = function
| [] -> []
| x::xs -> (x+i)::f (i*i) xs
f 2 [1;2;3]
val it : int list = [3; 6; 19]
Now, I'm attempting to rewrite it using a continuation, but I'm a little stuck. Here's what I've come up with so far:
let fC i l =
let rec loop cont = function
| [] -> []
| x::xs -> cont(x+i)::loop (fun acc -> (acc*acc)) xs
loop id l
fC 2 [1;2;3] //Expected [3;6;19]
val it : int list = [3; 16; 25]
Any hints to what I'm doing wrong?
Looking at this questions and the comments it seems to me that there is some confusion.
Tail recursive does not necessary mean continuation passing style (CPS).
Here's the function in CPS:
let f' i p =
let rec loop i p k =
match p with
| [] -> k []
| x::xs -> loop (i*i) xs (fun a -> k ((x+i)::a))
loop i p id
And of course, it's tail recursive. But you can also write it tail recursive by using an accumulator instead of a continuation:
let f'' i p =
let rec loop i p acc =
match p with
| [] -> acc
| x::xs -> loop (i*i) xs ((x+i)::acc)
loop i p [] |> List.rev
See also the answer to this question to understand better CPS.
I'm trying to write a function that would take an input like :
repeat 3 [1;2] ;;
and display something like:
[1;2;1;2;1;2]
Now the code I have is:
let repeat ls n =
let rec helper acc n l =
if n = 0 then acc else helper (l :: acc) (n-1) l in
let rec helper2 acc = function
| [] -> acc
| h :: t -> helper2 (helper acc n h) t in helper2 [] (List.rev ls);;
which gives me an output of:
[1;1;1;2;2;2]
for the same input. What can I do to fix this?
You are almost at the end ;)
Just modify the first helper :
let rec helper acc n l =
if n = 0 then acc else helper (l # acc) (n-1) l ;;
And you will be close to the solution.
(you just want to replicate the input list so # is ok to concatenate this list to the acc, you do not want to parse each and every element of the list, so :: is not what you need)
I think this solution may be a little bit faster in term of complexity (and simplicity):
let repeat ls n =
let rec f l = function
| 0 -> l
| n -> f (List.rev_append ls l) (n-1) in
List.rev (f [] n)
Also I always forget if List.rev is a tail-recursive or not, so this may be even better:
let repeat ls n =
let rec rev l = function
| [] -> l
| a::t -> rev (a::l) t in
let rec f l = function
| 0 -> l
| n -> f (List.rev_append ls l) (n-1) in
rev [] (f [] n)
Note: in my opinion Pierre's answer is good enough, my post is more like remark.
I am trying to get first and last element of the list in OCaml. I expect that my function will be like
'a list -> 'a * 'a
What I am trying to do is
let lista = [1;2;3;4;6;0];;
let rec first_last myList =
match myList with
[x] -> (List.hd lista,x)
| head::tail ->
first_last tail;;
first_last lista;;
Of course because of I made list as integer then I am doing this syntax like
*int list -> int * 'a
The point is that I dont have idea how to do this function for 'a.
Whats the direction?
The direction is to write two different functions first and last and implement the first_and_last function as:
let first_and_last xs = first xs, last xs
Another possibility with only one function:
let rec first_last = function
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You may prefer it like that:
let rec first_last myList = match myList with
| [] -> failwith "too bad"
| [e] -> failwith "too bad"
| [e1;e2] -> (e1,e2)
| e1 :: _ :: r -> first_last (e1::r)
You can create two separate functions to return first element and last element, and then in your first_and_last function return a tuple (first_element, last_element).
let rec first_element list =
match list with
| [] -> failwith "List is empty"
| first_el::rest_of_list -> first_el
let rec last_element list =
match list with
| [] -> failwith "List is empty"
| [x] -> x
| first_el::rest_of_list -> last_element rest_of_list
You can create a helper function that has a base-case of the empty-list - for which it returns itself, and otherwise checks if the next recursive call will return an empty list. If it does, return the current element (which is by definition the last element in the list), and if it doesn't, return what was returned by the recursive call.
For the regular (non-helper) method, if the list is at least one element long (i.e. hd::tl = hd::[]) then you can just concatenate the list you got from the last function onto the head from ls.
It can be implemented as follow:
let rec last ls =
match ls with
| [] -> []
| hd::tl -> let next = last tl in
if next = [] then [hd]
else next
;;
let first_last ls =
match ls with
| [] -> failwith "Oh no!!!!! Empty list!"
| hd::tl -> hd::last tl
;;
Yet another take on this problem.
let first_last xs =
let rec last_non_empty = function
| [x] -> x
| _ :: xs' -> last_non_empty xs'
| [] -> failwith "first_last: impossible case!"
in
match xs with
| [] -> failwith "first_last"
| x::_ -> (x, last_non_empty xs)
Some properties of this implementation:
(1) it meets the specification 'a list -> 'a * 'a:
utop > #typeof "first_last";;
val first_last : 'a list -> 'a * 'a
(2) it works for singleton lists: first_last [x] = (x,x):
utop> first_last [1];;
- : int * int = (1, 1) utop> first_last ["str"];;
- : bytes * bytes = ("str", "str")
(3) it's tail-recursive (hence it won't cause stack overflow for sufficiently big lists):
utop > first_last (Array.to_list (Array.init 1000000 (fun x -> x+1)));;
- : int * int = (1, 1000000)
(4) it traverses the input list one time only; (5) it avoids creating new lists as it goes down the recursive ladder; (6) it avoids polluting the namespace (with the price of not allowing the reuse of a function like last).
And another rather simple variant, from the first principles (I was trying to illustrate "wishful thinking" in the spirit of the SICP book):
(* Not tail-recursive, might result in stack overflow *)
let rec first_last = function
| [] -> failwith "first_last"
| [x] -> (x,x)
| x :: xs -> (x, snd (first_last xs))
You could write it like this:
let first_last = function
| [] -> assert false
| x :: xs -> (x, List.fold_left (fun _ y -> y) x xs)
Or, if you are using the Base library, you could write in this way:
let first_last xs = (List.hd_exn xs, List.reduce_exn ~f:(fun _ y -> y) xs)
The basic idea is that List.fold_left (fun _ y -> y) x xs will compute the last element of x :: xs. You can prove this by induction on xs: if xs = [] then List.fold_left (fun _ y -> y) x [] = x, which is the last element of x :: []; moreover, if xs = x' :: xs' then List.fold_left (fun _ y -> y) x (x' :: xs') can be rewritten as List.fold_left (fun _ y -> y) x' xs', because List.fold_left f acc (x :: xs) = List.fold_left (f acc x) xs, hence we are finished, because this is the last element of x' :: xs' by our induction hypothesis.
I implemented a non-in-place version of selection sort in OCaml.
let sort compare_fun l =
let rec find_min l' min_l origin_l =
match l' with
| [] ->
if min_l = [] then (min_l, l')
else
let min = List.hd min_l
in
(min_l, List.filter (fun x -> if x != min then true else false) origin_l)
| x::tl ->
if min_l = [] then
find_min tl [x] origin_l
else
let c = compare_fun (List.hd min_l) x
in
if c = 1 then
find_min tl [x] origin_l
else if c = 0 then
find_min tl (min_l # [x]) origin_l
else
find_min tl min_l origin_l
in
let rec insert_min l' new_l =
match l' with
| [] -> new_l
| _ ->
let (min_l, rest) = find_min l' [] l'
in
insert_min rest (new_l # min_l)
in
insert_min l [];;
My idea is that in a list, every time I find the list of minimum items (in case of duplicate values) and add this min list to the result list, then redo the finding_min in the rest of the list.
I use List.filter to filter out the min_list, so the resulting list will be the list for next find_min.
I find my implementation is quite complicated, and far more complicated than the Java in-place version of selection sort.
Any suggestions to improve it?
Edit: Here's a much better implementation: http://rosettacode.org/wiki/Sorting_algorithms/Selection_sort#OCaml
here's my own crappier implementation
(* partial function - bad habit, don't do this. *)
let smallest (x::xs) = List.fold_right (fun e acc -> min e acc) xs x
let remove l y =
let rec loop acc = function
| [] -> raise Not_found
| x::xs -> if y = x then (List.rev acc) # xs else loop (x::acc) xs
in loop [] l
let selection_sort =
let rec loop acc = function
| [] -> List.rev acc
| xs ->
let small = smallest xs in
let rest = remove xs small in
loop (small::acc) rest
in loop []
This is actually a solution to Project Euler Problem 14 in F#. However, I'm running into a System.OutOfMemory exception when attempting to calculate an iterative sequence for larger numbers. As you can see, I'm writing my recursive function with tail calls.
I was running into a problem with StackOverFlowException because I was debugging in visual studio (which disables the tail calls). I've documented that in another question. Here, I'm running in release mode--but I'm getting out of memory exceptions when I run this as a console app (on windows xp with 4gb ram).
I'm really at a loss to understand how I coded myself into this memory overflow & hoping someone can show my the error in my ways.
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1 -> List.rev (d::acc)
| e when e%2 = 0 -> calc (e::acc) (e/2)
| _ -> calc (startNum::acc) (startNum * 3 + 1)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2..99999]
|> List.map (fun n -> (n,(calc [] n)))
|> List.map (fun pair -> ((fst pair), (List.length (snd pair))))
|> maxNum
|> (fun x-> Console.WriteLine(x))
EDIT
Given the suggestions via the answers, I rewrote to use a lazy list and also to use Int64's.
#r "FSharp.PowerPack.dll"
let E14_interativeSequence =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc) |> List.toSeq
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum (lazyPairs:LazyList<System.Int64*System.Int64>) =
let rec maxPairInternal acc (pairs:seq<System.Int64*System.Int64>) =
match pairs with
| :? LazyList<System.Int64*System.Int64> as p ->
match p with
| LazyList.Cons(x,xs)-> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
| _ -> acc
| _ -> failwith("not a lazylist of pairs")
maxPairInternal (0L,0L) lazyPairs
|> fst
{2L..999999L}
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.map (fun pair -> ((fst pair), (Convert.ToInt64(Seq.length (snd pair)))))
|> LazyList.ofSeq
|> maxNum
which solves the problem. I'd also look at Yin Zhu's solution which is better, though.
As mentioned by Brian, List.* operations are not appropriate here. They cost too much memory.
The stackoverflow problem comes from another place. There are two possible for you to have stackoverflow: calc and maxPairInternal. It must be the first as the second has the same depth as the first. Then the problem comes to the numbers, the number in 3n+1 problem could easily go to very large. So you first get a int32 overflow, then you get a stackoverflow. That's the reason. After changing the numbers to 64bit, the program works.
Here is my solution page, where you can see a memoization trick.
open System
let E14_interativeSequence x =
let rec calc acc startNum =
match startNum with
| d when d = 1L -> List.rev (d::acc)
| e when e%2L = 0L -> calc (e::acc) (e/2L)
| _ -> calc (startNum::acc) (startNum * 3L + 1L)
let maxNum pl=
let rec maxPairInternal acc pairList =
match pairList with
| [] -> acc
| x::xs -> if (snd x) > (snd acc) then maxPairInternal x xs
else maxPairInternal acc xs
maxPairInternal (0L,0) pl
|> fst
// if I lower this to like [2..99999] it will work.
[2L..1000000L]
|> Seq.map (fun n -> (n,(calc [] n)))
|> Seq.maxBy (fun (n, lst) -> List.length lst)
|> (fun x-> Console.WriteLine(x))
If you change List.map to Seq.map (and re-work maxPairInternal to iterate over a seq) that will probably help tons. Right now, you're manifesting all the data at once in a giant structure before processing the whole structure to get a single number result. It is much better to do this lazily via Seq, and just create one row, and compare it with the next row, and create a single row at a time and then discard it.
I don't have time to code my suggestion now, but let me know if you are still having trouble and I'll revisit this.
Stop trying to use lists everywhere, this isn't Haskell! And stop writing fst pair and snd pair everywhere, this isn't Lisp!
If you want a simple solution in F# you can do it directly like this without creating any intermediate data structures:
let rec f = function
| 1L -> 0
| n when n % 2L = 0L -> 1 + f(n / 2L)
| n -> 1 + f(3L * n + 1L)
let rec g (li, i) = function
| 1L -> i
| n -> g (max (li, i) (f n, n)) (n - 1L)
let euler14 n = g (0, 1L) n
That takes around 15s on my netbook. If you want something more time efficient, reuse previous results via an array:
let rec inside (a : _ array) n =
if n <= 1L || a.[int n] > 0s then a.[int n] else
let p =
if n &&& 1L = 0L then inside a (n >>> 1) else
let n = 3L*n + 1L
if n < int64 a.Length then inside a n else outside a n
a.[int n] <- 1s + p
1s + p
and outside (a : _ array) n =
let n = if n &&& 1L = 0L then n >>> 1 else 3L*n + 1L
1s + if n < int64 a.Length then inside a n else outside a n
let euler14 n =
let a = Array.create (n+1) 0s
let a = Array.Parallel.init (n+1) (fun n -> inside a (int64 n))
let i = Array.findIndex (Array.reduce max a |> (=)) a
i, a.[i]
That takes around 0.2s on my netbook.
Found this looking for Microsoft.FSharp.Core.Operators.Checked.
I'm just learning F#, so I thought I'd take the Project Euler 14 Challenge.
This uses recursion but not tail-recursion.
Takes about 3.1 sec for me, but has the advantage that I can almost understand it.
let Collatz (n:int64) = if n % 2L = 0L then n / 2L else n * 3L + 1L
let rec CollatzLength (current:int64) (acc:int) =
match current with
| 1L -> acc
| _ -> CollatzLength (Collatz current) (acc + 1)
let collatzSeq (max:int64) =
seq{
for i in 1L..max do
yield i, CollatzLength i 0
}
let collatz = Seq.toList(collatzSeq 1000000L)
let result, steps = List.maxBy snd collatz