Skip to content

Instantly share code, notes, and snippets.

@Reconcyl
Created May 3, 2019 18:43
Show Gist options
  • Save Reconcyl/39561b1cb3e94f5044dc7203cf234c35 to your computer and use it in GitHub Desktop.
Save Reconcyl/39561b1cb3e94f5044dc7203cf234c35 to your computer and use it in GitHub Desktop.
Professor at MIT can read minds!
{-# LANGUAGE ViewPatterns #-}
import Data.Ord (Down (..))
import Data.List (sort, sortOn, elemIndex, groupBy)
import Data.Function (on)
-- == -- == == -- == --
-- == -- == UTILITY FUNCTIONS == -- == --
-- == -- == == -- == --
composeN :: (a -> a) -> Int -> (a -> a)
composeN f 0 = id
composeN f n
| even n = g
| otherwise = f . g
where g = g' . g'
g' = composeN f (n `div` 2)
shapeHash :: Ord a => [a] -> [Int]
shapeHash as = [i | s <- as, let Just i = elemIndex s sorted] where sorted = sort as
reshape :: [Int] -> [a] -> [a]
reshape is xs = map (xs !!) is
categorize :: (Eq c, Ord c) => (a -> c) -> [a] -> [[a]]
categorize f = groupBy ((==) `on` f) . sortOn f
perm3 :: Int -> [Int]
perm3 1 = [0, 1, 2]
perm3 2 = [0, 2, 1]
perm3 3 = [1, 0, 2]
perm3 4 = [1, 2, 0]
perm3 5 = [2, 0, 1]
perm3 6 = [2, 1, 0]
perm3' :: [Int] -> Int
perm3' [0, 1, 2] = 1
perm3' [0, 2, 1] = 2
perm3' [1, 0, 2] = 3
perm3' [1, 2, 0] = 4
perm3' [2, 0, 1] = 5
perm3' [2, 1, 0] = 6
-- == -- == == -- == --
-- == -- == MAIN PROGRAM == -- == --
-- == -- == == -- == --
data Rank = RA | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | RJ | RQ | RK deriving (Show, Read, Eq, Enum, Ord)
data Suit = SC | SD | SH | SS deriving (Show, Read, Eq, Ord)
data Card = Card {
rank :: Rank,
suit :: Suit
} deriving (Show, Eq, Ord)
inc :: Rank -> Rank
inc RK = RA
inc s = succ s
add :: Int -> Rank -> Rank
add = composeN inc
addCard :: Int -> Card -> Card
addCard n (Card r s) = Card (add n r) s
showCard :: Card -> String
showCard (Card rank suit) = ts rank ++ ts suit where
ts :: Show a => a -> String
ts = tail.show
readCard :: String -> Card
readCard s = Card (read $ 'R' : init s) (read $ ['S', last s])
distance :: Rank -> Rank -> Int
distance stt end
| stt == end = 0
| otherwise = 1 + distance (inc stt) end
selectCard :: [Card] -> (Card, Int, [Card])
selectCard cards
| dist1 < dist2 = (a, dist1, rest)
| otherwise = (b, dist2, rest)
where
((a:b:maxSuit) : nonMaxSuits) = sortOn (Down . length) $ categorize suit cards
rest = sort . concat $ maxSuit : nonMaxSuits
dist1 = distance (rank a) (rank b)
dist2 = distance (rank b) (rank a)
encode :: [Card] -> [Card]
encode cards = signal : reshape (perm3 diff) rest where
(signal, diff, rest) = selectCard cards
decode :: [Card] -> Card
decode (signal : shaped) = addCard (perm3' . shapeHash $ shaped) signal
printCards :: [Card] -> IO ()
printCards = mapM_ (putStrLn . showCard)
main = do
printCards . pure . decode . map readCard . words =<< getLine
{-# LANGUAGE ViewPatterns #-}
import Data.Ord (Down (..))
import Data.List (sort, sortOn, elemIndex, groupBy)
import Data.Function (on)
-- == -- == == -- == --
-- == -- == UTILITY FUNCTIONS == -- == --
-- == -- == == -- == --
composeN :: (a -> a) -> Int -> (a -> a)
composeN f 0 = id
composeN f n
| even n = g
| otherwise = f . g
where g = g' . g'
g' = composeN f (n `div` 2)
shapeHash :: Ord a => [a] -> [Int]
shapeHash as = [i | s <- as, let Just i = elemIndex s sorted] where sorted = sort as
reshape :: [Int] -> [a] -> [a]
reshape is xs = map (xs !!) is
categorize :: (Eq c, Ord c) => (a -> c) -> [a] -> [[a]]
categorize f = groupBy ((==) `on` f) . sortOn f
perm3 :: Int -> [Int]
perm3 1 = [0, 1, 2]
perm3 2 = [0, 2, 1]
perm3 3 = [1, 0, 2]
perm3 4 = [1, 2, 0]
perm3 5 = [2, 0, 1]
perm3 6 = [2, 1, 0]
perm3' :: [Int] -> Int
perm3' [0, 1, 2] = 1
perm3' [0, 2, 1] = 2
perm3' [1, 0, 2] = 3
perm3' [1, 2, 0] = 4
perm3' [2, 0, 1] = 5
perm3' [2, 1, 0] = 6
-- == -- == == -- == --
-- == -- == MAIN PROGRAM == -- == --
-- == -- == == -- == --
data Rank = RA | R2 | R3 | R4 | R5 | R6 | R7 | R8 | R9 | R10 | RJ | RQ | RK deriving (Show, Read, Eq, Enum, Ord)
data Suit = SC | SD | SH | SS deriving (Show, Read, Eq, Ord)
data Card = Card {
rank :: Rank,
suit :: Suit
} deriving (Show, Eq, Ord)
inc :: Rank -> Rank
inc RK = RA
inc s = succ s
add :: Int -> Rank -> Rank
add = composeN inc
addCard :: Int -> Card -> Card
addCard n (Card r s) = Card (add n r) s
showCard :: Card -> String
showCard (Card rank suit) = ts rank ++ ts suit where
ts :: Show a => a -> String
ts = tail.show
readCard :: String -> Card
readCard s = Card (read $ 'R' : init s) (read $ ['S', last s])
distance :: Rank -> Rank -> Int
distance stt end
| stt == end = 0
| otherwise = 1 + distance (inc stt) end
selectCard :: [Card] -> (Card, Int, [Card])
selectCard cards
| dist1 < dist2 = (a, dist1, rest)
| otherwise = (b, dist2, rest)
where
((a:b:maxSuit) : nonMaxSuits) = sortOn (Down . length) $ categorize suit cards
rest = sort . concat $ maxSuit : nonMaxSuits
dist1 = distance (rank a) (rank b)
dist2 = distance (rank b) (rank a)
encode :: [Card] -> [Card]
encode cards = signal : reshape (perm3 diff) rest where
(signal, diff, rest) = selectCard cards
decode :: [Card] -> Card
decode (signal : shaped) = addCard (perm3' . shapeHash $ shaped) signal
printCards :: [Card] -> IO ()
printCards = mapM_ (putStrLn . showCard)
main = do
printCards . encode . map readCard . words =<< getLine
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment