
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.

There are several problems with the behavior:
*Main> encrypt "" "XXXXX " *Main> decrypt $ encrypt "" "TANZP XXXXX "
So fixing this case would be the first thing to do, followed by:
*Main> encrypt "hello" "LBVJW XXXXX " *Main> decrypt $ encrypt "hello" "HELLO YFRTQ XXXXX "

Chris Kuklewicz wrote:
There are several problems with the behavior:
*Main> encrypt "" "XXXXX " *Main> decrypt $ encrypt "" "TANZP XXXXX "
So fixing this case would be the first thing to do, followed by:
*Main> encrypt "hello" "LBVJW XXXXX " *Main> decrypt $ encrypt "hello" "HELLO YFRTQ XXXXX "
Thanks a lot, I think these are all related...some changes in_fives l = trim $ foldr (\x y -> x++" "++y) [] $ unfoldr (splitAtMb 5) (l ++ replicate n 'X') where n = if m5 == 0 then 0 else 5 - m5 m5 = length l `mod` 5 trim :: String -> String trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace process :: (Int -> Int -> Int) -> String -> String process f s = if null str1 then "" else in_fives $ map int2alpha $ zipWith f ints1 ints2 where str1 = trim $ clean s str2 = take (length str1) (keystream newdeck) ints1 = map char2int str1 ints2 = map char2int str2 *Main> decrypt $ encrypt $ decrypt $ encrypt "hello" "HELLO" *Main> decrypt $ encrypt $ decrypt $ encrypt "haskell is miles better" "HASKE LLISM ILESB ETTER" *Main> -- View this message in context: http://www.nabble.com/Solitaire-cipher-tf2500700.html#a6971503 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

jim burton
data Card = Clubs Int | Spades Int | Diamonds Int | Hearts Int | JokerA | JokerB
They aren't really Ints; better to define something like
data FaceValue = Ace | F2 | F3 | F4 | F5 | F6 | F7 | F8 | F9 | F10 | Jack | Queen | King
and possibly derive Enum (which unfortunately would give the the "wrong" values, but that can be got around).
deriving (Show, Eq) type Deck = [Card] --cardval - clubs are face value, diamonds plus 13, and so on - Jokers are both 53
I'd be inclined to define an Enum instance rather than cardval directly, but define cardval as an auxilliary function that scrunches both jokers to the same value.
isJoker :: Card -> Bool isJoker JokerA = True isJoker JokerB = True isJoker _ = False
Since you've defined an instance of Eq, you can use
isJoker c = c == JokerA || c == JokerB
--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?
It's defined to, but you don't need a case clause as you can use cardval and mod.
--take a letter to int, A=1, Z=26 char2int :: Char -> Int char2int = (64 `subtract`) . (ord)
Better to use (ord 'A' - 1) if you are going to do it this way.
--take a letter to int, 1=A, Z=26 int2alpha :: Int -> Char int2alpha = (chr) . (+64)
and again
splitAtMb n l = let p = splitAt n l in if null $ fst p then Nothing else Just p
That was my mistake! Use the shorter, cleaner version I posted after that one.
in_fives l = foldr (\x y -> x++" "++y) [] $ unfoldr (splitAtMb 5) (l ++ replicate (5 - length l `mod` 5) 'X')
Putting the spaces in at this point is a mistake! Also see what I said about length.
--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]]
That seems overly complicated. With an Enum instance, you'd just do
newdeck = [Club Ace .. JokerB]
or better, with an instance of Bounded too,
newdeck = [minBound .. maxBound]
Of course, you'd have to write toEnum to do the work, but I'd do it something like
toEnum 54 = JokerB toEnum 53 = JokerA toEnum n = [Club, Diamond, Heart, Spade]!!suit $ (toEnum (val+1)) where (suit, val) = (n-1) `divMod` 13
Comments from now on are a bit less thought through... I think there are better ways to do some of these operations, but I'm not going to present them, just nitpick a bit instead.
--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
that looks like an unnecessary pass over the list
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
you can write
where (top,bot) = splitAt ... But how about List.break?
And if you know that bot is going to have enough elements
where (top, card1:card2:rest) = break ...
-- Jón Fairbairn Jon.Fairbairn@cl.cam.ac.uk

