Benchmark created to support PR#1453 for Microsoft/visualfsharp

benchmark-fsharp-set-diff.fs

module Program

open System
open System.Collections.Generic
open System.Threading.Tasks

/// https://www.nuget.org/packages/BenchmarkDotNet/
/// https://www.nuget.org/packages/BenchmarkDotNet.Diagnostics.Windows/

open BenchmarkDotNet.Attributes
open BenchmarkDotNet.Running
open BenchmarkDotNet.Configs
open BenchmarkDotNet.Jobs

#if MONO
#else
open BenchmarkDotNet.Diagnostics.Windows
#endif
                 
module SetForBenchmark =
    type SetTree<'T> when 'T : comparison = 
        | SetEmpty
        | SetNode of 'T * SetTree<'T> *  SetTree<'T> * int
        | SetOne  of 'T
    
    let tolerance = 2

    let height t = 
        match t with 
        | SetEmpty -> 0
        | SetOne _ -> 1
        | SetNode (_,_,_,h) -> h

    let mk l k r = 
        match l,r with 
        | SetEmpty,SetEmpty -> SetOne (k)
        | _ -> 
            let hl = height l 
            let hr = height r 
            let m = if hl < hr then hr else hl 
            SetNode(k,l,r,m+1)

    let rebalance t1 k t2 =
        let t1h = height t1 
        let t2h = height t2 
        if  t2h > t1h + tolerance then // right is heavier than left 
            match t2 with 
            | SetNode(t2k,t2l,t2r,_) -> 
                // one of the nodes must have height > height t1 + 1 
                if height t2l > t1h + 1 then  // balance left: combination 
                    match t2l with 
                    | SetNode(t2lk,t2ll,t2lr,_) ->
                        mk (mk t1 k t2ll) t2lk (mk t2lr t2k t2r) 
                    | _ -> failwith "rebalance"
                else // rotate left 
                    mk (mk t1 k t2l) t2k t2r
            | _ -> failwith "rebalance"
        else
            if  t1h > t2h + tolerance then // left is heavier than right 
                match t1 with 
                | SetNode(t1k,t1l,t1r,_) -> 
                    // one of the nodes must have height > height t2 + 1 
                    if height t1r > t2h + 1 then 
                        // balance right: combination 
                        match t1r with 
                        | SetNode(t1rk,t1rl,t1rr,_) ->
                            mk (mk t1l t1k t1rl) t1rk (mk t1rr k t2)
                        | _ -> failwith "rebalance"
                    else
                        mk t1l t1k (mk t1r k t2)
                | _ -> failwith "rebalance"
            else mk t1 k t2

    let rec spliceOutSuccessor t = 
        match t with 
        | SetEmpty -> failwith "internal error: Set.spliceOutSuccessor"
        | SetOne (k2) -> k2,SetEmpty
        | SetNode (k2,l,r,_) ->
            match l with 
            | SetEmpty -> k2,r
            | _ -> let k3,l' = spliceOutSuccessor l in k3,mk l' k2 r

    let rec add (comparer: IComparer<'T>) k t = 
        match t with 
        | SetNode (k2,l,r,_) -> 
            let c = comparer.Compare(k,k2) 
            if   c < 0 then rebalance (add comparer k l) k2 r
            elif c = 0 then t
            else            rebalance l k2 (add comparer k r)
        | SetOne(k2) -> 
            // nb. no check for rebalance needed for small trees, also be sure to reuse node already allocated 
            let c = comparer.Compare(k,k2) 
            if c < 0   then SetNode (k,SetEmpty,t,2)
            elif c = 0 then t
            else            SetNode (k,t,SetEmpty,2)                  
        | SetEmpty -> SetOne(k)

    let rec remove (comparer: IComparer<'T>) k t = 
        match t with 
        | SetEmpty -> t
        | SetOne (k2) -> 
            let c = comparer.Compare(k,k2) 
            if   c = 0 then SetEmpty
            else            t
        | SetNode (k2,l,r,_) -> 
            let c = comparer.Compare(k,k2) 
            if   c < 0 then rebalance (remove comparer k l) k2 r
            elif c = 0 then 
                match l,r with 
                | SetEmpty,_ -> r
                | _,SetEmpty -> l
                | _ -> 
                    let sk,r' = spliceOutSuccessor r 
                    mk l sk r'
            else rebalance l k2 (remove comparer k r) 

    let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) SetEmpty l

    // THE ORIGINAL METHOD, THAT WAS
    let rec diffAux comparer m acc = 
        match m with 
        | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc))
        | SetOne(k) -> remove comparer k acc
        | SetEmpty -> acc

    // THE METHOD AFTER MODIFICATION
    let rec diffAuxModified comparer m acc = 
        match acc with 
        | SetEmpty -> acc
        | _ ->
        match m with 
        | SetNode(k,l,r,_) -> diffAux comparer l (diffAux comparer r (remove comparer k acc))
        | SetOne(k) -> remove comparer k acc
        | SetEmpty -> acc

    let diff comparer a b = diffAux comparer b a
    
    let diffModified comparer a b = diffAuxModified comparer b a


