Haskell Quiz/The Solitaire Cipher/Solution Stoltze
From HaskellWiki
< Haskell Quiz  The Solitaire Cipher(Difference between revisions)
m 

(One intermediate revision by one user not shown) 
Latest revision as of 11:25, 21 February 2010
module Main where import Char import List data Card = Card Int  JokerA  JokerB deriving (Show, Eq) instance Enum Card where fromEnum JokerA = 53 fromEnum JokerB = 54 fromEnum (Card n) = n toEnum n  n == 53 = JokerA  n == 54 = JokerB  otherwise = Card n succ JokerB = Card 1 getValue :: Card > Int getValue (Card n) = n getValue JokerA = 53 getValue JokerB = 53 deck :: [Card] deck = [Card 1 .. JokerB] alphabet :: [Char] alphabet = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" letterToNumber :: Char > Int letterToNumber ch = f' 1 ch where f' n ch = if alphabet !! (n1) == ch then n else f' (n+1) ch numberToLetter :: Int > Char numberToLetter n  n < 1 = numberToLetter (n + 26)  n > 26 = numberToLetter (n  26)  otherwise = alphabet !! (n  1)  Not really needed, but since they specified cutting it into chuncks of 5, I thought I'd comply splitInto :: Int > [Char] > [Char] splitInto n list = unwords $ splitInto' n list where splitInto' n list  null list = []  length list < n = [list ++ replicate (n  length list) 'X']  otherwise = [take n list] ++ splitInto' n (drop n list)  Takes some words and a function for parsing. Since encode and decode were very similar, I thought this would be easier process :: [Char] > (Int > Int > Int) > [Char] process line fn = let noSpaces = map toUpper $ filter isAlpha line key = genKey $ length noSpaces keyvalues = map letterToNumber key linevalues = map letterToNumber noSpaces newline = map (\(x, y) > numberToLetter (fn x y)) $ zip linevalues keyvalues in splitInto 5 newline encode :: [Char] > [Char] encode line = process line (\line key > line + key) decode :: [Char] > [Char] decode line = process line (\line key > line  key)  Generates the keycode genKey :: Int > [Char] genKey n = repl n deck where repl 0 _ = [] repl n val = let res = convert $ move val in if res == ' ' then repl n (move val) else res : (repl (n1) (move val)) toLetter :: Card > Char toLetter JokerA = ' ' toLetter JokerB = ' ' toLetter card = (cycle alphabet !!) $ getValue card  1 convert :: [Card] > Char convert (x:xs) = toLetter $ (x:xs) !! getValue x  Moves the deck one step ahead move :: [Card] > [Card] move cards = stepFour $ stepThree $ stepTwo $ stepOne cards where findStart :: (Eq a) => a > [a] > [a] findStart n (x:xs) = if x == n then (x:xs) else findStart n (xs ++ [x]) stepOne, stepTwo, stepThree, stepFour :: [Card] > [Card] stepOne (JokerA:x:xs) = x:JokerA:xs stepOne (x:xs) = let change (x:y:xs) = if x == JokerA then (y:x:xs) else change ((y:xs) ++ [x]) in findStart x $ change (x:xs) stepTwo (JokerB:x:y:xs) = x:y:JokerB:xs stepTwo (x:xs) = let change (x:y:z:xs) = if x == JokerB then (y:z:x:xs) else change ((y:z:xs) ++ [x]) in findStart x $ change (x:xs) stepThree (x:xs) = let fn c = c /= JokerA && c /= JokerB toFirst = takeWhile fn (x:xs) toLast = reverse $ takeWhile fn $ reverse (x:xs) in toLast ++ (reverse (drop (length toLast) (reverse (drop (length toFirst) (x:xs))))) ++ toFirst stepFour cards = let l = last cards r = getValue l in drop r (init cards) ++ take r (cards) ++ [l]