Fork me on GitHub

NuGet Snippet:

C:\_tmp\performanceTest>nuget install -ExcludeVersion canopy
Attempting to resolve dependency 'Selenium.WebDriver (= 2.42.0)'.
Attempting to resolve dependency 'Selenium.Support (= 2.42.0)'.
Attempting to resolve dependency 'SizSelCsZzz (= 0.3.36.0)'.
Attempting to resolve dependency 'Newtonsoft.Json (= 6.0)'.
Installing 'Selenium.WebDriver 2.42.0'.
Successfully installed 'Selenium.WebDriver 2.42.0'.
Installing 'Selenium.Support 2.42.0'.
Successfully installed 'Selenium.Support 2.42.0'.
Installing 'Newtonsoft.Json 6.0.1'.
Successfully installed 'Newtonsoft.Json 6.0.1'.
Installing 'SizSelCsZzz 0.3.36.0'.
Successfully installed 'SizSelCsZzz 0.3.36.0'.
Installing 'canopy 0.9.11'.
Successfully installed 'canopy 0.9.11'.
 
C:\_tmp\performanceTest>

Script Snippet (DG.StressTest.Browser.cmd):

@echo off

:: Add the paths for the F# SDK 3.x (from higher version to lower)
set FSHARPSDK=^
C:\Program Files (x86)\Microsoft SDKs\F#\3.1\Framework\v4.0\;^
C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\

cls

:: Execute the script "only" with the first "fsianycpu.exe" found
for %%i in (fsianycpu.exe) do "%%~$FSHARPSDK:i" DG.StressTest.Browser.fsx %*

pause

Code Snippet (DG.StressTest.Browser.fsx):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
(* nuget install -ExcludeVersion canopy *)
#r @"Selenium.Support\lib\net40\WebDriver.Support.dll"
#r @"Selenium.WebDriver\lib\net40\WebDriver.dll"
#r @"canopy\lib\canopy.dll"
 
#load @"DG.Auth.fsx" (* Just contains let usr = "usr" and let pwd = "pwd" *)
 
open System
open System.IO
 
open canopy
open runner
open configuration
 
(* Config canopy *)
compareTimeout <- 30.0
 
(* Utils *)
let timestamp  () = DateTime.Now.ToString("o").Replace(":","")
let timestamp' () = DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss")
 
let string2float = function
  | (n,s) -> match Double.TryParse s with | true, value -> value * n | _ -> 0.
 
let parse (s:string) = 
  match s with
    | ms when s.Contains("ms")     ->    1., ms.Replace(" ms","")
    | KB when s.Contains("KB/sec") ->    1., KB.Replace(" KB/sec","")
    | MB when s.Contains("MB/sec") -> 1000., MB.Replace(" MB/sec","")
    | _ -> failwith "Not recognized unit"
  |> string2float |> int
 
(* Local files / folders *)
let output = @"./output.csv"
let source = @".source/"
 
(* Connection info: *)
let uriMain = Uri(@"https://org.crm4.dynamics.com");
let uriDiag = Uri(uriMain.AbsoluteUri + @"/tools/diagnostics/diag.aspx")
 
(* Save to .source folder *)
let save2source data =
  File.WriteAllText(source + timestamp() + ".log", data)
 
