» Solitaire Cipher in Haskell #

Paul R. Brown @ 2006-10-25

Jim Burton started a thread on haskell-cafe about working the Ruby Quiz problems in Haskell, and I decided to give it a go. I can't say that I'll work them all, but here's my solution to the first problem — implementing Bruce Schneier's Solitaire encryption algorithm. Among other things, a solution provides a quick walk-through of using Haskell's built-in Enum classes and list operations.

Step 1: A Deck of Cards

One of the ingredients for the cipher is a deck of 52 cards, numbered bridge-style from the ace of clubs through the king of spades and then followed by two jokers with suits "A" and "B". I'd like to implement the deck as a 2-tuple of a suit Enum, where the two jokers come from different suits, and a face Enum, like so:

data Suit = Clubs | Diamonds | Hearts | Spades | A | B
            deriving (Enum, Show, Bounded, Eq)

data Face = Ace | Two | Three | Four | Five | Six | Seven 
          | Eight | Nine | Ten | Jack | Queen | King | Joker
            deriving (Enum, Show, Bounded, Eq)

The "deriving" expression is worth some explanation after a 30-second, 30,000-foot look at Haskell's type system. A class in Haskell is a set of assertions of the form "there exists a function f with signature..." and potentially some default definitions, and a type can be an instance of the class if it has functions that meet the assertions. For example, the Eq class is defined:

(==), (/=) :: a -> a -> Boolean

x /= y = not (x == y)
x == y = not (x /= y)

For a given type that would play the role of the a, it's up to the implementer to supply (==) and (/=) functions with the correct signatures. The second and third statements mean that if the implementer only defines one of the two, the other is defined in the standard way. Nonetheless, the precise semantics of the functions — e.g., whether == remotely resembles "equals" or whether x==y implies not(x/=y) — are up to the implementer.

Back to the Suit and Face enumerated type definitions, the deriving tells Haskell that the type is an instance of the listed classes by inheriting default implementations. In simplest terms:

(The links above are to the Zvon Haskell reference.) Haskell supplies these functions by numbering the enumerated elements starting at 0. A quick example with ghci:

*Main> Ace
Ace
*Main> succ Ace
Two
*Main> succ it
Three
*Main> fromEnum Queen
11
*Main> Ace == Two
False

(In ghci, it refers to the last result.)

Now, with a little more effort, we can create a Card type that enumerates the deck as tuples of (Suit,Face), except that we want to supply a custom enumeration, either using dictionary ordering for a normal card or a custom index for the jokers:

data Card = Cd Suit Face
          deriving Eq

As above, this means that Haskell will supply an == for us, and it's important to have, e.g., to use functions like elemIndex:

Eq a => a -> [a] -> Maybe Int

I'll come to the Maybe monoid below, but the Eq a => means that the a in the definition must be an instance of Eq. Next up are a couple of convenience functions to access the components of a Card:

suit :: Card -> Suit
suit (Cd s _) = s

face :: Card -> Face
face (Cd _ f) = f

The Solitaire cipher imposes the bridge dictionary ordering on the deck with the A Joker and B Joker coming after the king of spades in the default order. So, the instance declaration that makes Card into an Enum:

instance Enum Card where
    toEnum 53 = (Cd B Joker)
    toEnum 52 = (Cd A Joker)
    toEnum n = let  d = n `divMod` 13
               in Cd (toEnum (fst d)) (toEnum (snd d))
    fromEnum (Cd B Joker) = 53
    fromEnum (Cd A Joker) = 52
    fromEnum c = 13* fromEnum(suit c) + fromEnum(face c)

Among other things, an instance of Enum makes the arithmetic sequence notation .. can be used to construct ranges, so the whole deck would be:

[(Cd Clubs Ace) .. (Cd B Joker)]

Note that typing this into ghci will result in an error. The type doesn't implement Show, so Haskell doesn't know how to display the elements of the list. This is easy enough to fix up:

