
I'm a beginner having a go at implementing the Solitaire cipher (http://www.rubyquiz.com/quiz1.html as mentioned in another post) and I'd be really grateful if you could help me improve the code to be neater & use more functions from the Prelude etc, or errors (eg at the moment I can't work out why padding accumulates after encrypting, decrypting?)...Thanks. *Main> decrypt $ encrypt "haskell is better by miles" "HASKE LLISB ETTER BYMIL ESAYP XXXXX " *Main> decrypt $ encrypt $ decrypt $ encrypt "haskell is better by miles" "HASKE LLISB ETTER BYMIL ESAYP XXXXX BFCRK XXXXX " *Main> ------------------------------------------- import Char import Random import List import Foreign import Maybe data Card = Clubs Int | Spades Int | Diamonds Int | Hearts Int | JokerA | JokerB deriving (Show, Eq) type Deck = [Card] --cardval - clubs are face value, diamonds plus 13, and so on - Jokers are both 53 cardval :: Card -> Int cardval (Clubs i) = i cardval (Diamonds i) = i+13 cardval (Hearts i) = i+26 cardval (Spades i) = i+39 cardval _ = 53 isJoker :: Card -> Bool isJoker JokerA = True isJoker JokerB = True isJoker _ = False --take a card to a letter card2char :: Card -> Char card2char c = case c of (Clubs i) -> int2alpha $ cardval c --can case fall through in haskell? (Diamonds i) -> int2alpha $ cardval c (Hearts i) -> int2alpha $ (cardval c-26) (Spades i) -> int2alpha $ (cardval c-26) _ -> error ("Can't make " ++ show c ++ "into alpha") --take a letter to int, A=1, Z=26 char2int :: Char -> Int char2int = (64 `subtract`) . (ord) --take a letter to int, 1=A, Z=26 int2alpha :: Int -> Char int2alpha = (chr) . (+64) splitAtMb n l = let p = splitAt n l in if null $ fst p then Nothing else Just p in_fives l = foldr (\x y -> x++" "++y) [] $ unfoldr (splitAtMb 5) (l ++ replicate (5 - length l `mod` 5) 'X') --get an ordered deck newdeck :: Deck newdeck = suit 'c' ++ suit 'd' ++ suit 'h' ++ suit 's' ++ JokerA : JokerB : [] where suit s = case s of 'c' -> [Clubs i | i <- [1..13]] 's' -> [Spades i | i <- [1..13]] 'd' -> [Diamonds i | i <- [1..13]] 'h' -> [Hearts i | i <- [1..13]] --key the deck ready to provide a keystream - move JokerA down one place, --JokerB down 2 places, perform a triplecut then a countcut keydeck :: Deck -> Deck keydeck = countcut. triplecut . (movedown JokerB) . (movedown JokerB) . (movedown JokerA) --bump a card down by one place in a deck, treating the deck as circular so if the card is -- last in the deck it becomes 2nd to front not 1st movedown :: Eq a => a -> [a] -> [a] movedown c d = if c == last d then head d : c : init (tail d) else top ++ bot!!1 : c : (tail (tail bot)) where splt = splitAt (locate c d) d top = fst splt bot = snd splt --substitute the cards above the first joker for those below the 2nd one triplecut :: Deck -> Deck triplecut d = afterLastJoker d ++ center d ++ beforeFirstJoker d where beforeFirstJoker = takeWhile (not . isJoker) afterLastJoker = reverse . beforeFirstJoker . reverse center = reverse . dropWhile (not . isJoker) . reverse . dropWhile (not . isJoker) --get the value of the last card and move that many cards from the top of deck to above the last card countcut :: Deck -> Deck countcut d = init (drop n d) ++ take n d ++ [last d] where n = cardval (last d) --key the deck, read the value of the top card as n, add the nth card to stream, repeat keystream :: Deck -> String keystream d = if isJoker c then keystream d' else card2char c : keystream d' where d' = keydeck d c = d'!!(cardval $ d'!!0) locate :: Eq a => a -> [a] -> Int locate x xs = fromJust (elemIndex x xs) clean :: String -> String clean = map toUpper . filter isAlpha encrypt, decrypt :: String -> String --encrypt a string using an unshuffled deck to start encrypt = process (\x y -> max26 (x+y)) where max26 x = if x > 26 then x-26 else x --decrypt a string using an unshuffled deck to start decrypt = process (\x y -> if x <= y then (x+26)-y else x-y) process :: (Int -> Int -> Int) -> String -> String process f s = in_fives $ map int2alpha $ zipWith f ints1 ints2 where str1 = clean s str2 = take (length str1) (keystream newdeck) ints1 = map char2int str1 ints2 = map char2int str2 -- View this message in context: http://www.nabble.com/Solitaire-cipher-tf2500700.html#a6971077 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.