main=interact$p.minimum.t(words "An Ch Cl Tr Dr Sn He")[][][].i.tail.lines
i x=(map(map(take 2).words)$init x,map read.words$last x)
t(a:b)x y z r=concat [t b(a:x)y z r,t b x(a:y)z r,t b x y(a:z)r]
t[]x y z(l,b)|any null w=[]|1>0=[(maximum d-minimum d,-sum e)]
 where
 (d,e)=unzip (zipWith f b w)
 w=[x, y, z]
 f b i=(b`div`length i,length$filter(\[g,_,h]->elem g i&&elem h i)l)
p(a,b)=show a++" "++show(-b)

import Data.Array
import Data.Maybe
import Data.List
import Control.Applicative
import Control.Monad

findId name = fromJust $ elemIndex name names
  where
    names = ["Anka", "Chapay", "Cleo", "Troll", "Dracul", "Snowy", "Hexadecimal"]

parseLine line = (findId (ws !! 0), findId (ws !! 2))
  where
    ws = words line

solve :: Array (Int,Int) Bool -> [Int] -> (Int, Int)
solve arr exp = minimum $ map score seps
  where
    r = [0..6]
    seps :: [[[Int]]]
    seps = [ [x \\ y, y, r \\ x]
           | x <- subsequences r
           , x /= r && x /= []
           , y <- subsequences x
           , y /= x && y /= []
           ]
    score sep = (maximum scores - minimum scores, negate . sum $ map likes sep)
      where
        scores = zipWith div exp $ map length sep
    likes grp = length [True | a <- grp , b <- grp, arr ! (a, b)]

main = do
    n <- read <$> getLine :: IO Int
    likes <- replicateM n (parseLine <$> getLine)
    let arr = accumArray (||) False ((0,0),(6,6)) $ map (\x -> (x,True)) likes
    exp <- map read . words <$> getLine :: IO [Int]
    let (minv, maxv) =  solve arr exp
    putStrLn $ show minv ++ " " ++ show (negate maxv)

import Data.Char

import Control.Monad
import Data.Int(Int64)
import Data.List
import Data.Maybe
import Control.Applicative

readInts :: IO [Int]
readInts = map read . words <$> getLine

unsafeReadInt :: String -> Int
unsafeReadInt = read
readLiking = do
    [a,_,b] <- words <$> getLine
    return (read a, read b)

data Boss = A | B | C deriving (Eq, Show)
data Hero = Anka | Chapay | Cleo | Troll | Dracul | Snowy | Hexadecimal deriving (Read, Eq)

allHeroes = [Anka, Chapay, Cleo, Troll, Dracul, Snowy, Hexadecimal]

assignments :: Int -> [[Boss]]
assignments 0 = [[]]
assignments i = let next = assignments (i-1) in (map (A :) next) ++ (map (B :) next) ++ (map (C :) next)

allAssignments = assignments 7

likes likings i j = any (\(a, b) -> a == (allHeroes !! i) && b == (allHeroes !! j)) likings

liking likings assignment = length [() | p <- [0..6], q <- [0..6], likes likings p q, assignment !! p == assignment !! q]

expFrom :: Boss -> Int -> [Boss] -> Int
expFrom boss totalExp assignment = totalExp `div` length (filter (==boss) assignment)

maxDiff :: [Int] -> Int
maxDiff l = maximum l - minimum l

expdiff (a,b,c) assignment = maxDiff [
            expFrom A a assignment ,
            expFrom B b assignment ,
            expFrom C c assignment ]

allBossesDead assignment = any (==A) assignment && any (==B) assignment && any (==C) assignment

main = do
    [n] <- readInts
    likings <- sequence $ replicate n readLiking
    [a,b,c] <- readInts
    let exps = (a,b,c)
    let cmp a1 a2 = let md1 = expdiff exps a1
                        md2 = expdiff exps a2
                    in if md1 < md2 then LT else if md1 > md2 then GT else
                        compare (liking likings a2) (liking likings a1)
    let bestAssignment = minimumBy cmp (filter allBossesDead allAssignments)
    putStrLn (unwords [show (expdiff exps bestAssignment), show (liking likings bestAssignment)])


parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

solveSingle :: IO()
solveSingle = do
    arr <- readIntArr
    let x = arr !! 0
    let y = arr !! 1
    if (x == 0 && y == 0)
        then
            print(0)
        else if (isqrt(x * x + y * y) * isqrt(x * x + y * y) == x * x + y * y)
            then print(1)
            else print(2)

solve :: Int -> IO ()
solve n = if (n == 0)
    then
        pure()
    else do
        solveSingle
        solve(n - 1)

main :: IO ()
main = do
    n <- readInt
    solve $ n

parseInt :: String -> Int
parseInt number = (read number) :: Int

readInt :: IO Int
readInt = do
    number <- getLine
    pure $ parseInt number

readIntArr :: IO [Int]
readIntArr = do
    numbers <- getLine
    pure $ map parseInt $ words numbers

isqrt :: Int -> Int
isqrt = floor . sqrt . fromIntegral

solve :: IO()
solve = do
    (x: y: _) <- readIntArr
    if (x == 0 && y == 0)
        then print 0
        else let s = isqrt (x * x + y * y)
            in if (s * s == x * x + y * y)
                then print 1
                else print 2

for :: Int -> IO () -> IO ()
for 0 _ = pure ()
for i f = do
    f
    for (i - 1) f

main :: IO ()
main = do
    t <- readInt
    for t solve


import Control.Monad

type Sector = (Integer, Integer)

main = do
    [n, m, tests] <- readNums
    let common = gcd n m
        realN = n `div` common
        realM = m `div` common

    results <- replicateM (fromInteger tests) $ (solve realN realM)
    putStr . unlines $ results

readNums :: IO [Integer]
readNums = map (\tok -> read tok :: Integer) . words <$> getLine

solve :: Integer -> Integer -> IO String
solve n m = do
    [x1, y1, x2, y2] <- readNums
    let source = (x1, y1)
        dest = (x2, y2)
    return (if canReach source dest (n, m) then "YES" else "NO")

canReach :: Sector -> Sector -> (Integer, Integer) -> Bool
canReach source dest (n, m) =
    let indexSource = index source (n, m)
        indexDest = index dest (n, m)
    in indexSource == indexDest

index :: Sector -> (Integer, Integer) -> Integer
index (x, y) (n, m) = (y - 1) `div` (if x == 1 then n else m)

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[ n, m, q ] <- readIntegers
	let
		units = lcm n m
		width = units `div` gcd n m
-- 	print units
-- 	print width
-- 	putStrLn "=========="
	replicateM ( fromIntegral q ) $ do
		[ sx, sy', ex, ey' ] <- readIntegers
		let
			sy = pred sy'
			ey = pred ey'
			u1 = units `div` ( which n m $ sx == 1 ) * sy `div` width
			u2 = units `div` ( which n m $ ex == 1 ) * ey `div` width
-- 		print u1
-- 		print u2
		putStrLn $ which "YES" "NO" $ u1 == u2

import Control.Monad

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Int]
getInts = fmap (fst . fromJust . C.readInt) . C.words <$> C.getLine

getInteger :: IO Integer
getInteger = read <$> getLine

getIntegers :: IO [Integer]
getIntegers = fmap (fst . fromJust . C.readInteger) . C.words <$> C.getLine

--
-- MAIN
--

main :: IO ()
main = do
  [n,m,q] <- getIntegers
  let d = gcd n m
      rn = n `div` d
      rm = m `div` d
  replicateM_ (fromIntegral q) $ do
    [sx,sy,ex,ey] <- getIntegers
    putStrLn $ if solve rn rm sx sy ex ey then "YES" else "NO"

solve :: Integer -> Integer -> Integer -> Integer -> Integer -> Integer -> Bool
solve rn rm 1 sy 1 ey = pred sy `div` rn == pred ey `div` rn
solve rn rm 1 sy 2 ey = pred sy `div` rn == pred ey `div` rm
solve rn rm 2 sy 1 ey = pred sy `div` rm == pred ey `div` rn
solve rn rm 2 sy 2 ey = pred sy `div` rm == pred ey `div` rm

import Control.Monad

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Int]
getInts = fmap (fst . fromJust . C.readInt) . C.words <$> C.getLine

--
-- MAIN
--

main :: IO ()
main = do
  [n,m,q] <- getInts
  let d = gcd n m
      rn = n `div` d
      rm = m `div` d
  replicateM_ q $ do
    [sx,sy,ex,ey] <- getInts
    putStrLn $ if solve rn rm sx sy ex ey then "YES" else "NO"

solve :: Int -> Int -> Int -> Int -> Int -> Int -> Bool
solve rn rm 1 sy 1 ey = pred sy `div` rn == pred ey `div` rn
solve rn rm 1 sy 2 ey = pred sy `div` rn == pred ey `div` rm
solve rn rm 2 sy 1 ey = pred sy `div` rm == pred ey `div` rn
solve rn rm 2 sy 2 ey = pred sy `div` rm == pred ey `div` rm


