countbyPerformance.fsx

open System.Diagnostics
open System.Reflection
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Primitives.Basics
open System.Collections.Generic

let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) (projection:'T->'SafeKey) (getKey:'SafeKey->'Key) (list:'T list) =
    let dict = Dictionary comparer
    let rec loop srcList  =
        match srcList with
        | [] -> ()
        | h::t ->
            let safeKey = projection h
            let mutable prev = 0
            if dict.TryGetValue(safeKey, &prev) then dict.[safeKey] <- prev + 1 else dict.[safeKey] <- 1
            loop t
    loop list
    let mutable result = []
    for group in dict do
        result <- (getKey group.Key, group.Value) :: result
    result |> List.rev

// We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance
let countByValueType (projection:'T->'Key) (list:'T list) = countByImpl HashIdentity.Structural<'Key> projection id list

let countBy (projection:'T->'Key) (list:'T list) =
    countByValueType projection list

let run (f : 'a -> 'b) l =
    let res = f l
    for i in 2..500 do
        f l |> ignore
    res
let count = 5000000
let listOfInts = [1..count]

let listOfInts1 = List.concat [[1..count]; [1..10000]; [1..10000]]

#time "on"
run List.countBy id listOfInts //Real: 00:00:01.859, CPU: 00:00:02.015, GC gen0: 27, gen1: 26, gen2: 1
#time "off"
#time "on"
run countBy id listOfInts //Real: 00:00:01.935, CPU: 00:00:01.859, GC gen0: 38, gen1: 38, gen2: 0
#time "off"

#time "on"
run List.countBy (fun i -> if i % 2 = 0 then 0 else 1) listOfInts //Real: 00:00:00.190, CPU: 00:00:00.187, GC gen0: 0, gen1: 0, gen2: 0
#time "off"
#time "on"
run countBy (fun i -> if i % 2 = 0 then 0 else 1) listOfInts //Real: 00:00:00.217, CPU: 00:00:00.218, GC gen0: 0, gen1: 0, gen2: 0
#time "off"


#time "on"
run List.countBy id listOfInts1 //Real: 00:00:02.340, CPU: 00:00:02.265, GC gen0: 26, gen1: 25, gen2: 1
#time "off"
#time "on"
run countBy id listOfInts1 //Real: 00:00:06.138, CPU: 00:00:05.953, GC gen0: 41, gen1: 38, gen2: 2
#time "off"

change the file extension to .fs or .fsx so it highlights properly