I'm trying to write a function which insert an integer n in every position of a given list. Little example, insert_everywhere 0 [1;2] -> [[0;1;2]; [1;0;2]; [1;2;0]]. I wrote this :
let insert_everywhere l n =
let l_aux = [] in
let rec aux l1 l2 = match l1 with
| [] -> []
| x::tl -> (l_aux # [n] # l1) :: aux tl (l_aux # [x])
in aux l l_aux
;;
The probleme is that calling aux tl (l_aux # [x]) doesn't do what I want. My idea is: when I'm reading the head of my list, I insert into an another list which I append to the number n and the rest of the list. With this way, I will have the final list of list that I excepted but not with my current implementation…
Well, solution is strongly related to data structure called zipper. You need to keep not evaluated tail of list if 1st argument of aux and also keep evaluated prefix of list to build a part of answer of it. You don't need l_aux, we will use 2nd argument instead of using mutable variable. Let's look at skeleton
let insert_everywhere l (n : int) =
let rec aux l1 l2 : int list list = match l1 with
| [] -> (* There we need to built a part of answer
from l1 prefix, n and empty tail postfix*)
| x::tl -> (* There we need to construct part of answer *)
:: aux tl ( (* construct new prefix from old one and `n` there *) )
in
aux l []
If you still can't find answer you can look at my solution there. I will add it to my answer when you will find an answer. Try not to peep into link! :)
P.S.
let insert_everywhere l (n : int) =
let rec aux l1 l2 = match l1 with
| [] -> [l2 # [n]]
| x::tl -> (l2 # [n] # l1) :: aux tl (l2 # [x])
in
aux l []
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
I'm trying to self-learn some programming in a functional programming language and recently stumbled on the problem of generating all the permutations of length m from a list of length n, with repetition. Mathematically, this should result in a total of n^m possible permutations, because each of the m 'slots' can be filled with any of the n elements. The code I have currently, however, does not give me all the elements:
let rec permuts n list =
match n, list with
0, _ -> [[]]
| _, [] -> []
| n, h :: t -> (List.map (fun tt -> h::tt) (permuts (n-1) list))
# permuts n t;;
The algorithm basically takes one element out of a list with m elements, slaps it onto the front of all the combinations with the rest of the elements, and concatenates the results into one list, giving only n C m results.
For example, the output for permuts 2 [1;2;3] yields
[[1;1]; [1;2]; [1;3]; [2;2]; [2;3]; [3;3]]
whereas I actually want
[[1;1]; [1;2]; [1;3]; [2;1]; [2;2]; [2;3]; [3;1]; [3;2]; [3;3]]
-- a total of 9 elements. How do I fix my code so that I get the result I need? Any guidance is appreciated.
Your error appears on the second line of:
| n, h :: t -> List.map (fun tt -> h::tt) (permuts (n-1) list)
# permuts n t
Indeed, with this you are decomposing the set of n-tuples with k elements as the sum of
the set of (n-1)-tuples prefixed with the first element
the set of n-tuples with (k-1) elements
Looking at the cardinal of the three sets, there is an obvious mismatch since
k^n ≠k^(n-1) + (k-1)^n
And the problem is that the second term doesn't fit.
To avoid this issue, it is probably better to write a couple of helper function.
I would suggest to write the following three helper functions:
val distribute: 'a list -> 'a list -> 'a list list
(** distribute [x_1;...;x_n] y returns [x_1::y;...x_n::y] *)
val distribute_on_all: 'a list -> 'a list list
(** distribute_on_all x [l_1;...;l_n] returns distribute x l_1 # ... # distribute x l_n *)
val repeat: int -> ('a -> 'a) -> 'a -> 'a
(** repeat n f x is f(...(f x)...) with f applied n times *)
then your function will be simply
let power n l = repeat n (distribute_on_all l) [[]]
In Haskell, it's very natural to do this using a list comprehension:
samples :: Int -> [a] -> [[a]]
samples 0 _ = [[]]
samples n xs =
[ p : ps
| p <- xs
, ps <- samples (n - 1) xs
]
It seems to me you never want to recurse on the tail of the list, since all your selections are from the whole list.
The Haskell code of #dfeuer looks right. Note that it never deconstructs the list xs. It just recurses on n.
You should be able to copy the Haskell code using List.map in place of the first two lines of the list comprehension, and a recursive call with (n - 1) in place of the next line.
Here's how I would write it in OCaml:
let perm src =
let rec extend remaining_count tails =
match remaining_count with
| 0 -> tails
| _ ->
(* Put an element 'src_elt' taken from all the possible elements 'src'
in front of each possible tail 'tail' taken from 'tails',
resulting in 'new_tails'. The elements of 'new_tails' are one
item longer than the elements of 'tails'. *)
let new_tails =
List.fold_left (fun new_tails src_elt ->
List.fold_left (fun new_tails tail ->
(src_elt :: tail) :: new_tails
) new_tails tails
) [] src
in
extend (remaining_count - 1) new_tails
in
extend (List.length src) [[]]
The List.fold_left calls may look a bit intimidating but they work well. So it's a good idea to practice using List.fold_left. Similarly, Hashtbl.fold is also common and idiomatic, and you'd use it to collect the keys and values of a hash table.
I'm trying to write a function that takes a list of binary numbers and returns a list of lists as follow: it must iterate over the initial list and can either add a nested list of n ones, up to n-1 ones ending with a zero or a single zero. For example (with n = 3) :
[1;1;1;1;0;0] -> [[1;1;1];[1;0];[0]]
[1;1;1] -> [[1;1;1]]
[1;0;0;1;1;0] -> [[1;0];[0];[1;1;0]]
The code i have so far is
let bitListSequence binList n =
let rec aux acc binList =
match binList with
| [] -> acc
| x::xs ->
let rec loop acc2 = function
| 1 -> if List.length acc2 < n-1 then loop acc2::1 xs
else aux acc2 xs
| 0 -> aux acc2::0 xs in
aux [] acc
I think the logic is good but the syntax is incorrect. I'm trying to accumulate a nested list into acc2 until a condition is met before appending it to acc and repeating the process until binList is empty.
You have a definition of a function named aux but no call to the function.
The body of binList looks roughly like this:
let rec aux acc binlist =
(* Definition of aux *)
That's it. There's no in associated with this let, and hence no call to aux.
I implemented it using continuation. I think this is tail recursive but I'm told it's not. Why isn't it tail recursive?
let rec zip_tr fc sc l1 l2 = match l1, l2 with
| [], [] -> sc []
| [], _ -> fc (List.length l2)
| _, [] -> fc (List.length l1)
| h1::t1, h2::t2 ->
zip_tr fc (fun l -> sc ((h1, h2) :: l)) t1 t2
Isn't this tail recursive? Do the failure/success continuations have an effect effect on tail recursiveness?
There's only one recursive call in your code, and it is in tail position. So I would say your function is tail recursive.
It does build up a fairly large computation in the sc argument. However, the call to sc is in tail position also. In my tests, the function works for very large lists without running out of stack space.
If I try your function on two copies of a very long list (100,000,000 elements), it terminates successfully (after quite a long time). This suggests to me that it really is tail recursive.
Here is the session with the long list:
# let rec zip_tr fc sc l1 l2 = . . . ;;
val zip_tr :
(int -> 'a) -> (('b * 'c) list -> 'a) -> 'b list ->
'c list -> 'a = <fun>
# let rec mklong accum k =
if k <= 0 then accum
else mklong (k :: accum) (k - 1);;
val mklong : int list -> int -> int list = <fun>
# let long = mklong [] 100_000_000;;
val long : int list =
[1; 2; 3; 4; 5; ...]
# let long_pairs =
zip_tr (fun _ -> failwith "length mismatch")
(fun x -> x) long long;;
val long_pairs : (int * int) list =
[(1, 1); (2, 2); (3, 3); (4, 4); (5, 5); ...]
# List.length long_pairs;;
- : int = 100000000
If you change your code so that the call to sc is not a tail call:
zip_tr fc (fun l -> (h1, h2): sc l) t1 t2
It generates the result in reverse order, but it also fails for long lists:
# zip_tr (fun _ -> failwith "length mismatch")
(fun x -> x) [1;2] [3;4];;
- : (int * int) list = [(2, 4); (1, 3)]
# zip_tr (fun _ -> failwith "length mismatch")
(fun x -> x) long long;;
Stack overflow during evaluation (looping recursion?).
I'm don't know enough about OCaml code generation to explain this in detail, but it does suggest that your code really is tail recursive. However it's possible this depends on the implementation of closures. For a different implementation, perhaps the generated compuation for sc would consume a large amount of stack. Maybe this is what you're being told.
Using a tail-recursive function, you build something which is like a linked-list of continuations, by wrapping each sc inside another anonymous function; then, you call the resulting continuation.
Fortunately, your continuations are also tail-recursive, since the result of one call to sc directly gives the result of the anonymous closure. That explains why you don't have stack overflows when testing it.
The possible drawback of this function is that it allocates a lot of closures (but still with linear complexity) before starting to do any actual work, which is not what is usually done.
An advantage of this approach is that the success continuation is only called when both your lists are known to have the same size; more generally, compiling code to continuations is something that is interesting to know when working with languages (so your effort is not wasted).
If the function is part of some course, you are probably expected to directly build the result list while traversing your input lists, in a tail-recursive way, without delaying the work in continuations.
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.