Partitioning a list in F# based on whole group characteristics

Question

I only started programming in F# yesterday, so I've not yet discovered what idiomatic F# actually looks like.

The first task I set myself required partitioning a list into smaller lists but where the partitioning is based on the characteristics of the whole group, rather than just being able to find split points based on the current element.

For example, given the list [1;2;3;4;5], I might want to group into sub-lists when the sum of the sub-list has reached at least 5. This would result in the output [[1;2;3]; [4;5]].

Any remaining elements that don't meet the criteria would be in a final sub-list.

My first attempt is below:

module Test

let rec partitionOn groupComplete list =
    let take list n = Seq.take n list

    // Take items from the front of the list until they form a complete group
    // or there are no more items
    let firstGroupAndRemainder itemsList =
        let firstGroup =
            [0 .. List.length itemsList]
            |> Seq.map (take itemsList)
            |> Seq.tryFind groupComplete
        match firstGroup with
        | Some g ->
            let groupList = g |> Seq.toList
            let remainingList = Seq.skip (List.length groupList) itemsList |> Seq.toList
            (groupList, remainingList)
        | None -> (itemsList, [])

    match list with
    | [] -> []
    | _ ->
        let group, rest = firstGroupAndRemainder list
        [group] @ partitionOn groupComplete rest

[<EntryPoint>]
let main argv =
    // Groups with sum greater than 5 (plus remaining elements)
    let result1 = partitionOn (fun l -> Seq.sum l > 5) [1;5;2;6;2]
    printfn "result1: %A" result1 // [[1;5]; [2;6]; [2]]

    // Groups with length 3 (plus remaining elements)
    let result2 = partitionOn (fun l -> Seq.length l = 3) [1;5;2;6;2]
    printfn "result2: %A" result2  // [[1;5;2]; [6;2]]

    0

It feels like there should be a simpler way to achieve this but I haven't yet thought of it.

Update

I've discovered the defaultArg function, so the firstGroupAndRemainder function might be slightly tidier as:

let firstGroupAndRemainder itemsList =
    let firstGroup =
        [0 .. List.length itemsList]
        |> Seq.map (take itemsList)
        |> Seq.tryFind groupComplete
    let groupList = (defaultArg firstGroup (List.toSeq itemsList)) |> Seq.toList
    let remainingList = Seq.skip (List.length groupList) itemsList |> Seq.toList
    (groupList, remainingList)

Answer 1

Not much of a review but another way is to use Seq.fold:

let partitionOn delimiter sequence = 
    let folder (groups, acc) x =
        let curAcc = x :: acc
        if (delimiter curAcc) then
            (curAcc :: groups, [])
        else
            (groups, curAcc)
    let groups, reminders = (sequence |> Seq.fold folder ([], []))
    ((groups |> List.map (fun l -> l |> List.rev)) |> List.rev, reminders)

---

One problem with your solutions is that they aren't tail recursive and for large data sets they build up the stack. A way to avoid that could be like the below modification of the solution in your own answer:

let partitionOn groupComplete list =
    let rec inner currentGroup remainingList groups =
        match (currentGroup, remainingList) with
        | (group, []) -> groups, group
        | (group, remaining) when groupComplete group -> (inner [] remaining (groups @ [group]))
        | (group, head::tail) -> inner (group @ [head]) tail groups
    inner [] list []

Here the groups found so far are given as argument to the rec inner function and finally returned as the first part of the resulting tuple (with the remaining items as the last).

Yet another aspect to consider is performance...

Answer 2

Based on this answer from the Haskell version of this question, it looks like we can do something as simple as:

let partitionOn groupComplete list =
    let rec inner currentGroup remainingList =
        match (currentGroup, remainingList) with
        | (group, []) -> [group]
        | (group, remaining) when groupComplete group -> [group] @ (inner [] remaining)
        | (group, head::tail) -> inner (group @ [head]) tail
    inner [] list

This simply recursively handles the three cases of: running out of elements; having a complete group; and building a group.

Update

Henrik Hansen pointed out that it is preferable to have a tail-recursive function. One possible way of achieving this is:

let partitionOn groupComplete list =
    let rec inner currentGroup remainingList =
        match remainingList with
        | [] -> [currentGroup]
        | head::tail ->
            let complete = groupComplete currentGroup
            let additionalGroup = if complete then [currentGroup] else []
            let newCurrentGroup = if complete then [] else currentGroup @ [head]
            let newRemaining = if complete then remainingList else tail
            additionalGroup @ (inner newCurrentGroup newRemaining)
    inner [] list

This merges together the last two cases of the match and gives a single call to inner at the end.

Update 2

If we look at the IL for this version, we can see that it is tail recursive:

    ...
    IL_0069: tail.
    IL_006b: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!0> [FSharp.Core]Microsoft.FSharp.Core.Operators::op_Append<class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!a>>(class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!0>, class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!0>)
    IL_0070: ret
    IL_0071: ldarg.1
    IL_0072: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!0> class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!a>>::get_Empty()
    IL_0077: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!0> class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!!a>>::Cons(!0, class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1<!0>)
    IL_007c: ret
} // end of method _::'inner@2-5'

Update 3

Nice idea to use a fold, from TheQuickBrownFox. This can be done more simply using the built-in fold function, keeping the same API:

let partitionOn groupComplete list =
    let folder acc x =
        match List.rev acc with
        | [] -> [[x]]
        | current::rest when groupComplete current -> acc @ [[x]]
        | current::rest -> (List.rev rest) @ [current @ [x]]
    List.fold folder [] list

However, @ is O(n), whereas :: is O(1), so it should really be:

let partitionOn groupComplete list =
    let folder acc x =
        match acc with
        | [] -> [[x]]
        | current::rest when groupComplete current -> [x]::acc
        | current::rest -> (x::current)::rest
    List.fold folder [] list |> List.map List.rev |> List.rev

Update 4

Based on TheQuickBrownFox comment the fold could be modified as follows:

let partitionOn initialGroupValue groupUpdate groupComplete list =
    let folder acc x =
        match acc with
        | ([], score) -> ([[x]], groupUpdate score x)
        | (a, score) when groupComplete score -> ([x]::a, groupUpdate initialGroupValue x)
        | (current::rest, score) -> ((x::current)::rest, groupUpdate score x)
    List.fold folder ([], initialGroupValue) list |> fst |> List.map List.rev |> List.rev

This version separates the current group evaluation into an update and a test, so that the minimum change is made for each iteration of the fold and the whole group doesn't need to be recalculated each time.

Answer 3

The groupComplete predicate could instead be expressed in terms of a fold: a folder function, a starting state and a predicate on the state instead of the whole group. This has the advantage that it could be a lot more efficient, you don't have to keep rechecking each element multiple times. However, it's a bit harder to use. Here's an implementation I came up with if you're interested:

let foldPartition folder zeroState predicate list =
    let rec loop result state currentGroup = function
        | [] -> List.rev (List.rev currentGroup :: result)
        | x :: xs ->
            let state' = folder state x
            if predicate state' then
                let result' = (List.rev (x :: currentGroup)) :: result
                loop result' zeroState [] xs
            else
                loop result state' (x :: currentGroup) xs
    loop [] zeroState [] list

Usage:

foldPartition (+) 0 (fun x -> x > 5) [1;5;2;6;2]
foldPartition (fun n _ -> n + 1) 0 ((=) 3) [1;5;2;6;2]