Enigma machine simulator - improving recursive algorithm performance

Question

I'm new to Haskell and am confused by why my code seems to preform so poorly, and wonder if there's something I've not grasped about the coding philosophy behind the language, or the best way to take advantage of its features.

For example, I have started, as an exercise (yet another) simple Enigma machine simulator (for which I've attached the state changing code below) that I have implemented in other languages (e.g., Mathematica) using exactly the same recursive approach to computing the state of the machine from previous states.

But in Haskell, this code performs too slowly to be of any use. I can for example

ghci> let cfg = EnigmaConfig "B-III-II-I" "KDO" "" "01.01.01"
ghci> map (windows . step cfg) [0..10]

to view the state changes of the machine as expressed by the rotor letters visible in the machine windows. But for larger ranges of steps, things start to take forever. I have to give up after a few minutes waiting for

ghci> map (windows . step cfg) [0..20]

to complete.

I've tried caching results of the overall machine state (step) and the rotor positions (componentPos), as indicated in the alternate versions of the relevant functions in the comment to the code fragment, but this has little effect.

Is there a better approach to improving the performance of recursive code like this in Haskell? Have my attempts to "cache" results failed to store the relevant values, or missed the source of my performance issues?

---

import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Ix (inRange)

letters = ['A'..'Z'] 

letterIndex :: Char ->  Int
letterIndex l = fromJust $ elemIndex l letters

type Wiring = String
type Turnovers = String
type Name = String

data Component = Component { wiring :: Wiring, turnovers :: Turnovers }

component :: Name -> Component
component n = case n of
    "I"       -> Component "EKMFLGDQVZNTOWYHXUSPAIBRCJ" "Q"
    "II"      -> Component "AJDKSIRUXBLHWTMCQGZNPYFVOE" "E"
    "III"     -> Component "BDFHJLCPRTXVZNYEIWGAKMUSQO" "V"
    "IV"      -> Component "ESOVPZJAYQUIRHXLNFTGKDCMWB" "J"
    "V"       -> Component "VZBRGITYUPSDNHLXAWMJQOFECK" "Z"
    "VI"      -> Component "JPGVOUMFYQBENHZRDKASXLICTW" "ZM"
    "VII"     -> Component "NZJHGRCXMYSWBOUFAIVLPEKQDT" "ZM"
    "VIII"    -> Component "FKQHTLXOCBJSPDZRAMEWNIUYGV" "ZM"
    "β"       -> Component "LEYJVCNIXWPBQMDRTAKZGFUHOS" ""
    "γ"       -> Component "FSOKANUERHMBTIYCWLQPZXVGJD" ""
    "A"       -> Component "EJMZALYXVBWFCRQUONTSPIKHGD" ""
    "B"       -> Component "YRUHQSLDPXNGOKMIEBFZCWVJAT" ""
    "C"       -> Component "FVPJIAOYEDRZXWGCTKUQSBNMHL" ""
    "b"       -> Component "ENKQAUYWJICOPBLMDXZVFTHRGS" ""
    "c"       -> Component "RDOBJNTKVEHMLFCWZAXGYIPSUQ" ""
    otherwise -> Component "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ""

type Stage = Int

data EnigmaConfig = EnigmaConfig { rotors :: String, windows :: String, plugboard :: String, rings :: String } deriving Show

windowNum :: EnigmaConfig -> Stage -> Int
windowNum ec i = letterIndex (("A" ++ (reverse $ windows ec) ++ "A") !! i)   
ringNum :: EnigmaConfig -> Stage -> Int
ringNum ec i =  (reverse $ map (\x -> read x :: Int) (splitOn "." ("01." ++ (rings ec) ++ ".01"))) !! i
stageName :: EnigmaConfig -> Stage -> Name
stageName ec i = (reverse (splitOn "-" ((rotors ec) ++ "-" ++ (plugboard ec)))) !! i

isTurn :: EnigmaConfig -> Stage -> Bool
isTurn ec i = elem (letters !! (windowNum ec i)) (turnovers $ component (stageName ec i))

step :: EnigmaConfig -> Int -> EnigmaConfig
step ec n = EnigmaConfig {
    rotors = rotors ec,
    windows = map (\i -> (cycle letters) !! (componentPos ec n i)) [3,2,1],
    plugboard = plugboard ec,
    rings = rings ec
    }

componentPos :: EnigmaConfig -> Int -> Int -> Int
componentPos ec n i | i == 0                            = 0
                    | i >  3 && n /= 0                  = componentPos ec 0 i
                    |           n == 0                  = windowNum ec i - ringNum ec i + 1
                    | i == 1                            = prevPos + 1
                    | i == 2 && isTurn prevConfig 2     = prevPos + 1
                    |           isTurn prevConfig (i-1) = prevPos + 1
                    | otherwise                         = prevPos
                where 
                    prevConfig = step ec (n-1)
                    prevPos = componentPos ec (n-1) i

-- cached?
-- step :: EnigmaConfig -> Int -> EnigmaConfig
-- step ec = (map (step' ec) [0 ..] !!)
--         where step' ec n = EnigmaConfig {
--             rotors = rotors ec,
--             windows = map (\i -> (cycle letters) !! ((componentPos ec i n)     - (0))) [3,2,1],
--             plugboard = plugboard ec,
--             rings = rings ec
--         }   
-- componentPos :: EnigmaConfig -> Int -> Int -> Int
-- componentPos ec i = (map (componentPos' ec i) [0 ..] !!)
--     where componentPos' ec i n | i == 0                            = 0
--                                | i >  3 && n /= 0                  = componentPos ec i 0
--                                |           n == 0                  = windowNum ec i - ringNum ec i + 1
--                                | i == 1                            = prevPos + 1
--                                | i == 2 && isTurn prevConfig 2     = prevPos + 1
--                                |           isTurn prevConfig (i-1) = prevPos + 1
--                                | otherwise                         = prevPos
--                             where 
--                                 prevConfig = step ec (n-1)
--                                 prevPos = componentPos ec i (n-1)

---

Note: The question here is not about the algorithm itself (I know there are other approaches that are faster; that would be a question for code review). The question here is about how to use Haskell's features and idioms to modify the basic recursive approach so that it performs well.

Answer 1

Here is a way to use your existing code to efficiently compute any number of windows:

test n = take n $ map windows $ iterate ((flip step) 1) cfg0

The key is to use step with an increment of 1 starting from the previous computed config.

Using this idea, here is a better definition of step for a general n:

newStep ec n = last $ take (n+1) $ iterate ((flip step) 1) ec

newTest n = map (windows . newStep cfg0) [0..n]

newTest is still a quadratic algorithm because newStep cfg 50 starts the stepping process from the beginning instead of using the result of newStep cfg 49. If you really are going to be using the sequence of stepped configs, just use iterate directly like test does above.

Finally, a some philosophical musings...

What's going on here is that the code you've written for stepping n times turns out to be less efficient than just applying the step once function n times. Turning this around, if you have a "step once" function:

stepOnce :: Config -> Config

you can always define a "step n times" function as the repeated application of that function:

stepNTimes :: Int -> Config -> Config
stepNTimes n c = head $ drop n $ iterate stepOnce c

If you have a short-cut way of stepping n times then perhaps it is worthwhile to define a custom stepNTimes function. However, if you are defining stepping n times in a recursive fashion, then perhaps it is no better than repeatedly applying stepOnce n times. The result will be simpler and more obviously correct.

Answer 2

First, the automatic stuff people will reply when somebody asks a question like this:

• You are compiling the code with optimisations on, right?

• You may (or may not) find that changing String to something else gives a speedup. (In this case, it's probably not the main bottleneck.)

---

I see several things which say "slow" to me. For a start,

letters = ['A'..'Z']

letterIndex :: Char ->  Int
letterIndex l = fromJust $ elemIndex l letters

That's a linear-time scan just to convert a character to a number. OK, it's a very small list to search. OTOH, I'm not sure how often this gets called, so... How about this:

letterIndex :: Char -> Int
letterIndex l = fromIntegral l - fromIntegral 'A'

That's now a constant-time calculation. And you don't need the fromJust nonsense.

windowNum :: EnigmaConfig -> Stage -> Int
windowNum ec i = letterIndex (("A" ++ (reverse $ windows ec) ++ "A") !! i)

OK, that doesn't sound good. Calling reverse is likely to be slow. Calling ++ is likely to be slow. Calling !! is likely to be slow. It sounds like you probably want to be using a different data structure here. Maybe Data.Map or something?

I'm not precisely sure what component is doing, but it may be worth changing Name from a String to an enumeration:

data Name = I | II | III | ...

This will probably make the case-block in component go a bit faster.

Without studying your actual algorithm in detail, these are the things that jump out at me.

---

EDIT: OK, so studying the code a bit closer, it seems that EnigmaConfig stores a bunch of strings, and every single time you want to do something, you parse and re-parse the strings into the actual codes you want. Don't do that. Store the actual code numbers you want (as Int or [Int] or Map Int Int or whatever). Reparsing again and again will be slow as hell — especially with all the calls to reverse and !! involved.

Answer 3

There have been several mentions of inefficiencies like using String everywhere here, but those are in fact, almost irrelevant compared to the big issue which you've already suspected.

The fact that your code runs relatively fine with 10 steps but blows up completely with 20 should be a big hint: Your code has recursion with exponential blowup, and your caching method isn't quite working. Once that is fixed, your current test cases will run almost instantaneously in GHCi, regardless of the other issues mentioned. However, if you need to make it more efficient later, those might be worth looking at.

First, let me state a fundamental rule of (GHC) Haskell caching/memoizing: The results of a function defined in the step ec = form are essentially never cached between invocations to it. It doesn't matter how much caching you do internally in the function; different invocations of step ec will not share any calculation that depends on ec. And all the mutual mentions of step ec and componentPos ec in those functions will not see the caching, the way you tried it.

There are two problems in your case that makes the caching trickier: the need to pass in a common configuration, and especially the mutual recursion between two top level functions. To fix this, I've defined below a function

cached ec = (stepEc, componentPosEc)

so that all the caching within a single invocation can be shared between them.

(It would be possible to cache even based on the ec argument, but then we would need to define a way to memoize on EnigmaConfig arguments. One of the memoization libraries on Hackage might help for this. Here I've gone with a method that works with just the (map ... !!) trick you're already using.)

Also, your caching for componentPos only cached one of the arguments. For proper caching we need to include both, but this is a relatively simple change.

Finally, I defined the original names step and componentPos at the top level to go via cached instead. Note that there is still no caching between invocations of those.

Other than this, I've tried to keep changes minimal from your original cached version.

import Data.Char
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Ix (inRange)

letters = ['A'..'Z'] 

letterIndex :: Char ->  Int
letterIndex l = fromJust $ elemIndex l letters

type Wiring = String
type Turnovers = String
type Name = String

data Component = Component { wiring :: Wiring, turnovers :: Turnovers }

component :: Name -> Component
component n = case n of
    "I"       -> Component "EKMFLGDQVZNTOWYHXUSPAIBRCJ" "Q"
    "II"      -> Component "AJDKSIRUXBLHWTMCQGZNPYFVOE" "E"
    "III"     -> Component "BDFHJLCPRTXVZNYEIWGAKMUSQO" "V"
    "IV"      -> Component "ESOVPZJAYQUIRHXLNFTGKDCMWB" "J"
    "V"       -> Component "VZBRGITYUPSDNHLXAWMJQOFECK" "Z"
    "VI"      -> Component "JPGVOUMFYQBENHZRDKASXLICTW" "ZM"
    "VII"     -> Component "NZJHGRCXMYSWBOUFAIVLPEKQDT" "ZM"
    "VIII"    -> Component "FKQHTLXOCBJSPDZRAMEWNIUYGV" "ZM"
    "β"       -> Component "LEYJVCNIXWPBQMDRTAKZGFUHOS" ""
    "γ"       -> Component "FSOKANUERHMBTIYCWLQPZXVGJD" ""
    "A"       -> Component "EJMZALYXVBWFCRQUONTSPIKHGD" ""
    "B"       -> Component "YRUHQSLDPXNGOKMIEBFZCWVJAT" ""
    "C"       -> Component "FVPJIAOYEDRZXWGCTKUQSBNMHL" ""
    "b"       -> Component "ENKQAUYWJICOPBLMDXZVFTHRGS" ""
    "c"       -> Component "RDOBJNTKVEHMLFCWZAXGYIPSUQ" ""
    otherwise -> Component "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ""

type Stage = Int

data EnigmaConfig = EnigmaConfig { rotors :: String, windows :: String, plugboard :: String, rings :: String } deriving Show

windowNum :: EnigmaConfig -> Stage -> Int
windowNum ec i = letterIndex (("A" ++ (reverse $ windows ec) ++ "A") !! i)   
ringNum :: EnigmaConfig -> Stage -> Int
ringNum ec i =  (reverse $ map (\x -> read x :: Int) (splitOn "." ("01." ++ (rings ec) ++ ".01"))) !! i
stageName :: EnigmaConfig -> Stage -> Name
stageName ec i = (reverse (splitOn "-" ((rotors ec) ++ "-" ++ (plugboard ec)))) !! i

isTurn :: EnigmaConfig -> Stage -> Bool
isTurn ec i = elem (letters !! (windowNum ec i)) (turnovers $ component (stageName ec i))

step :: EnigmaConfig -> Int -> EnigmaConfig
step ec = fst $ cached ec

componentPos :: EnigmaConfig -> Int -> Int -> Int
componentPos ec = snd $ cached ec

cached ec = (stepEc, componentPosEc) where
    stepEc :: Int -> EnigmaConfig
    stepEc = (map (step' ec) [0 ..] !!)
            where step' ec n = EnigmaConfig {
                rotors = rotors ec,
                windows = map (\i -> (cycle letters) !! ((componentPosEc i n)     - (0))) [3,2,1],
                plugboard = plugboard ec,
                rings = rings ec
            }   
    componentPosEc :: Int -> Int -> Int
    componentPosEc = (map (\i -> (map (componentPos' ec i) [0 ..] !!)) [0..] !!)
        where componentPos' ec i n | i == 0                            = 0
                                   | i >  3 && n /= 0                  = componentPosEc i 0
                                   |           n == 0                  = windowNum ec i - ringNum ec i + 1
                                   | i == 1                            = prevPos + 1
                                   | i == 2 && isTurn prevConfig 2     = prevPos + 1
                                   |           isTurn prevConfig (i-1) = prevPos + 1
                                   | otherwise                         = prevPos
                                where 
                                    prevConfig = stepEc (n-1)
                                    prevPos = componentPosEc i (n-1)