Count occurrences of an element in a list - f#

I have a list of integers and any integers that occur multiple times will do so consecutively. I would like to convert this to a list of tuples, containing each object together with its count.
I have come up with the below, but there is a problem with the return type of temp: "The type 'int' does not match the type ''a list'". However, the three return types look consistent to me. What have I done wrong? If what I've done is not good F# and should be done in a completely different way, please also let me know.
let countoccurences list =
match list with
| x::xs -> let rec temp list collecting counted =
match list with
| x::xs when x=collecting -> temp xs collecting counted+1
| x::xs -> (collecting,counted)::temp xs x 1
| [] -> (collecting,counted)::[]
temp xs x 1
| [] -> []

EDIT: Oops, this does not answer your question, since you said "consecutive". But I'll leave it here since someone searching the question title may find it useful.
Seq.countBy does this.
let list = [1;2;3;4;5;6;1;2;3;1;1;2]
let results = list |> Seq.countBy id |> Seq.toList
printfn "%A" results
// [(1, 4); (2, 3); (3, 2); (4, 1); (5, 1); (6, 1)]

What about this one?
lst |> Seq.groupBy (fun x -> x) |> Seq.map (fun (a,b) -> (a, Seq.length(b)))

In this line:
| x::xs when x=collecting -> temp xs collecting counted+1
the compiler interprets your code as
| x::xs when x=collecting -> (temp xs collecting counted)+1
but what you want is
| x::xs when x=collecting -> temp xs collecting (counted+1)
However, even with this change, one problem with your algorithm is that the temp function is not tail-recursive, which means that it can cause a stack overflow when called on a long list (e.g. countoccurences [1..10000] fails on my machine). If this is important to you, then you should rewrite your temp helper function to be tail recursive. The easiest way to do this is to add an accumulated list parameter and reverse the list afterwards.
let countoccurences list =
match list with
| x::xs ->
let rec temp list collecting counted acc =
match list with
| x::xs when x = collecting -> temp xs collecting (counted+1) acc
| x::xs -> temp xs x 1 ((collecting, counted)::acc)
| [] -> (collecting, counted)::acc
temp xs x 1 []
|> List.rev
| [] -> []

I would probably use a mutable solution for this. Maybe something like:
let countOccurrences l =
let counts = System.Collections.Generic.Dictionary()
l |> List.iter (fun x ->
match counts.TryGetValue(x) with
| true, i -> counts.[x] <- i + 1
| _ -> counts.Add(x, 1))
counts |> Seq.map (|KeyValue|)
EDIT
I forgot about countBy (which is implemented similarly).

If you're using recursion to traverse a list, you can always use fold.
let countOccurrences = function
| [] -> []
| x::xs -> ([(x,1)],xs)
||> List.fold(fun ((y,c)::acc) x -> if x = y then (y,c+1)::acc else (x,1)::(y,c)::acc)
|> List.rev

Related

F# Finding occurrences of value in list

I'm quite a newbie at F# and want to find how many times a value x has occurred in a list ys
So for example multiplicity (2, [1;2;3;4;2]) returns 2. The code I've written below returns 4 on the above example. What am I missing?
let rec multiplicity (x, ys) =
match ys with
| [] -> 0
| y::tail when x=y -> x + multiplicity(x, tail)
| y::tail -> multiplicity(x, tail)
If you're not writing this as a recursive function as a learning exercise, it's probably more idiomatic to use the built-in collection functions:
[1;2;3;4;2] |> Seq.filter ((=) 2) |> Seq.length
[1;2;3;4;2] |> List.sumBy (fun x -> if x = 2 then 1 else 0)
Alright, this is a good example of why it's always a good idea to write down a problem/question.
I figured out, I should do this instead:
let rec multiplicity (x, ys) =
match ys with
| [] -> 0
| y::tail when x=y -> 1 + multiplicity(x, tail)
| y::tail -> multiplicity(x, tail)
It should be 1 and not x, which is added to the recursive call, doh.
I find it's a good idea to replace recursion with fold, so here is another version:
let xs = [1;2;3;4;2]
(0,xs) ||> List.fold (fun acc elem -> match elem with
| 2 -> acc + 1
| _ -> acc)
You can also use countBy, which will return a list of tuples with true and false.
xs |> List.countBy (fun x -> x = 2)

