Google Code Jam/Mousetrap
Problem
Mousetrap is a simple card game for one player. It is played with a shuffled deck of cards numbered 1 through K, face down. You play by revealing the top card of the deck and then putting it on the bottom of the deck, keeping count of how many cards you have revealed. If you reveal a card whose number matches the current count, remove it from the deck and reset the count. If the count ever reaches K+1, you have lost. If the deck runs out of cards, you win.
Suppose you have a deck of 5 cards, in the order 2, 5, 3, 1, 4. You will reveal the 2 on count 1, the 5 on count 2, then the 3 on count 3. Since the value matches the count, you remove the 3 from the deck, and reset the count. You now have 4 cards left in the order 1, 4, 2, 5. You then reveal the 1 on count 1, and remove it as well (you're doing great so far!). Continuing in this way you will remove the 2, then the 4, and then finally the 5 for victory.
You would like to set up a deck of cards in such a way that you will win the game and remove the cards in increasing order. We'll call a deck organized in this way "perfect." For example, with 4 cards you can organize the deck as 1, 4, 2, 3, and you will win by removing the cards in the order 1, 2, 3, 4.
Input
The first line of input gives the number of cases, T. Each test case starts with a line containing K, the number of cards in a deck. The next line starts with an integer n, which is followed by n integers (d1,d2, ...), indices into the deck.
Output
For each test case, output one line containing "Case #x: " followed by n integers (k1,k2, ...), where ki is the value of the card at index di of a perfect deck of size K. The numbers in the output should be separated by spaces, and there must be at least one space following the colon in each "Case #x:" line.
Limits
Small dataset
T = 100, 1 ≤ K ≤ 5000, 1 ≤ n ≤ 100, 1 ≤ di ≤ K.
Large dataset
T = 10, 1 ≤ K ≤ 1000000, 1 ≤ n ≤ 100, 1 ≤ di ≤ K.
Sample
Input
2 5 5 1 2 3 4 5 15 4 3 4 7 10
Output
Case #1: 1 3 2 5 4 Case #2: 2 8 13 4
Solutions
Naive solution
This solution is not fast enough for the large dataset, but suffices widely for the small one.
{-# LANGUAGE ViewPatterns, PatternGuards #-}
import qualified Data.Sequence as S
import Data.Sequence ((|>), (<|), (><), ViewL(..))
import Text.Printf
main = (enumFromTo (1::Int) <$> readLn) >>= mapM_ go
where go i = do
k <- read <$> getLine
(_:ii) <- (map read . words) <$> getLine
printf "Case #%i: %s\n" i (solve k ii)
solve p ii = (unwords . map show . getIndexes ii . maindeck) p
type Deck = (S.Seq Int, Cursor)
type Cursor = Int
card <> (cards,cursor) = pre >< (card <| post)
where (pre, post) = S.splitAt cursor cards
n = S.length cards
maindeck n = deck n n
deck 2 n | odd (n-1) = (S.fromList [n-1, n],0)
| otherwise = (S.fromList [n,n-1],0)
deck n' n | n' == n = (1 <| flipDeck (deck (n-1) n), 0)
deck i n = (card <> deck', newcursor)
where card = (n - i + 1)
deck'@(_, cursor) = deck (i-1) n
newcursor = (cursor + i - ((card - 1) `mod` i)) `mod` i
flipDeck (cards, i) = post >< pre where (pre, post) = S.splitAt i cards
getIndexes ii (seq, pointer) = map (\i -> S.index seq ((i + pointer - 1) `mod` S.length seq )) ii
The beef
This solution is derived from the previous one by removing all the intermediate Sequences. Cryptic, but good enough for the large dataset.
{-# LANGUAGE PatternGuards #-}
import Control.Applicative
import Text.Printf
main = (enumFromTo (1::Int) <$> readLn) >>= mapM_ go
where go i = do
k <- read <$> getLine
(_:ii) <- (map read . words) <$> getLine
printf "Case #%i: %s\n" i (solve k ii)
solve k = unwords . map (show . deck k k) . map pred
-- Deck is the type of functions that given an index, tell you the card placed
-- in that index in a perfect mousetrap card configuration
type Deck = Index -> Card
type Index = Int
type Card = Int
----------------------
-- Working with cards
maindeck k = deck k k
deck n 2 0 | odd (n-1) = n - 1
| otherwise = n
deck n 2 1 | odd (n-1) = n
| otherwise = n - 1
deck n 1 0 = n
deck n n' 0 | n' == n = 1
deck n n' i | n' == n = deck n (n-1) (i - 1)
deck n m i | i == card_in = card
| otherwise = deck n (m-1) (i' - 1)
where card = (n - m + 1)
card_in = rotate (card - 1)
i' = rotate (i - card_in)
rotate = rotateN m
rotateN n i | i < 0 = rotateN n (n + i)
| otherwise = i `mod` n