count number of duplicates in a list in OCaml - ocaml

I have a list like:
let lst = ["cat"; "dog"; "cow"; "dog"; "cat"; "horse"; "dog"];;
I want to count the number of same elements and have the output in a list of tuples (element, count) like:
[("cat", 2); ("dog", 3); ("cow", 1); ("horse", 1)]
I tried using List.fold_left but found that the folding function will be complex. Any suggestion?

If you don't care about performance, then it can be like this:
let count_dup l =
let scan_count x l = List.fold_left (fun (c,acc) y -> if x = y then c+1,acc else c,y::acc) (1,[]) l in
let rec count acc = function
| [] -> List.rev acc
| hd::tl -> let c,r = scan_count hd tl in count ((hd,c)::acc) r
in
count [] l
If you care about performance, but don't care about the order, then it is better that you sort the list first, then scan once.
let count_dup' l =
let sl = List.sort compare l in
match sl with
| [] -> []
| hd::tl ->
let acc,x,c = List.fold_left (fun (acc,x,c) y -> if y = x then acc,x,c+1 else (x,c)::acc, y,1) ([],hd,1) tl in
(x,c)::acc

let count l =
let hash = Hashtbl.create 10 in
List.iter (fun key -> if Hashtbl.mem hash key then Hashtbl.replace hash key ((Hashtbl.find hash key) + 1) else Hashtbl.add hash key 1) l;
Hashtbl.fold (fun k v ls -> (k, v) :: ls) hash []