Folding a list in F#

I have a pretty trivial task but I can't figure out how to make the solution prettier.
The goal is taking a List and returning results, based on whether they passed a predicate. The results should be grouped. Here's a simplified example:
Predicate: isEven
Inp : [2; 4; 3; 7; 6; 10; 4; 5]
Out: [[^^^^]......[^^^^^^^^]..]
Here's the code I have so far:
let f p ls =
List.foldBack
(fun el (xs, ys) -> if p el then (el::xs, ys) else ([], xs::ys))
ls ([], [])
|> List.Cons // (1)
|> List.filter (not << List.isEmpty) // (2)
let even x = x % 2 = 0
let ret =
[2; 4; 3; 7; 6; 10; 4; 5]
|> f even
// expected [[2; 4]; [6; 10; 4]]
This code does not seem to be readable that much. Also, I don't like lines (1) and (2). Is there any better solution?
Here is my take. you need a few helper functions first:
// active pattern to choose between even and odd intengers
let (|Even|Odd|) x = if (x % 2) = 0 then Even x else Odd x
// fold function to generate a state tupple of current values and accumulated values
let folder (current, result) x =
match x, current with
| Even x, _ -> x::current, result // even members a added to current list
| Odd x, [] -> current, result // odd members are ignored when current is empty
| Odd x, _ -> [], current::result // odd members starts a new current
// test on data
[2; 4; 3; 7; 6; 10; 4; 5]
|> List.rev // reverse list since numbers are added to start of current
|> List.fold folder ([], []) // perform fold over list
|> function | [],x -> x | y,x -> y::x // check that current is List.empty, otherwise add to result
How about this one?
let folder p l = function
| h::t when p(l) -> (l::h)::t
| []::_ as a -> a
| _ as a -> []::a
let f p ls =
ls
|> List.rev
|> List.fold (fun a l -> folder p l a) [[]]
|> List.filter ((<>) [])
At least the folder is crystal clear and effective, but then you pay the price for this by list reversing.
Here is a recursive solution based on a recursive List.filter
let rec _f p ls =
match ls with
|h::t -> if p(h) then
match f p t with
|rh::rt -> (h::rh)::rt
|[] -> (h::[])::[]
else []::f p t
|[] -> [[]]
let f p ls = _f p ls |> List.filter (fun t -> t <> [])
Having to filter at the end does seem inelegant though.
Here you go. This function should also have fairly good performance.
let groupedFilter (predicate : 'T -> bool) (list : 'T list) =
(([], []), list)
||> List.fold (fun (currentGroup, finishedGroups) el ->
if predicate el then
(el :: currentGroup), finishedGroups
else
match currentGroup with
| [] ->
[], finishedGroups
| _ ->
// This is the first non-matching element
// following a matching element.
// Finish processing the previous group then
// add it to the finished groups list.
[], ((List.rev currentGroup) :: finishedGroups))
// Need to do a little clean-up after the fold.
|> fun (currentGroup, finishedGroups) ->
// If the current group is non-empty, finish it
// and add it to the list of finished groups.
let finishedGroups =
match currentGroup with
| [] -> finishedGroups
| _ ->
(List.rev currentGroup) :: finishedGroups
// Reverse the finished groups list so the grouped
// elements will be in their original order.
List.rev finishedGroups;;
With the list reversing, I would like to go to #seq instead of list.
This version uses mutation (gasp!) internally for efficiency, but may also be a little slower with the overhead of seq. I think it is quite readable though.
let f p (ls) = seq {
let l = System.Collections.Generic.List<'a>()
for el in ls do
if p el then
l.Add el
else
if l.Count > 0 then yield l |> List.ofSeq
l.Clear()
if l.Count > 0 then yield l |> List.ofSeq
}
I can't think of a way to do this elegantly using higher order functions, but here's a solution using a list comprehension. I think it's fairly straightforward to read.
let f p ls =
let rec loop xs =
[ match xs with
| [] -> ()
| x::xs when p x ->
let group, rest = collectGroup [x] xs
yield group
yield! loop rest
| _::xs -> yield! loop xs ]
and collectGroup acc = function
| x::xs when p x -> collectGroup (x::acc) xs
| xs -> List.rev acc, xs
loop ls

