Haskell Quiz/The Solitaire Cipher/Solution Paul
Jump to navigation
Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.
-- 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
to_number c = fromEnum c - fromEnum 'A' + 1
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
show_suit = head . show
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
fromEnum c = 13* fromEnum(suit c) + fromEnum(face c)
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