show_suit :: Suit -> String
show_suit s = (take 1) (show s)

show_face :: Face -> String
show_face f = (take 1) (drop (fromEnum f) "A23456789TJQK$") 

instance Show Card where
    show c = (show_face (face c)) ++ (show_suit (suit c))

Now we can get a look at our deck:

*Main> [(Cd Clubs Ace) .. (Cd B Joker)]
[AC,2C,3C,4C,5C,6C,7C,8C,9C,TC,JC,QC,KC,
 AD,2D,3D,4D,5D,6D,7D,8D,9D,TD,JD,QD,KD,
 AH,2H,3H,4H,5H,6H,7H,8H,9H,TH,JH,QH,KH,
 AS,2S,3S,4S,5S,6S,7S,8S,9S,TS,JS,QS,KS,
 $A,$B]

(The linebreaks are added.) We're almost done, but the Solitaire cipher assigns different values to the cards than our enumeration does, so we wrap that up in a function:

value :: Card -> Int
value (Cd B Joker) = 53
value c = fromEnum c + 1

Step 2: Implement Shuffling

The Solitaire cipher uses a shuffling algorithm to generate a sequence of letters from the cards in the deck (thus the name for the cipher), and the next step is to implement the shuffling algorithm on top of the Card data type. There are three fundamental operations:

One approach would be to model these three operations as functions:

m :: Card -> [Card] -> [Card]             -- "move down"
t_cut :: Card -> Card -> [Card] -> [Card] -- "triple cut"
c_cut :: [Card] -> [Card]                 -- "count cut"

With these in hand, the shuffle algorithm is:

c_cut ( (t_cut ja jb) ( (m jb) ((m jb) ( (m ja) ( deck )))))

where I'm using ja for (Cd A Joker) and jb for (Cd B Joker).

The whole implementation, complete with some inelegant bits for improvement, is here (or pretty-printed code here) and works:

*Main> encode "Code in Ruby, live longer!"
"GLNCQMJAFFFVOMBJIYCB"
*Main> decode it
"CODEINRUBYLIVELONGER"

Not all of the code is that pretty (I got a little bored toward the end...), so I'll just include a snippets here that demonstrate basic list handling and Maybe.

Maybe is a convenience that sidesteps the null return type problem in other languages. For example, here's a function that splits a String into five-character groups with all non-letters removed, all letters capitalized, and the last group padded:

cleanse :: String -> String
cleanse c = (map toUpper) ((filter isAlpha) c)

pad :: Int -> Char -> String -> String
pad n c s | length s < n = s ++ (replicate (n-length s) c)
pad n c s = s

maybe_split :: String -> Maybe(String,String)
maybe_split [] = Nothing
maybe_split s | w == "" = Just (pad 5 'X' s,w)
              | True = Just (take 5 s, w)
              where w = drop 5 s

quintets :: String -> [String]
quintets s = (unfoldr maybe_split) (cleanse s)

The Nothing value is just that, while Just wraps a real value. (Note that Nothing is outside of the normal value space of the wrapped type, so unlike null, this makes the semantics of "no return value" explicit.) The unfoldr function is a way to generate a list by repeatedly applying a function. It appends the first component of the return value to the list and then applies the function to the second component until the function returns Nothing. The quintets is almost the pretty-print routine discussed in the quiz and in the cipher:

*Main> quintets "That was an interesting exercise."
["THATW","ASANI","NTERE","STING","EXERC","ISEXX"]
*Main> concat (intersperse " " it)
"THATW ASANI NTERE STING EXERC ISEXX"

That said, the pretty-printed version is useless for computing the cipher...

I can think of a few ways to make this more elegant and efficient, and maybe I'll give that a shot later. In the meantime, hopefully it's an entertaining example.


Update. There is now a page on the Haskell wiki devoted to solutions.

 

← 2006-10-18 — More Haskell and Personal Publishing Platform Ramblings
→ 2006-12-17 — Secret Santas in Haskell I: Preliminaries