OCaml -- return a list containing the tails of that list - ocaml

For [1;2;3;4;5], I want to return [[1;2;3;4;5];[2;3;4;5];[3;4;5;];[4;5];[5];[]]
I'm trying to use the List library but I'm unsure how to. So far, I know I have to use List.tl to get the list without the first element
let rec tailsoflist (l : 'a list) : 'a list list =
match l with
[] -> [[]]
| x::xs -> l::(tails xs)
I did this recursively but now I want to just use the list library without using recursion.
let tails (l : 'a list) : 'a list list
EDIT: Sorry guys, what I specified for the function to return is incorrect. Just updated it with the correct output.

As I said in the comment, these are not the tails of l but copies of the tails of l:
# let tails l = List.fold_right (fun e acc -> (e::(List.hd acc))::acc) l [[]] ;;
val tails : 'a list -> 'a list list = <fun>
# tails [1; 2; 3; 4] ;;- : int list list = [[1; 2; 3; 4]; [2; 3; 4]; [3; 4]; [4]; []]

There is no good way to write that function in terms of the built-in functions.
The answer you give in your question is fine but it would be more idiomatic to not annotate the types and use function:
let rec tails = function
| [] -> [[]]
| _::xs' as xs -> xs::tails xs'
Other languages, like F#, provide a List.unfold function that tails can be written in terms of.

Ah, the old trick to accumulate on the original list to cast tails as a catamorphism. This is done without explicit recursion using just functions on the List module:
let tails l = List.rev ( [] :: snd (List.fold_right
(fun _ (t,ts) -> List.tl t, t::ts) l (l, [])) )
It produces the tails as you expect:
# tails [1;2;3;4;5];;
- : int list list = [[1; 2; 3; 4; 5]; [2; 3; 4; 5]; [3; 4; 5]; [4; 5]; [5]; []]
and the tails are the actual structural tails of the input list, so that List.tl l == List.hd (List.tl (tails l)).

"Without using recursion"... why ? Recursion is a useful tool, even outside the List library.
let rec suffixes = function
| [] -> [[]]
| hd::tl as suff -> suff :: suffixes tl
Your function (which doesn't compile because you use tails instead of tailsoflist) returns the list of suffixes of a list. Due to the list structure, it's easier to compute than the prefixes.
You can express the prefixes from the suffixes :
let prefixes li = List.map List.rev (suffixes (List.rev li));;
You could do a direct version using an accumulator:
let prefixes li =
let rec pref acc = function
| [] -> List.rev acc :: []
| hd::tl -> List.rev acc :: pref (hd :: acc) tl
in pref [] li
and express it using List.fold_left if you want to avoid recursion, but this is convoluted so you should prefer the direct version in my opinion:
let prefixes li =
let acc, res =
List.fold_left
(fun (acc, res) e -> (e :: acc), (List.rev acc :: res))
([], []) li in
List.rev acc :: res
Finally, it is possible to destroy your brain with a version using continuations, but I don't remember the exact code. Roughly, the continuation is equivalent to the "accumulator" of the direct version.

Related

Removing consecutive duplicates from a list without recursion

I'm supposed to remove consecutive duplicates from an int list without using recursion and using only List.fold, map, filter, fold_left, fold_right.
I almost got it, but the problem with my code is that it checks if each element equals the 2nd element, and not the next element.
For example if let z = int list [3;1;4;5;5;1;1] my code will return [3;4;5] and not [3;1;4;5;1]. I'm not sure how to change it so filter uses a dynamically changing list parameter and not simply the original one (so it doesn't compare each element to the second element (1 in this case) each time):
let dupe (ls: int list) : int list =
List.filter (fun x -> if List.length ls = 0 then true else if x = List.hd (List.tl xs) then false else true) ls
The type of List.filter is this:
# List.filter;;
- : ('a -> bool) -> 'a list -> 'a list = <fun>
Notably, the filter function can see only one element of the list at a time. You need to see two consecutive elements to decide what to do, so I'd say List.filter won't do the job.
You're going to have to use map or one of the folds, I'd say. You can figure out which one(s) will work, with similar reasoning.
(I assume this is the sort of reasoning the assignment is supposed to illustrate. So I'm going to leave it there.)
Without rec
let remove = function
[] -> []
| x::tl ->
let (_,lxRes)=
List.fold_left (
fun (xPrec,lxRes) xCour ->
if xPrec=xCour then
(xCour,lxRes)
else
(xCour,lxRes#[xCour])
) (x+1,[]) (x::tl)
in
lxRes
Test:
# remove [3;1;4;5;5;1;1];;
- : int list = [3; 1; 4; 5; 1]
# remove [1;1];;
- : int list = [1]
# remove [1;1;1;1;2;2;3;4;5;5];;
- : int list = [1; 2; 3; 4; 5]
With rec (just for information)
let rec remove =
function
| [] -> []
| x::[] -> x::[]
| x::y::tl ->
if x=y then remove (y::tl)
else x::remove (y::tl)
Using just List.fold_left can be a little bit more concise than the previous answer. Of course, this will build up the list in reverse order, so we need to reverse the result.
let remove lst =
List.(
lst
|> fold_left
(fun acc x ->
match acc with
| [] -> [x]
| hd::_ when x = hd -> acc
| _ -> x::acc)
[]
|> rev
)
Of course, if you're not allowed to use List.rev we can reimplement it easily using List.fold_left, List.cons and Fun.flip.
let rev lst =
List.fold_left (Fun.flip List.cons) [] lst

Appending two lists

So this is one way to append two lists:
let rec append l1 l2 =
match l1 with
| h :: t -> h :: append t l2
| [] -> l2
But I am trying to write a tail-recursive version of append. (solve the problem before calling the recursive function).
This is my code so far, but when I try to add append in the first if statement the code becomes faulty for weird reasons.
let list1 = [1;2;3;4]
let list2 = [5;6;7;8]
let rec append lista listb =
match listb with
| h :: taillist -> if taillist != [] then
begin
lista # [h];
(* I cant put an append recursive call here because it causes error*)
end else
append lista taillist;
| [] -> lista;;
append list1 list2;;
The easiest way to transform a non tail-recursive list algorithm into a tail-recursive one, is to use an accumulator. Consider rewriting your code using a third list, that will accumulate the result. Use cons (i.e., ::) to prepend new elements to the third list, finally you will have a result of concatenation. Next, you need just to reverse it with List.rev et voila.
For the sake of completeness, there is a tail-recursive append:
let append l1 l2 =
let rec loop acc l1 l2 =
match l1, l2 with
| [], [] -> List.rev acc
| [], h :: t -> loop (h :: acc) [] t
| h :: t, l -> loop (h :: acc) t l
in
loop [] l1 l2
I would recommend to solve 99 problems to learn this idiom.
A couple of comments on your code:
It seems like cheating to define a list append function using #, since this is already a function that appends two lists :-)
Your code is written as if OCaml were an imperative language; i.e., you seem to expect the expression lista # [h] to modify the value of lista. But OCaml doesn't work that way. Lists in OCaml are immutable, and lista # [h] just calculates a new value without changing any previous values. You would need to pass this new value in your recursive call.
As #ivg says, the most straightforward way to solve your problem is using an accumulator, with a list reversal at the end. This is a common idiom in a language with immutable lists.
A version using constant stack space, implemented with a couple of standard functions (you'll get a tail-recursive solution after unfolding the definitions):
let append xs ys = List.rev_append (List.rev xs) ys
Incidentally, some OCaml libraries implement the append function in a pretty sophisticated way:
(1) see core_list0.ml in the Core_kernel library: search for "slow_append" and "count_append"
(2) or batList.mlv in the Batteries library.
An alternative tail-recursive solution (F#) leveraging continuations :
let concat x =
let rec concat f = function
| ([], x) -> f x
| (x1::x2, x3) -> concat (fun x4 -> f (x1::x4)) (x2, x3)
concat id x
I think the best way to go about it, like some have said would be to reverse the first list, then recursively add the head to the front of list2, but the top comment with code uses an accumulator, when you can get the same result without it by :: to the second list instead of an accumulator
let reverse list =
let rec reverse_helper acc list =
match list with
| [] -> acc
| h::t -> reverse_helper (h::acc) t in
reverse_helper [] lst;;
let append list1 list2 =
let rec append_helper list1_rev list2 =
match list1_rev with
| [] -> list2
| h :: t -> append_helper t (h::lst2) in
append_helper (reverse lst1) lst2;;
A possible answer to your question could be the following code :
let append list1 list2 =
let rec aux acc list1 list2 = match list1, list2 with
| [], [] -> List.rev(acc)
| head :: tail, [] -> aux (head :: acc) tail []
| [], head :: tail -> aux (head :: acc) [] tail
| head :: tail, head' :: tail' -> aux (head :: acc) tail (head' :: tail')
in aux [] list1 list2;
It's pretty similar to the code given by another one of the commenters on your post, but this one is more exhaustive, as I added a case for if list2 is empty from the beginning and list1 isn't
Here is a simpler solution:
let rec apptr l k =
let ln = List.rev l in
let rec app ln k acc = match ln with
| [] -> acc
| h::t -> app t k (h::acc) in
app ln k k
;;
let rec append (mylist: 'a list) (myotherlist : 'a list ): 'a list =
match mylist with
| [] -> myotherlist
| a :: rest -> a :: append rest myotherlist

Split list into two

I would like to implement a function that takes as input a size n and a list. This function will cut the list into two lists, one of size n and the rest in another list. I am new to this language and have a hard time learning the syntax.
The main problem I have is that is finding a way to express a size of the list without using any loops or mutable variables.
Can anyone give a me some pointers?
Let's start with the function's type signature. Since it gets n and a list as arguments and returns a pair of lists, you have a function split:
val split : int -> 'a list -> 'a list * 'a list
Here is one approach to implement this function:
let split n xs =
let rec splitUtil n xs acc =
match xs with
| [] -> List.rev acc, []
| _ when n = 0 -> List.rev acc, xs
| x::xs' -> splitUtil (n-1) xs' (x::acc)
splitUtil n xs []
The idea is using an accumulator acc to hold elements you have traversed and decreasing n a long the way. Because elements are prepended to acc, in the end you have to reverse it to get the correct order.
The function has two base cases to terminate:
There's no element left to traverse (xs = [] at that point).
You have gone through the first n elements of the list (n decreases to 0 at that time).
Here is a short illustration of how split computes the result:
split 2 [1; 2; 3] // call the auxiliary function splitUtil
~> splitUtil 2 [1; 2; 3] [] // match the 3rd case of x::xs'
~> splitUtil 1 [2; 3] [1] // match the 3rd case of x::xs'
~> splitUtil 0 [3] [2; 1] // match the 2nd case of n = 0 (base case)
~> List.rev [2; 1], [3] // call List.rev on acc
~> [1; 2], [3]
let split n list =
let rec not_a_loop xs = function
| (0, ys) | (_, ([] as ys)) -> (List.rev xs), ys
| (n, x::ys) -> not_a_loop (x::xs) (n-1, ys)
not_a_loop [] (n, list)
New solution - splitAt is now built into List and Array. See commit around 2014 on github. I noticed this today while using F# in VS.2015
Now you can simply do this...
let splitList n list =
List.splitAt n list
And as you might expect the signature is...
n: int -> list: 'a list -> 'a list * 'a list
Example usage:
let (firstThree, remainder) = [1;2;3;4;5] |> (splitList 3)
printfn "firstThree %A" firstThree
printfn "remainder %A" remainder
Output:
firstThree [1; 2; 3]
remainder [4; 5]
Github for those interested: https://github.com/dsyme/visualfsharp/commit/1fc647986f79d20f58978b3980e2da5a1e9b8a7d
One more way, using fold:
let biApply f (a, b) = (f a, f b)
let splitAt n list =
let splitter ((xs, ys), n') c =
if n' < n then
((c :: xs, ys), n' + 1)
else
((xs, c :: ys), n' + 1)
List.fold splitter (([], []), 0) list
|> fst
|> biApply List.rev
Here is a great series on folds than you can follow to learn more on the topic.

Linked list partition function and reversed results

I wrote this F# function to partition a list up to a certain point and no further -- much like a cross between takeWhile and partition.
let partitionWhile c l =
let rec aux accl accr =
match accr with
| [] -> (accl, [])
| h::t ->
if c h then
aux (h::accl) t
else
(accl, accr)
aux [] l
The only problem is that the "taken" items are reversed:
> partitionWhile ((>=) 5) [1..10];;
val it : int list * int list = ([5; 4; 3; 2; 1], [6; 7; 8; 9; 10])
Other than resorting to calling rev, is there a way this function could be written that would have the first list be in the correct order?
Here's a continuation-based version. It's tail-recursive and returns the list in the original order.
let partitionWhileCps c l =
let rec aux f = function
| h::t when c h -> aux (fun (acc, l) -> f ((h::acc), l)) t
| l -> f ([], l)
aux id l
Here are some benchmarks to go along with the discussion following Brian's answer (and the accumulator version for reference):
let partitionWhileAcc c l =
let rec aux acc = function
| h::t when c h -> aux (h::acc) t
| l -> (List.rev acc, l)
aux [] l
let test =
let l = List.init 10000000 id
(fun f ->
let r = f ((>) 9999999) l
printfn "%A" r)
test partitionWhileCps // Real: 00:00:06.912, CPU: 00:00:07.347, GC gen0: 78, gen1: 65, gen2: 1
test partitionWhileAcc // Real: 00:00:03.755, CPU: 00:00:03.790, GC gen0: 52, gen1: 50, gen2: 1
Cps averaged ~7s, Acc ~4s. In short, continuations buy you nothing for this exercise.
I expect you can use continuations, but calling List.rev at the end is the best way to go.
I usually prefer Sequences over List as they are lazy and you got List.toSeq and Seq.toList functions to convert between them. Below is the implementation of your partitionWhile function using sequences.
let partitionWhile (c:'a -> bool) (l:'a list) =
let fromEnum (e:'a IEnumerator) =
seq { while e.MoveNext() do yield e.Current}
use e = (l |> List.toSeq).GetEnumerator()
(e |> fromEnum |> Seq.takeWhile c |> Seq.toList)
,(e |> fromEnum |> Seq.toList)
You can rewrite the function like this:
let partitionWhile c l =
let rec aux xs =
match xs with
| [] -> ([], [])
| h :: t ->
if c h then
let (good, bad) = aux t in
(h :: good, bad)
else
([], h :: t)
aux l
Yes, as Brian has noted it is no longer tail recursive, but it answers the question as stated. Incidentally, span in Haskell is implemented exactly the same way in Hugs:
span p [] = ([],[])
span p xs#(x:xs')
| p x = (x:ys, zs)
| otherwise = ([],xs)
where (ys,zs) = span p xs'
A good reason for preferring this version in Haskell is laziness: In the first version all the good elements are visited before the list is reversed. In the second version the first good element can be returned immediately.
I don't think I'm the only one to learn a lot from (struggling with) Daniel's CPS solution. In trying to figure it out, it helped me change several potentially (to the beginner) ambiguous list references, like so:
let partitionWhileCps cond l1 =
let rec aux f l2 =
match l2 with
| h::t when cond h -> aux (fun (acc, l3) -> f (h::acc, l3)) t
| l4 -> f ([], l4)
aux id l1
(Note that "[]" in the l4 match is the initial acc value.) I like this solution because it feels less kludgey not having to use List.rev, by drilling to the end of the first list and building the second list backwards. I think the other main way to avoid .rev would be to use tail recursion with a cons operation. Some languages optimize "tail recursion mod cons" in the same way as proper tail recursion (but Don Syme has said that this won't be coming to F#).
So this is not tail-recursive safe in F#, but it makes my answer an answer and avoids List.rev (this is ugly to have to access the two tuple elements and would be a more fitting parallel to the cps approach otherwise, I think, like if we only returned the first list):
let partitionWhileTrmc cond l1 =
let rec aux acc l2 =
match l2 with
| h::t when cond h -> ( h::fst(aux acc t), snd(aux acc t))
| l3 -> (acc, l3)
aux [] l1

Most elegant combinations of elements in F#

One more question about most elegant and simple implementation of element combinations in F#.
It should return all combinations of input elements (either List or Sequence).
First argument is number of elements in a combination.
For example:
comb 2 [1;2;2;3];;
[[1;2]; [1;2]; [1;3]; [2;2]; [2;3]; [2;3]]
One less concise and more faster solution than ssp:
let rec comb n l =
match n, l with
| 0, _ -> [[]]
| _, [] -> []
| k, (x::xs) -> List.map ((#) [x]) (comb (k-1) xs) # comb k xs
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
let useX = List.map (fun l -> x::l) (comb (n-1) xs)
let noX = comb n xs
useX # noX
There is more consise version of KVB's answer:
let rec comb n l =
match (n,l) with
| (0,_) -> [[]]
| (_,[]) -> []
| (n,x::xs) ->
List.flatten [(List.map (fun l -> x::l) (comb (n-1) xs)); (comb n xs)]
The accepted answer is gorgeous and quickly understandable if you are familiar with tree recursion. Since elegance was sought, opening this long dormant thread seems somewhat unnecessary.
However, a simpler solution was asked for. Iterative algorithms sometimes seem simpler to me. Furthermore, performance was mentioned as an indicator of quality, and iterative processes are sometimes faster than recursive ones.
The following code is tail recursive and generates an iterative process. It requires a third of the amount of time to compute combinations of size 12 from a list of 24 elements.
let combinations size aList =
let rec pairHeadAndTail acc bList =
match bList with
| [] -> acc
| x::xs -> pairHeadAndTail (List.Cons ((x,xs),acc)) xs
let remainderAfter = aList |> pairHeadAndTail [] |> Map.ofList
let rec comboIter n acc =
match n with
| 0 -> acc
| _ ->
acc
|> List.fold (fun acc alreadyChosenElems ->
match alreadyChosenElems with
| [] -> aList //Nothing chosen yet, therefore everything remains.
| lastChoice::_ -> remainderAfter.[lastChoice]
|> List.fold (fun acc elem ->
List.Cons (List.Cons (elem,alreadyChosenElems),acc)
) acc
) []
|> comboIter (n-1)
comboIter size [[]]
The idea that permits an iterative process is to pre-compute a map of the last chosen element to a list of the remaining available elements. This map is stored in remainderAfter.
The code is not concise, nor does it conform to lyrical meter and rhyme.
A naive implementation using sequence expression. Personally I often feel sequence expressions are easier to follow than other more dense functions.
let combinations (k : int) (xs : 'a list) : ('a list) seq =
let rec loop (k : int) (xs : 'a list) : ('a list) seq = seq {
match xs with
| [] -> ()
| xs when k = 1 -> for x in xs do yield [x]
| x::xs ->
let k' = k - 1
for ys in loop k' xs do
yield x :: ys
yield! loop k xs }
loop k xs
|> Seq.filter (List.length >> (=)k)
Method taken from Discrete Mathematics and Its Applications.
The result returns an ordered list of combinations stored in arrays.
And the index is 1-based.
let permutationA (currentSeq: int []) (n:int) (r:int): Unit =
let mutable i = r
while currentSeq.[i - 1] = n - r + i do
i <- (i - 1)
currentSeq.[i - 1] <- currentSeq.[i - 1] + 1
for j = i + 1 to r do
currentSeq.[j - 1] <- currentSeq.[i - 1] + j - i
()
let permutationNum (n:int) (r:int): int [] list =
if n >= r then
let endSeq = [|(n-r+1) .. n|]
let currentSeq: int [] = [|1 .. r|]
let mutable resultSet: int [] list = [Array.copy currentSeq];
while currentSeq <> endSeq do
permutationA currentSeq n r
resultSet <- (Array.copy currentSeq) :: resultSet
resultSet
else
[]
This solution is simple and helper function costs constant memory.
My solution is less concise, less effective (altho, no direct recursion used) but it trully returns all combinations (currently only pairs, need to extend filterOut so it can return a tuple of two lists, will do little later).
let comb lst =
let combHelper el lst =
lst |> List.map (fun lstEl -> el::[lstEl])
let filterOut el lst =
lst |> List.filter (fun lstEl -> lstEl <> el)
lst |> List.map (fun lstEl -> combHelper lstEl (filterOut lstEl lst)) |> List.concat
comb [1;2;3;4] will return:
[[1; 2]; [1; 3]; [1; 4]; [2; 1]; [2; 3]; [2; 4]; [3; 1]; [3; 2]; [3; 4]; [4; 1]; [4; 2]; [4; 3]]
Ok, just tail combinations little different approach (without using of library function)
let rec comb n lst =
let rec findChoices = function
| h::t -> (h,t) :: [ for (x,l) in findChoices t -> (x,l) ]
| [] -> []
[ if n=0 then yield [] else
for (e,r) in findChoices lst do
for o in comb (n-1) r do yield e::o ]