{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Maybe

readWords = map read . words <$> getLine

solve n b as =
		if any (\a → s < a * n) as
			then Nothing
			else Just $ map (\a → s/n - a) as
	where
		s = b + sum as

main = do
	[n, b] ← readWords
	as ← readWords

	let r = solve n b as
	if isNothing r
		then putStrLn "-1"
		else mapM_ print $ fromJust r

main = do interact (unlines . gao . map read . words)
gao (n:m:a) = if d <= m then map (\i -> show $ i + (m - d) / n) c else ["-1"] where
    b = maximum a
    c = map (b-) a
    d = sum c

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.IO
import System.IO.Error

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

main = do n <- readNum :: IO Double
          b <- readNum :: IO Double

          mugs <- replicateM (round n) readNum

          let max_ml = maximum mugs -- 最大に合わせる
          let need_more = [ max_ml - m | m <- mugs] -- 後それぞれ、これだけ入れれば平等
          let total_filling = sum need_more -- 平等のために必要な送料
          let redundant_each = (b - total_filling) / n
          let actual_value = [ redundant_each + m | m <- need_more] -- 余りを平等にわけてからの、各々必要な量

          if total_filling > b then print (-1)
                               else mapM_ print actual_value

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: Int -> Int -> [Int] -> Maybe [Double]
solve n b' as
  | b < n * maximum as  =  Nothing
  | otherwise  =  Just $ map (\a -> d - fromIntegral a) as
  where
    b  =  b' + sum as
    d  =  fromIntegral b / fromIntegral n

printAns :: Maybe [Double] -> IO ()
printAns Nothing  =  print (-1)
printAns (Just as)  =  mapM_ print as

main :: IO ()
main  =  do
    [n, b] <- Main.reads
    as <- Main.reads
    printAns $ solve n b as

import Text.Printf

main = getContents >>= solve.map read.words

solve :: [Int] -> IO ()
solve (n:b:xs)
  | b < y = print $ -1
  | otherwise = mapM_ (printf "%.6f\n".(z-).fromIntegral) xs
   where x = maximum xs
         y = sum $ map (x-) xs
         z :: Double
         z = (fromIntegral$b-y)/(fromIntegral n) + (fromIntegral x)

import Text.Printf

solve :: (Double, [Double]) -> Maybe [Double]
solve (b, as) =
    if all (>= 0) res
    then Just res
    else Nothing
    where
      one = (b + sum as) / (fromIntegral $ length as)
      res = map (\x -> one - x) as

pprint :: Maybe [Double] -> String
pprint (Just foo) = unlines $ map (printf "%.7f") foo
pprint Nothing = "-1"

parse :: String -> (Double, [Double])
parse foo =
    let [first, rest] = lines foo
        (_:nn:_) = words first
        n = read nn
        stuff = map read (words rest)
    in (n, stuff)

main = interact (pprint . solve . parse)

import Text.Printf

solve :: (Float, [Float]) -> Maybe [Float]
solve (b, as) =
    if all (>= 0) res
    then Just res
    else Nothing
    where
      one = (b + sum as) / (fromIntegral $ length as)
      res = map (\x -> one - x) as

pprint :: Maybe [Float] -> String
pprint (Just foo) = unlines $ map (printf "%.7f") foo
pprint Nothing = "-1"

parse :: String -> (Float, [Float])
parse foo =
    let [first, rest] = lines foo
        (_:nn:_) = words first
        n = read nn
        stuff = map read (words rest)
    in (n, stuff)

main = interact (pprint . solve . parse)


import Data.List
import Data.Map (elems, fromList)
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

process_ []     end teamed = end
process_ (v:vs) end teamed
    | inTeam    = process_ vs end teamed
    | otherwise = process_ vs (end ++ [(c, r)]) newA
    where c = (fst . snd) v
          r = (snd . snd) v
          inTeam = Set.member c teamed || Set.member r teamed
          newA = Set.insert c $ Set.insert r teamed

solve_ n values = process_ (sorted values) [] (Set.empty)

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- B.getLine
      return $ map (maybe (error "a") fst) . map B.readInt . B.words $ line
    let coords = [(y, x) | x <- [1..n*2], y <- [1..x-1]]
    let withRow = zip (concat strengths) coords
    let result = solve_ n $ withRow
    -- let vvv = [(6,(1,2)),(1,(1,3)),(2,(2,3)),(3,(1,4)),(4,(2,4)),(5,(3,4))]
    let showResult = concat . intersperse " " . map show . elems. fromList
    putStrLn $ showResult $ result ++ (map swap result)

        where swap (x, y) = (y, x)

-- Codeforces 579B

import Control.Monad
import Data.List
import Data.Function
import Data.Maybe
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B

-- Hint: get all combinations of (i, j), then sort it by the value of `d` in decreasing order.

main :: IO ()
main = B.getContents >>= putStrLn . intercalate " " . map show . solve . map (fst . fromJust . B.readInt) . B.words

solve :: [Int] -> [Int]
solve (n:xs) = map snd $ sort $ fst $ foldl (\(now, acc) (x, y) -> if (Set.member x acc) || (Set.member y acc) then (now, acc) else ((x,y):(y,x):now, (Set.insert x $ Set.insert y acc))) ([], Set.empty) $ map snd $ reverse $ sort $ zip xs [(i,j) | i <- [1..2*n], j <- [1..i-1]]

import Data.List (intercalate, sort)
import Data.Set hiding (map)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [(x,y) | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | size set == 2*n = []
               f ((pair@(x,y)):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, (y,x)] ++ f ss (insert y $ insert x set)
               ret = intercalate " " $ map (show.snd) $ sort $ f score empty

import Data.List (intercalate, sort)
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

main = do  putStrLn. solve =<< map (fst . fromJust . B.readInt) . B.words <$> B.getContents
solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [(x,y) | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | S.size set == 2*n = []
               f ((pair@(x,y)):ss) set | S.member x set || S.member y set = f ss set
                                       | otherwise = [pair, (y,x)] ++ f ss (S.insert y $ S.insert x set)
               ret = intercalate " " $ map (show.snd) $ sort $ f score S.empty

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn

  cs <- replicateM (2*n-1) getInts

  let ps = reverse $ sort $ concat $ zipWith (\cs i -> zipWith (\j c -> (c, (i, j))) [1..i] cs) cs [2..2*n]

  let
    f [] l s = l
    f ((c, (i, j)):ps) l s
      | i `Set.member` s || j `Set.member` s = f ps l s
      | otherwise = f ps ((i, j):(j, i):l) (i `Set.insert` (j `Set.insert` s))

    a = array (1, 2*n) $ f ps [] Set.empty :: Array Int Int

  putStrLn $ unwords $ map show $ elems a

import Data.List (intercalate, sort)
import Data.Map (elems, fromList)
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

process []          teamed = []
process ((c, r):vs) teamed
    | inTeam    = process vs teamed
    | otherwise = (c, r):(r, c):process vs newA
    where inTeam = Set.member c teamed || Set.member r teamed
          newA   = Set.insert c $ Set.insert r teamed

solve (n:vs) = process scores (Set.empty)
    where coords = [(y, x) | x <- [1..n*2], y <- [1..x-1]]
          scores = map snd . reverse . sort $ zip vs coords

showResult result = putStrLn . s $ result
    where s = intercalate " " . map show . elems . fromList

main = do
    contents <- B.getContents
    let values = map (fst . fromJust . B.readInt) . B.words $ contents
    showResult $ solve values

import Data.List (intersperse, sort)
import Data.Set (insert, member, empty)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f ((pair@[x,y]):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, reverse pair] ++ f ss (insert y $ insert x set)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score empty

import Data.List (intersperse, sort)
import Data.Set hiding (map)
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = map snd $ reverse $ sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f [] _ = []
               f _ set | size set == 2*n = []
               f ((pair@[x,y]):ss) set | member x set || member y set = f ss set
                                       | otherwise = [pair, reverse pair] ++ f ss (insert y $ insert x set)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score empty

import Data.List
main=interact $ solve. map read. words

solve (n:xs) = ret
         where score = sort $ zip xs [[x,y] | x<-[2..2*n], y<-[1..x-1]]
               f _ 0 = []
               f score n  = let (_,pair) = head score
                                score' = filter ((==4) . length . nub . (pair++) . snd)  score
                            in [pair, reverse pair] ++ f score' (n-1)
               ret = intersperse ' ' $ concatMap (show.head.tail) $ sort $ f score n

import Data.List
import Data.Map (elems, fromList)
import qualified Data.Set as Set

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

process_ []     end teamed = end
process_ (v:vs) end teamed
    | inTeam    = process_ vs end teamed
    | otherwise = process_ vs (end ++ [(c, r)]) newA
    where c = (fst . snd) v
          r = (snd . snd) v
          inTeam = Set.member c teamed || Set.member r teamed
          newA = Set.insert c $ Set.insert r teamed

solve_ n values = process_ (sorted values) [] (Set.empty)

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- getLine
      return (map read . words $ line :: [Int])
    let coords = [(y, x) | x <- [1..nl], y <- [1..x-1]]
    let withRow = zip (concat strengths) coords
    let result = solve_ n $ withRow
    -- let vvv = [(6,(1,2)),(1,(1,3)),(2,(2,3)),(3,(1,4)),(4,(2,4)),(5,(3,4))]
    let showResult = concat . intersperse " " . map show . elems. fromList
    putStrLn $ showResult $ result ++ (map swap result)

        where swap (x, y) = (y, x)

import Data.List
import Data.Map (elems, fromList)

{-
solve n = 1 + floor rem
    where root = logBase 2 n
          btm = floor root
          rem = if 2 ^ btm == n then 0 else n - (2 ^ btm)
-}

-- [(val, (t1, t2))]
sorted :: [(Int, (Int, Int))] -> [(Int, (Int, Int))]
sorted = reverse . sortBy sortFn
    where sortFn x y = compare (fst x) (fst y)

-- get largest
process [] start end = end
process (v:vs) start end = process (newvs) nstart nend
    where (nstart, nend) = groupUp start end t1 t2
          t1 = (fst . snd) v
          t2 = (snd . snd) v
          newvs = filter fn vs
          fn = \(v, (t3, t4)) -> and [t1/=t3, t1/=t4, t2/=t3, t2/=t4]

groupUp [] end _ _ = ([], end)
groupUp start end t1 t2 = (news, newe)
    where news = filter (\s -> s /= t1 && s /= t2) start
          newe = end ++ [(t1, t2)]

solve values = process (sorted values) [1..n] []
    where n = (div (length values) 2 - 1) * 2

main :: IO ()
main = do
    n <- readLn
    let nl = n * 2 - 1
    strengths <- sequence $ replicate nl $ do
      line <- getLine
      return (map read . words $ line :: [Int])
    let zipper = zipWith3 (\c r v -> (v, (c, r)))
    let withRow = zipWith (\r l -> zipper [1..] (repeat r) l) [2..] strengths
    let result = solve $ concat withRow
    putStrLn $ intersperse ' ' . concatMap show . elems . fromList $ result ++ (map swap result)
        where swap (x, y) = (y, x)


import Prelude
import Control.Monad

str2Ints str = [read x::Int | x <- words str]
getLineN n = replicateM n getLine

intersect a b = [x| x<-a, elem x a, elem x b]

popfront (x:xs) = xs

main = do
    str <- getLine;
    let n = read str::Int;
    strs <- getLineN n;
    mapM (putStr.(++ " ").show) (foldr1 intersect (map (popfront.str2Ints) strs));

import System.IO
import Control.Monad (replicateM)

count x xs = (length . filter (== x)) xs

readStations = do
  line <- fmap (fmap read . words) getLine :: IO [Int]
  return $ tail line

main = do
  n <- fmap read getLine :: IO Int
  all <- replicateM n readStations
  putStrLn $ unwords . (fmap show) $ filter (\x -> count x (concat all) == n) [1..100]

import System.IO
import Data.List
import Control.Monad

numTimesFound xs x = (length . filter (== x)) xs

get = fmap read getLine

gets = fmap (fmap read . words) getLine

readStations = do
  line <- gets :: IO [Int]
  return $ tail line

main = do
  n <- get :: IO Int
  all <- replicateM n readStations
  putStrLn $ unwords . (fmap show) $ filter (\x -> numTimesFound (concat all) x == n) [1..100]

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import Data.Char
import qualified Data.Set as S

process s n m k | n>k || m>k = s
                | n<m = process (s+1) (n+m) m k
                | otherwise = process (s+1) n (m+n) k

onecase = do
		[n,m,k]<-map read <$> words <$> getLine ::IO [Int]
		print $ process 0 n m k

main = do
		n<-read <$> getLine ::IO Int
		x<-map tail <$> map (map read) <$> map words <$> replicateM n getLine :: IO [[Int]]
		putStrLn $ intercalate " "$ map show $ S.toList $ foldl1 (S.intersection) $ map (S.fromList) x

import System.IO
import Data.Char
import Data.List
import Control.Applicative
import Control.Monad
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: BS.ByteString -> [Int]
construct str
    | BS.null str = []
    | isSpace (BS8.head str) = construct (BS8.tail str)
    | otherwise = let Just (i, other) = BS8.readInt str in i : construct other

getInts :: IO [Int]
getInts = construct <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

main = do
    [n] <- getInts
    stops <- forM [1..n] (\_ -> getInts)
    let cand = filter (\x -> all (\s -> x `elem` s) (map (drop 1) $ stops)) [1..100]
    printInts cand


import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    w <- map read . words <$> getLine
    print (solve w)

mkArray :: a -> [(Int, a)] -> [a]
mkArray def = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = def : helper (succ n) l

solve :: [Int] -> Int
solve w =  maximum $ map ((`div` 2) . sum . zipWith min l) (tails lr)
  where
    n = length w
    l = mkArray 0 . map (\a -> (head a, length a)) .  group . sort $ w
    lr = replicate n 0 ++ reverse l

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  ws <- sort . map read . words <$> getLine
  print $ maximum [teamsWithSum s ws | s <- [2 .. 2 * n]]

teamsWithSum s ws = f ws (reverse ws) `div` 2
  where
    f (a : as) (b : bs)
      | a + b < s = f as (b : bs)
      | a + b == s = 1 + f as bs
      | otherwise = f (a : as) bs
    f _ _ = 0

import Control.Monad
import Data.List

teamsWithSum :: Int -> [Int] -> Int
teamsWithSum s ws = f ws (reverse ws) `div` 2
  where
    f (a : as) (b : bs)
      | a + b < s = f as (b : bs)
      | a + b == s = 1 + f as bs
      | otherwise = f (a : as) bs
    f _ _ = 0

solve :: IO ()
solve = do
  n <- read <$> getLine
  ws <- sort . map read . words <$> getLine
  print $ maximum [teamsWithSum s ws | s <- [2 .. 2 * n]]

main :: IO ()
main = do
  getLine >>= flip replicateM_ solve . read

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ getLine >> getLine >>= print . solve . map read . words

mkArray :: a -> [(Int, a)] -> [a]
mkArray def = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = def : helper (succ n) l

solve :: [Int] -> Int
solve w = maximum $ map ((`div` 2) . sum . zipWith min l) (tails lrev)
  where
    l = mkArray 0 . map (\a -> (head a, length a)) . group . sort $ w
    lrev = replicate (length w) 0 ++ reverse l

import GHC.Stack
import Control.Monad
import Data.List (group, sort)
import Data.Map (Map)
import qualified Data.Map as M

maximumOn :: (Ord b) => (a -> b) -> [a] -> a
maximumOn f [] = error "Data.List.Extra.maximumOn: empty list"
maximumOn f (x:xs) = g x (f x) xs
    where
        g v mv [] = v
        g v mv (x:xs) | mx > mv = g x mx xs
                      | otherwise = g v mv xs
            where mx = f x

dropAt 0 (x:xs) = xs
dropAt i (x:xs) = dropAt (i-1) xs

combinations 0 xs = [[]]
combinations k xs = do
  (i, x) <- zip [0..] xs
  (x:) <$> combinations (k-1) (dropAt i xs)

decrement :: (HasCallStack, Ord k) => k -> Map k Int -> Map k Int
decrement = M.alter f
  where
    f Nothing = error "Tried to decrement key that isn't there!"
    f (Just x)
      | x-1 > 0 = Just (x-1)
      | otherwise = Nothing

increment :: (HasCallStack, Ord k) => k -> Map k Int -> Map k Int
increment = M.alter f
  where
    f Nothing = Just 1
    f (Just x) = Just (x+1)

numTeams :: HasCallStack => [Int] -> Int -> Int
numTeams weights target = snd $ foldr f (M.empty, 0) weights
  where
    f weight (counts, ans)
      | (target - weight) `M.member` counts = (decrement (target-weight) counts, ans+1)
      | otherwise                           = (increment weight counts, ans)

uniq :: Ord a => [a] -> [a]
uniq = map head . group . sort

solve :: HasCallStack => [Int] -> Int
solve [] = 0
solve [_] = 0
solve weights = maximum . map (numTeams weights) . uniq $ targets
  where targets = map sum $ combinations 2 weights

main = do
  numCases <- readLn
  replicateM_ numCases $ do
    getLine
    print =<< solve <$> fmap read <$> words <$> getLine

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: Int -> [Int] -> Int
solve goal xs = f xs (reverse xs) `div` 2
    where
        f (x:xs) (y:ys)
            | x + y < goal = f xs (y:ys)
            | x + y == goal = 1 + f xs ys
            | otherwise = f (x:xs) ys
        f _ _ = 0

deal :: IO()
deal = do
    n <- read <$> getLine
    a <- sort . map read . words <$> getLine
    putStrLn $ show $ maximum [solve s a | s <- [2 .. 2*n]]

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad (replicateM_)
import Data.List (group, groupBy, sort, tails) --'
import Data.Function (on)

solve :: [Int] -> Int
solve li = let
  sli = [(head x, length x) | x <- group (sort li)]
  pairSums = do
    ys <- tails sli
    let  (x, kx) = head ys
    (y, ky) <- ys
    pure (x + y, if  x == y  then  div kx 2  else  min kx ky)
  counts = [sum ks | ks <- map (map snd) . groupBy ((==) `on` fst) $ sort pairSums]
  in  maximum counts

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    _nStr <- getLine
    ws <- map read . words <$> getLine :: IO [Int]
    print $ solve ws

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.List

main :: IO ()
main =
  interact $
    lines >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map show
      >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process ([_] : xs : rest) = solve xs : process rest

solve :: [Int] -> Int
solve [_] = 0
solve xs =
  maximum $
    (map length . group . sort . map (uncurry (+)) . filter (uncurry (<=)) . concatMap dropEqDup)
      (zip <$> gs <*> gs)
  where
    gs = group . sort $ xs

    dropEqDup :: [(Int, Int)] -> [(Int, Int)]
    dropEqDup xs
      | uncurry (==) (head xs) = take (length xs `div` 2) xs
      | otherwise = xs

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    w <- map read . words <$> getLine
    print (solve w)

mkArray :: [(Int, a)] -> [a]
mkArray = helper 0
  where
    helper _ [] = []
    helper n l@((i, x):xs)
      | i == n = x : helper (succ n) xs
      | otherwise = helper (succ n) l

solve :: [Int] -> Int
solve w = (`div` 2) . maximum $ map (sum . zipWith min l) (tails lr)
  where
    n = length w
    l = mkArray . map (\a -> (head a, length a)) .  group . sort $ w
    lr = replicate n 0 ++ reverse l


module Main where

import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (unwords . map show . solve . map read . words . (!! 1) . lines)

startTime = 10
middleTime = (24 - 18) * 60
endTime = (6 - 18 + 24) * 60

solve :: [Int] -> [Int]
solve times = result where
    result = cutProblems bestOrder
    bestOrder = sort times

cutProblems :: [Int] -> [Int]
cutProblems = cutProblems' startTime 0 0
cutProblems' _ result tasks [] = [tasks, result]
cutProblems' sm result tasks (x : xs) = if sm + x <= endTime
    then cutProblems' (sm + x) (result + if sm + x < middleTime then 0 else sm + x - middleTime) (tasks + 1) xs
    else [tasks, result]

import Control.Monad
import Data.List (sort)

main = do
  getLine
  lengths <- (liftM (map read . words)) getLine
  let solveTimes = tail . takeWhile (<= 710) $ scanl (+) 0 (sort lengths)
  putStrLn $ show (length solveTimes) ++ " " ++ (show . sum $ map (\x -> max 0 (x-350)) solveTimes)

{-# LANGUAGE BangPatterns #-}

import Data.List

end = 720 -- end time

cost t = max 0 (t-360)

solve :: [Int] -> (Int,Int)
solve as = go 0 0 10 (sort as)
  where
    go !n c t [] = (n,c)
    go !n c t (a:as) | t+a <= end = go (n+1) (c+cost (t+a)) (t+a) as
                     | otherwise = (n,c)

main = do
  n <- fmap read getLine :: IO Int
  as <- fmap (map read . words) getLine
  let (n,c) = solve as
  putStrLn $ show n ++ " " ++ show c
  return ()

import Control.Monad (liftM)
import Data.List (sort)
import Prelude hiding (print, reads)

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

solve :: [Int] -> (Int, Int)
solve xs  =  ((flip (-) 1) $ length $ takeWhile (<= 720) $ scanl (+) 10 $ sort xs, solve' 10 $ sort xs)
  where
    solve' time []  =  0
    solve' time (x:xs)
      | time' <= 360  =  solve' time' xs
      | time' <= 720  =  (time' - 360) + solve' time' xs
      | otherwise  =  0
      where
        time'  =  time + x

print :: (Int, Int) -> IO ()
print (a, b)  =  putStrLn $ concat [show a, " ", show b]

main :: IO ()
main  =  getLine >> reads >>= print . solve

import Control.Applicative
import Text.Printf
import Data.List

main :: IO ()
main = do
  _ <- getLine
  xs <- sort . map read . words <$> getLine
  let (n,p) = foldl (\(n,p) y -> (n+1, p + penalty y)) (0::Int,0) $ takeWhile (<= 710) $ scanl1 (+) xs
  printf "%d %d\n" n p

penalty :: Int -> Int
penalty t
  | t <= 350 = 0
  | otherwise = t - 350

import Data.List(scanl,sort)
import Control.Applicative

main = do n <- read <$> getLine
          ts <- map read <$> words <$> getLine
          putStrLn $ solve n ts

solve :: Int -> [Int] -> String
solve _ ts = let (n,p) = fst $ last $ takeWhile ((<=710).snd) $ scanl f ((0,0),0) $ zip [1..] $ sort ts
             in (show n) ++ " " ++ (show p)

f ((_,p),t) (n,s) = ((n, p + max 0 (s+t-350)), s+t)

import Control.Monad

main = do
  getLine
  lengths <- (liftM (map read . words)) getLine
  let solveTimes = tail . takeWhile (<= 710) $ scanl (+) 0 lengths
  putStrLn $ show (length solveTimes) ++ " " ++ (show . sum $ map (\x -> max 0 (x-350)) solveTimes)

import Data.List(scanl1,sort)
import Control.Applicative

main = do n <- read <$> getLine
          ts <- map read <$> words <$> getLine
          putStrLn $ unwords $ map show $ solve n ts

solve :: Int -> [Int] -> [Int]
solve _ ts = let (n,t) = last $ takeWhile ((<=710).snd) $ zip [0..] $ scanl1 (+) $ 0:sort ts
             in [n,max 0 (t-350)]


import Data.Int
import Data.Tree
import Data.Char
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Foldable (toList)
import Control.Monad (when)
import Data.Array.IArray
import qualified Data.Sequence as S
import qualified Data.ByteString.Char8 as C
f2read' :: Int -> Char -> Int
f2read' x y = 10 * x + ord y - ord '0'

f2read :: C.ByteString -> Int
f2read x = C.foldl' f2read' 0 x

f2show :: Int -> C.ByteString
f2show x = C.reverse $ C.cons ' ' $ fst $ C.unfoldrN 8 (\x -> if x /= 0 then Just (chr $ rem x 10 + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

indexed :: Int -> [a] -> [(Int, a)]
indexed _ [] = []
indexed i (x:xs) = (i, x) : (indexed (i+1) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

f2folder :: Int -> [(Int, (S.Seq Int, S.Seq Int))] -> (Int, (S.Seq Int, S.Seq Int))
f2folder v ls = (s, (bef, aft))
              where s = rem ((+1) $ sum $ map fst ls) 2
                    bef' = foldl' (S.><) S.empty $ map (fst . snd) ls
                    aft' = foldl' (S.><) S.empty $ map (snd . snd) ls
                    bef = if s == 0 then (v S.<| bef') else bef'
                    aft = if s == 1 then (v S.<| aft') else aft'

solve :: Tree Int -> Maybe [Int]
solve t = if s == 1 then Just $ toList ((S.reverse bef) S.>< aft) else Nothing
        where ans = foldTree f2folder t
              s = fst ans
              bef = fst (snd ans)
              aft = snd (snd ans)

f2buildTree :: [Int] -> Tree Int
f2buildTree xs = unfoldTree (\x -> (x, a!x)) (head $ a!0)
               where n = length xs
                     a = accumArray (\x y -> y : x) [] (0, n) (map swap (indexed 1 xs)) :: Array Int [Int]

main :: IO ()
main = do dat <- C.getContents
          let ans = solve $ f2buildTree $ map f2read $ C.words $ last $ f2lines dat
          C.putStrLn $ C.pack $ (if isJust ans then "YES" else "NO")
          when (isJust ans) $ C.putStrLn $ C.concat $ map f2show $ fromJust ans

import Data.Int
import Data.Tree
import Data.Char
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Foldable (toList)
import Control.Monad (when)
import Data.Array.IArray
import qualified Data.Sequence as S
import qualified Data.ByteString.Char8 as C
f2read' :: Int -> Char -> Int
f2read' x y = 10 * x + ord y - ord '0'

f2read :: C.ByteString -> Int
f2read x = C.foldl' f2read' 0 x

f2show :: Int -> C.ByteString
f2show x = C.reverse $ C.cons ' ' $ fst $ C.unfoldrN 8 (\x -> if x /= 0 then Just (chr $ rem x 10 + ord '0', div x 10) else Nothing) x

f2lines :: C.ByteString -> [C.ByteString]
f2lines x = map (\x -> if (C.last x == '\r') then (C.init x) else x) (C.lines x)

indexed :: Int -> [a] -> [(Int, a)]
indexed _ [] = []
indexed i (x:xs) = (i, x) : (indexed (i+1) xs)

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

f2folder :: Int -> [(Int, (S.Seq Int, S.Seq Int))] -> (Int, (S.Seq Int, S.Seq Int))
f2folder v ls = (s, (bef, aft))
              where s = rem ((+1) $ sum $ map fst ls) 2
                    bef' = foldl (S.><) S.empty $ map (fst . snd) ls
                    aft' = foldl (S.><) S.empty $ map (snd . snd) ls
                    bef = if s == 0 then (v S.<| bef') else bef'
                    aft = if s == 1 then (v S.<| aft') else aft'

solve :: Tree Int -> Maybe [Int]
solve t = if s == 1 then Just $ toList ((S.reverse bef) S.>< aft) else Nothing
        where ans = foldTree f2folder t
              s = fst ans
              bef = fst (snd ans)
              aft = snd (snd ans)

f2buildTree :: [Int] -> Tree Int
f2buildTree xs = unfoldTree (\x -> (x, a!x)) (head $ a!0)
               where n = length xs
                     a = accumArray (\x y -> y : x) [] (0, n) (map swap (indexed 1 xs)) :: Array Int [Int]

main :: IO ()
main = do dat <- C.getContents
          let ans = solve $ f2buildTree $ map f2read $ C.words $ last $ f2lines dat
          C.putStrLn $ C.pack $ (if isJust ans then "YES" else "NO")
          when (isJust ans) $ C.putStrLn $ C.concat $ map f2show $ fromJust ans


main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [n, k, _, _, sall, sk] = f sk k ++ f (sall - sk) (n - k)
  where f _ 0 = []; f s m = replicate (s `mod` m) ((s + m - 1) `div` m) ++ replicate (m - s `mod` m) (s `div` m)
solve _ = undefined

main=getContents>>=putStrLn.unwords.map show.solve.map read.words
solve[n,k,_,_,sall,sk]=f sk k++f(sall-sk)(n-k)
 where f _ 0=[];f s m=replicate(s`mod`m)((s+m-1)`div`m)++replicate(m-s`mod`m)(s`div`m)

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve [n, k, _, _, sall, sk] = replicate (sk `mod` k) ((sk + k - 1) `div` k)
                            ++ replicate (k - sk `mod` k) (sk `div` k)
     ++ if n == k then [] else replicate ((sall - sk) `mod` (n - k)) (((sall - sk) + (n - k) - 1) `div` (n - k))
                            ++ replicate ((n - k) - (sall - sk) `mod` (n - k)) ((sall - sk) `div` (n - k))
solve _ = undefined

import Data.List

main :: IO ()
main = getContents >>= putStrLn. intercalate " ". map show. (\[n, k, l, r, sall, sk] -> (getArr k sk) ++ (getArr (n-k) (sall - sk))). map read. words
  where
    getArr n s
      | n == 0 = []
      | otherwise =
          let
            mre = s`rem`n
            lss = n - mre
          in
            (replicate mre (s`div`n + 1)) ++ (replicate lss (s`div`n))

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k,l,r,sa,sk] <- readInts
    let v = div sk k
        w = mod sk k
        ans1 = take k $ f w
        f w = let x = min r (v+w) in x:f (w-(x-v))
        s = div (sa-sk) (n-k)
        t = mod (sa-sk) (n-k)
        ans2 = take (n-k) $ g t
        g w = let x = min v (s+w) in x:g (w-(x-s))
    putStrLn $ unwords $ map show $ ans1 ++ ans2

getlist :: Int -> Int -> [Int]
getlist 0 _ = []
getlist n s = (map (+1) (take (s `mod` n) rep)) ++ (drop (s `mod` n) rep)
  where
    rep = replicate n (s `div` n)

main :: IO ()
main = do
  line <- getLine
  let [n,k,l,r,sall,sk] = map (read :: String -> Int) (words line)

  let r = (getlist k sk) ++ (getlist (n-k) (sall-sk))

  putStrLn $ concatMap (\x -> show x ++ " ") r

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k,l,r,sa,sk] <- readInts
    let v = div sk k
        w = mod sk k
        ans1 = take k $ f w
        f w = let x = min r (v+w) in x:f (w-(x-v))
        s = div (sa-sk) (n-k)
        t = mod (sa-sk) (n-k)
        ans2 = take (n-k) $ g t
        g w = let x = min r (s+w) in x:g (w-(x-s))
    putStrLn $ unwords $ map show $ ans1 ++ ans2


import Control.Monad (replicateM_)
import qualified Data.Map.Strict as M

solve :: String -> (Int, String)
solve xs = (d + r + u + l, ans) where
    counts = M.fromListWith (+) [(x, 1) | x <- xs]
    numDs = M.findWithDefault 0 'D' counts
    numRs = M.findWithDefault 0 'R' counts
    numUs = M.findWithDefault 0 'U' counts
    numLs = M.findWithDefault 0 'L' counts
    d' = min numDs numUs
    r' = min numRs numLs
    d = if d' > 0 && r' == 0 then 1 else d'
    r = if r' > 0 && d' == 0 then 1 else r'
    u = d
    l = r
    ans = replicate d 'D' ++ replicate r 'R' ++ replicate u 'U' ++ replicate l 'L'

main =
    read <$> getLine >>= \q ->
    replicateM_ q (
        solve <$> getLine >>= \(num, ans) ->
        putStrLn $ show num ++ "\n" ++ ans
    )

import Control.Monad

f1 :: String -> (Int,Int,Int,Int)
f1 = foldl f (0,0,0,0)
  where
    f (a,b,c,d) v
      |v=='R' = (a+1,b,c,d)
      |v=='U' = (a,b+1,c,d)
      |v=='L' = (a,b,c+1,d)
      |v=='D' = (a,b,c,d+1)
      |otherwise = error "saas"
f2 :: (Int,Int,Int,Int) -> (Int,String)
f2 (a,b,c,d)
  |e>0 && f>0 =(2*(e+f),replicate e 'R' ++ replicate f 'U' ++ replicate e 'L' ++ replicate f 'D')
  |e==0 && f==0 = (0,"")
  |e>0 = (2,"RL")
  |otherwise = (2,"UD")
  where
    e=min a c
    f=min b d

routine :: IO ()
routine = do
  s <- getLine
  let (a,b)=f2 $ f1 s
  print a
  putStrLn b

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine


module Main where

import Prelude

ans :: Int -> Int -> Int -> Int -> [Int] -> IO ()
ans k c last _ [] | last < k		= print last
				  | otherwise 		= putStrLn "-1"
ans k c last id (x:xs) | x /= c		= ans k c id (id + 1) xs
					   | otherwise  = ans k c last (id + 1) xs

main = do
	t <- getLine
	let [n, k] = map read $ words t
	t <- getLine
	let a = map read $ words t
	ans k (last a) 0 1 a

import Data.List

solve (n:k:xs)
  | t <= k    = t - 1
  | otherwise = -1
  where ((t, _):_) = last $ groupBy (\x y -> snd x == snd y) $ zip [1 .. ] xs

main = interact $ show . solve . map read . words

main = do
  k <- fmap (read . last . words) getLine
  as <- fmap (map read . words) getLine
  let i = as !! (k-1) :: Int
      ok = all (==i) (drop k as)
  let bs = scanr f True (take k as)
      f a b = b && a == i
      n = length (takeWhile not bs)
  print $ if ok && n < k then n else -1

import qualified Data.ByteString.Char8 as B
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  (n:k:xs) <- map readInt.B.words <$> B.getContents
  let (ys,zs) = splitAt (k-1) xs
      f [] = True
      f (x:xs) = all(x==)xs
  if f zs
     then print $ length $ dropWhile (xs!!(k-1)==) $ reverse ys
     else print $ -1

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

import Data.Array.MArray
import Data.Array.IO

solve :: Int -> Int -> [Int] -> Maybe Int
solve n k l =
  let cycle = n-k+1
      (last : rest) = reverse l
      walk [] i = i
      walk (x : r) i = if last /= x then i else walk r (i+1)
      same = walk rest 1
  in  if same < cycle then
        Nothing
      else
        Just (k - 1 - same + cycle)

main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let Just (k, r2) = readInt r1
     let Just (l, _) = readIntList n r2
     case solve n k l of
       Nothing -> print (-1)
       Just v  -> print v
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (x, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return (x : l, t)

import Data.List

solve :: Int -> Int -> [Int] -> Int
solve n k l =
    if same latter then count (head latter) l else -1
    where latter = drop (k-1) l
          same [] = True
          same (x:xs) = xs == [ x | _ <- xs ]
          count x xs =
            case findIndex (/=x) (reverse xs) of
                Just i -> n - i
                Nothing -> 0

main :: IO ()
main = do str <- getLine
          let [n,k] = map read $ words str
          str <- getLine
          putStrLn $ show $ solve n k $ (map read $ words str)

import Control.Applicative
import Data.List

main :: IO ()
main = do
  [n, k] <- map read <$> (words <$> getLine) :: IO [Int]
  a      <- map read <$> (words <$> getLine) :: IO [Int]
  let
    b = drop (k - 1) a
    c = take (k - 1) a
    bb = (length . nub $ b) == 1
    cc = length . takeWhile (== (head b)) . reverse $ c
  if bb then print (k - 1 - cc) else print (-1)

on :: (b -> c -> d) -> (a -> b) -> (a -> c) -> (a -> d)
on f g h x  =  f (g x) (h x)

solve :: Int -> Int -> [Int] -> Int
solve n k xs
  | k + m >= n + 1  =  n - m
  | otherwise  =  -1
  where
    xs'  =  reverse xs
    m  =  solve' 1 $ tail xs'
    solve' acc []  =  acc
    solve' acc (y:ys)
      | y == head xs'  =  solve' (acc+1) ys
      | otherwise  =  acc

main :: IO ()
main  =  do
    [n, k]  <-  fmap (map read . words) getLine
    xs  <-  fmap (map read . words) getLine
    print $ solve n k xs

solve (n:k:xs)
  | mn == mx  = k - 1
  | otherwise = -1
  where ts = drop (k - 1) xs
        mn = minimum ts
        mx = maximum ts

main = interact $ show . solve . map read . words

main = do
  k <- fmap (read . last . words) getLine
  as <- fmap (map read . words) getLine
  let i = as !! (k-1) :: Int
  let bs = scanr f True (take k as)
      f a b = b && a == i
      n = length (takeWhile not bs)
  print $ if n < k then n else -1

module Main where

import Prelude

ans :: Int -> Int -> Int -> Int -> [Int] -> IO ()
ans k c last _ [] | last < k		= print last
				  | otherwise 		= putStrLn "-1"
ans k c last id (x:xs) | x /= c		= ans k c id (id + 1) xs
					   | otherwise  = ans k c last (id + 1) xs

main = do
	t <- getLine
	let [n, k] = map read $ words t
	t <- getLine
	let a = map read $ words t
	ans k (last a) (0-1) 1 a

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

import Data.Array.MArray
import Data.Array.IO

solve :: Int -> Int -> [Int] -> Maybe Int
solve n k l =
  let cycle = n-k+1
      (last : rest) = reverse l
      walk [] i = i
      walk (x : r) i = if i /= x then i else walk r (i+1)
      same = walk rest 1
  in  if same < cycle then
        Nothing
      else
        Just (k - 1 - same + cycle)

main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let Just (k, r2) = readInt r1
     let Just (l, _) = readIntList n r2
     case solve n k l of
       Nothing -> print (-1)
       Just v  -> print v
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (x, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return (x : l, t)


{-
instructions go here...
-}

module Main where
import Data.Text as T hiding (length)

solve haystack needle = length (T.splitOn needle haystack) - 1

main :: IO ()
main = do
  haystack <- getLine
  needle <- getLine
  putStrLn $ show $ solve (T.pack haystack) (T.pack needle)

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  x <- getLine
  y <- getLine
  print $ solve x y

--solve :: String -> String -> Int
solve ai inp = ans
    where
      ans = merge intervals
      intervals = map g $ filter f (zip (tails ai) [0..])
      f (x, t) = take len x == inp
      g (x, t) = (t, t+len-1)
      len = length inp
merge is = merge' (-1) (sort is) - 1
    where
      merge' p ((s, e):r) | p < s = 1 + merge' e r
                          | otherwise = merge' p r
      merge' _ [] = 1

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  x <- getLine
  y <- getLine
  print $ solve x y

--solve :: String -> String -> Int
solve ai inp = ans
    where

      ans = merge intervals
      intervals = map g $ filter f (zip (tails ai) [0..])
      f (x, t) = take len x == inp
      g (x, t) = (t, t+len-1)
      len = length inp
merge is = merge' (-1) (sort is) - 1
    where
      merge' p ((s, e):r) | p < s = 1 + merge' e r
                          | otherwise = merge' e r
      merge' _ [] = 1


{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m] <- getInts
  xs <- getInts

  let
    (_, cs) = mapAccumR (\s x -> let s' = Set.insert x s in (s', Set.size s')) Set.empty xs

    cs' = listArray (1, n) cs :: UArray Int Int

  qs <- unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getContents

  putStr $ unlines $ map show $ map (cs' !) qs

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ unlines.solve.(\(a1:a2:as)->[map read  (words a1), map read (words a2),  map read as]).(\(a:as)-> [a]++take ((+) 1 $ read $ last $ words a) as).lines
solve :: [[Int]]-> [String]
solve [[x1,x2],ys,zs] = [show $ (ma1!i)|i<-zs]
  where
  ma1::Array Int Int
  ma1 =  runST $ do
    am  <- newArray (1,100000) False :: ST s (STArray s Int Bool)
    am2 <- newArray (1,x1) 0 :: ST s (STArray s Int Int)
    ref <- newSTRef 0
    forM_ (reverse $ zip [1..] ys) $ \ (i,n) -> do
       e <- readArray am n
       ref1<-readSTRef ref
       if e==False then do { modifySTRef ref (+1); ref1<-readSTRef ref; writeArray am2 i ref1; writeArray am n True} else writeArray am2 i ref1
    freeze am2

import qualified Data.Set as S
import qualified Data.Array as A
import Data.Array((!))
import Data.List
import Numeric

main = interact solve

fastRead :: String -> Int
fastRead s = case readDec s of [(n, "")] -> n

solve input = intercalate "\n" answer_as_strings
-- solve input = show (sum answers)
-- solve input = seq asnumbers " "
-- solve input = show (length dp)
    where
        answer_as_strings = map show answers

        asnumbers::[Int]
        asnumbers = (map fastRead . words) input
        n:m:afterfirst = asnumbers
        (as,ls) = splitAt n afterfirst

        (fset,dplist) = foldr dp_folder (S.empty,[]) as
            where
                dp_folder curn (cset,xs) = seq nset (nset,(S.size nset):xs)
                    where nset = S.insert curn cset

        -- dplist = [1..n]

        dp = A.listArray (1,n) dplist

        answers = map (\idx -> dp!idx) ls

import qualified Data.Array as A
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

main :: IO ()
main = B.getContents >>= mapM_ print . solve . map (fst . fromJust . B.readInt) . B.words

solve :: [Int] -> [Int]
solve (n:_:asls) = map (S.size . (aset A.!)) ls
  where (as, ls) = splitAt n asls
        aset = A.listArray (1, n) $ scanr S.insert S.empty as
solve _ = undefined

import qualified Data.Array as A
import qualified Data.ByteString.Char8 as B
import qualified Data.Set as S
import Data.Maybe (fromJust)

main :: IO ()
main = B.getContents >>= mapM_ print . solve . map (fst . fromJust . B.readInt) . B.words

solve :: [Int] -> [Int]
solve (n:_:asls) = [ S.size $ aset A.! l | l <- ls ]
  where (as, ls) = splitAt n asls
        aset = A.listArray (1, n) $ scanr S.insert S.empty as
solve _ = undefined

import Data.Bits
import Data.Array.Unboxed
import Data.List
import qualified Data.ByteString.Char8 as B
import Data.Array.ST.Safe
import Control.Monad
readI b = i where Just (i,_) = B.readInt b
main = do
  [n,m] <- map readI . B.words <$> B.getLine
  ss <- acc n . map readI . B.words <$> B.getLine
  mapM_ (print . (ss!) . readI) . B.words =<< B.getContents
acc n as = runSTUArray $ do
  acc <- newListArray (1,n) as
  let go i s = when (i > 0) $ do
        a <- readArray acc i
        let s' = setBit s a :: Integer
        writeArray acc i (popCount s')
        go (i-1) s'
  go n 0
  return acc

import Control.Applicative
import Data.List
import Data.Char
import qualified Data.IntSet as A
import Data.Maybe
import Data.Array

process [] _ ns =    reverse $ scanl1 (+) $ reverse ns
process (y:ys) s ns | A.member y s = process ys s (0:ns)
                    | otherwise = process ys (A.insert y s) (1:ns)

main= do
		getLine
 		a<-  reverse.map read. words <$> getLine::IO [Int]
	        let la = length a
		let z=listArray (1,la) $ process a A.empty []
		b<- map read. words <$> getContents::IO [Int]
	        putStrLn $ intercalate "\n" $ map show $ map (z!) b

import Control.Applicative
import Data.List
import Data.Char
import qualified Data.IntSet as A
import Data.Maybe
import Data.Array
import qualified Data.ByteString.Char8 as C

process [] _ ns =    reverse $ scanl1 (+) $ reverse ns
process (y:ys) s ns | A.member y s = process ys s (0:ns)
                    | otherwise = process ys (A.insert y s) (1:ns)

main= do
		getLine
 		a<-  reverse.map (fst.fromJust.C.readInt). C.words <$> C.getLine::IO [Int]
	        let la = length a
		let z=listArray (1,la) $ process a A.empty []
		b<- map (fst.fromJust.C.readInt). C.words <$> C.getContents::IO [Int]
	        putStrLn $ intercalate "\n" $ map show $ map (z!) b

import Data.Array
import qualified Data.ByteString.Lazy.Char8 as BS
import qualified Data.ByteString.Builder as BUI
import Data.Maybe (fromJust)
import qualified Data.Set as Set

readInt :: BS.ByteString -> Int
readInt = fst . fromJust . BS.readInt
intToByteString = BUI.toLazyByteString . BUI.intDec

main = BS.interact $ BS.unlines . map intToByteString . f . parse . tail . BS.lines

parse (x:xs) = ((map readInt (BS.words x)):(map readInt xs):[])

f (x:y:xs) = map (ans ! ) y
  where i = solve Set.empty (reverse x) []
        ans = listArray (1, (length i)) i

solve st [] ans = ans
solve st (x:xs) ans = solve newst xs ((Set.size newst):ans)
  where newst = Set.insert x st

import Data.Array
import qualified Data.Set as Set
import Numeric

fastRead :: String -> Int
fastRead ('-':s) = case readDec s of [(n, "")] -> (-n)
fastRead s = case readDec s of [(n, "")] -> n

main = interact $ unlines.map show.f.parse.tail.lines

parse (x:xs) = ((map fastRead (words x)):(map fastRead xs):[])

f (x:y:xs) = map (ans ! ) y
  where i = solve Set.empty (reverse x) []
        ans = listArray (1, (length i)) i

solve st [] ans = ans
solve st (x:xs) ans = solve newst xs ((Set.size newst):ans)
  where newst = Set.insert x st

import Data.List
import Data.Int
import Data.Maybe
import Data.Char
import Data.Array
main=   readsolveprint
readsolveprint::IO()
readsolveprint = interact $ unlines.solve.(\(a1:a2:as)->[map read  (words a1), map read (words a2),  map read as]).(\(a:as)-> [a]++take ((+) 1 $ read $ last $ words a) as).lines
solve :: [[Integer]]-> [String]
solve [[x1,x2],ys,zs] = [show $ fst $ (ar!i)|i<-zs]
  where
  ar= listArray (1, x1) slv2
  ls1= group $ concat $ map tail $ group $ sort ys
  slv1 (a2,as) a1  | snd tup ==[]         = (maximum [0, a2-1],as)
                   | otherwise            = (a2, fst tup ++ ([tail $ head $ snd tup ]++tail (snd tup)))
    where tup = break (\a-> if a== [] then False else head a ==a1 ) as
  slv2 = scanl slv1 (x1- fromIntegral (length ls1), ls1) ys

import Control.Applicative
import Data.List
import Data.Char
import qualified Data.IntSet as A
import Data.Maybe
import Data.Array

process [] _ ns =    reverse $ scanl1 (+) $ reverse ns
process (y:ys) s ns | A.member y s = process ys s (0:ns)
                    | otherwise = process ys (A.insert y s) (1:ns)

main= do
		getLine
 		a<-  reverse.map read. words <$> getLine::IO [Int]
	        let la = length a
		let z=listArray (1,la) $ process a A.empty []
		b<- sort.map read. words <$> getContents::IO [Int]
	        putStrLn $ intercalate "\n" $ map show $ map (z!) b

import Control.Applicative
import Data.List
import Data.Char
import qualified Data.IntSet as A
import Data.Maybe
import Data.Array

process [] _ ns = reverse $ scanl1 (+) $ reverse ns
process (y:ys) s ns | A.member y s = process ys s (0:ns)
                    | otherwise = process ys (A.insert y s) (1:ns)

main= do
		getLine
 		a<-  reverse.map read. words <$> getLine::IO [Int]
	        let la = length a
		let z=listArray (1,la) $ process a A.empty []
		print z
		b<- sort.map read. words <$> getContents::IO [Int]
	        putStrLn $ intercalate "\n" $ map show $ map (z!) b


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE Safe #-}

import qualified Data.Array.ST.Safe as V

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:y:xs) = ((n,m,as), xs)
  where [n,m] = map readInt $ take 2 $ words x
        as = map readInt $ words y

solve (n,m,as) = solve' n m as || solve' m n as

solve' n m as = check $ foldl f (0,0,0) $ map maxCols as
  where maxCols a
          | a < 2*n = 0
          | otherwise = a `div` n
        f (s,t,u) x = (s+x, t + max 0 (x-2), u + min 2 x)
        check (s,t,u) = s >= m && (d <= 0 ||
                                   d <= u && even d ||
                                   d+1 <= u && odd d && t >= 1)
          where d = (s-m)-t

format x
  | x = "Yes"
  | otherwise = "No"

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)

{-# OPTIONS_GHC -O2 #-}

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:y:xs) = ((n,m,as), xs)
  where [n,m] = map readInt $ take 2 $ words x
        as = map readInt $ words y

solve (n,m,as) = solve' n m as || solve' m n as

solve' n m as = check $ foldl f (0,0,0) $ map maxCols as
  where maxCols a
          | a < 2*n = 0
          | otherwise = a `div` n
        f (s,t,u) x = (s+x, t + max 0 (x-2), u + min 2 x)
        check (s,t,u) = s >= m && (d <= 0 ||
                                   d <= u && even d ||
                                   d+1 <= u && odd d && t >= 1)
          where d = (s-m)-t

format x
  | x = "Yes"
  | otherwise = "No"

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&))

-- road map in reverse, and the number of cities, init pen state
type Domain = (Int, Int, [Int])
type CoDomain = String
type Solver  = Domain -> CoDomain

readChar8 :: IO [Int]
readChar8 = fmap read . words <$> getLine

printAns :: CoDomain -> IO ()
printAns = putStrLn

parse :: IO Domain
parse = do
  (ys) <- readChar8
  if length ys /= 3
    then error "error input"
    else (do
      xs <- readChar8
      return (ys!!0, ys!!1, xs))

solveOne :: Int -> Int -> Int -> [Int] -> Bool
solveOne total n m xs = (not (null ks) && (maximum ks) > 2 || even m) && sum ks >= m
  where ks = filter (>1) $ map (`div` n) xs

solve :: Solver
solve (n, m, xs) = if solveOne (n * m) n m xs || solveOne (n * m) m n xs then "YES" else "NO"

main :: IO ()
main = do
  [n] <- readChar8
  replicateM n $ printAns =<< solve <$> parse
  return ()

{-# OPTIONS_GHC -O2 #-}

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:y:xs) = ((n,m,as), xs)
  where [n,m] = map readInt $ take 2 $ words x
        as = map readInt $ words y

solve (n,m,as) = solve' n m as || solve' m n as

solve' n m as = check $ foldl f (0,0,0) $ map maxCols as
  where maxCols a
          | a < 2*n = 0
          | otherwise = a `div` n
        f (s,t,u) x = (s+x, t + max 0 (x-2), u + min 2 x)
        check (s,t,u) = s >= m && (d <= 0 || even d && d <= u)
          where d = (s-m)-t

format x
  | x = "Yes"
  | otherwise = "No"

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)

{-# OPTIONS_GHC -O2 #-}

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:y:xs) = ((n,m,as), xs)
  where [n,m] = map readInt $ take 2 $ words x
        as = map readInt $ words y

solve (n,m,as) = solve' n m as || solve' m n as

solve' n m as = check $ foldl f (0,0,0) $ map maxCols as
  where maxCols a
          | a < 2*n = 0
          | otherwise = a `div` n
        f (s,t,u) x = (s+x, t + max 0 (x-2), u + min 2 x)
        check (s,t,u) = s >= m && (d >= 0 || even d && d <= u)
          where d = t-(s-m)

format x
  | x = "Yes"
  | otherwise = "No"

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)

{-# OPTIONS_GHC -O2 #-}

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:y:xs) = ((n,m,as), xs)
  where [n,m] = map readInt $ take 2 $ words x
        as = map readInt $ words y

solve (n,m,as) = solve' n m as || solve' m n as

solve' n m as = check $ foldl f (0,0) $ map maxCols as
  where maxCols a
          | a < 2*n = 0
          | otherwise = a `div` n
        f (s,t) x = (s+x, t + max 0 (x-2))
        check (s,t) = s >= m && s-m <= t

format x
  | x = "Yes"
  | otherwise = "No"

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)


-- http://codeforces.com/contest/818/problem/C

{-# LANGUAGE CPP #-}

import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
import Data.Maybe
import Data.Array
import Control.Monad

#ifdef DEBUG
import Debug.Trace
#endif

getInt = read `fmap` getLine :: IO Int

getInts = (map parseInt . BS8.words) `fmap` BS.getLine
parseInt = fst . fromJust . BS8.readInt

-- returns [l,r,t,b]
getSofa :: IO [Int]
getSofa = do
	[x1,y1,x2,y2] <- getInts
	return [min x1 x2, max x1 x2, min y1 y2, max y1 y2]

main = do
	d <- getInt
	[n,m] <- getInts
	sofas <- replicateM d getSofa
	[cntL,cntR,cntT,cntB] <- getInts
	let sumL = subsumL sofas n
	let sumR = subsumR sofas n
	let sumT = subsumT sofas m
	let sumB = subsumB sofas m
	let feasible [l,r,t,b] =
#ifdef DEBUG
		trace (show (sumL ! (r-1) - (if l == r then 0 else 1),
						sumR ! (l+1) - (if l == r then 0 else 1),
						sumT ! (b-1) - (if t == b then 0 else 1),
						sumB ! (t+1) - (if t == b then 0 else 1))) $
#endif
		(sumL ! (r-1) - (if l == r then 0 else 1)) == cntL &&
		(sumR ! (l+1) - (if l == r then 0 else 1)) == cntR &&
		(sumT ! (b-1) - (if t == b then 0 else 1)) == cntT &&
		(sumB ! (t+1) - (if t == b then 0 else 1)) == cntB
	let answers = [i | (i, sofa) <- zip [1..d] sofas, feasible sofa] :: [Int]
	if length answers == 1
	then print (head answers)
	else print (-1)

subsumL :: [[Int]] -> Int -> Array Int Int
subsumL sofas n = listArray (0,n+1) xs where
	src = [(0,0),(n+1,0)] ++ [(l,1) | [l,_,_,_] <- sofas]
	es = elems $ accumArray (+) 0 (0,n+1) src
	xs = scanl1 (+) es

subsumR :: [[Int]] -> Int -> Array Int Int
subsumR sofas n = listArray (0,n+1) xs where
	src = [(0,0),(n+1,0)] ++ [(r,1) | [_,r,_,_] <- sofas]
	es = elems $ accumArray (+) 0 (0,n+1) src
	xs = (reverse . scanl1 (+) . reverse) es

subsumT :: [[Int]] -> Int -> Array Int Int
subsumT sofas m = listArray (0,m+1) ys where
	src = [(0,0),(m+1,0)] ++ [(t,1) | [_,_,t,_] <- sofas]
	es = elems $ accumArray (+) 0 (0,m+1) src
	ys = scanl1 (+) es

subsumB :: [[Int]] -> Int -> Array Int Int
subsumB sofas m = listArray (0,m+1) ys where
	src = [(0,0),(m+1,0)] ++ [(b,1) | [_,_,_,b] <- sofas]
	es = elems $ accumArray (+) 0 (0,m+1) src
	ys = (reverse . scanl1 (+) . reverse) es

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Array.Unboxed
import Control.Monad

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

solve n m rs tc = maybe (-1) fst $ find (\(_, (x1, y1, x2, y2)) -> (i2cl!(x2 - 1) - fromEnum (x1 /= x2), i2cr!(x1 + 1) - fromEnum (x1 /= x2), i2ct!(y2 - 1) - fromEnum (y1 /= y2), i2cb!(y1 + 1) - fromEnum (y1 /= y2)) == tc') $ zip [(1 :: Int)..] rs'
  where
    tc' = case tc of
      [_1, _2, _3, _4] -> (_1, _2, _3, _4)
    rs' = map (\[x1, y1, x2, y2] -> (min x1 x2, min y1 y2, max x1 x2, max y1 y2)) rs
    els = elems :: UArray Int Int -> [Int]
    bx = (0, n + 1)
    by = (0, m + 1)
    i2cl = listArray bx $ scanl1 (+) $ els $ accumArray (+) 0 bx $ map (\(x1, _, _, _) -> (x1, 1)) rs' :: UArray Int Int
    i2ct = listArray by $ scanl1 (+) $ els $ accumArray (+) 0 by $ map (\(_, y1, _, _) -> (y1, 1)) rs' :: UArray Int Int
    i2cr = listArray bx $ scanr1 (+) $ els $ accumArray (+) 0 bx $ map (\(_, _, x2, _) -> (x2, 1)) rs' :: UArray Int Int
    i2cb = listArray by $ scanr1 (+) $ els $ accumArray (+) 0 by $ map (\(_, _, _, y2) -> (y2, 1)) rs' :: UArray Int Int

main = do
  d <- fmap readInt B.getLine
  [n, m] <- fmap readInts B.getLine
  rs <- replicateM d (fmap readInts B.getLine)
  cs <- fmap readInts B.getLine
  print $ solve n m rs cs


import qualified Data.ByteString.Char8 as BS

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord

import Data.Function
import Data.Maybe

score = BS.count '1'

main = do
  n <- fst . fromJust . BS.readInt <$> BS.getLine
  inp <- replicateM n BS.getLine
  case filter ((>1) . length) . groupBy ((==) `on` (score . snd)) . sortBy (comparing (score . snd)) $ zip [0..] inp of
    [] -> print (-1)
    (((i,a):(j,b):_):_) ->
      let reorderIfBad [i,j,k] | BS.index (inp !! i) j == '1' = [i,j,k]
           | otherwise = [k,j,i]
      in putStrLn $ unwords $ map (show . succ) $ reorderIfBad [i, j, head $ filter
                                                             (\k -> k /= i && k /= j && BS.index a k /= BS.index a j && BS.index b k /= BS.index b i) [0..length inp - 1]]

import qualified Data.ByteString.Char8 as BS

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord

import Data.Function
import Data.Maybe
import Control.Arrow

score = BS.count '1'

main = do
  n <- fst . fromJust . BS.readInt <$> BS.getLine
  inp <- replicateM n BS.getLine
  case filter ((>1) . length) . groupBy ((==) `on` (snd . snd)) . sortBy (comparing (snd . snd)) $ zip [0..] $ map (id &&& score) inp of
    [] -> print (-1)
    (((i,(a,_)):(j,(b,_)):_):_) ->
      let reorderIfBad [i,j,k] | BS.index (inp !! i) j == '1' = [i,j,k]
           | otherwise = [k,j,i]
      in putStrLn $ unwords $ map (show . succ) $ reorderIfBad [i, j, head $ filter
                                                             (\k -> k /= i && k /= j && BS.index a k /= BS.index a j && BS.index b k /= BS.index b i) [0..length inp - 1]]


import Data.Set as S
import Data.List as L

solve :: [Int] -> Int
solve arr = length $ S.fromList arr

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines n [] = []
groupByNLines n arr = (L.take n arr):(groupByNLines n (L.drop n arr))

parse :: [String] -> String
parse [_, input] = show $ solve arr
  where arr = L.map (\x -> read x :: Int) $ words input

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 2 . tail . lines)

module Main where

import Control.Monad
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getIntList
        print $ a --> S.fromList --> S.size

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

(-->) :: a -> (a -> b) -> b
(-->) = flip ($)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        a <- getIntList
        print $ a --> sort --> group --> length

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Data.List

main = getLine >>= test.read
test 0 = return ()
test a = do
  getLine
  as <- map read.words <$> getLine :: IO [Integer]
  print $ length $ group $ sort as
  test (a - 1)

import Control.Monad
import qualified Data.Set as Set

main :: IO ()
main = do
  t <- readLn
  replicateM_ t routine

routine :: IO ()
routine = do
  _ <- getLine
  xs <- (map read.words) <$> getLine
  print $ solve xs

solve :: [Int] -> Int
solve xs = length $ Set.toList $ Set.fromList xs

import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IntSet

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

work :: IO ()
work = do
  _ <- C.getLine
  as <- fmap (map parseInt . C.words) C.getLine
  putStrLn $ show $ IntSet.size $ IntSet.fromList as

main :: IO ()
main = do
  n <- fmap parseInt C.getLine
  replicateM_ n work

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array

onecase = do
		getLine
		a1<- map read <$> words <$> getLine::IO [Int]
		print $  length $ group $ sort a1

main::IO ()
main=do
  	t<- read<$> getLine ::IO Int
	replicateM_ t onecase

import qualified Data.Set  as S (fromList, size)

process :: [Int] -> Int
process = S.size . S.fromList

readInt :: String -> Int
readInt = read

readCases :: [String] -> [[Int]]
readCases (n:as:xs) = map readInt (words as):readCases xs
readCases _ = []

main = do
    t <- fmap readInt getLine
    xs <- fmap (readCases.lines) getContents
    sequence (map print $ map process xs)

import System.IO
import Control.Monad
import Data.List
import qualified Data.Set as S

main :: IO ()
main = do
    getLine
    tc <- (map (map read . words) . filterEvens . lines) <$> getContents :: IO [[Int]]
    let uniqueNums :: [Int]
        uniqueNums = map (S.size . S.fromList) tc
    forM_ uniqueNums print

filterEvens :: [String] -> [String]
filterEvens xs = let ps = zip [1..] xs
                 in map snd . filter (even . fst) $ ps


import Control.Applicative
main = do
    n <- read <$> getLine ::IO Int
    cards <- map read <$> words <$> getLine ::IO [Int]
    putStrLn $ answer n cards where
        answer n cards = unwords $ map show $ result n cards
        split acc1 acc2 [] = [acc2,acc1]
        split acc1 acc2 (x:xs) = split acc2 (x:acc1) xs
        result n cards = map sum $ split [] [] $ find n cards (reverse cards) []
        find 0 _ _ acc = acc
        find n (a:as) (b:bs) acc | a > b     = find (n-1) as (b:bs) (a:acc)
                                 | otherwise = find (n-1) (a:as) bs  (b:acc)

module Main
    where

import Data.List
import System.IO

main = do
    first <- getLine
    second <- getLine
    putStrLn . solve 0 0 True . map read . words $ second
    where
        solve s d _ [] =
            show s ++ " " ++ show d
        solve s d st cards =
            case choose cards of
                (card, rest) ->
                    if st then
                        solve (s + card) d False rest
                    else
                        solve s (d + card) True rest
        choose cards =
            if h < l then
                (l, take (length cards - 1) cards)
            else
                (h, drop 1 cards)
            where
                h = head cards
                l = last cards

main = do
    getLine
    getLine>>=(\x->putStr (solve 0 (map read (words x)) 0 0))
solve n x s1 s2
    |null x             = show s1 ++" "++show s2
    |n==0&&(last x>head x)      = solve 1 (init x) (s1+last x) s2
    |n==0               = solve 1 (tail x) (s1+head x) s2
    |n==1&&(last x>head x)      = solve 0 (init x) s1 (s2+last x)
    |n==1               = solve 0 (tail x) s1 (s2+head x)

main = do
    n <- readLn :: IO Int
    temp <- getLine
    let a = map (read :: String -> Int) $ words temp
    let (x, y) = solve a (0, 0)
    putStrLn ((show x) ++ " " ++ (show y))

solve :: [Int] -> (Int, Int) -> (Int, Int)
solve [] p = p
solve a (x, y) = (j, i)
    where (i, j) = if head a > last a
            then solve (tail a) (y, x + (head a))
            else solve (init a) (y, x + (last a))

import Control.Applicative

solve1 f s []  = (f, s)
solve1 f s lst = if head lst > last lst
                 then solve2 (f + head lst) s (tail lst)
                 else solve2 (f + last lst) s (tail (reverse lst))

solve2 f s []  = (f, s)
solve2 f s lst = if head lst > last lst
                 then solve1 f (s + head lst) (tail lst)
                 else solve1 f (s + last lst) (tail (reverse lst))

solve a = solve1 0 0 a

main = do
  n <- read <$> getLine :: IO Int
  a <- map read <$> (words <$> getLine)
  let (f, s) = solve a
  putStrLn $ (show f) ++ " " ++ (show s)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    step1 (l:ls) (r:rs) (a, b)
      | l == r = (a+l, b)
      | l < r = step2 (l:ls) rs (a+r, b)
      | l > r = step2 ls (r:rs) (a+l, b)
    step2 (l:ls) (r:rs) (a, b)
      | l == r = (a, b+l)
      | l < r = step1 (l:ls) rs (a, b+r)
      | l > r = step1 ls (r:rs) (a, b+l)

    (a, b) = step1 xs (reverse xs) (0, 0)

  putStrLn $ show a ++ " " ++ show b

main = do
  getLine
  getLine >>= (\x -> let (c, d) = f False (map read (words x)) in putStrLn $ show c  ++ " " ++ show d)
f _ [] = (0, 0)
f n x = let (a, b) = if head x < last x then (init x, last x) else (tail x, head x); (c, d) = f (not n) a in if n then (c, d + b) else (c + b, d)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

data Turn = Sereja | Dima deriving(Eq)
main = do
    getLine
    as <- readInts
    let (a,b) = game as
    printf "%d %d\n" a b

game :: [Int] -> (Int,Int)
game l = go Sereja 0 0 l
    where
    go _ a b [] = (a,b)
    go t a b l | t == Sereja = go Dima (a+c) b l'
               | otherwise   = go Sereja a (b+c) l'
        where
        c = max (head l) (last l)
        l' = delete c l

import Data.Array

gameOver :: (Int, Int) -> Bool
gameOver (p1, p2) = p1 > p2

makeTurn :: Array Int Int -> (Int, Int) -> ((Int, Int), Int)
makeTurn arr (p1, p2)
    | (arr ! p1) > (arr ! p2) = ((p1 + 1, p2), arr ! p1)
    | otherwise = ((p1, p2 - 1), arr ! p2)

data GameState = GameState { leftPtr :: Int, rightPtr :: Int, score1 :: Int, score2 :: Int } deriving (Show)

play :: Array Int Int -> GameState -> GameState
play arr state = if gameOver (leftPtr state, rightPtr state) then state else
                let ((leftPtr', rightPtr'), deltaScore1) = makeTurn arr (leftPtr state, rightPtr state) in
                let state' = GameState leftPtr' rightPtr' (score1 state + deltaScore1) (score2 state) in
                if gameOver (leftPtr state', rightPtr state') then state' else
                let ((leftPtr'', rightPtr''), deltaScore2) = makeTurn arr (leftPtr state', rightPtr state') in
                let state'' = GameState leftPtr'' rightPtr'' (score1 state + deltaScore1) (score2 state + deltaScore2) in
                state''

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap (fmap read) (fmap words getLine) :: IO [Int]
    let arr = listArray (1, n) li
    let res = iterate (play arr) (GameState 1 n 0 0) !! 1001
    putStrLn $ (show $ score1 res) ++ " " ++ (show $ score2 res)

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (_:xs) = go (0, 0, True) xs
  where go (a, b, _) [] = [a, b]
        go (a, b, c) as | c && head as > last as = go (a + head as, b, not c) (tail as)
                        |      head as > last as = go (a, b + head as, not c) (tail as)
                        | c                      = go (a + last as, b, not c) (init as)
                        | otherwise              = go (a, b + last as, not c) (init as)
solve _ = undefined

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . tail . words

solve :: [Int] -> [Int]
solve = go (0, 0, True)
  where go (a, b, _) [] = [a, b]
        go (a, b, c) as | c && head as > last as = go (a + head as, b, not c) (tail as)
                        |      head as > last as = go (a, b + head as, not c) (tail as)
                        | c                      = go (a + last as, b, not c) (init as)
                        | otherwise              = go (a, b + last as, not c) (init as)

import qualified Data.Sequence as S
main = interact $ unwords . map show . solve . map read . tail . words
solve = go . S.fromList where
  go s | S.null s  =                      [0 , 0]
       | l > r     = let [a,b] = go l' in [l+b,a]
       | otherwise = let [a,b] = go r' in [r+b,a]
    where (l S.:< l') = S.viewl s
          (r' S.:> r) = S.viewr s

#!/usr/bin/env runghc
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c1:c2:cs) = (:solve cs)$ unwords . map show $ s (read c1) True n (reverse n) (0,0)
  where n = map read . words $ c2
s c t n1s n2s (s1,s2)
  | c==0 = [s1,s2]
  | t = s (c-1) (not t) nn1 nn2 (s1+n,s2)
  | otherwise = s (c-1) (not t) nn1 nn2 (s1,s2+n)
  where
    n1 = head n1s
    n2 = head n2s
    (n,nn1,nn2) = if n1>n2 then (n1,tail n1s,n2s) else (n2,n1s,tail n2s)

import Control.Applicative
import Data.List

process [] x y _ = show x ++ " " ++ show y
process s x y 1 | last s >head s = process (init s) (x+last s) y 2
		| otherwise = process (tail s) (x+head s) y 2
process s x y 2 | last s >head s = process (init s) x (y+last s)   1
		| otherwise = process (tail s) x (y+head s)   1

main= do
	s<-  getLine
	n<- map read. words <$> getLine::IO [Int]
	putStrLn $ process n 0 0 1

process :: [Int] -> (Int,Int)
process xs = f xs (reverse xs) (length xs)
    where
        f _ _ 0 = (0,0)
        f (l:ls) (r:rs) n
            | l > r =
                let (s2,s1) = f ls (r:rs) (n-1)
                in (l+s1,s2)
            | otherwise =
                let (s2,s1) = f (l:ls) rs (n-1)
                in (r+s1,s2)

readInt :: String -> Int
readInt = read

main = do
    n <- fmap readInt getLine
    xs <- fmap (map readInt.words) getLine
    let (s1,s2) = process xs
    putStrLn $ show s1 ++ " " ++ show s2

main = do
    (_:a) <- fmap (map read . words) getContents :: IO [Int]
    putStrLn $ unwords $ map show (f a 0)
f [] _ = [0, 0]
f xs t = if t == 0 then [a+mx, b] else [a, b+mx] where
    front = head xs
    back = last xs
    mx = max front back
    [a, b] = f (if front > back then (tail xs) else (init xs)) (1 - t)

import Data.List (sort)

main = do
    n <- readLn :: IO Int
    temp <- getLine
    let a = reverse . sort $ map (read :: String -> Int) $ words temp
    let (x, y) = solve a (0, 0)
    putStrLn ((show x) ++ " " ++ (show y))

solve :: [Int] -> (Int, Int) -> (Int, Int)
solve [] p = p
solve a (x, y) = (j, i)
    where (i, j) = solve (tail a) (y, x + (head a))

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C

main= do
	s<-  C.tail. C.take 3 . C.reverse .C.filter (/=' ') <$> C.getLine
	let s1 = read (reverse (C.unpack s)) ::Int
	print $ if mod s1 4 ==0 then 4 else 0


import Control.Monad (liftM, replicateM)
import Data.Array ((!), listArray)
import Data.List (intercalate)
import Prelude hiding (reads)

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

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

type Point  =  [Integer]

symmetric :: Point -> Point -> Point
symmetric [x0, y0] [x, y]  =  [2*x0 - x, 2*y0 - y]

genPoints :: Integer -> Integer -> Point -> [Point] -> [Point]
genPoints n start m0 as  =  map fst $ iterate next (m0, start)
  where
    array  =  listArray (0, n-1) as
    next (a, i)  =  (symmetric (array ! i) a, if i+1 == n then 0 else i+1)

solve :: Integer -> Integer -> Point -> [Point] -> Bool -> Point
solve 1 j m0 ps p
  | odd j  =  symmetric (head ps) m0
  | otherwise  =  m0
solve n j m0 ps p
  | j < 2*n || p =  head $ drop (fromIntegral j) $ genPoints n 0 m0 ps
  | odd n  =  head $ drop (fromIntegral (mod j (2*n))) $ genPoints n 0 m0 ps
  | otherwise  =  head $ drop (fromIntegral (mod j n)) $ genPoints n 0 [mjx, mjy] ps
  where
    mn  =  head $ drop (fromIntegral n) $ genPoints n 0 m0 ps
    [m0x, m0y]  =  m0
    [mnx, mny]  =  mn
    mjx  =  m0x + (mnx - m0x) * (div j n)
    mjy  =  m0y + (mny - m0y) * (div j n)

main :: IO ()
main  =  do
    [n, j]  <-  reads
    m0  <-  reads
    ps  <-  replicateM (fromIntegral n) reads
    --prints $ solve n j m0 ps True
    prints $ solve n j m0 ps False

import Control.Monad
import Control.Applicative
import Data.Maybe
import qualified Data.ByteString.Char8 as B

getNums = do
  [a, b] <- map (fst . fromJust . B.readInteger) . B.words <$> B.getLine
  return (a :: Integer, b :: Integer)

move (mx, my) (ax, ay)= (ax*2-mx, ay*2-my)

main = do
  (n, j) <- getNums
  (m0 : as) <- replicateM (fromIntegral n+1) getNums
  j <- return $ j `mod` (2*n)
  let (rx, ry) = foldl move m0 $ take (fromIntegral j) $ cycle as
  putStrLn $ show rx ++ " " ++ show ry

import Control.Monad
import Control.Applicative

getNums = do
  [a, b] <- map read . words <$> getLine
  return (a, b)

move (mx, my) (ax, ay)= (ax*2-mx, ay*2-my)

main = do
  (n, j) <- getNums
  (m0 : as) <- replicateM (n+1) getNums
  j <- return $ j `mod` (2*n)
  -- print $ scanl move m0 $ take (j+1) $ cycle as
  let (rx, ry) = foldl move m0 $ take j $ cycle as
  putStrLn $ show rx ++ " " ++ show ry

import Control.Monad (liftM, replicateM)
import Data.Array ((!), listArray)
import Data.List (intercalate)
import Prelude hiding (reads)

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

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

type Point  =  [Integer]

symmetric :: Point -> Point -> Point
symmetric [x0, y0] [x, y]  =  [2*x0 - x, 2*y0 - y]

genPoints :: Integer -> Integer -> Point -> [Point] -> [Point]
genPoints n start m0 as  =  map fst $ iterate next (m0, start)
  where
    array  =  listArray (0, n-1) as
    next (a, i)  =  (symmetric (array ! i) a, if i+1 == n then 0 else i+1)

solve :: Integer -> Integer -> Point -> [Point] -> Point
solve 1 j m0 ps
  | odd j  =  symmetric (head ps) m0
  | otherwise  =  m0
solve n j m0 ps
  | j < n  =  head $ drop (fromIntegral j) $ genPoints n 0 m0 ps
  | otherwise  =  head $ drop (fromIntegral (mod j n)) $ genPoints n 0 [mjx, mjy] ps
  where
    mn  =  head $ drop (fromIntegral n) $ genPoints n 0 m0 ps
    [m0x, m0y]  =  m0
    [mnx, mny]  =  mn
    mjx  =  m0x + (mnx - m0x) * (div j n)
    mjy  =  m0y + (mny - m0y) * (div j n)

main :: IO ()
main  =  do
    [n, j]  <-  reads
    m0  <-  reads
    ps  <-  replicateM (fromIntegral n) reads
    prints $ solve n j m0 ps


import Control.Monad
makePairs x y sindex desired vindex available =
  if null desired || null available
  then []
  else if head desired - x > head available
       then makePairs x y sindex desired (vindex+1) (tail available)
       else if head desired + y < head available
            then makePairs x y (sindex+1) (tail desired) vindex available
            else (sindex, vindex) : makePairs x y (sindex+1) (tail desired) (vindex+1) (tail available)
main = do
  [n,m,x,y] <- (liftM $ (map read) . words) getLine
  desired <- (liftM $ (map read) . words) getLine
  available <- (liftM $ (map read) . words) getLine
  let pairs = makePairs x y 1 desired 1 available
  putStrLn . show $ length pairs
  mapM_ (\(soldier, vest) -> putStrLn $ show soldier ++ " " ++ show vest) pairs

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Data.List
import Debug.Trace
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

solve :: Int -> Int -> [(Int, Int)] -> [(Int, Int)] -> [(Int, Int)]
solve _ _ [] _ = []
solve _ _ _ [] = []
solve x y ps@((i, p):ps') qs@((j, q):qs')
    | q < p-x = solve x y ps qs'
    | q > p+y = solve x y ps' qs
    | otherwise = (i, j) : solve x y ps' qs'

main = do
    [_, _, x, y] <- map atoi . B.words <$> B.getLine
    ps <- (zip [1..]) . map atoi . B.words <$> B.getLine
    qs <- (zip [1..]) . map atoi . B.words <$> B.getLine
    let as = solve x y ps qs
    putStrLn . show $ length as
    forM_ as $ uncurry (printf "%d %d\n")

import List

bigTest n = foldr (\n s -> show n ++ " " ++ s) "" [1..n] ++ "\n" ++ foldr (\n s -> show n ++ " " ++ s) "" (reverse [1..n])

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

mySort :: [Int] -> [(Int, Int)]
mySort xs  =  sortBy (\x y -> compare (snd x) (snd y)) (zip [1..] xs)

solve :: (Int, Int) -> [Int] -> [Int] -> [(Int, Int)]
solve (x, y) as bs  =  solve' (mySort as) (mySort bs) []
  where
    solve' [] _ acc  =  acc
    solve' _ [] acc  =  acc
    solve' ((i, a):as) ((j, b):bs) acc
      | a - x > b  =  solve' ((i, a):as) bs acc
      | a + y < b  =  solve' as ((j, b):bs) acc
      | otherwise  =  solve' as bs ((i, j):acc)

printAns :: [(Int, Int)] -> IO ()
printAns  ans  =  print (length ans) >> mapM_ (\(x, y) -> putStrLn (show x ++ " " ++ show y)) ans

main :: IO ()
main  =  do
    [n, m, x, y] <- Main.reads
    as <- Main.reads
    bs <- Main.reads
    printAns $ solve (x, y) as bs

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Control.Monad
import Data.List

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
solve [] _  x y = []
solve _  [] x y = []
solve a0@((a, ia):as) b0@((b, ib):bs) x y | a + y < b                = solve as b0 x y
solve a0@((a, ia):as) b0@((b, ib):bs) x y | a - x <= b && b <= a + y = (ia, ib) : solve as bs x y
solve a0@((a, ia):as) b0@((b, ib):bs) x y | b < a - x                = solve a0 bs x y

readInt = fst . fromJust . BS.readInt

main = do
    [n, m, x, y] <- liftM (map readInt . BS.words) BS.getLine
    as <- liftM (map readInt . BS.words) BS.getLine
    bs <- liftM (map readInt . BS.words) BS.getLine

    let ans = solve (sort $ zip as [1..]) (sort $ zip bs [1..]) x y

    print . length $ ans
    forM_ ans $ \(x, y) -> putStrLn $ show x ++ " " ++ show y

import Data.List

loop :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)] ->  [(Int, Int)]
loop [] _ _ _ acc = acc
loop _ [] _ _ acc = acc
loop vV@((v, vi):vs) sS@((s, si):ss) lo hi acc
     | s + hi >= v && s - lo <= v  = loop vs ss lo hi ((si, vi):acc)
     | s + hi < v                  = loop vV ss lo hi acc
     | s - lo > v             = loop vs sS lo hi acc

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
solve vests solds lo hi =
    loop (sort vests) (sort solds) lo hi []

parse :: [(Int, Int)] -> String
parse l = unlines $ map (\(a, b) -> (show b) ++ " " ++ (show a)) l

main = do
  [_, _, lo, hi] <- (getLine >>= return . map (read::String->Int) . words)
  vests <- (getLine >>= return . map (read::String->Int) . words)
  solds <- (getLine >>= return . map (read::String->Int) . words)
  let ss = solve (zip vests [1..]) (zip solds [1..]) hi lo
  print $ length ss
  putStrLn $ parse ss

import Data.List

loop :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)] ->  [(Int, Int)]
loop [] _ _ _ acc = acc
loop _ [] _ _ acc = acc
loop vV@((v, vi):vs) sS@((s, si):ss) lo hi acc
     | s + hi >= v && s - lo <= v  = loop vs ss lo hi ((si, vi):acc)
     | s + hi < v                  = loop vV ss lo hi acc
     | s - lo > v             = loop vs sS lo hi acc

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
solve vests solds lo hi =
    loop (sort vests) (sort solds) lo hi []

parse :: [(Int, Int)] -> String
parse l = unlines $ map (\(a, b) -> (show b) ++ " " ++ (show a)) l

main = do
  [_, _, lo, hi] <- (getLine >>= return . map (read::String->Int) . words)
  vests <- (getLine >>= return . map (read::String->Int) . words)
  solds <- (getLine >>= return . map (read::String->Int) . words)
  let ss = solve (zip vests [1..]) (zip solds [1..]) lo hi
  print $ length ss
  putStrLn $ parse ss

import Data.List

loop :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)] ->  [(Int, Int)]
loop [] _ _ _ acc = acc
loop _ [] _ _ acc = acc
loop vV@((v, vi):vs) sS@((s, si):ss) lo hi acc
     | s + hi >= v && s - lo <= v  = loop vs ss lo hi ((si, vi):acc)
     | s + hi < v                  = loop vV ss lo hi acc
     | s - lo > v             = loop vs sS lo hi acc

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
solve vests solds lo hi =
    loop (sort vests) (sort solds) lo hi []

parse :: [(Int, Int)] -> String
parse l = unlines $ map (\(a, b) -> (show a) ++ " " ++ (show b)) l

main = do
  [_, _, lo, hi] <- (getLine >>= return . map (read::String->Int) . words)
  vests <- (getLine >>= return . map (read::String->Int) . words)
  solds <- (getLine >>= return . map (read::String->Int) . words)
  let ss = solve (zip vests [1..]) (zip solds [1..]) lo hi
  print $ length ss
  putStrLn $ parse ss