Demonstrates some techniques for performance improvements while remaining type-safe. Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

typesafe-performance-with-compiler-directives-1.fsx

(*
typesafe-performance-with-compiler-directives-1.fsx

Demonstrates some techniques for performance improvements while remaining type-safe.

Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

See also the others in this series: "typesafe-performance-with-compiler-directives-XXX".fsx

*)

// ====================================
// "Wrapped" version of CustomerId 
// ====================================


// type is an wrapper for a primitive type
type CustomerId = CustomerId of int

// create two silly functions for mapping and filtering 
let add1ToCustomerId (CustomerId i) = 
    CustomerId (i+1)

let isCustomerIdSmall (CustomerId i) = 
    i < 100000

// ---------------------------------
// timed with a 1 million element array
// ---------------------------------
#time
Array.init 1000000 CustomerId
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results
// Real: 00:00:00.296, CPU: 00:00:00.296, GC gen0: 6, gen1: 4, gen2: 0
// Real: 00:00:00.240, CPU: 00:00:00.249, GC gen0: 7, gen1: 5, gen2: 1
// Real: 00:00:00.309, CPU: 00:00:00.280, GC gen0: 6, gen1: 4, gen2: 0

// ---------------------------------
// timed with a 10 million element array
// ---------------------------------
#time
Array.init 10000000 CustomerId
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results
// Real: 00:00:02.801, CPU: 00:00:02.792, GC gen0: 64, gen1: 42, gen2: 0
// Real: 00:00:03.489, CPU: 00:00:03.541, GC gen0: 68, gen1: 46, gen2: 2
// Real: 00:00:03.774, CPU: 00:00:03.822, GC gen0: 65, gen1: 34, gen2: 3

typesafe-performance-with-compiler-directives-2.fsx

(*
typesafe-performance-with-compiler-directives-2.fsx

Demonstrates some techniques for performance improvements while remaining type-safe.

Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

See also the others in this series: "typesafe-performance-with-compiler-directives-XXX".fsx

*)


// ====================================
// Type alias version of CustomerId 
// ====================================

type CustomerId = int
type OrderId = int

// create two silly functions for mapping and filtering 
let add1ToCustomerId (id:CustomerId) :CustomerId = 
    id+1
// val add1ToCustomerId : id:CustomerId -> CustomerId

let isCustomerIdSmall (id:CustomerId) = 
    id < 100000
// val isCustomerIdSmall : id:CustomerId -> bool

// ---------------------------------
// timed with a 1 million element array
// ---------------------------------
#time
Array.init 1000000 (fun i -> i)
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results
// Real: 00:00:00.017, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0
// Real: 00:00:00.016, CPU: 00:00:00.015, GC gen0: 0, gen1: 0, gen2: 0

// ---------------------------------
// timed with a 10 million element array
// ---------------------------------
#time
Array.init 10000000 (fun i -> i)
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results
// Real: 00:00:00.166, CPU: 00:00:00.156, GC gen0: 0, gen1: 0, gen2: 0
// Real: 00:00:00.171, CPU: 00:00:00.171, GC gen0: 0, gen1: 0, gen2: 0

// ---------------------------------
// why I'm wary of type aliases
// ---------------------------------

// create two
let cid : CustomerId = 12
let oid : OrderId = 12

// test
cid = oid              // true

// can pass OrderId to function expecting a CustomerId 
add1ToCustomerId oid   //  CustomerId = 13

typesafe-performance-with-compiler-directives-3.fsx

(*
typesafe-performance-with-compiler-directives-3.fsx

Demonstrates some techniques for performance improvements while remaining type-safe.

Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

See also the others in this series: "typesafe-performance-with-compiler-directives-XXX".fsx

*)


// ====================================
// Unit of measure version of CustomerId 
// ====================================


type [<Measure>] CustomerIdUOM 
type [<Measure>] OrderIdUOM 

type CustomerId = int<CustomerIdUOM>
type OrderId = int<OrderIdUOM>

// create two silly functions for mapping and filtering 
let add1ToCustomerId id  = 
    id+1<CustomerIdUOM>

let isCustomerIdSmall i = 
    i < 100000<CustomerIdUOM>

// ---------------------------------
// timed with a 1 million element array
// ---------------------------------
#time
Array.init 1000000 (fun i -> LanguagePrimitives.Int32WithMeasure<CustomerIdUOM> i)
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> ignore
#time

// results
// Real: 00:00:00.022, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0
// Real: 00:00:00.019, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0
// Real: 00:00:00.021, CPU: 00:00:00.015, GC gen0: 1, gen1: 1, gen2: 0

