Haskell Quiz/The Solitaire Cipher/Solution JFoutz
From HaskellWiki
< Haskell Quiz | The Solitaire Cipher(Difference between revisions)
m (i wish i could spell. solitare -> solitaire) |
m |
||
| Line 23: | Line 23: | ||
| - | drawMsg msg = | + | drawMsg msg = unwords (loop msg) |
where loop msg | where loop msg | ||
| length msg > 5 = (take 5 msg) : loop (drop 5 msg) | | length msg > 5 = (take 5 msg) : loop (drop 5 msg) | ||
| Line 32: | Line 32: | ||
decrypt msg = churn solSub msg | decrypt msg = churn solSub msg | ||
| - | main = do | + | main = do (x:xs) <- getArgs |
| - | + | case x of | |
| - | "c" -> putStrLn $ crypt $ concat $ | + | "c" -> putStrLn $ crypt $ concat $ xs |
| - | "d" -> putStrLn $ decrypt $ concat $ | + | "d" -> putStrLn $ decrypt $ concat $ xs |
_ -> putStrLn "Try solitaire c my message, or d my message"} | _ -> putStrLn "Try solitaire c my message, or d my message"} | ||
| Line 43: | Line 43: | ||
-- add and subtract base solitaire style | -- add and subtract base solitaire style | ||
| - | solAdd x y = | + | solAdd x y = (x + y) `mod` 26 |
| - | solSub x y = | + | solSub x y = (x + 26 - y) `mod` 26 |
Current revision
This took longer than expected. I didn't read the specification closely enough to realize both jokers count as 53 rather than A == 53 and B == 54
Other than that, looking through Data.List for shortcuts was educational. I really like zipWith and groupBy.
This could probably use a lot more orginization, and a bit more commentary. Fortunately the function names match the spec closely, which helps.
import Data.Char import Data.List import System -- discard any non a to z characers, uppercase the rest -- split into groups of 5, padded with 'X' prep ls = loop $ map toUpper $ filter (\x -> and [isAscii x, isLetter x]) ls where loop [] = [] loop ls | length ls < 5 = [take 5 (ls ++ "XXXX")] | otherwise = (take 5 ls) : loop (drop 5 ls) drawMsg msg = unwords (loop msg) where loop msg | length msg > 5 = (take 5 msg) : loop (drop 5 msg) | otherwise = [msg] churn f msg = drawMsg $ toChr $ zipWith f (toNum $ concat $ prep msg) (keyStream [1..54]) crypt msg = churn solAdd msg decrypt msg = churn solSub msg main = do (x:xs) <- getArgs case x of "c" -> putStrLn $ crypt $ concat $ xs "d" -> putStrLn $ decrypt $ concat $ xs _ -> putStrLn "Try solitaire c my message, or d my message"} -- letters to numbers and back toNum = map (\x -> ord x - 65) toChr = map (\x -> chr (x + 65)) -- add and subtract base solitaire style solAdd x y = (x + y) `mod` 26 solSub x y = (x + 26 - y) `mod` 26 --keyStream down1 x ls = move $ break (==x) ls where move (x:xs, t:[]) = x:t:xs move (xs, c:n:cx) = xs ++ n : c : cx down2 x ls = down1 x $ down1 x ls notEither a b = (\x y -> x /= a && y /= a && x /= b && y /= b) tripleCut a b ls = swap a b $ concat $ reverse $ groupBy (notEither a b) ls swap a b [] = [] swap a b (x:xs) | a == x = b : swap a b xs | b == x = a : swap a b xs | otherwise = x : swap a b xs cardVal c = if c == 54 then 53 else c countCut ls = glue $ splitAt (cardVal $ last ls) (init ls) where glue (f,b) = b ++ f ++ [last ls] jokerA = 53 jokerB = 54 keyStep deck = countCut $ tripleCut jokerA jokerB $ down2 jokerB $ down1 jokerA deck getCard deck = deck !! (cardVal $ head deck) keyStream deck = let d2 = keyStep deck out = getCard d2 in if out == jokerA || out == jokerB then keyStream d2 else out : keyStream d2