Swapping every pair of items in an F# list

I'm positive that there is a better way to swap items in a list by pairs ( [1;2;3;4] -> [2;1;4;3] ) as I'm doing too many appends for my liking but I'm not sure how best to do it.
let swapItems lst =
let f acc item =
match acc with
| [] -> [item]
| hd :: next :: tl when tl <> [] -> [next] # tl # [item;hd]
| _ -> item :: acc
List.fold f [] lst
How can I improve this? This only works on lists that have an even length.
Simplest possible solution:
let rec swapItems = function
| a::b::xs -> b::a::swapItems xs
| xs -> xs
I like to make the names of variables that are sequences like lists "plural", e.g. xs instead of x.
Note that this is not tail recursive so it will stack overflow if you give it a very long list.
What about this:
let rec swapItems = function
| []
| _::[] as l -> l
| a::b::t ->
b::a::(swapItems t)
?
Using higher order functions this can be done as:
let swapItems l =
l |> List.toSeq |> Seq.pairwise
|> Seq.mapi (fun i (a,b) -> if i % 2 = 0 then seq [b;a] else Seq.empty)
|> Seq.concat |> Seq.toList

Avoiding code duplication in F#

I have two snippets of code that tries to convert a float list to a Vector3 or Vector2 list. The idea is to take 2/3 elements at a time from the list and combine them as a vector. The end result is a sequence of vectors.
let rec vec3Seq floatList =
seq {
match floatList with
| x::y::z::tail -> yield Vector3(x,y,z)
yield! vec3Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 3?"
}
let rec vec2Seq floatList =
seq {
match floatList with
| x::y::tail -> yield Vector2(x,y)
yield! vec2Seq tail
| [] -> ()
| _ -> failwith "float array not multiple of 2?"
}
The code looks very similiar and yet there seems to be no way to extract a common portion. Any ideas?
Here's one approach. I'm not sure how much simpler this really is, but it does abstract some of the repeated logic out.
let rec mkSeq (|P|_|) x =
seq {
match x with
| P(p,tail) ->
yield p
yield! mkSeq (|P|_|) tail
| [] -> ()
| _ -> failwith "List length mismatch" }
let vec3Seq =
mkSeq (function
| x::y::z::tail -> Some(Vector3(x,y,z), tail)
| _ -> None)
As Rex commented, if you want this only for two cases, then you probably won't have any problem if you leave the code as it is. However, if you want to extract a common pattern, then you can write a function that splits a list into sub-list of a specified length (2 or 3 or any other number). Once you do that, you'll only use map to turn each list of the specified length into Vector.
The function for splitting list isn't available in the F# library (as far as I can tell), so you'll have to implement it yourself. It can be done roughly like this:
let divideList n list =
// 'acc' - accumulates the resulting sub-lists (reversed order)
// 'tmp' - stores values of the current sub-list (reversed order)
// 'c' - the length of 'tmp' so far
// 'list' - the remaining elements to process
let rec divideListAux acc tmp c list =
match list with
| x::xs when c = n - 1 ->
// we're adding last element to 'tmp',
// so we reverse it and add it to accumulator
divideListAux ((List.rev (x::tmp))::acc) [] 0 xs
| x::xs ->
// add one more value to 'tmp'
divideListAux acc (x::tmp) (c+1) xs
| [] when c = 0 -> List.rev acc // no more elements and empty 'tmp'
| _ -> failwithf "not multiple of %d" n // non-empty 'tmp'
divideListAux [] [] 0 list
Now, you can use this function to implement your two conversions like this:
seq { for [x; y] in floatList |> divideList 2 -> Vector2(x,y) }
seq { for [x; y; z] in floatList |> divideList 3 -> Vector3(x,y,z) }
This will give a warning, because we're using an incomplete pattern that expects that the returned lists will be of length 2 or 3 respectively, but that's correct expectation, so the code will work fine. I'm also using a brief version of sequence expression the -> does the same thing as do yield, but it can be used only in simple cases like this one.
This is simular to kvb's solution but doesn't use a partial active pattern.
let rec listToSeq convert (list:list<_>) =
seq {
if not(List.isEmpty list) then
let list, vec = convert list
yield vec
yield! listToSeq convert list
}
let vec2Seq = listToSeq (function
| x::y::tail -> tail, Vector2(x,y)
| _ -> failwith "float array not multiple of 2?")
let vec3Seq = listToSeq (function
| x::y::z::tail -> tail, Vector3(x,y,z)
| _ -> failwith "float array not multiple of 3?")
Honestly, what you have is pretty much as good as it can get, although you might be able to make a little more compact using this:
// take 3 [1 .. 5] returns ([1; 2; 3], [4; 5])
let rec take count l =
match count, l with
| 0, xs -> [], xs
| n, x::xs -> let res, xs' = take (count - 1) xs in x::res, xs'
| n, [] -> failwith "Index out of range"
// split 3 [1 .. 6] returns [[1;2;3]; [4;5;6]]
let rec split count l =
seq { match take count l with
| xs, ys -> yield xs; if ys <> [] then yield! split count ys }
let vec3Seq l = split 3 l |> Seq.map (fun [x;y;z] -> Vector3(x, y, z))
let vec2Seq l = split 2 l |> Seq.map (fun [x;y] -> Vector2(x, y))
Now the process of breaking up your lists is moved into its own generic "take" and "split" functions, its much easier to map it to your desired type.