// ---------------------------------
// timed with a 10 million element array
// ---------------------------------
#time
Array.init 10000000 (fun i -> LanguagePrimitives.Int32WithMeasure<CustomerIdUOM> i)
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> ignore
#time

// results
//Real: 00:00:00.157, CPU: 00:00:00.156, GC gen0: 0, gen1: 0, gen2: 0
//Real: 00:00:00.156, CPU: 00:00:00.156, GC gen0: 0, gen1: 0, gen2: 0
//Real: 00:00:00.154, CPU: 00:00:00.156, GC gen0: 0, gen1: 0, gen2: 0


// ---------------------------------
// why I'm wary of UOMs
// ---------------------------------

// create a customer id and order id
let cid = 12<CustomerIdUOM>
let oid = 4<OrderIdUOM>

// what does it mean that you can divide them!
let ratio = cid / oid
// val ratio : int<CustomerIdUOM/OrderIdUOM> = 3

typesafe-performance-with-compiler-directives-4.fsx

(*
typesafe-performance-with-compiler-directives-4.fsx

Demonstrates some techniques for performance improvements while remaining type-safe.

Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

See also the others in this series: "typesafe-performance-with-compiler-directives-XXX".fsx

*)

// ====================================
// Swap implementations based on compiler directive
// ====================================

#if COMPILED  // uncomment to use aliased version   
//#if INTERACTIVE // uncomment to use wrapped version

// type is an wrapper for a primitive type
type CustomerId = CustomerId of int

// constructor
let createCustomerId i = CustomerId i

// get data
let customerIdValue (CustomerId i) = i

// pattern matching
// not needed

#else
// type is an alias for a primitive type
type CustomerId = int

// constructor
let inline createCustomerId i :CustomerId = i

// get data
let inline customerIdValue (id:CustomerId) = id

// pattern matching
let inline (|CustomerId|) (id:CustomerId) :int = id

#endif


// ---------------------------------
// usage example that is ignorant of the implementation
// ---------------------------------

// test the getter
let testGetter c1 c2 =
    let i1 = customerIdValue c1
    let i2 = customerIdValue c2
    printfn "Get inner value from customers %i %i" i1 i2
// Note that the signature is as expected:
// c1:CustomerId -> c2:CustomerId -> unit

// test pattern matching
let testPatternMatching c1 =
    let (CustomerId i) = c1
    printfn "Get inner value from Customers via pattern match: %i" i

    match c1 with
    | CustomerId i2 -> printfn "match/with %i" i
// Note that the signature is as expected:
// c1:CustomerId -> unit

let test() = 
    // create two ids
    let c1 = createCustomerId 1
    let c2 = createCustomerId 2
    let custArray : CustomerId [] = [| c1; c2 |]
    
    // test them
    testGetter c1 c2 
    testPatternMatching c1 


// ---------------------------------
// create two silly functions for mapping and filtering 
// ---------------------------------

let add1ToCustomerId (CustomerId i) = 
    createCustomerId (i+1)

let isCustomerIdSmall (CustomerId i) = 
    i < 100000

// ---------------------------------
// timed with a 1 million element array
// ---------------------------------
#time
Array.init 1000000 createCustomerId
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results using wrapped version
// Real: 00:00:00.408, CPU: 00:00:00.405, GC gen0: 7, gen1: 4, gen2: 1

// results using aliased version
// Real: 00:00:00.022, CPU: 00:00:00.031, GC gen0: 0, gen1: 0, gen2: 0


// ---------------------------------
// timed with a 10 million element array
// ---------------------------------
#time
Array.init 10000000 createCustomerId
// map it 
|> Array.map add1ToCustomerId 
// map it again
|> Array.map add1ToCustomerId 
// filter it 
|> Array.filter isCustomerIdSmall 
|> Array.length
#time

// results using wrapped version
// Real: 00:00:03.199, CPU: 00:00:03.354, GC gen0: 67, gen1: 45, gen2: 2

// results using aliased version
// Real: 00:00:00.239, CPU: 00:00:00.202, GC gen0: 0, gen1: 0, gen2: 0

typesafe-performance-with-compiler-directives-5.fsx

(*
typesafe-performance-with-compiler-directives-5.fsx

Demonstrates some techniques for performance improvements while remaining type-safe.

Related blog post: http://fsharpforfunandprofit.com/posts/typesafe-performance-with-compiler-directives/

See also the others in this series: "typesafe-performance-with-compiler-directives-XXX".fsx

*)

// ====================================
// A complex example 
// ====================================

#if COMPILED  // uncomment to use aliased version   
//#if INTERACTIVE // uncomment to use wrapped version

module EmailAddress =
    // type with private constructor 
    type EmailAddress = private EmailAddress of string

    // safe constructor
    let create s = 
        if System.String.IsNullOrWhiteSpace(s) then 
            None
        else if s.Contains("@") then
            Some (EmailAddress s)
        else
            None

    // get data
    let value (EmailAddress s) = s

    // pattern matching
    // not needed

module ActivityHistory =
    open EmailAddress
    
    // type with private constructor 
    type ActivityHistory = private {
        emailAddress : EmailAddress
        visits : int
        }

    // safe constructor
    let create email visits = 
        {emailAddress = email; visits = visits }

    // get data
    let email {emailAddress=e} = e
    let visits {visits=a} = a

    // pattern matching
    // not needed

module Classification =
    open EmailAddress
    open ActivityHistory

    type Classification = 
        | Active of EmailAddress * int
        | Inactive of EmailAddress 

    // constructor
    let createActive email visits = 
        Active (email,visits)
    let createInactive email = 
        Inactive email

    // pattern matching
    // not needed
    
// label for printing report
let WrappedOrAliased = "Wrapped"


#else

module EmailAddress =

    // aliased type 
    type EmailAddress = string

    // safe constructor
    let inline create s :EmailAddress option = 
        if System.String.IsNullOrWhiteSpace(s) then 
            None
        else if s.Contains("@") then
            Some s
        else
            None

    // get data
    let inline value (e:EmailAddress) :string = e

    // pattern matching
    let inline (|EmailAddress|) (e:EmailAddress) :string = e

module ActivityHistory =
    open EmailAddress
    
    [<Struct>]
    type ActivityHistory(emailAddress : EmailAddress, visits : int) = 
        member this.EmailAddress = emailAddress 
        member this.Visits = visits 

    // safe constructor
    let create email visits = 
        ActivityHistory(email,visits)

    // get data
    let email (act:ActivityHistory) = act.EmailAddress
    let visits (act:ActivityHistory) = act.Visits

    // pattern matching
    // not needed

module Classification =
    open EmailAddress
    open ActivityHistory
    open System

    [<Struct>]
    type Classification(isActive : bool, email: EmailAddress, visits: int) = 
        member this.IsActive = isActive 
        member this.Email = email
        member this.Visits = visits

    // constructor
    let inline createActive email visits = 
        Classification(true,email,visits)
    let inline createInactive email = 
        Classification(false,email,0)

    // pattern matching
    let inline (|Active|Inactive|) (c:Classification) = 
        if c.IsActive then 
            Active (c.Email,c.Visits)
        else
            Inactive (c.Email)

// label for printing report
let WrappedOrAliased = "Aliased"


#endif

// for compiling whole file, finish compiling first part here
;;


// ---------------------------------
// helper functions which are independent of the implementation
// ---------------------------------

let rand = new System.Random()

let createCustomerWithRandomActivityHistory() = 
    let emailOpt = EmailAddress.create "abc@example.com"
    match emailOpt with
    | Some email  -> 
        let visits = rand.Next(0,100) 
        ActivityHistory.create email visits 
    | None -> 
        failwith "should not happen"

let add1ToVisits activity = 
    let email = ActivityHistory.email activity
    let visits = ActivityHistory.visits activity 
    ActivityHistory.create email (visits+1)

let isCustomerInactive activity = 
    let visits = ActivityHistory.visits activity 
    visits < 3

// execute creation and iteration for a large number of records
let mapAndFilter noOfRecords = 
    Array.init noOfRecords (fun _ -> createCustomerWithRandomActivityHistory() )
    // map it 
    |> Array.map add1ToVisits 
    // map it again
    |> Array.map add1ToVisits 
    // filter it 
    |> Array.filter isCustomerInactive 
    |> ignore  // we don't actually care!


// ---------------------------------
// helper functions for Classification
// ---------------------------------


let createClassifiedCustomer activity = 
    let email = ActivityHistory.email activity
    let visits = ActivityHistory.visits activity 

    if isCustomerInactive activity then 
        Classification.createInactive email 
    else
        Classification.createActive email visits 

open Classification

// execute creation and iteration for a large number of records
let extractActiveEmails noOfRecords =
    Array.init noOfRecords (fun _ -> createCustomerWithRandomActivityHistory() )
    // map to a classification
    |> Array.map createClassifiedCustomer
    // extract emails for active customers
    |> Array.choose (function
        | Active (email,visits) -> email |> Some
        | Inactive _ -> None )
    |> ignore


// ---------------------------------
// timer tool
// ---------------------------------

/// Do countN repetitions of the function f and print the 
/// time elapsed, number of GCs and change in total memory
let time countN label f  = 

    let stopwatch = System.Diagnostics.Stopwatch()
    
    // do a full GC at the start but NOT thereafter
    // allow garbage to collect for each iteration
    System.GC.Collect()  
    printfn "Started"         

    let getGcStats() = 
        let gen0 = System.GC.CollectionCount(0)
        let gen1 = System.GC.CollectionCount(1)
        let gen2 = System.GC.CollectionCount(2)
        let mem = System.GC.GetTotalMemory(false)
        gen0,gen1,gen2,mem


    printfn "======================="         
    printfn "%s (%s)" label WrappedOrAliased
    printfn "======================="         
    for iteration in [1..countN] do
        let gen0,gen1,gen2,mem = getGcStats()
        stopwatch.Restart() 
        f()
        stopwatch.Stop() 
        let gen0',gen1',gen2',mem' = getGcStats()
        // convert memory used to K
        let changeInMem = (mem'-mem) / 1000L
        printfn "#%2i elapsed:%6ims gen0:%3i gen1:%3i gen2:%3i mem:%6iK" iteration stopwatch.ElapsedMilliseconds (gen0'-gen0) (gen1'-gen1) (gen2'-gen2) changeInMem 

// ---------------------------------
// timed with a 100L. 1M and 10M element array
// ---------------------------------

do 
    let size = 100000
    let label = sprintf "mapAndFilter: %i records" size 
    time 10 label (fun () -> mapAndFilter size)

do 
    let size = 1000000
    let label = sprintf "mapAndFilter: %i records" size 
    time 10 label (fun () -> mapAndFilter size)

do 
    let size = 1000000
    let label = sprintf "extractActiveEmails: %i records" size 
    time 10 label (fun () -> extractActiveEmails size)

(*
=======================
mapAndFilter: 100000 records (Wrapped)
=======================
# 1 elapsed:    97ms gen0:  1 gen1:  1 gen2:  0 mem:  7202K
# 2 elapsed:    78ms gen0:  1 gen1:  1 gen2:  0 mem:  7200K
# 3 elapsed:    60ms gen0:  1 gen1:  1 gen2:  0 mem:  7244K
# 4 elapsed:    74ms gen0:  1 gen1:  1 gen2:  0 mem:  7475K
# 5 elapsed:   104ms gen0:  2 gen1:  1 gen2:  0 mem:  6883K
# 6 elapsed:    43ms gen0:  1 gen1:  0 gen2:  0 mem:  7196K
# 7 elapsed:    98ms gen0:  1 gen1:  1 gen2:  0 mem:  7204K
# 8 elapsed:    32ms gen0:  1 gen1:  0 gen2:  0 mem:  7195K
# 9 elapsed:    87ms gen0:  1 gen1:  1 gen2:  0 mem:  7640K
#10 elapsed:   103ms gen0:  2 gen1:  1 gen2:  0 mem:  6763K
=======================
mapAndFilter: 1000000 records (Wrapped)
=======================
# 1 elapsed:   820ms gen0: 13 gen1:  8 gen2:  1 mem: 72159K
# 2 elapsed:   878ms gen0: 12 gen1:  7 gen2:  0 mem: 71997K
# 3 elapsed:   850ms gen0: 12 gen1:  6 gen2:  0 mem: 72005K
# 4 elapsed:   885ms gen0: 12 gen1:  7 gen2:  0 mem: 72000K
# 5 elapsed:  6690ms gen0: 16 gen1: 10 gen2:  1 mem:-216005K
# 6 elapsed:   714ms gen0: 12 gen1:  7 gen2:  0 mem: 72003K
# 7 elapsed:   668ms gen0: 12 gen1:  7 gen2:  0 mem: 71995K
# 8 elapsed:   670ms gen0: 12 gen1:  7 gen2:  0 mem: 72001K
# 9 elapsed:  6676ms gen0: 16 gen1: 11 gen2:  2 mem:-215998K
#10 elapsed:   712ms gen0: 13 gen1:  7 gen2:  0 mem: 71998K
=======================
extractActiveEmails: 1000000 records (Wrapped)
=======================
# 1 elapsed:   664ms gen0: 12 gen1:  6 gen2:  0 mem: 64542K
# 2 elapsed:   584ms gen0: 14 gen1:  7 gen2:  0 mem: 64590K
# 3 elapsed:   589ms gen0: 13 gen1:  7 gen2:  0 mem: 63616K
# 4 elapsed:   573ms gen0: 11 gen1:  5 gen2:  0 mem: 69438K
# 5 elapsed:   640ms gen0: 15 gen1:  7 gen2:  0 mem: 58464K
# 6 elapsed:  4297ms gen0: 13 gen1:  7 gen2:  1 mem:-256192K
# 7 elapsed:   593ms gen0: 14 gen1:  7 gen2:  0 mem: 64623K
# 8 elapsed:   621ms gen0: 13 gen1:  7 gen2:  0 mem: 63689K
# 9 elapsed:   577ms gen0: 11 gen1:  5 gen2:  0 mem: 69415K
#10 elapsed:   609ms gen0: 15 gen1:  7 gen2:  0 mem: 58480K

*)

(*
=======================
mapAndFilter: 100000 records (Aliased)
=======================
# 1 elapsed:    21ms gen0:  0 gen1:  0 gen2:  0 mem:  3621K
# 2 elapsed:    13ms gen0:  0 gen1:  0 gen2:  0 mem:  3620K
# 3 elapsed:    13ms gen0:  0 gen1:  0 gen2:  0 mem:  3645K
# 4 elapsed:    13ms gen0:  0 gen1:  0 gen2:  0 mem:  3628K
# 5 elapsed:    83ms gen0:  1 gen1:  1 gen2:  0 mem: -2374K
# 6 elapsed:    13ms gen0:  0 gen1:  0 gen2:  0 mem:  3628K
# 7 elapsed:    13ms gen0:  1 gen1:  0 gen2:  0 mem:  2047K
# 8 elapsed:    13ms gen0:  1 gen1:  0 gen2:  0 mem:  2055K
# 9 elapsed:    15ms gen0:  1 gen1:  0 gen2:  0 mem:  2064K
#10 elapsed:    13ms gen0:  1 gen1:  0 gen2:  0 mem:  2080K
=======================
mapAndFilter: 1000000 records (Aliased)
=======================
# 1 elapsed:   193ms gen0:  7 gen1:  0 gen2:  0 mem: 25325K
# 2 elapsed:   142ms gen0:  8 gen1:  0 gen2:  0 mem: 23779K
# 3 elapsed:   143ms gen0:  8 gen1:  0 gen2:  0 mem: 23761K
# 4 elapsed:   138ms gen0:  8 gen1:  0 gen2:  0 mem: 23745K
# 5 elapsed:   135ms gen0:  7 gen1:  0 gen2:  0 mem: 25327K
# 6 elapsed:   135ms gen0:  8 gen1:  0 gen2:  0 mem: 23762K
# 7 elapsed:   137ms gen0:  8 gen1:  0 gen2:  0 mem: 23755K
# 8 elapsed:   140ms gen0:  8 gen1:  0 gen2:  0 mem: 23777K
# 9 elapsed:   174ms gen0:  7 gen1:  0 gen2:  0 mem: 25327K
#10 elapsed:   180ms gen0:  8 gen1:  0 gen2:  0 mem: 23762K
=======================
extractActiveEmails: 1000000 records (Aliased)
=======================
# 1 elapsed:   254ms gen0: 32 gen1:  1 gen2:  0 mem: 33162K
# 2 elapsed:   221ms gen0: 33 gen1:  0 gen2:  0 mem: 31532K
# 3 elapsed:   196ms gen0: 32 gen1:  0 gen2:  0 mem: 33113K
# 4 elapsed:   185ms gen0: 33 gen1:  0 gen2:  0 mem: 31523K
# 5 elapsed:   187ms gen0: 33 gen1:  0 gen2:  0 mem: 31532K
# 6 elapsed:   186ms gen0: 32 gen1:  0 gen2:  0 mem: 33095K
# 7 elapsed:   191ms gen0: 33 gen1:  0 gen2:  0 mem: 31514K
# 8 elapsed:   200ms gen0: 32 gen1:  0 gen2:  0 mem: 33096K
# 9 elapsed:   189ms gen0: 33 gen1:  0 gen2:  0 mem: 31531K
#10 elapsed:  3732ms gen0: 33 gen1:  1 gen2:  1 mem:-256432K

*)