Fork me on GitHub

Code Snippet:

 1 let NOT = function | 1 -> 0 | _ -> 1
 2 let AND x y = match x,y with | (1,1) -> 1 | _ -> 0
 3 let OR  x y = match x,y with | (0,0) -> 0 | _ -> 1
 4 let XOR x y = match x,y with | (1,1) | (0,0) -> 0 | _ -> 1
 5 let NAND x y = (x,y) ||> AND |> NOT
 6 let NOR  x y = (x,y) ||> OR  |> NOT
 7 let XNOR x y = (x,y) ||> XOR |> NOT
 8 
 9 let HALFADDER x y = (x,y) ||> AND,(x,y) ||> XOR
10 let FULLADDER x y z =
11   let c,s   = (x,y) ||> HALFADDER
12   let c',s' = (z,s) ||> HALFADDER
13   (c,c') ||> OR, s'
14 
15 let itb n =
16   System.Convert.ToString(0+n, 2).PadLeft(32,'0')
17   |> Seq.map string |> Seq.map int |> Seq.toList
18 
19 let bti (ls:int list) =
20   ls |> List.map string |> List.reduce (+)
21      |> fun x -> System.Convert.ToInt32(x,2)
22 
23 let add x y =
24   (x |> itb , y |> itb)
25   ||> List.zip
26   |> List.rev
27   |> List.fold(
28     fun (c,zs) (x,y) -> (x,y,c) |||> FULLADDER |> fun (c',z) -> c',z::zs) (0,[])
29   |> fun (x,ys) -> ys |> bti
30 
31 // Eight cases:
32 (0,0,0) |||> FULLADDER;;
33 (1,0,0) |||> FULLADDER;;
34 (0,1,0) |||> FULLADDER;;
35 (1,1,0) |||> FULLADDER;;
36 (0,0,1) |||> FULLADDER;;
37 (1,0,1) |||> FULLADDER;;
38 (0,1,1) |||> FULLADDER;;
39 (1,1,1) |||> FULLADDER;;
40 
41 // Examples taken from 'Domino Addition - Numberphile'
42 (42,17) ||> add;;
43 (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 type SeqMonad() =
 2   member t.Bind(m,f) = Seq.concat(Seq.map f m)
 3   member t.Return v = seq{ yield v }
 4 let seqMonad = SeqMonad()
 5 
 6 let permutations ls = 
 7   let rec insertions x = function
 8     | []             -> [[x]]
 9     | (y :: ys) as l -> (x::l)::(List.map (fun x -> y::x) (insertions x ys))
10   let rec permutations' = function
11     | []      -> seq [ [] ]
12     | x :: xs -> Seq.concat (Seq.map (insertions x) (permutations' xs))
13   ls |> permutations'
14 
15 let md5 s =
16   System.BitConverter
17     .ToString(
18       System.Security.Cryptography.MD5
19         .Create()
20         .ComputeHash(buffer = System.Text.Encoding.UTF8.GetBytes(s = s)))
21     .Replace("-", System.String.Empty)
22     .ToLower()
23 
24 let factorial n = 
25   let rec fact acc = function | 0 -> acc | i -> fact (acc * i) (i - 1)
26   (1,n) ||> fact
27 
28 let unitTestPermutations () = 
29   "FooBar" 
30   |> Seq.toList
31   |> fun xs -> xs |> permutations |> Seq.length,
32                xs |> Seq.length   |> factorial
33   |> fun (x,y) -> x = y
34 
35 let unitTestMD5 () =  
36   // [ mon@mbai7 tmp ] md5 -s "FooBar"
37   // MD5 ("FooBar") = f32a26e2a3a8aa338cd77b6e1263c535
38   "FooBar" |> md5 |> fun x -> x = "f32a26e2a3a8aa338cd77b6e1263c535"
39 
40 (unitTestPermutations() && unitTestMD5()) |> function 
41   | true -> () 
42   | false -> failwith "Must be n! permuations per string"
43 
44 let cache file =
45   use reader = System.IO.File.OpenText(file)
46   let rec cache' acc = function
47     | true -> acc
48     | false -> cache' (acc |> Set.add(reader.ReadLine())) reader.EndOfStream
49   cache' Set.empty reader.EndOfStream
50 
51 let root     = __SOURCE_DIRECTORY__
52 let wordList = System.IO.Path.Combine(root,"wordlist.txt")
53 let anagram  = @"poultry outwits ants"
54 let hash     = @"4624d200580677270a54ccff86b9610e"
55 let words    = anagram.Split(char " ")
56 let cached   = wordList |> cache
57 
58 words |> Array.map(fun x  -> x  |> Seq.toList |> permutations)
59       |> Array.map(fun xs -> xs |> Seq.map(fun ys -> ys |> List.map string))
60       |> Array.map(fun xs -> xs |> Seq.map(fun ys -> ys |> List.reduce(+)))
61       |> Array.map(fun xs -> xs |> Seq.filter(fun x -> (x,cached) ||> Set.contains))
62       |> fun xs -> xs.[0],xs.[1],xs.[2]
63       |> fun (xs,ys,zs) -> seqMonad{let! x = xs
64                                     let! y = ys
65                                     let! z = zs
66                                     return (x,y,z)}
67       |> Seq.map(fun (x,y,z) -> x + " " + y + " " + z)
68       |> Seq.map(fun x -> x |> md5, x)
69       |> Seq.filter(fun (x,y) -> x = hash)
70       |> Seq.map(fun (x,y) -> y)
71       |> Seq.truncate 1
72       |> 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:

Code Snippet:

 1 let bitlength (x:bigint) =
 2   let xs  = x.ToByteArray()
 3   let n   = xs |> Array.length
 4   let msb = xs.[n-1]
 5   let rec bitlength' a = function
 6     | 0uy  -> a
 7     | msb' -> (a+1,msb' >>> 1) ||> bitlength'
 8   ((n-1)*8,msb) ||> bitlength'
 9 
10 let split (x:bigint) m =
11   let y = x >>> m
12   y,(x - (y <<< m))
13 
14 let karatsuba x y =
15   let r = 1 <<< 10
16   let leq x y = (x |> bitlength) <= y
17   let rec karatsuba' = function
18     | (x',y') when (x',r) ||> leq || (y',r) ||> leq -> (x' * y')
19     | (x',y') ->
20       let n = (x' |> bitlength, y' |> bitlength) ||> max
21       let m = n >>> 1
22       let h1,l1 = (x',m) ||> split
23       let h2,l2 = (y',m) ||> split 
24       let z0 = (l1,l2)       |> karatsuba'
25       let z1 = (l1+h1,l2+h2) |> karatsuba'
26       let z2 = (h1,h2)       |> karatsuba'   
27       (z2 <<< (2 * m)) + ((z1 - z0 - z2) <<< m) + z0
28   (x,y) |> karatsuba'
29 
30 let fib n = // tail-recursive with two accs
31   let rec fib' a1 a2 = function
32     | 0 -> 0I
33     | 1 -> a1 + a2
34     | i -> fib' a2 (a1 + a2) (i - 1)
35   fib' 1I 0I n
36 
37 let fibfast n =
38   let inline inner x y i =
39     let a = x * (2I * y - x)
40     let b = y * y + x * x
41     match i % 2 = 0 with | true -> (a,b) | false -> (b, a+b)
42   let rec fibfast' k = function
43     | 0 -> k (0I,1I)
44     | i -> fibfast' (fun (x,y) -> k((x,y,i) |||> inner)) (i >>> 1)
45   (id,n) ||> fibfast' |> fst
46 
47 let fibfastkarat n =
48   let inline inner x y i =
49     let a = (x,((2I,y) ||> karatsuba) - x) ||> karatsuba
50     let b = ((y,y) ||> karatsuba) + ((x,x) ||> karatsuba)
51     match i % 2 = 0 with | true -> (a,b) | false -> (b, a+b)
52   let rec fibfastkarat' k = function
53     | 0 -> k (0I,1I)
54     | i -> fibfastkarat' (fun (x,y) -> k((x,y,i) |||> inner)) (i >>> 1)
55   (id,n) ||> fibfastkarat' |> fst

Code output:

> val bitlength : x:bigint -> int
> val split : x:bigint -> m:int32 -> bigint * System.Numerics.BigInteger
> val karatsuba : x:bigint -> y:bigint -> System.Numerics.BigInteger
> val fib : n:int -> System.Numerics.BigInteger
> val fibfast : n:int -> System.Numerics.BigInteger
> val fibfastkarat : n:int -> System.Numerics.BigInteger

Correctness test:

1 let correctness =
2   ((10. ** 6. |> int |> fib),
3    (10. ** 6. |> int |> fibfast),
4    (10. ** 6. |> int |> fibfastkarat))
5   |> fun (x,y,z) -> x = y && x = z;;

Correctness output:

> val correctness : bool = true

Performance test:

1 let duration f =
2   let t = System.Diagnostics.Stopwatch()
3   t.Start()
4   let x = f()
5   x,t.ElapsedMilliseconds |> float
6 
7 duration(fun _ -> 10. ** 6. |> int |> fib)          |> snd;;
8 duration(fun _ -> 10. ** 6. |> int |> fibfast)      |> snd;;
9 duration(fun _ -> 10. ** 6. |> int |> fibfastkarat) |> snd;;

Performance output:

> val duration : f:(unit -> 'a) -> 'a * float
> val it : float = 198480.0
> val it : float = 4623.0
> val it : float = 1082.0

References: