Difference between revisions of "Haskell Quiz/The Solitaire Cipher/Solution Paul"
From HaskellWiki
(sharpen cat) 
m 

Line 11:  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 (nlength 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 39:  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 46:  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 

−  
−  suit :: Card > Suit 

−  suit (Cd s _) = s 

−  
−  face :: Card > Face 

−  face (Cd _ f) = f 

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

−  
−  drop_tail :: [a] > [a] 

−  drop_tail l = reverse (drop 1 (reverse l)) 

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  
+  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 100:  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 111:  Line 102:  
count_cut :: [Card] > [Card] 
count_cut :: [Card] > [Card] 

−  count_cut deck = 
+  count_cut deck = drop (val1) 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 129:  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 137:  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 
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 (nlength 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 (nm1) (drop (m+1) l)
 n < m = take (mn1) (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 (val1) 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