Google Code Jam 2011 決勝 A, B やってみた。

http://code.google.com/codejam/japan/contests.html

時間がとれたので、やってみた。どちらも、large通ったけど、解説読んでないから、完全に正しい保証はない(多分あってると思うけど、例外処理とか

A

予想をつけて、小さい問題サイズで正しいことを確認。直観的ではある。

import Control.Monad
import Text.Printf
import Data.List

f :: Num a => [a] -> a
f xs = sum $ zipWith (*) xs (tail xs)

g :: [a] -> [a] -> [a] -> ([a], [a])
g ls rs [] = (ls,rs)
g ls rs [x] = (x:ls,rs)
g ls rs (x:y:zs) = g (x:ls) (y:rs) zs

h :: [Integer] -> Double
h xs = (c*).fromIntegral $ f (x: reverse ls) + f (x: reverse rs) + (head ls) * (head rs)
    where (x:xs') = reverse.sort $ xs
          (ls,rs) = g [] [] xs'
          c = (/2).sin $ 2 * pi / (fromIntegral $ length xs)

-- output and input function
main :: IO ()
main = do [t] <- getList :: IO [Int]
          forM_ [1..t] $ \i -> do
            _ <- getLine
            xs <- getList :: IO [Integer]
            printf "Case #%d: %f\n" i $ h xs

getList :: Read a => IO [a]
getList = liftM (map read.words) getLine

B

Project Eulerで似たような問題をやったことがあったので、それを思い出しながら。

配列使うのが面倒だったので、メモ化再帰。だから少し遅い。毎回素因数分解してるし。

import Control.Monad
import Text.Printf
import Data.List
import ONeillPrimes (primes)
import Data.MemoTrie

-- a^n (mod p)
powMod :: (Integral a, Integral b) => a -> b -> a -> a
powMod a n p | n == 0 = 1
             | even n = powMod (mod (a*a) p) (div n 2) p
             | otherwise = (a * powMod a (n-1) p)`mod` p

factors :: Integer -> [(Integer, Int)]
factors n = map (\xs -> (head xs, length xs)).group $ f n primes
    where f _ [] = []
          f m (p:ps) | p*p > m = [m]
                     | m `mod` p == 0 = p:f(div m p) (p:ps)
                     | otherwise = f m ps

totient :: Integer -> Integer
totient n = product [(p-1) * p ^ (k-1) | (p, k) <- factors n]

f, memoF :: Integer -> Integer -> Integer -> Integer
f x 0 m = x `mod` m
f x _ 1 = 0
f x _ 2 | odd x  = 1
        | even x = 0
f x n m | mod x m == 0 = 0
f x n m | x < s     = f (x^x) (n-1) m 
        | c == 1    = 0
        | otherwise =  (`mod` m) $ (a ^ s * (powMod a (mod (b-s) m') c))
    where a = memoF x (n-1) m
          b = memoF x (n-1) m'
          c = g x m
          m' = totient c
          s = h x (m `div` c)
memoF = memo3 f

g, h :: Integer -> Integer -> Integer
g x m = product [p ^ k | (p, k) <- factors m, mod x p /= 0]
h x c = toInteger.succ.length.takeWhile (\y -> y `mod` c /= 0) $ iterate (*x) x

-- output and input function
main :: IO ()
main = do [t] <- getList :: IO [Int]
          forM_ [1..t] $ \i -> do
            (x:n:m:_) <- getList :: IO [Integer]
            printf "Case #%d: %d\n" i $ memoF x n m

getList :: Read a => IO [a]
getList = liftM (map read.words) getLine