Jón Fairbairn-2 wrote:
jim burton
writes: In addition to Chris's comments, here are some more: [snip]
Thanks for your comments Jon. I thought about making Cards an instance of Enum but didn't realise how helpful it would be in various places. I will use the shorter version of your function - I need to get a chance to think about how it works first to be honest. Haven't noticed divMod before - handy! -- View this message in context: http://www.nabble.com/Solitaire-cipher-tf2500700.html#a6979284 Sent from the Haskell - Haskell-Cafe mailing list archive at Nabble.com.

I brute-forced my way through a solution to the Solitaire cipher quiz challenge last night: http://mult.ifario.us/articles/2006/10/25/solitaire-cipher-in-haskell Full source is linked from the entry, or look here: http://mult.ifario.us/files/solitaire.hs I think (i.e., know) that my list-based implementation of the shuffling is somewhat inelegant, and I can imagine one that uses a monad to encapsulate the state of the deck. Nonetheless, I think I'm happy with the data structure for the deck. Comments / criticism welcome. --- Paul R Brown paulrbrown@gmail.com http://mult.ifario.us/

Paul, other Haskell Cafe guests,
About
http://mult.ifario.us/articles/2006/10/25/solitaire-cipher-in-haskell:
Remove the ']' from the line:
show_face f = (take 1) (drop (fromEnum f) "A23456789TJQK$")]
An easier way to write this:
show_face f = "A23456789TJQK$" !! fromEnum f
Other improvements:
from_number n = (toEnum (n - 1 + fromEnum 'A'))
->
from_number n = ['A'..] !! (n - 1)
show_suit s = (take 1) (show s)
->
show_suit s = head (show s)
or:
show_suit (s:_) = show s
show c = (show_face (face c)) ++ (show_suit (suit c))
->
show (Cd s f) = show_face f ++ show_suit s
or:
show (Cd s f) = show f ++ " of " ++ show s
head (reverse l)
->
init l
drop 1 l
->
tail l
decode_ (s:ss) deck = let c = compute(deck)
in (from_number(wrap_zero ((26 + (to_number s) -
fst c) `mod` 26))):(decode_ ss (snd c))
->
decode_ (s:ss) deck = let (a, b) = compute(deck)
in (from_number(wrap_zero ((26 + (to_number s) -
a) `mod` 26))):(decode_ ss b)
quintets :: String -> [String]
quintets s = quintets' (s ++ "XXXX")
where
quintets' (a : b : c : d : e: s') = [a, b, c, d, e] : quintets' s'
quintets' _ = []
Met vriendelijke groet (best regards),
Henk-Jan van Tuyl
On Thu, 26 Oct 2006 08:43:13 +0200, Paul Brown
I brute-forced my way through a solution to the Solitaire cipher quiz challenge last night:
http://mult.ifario.us/articles/2006/10/25/solitaire-cipher-in-haskell
Full source is linked from the entry, or look here:
http://mult.ifario.us/files/solitaire.hs
I think (i.e., know) that my list-based implementation of the shuffling is somewhat inelegant, and I can imagine one that uses a monad to encapsulate the state of the deck. Nonetheless, I think I'm happy with the data structure for the deck.
Comments / criticism welcome.
--- Paul R Brown paulrbrown@gmail.com http://mult.ifario.us/ _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe
-- -- http://Van.Tuyl.eu/ -- Using Opera's revolutionary e-mail client: https://secure.bmtmicro.com/opera/buy-opera.html?AID=789433

I was to fast: On Thu, 26 Oct 2006 22:29:56 +0200, I wrote:
-> show_suit s = head (show s) or: show_suit (s:_) = show s The last one is nonsense
head (reverse l) -> init l Should be: last l
-- Met vriendelijke groet, Henk-Jan van Tuyl -- http://Van.Tuyl.eu/ -- Using Opera's revolutionary e-mail client: https://secure.bmtmicro.com/opera/buy-opera.html?AID=789433
participants (5)
-
Chris Kuklewicz
-
Henk-Jan van Tuyl
-
jim burton
-
Jón Fairbairn
-
Paul Brown