Splitting a list into list of lists based on predicate

(I am aware of this question, but it relates to sequences, which is not my problem here)
Given this input (for example):
let testlist =
[
"*text1";
"*text2";
"text3";
"text4";
"*text5";
"*text6";
"*text7"
]
let pred (s:string) = s.StartsWith("*")
I would like to be able to call MyFunc pred testlist and get this output:
[
["*text1";"*text2"];
["*text5";"*text6";"*text7"]
]
This is my current solution, but I don't really like the nested List.revs (ignore the fact that it takes Seq as input)
let shunt pred sq =
let shunter (prevpick, acc) (pick, a) =
match pick, prevpick with
| (true, true) -> (true, (a :: (List.hd acc)) :: (List.tl acc))
| (false, _) -> (false, acc)
| (true, _) -> (true, [a] :: acc)
sq
|> Seq.map (fun a -> (pred a, a))
|> Seq.fold shunter (false, [])
|> snd
|> List.map List.rev
|> List.rev
there is a List.partition function in the F# core library (in case you wanted to implement this just to have it working and not to learn how to write recursive functions yourself). Using this function, you can write this:
> testlist |> List.partition (fun s -> s.StartsWith("*"))
val it : string list * string list =
(["*text1"; "*text2"; "*text5"; "*text6"; "*text7"], ["text3"; "text4"])
Note that this function returns a tuple instead of returning a list of lists. This is a bit different to what you wanted, but if the predicate returns just true or false, then this makes more sense.
The implementation of partition function that returns tuples is also a bit simpler, so it may be useful for learning purposes:
let partition pred list =
// Helper function, which keeps results collected so
// far in 'accumulator' arguments outTrue and outFalse
let rec partitionAux list outTrue outFalse =
match list with
| [] ->
// We need to reverse the results (as we collected
// them in the opposite order!)
List.rev outTrue, List.rev outFalse
// Append element to one of the lists, depending on 'pred'
| x::xs when pred x -> partitionAux xs (x::outTrue) outFalse
| x::xs -> partitionAux xs outTrue (x::outFalse)
// Run the helper function
partitionAux list [] []
Edit: rev-less version using foldBack added below.
Here's some code that uses lists and tail-recursion:
//divides a list L into chunks for which all elements match pred
let divide pred L =
let rec aux buf acc L =
match L,buf with
//no more input and an empty buffer -> return acc
| [],[] -> List.rev acc
//no more input and a non-empty buffer -> return acc + rest of buffer
| [],buf -> List.rev (List.rev buf :: acc)
//found something that matches pred: put it in the buffer and go to next in list
| h::t,buf when pred h -> aux (h::buf) acc t
//found something that doesn't match pred. Continue but don't add an empty buffer to acc
| h::t,[] -> aux [] acc t
//found input that doesn't match pred. Add buffer to acc and continue with an empty buffer
| h::t,buf -> aux [] (List.rev buf :: acc) t
aux [] [] L
usage:
> divide pred testlist;;
val it : string list list =
[["*text1"; "*text2"]; ["*text5"; "*text6"; "*text7"]]
Using a list as data structure for a buffer means that it always needs to be reversed when outputting the contents. This may not be a problem if individual chunks are modestly sized. If speed/efficiency becomes an issue, you could use a Queue<'a> or a `List<'a>' for the buffers, for which appending is fast. But using these data structures instead of lists also means that you lose the powerful list pattern matching. In my opinion, being able to pattern match lists outweighs the presence of a few List.rev calls.
Here's a streaming version that outputs the result one block at a time. This avoids the List.rev on the accumulator in the previous example:
let dividestream pred L =
let rec aux buf L =
seq { match L, buf with
| [],[] -> ()
| [],buf -> yield List.rev buf
| h::t,buf when pred h -> yield! aux (h::buf) t
| h::t,[] -> yield! aux [] t
| h::t,buf -> yield List.rev buf
yield! aux [] t }
aux [] L
This streaming version avoids the List.rev on the accumulator. Using List.foldBack can be used to avoid reversing the accumulated chunks as well.
update: here's a version using foldBack
//divides a list L into chunks for which all elements match pred
let divide2 pred L =
let f x (acc,buf) =
match pred x,buf with
| true,buf -> (acc,x::buf)
| false,[] -> (acc,[])
| false,buf -> (buf::acc,[])
let rest,remainingBuffer = List.foldBack f L ([],[])
match remainingBuffer with
| [] -> rest
| buf -> buf :: rest
Just reverse the list once up front, and then build the structure in order easily:
let Shunt p l =
let mutable r = List.rev l
let mutable result = []
while not r.IsEmpty do
let mutable thisBatch = []
while not r.IsEmpty && not(p r.Head) do
r <- r.Tail
while not r.IsEmpty && p r.Head do
thisBatch <- r.Head :: thisBatch
r <- r.Tail
if not thisBatch.IsEmpty then
result <- thisBatch :: result
result
The outer while deals with each 'batch', and the first inner while skips over any that don't match the predicate, followed by another while that grabs all those that do and stores them in the current batch. If there was anything in this batch (the final one may be empty), prepend it to the final result.
This is an example where I think locally imperative code is simply superior to a purely functional counterpart. The code above is so easy to write and to reason about.
Another version of shunt:
let shunt pred lst =
let rec tWhile pred lst =
match lst with
| [] -> [], []
| hd :: tl when pred hd -> let taken, rest = tWhile pred tl
(hd :: taken), rest
| lst -> [], lst
let rec collect = function
| [] -> []
| lst -> let taken, rest = tWhile pred lst
taken :: (collect (snd (tWhile (fun x -> not (pred x)) rest)))
collect lst
This one avoids List.rev but it's not tail recursive - so only suitable for small lists.
yet another one...
let partition pred lst =
let rec trec xs cont =
match xs with
| [] -> ([],[]) |> cont
| h::t when pred h -> (fun (y,n) -> h::y,n) >> cont |> trec t
| h::t -> (fun (y,n) -> y,h::n) >> cont |> trec t
trec lst id
then we can define shunt:
let shunt pred lst = lst |> partition pred |> (fun (x,y) -> [x;y])

Resources