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.