モビール

http://www.ioi-jp.org/joi/2006/2007-ho-prob_and_sol/2007-ho.pdf から。工夫した点は特にありません。

-- 
-- http://www.ioi-jp.org/joi/2006/2007-ho-prob_and_sol/2007-ho.pdf
-- problem 5-3
--
import Text.ParserCombinators.Parsec
import Data.List (delete)
import System

input :: GenParser Char [Int] ([[Int]], Int)
input = do n <- many1 digit >>= return . read
           setState [1..n]
           sticks  <- count n stick
           [start] <- getState
           return (sticks,start)
stick = do distance <- count 2 (spaces >> many1 digit)
                         >>= return . (map read)
           ln <- spaces >> many1 digit >>= return . read
           rn <- spaces >> many1 digit >>= return . read
           updateState (delete ln) >> updateState (delete rn)
           return $ distance++[ln,rn]

data Mobile = S Int Int Mobile Mobile | W deriving Show
makeMobile :: [[Int]] -> Int -> Mobile
makeMobile sticks start = makeMobile' start
    where makeMobile' 0 = W
          makeMobile' n =
              case sticks!!(n-1) of
                [ld,rd,lw,rw] -> S ld rd (makeMobile' lw) (makeMobile' rw)
calcMobile :: Mobile -> [Int]
calcMobile W = [1..]
calcMobile (S ld rd lm rm) =
    let lws   = calcMobile lm
        rws   = calcMobile rm
        (a,b) = lcmWith lws rws (*ld) (*rd)
    in  [a+b, 2*(a+b)..]
lcmWith a b l r = lcmWith' a b
    where lcmWith' (a:aa) (b:bb) | l a == r b = (a,b)
                                 | l a <  r b = lcmWith' aa (b:bb)
                                 | otherwise  = lcmWith' (a:aa) bb

main = do paths <- getArgs
          mapM (?p -> readFile p >>= print.solve) paths
solve file = case runParser input [] "" file of
              Right (sticks,start) ->
                  head $ calcMobile $ makeMobile sticks start
              Left _  -> -1