Folding a list in F# - f#

Question

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?

Answer 1

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

Answer 2

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.

Answer 3

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.

Answer 4

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;;

Answer 5

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
}

Answer 6

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