type SetDiffPerfConfig () =
    inherit ManualConfig()
    do 
        base.Add Job.RyuJitX64

        #if MONO
        #else
        base.Add(new MemoryDiagnoser())
        #endif


[<Config(typeof<SetDiffPerfConfig>)>]
type SetDifferenceBenchmark () =
    
    let random = Random()
    let comparer = LanguagePrimitives.FastGenericComparer<int>

    let mutable firstSet = SetForBenchmark.SetEmpty
    let mutable secondSet = SetForBenchmark.SetEmpty

    let arrayOfMaxLen len =
        Array.init len (fun i -> int(random.NextDouble()*2.0*float(len)))

    [<Params(0, 10, 100)>]
    member val public FirstSetItemCount = 0 with get, set

    [<Params(0, 10, 100)>]
    member val public SecondSetItemCount = 0 with get, set 

    [<Setup>]
    member this.Setup () =
        firstSet <- this.FirstSetItemCount |> arrayOfMaxLen |> SetForBenchmark.ofArray comparer
        secondSet <- this.SecondSetItemCount |> arrayOfMaxLen |> SetForBenchmark.ofArray comparer

    [<Benchmark(Baseline=true)>]
    member this.OriginalMethod () =
        SetForBenchmark.diff comparer firstSet secondSet |> ignore

    [<Benchmark>]
    member this.ModifiedMethod () =
        SetForBenchmark.diffModified comparer firstSet secondSet |> ignore

[<EntryPoint>]
let main argv =              
    
    let switch = 
        BenchmarkSwitcher [|
            typeof<SetDifferenceBenchmark>
        |]

    switch.Run argv |> ignore
    0

benchmark-result.md

Host Process Environment Information:
BenchmarkDotNet.Core=v0.9.9.0
OS=Microsoft Windows NT 6.2.9200.0
Processor=Intel(R) Core(TM) i7-4710HQ CPU 2.50GHz, ProcessorCount=8
Frequency=2439991 ticks, Resolution=409.8376 ns, Timer=TSC
CLR=MS.NET 4.0.30319.42000, Arch=64-bit RELEASE [RyuJIT]
GC=Concurrent Workstation
JitModules=clrjit-v4.6.1080.0

Type=SetDifferenceBenchmark  Mode=Throughput  Platform=X64  
Jit=RyuJit  

Method	FirstSetItemCount	SecondSetItemCount	Median	StdDev	Scaled	Scaled-SD	Gen 0	Gen 1	Gen 2	Bytes Allocated/Op
OriginalMethod	0	0	6.3329 ns	0.1011 ns	1.00	0.00	-	-	-	0.00
ModifiedMethod	0	0	3.4246 ns	0.0493 ns	0.54	0.01	-	-	-	0.00
OriginalMethod	0	10	134.0573 ns	19.9930 ns	1.00	0.00	-	-	-	0.01
ModifiedMethod	0	10	3.4266 ns	0.0351 ns	0.03	0.00	-	-	-	0.00
OriginalMethod	0	100	1,436.9095 ns	73.6156 ns	1.00	0.00	-	-	-	0.14
ModifiedMethod	0	100	3.4256 ns	0.1928 ns	0.00	0.00	-	-	-	0.00
OriginalMethod	10	0	6.4268 ns	0.1003 ns	1.00	0.00	-	-	-	0.00
ModifiedMethod	10	0	8.4511 ns	0.2946 ns	1.33	0.05	-	-	-	0.00
OriginalMethod	10	10	1,013.7267 ns	198.7324 ns	1.00	0.00	52.53	-	-	357.31
ModifiedMethod	10	10	997.5556 ns	198.8970 ns	1.03	0.30	51.93	-	-	353.88
OriginalMethod	10	100	10,271.1103 ns	2,448.6114 ns	1.00	0.00	536.10	-	-	3,676.07
ModifiedMethod	10	100	10,185.6326 ns	2,326.5314 ns	1.04	0.35	538.28	-	-	3,693.48
OriginalMethod	100	0	6.3741 ns	0.1009 ns	1.00	0.00	-	-	-	0.00
ModifiedMethod	100	0	8.4242 ns	0.0592 ns	1.32	0.02	-	-	-	0.00
OriginalMethod	100	10	2,491.3317 ns	427.6977 ns	1.00	0.00	127.90	-	-	871.12
ModifiedMethod	100	10	2,502.6171 ns	420.1160 ns	1.03	0.27	130.60	-	-	889.54
OriginalMethod	100	100	25,529.7993 ns	1,219.4332 ns	1.00	0.00	1,113.24	-	-	7,595.49
ModifiedMethod	100	100	25,155.1821 ns	1,575.0865 ns	0.99	0.08	1,098.00	-	-	7,549.01