# Haskell Quiz/The Solitaire Cipher/Solution Paul

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)

```-- Solution to Ruby Quiz problem #1
-- Paul Brown (paulrbrown@gmail.com)
-- http://mult.ifario.us/

import Char
import List
import Maybe

to_number :: Char  -> Int

from_number :: Int -> Char
from_number n = toEnum (n - 1 + fromEnum 'A')

to_numbers :: String -> [Int]
to_numbers = map to_number

cleanse :: String -> String
cleanse = map toUpper . filter isAlpha

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

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

quintets :: String -> [String]
quintets = unfoldr maybe_split

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

show_suit :: Suit -> String

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

show_face :: Face -> String
show_face f = ["A23456789TJQK\$" !! fromEnum f]

data Card = Cd {suit :: Suit, face :: Face}
deriving Eq

instance Enum Card where
toEnum 53 = Cd B Joker
toEnum 52 = Cd A Joker
toEnum n = let (q,r) = n `divMod` 13
in Cd (toEnum q) (toEnum r)
fromEnum (Cd B Joker) = 53
fromEnum (Cd A Joker) = 52

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

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

split_on_elem :: Eq a => a -> [a] -> ([a],[a])
split_on_elem x l | x == head l = ([],tail l)
split_on_elem x l | x == last l = (init l, [])
split_on_elem x l | otherwise = case elemIndex x l of
Nothing -> error "Can't split a list on an element that isn't present."
Just y  -> (take y l, drop (y+1) l)

swap_down :: Card -> [Card] -> [Card]
swap_down x deck | null xs = head ys:x:tail ys
| null ys = head xs:x:tail xs
| otherwise = xs ++ (head ys:x:tail ys)
where (xs,ys) = split_on_elem x deck

move_a :: [Card] -> [Card]
move_a deck = swap_down (Cd A Joker) deck

move_b :: [Card] -> [Card]
move_b deck = swap_down (Cd B Joker) (swap_down (Cd B Joker) deck)

from_m_to_n :: Int -> Int -> [a] -> [a]
from_m_to_n m n l | m < n = take (n-m-1) (drop (m+1) l)
| n < m = take (m-n-1) (drop (n+1) l)

triple_cut :: Card -> Card -> [Card] -> [Card]
triple_cut x y deck | slot_x < slot_y = y2 ++ (x:(from_m_to_n slot_x slot_y deck)) ++ (y:x1)
| slot_x > slot_y = x2 ++ (y:(from_m_to_n slot_y slot_x deck)) ++ (x:y1)
where Just slot_x = elemIndex x deck
Just slot_y = elemIndex y deck
(x1,x2) = split_on_elem x deck
(y1,y2) = split_on_elem y deck

triple_cut_a_b :: [Card] -> [Card]
triple_cut_a_b deck = triple_cut (Cd A Joker) (Cd B Joker) deck

count_cut :: [Card] -> [Card]
count_cut deck = drop (val-1) deck ++ take val deck ++ [bottom_card]
where bottom_card = last deck
val = value (bottom_card)

evaluate :: [Card] -> Int
evaluate deck = value (deck !! value (head deck))

compute :: [Card] -> (Int,[Card])
compute deck | val == 53 = compute x
| otherwise = (val `mod` 26, x)
where x = count_cut \$ triple_cut_a_b \$ move_b \$ move_a \$ deck
val = evaluate x

encode :: String -> String
encode s = encode_ (concat (quintets (cleanse s))) [(Cd Clubs Ace) .. (Cd B Joker)]

encode_ :: String -> [Card] -> String
encode_ [] _ = []
encode_ (s:ss) deck = let (a,b) = compute deck
in from_number(wrap_zero ((a + to_number s) `mod` 26)):encode_ ss b

decode :: String -> String
decode s = decode_ s [(Cd Clubs Ace) .. (Cd B Joker)]

decode_ :: String -> [Card] -> String
decode_ [] _ = []
decode_ (s:ss) deck = let (a,b) = compute deck
in from_number(wrap_zero ((26 + to_number s - a) `mod` 26)):decode_ ss b

wrap_zero :: Int -> Int
wrap_zero 0 = 26
wrap_zero x = x
```