Closed. This question needs to be more focused. It is not currently accepting answers.
Want to improve this question? Update the question so it focuses on one problem only by editing this post.
Closed 8 years ago.
Improve this question
I am trying to find all permutations where n balls are spread into m buckets. I am approaching it through recursion but I am confused on what I should recurse n on since n could decrease by any numbers... (I am recursing on m-1) Any thoughts on how to do this with a functional language approach?
There's a solution in C++ but I don't understand C++.
List of combinations of N balls in M boxes in C++
There is no need to generate redundant results. The following code is a bit ugly, but it does the job :
let ( <|> ) s e =
let rec aux s e res =
if e - s < 0 then res
else aux (s + 1) e (s :: res) in
List.rev (aux s e [])
let rec generate n m =
let prepend_x l x = List.map (fun u -> x::u) l in
if m = 1 then [[n]]
else
let l = List.map (fun p -> prepend_x (generate (n - p) (m - 1)) p) (0 <|> n) in
List.concat l
The idea is simply that you want all lists of the form p::u with u in generate (n - p) (m - 1), with p ranging over 0..n
let flatten_tail l =
let rec flat acc = function
| [] -> List.rev acc
| hd::tl -> flat (List.rev_append hd acc) tl
in
flat [] l
let concat_map_tail f l =
List.rev_map f l |> List.rev |> flatten_tail
let rm_dup l =
if List.length l = 0 then l
else
let sl = List.sort compare l in
List.fold_left (
fun (acc, e) x -> if x <> e then x::acc, x else acc,e
) ([List.hd sl], List.hd sl) (List.tl sl) |> fst |> List.rev
(* algorithm starts from here *)
let buckets m =
let rec generate acc m =
if m = 0 then acc
else generate (0::acc) (m-1)
in
generate [] m
let throw_1_ball bs =
let rec throw acc before = function
| [] -> acc
| b::tl ->
let new_before = b::before in
let new_acc = (List.rev_append before ((b+1)::tl))::acc in
throw new_acc new_before tl
in
throw [] [] bs
let throw_n_ball n m =
let bs = buckets m in
let rec throw i acc =
if i = 0 then acc
else throw (i-1) (concat_map_tail throw_1_ball acc |> rm_dup)
in
throw n [bs]
Above is the correct code, it is scary because I added several utility functions and make things as tail-recursive as possible. But the idea is very simple.
Here is the algorithm:
Let's say we have 3 buckets, initially it is [0;0;0].
If we throw 1 ball into the 3 buckets, we have 3 cases each of which
is a snapshot of the buckets, i.e., [[1;0;0];[0;1;0];[0;0;1]].
Then if we have 1 more ball, for each case above, we will 3 cases,
so the resulting case list have 9 cases
Then if we have 1 more ball, .....
In this way, we will generate 3^n cases and many of them may be redundant.
So when generated each case list, we just remove all duplicates in the case list.
utop # throw_n_ball 3 2;;
- : int list list = [[0; 3]; [1; 2]; [2; 1]; [3; 0]]
utop # throw_n_ball 5 3;;
- : int list list = [[0; 0; 5]; [0; 1; 4]; [0; 2; 3]; [0; 3; 2]; [0; 4; 1]; [0; 5; 0]; [1; 0; 4];[1; 1; 3]; [1; 2; 2]; [1; 3; 1]; [1; 4; 0]; [2; 0; 3]; [2; 1; 2]; [2; 2; 1]; [2; 3; 0]; [3; 0; 2]; [3; 1; 1]; [3; 2; 0]; [4; 0; 1]; [4; 1; 0]; [5; 0; 0]]
Related
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 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 have to do projection of a list of lists which returns all combinations with each element from each list. For example:
projection([[1]; [2; 3]]) = [[1; 2]; [1; 3]].
projection([[1]; [2; 3]; [4; 5]]) = [[1; 2; 4]; [1; 2; 5]; [1; 3; 4]; [1; 3; 5]].
I come up with a function:
let projection lss0 =
let rec projectionUtil lss accs =
match lss with
| [] -> accs
| ls::lss' -> projectionUtil lss' (List.fold (fun accs' l ->
accs' # List.map (fun acc -> acc # [l]) accs)
[] ls)
match lss0 with
| [] -> []
| ls::lss' ->
projectionUtil lss' (List.map (fun l -> [l]) ls)
and a testcase:
#time "on";;
let N = 10
let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i));;
let fss1 = projection fss0;;
The function is quite slow now, with N = 10 it takes more than 10 seconds to complete. Moreover, I think the solution is unnatural because I have to breakdown the same list in two different ways. Any suggestion how I can improve performance and readability of the function?
First of all, try to avoid list concatenation (#) whenever possible, since it's O(N) instead of O(1) prepend.
I'd start with a (relatively) easy to follow plan of how to compute the cartesian outer product of lists.
Prepend each element of the first list to each sublist in the cartesian product of the remaining lists.
Take care of the base case.
First version:
let rec cartesian = function
| [] -> [[]]
| L::Ls -> [for C in cartesian Ls do yield! [for x in L do yield x::C]]
This is the direct translation of the sentences above to code.
Now speed this up: instead of list comprehensions, use list concatenations and maps:
let rec cartesian2 = function
| [] -> [[]]
| L::Ls -> cartesian2 Ls |> List.collect (fun C -> L |> List.map (fun x->x::C))
This can be made faster still by computing the lists on demand via a sequence:
let rec cartesian3 = function
| [] -> Seq.singleton []
| L::Ls -> cartesian3 Ls |> Seq.collect (fun C -> L |> Seq.map (fun x->x::C))
This last form is what I use myself, since I most often just need to iterate over the results instead of having them all at once.
Some benchmarks on my machine:
Test code:
let test f N =
let fss0 = List.init N (fun i -> List.init (i+1) (fun j -> j+i*i+i))
f fss0 |> Seq.length
Results in FSI:
> test projection 10;;
Real: 00:00:18.066, CPU: 00:00:18.062, GC gen0: 168, gen1: 157, gen2: 7
val it : int = 3628800
> test cartesian 10;;
Real: 00:00:19.822, CPU: 00:00:19.828, GC gen0: 244, gen1: 121, gen2: 3
val it : int = 3628800
> test cartesian2 10;;
Real: 00:00:09.247, CPU: 00:00:09.250, GC gen0: 94, gen1: 52, gen2: 2
val it : int = 3628800
> test cartesian3 10;;
Real: 00:00:04.254, CPU: 00:00:04.250, GC gen0: 359, gen1: 1, gen2: 0
val it : int = 3628800
This function is Haskell's sequence (although sequence is more generic). Translating to F#:
let sequence lss =
let k l ls = [ for x in l do for xs in ls -> x::xs ]
List.foldBack k lss [[]]
in interactive:
> test projection 10;;
Real: 00:00:12.240, CPU: 00:00:12.807, GC gen0: 163, gen1: 155, gen2: 4
val it : int = 3628800
> test sequence 10;;
Real: 00:00:06.038, CPU: 00:00:06.021, GC gen0: 75, gen1: 74, gen2: 0
val it : int = 3628800
General idea: avoid explicit recursion in favor to standard combinators (fold, map etc.)
Here's a tail-recursive version. It's not as fast as some of the other solutions (only 25% faster than your original function), but memory usage is constant, so it works for extremely large result sets.
let cartesian l =
let rec aux f = function
| [] -> f (Seq.singleton [])
| h::t -> aux (fun acc -> f (Seq.collect (fun x -> (Seq.map (fun y -> y::x) h)) acc)) t
aux id l
You implementation is slow because of the # (i.e List concat) operation, which is a slow operation and it is being done many a times in recursive way. The reason for # being slow is that List are Linked list in functional programming and to concat 2 list you have to first go till the end of the list (one by one traversing through elements) and then append another list .
Please look at the suggested references in comments. I hope those will help you out.
The following version is even faster than cartesian3, and uses basic features of functional programming (no fancy List.collect, Seq.collect...)
let cartesian xss =
let rec add x yss s =
match yss with
| [] -> s
| ys :: yss' -> add x yss' ((x :: ys) :: s)
let rec mul xs yss p =
match xs with
| [] -> p
| x :: xs' -> mul xs' yss (add x yss p)
let rec cartesian xss c =
match xss with
| [] -> c
| xs :: xss' -> cartesian xss' (mul xs c [])
cartesian xss [ [] ]
Results
> test cartesian3 10;;
Real: 00:00:04.132, CPU: 00:00:04.109, GC Gen0: 482, Gen1: 2, Gen2: 1
val it: int = 3628800
> test cartesian 10;;
Real: 00:00:01.414, CPU: 00:00:01.406, GC Gen0: 27, Gen1: 16, Gen2: 2
val it: int = 3628800
> test cartesian3 11;;
Real: 00:00:45.652, CPU: 00:00:45.281, GC Gen0: 5299, Gen1: 5, Gen2: 1
val it: int = 39916800
> test cartesian 11;;
Real: 00:00:17.242, CPU: 00:00:16.812, GC Gen0: 260, Gen1: 174, Gen2: 6
val it: int = 39916800
The partition strategy used here is naive: the input list xss is separated into head and tail, I believe that a smarter strategy can give much better performance.
Edit: Another solution is of Christopher Strachey, which is explained in [1] (the observation is that the recursion on list can be expressed by folding):
let cartesianf xss =
let f xs yss =
let h x ys uss = (x :: ys) :: uss
let g yss x zss = List.foldBack (h x) yss zss
List.foldBack (g yss) xs []
List.foldBack f xss [ [] ]
[1] Mike Spivey. Strachey's function pearl, forty years on.
let crossProduct listA listB listC listD listE =
listA |> Seq.collect (fun a ->
listB |> Seq.collect (fun b ->
listC |> Seq.collect (fun c ->
listD |> Seq.collect (fun d ->
listE |> Seq.map (fun e -> a,b,c,d,e))
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
As part of a bigger problem of enumerating a set, I need to write an OCaml function 'choose' which takes a list and outputs as the list of all possible sequences of size k made up of elements of that list (without repeating sequences which can be obtained from each other by permutation). The order they are put in the end list is not relevant.
For example,
choose 2 [1;2;3;4] = [[1;2];[1;3];[1;4];[2;3];[2;4];[3;4]]
Any ideas?
I would like to have the whole thing to be lazy, outputting a lazy list, but if you have a strict solution, that'll be very useful too.
Here is a strict and suboptimal version. I hope it is clear. It avoids duplicates by assuming there are no duplicates in the input list, and by generating only sublists that are in the same order as in the original list.
The length computation could be factored by passing l's length as an argument of choose. That would make the code less readable but more efficient.
For the lazy version, sprinkle "lazy" and "Lazy.force" on the code...
let rec choose k l =
if k = 0
then [ [] ]
else
let len = List.length l in
if len < k
then []
else if k = len
then [ l ]
else
match l with
h :: t ->
let starting_with_h =
(List.map (fun sublist -> h :: sublist) (choose (pred k) t))
in
let not_starting_with_h = choose k t in
starting_with_h # not_starting_with_h
| [] -> assert false
;;
val choose : int -> 'a list -> 'a list list = <fun>
# choose 3 [1; 2; 3; 4; 5; 6; 7] ;;
- : int list list =
[[1; 2; 3]; [1; 2; 4]; [1; 2; 5]; [1; 2; 6]; [1; 2; 7]; [1; 3; 4]; [1; 3; 5];
[1; 3; 6]; [1; 3; 7]; [1; 4; 5]; [1; 4; 6]; [1; 4; 7]; [1; 5; 6]; [1; 5; 7];
[1; 6; 7]; [2; 3; 4]; [2; 3; 5]; [2; 3; 6]; [2; 3; 7]; [2; 4; 5]; [2; 4; 6];
[2; 4; 7]; [2; 5; 6]; [2; 5; 7]; [2; 6; 7]; [3; 4; 5]; [3; 4; 6]; [3; 4; 7];
[3; 5; 6]; [3; 5; 7]; [3; 6; 7]; [4; 5; 6]; [4; 5; 7]; [4; 6; 7]; [5; 6; 7]]
EDIT:
A lazy_list_append as appears necessary from the comments below:
type 'a node_t =
| Empty
| Node of 'a * 'a zlist_t
and 'a zlist_t = 'a node_t lazy_t
let rec lazy_list_append l1 l2 =
lazy
(match Lazy.force l1 with
Empty -> Lazy.force l2
| Node (h, lt) ->
Node (h, lazy_list_append lt l2))
;;
Plugging in again with a Haskell solution (it's just easier to work with lazy lists since they are built-in):
combinations 0 _ = [[]]
combinations k [] = []
combinations k (x:xs) = map (x:) (combinations (k-1) xs) ++ combinations k xs
The first two cases follow from the properties of binomial coefficients and more specifically: n choose 0 = 1 for all n including n=0 (that's why it is first to handle the case 0 choose 0). The other one is 0 choose k = 0. The third equation is exact translation of the recursive definition of combinations.
Unfortunately when you apply it to an infinite list it returns a trivial solution:
> take 10 $ combinations 3 [1..]
[[1,2,3],[1,2,4],[1,2,5],[1,2,6],[1,2,7],[1,2,8],[1,2,9],[1,2,10],[1,2,11],[1,2,12]]
EDIT:
OK, so we really want to go trough each combination in a finite number of steps. With the above version we are obviously using only the expression to the left of ++ which generates only combinations starting with 1. We can work around this problem by defining an interesting list zipping function which builds a list by alternately picking the head of each of its argument lists (it's important to be non-strict in the second argument):
merge [] ys = ys
merge (x:xs) ys = x:merge ys xs
and use it instead of ++:
combinations k (x:xs) = map (x:) (combinations (k-1) xs) `merge` combinations k xs
lets see:
> let comb_10_3 = combinations 3 [1..10]
> let comb_inf_3 = combinations 3 [1..]
> take 10 comb_inf_3
[[1,2,3],[2,3,4],[1,3,4],[3,4,5],[1,2,4],[2,4,5],[1,4,5],[4,5,6],[1,2,5],[2,3,5]]
> comb_10_3 `intersect` comb_inf_3 == comb_10_3
True
> last $ combinations 3 [1..10]
[6,8,10]
> elemIndex [6,8,10] $ combinations 3 [1..]
Just 351
All 10 choose 3 combinations are there!
Just for the sake of completeness, I am putting here the final code which brings together the strict code from Pascal with my lazy stuff and all other Pascal's useful comments.
The lazy list type is defined, then two auxiliary lazy functions (append and map), and finally the function "choose" that we aim to define.
type 'a node_t =
| Nil
| Cons of 'a * 'a t
and 'a t = ('a node_t) Lazy.t
let rec append l1 l2 =
match Lazy.force l1 with
| Nil -> l2
| Cons (a, l) -> lazy (Cons (a, append l l2))
let rec map f ll = lazy (
match Lazy.force ll with
| Nil -> Nil
| Cons(h,t) -> Cons(f h, map f t) )
let rec choose k l len =
if k = 0
then lazy (Cons(lazy Nil,lazy Nil))
else
if len < k
then lazy Nil
else if k = len
then lazy (Cons (l,lazy Nil))
else
match Lazy.force l with
| Cons(h,t) -> let g h sublist = lazy (Cons (h,sublist))
in let starting_with_h = (map (g h) (choose (k-1) t (len-1)))
in let not_starting_with_h = choose k t (len-1)
in append starting_with_h not_starting_with_h
| Nil -> assert false
The result of evaluating "choose k ls n" is a lazy list of all choices of k elements of list ls, with ls considered up to size n. Note that, as pointed out by Pascal, because of the way the enumeration takes place, the function choose will not cover all choices of an infinite list.
Thanks, this was really useful!
Best,
Surikator.