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
Related
We can create function that take n elements from a list, and drop n elements from a list, as the following:
let rec take n l =
if n = 0 then [] else
match l with
h::t -> h::take(n-1) t
Similarily,
let rec drop n l =
if n = 0 then l else
match l with
h::t -> drop(n-1) t
But how do we combine take and drop function such that it returns a pair with the result of dropping n elements and adding n elements from a list l?
let rec add_drop n l =
if n = 0 then ([],l) else
match l with
h::t -> let (a,b) = add_drop (n-1) t in
(h::a, b)
This is also available in ocaml-containers as take_drop:
val take_drop : int -> 'a t -> 'a t * 'a t
And in Jane Street's Base as split_n
val split_n : 'a t -> int -> 'a t * 'a t
I'd use a tail-recursive approach, with a helper function that builds up the first N elements in an extra argument, originally in reverse order, and then reversing that list before returning it. That way it takes the same stack space no matter how big N is.
let split n lst =
let rec helper n lst head =
if n = 0 then
head, lst
else
match lst with
| car :: cdr -> helper (n - 1) cdr (car :: head)
| [] -> head, [] (* List is shorter than n *) in
let head, tail = helper n lst [] in
List.rev head, tail
What is the right way to append items to a list inside a recursive function?
let () =
let rec main m l acc =
if (acc = 3) then
acc
else
if (m = 1) then
l := 1 :: !l
main (m - 1) l
else if (m = 2) then
l := 2 :: !l
main (m - 1) l
else
l := m :: !l
main (m - 1) l
in l = ref []
let main 10 l 0
List.iter (fun l -> List.iter print_int l) l
another Example:
let () =
let rec main m =
if (m = 3) then m
else
l := m :: !l;
main (m + 1) l
in l = ref []
let main 0 l
List.iter (fun l -> List.iter print_int l) l
I want to append a value to a list inside a function and then print the elements of the list.
If you want to print [1;2;...;10]:
let () =
let rec main m l =
if (m = 0) then
!l
else begin
l := m :: !l;
main (m - 1) l
end
in
let l = ref [] in
List.iter print_int (main 10 l); print_newline();;
or better without ref
let () =
let rec main m l =
if (m = 0) then
l
else
main (m - 1) (m::l)
in
List.iter print_int (main 10 []); print_newline();;
but I am not sure of what you want to do...
What you mean by "the right way" is not quite clear. The functional "right way" would be not to use references. The efficiency "right way" would be to prepend rather than to append.
Another direct way to build a list inspired from user4624500's answer could be:
let rec f = function
| 0 -> [0]
| n -> n :: f (n-1)
(note: that's not tail recursive, and would uglily fail with negative numbers...)
Then the following expression calls the previous function to build the list and then print the result (adding newlines for readability purposes):
let my_list = f 10 in
List.iter (fun n -> print_int n; print_newline ()) my_list
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 have some problems with recursion in Lazy Computations. I need calculation the square root by Newton Raphson method. I do not know how to apply a lazy evaluation. This is my code:
let next x z = ((x + z / x) / 2.);
let rec iterate f x =
List.Cons(x, (iterate f (f x)));
let rec within eps list =
let a = float (List.head list);
let b = float (List.head (List.tail list));
let rest = (List.tail (List.tail (list)));
if (abs(a - b) <= eps * abs(b))
then b
else within eps (List.tail (list));
let lazySqrt a0 eps z =
within eps (iterate (next z) a0);
let result2 = lazySqrt 10. Eps fvalue;
printfn "lazy approach";
printfn "result: %f" result2;
Of course, stack overflow exception.
You're using F# lists which has eager evaluation. In your example, you need lazy evaluation and decomposing lists, so F# PowerPack's LazyList is appropriate to use:
let next z x = (x + z / x) / 2.
let rec iterate f x =
LazyList.consDelayed x (fun () -> iterate f (f x))
let rec within eps list =
match list with
| LazyList.Cons(a, LazyList.Cons(b, rest)) when abs(a - b) <= eps * abs(b) -> b
| LazyList.Cons(a, res) -> within eps res
| LazyList.Nil -> failwith "Unexpected pattern"
let lazySqrt a0 eps z =
within eps (iterate (next z) a0)
let result2 = lazySqrt 10. Eps fvalue
printfn "lazy approach"
printfn "result: %f" result2
Notice that I use pattern matching which is more idiomatic than head and tail.
If you don't mind a slightly different approach, Seq.unfold is natural here:
let next z x = (x + z / x) / 2.
let lazySqrt a0 eps z =
a0
|> Seq.unfold (fun a ->
let b = next z a
if abs(a - b) <= eps * abs(b) then None else Some(a, b))
|> Seq.fold (fun _ x -> x) a0
If you need lazy computations, then you have to use appropriate tools. List is not lazy, it is computed to the end. Your iterate function never ends, so the entire code stack overflows in this function.
You may use Seq here.
Note: Seq.skip almost inevitably leads you to an O(N^2) complexity.
let next N x = ((x + N / x) / 2.);
let rec iterate f x = seq {
yield x
yield! iterate f (f x)
}
let rec within eps list =
let a = Seq.head list
let b = list |> Seq.skip 1 |> Seq.head
if (abs(a - b) <= eps * abs(b))
then b
else list |> Seq.skip 1 |> within eps
let lazySqrt a0 eps z =
within eps (iterate (next z) a0);
let result2 = lazySqrt 10. 0.0001 42.;
printfn "lazy approach";
printfn "result: %f" result2;
// 6.4807406986501
Yet another approach is to use LazyList from F# PowerPack. The code is available in this article. Copying it to my answer for sake of integrity:
open Microsoft.FSharp.Collections.LazyList
let next N (x:float) = (x + N/x) / 2.0
let rec repeat f a =
LazyList.consDelayed a (fun() -> repeat f (f a))
let rec within (eps : float) = function
| LazyList.Cons(a, LazyList.Cons(b, rest)) when (abs (a - b)) <= eps -> b
| x -> within eps (LazyList.tail x)
let newton_square a0 eps N = within eps (repeat (next N) a0)
printfn "%A" (newton_square 16.0 0.001 16.0)
Some minor notes:
Your next function is wrong;
The meaning of eps is relative accuracy while in most academic books I've seen an absolute accuracy. The difference between the two is whether or not it's measured against b, here: <= eps * abs(b). The code from FPish treats eps as an absolute accuracy.
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 []