A way to preserve order and performance:
let count lst =
let sorted = List.sort (compare) lst in
List.fold_right (fun ele acc -> match acc with
| [] -> [(ele, 1)]
| (ele', c)::t ->
if ele = ele'
then (ele, c+1)::t
else (ele,1)::(ele',c)::t) sorted []

Related

F# - splitting list into tuple of odd-even lists (by element, not position)

Example: split [1;3;2;4;7;9];;
Output: ([1;3;7;9], [2;4])
I'm new to F# and I can't figure it out.
Can't use the partition built in function.
This is what I have so far:
let rec split xs =
match xs with
| [] -> [], []
| xs -> xs, []
| xh::xt -> let odds, evens = split xt
if (xh % 2) = 0 then xh::odds, xh::evens
else xh::odds, evens
Fixed code:
let rec split xs =
match xs with
| [] -> [], []
| xh::xt -> let odds, evens = split xt
if (xh % 2) = 0 then odds, xh::evens
else xh::odds, evens
*Thanks to #TheInnerLight for pointing out my errors: unreachable case and unnecessarily modifying odds
You can use the built-in List.partition function
let splitOddEven xs =
xs |> List.partition (fun x -> x % 2 <> 0)
splitOddEven [1;3;2;4;7;9];;
val it : int list * int list = ([1; 3; 7; 9], [2; 4])
If you want a recursive implementation, I'd probably go for a tail recursive implementation like this:
let splitOddEven xs =
let rec splitOddEvenRec oddAcc evenAcc xs =
match xs with
| [] -> oddAcc, evenAcc
| xh::xt ->
if (xh % 2) = 0 then splitOddEvenRec oddAcc (xh :: evenAcc) xt
else splitOddEvenRec (xh :: oddAcc) evenAcc xt
splitOddEvenRec [] [] xs
splitOddEven [1;3;2;4;7;9]
Note that this will give you the two resulting lists in reverse order so you might wish to reverse them yourself.

Implementing collect for list in F#

I am new to programming in functional languages. I am attempting to implement the F# collect for list.
let rec collect func list =
match list with
| [] -> []
| hd::tl -> let tlResult = collect func tl
func hd::tlResult;;
collect (fun x -> [for i in 1..3 -> x * i]) [1;2;3];;
should print:
val it : int list = [1; 2; 3; 2; 4; 6; 3; 6; 9]
but I got:
val it : int list = [[1; 2; 3;], [2; 4; 6;], [3; 6; 9]]
Here's a tail recursive collect that won't stack overflow for large lists.
let collect f xs =
let rec prepend res xs = function
| [] -> loop res xs
| y::ys -> prepend (y::res) xs ys
and loop res = function
| [] -> List.rev res
| x::xs -> prepend res xs (f x)
loop [] xs
A simpler version, that's somewhat cheating, is:
let collect (f: _ -> list<_>) (xs: list<_>) = [ for x in xs do yield! f x ]
The collect function is tricky to implement efficiently in the functional style, but you can quite easily implement it using the # operator that concatenates lists:
let rec collect f input =
match input with
| [] -> []
| x::xs -> (f x) # (collect f xs)

Tail-recursive version of function combinations in OCaml

The non-tail-recursive combinations function can be written like this:
let rec combinations l k =
if k <= 0 || k > List.length l then []
else if k = 1 then List.map (fun x -> [x]) l
else
let hd, tl = List.hd l, List.tl l in
combinations tl k |> List.rev_append (List.map (fun x -> hd::x) (combinations tl (k-1)))
Note that I use List.rev_append to at least given the append a tail recursive version
It means generate all the combinations if you want to get k elements out of the list.
I am just wondering is it possible to create a total tail-recursive version of combinations?
You could use continuation passing style:
let combos l k =
let rec aux l k cont =
if k <= 0 || k > List.length l then cont []
else if k = 1 then cont (List.map (fun x -> [x]) l)
else
let hd, tl = List.hd l, List.tl l in
aux tl k
(
fun res1 -> aux tl (k-1)
(
fun res2 -> cont (List.rev_append (List.map (fun x -> hd::x) res2) res1)
)
)
in aux l k (fun x -> x)
This way, you avoid calling something after the recursive call of aux at the price of creating an anonymous function that accounts for the "future computation" that shall be done after the "original recursive call".
Usually we do continuations-passing-style, as in phimuemue's answer. E.g.
let rec prefix_cps tree k =
match tree with
| Tip -> k []
| Node (left,n,right) ->
prefix_cps left (fun nleft ->
prefix_cps right (fun nright ->
k (n :: nleft # nright)))
let prefix_cps t = prefix_cps t (fun l -> l)
However, sometimes we can rearrange the input on the fly:
let rec prefix_tr t =
let rec loop queue = function
| Tip -> queue
| Node (l, n, Tip) -> loop (n::queue) l
| Node (l, k, Node (rl, n, rr)) ->
loop queue (Node (Node (l, k, rl), n, rr)) in
loop [] t

Insertion Sort implementation with one recursive function and foldBack function

I am reviewing implementations for some basic data structures and the algorithms operating on them. I guess the idiomatic F# code for Insertion Sort is very much like:
let rec insert x = function
| [] -> [x]
| y::ys -> if x<=y then x::y::ys
else y::(insert x ys)
and insertionSort = function
| [] -> []
| x::xs -> insert x (insertionSort xs)
let myLst = [8;3;3;5;-6;0;1;4;-3;2]
let result = myLst |> insertionSort
val result : int list = [-6; -3; 0; 1; 2; 3; 3; 4; 5; 8]
While I was trying to implement it with List.foldBack and only one recursive function, as below, and couldn't give me the correct result? Anyone can figure out where the problem lies?
let rec anotherInsertionSort lst =
List.foldBack(fun x (ys:list<_>) ->
if ys.IsEmpty then [x]
elif x <= ys.Head then x::ys
else ys.Head::x::anotherInsertionSort ys.Tail) lst []
Un-golfed from cfern's code:
let rec insert i = function
| h::t -> min h i::(insert (max h i) t)
| _ -> [i]
let insertionSort l = List.foldBack insert l []
As I said in my comment, the problem is that you're dropping x in your else branch. Here's one way to fix it:
let rec anotherInsertionSort lst =
List.foldBack(fun x ys ->
match ys with
| [] -> [x]
| y::_ when x <= y -> x::ys
| y::ys -> y::(anotherInsertionSort (x::ys))) lst []
Having said that, I like Daniel's approach better.

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 ]