Google Code Jam 2010: Qualification Round のメモ．

解いた．とりあえず，問題文に骨が折れる． メモ，メモ．

A

そのまま．

import Control.Monad
import Text.Printf


light :: (Integral a, Integral b) => b -> a -> String
light n k | mod (k+1) (2^n) == 0 = "ON"
          | otherwise            = "OFF"

main :: IO ()
main = do (t:_)  do
            (n:k:_)  IO [a]
getList = liftM (map read.words) getLine

B

そのままだったと思う．

import Control.Monad
import Text.Printf

multiple :: (Integral a) => [a] -> a
multiple (t:ts) = foldl1 gcd.filter (0/=).zipWith (-) (t:ts) $ ts++[t]

main :: IO ()
main = do (t:_)  do
            (n:ts)  IO [a]
getList = liftM (map read.words) getLine

C

循環を見つけるコードが肥大化している．なんかダメだよね，このコード．

import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad
import Text.Printf

-- number of groups
g :: (Ord a, Num a) => a -> [a] -> Int
g k gs = length.takeWhile (<=k).scanl1 (+) $ gs

roll :: (Enum b, Num b, Num a, Ord a) => a -> [a] -> [(a, b)]
roll k _gs = ((0,0):) $ unfoldr (Just .f) gs
    where gs = zip _gs [0..]
          f xs = let n = g k.map fst $ xs
                     (as, bs) = splitAt n xs
                     ys = bs ++ as
                 in ((sum.map fst $ as, snd.head $ ys), ys)

period :: (Num t, Ord t) => [t] -> (Int, Int)
period xs = let (ps, qs) = part Set.empty [] xs
            in (length ps - 1, length qs)
    where part s ys (z:zs) | Set.member z s = (reverse $ ys, z:takeWhile (z/=) zs)
                           | otherwise      = part (Set.insert z s) (z:ys) zs

count :: (Num a, Ord a) => Int -> a -> [a] -> a
count r k gs | r < p     = sum $ take r ys
             | otherwise = sum ys + fromIntegral a * sum zs + sum (take b zs)
    where xs = roll k gs
          (p, q) = period.map snd $ xs
          (ys, zs) = splitAt p.take (p+q).tail$ map fst xs
          (a, b) = divMod (r-p) q

main :: IO ()
main = do (t:_)  do
            (r:k:_)  IO [a]
getList = liftM (map read.words) getLine