ttsiodras.fs

open Perf

open System
open System.Diagnostics
open System.IO
open System.Collections.Generic

let inline run<'key when 'key : equality> (comparer:IEqualityComparer<'key>) (createKey:int -> int -> 'key)  =
    let g_maxSize = 4480
    let fileSizes = [ 1 .. 99 ]

    let optimalResults = Dictionary comparer
    let lastStep = Dictionary comparer

    let inline FetchOrZero (dict:Dictionary<_,_>) (k:'key) = 
        let mutable v = Unchecked.defaultof<_>
        if dict.TryGetValue (k, &v) then v else 0

    for containerSize in 0 .. g_maxSize do
        for (idx,fileSize) in List.mapi (fun i x -> (i,x)) fileSizes do
            // We will index the "optimalResults" via tuples:
            let cellCurrent = createKey containerSize idx              // The current cell
            let cellOnTheLeftOfCurrent = createKey containerSize (idx-1) // The cell on our left
            // Does the file on column "idx" fit inside containerSize?
            if containerSize<fileSize then
                // it doesn't fit in containerSize
                // so copy optimal value from the cell on its left
                optimalResults.[cellCurrent] <- FetchOrZero optimalResults cellOnTheLeftOfCurrent
                // Copy last step from cell on the left...
                lastStep.[cellCurrent] <- FetchOrZero lastStep cellOnTheLeftOfCurrent
            else
                // It fits!
                // Using file of column "idx", the remaining space is...
                let remainingSpace = containerSize - fileSize
                // and for that remaining space, the optimal result 
                // using the first idx-1 files has been found to be:
                let optimalResultOfRemainingSpace = FetchOrZero optimalResults (createKey remainingSpace (idx-1))
                // so let's check: do we improve things by using "idx"?
                if optimalResultOfRemainingSpace + fileSize > FetchOrZero optimalResults cellOnTheLeftOfCurrent then
                    // we improved the best result, store it!
                    optimalResults.[cellCurrent] <- optimalResultOfRemainingSpace + fileSize
                    // Store last step - i.e. using file "idx"
                    lastStep.[cellCurrent] <- fileSize
                else
                    // no improvement by using "idx" - copy from left...
                    optimalResults.[cellCurrent] <- FetchOrZero optimalResults cellOnTheLeftOfCurrent
                    // Copy last step from cell on the left...
                    lastStep.[cellCurrent] <- FetchOrZero lastStep cellOnTheLeftOfCurrent
   

//    printfn "Attainable: %d" (FetchOrZero optimalResults (g_maxSize,fileSizes.Length-1))
   
    // Navigate backwards... starting from the optimal result:
    let rightMostIndex = fileSizes.Length-1
    let mutable total = FetchOrZero optimalResults (createKey g_maxSize rightMostIndex)
    while total>0 do
       // The last step we used to get to "total" was...
       let lastFileSize = lastStep.[createKey total rightMostIndex]
//       printfn "%d removing %d" total lastFileSize
       // And the one before the last step was... (loop)
       total <- total - lastFileSize
    total

let runTrials theType f =
    let count = 10

    printf "%s " theType

    let runs = ResizeArray ()
    for i = 1 to count do
        System.GC.Collect ()
        let sw = Stopwatch.StartNew ()
        let t = f ()
        System.GC.Collect ()
        runs.Add sw.ElapsedMilliseconds
        printf "."
    runs.Sort ()

    let averageTime = 
        runs
        |> Seq.skip 2
        |> Seq.take (count-4)
        |> Seq.map float
        |> Seq.average
    
    printfn " %0.2f" averageTime

type GenericStruct<'a> =
  struct
    val Item1 : 'a
    val Item2 : 'a
    new (i1, i2) = { Item1 = i1; Item2 = i2 }
  end

type Struct =
  struct
    val Item1 : int
    val Item2 : int
    new (i1, i2) = { Item1 = i1; Item2 = i2 }
  end

type GenericRef<'a> = { 
    Item1 : 'a
    Item2 : 'a
}

type Ref = { 
    Item1 : int
    Item2 : int
}

module Help =
    let IEquatable_Equals<'a when 'a :> IEquatable<'a>> (this:'a) (other:'a) = 
        this.Equals other

[<CustomEquality; NoComparisonAttribute>]
type CustomStruct =
  struct
    val Item1 : int
    val Item2 : int
    new (i1, i2) = { Item1 = i1; Item2 = i2 }

    override this.Equals other =
        match other with
        | :? CustomStruct as other -> Help.IEquatable_Equals this other
        | _ -> failwith "unexpected"

    override this.GetHashCode () =
        (this.Item1 <<< 5) + this.Item1 ^^^ this.Item2 // the same as Tuple
    interface IEquatable<CustomStruct> with
        member this.Equals other =
            other.Item1 = this.Item1 && other.Item2 = this.Item2
  end

type Comparer<'a when 'a : equality>() =
     member __.Comparer = HashIdentity.Structural<'a>

type DynamicComparer<'a when 'a : equality> =
    static member Comparer =
        let t = typedefof<Comparer<_>>.MakeGenericType [|typeof<'a>|]
        match System.Activator.CreateInstance t with
        | :? Comparer<'a> as c -> c.Comparer
        | _ -> failwith "unexpected"

let customDynamic        () = run DynamicComparer.Comparer (fun x y -> CustomStruct(x, y))
let customStructural     () = run HashIdentity.Structural  (fun x y -> CustomStruct(x, y))
let customDefault        () = run EqualityComparer.Default (fun x y -> CustomStruct(x, y))
let valueDynamic         () = run DynamicComparer.Comparer (fun x y -> Struct(x, y))
let valueStructural      () = run HashIdentity.Structural  (fun x y -> Struct(x, y))
let valueDefault         () = run EqualityComparer.Default (fun x y -> Struct(x, y))
let genValueDynamic      () = run DynamicComparer.Comparer (fun x y -> GenericStruct(x, y))
let genValueStructural   () = run HashIdentity.Structural  (fun x y -> GenericStruct(x, y))
let genValueDefault      () = run EqualityComparer.Default (fun x y -> GenericStruct(x, y))
let refDynamic           () = run DynamicComparer.Comparer (fun x y -> { Ref.Item1 = x; Item2 = y })
let refStructural        () = run HashIdentity.Structural  (fun x y -> { Ref.Item1 = x; Item2 = y })
let refDefault           () = run EqualityComparer.Default (fun x y -> { Ref.Item1 = x; Item2 = y })
let genRefDynamic        () = run DynamicComparer.Comparer (fun x y -> { GenericRef.Item1 = x; Item2 = y })
let genRefStructural     () = run HashIdentity.Structural  (fun x y -> { GenericRef.Item1 = x; Item2 = y })
let genRefDefault        () = run EqualityComparer.Default (fun x y -> { GenericRef.Item1 = x; Item2 = y })
let tupleDynamic         () = run DynamicComparer.Comparer (fun x y -> x,y)
let tupleStructural      () = run HashIdentity.Structural  (fun x y -> x,y)
let tupleDefault         () = run EqualityComparer.Default (fun x y -> x,y)
let valueTupleDynamic    () = run DynamicComparer.Comparer (fun x y -> struct (x,y))
let valueTupleStructural () = run HashIdentity.Structural  (fun x y -> struct (x,y))
let valueTupleDefault    () = run EqualityComparer.Default (fun x y -> struct (x,y))

[<EntryPoint>]
let main (args : string[]) =
    printfn "%s\n" Id.Name

    runTrials "custom dynamic        " customDynamic
    runTrials "custom structural     " customStructural   
    runTrials "custom default        " customDefault      
    runTrials "value dynamic         " valueDynamic
    runTrials "value structural      " valueStructural   
    runTrials "value default         " valueDefault      
    runTrials "gen value dynamic     " genValueDynamic
    runTrials "gen value structural  " genValueStructural
    runTrials "gen value default     " genValueDefault   
    runTrials "ref dynamic           " refDynamic
    runTrials "ref structural        " refStructural     
    runTrials "ref default           " refDefault        
    runTrials "gen ref dynamic       " genRefDynamic
    runTrials "gen ref structural    " genRefStructural  
    runTrials "gen ref default       " genRefDefault     
    runTrials "tuple dynamic         " tupleDynamic
    runTrials "tuple structural      " tupleStructural   
    runTrials "tuple default         " tupleDefault      
    runTrials "value tuple dynamic   " valueTupleDynamic
    runTrials "value tuple structural" valueTupleStructural   
    runTrials "value tuple default   " valueTupleDefault      
    
    0