# Haskell Quiz/The Solitaire Cipher/Solution Paul

### From HaskellWiki

< Haskell Quiz | The Solitaire Cipher(Difference between revisions)

Paulrbrown (Talk | contribs) |
m |
||

(2 intermediate revisions by 2 users not shown) | |||

Line 1: | Line 1: | ||

+ | [[Category:Haskell Quiz solutions|Solitaire Cipher]] | ||

+ | |||

+ | <haskell> | ||

-- Solution to Ruby Quiz problem #1 | -- Solution to Ruby Quiz problem #1 | ||

-- Paul Brown (paulrbrown@gmail.com) | -- Paul Brown (paulrbrown@gmail.com) | ||

Line 8: | Line 11: | ||

to_number :: Char -> Int | to_number :: Char -> Int | ||

− | to_number c = | + | to_number c = fromEnum c - fromEnum 'A' + 1 |

from_number :: Int -> Char | from_number :: Int -> Char | ||

− | from_number n = | + | from_number n = toEnum (n - 1 + fromEnum 'A') |

to_numbers :: String -> [Int] | to_numbers :: String -> [Int] | ||

− | to_numbers | + | to_numbers = map to_number |

cleanse :: String -> String | cleanse :: String -> String | ||

− | cleanse | + | cleanse = map toUpper . filter isAlpha |

pad :: Int -> Char -> String -> String | pad :: Int -> Char -> String -> String | ||

− | pad n c s | length s < n = s ++ | + | pad n c s | length s < n = s ++ replicate (n-length s) c |

− | pad n c s = s | + | pad n c s | otherwise = s |

maybe_split :: String -> Maybe(String,String) | maybe_split :: String -> Maybe(String,String) | ||

maybe_split [] = Nothing | maybe_split [] = Nothing | ||

maybe_split s | w == "" = Just (pad 5 'X' s,w) | maybe_split s | w == "" = Just (pad 5 'X' s,w) | ||

− | | | + | | otherwise = Just (take 5 s, w) |

where w = drop 5 s | where w = drop 5 s | ||

quintets :: String -> [String] | quintets :: String -> [String] | ||

− | quintets | + | quintets = unfoldr maybe_split |

data Suit = Clubs | Diamonds | Hearts | Spades | A | B | data Suit = Clubs | Diamonds | Hearts | Spades | A | B | ||

Line 36: | Line 39: | ||

show_suit :: Suit -> String | show_suit :: Suit -> String | ||

− | show_suit | + | show_suit = head . show |

data Face = Ace | Two | Three | Four | Five | Six | Seven | data Face = Ace | Two | Three | Four | Five | Six | Seven | ||

Line 43: | Line 46: | ||

show_face :: Face -> String | show_face :: Face -> String | ||

− | show_face f = [ | + | show_face f = ["A23456789TJQK$" !! fromEnum f] |

− | data Card = Cd Suit Face | + | data Card = Cd {suit :: Suit, face :: Face} |

deriving Eq | deriving Eq | ||

− | |||

− | |||

− | |||

− | |||

− | |||

− | |||

instance Enum Card where | instance Enum Card where | ||

− | toEnum 53 = | + | toEnum 53 = Cd B Joker |

− | toEnum 52 = | + | toEnum 52 = Cd A Joker |

− | toEnum n = let | + | toEnum n = let (q,r) = n `divMod` 13 |

− | in Cd (toEnum | + | in Cd (toEnum q) (toEnum r) |

fromEnum (Cd B Joker) = 53 | fromEnum (Cd B Joker) = 53 | ||

fromEnum (Cd A Joker) = 52 | fromEnum (Cd A Joker) = 52 | ||

Line 64: | Line 61: | ||

instance Show Card where | instance Show Card where | ||

− | show c = | + | show c = show_face (face c) ++ show_suit (suit c) |

value :: Card -> Int | value :: Card -> Int | ||

value (Cd B Joker) = 53 | value (Cd B Joker) = 53 | ||

value c = fromEnum c + 1 | value c = fromEnum c + 1 | ||

− | |||

− | |||

− | |||

split_on_elem :: Eq a => a -> [a] -> ([a],[a]) | split_on_elem :: Eq a => a -> [a] -> ([a],[a]) | ||

− | split_on_elem x l | x == head l = ([], | + | split_on_elem x l | x == head l = ([],tail l) |

− | split_on_elem x l | x == | + | split_on_elem x l | x == last l = (init l, []) |

− | split_on_elem x l | elemIndex x 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 :: Card -> [Card] -> [Card] | ||

− | swap_down x deck | | + | 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 | + | where (xs,ys) = split_on_elem x deck |

move_a :: [Card] -> [Card] | move_a :: [Card] -> [Card] | ||

Line 97: | Line 91: | ||

triple_cut :: Card -> Card -> [Card] -> [Card] | triple_cut :: Card -> Card -> [Card] -> [Card] | ||

− | triple_cut x y deck | slot_x < slot_y = | + | 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 = | + | | slot_x > slot_y = x2 ++ (y:(from_m_to_n slot_y slot_x deck)) ++ (x:y1) |

− | where slot_x = | + | where Just slot_x = elemIndex x deck |

− | slot_y = | + | 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 :: [Card] -> [Card] | ||

Line 108: | Line 102: | ||

count_cut :: [Card] -> [Card] | count_cut :: [Card] -> [Card] | ||

− | count_cut deck = ( | + | count_cut deck = drop (val-1) deck ++ take val deck ++ [bottom_card] |

− | where bottom_card = | + | where bottom_card = last deck |

val = value (bottom_card) | val = value (bottom_card) | ||

evaluate :: [Card] -> Int | evaluate :: [Card] -> Int | ||

− | evaluate deck = value ( | + | evaluate deck = value (deck !! value (head deck)) |

compute :: [Card] -> (Int,[Card]) | compute :: [Card] -> (Int,[Card]) | ||

− | compute deck | val == 53 = compute | + | compute deck | val == 53 = compute x |

− | | | + | | otherwise = (val `mod` 26, x) |

− | where x = count_cut | + | where x = count_cut $ triple_cut_a_b $ move_b $ move_a $ deck |

val = evaluate x | val = evaluate x | ||

Line 126: | Line 120: | ||

encode_ :: String -> [Card] -> String | encode_ :: String -> [Card] -> String | ||

encode_ [] _ = [] | encode_ [] _ = [] | ||

− | encode_ (s:ss) deck = let | + | encode_ (s:ss) deck = let (a,b) = compute deck |

− | in | + | in from_number(wrap_zero ((a + to_number s) `mod` 26)):encode_ ss b |

decode :: String -> String | decode :: String -> String | ||

Line 134: | Line 128: | ||

decode_ :: String -> [Card] -> String | decode_ :: String -> [Card] -> String | ||

decode_ [] _ = [] | decode_ [] _ = [] | ||

− | decode_ (s:ss) deck = let | + | decode_ (s:ss) deck = let (a,b) = compute deck |

− | in | + | in from_number(wrap_zero ((26 + to_number s - a) `mod` 26)):decode_ ss b |

wrap_zero :: Int -> Int | wrap_zero :: Int -> Int | ||

wrap_zero 0 = 26 | wrap_zero 0 = 26 | ||

wrap_zero x = x | wrap_zero x = x | ||

+ | </haskell> |

## Latest revision as of 19:33, 21 February 2010

-- 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