Initial commit

CipherSuite/Monoalphabetic.fs

@@ -0,0 +1,118 @@
+namespace CipherSuite
+
+#if DEBUG
+#else
+#nowarn "9"
+#endif
+
+[<RequireQualifiedAccess>]
+module Monoalphabetic =
+
+    /// The hill climber is allowed to accept a worse solution sometimes
+    /// (in the name of escaping local optima). This is a table of probabilities
+    /// for how much worse the solution is allowed to be; for example, there is a
+    /// 5 in 20 chance that we don't accept any worse solution, and a 2 in 20 chance
+    /// we accept a solution that is 8-or-more worse.
+    /// I have completely lost the source of these numbers, and it appears that
+    /// by sheer coincidence the scale I chose for the built-in fitness function
+    /// happens to be very compatible with these perturbations.
+    let private perturbations =
+        [|
+            0
+            0
+            0
+            0
+            0
+            1
+            1
+            1
+            1
+            1
+            2
+            2
+            2
+            3
+            4
+            4
+            5
+            6
+            8
+            15
+        |]
+        |> Array.map float
+
+    let private decrypt (key : int[]) (ciphertext : int[]) (output : int[]) : unit =
+        for i = 0 to ciphertext.Length - 1 do
+            output.[i] <- key.[ciphertext.[i]]
+
+    let inline private swap (arr : int[]) (p1 : int) (p2 : int) : unit =
+        let temp = arr.[p1]
+        arr.[p1] <- arr.[p2]
+        arr.[p2] <- temp
+
+    let rec private backToString (text : int[]) : string =
+        text |> Array.map ((+) (int 'a') >> char) |> System.String
+
+    // I *think* this may originally be an algorithm described in
+    // http://web.archive.org/web/20110210123730/http://web.mac.com/mikejcowan/Ciphers/Churn_Algorithm.html
+    // But it was over a decade ago and I've simply forgotten the source.
+    let crack (rand : System.Random) (keysLimit : int) (ciphertext : string) : int[] * string * float =
+        let ciphertext = ciphertext.ToUpperInvariant ()
+#if DEBUG
+        let fitness = Fitness.fromEmbedded ()
+#else
+        let arr = Fitness.allocate ()
+        use ptr = fixed arr
+        let fitness = Fitness.fromEmbedded ptr
+#endif
+        let plaintext =
+            Array.init
+                ciphertext.Length
+                (fun i ->
+                    let output = int ciphertext.[i] - int 'A'
+
+                    if output < 0 || output > 25 then
+                        failwith "non-alphabetic character"
+
+                    output
+                )
+
+        let ciphertext = Array.copy plaintext
+        let currentKey = [| 0..25 |]
+        let bestKey = Array.copy currentKey
+        decrypt currentKey ciphertext plaintext
+        let mutable currentFitness = Fitness.get' plaintext fitness
+        let mutable bestFitness = currentFitness
+        let mutable keyCount = 0
+
+        while keyCount < keysLimit do
+            let swap1 = rand.Next (0, 26)
+            let swap2 = rand.Next (0, 25)
+            let swap2 = if swap2 < swap1 then swap2 else swap2 + 1
+
+            swap currentKey swap1 swap2
+
+            // We could do better here, because the plaintext changes
+            // only in well-defined ways from loop to loop.
+            // I'm lazy.
+            decrypt currentKey ciphertext plaintext
+
+            let newFitness = Fitness.get' plaintext fitness
+
+            if newFitness > bestFitness then
+                bestFitness <- newFitness
+                currentFitness <- newFitness
+                Array.blit currentKey 0 bestKey 0 currentKey.Length
+            elif newFitness > currentFitness - perturbations.[rand.Next (0, perturbations.Length)] then
+                // This guess wasn't the best we've had, but it's good enough when we
+                // add in a bit of jitter to get us out of local optima.
+                currentFitness <- newFitness
+            else
+                // Revert this guess, it wasn't sufficiently high fitness
+                swap currentKey swap1 swap2
+
+            keyCount <- keyCount + 1
+
+        decrypt bestKey ciphertext plaintext
+        let plaintext = backToString plaintext
+        bestKey, plaintext, bestFitness