(* Browser Performance Test MS CRM Online *)
let rec performanceTestCrm date path = 
  match (date > DateTime.Now) with
  | true -> 
    click "#runBtn_all"
 
    waitFor (fun () -> (read "#td_status_all") = "complete")
 
    save2source (read "#resultConsole")
 
    let latency, speed, jsArray, jsMorph, jsBase64, jsDOM =
      parse (read "#td_result_latency"),
      parse (read "#td_result_bandwidth"),
      parse (read "#td_result_jsArrayBenchmark"),
      parse (read "#td_result_jsMorphBenchmark"),
      parse (read "#td_result_jsBase64Benchmark"),
      parse (read "#td_result_jsDomBenchmark")
 
    let sw = File.AppendText(path)
    sw.WriteLine(
      sprintf "%s;%i;%i;%i;%i;%i;%i;"
        (timestamp'()) latency speed jsArray jsMorph jsBase64 jsDOM)
    sw.Dispose()
 
    reload()
 
    performanceTestCrm date path
  | false -> ()
 
(* Start Browser Response Test: *)
start chrome
 
"MS CRM Online Browser Performance Test" &&& fun _ ->
  (* Clear output.csv and .source folder *)
  File.Exists(output) |> function 
    | true -> File.Delete(output)
    | false -> ()
  Directory.EnumerateFiles(@".source","*.log",SearchOption.AllDirectories)
  |> Seq.iter(fun x -> File.Delete(x))
 
  (* Go to MS CRM Online *)
  url uriMain.AbsoluteUri
 
  (* Login *)
  "#cred_userid_inputtext"   << DG.Auth.usr
  "#cred_password_inputtext" << DG.Auth.pwd
  click "#cred_sign_in_button"
  press enter
 
  (* Go to diag url *)
  url uriDiag.AbsoluteUri
 
  (* Start and Stop DateTimes *)
  let startDate = DateTime.Now
  let stopDate  = startDate.AddMinutes(60.)
 
  let sw = File.CreateText(output)
  sw.WriteLine(
    "Timestamp (ISO 8601);Latency (ms);Speed (KB/sec);" +
    "JS Array (ms);JS Morph (ms);JS Base64 (ms);JS DOM (ms);"
  )
  sw.Dispose()
 
  performanceTestCrm stopDate output
 
run()
 
quit()

Code result:

Starting ChromeDriver (v2.10.267521) on port 64015
Only local connections are allowed.
Test: Browser Performance Test MS CRM Online
Passed
 
60 minutes 19 seconds to execute
1 passed
0 failed
Press any key to continue . . .

Code result (output.csv):

Timestamp (ISO 8601);Latency (ms);Speed (KB/sec);JS Array (ms);JS Morph (ms);JS Base64 (ms);JS DOM (ms);
2014-09-18 22:59:59;47;302;229;33;5;13;
2014-09-18 23:00:03;47;302;197;46;6;17;
2014-09-18 23:00:07;48;322;192;45;4;18;
2014-09-18 23:00:10;48;315;186;36;4;12;
2014-09-18 23:00:14;46;302;186;32;3;13;
2014-09-18 23:00:17;47;322;186;33;3;13;
...
2014-09-18 23:59:59;48;329;194;47;4;17;

Code result (.source\2014-09-18T225959.2540079+0200.log):

=== Latency Test Info ===
Number of times run: 20
Run 1 time: 46 ms
Run 2 time: 51 ms
Run 3 time: 48 ms
Run 4 time: 47 ms
Run 5 time: 48 ms
Run 6 time: 45 ms
Run 7 time: 46 ms
Run 8 time: 46 ms
Run 9 time: 46 ms
Run 10 time: 52 ms
Run 11 time: 50 ms
Run 12 time: 47 ms
Run 13 time: 47 ms
Run 14 time: 45 ms
Run 15 time: 44 ms
Run 16 time: 47 ms
Run 17 time: 48 ms
Run 18 time: 48 ms
Run 19 time: 45 ms
Run 20 time: 50 ms
Average latency: 47 ms
Client Time: Thu, 18 Sep 2014 20:59:57 GMT
 
=== Bandwidth Test Info ===
Run 1
  Time: 56 ms
  Blob Size: 15180 bytes
  Speed: 264 KB/sec
Run 2
  Time: 49 ms
  Blob Size: 15180 bytes
  Speed: 302 KB/sec
Run 3
  Time: 50 ms
  Blob Size: 15180 bytes
  Speed: 296 KB/sec
Run 4
  Time: 49 ms
  Blob Size: 15180 bytes
  Speed: 302 KB/sec
Run 5
  Time: 51 ms
  Blob Size: 15180 bytes
  Speed: 290 KB/sec
Run 6
  Time: 51 ms
  Blob Size: 15180 bytes
  Speed: 290 KB/sec
Run 7
  Time: 52 ms
  Blob Size: 15180 bytes
  Speed: 285 KB/sec
Run 8
  Time: 52 ms
  Blob Size: 15180 bytes
  Speed: 285 KB/sec
Run 9
  Time: 50 ms
  Blob Size: 15180 bytes
  Speed: 296 KB/sec
Run 10
  Time: 53 ms
  Blob Size: 15180 bytes
  Speed: 279 KB/sec
Max Download speed: 302 KB/sec
Client Time: Thu, 18 Sep 2014 20:59:58 GMT
 
=== Browser Info ===
Browser CodeName: Mozilla
Browser Name: Netscape
Browser Version: 5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.120 Safari/537.36
Cookies Enabled: true
Platform: Win32
User-agent header: Mozilla/5.0 (Windows NT 6.3; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/37.0.2062.120 Safari/537.36
Client Time: Thu, 18 Sep 2014 20:59:58 GMT
 
=== Machine Info ===
Client IP Address: XXX.XXX.XXX.XXX
Client Time: Thu, 18 Sep 2014 20:59:58 GMT
 
=== Array Manipultaion Benchmark ===
Time: 229 ms
Client Time: Thu, 18 Sep 2014 20:59:58 GMT
 
=== Morph Benchmark ===
Time: 33 ms
Client Time: Thu, 18 Sep 2014 20:59:58 GMT
 
=== Base 64 Benchmark ===
Time: 5 ms
Client Time: Thu, 18 Sep 2014 20:59:59 GMT
 
=== DOM Benchmark ===
Total Time: 13 ms
Breakdown:
  Append:  3ms
  Prepend: 5ms
  Index:   0ms
  Insert:  4ms
  Remove:  1ms
Client Time: Thu, 18 Sep 2014 20:59:59 GMT
 
=== Organization Info ===
Organization name: orgSomeIdNumber
Is Live: True
Server time: 9/18/2014 8:59:55 PM UTC
Url: https://org.crm4.dynamics.com//tools/diagnostics/diag.aspx
Client Time: Thu, 18 Sep 2014 20:59:59 GMT

Chart diagrams:

All

All

All

Architecture (Lenovo ThinkPad W540):

All

NuGet Snippet:

C:\_tmp\stressTest>nuget install -ExcludeVersion Microsoft.CrmSdk.CoreAssemblies
Attempting to resolve dependency 'Microsoft.IdentityModel (= 6.1.7600.16394)'.
Installing 'Microsoft.IdentityModel 6.1.7600.16394'.
Successfully installed 'Microsoft.IdentityModel 6.1.7600.16394'.
Installing 'Microsoft.CrmSdk.CoreAssemblies 6.1.0'.
Successfully installed 'Microsoft.CrmSdk.CoreAssemblies 6.1.0'.

C:\_tmp\stressTest>
C:\_tmp\stressTest>nuget install -ExcludeVersion FSharp.Data
Attempting to resolve dependency 'Zlib.Portable (= 1.9.2)'.
Installing 'Zlib.Portable 1.9.2'.
Successfully installed 'Zlib.Portable 1.9.2'.
Installing 'FSharp.Data 2.0.4'.
Successfully installed 'FSharp.Data 2.0.4'.

C:\_tmp\stressTest>

Script Snippet (DG.StressTest.cmd):

@echo off

:: Add the paths for the F# SDK 3.x (from higher version to lower)
set FSHARPSDK=^
C:\Program Files (x86)\Microsoft SDKs\F#\3.1\Framework\v4.0\;^
C:\Program Files (x86)\Microsoft SDKs\F#\3.0\Framework\v4.0\

cls

:: Execute the script "only" with the first "fsianycpu.exe" found
for %%i in (fsianycpu.exe) do "%%~$FSHARPSDK:i" DG.StressTest.fsx %*

pause

Code Snippet (DG.StressTest.fsx):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
#r @"System.Runtime.Serialization"
#r @"System.ServiceModel"
 
// nuget install -ExcludeVersion Microsoft.CrmSdk.CoreAssemblies
#r @"Microsoft.CrmSdk.CoreAssemblies\lib\net40\Microsoft.Xrm.Sdk.dll"
 
// nuget install -ExcludeVersion FSharp.Data
#r @"FSharp.Data\lib\net40\FSharp.Data.dll"
 
#load @"DG.Auth.fsx" // Just contains let usr = "usr" and let pwd = "pwd"
 
open System
open System.Runtime.Serialization
open System.ServiceModel.Description
 
open Microsoft.Xrm.Sdk
open Microsoft.Xrm.Sdk.Client
open Microsoft.Xrm.Sdk.Messages
open Microsoft.Xrm.Sdk.Query
 
open FSharp.Data
 
/// Utils
let r = new System.Random()

let crmCount (proxy:OrganizationServiceProxy) logicalName (date:DateTime) = 
  let f = FilterExpression()
  f.AddCondition(@"createdon", ConditionOperator.GreaterEqual, date.ToUniversalTime())
 
  let q = QueryExpression(logicalName)
  q.ColumnSet <- ColumnSet(logicalName + "id")
  q.Criteria <- f
  q.PageInfo <- PagingInfo()
  q.PageInfo.PageNumber <- 1
 
  seq{ let resp = proxy.RetrieveMultiple(q)
       yield! resp.Entities
 
       let rec retrieveMultiple' (ec:EntityCollection) pn = seq{
         match ec.MoreRecords with
         | true ->
           q.PageInfo.PageNumber <- (pn + 1)
           q.PageInfo.PagingCookie <- ec.PagingCookie
 
           let resp' = proxy.RetrieveMultiple(q)
 
           yield! resp'.Entities
           yield! retrieveMultiple' resp' (pn + 1)
         | false -> () }
 
       yield! retrieveMultiple' resp 1 }
  |> Seq.length

/// Connection info:
let uri = Uri("https://org.api.crm4.dynamics.com/XRMServices/2011/Organization.svc");
 
let ac = AuthenticationCredentials()
ac.ClientCredentials.UserName.UserName <- DG.Auth.usr
ac.ClientCredentials.UserName.Password <- DG.Auth.pwd
 
let m = ServiceConfigurationFactory.CreateManagement<IOrganizationService>(uri)
let tc = m.Authenticate(ac)
let p = new OrganizationServiceProxy(m, tc.SecurityTokenResponse)
 
/// Test data:
let data = FreebaseData.GetDataContext()
 
let names = data.Society.People.``Family names`` |> Seq.take 250
let namesCache = names |> Seq.toArray |> Array.map(fun x -> x.Name)
 
let titles = data.``Products and Services``.Business.``Job titles`` |> Seq.take 250
let titlesCache = titles |> Seq.toArray |> Array.map(fun x -> x.Name)
 
let products = data.``Products and Services``.``Food & Drink``.Foods |> Seq.take 250
let productsCache = products |> Seq.toArray |> Array.map(fun x -> x.Name)
 
let countries = data.Commons.Location.Countries |> Seq.take 250
let countriesCache = countries |> Seq.toArray |> Array.map(fun x -> x.Name)
 
let cities = data.Commons.Location.``City/Town/Villages`` |> Seq.take 250
let citiesCache = cities |> Seq.toArray |> Array.map(fun x -> x.Name)
 
let companyName name = name + " Company"
let streetName name = name + " Street " + string(r.Next(1,1000))
let phoneNumber () = "555-" + string(r.Next(1000,10000))
let zipCode () = string(r.Next(1000,10000))
let email firstname lastname = (firstname + "." + lastname + "@mail.co.dk").ToLower()
 
/// Create as many accounts as possible
let createAccount () =
  let a = Entity("account")
  a.Attributes.Add("name", 
    namesCache.[r.Next(0,250)] + " " + 
    namesCache.[r.Next(0,250)] |> companyName)
  a.Attributes.Add("telephone1", phoneNumber())
  a.Attributes.Add("address1_line1", namesCache.[r.Next(0,250)] |> streetName)
  a.Attributes.Add("address1_city", citiesCache.[r.Next(0,250)])
  a.Attributes.Add("address1_postalcode", zipCode())
  a.Attributes.Add("address1_country", countriesCache.[r.Next(0,250)])
  a
 
// One account per thread
let createAccounts date concurrency =
  Array.Parallel.init concurrency (fun _ -> createAccount ())
  |> Array.Parallel.map(
    fun x -> 
      try
        match (date > DateTime.Now) with
        | true -> 
          let p' = new OrganizationServiceProxy(m, tc.SecurityTokenResponse)
          p'.Create(x) |> Some
        | false -> None
      with ex -> None)
 
// Ten accounts per thread
let createAccounts' date concurrency =
  Array.Parallel.init concurrency
    (fun _ -> 
      let em = new ExecuteMultipleRequest()
      em.Settings <- new ExecuteMultipleSettings()
      em.Settings.ContinueOnError <- true
      em.Settings.ReturnResponses <- true
      em.Requests <- new OrganizationRequestCollection()
      em)
  |> Array.Parallel.map(
    fun x -> 
      try
        Array.Parallel.init 10
          (fun _ -> 
            let cr = new CreateRequest()
            cr.Target <- createAccount()
            x.Requests.Add(cr)) |> ignore
        match (date > DateTime.Now) with
        | true -> 
          let p' = new OrganizationServiceProxy(m, tc.SecurityTokenResponse)
          p'.Execute(x) :?> ExecuteMultipleResponse |> Some
        | false -> None
      with ex -> None)
 
/// Stress Test
let rec stressTestCrm date concurrency = 
  match (date > DateTime.Now) with
  | true -> 
    createAccounts' date concurrency |> ignore
    stressTestCrm date concurrency
  | false -> ()
 
/// Concurrent users (threads)
let concurrency = (1 <<< 10) // 1024
 
/// Start and Stop DateTimes
let startDate = DateTime.Now
let stopDate  = startDate.AddMinutes(60.)
 
/// Perfom stress test and print outcome
stressTestCrm stopDate concurrency
 
(crmCount p "account" startDate, startDate.ToString("o"))
||> printfn "Accounts created: %i, since: %s"

Code result:

Accounts created: 141225, since: 2014-09-16T22:31:53.9798783+02:00
Press any key to continue . . .

Architecture (Lenovo ThinkPad W540):

All

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
#if INTERACTIVE
#r "System.Data.Services.Client"
#r "FSharp.Data.TypeProviders"
#endif

open System
open System.Net
open System.Data.Services.Client
open Microsoft.FSharp.Data

[<Literal>]
let url = @"https://demo.crm4.dynamics.com/XRMServices/2011/OrganizationData.svc/"

[<Literal>] // "%TMP%/odata/OrganizationData.csdl"
let csdl = __SOURCE_DIRECTORY__  + @"/odata/OrganizationData.csdl" 

type Xrm = 
    TypeProviders.ODataService<
        ServiceUri = url,
        LocalSchemaFile = csdl,
        ForceUpdate = false>

let ctx = Xrm.GetDataContext()

// To be used when writing JavaScript with OData
ctx.DataContext.SendingRequest.Add (
    fun eventArgs -> printfn "-Url: %A" eventArgs.Request.RequestUri)
ctx.DataContext.SendingRequest.Add (
    fun eventArgs -> printfn "-Query: %s" eventArgs.Request.RequestUri.Query)

// Remember to "pipe" to a Sequence, in order to evaluate the Linq Query:
query { for a in ctx.AccountSet do
        where (a.AccountNumber = "42")
        select (a.AccountNumber, a.AccountId)
        skip 5
        take 1} 
|> Seq.map id

Code output:

val url : string =
  "https:demo.crm4.dynamics.com/XRMServices/2011/OrganizationData.svc/"
val csdl : string =
  "C:\Users\rsm\AppData\Local\Temp\odata\OrganizationData.csdl"
type Xrm =
  class
    static member GetDataContext : unit -> Xrm.ServiceTypes.SimpleDataContextTypes.demoContext
     + 1 overload
    nested type ServiceTypes
  end
val ctx : Xrm.ServiceTypes.SimpleDataContextTypes.demoContext
val it : unit = ()
-Uri: https:demo.crm4.dynamics.com/XRMServices/2011/OrganizationData.svc/AccountSet()?$filter=AccountNumber eq '42'&$skip=5&$top=1&$select=AccountNumber,AccountId
-Query: $filter=AccountNumber eq '42'&$skip=5&$top=1&$select=AccountNumber,AccountId
val it : seq<string * Guid> = seq []

Remark:

The reason LocalSchemaFile = csdl and ForceUpdate = false are set to static values are because Microsoft still doesn’t allow us to use OData from a server side context (we still need to login to CRM Online with a browser that supports JavaScript). If anybody have a hint on how to access the CSDL service from a .NET application, please write a comment below.

The point is that even though there is no data returned in the .NET application from CRM Online, it doesn’t matter as we just want to use the queries (nicely written in Linq with intellisense and type-safety) outputted from fun eventArgs -> printfn "-Query: %s" eventArgs.Request.RequestUri.Query for our JavaScript code in combination with the official SDK.REST.js library:

1
2
3
4
5
6
7
8
9
SDK.REST.retrieveMultipleRecords(
  "Account",
  "$filter=AccountNumber eq '42'&$skip=5&$top=1&$select=AccountNumber,AccountId", // query
  function (results) {
    // Do stuff
  },
  errorHandler,
  onCompleteHandler
);

The current way it’s done (and built on @deprecated technologies) is just not very handy (and has never been) as it requires to expand your current CRM tenant with a 3rd party managed solution:

CRM 2011 OData Query Designer

References:

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
let NOT = function | 1 -> 0 | _ -> 1
let AND x y = match x,y with | (1,1) -> 1 | _ -> 0
let OR  x y = match x,y with | (0,0) -> 0 | _ -> 1
let XOR x y = match x,y with | (1,1) | (0,0) -> 0 | _ -> 1
let NAND x y = (x,y) ||> AND |> NOT
let NOR  x y = (x,y) ||> OR  |> NOT
let XNOR x y = (x,y) ||> XOR |> NOT

let HALFADDER x y = (x,y) ||> AND,(x,y) ||> XOR
let FULLADDER x y z =
  let c,s   = (x,y) ||> HALFADDER
  let c',s' = (z,s) ||> HALFADDER
  (c,c') ||> OR, s'

let itb n =
  System.Convert.ToString(0+n, 2).PadLeft(32,'0')
  |> Seq.map string |> Seq.map int |> Seq.toList

let bti (ls:int list) =
  ls |> List.map string |> List.reduce (+)
     |> fun x -> System.Convert.ToInt32(x,2)

let add x y =
  (x |> itb , y |> itb)
  ||> List.zip
  |> List.rev
  |> List.fold(
    fun (c,zs) (x,y) -> (x,y,c) |||> FULLADDER |> fun (c',z) -> c',z::zs) (0,[])
  |> fun (x,ys) -> ys |> bti

// Eight cases:
(0,0,0) |||> FULLADDER;;
(1,0,0) |||> FULLADDER;;
(0,1,0) |||> FULLADDER;;
(1,1,0) |||> FULLADDER;;
(0,0,1) |||> FULLADDER;;
(1,0,1) |||> FULLADDER;;
(0,1,1) |||> FULLADDER;;
(1,1,1) |||> FULLADDER;;

// Examples taken from 'Domino Addition - Numberphile'
(42,17) ||> add;;
(55,27) ||> add;

Code output:

val NOT : _arg1:int -> int
val AND : x:int -> y:int -> int
val OR : x:int -> y:int -> int
val XOR : x:int -> y:int -> int
val NAND : x:int -> y:int -> int
val NOR : x:int -> y:int -> int
val XNOR : x:int -> y:int -> int
val HALFADDER : x:int -> y:int -> int * int
val FULLADDER : x:int -> y:int -> z:int -> int * int
val itb : n:int -> int list
val bti : ls:int list -> int
val add : x:int -> y:int -> int

> val it : int * int = (0, 0)
> val it : int * int = (0, 1)
> val it : int * int = (0, 1)
> val it : int * int = (1, 0)
> val it : int * int = (0, 1)
> val it : int * int = (1, 0)
> val it : int * int = (1, 0)
> val it : int * int = (1, 1)

> val it : int = 59
> val it : int = 82

References:

Code Snippet:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
type SeqMonad() =
  member t.Bind(m,f) = Seq.concat(Seq.map f m)
  member t.Return v = seq{ yield v }
let seqMonad = SeqMonad()

let permutations ls = 
  let rec insertions x = function
    | []             -> [[x]]
    | (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
  let rec permutations' = function
    | []      -> seq [ [] ]
    | x :: xs -> Seq.concat (Seq.map (insertions x) (permutations' xs))
  ls |> permutations'

let md5 s =
  System.BitConverter
    .ToString(
      System.Security.Cryptography.MD5
        .Create()
        .ComputeHash(buffer = System.Text.Encoding.UTF8.GetBytes(s = s)))
    .Replace("-", System.String.Empty)
    .ToLower()

let factorial n = 
  let rec fact acc = function | 0 -> acc | i -> fact (acc * i) (i - 1)
  (1,n) ||> fact

let unitTestPermutations () = 
  "FooBar" 
  |> Seq.toList
  |> fun xs -> xs |> permutations |> Seq.length,
               xs |> Seq.length   |> factorial
  |> fun (x,y) -> x = y

let unitTestMD5 () =  
  // [ mon@mbai7 tmp ] md5 -s "FooBar"
  // MD5 ("FooBar") = f32a26e2a3a8aa338cd77b6e1263c535
  "FooBar" |> md5 |> fun x -> x = "f32a26e2a3a8aa338cd77b6e1263c535"

(unitTestPermutations() && unitTestMD5()) |> function 
  | true -> () 
  | false -> failwith "Must be n! permuations per string"

let cache file =
  use reader = System.IO.File.OpenText(file)
  let rec cache' acc = function
    | true -> acc
    | false -> cache' (acc |> Set.add(reader.ReadLine())) reader.EndOfStream
  cache' Set.empty reader.EndOfStream

let root     = __SOURCE_DIRECTORY__
let wordList = System.IO.Path.Combine(root,"wordlist.txt")
let anagram  = @"poultry outwits ants"
let hash     = @"4624d200580677270a54ccff86b9610e"
let words    = anagram.Split(char " ")
let cached   = wordList |> cache

words |> Array.map(fun x  -> x  |> Seq.toList |> permutations)
      |> Array.map(fun xs -> xs |> Seq.map(fun ys -> ys |> List.map string))
      |> Array.map(fun xs -> xs |> Seq.map(fun ys -> ys |> List.reduce(+)))
      |> Array.map(fun xs -> xs |> Seq.filter(fun x -> (x,cached) ||> Set.contains))
      |> fun xs -> xs.[0],xs.[1],xs.[2]
      |> fun (xs,ys,zs) -> seqMonad{let! x = xs
                                    let! y = ys
                                    let! z = zs
                                    return (x,y,z)}
      |> Seq.map(fun (x,y,z) -> x + " " + y + " " + z)
      |> Seq.map(fun x -> x |> md5, x)
      |> Seq.filter(fun (x,y) -> x = hash)
      |> Seq.map(fun (x,y) -> y)
      |> Seq.truncate 1
      |> fun x -> x |> printfn "%A"

Code output:

type SeqMonad =
  class
    new : unit -> SeqMonad
    member Bind : m:seq<'b> * f:('b -> #seq<'d>) -> seq<'d>
    member Return : v:'a -> seq<'a>
  end
val seqMonad : SeqMonad
val permutations : ls:'a list -> seq<'a list>
val md5 : s:string -> string
val factorial : n:int -> int
val unitTestPermutations : unit -> bool
val unitTestMD5 : unit -> bool
val cache : file:string -> Set<string>
val root : string = "/Users/mon/tmp"
val wordList : string = "/Users/mon/tmp/wordlist.txt"
val anagram : string = "poultry outwits ants"
val hash : string = "4624d200580677270a54ccff86b9610e"
val words : string [] = [|"poultry"; "outwits"; "ants"|]
val cached : Set<string> =
  set
    ["a"; "a's"; "ab's"; "abaci"; "aback"; "abacus"; "abacus's"; "abacuses";
     "abaft"; ...]

Code result:

> seq []
> val it : unit = ()

References: