import Data.List

type Answer = (Int, Int)

findNumbers :: [Int] -> Answer
findNumbers divisors = getNumbers $ reverse $ sort divisors

getNumbers :: [Int] -> Answer
getNumbers [] = (0, 0)
getNumbers (x:y:rest) = if x == y
                        then (x, y)
                        else findAnother (x:y:rest) x

findAnother :: [Int] -> Int -> Answer
findAnother divisors x = (last rest, x)
    where xDivisors = removeDuplicates (filter (\y -> x `mod` y == 0) divisors)
          rest = sort (divisors \\ xDivisors)

removeDuplicates :: [Int] -> [Int]
removeDuplicates list = removeDuplicates' list []

removeDuplicates' :: [Int] -> [Int] -> [Int]
removeDuplicates' [] result = result
removeDuplicates' (first:rest) result = if elem first result
                                        then removeDuplicates' rest result
                                        else removeDuplicates' rest (first:result)

main :: IO ()
main = do
    _ <- getLine
    list <- getLine
    let divisors = map read (words list)
    let (x, y) = findNumbers divisors
    putStr ((show x) ++ " " ++ (show y))


main = print . solve =<< getLine
solve "" = 0 -- seriously?
solve "0" = 0
solve ('1' : ns) = (length ns + 1 + if any (== '1') ns then 1 else 0) `div` 2


{-# 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
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	n <- readInt
	s <- getLine
	let
		zeros = length $ filter ( == '0' ) s
		ones = n - zeros
	if zeros == ones
		then do
			print 2
			putStrLn $ unwords $ [ [ head s ], tail s ]
		else do
			print 1
			putStrLn s


import Text.ParserCombinators.Parsec
import Control.Applicative hiding (optional, (<|>))

main = do
    jID <- return . (parse jabberID "<stdin>") =<< getLine
    case jID   of
	Left _	    -> putStr "NO"
	Right id    -> putStr "YES"

jabberID = do
    username
    char '@'
    hostname
    optional $ char '/' >> resource
    eof

username = do
    str <- many1 unchar
    if length str <= 16
    then return ()
    else fail "USER NAME"

unchar = letter <|> digit <|> char '_'

hostname = do
    ws <- wordpart `sepBy1` char '.'
    let l =			   (+)
	    <$> sum . (length <$>) <*> subtract 1 . length
	     $			    ws
    if l <= 32
    then return ()
    else fail "HOST NAME"

wordpart = do
    word <- many1 unchar
    if length word <= 16
    then return word
    else fail "Word Part"

resource = do
    str <- many1 unchar
    if length str <= 16
    then return ()
    else fail "RESOURCE"


import Char

getP = do
	[x, y] <- getLine
	return (ord x - 96, digitToInt y)
main = do
	(a, b) <- getP
	(c, d) <- getP
	putStrLn $ show $ sum [1 | i <- [1 .. 8], j <- [1 .. 8], i /= a, j /= b, i /= c || j /= d,
		and [z /= (a, b) && z /= (c, d) | x <- [-2 .. 2], y <- [-2 .. 2], abs x + abs y == 3, z <- [(i + x, j + y)]]]


import Data.List
main = interact $ show. gao. head. words
gao x = sum . map (cal. length) . group $ x
cal x = x `div` 5 + if (x `mod` 5 == 0) then 0 else 1


closestGreater :: Integer -> Integer -> Integer
closestGreater n m = if 2 ^ m > n then m
	else closestGreater n (m+1)

main :: IO ()
main = do
       nos_temp <- getLine
       let nos = map (\x -> read x :: Integer) $ words nos_temp
       let n = nos!!0
           k = nos!!1
       print $ if k==1 then n
       	else 2 ^ (closestGreater n 0) - 1


main = interact $ f . map read . words
f [w,m] | w <= 3 || (foldr g m . takeWhile (<m) $ iterate ((+1).(*w)) 0) == 0 = "YES"
        | otherwise = "NO"
        where g x m | m <= x = m
                    | m > x = abs $ x * w + 1 - x - m


{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Control.Applicative((<$>))
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
foreign import ccall "stdio.h scanf"
        scanf :: CString -> Ptr CInt -> IO ()
foreign import ccall "stdio.h puts"
        c_puts :: CString -> IO ()
scanInt :: IO Int
scanInt = do alloca $ \i -> do
               format <- newCString "%d"
               scanf format i
               free format
               fromEnum <$> peek i
puts :: String -> IO ()
puts str = do str' <- newCString str
              c_puts str'
              free str'

main = do n <- scanInt
          (puts.show) ((div n 2)*3)


main :: IO ()
main =
  do
    s <- getLine
    n <- getLine
    putStrLn $ show $ (\(x, y) -> x + y * 10) $ foldl (\(acc1, acca) x -> if x == '1' then (acc1 + 1, acca) else (0, acca * 10 + acc1)) (0, 0) n


import Data.Array

main = do
    strLength <- readIntegers
    string <- getLine
    let solution = solve string (strLength!!0) 1
    putStrLn $ solution

solve :: String -> Int -> Int -> String
solve string 0 _ = ""

solve string strlen removeLen = [head string] ++  (solve shortString newLength (removeLen+1))
        where shortString = drop removeLen string
              newLength = length shortString

matchAndDrop :: String -> Char -> String
matchAndDrop string character = dropWhile (== character) string

readIntegers :: IO [Int]
readIntegers = fmap (map read.words) getLine


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

solve [n,1,a,b] = a * (n - 1)
solve [n,k,a,b] = result n 0
    where result 1 ans = ans
          result x ans
              | x < k = result 1 $ ans + a * (x - 1)
              | r > 0 = result (x - r) $ ans + a * r
              | otherwise = if a * (x - d) > b
                            then result d $ ans + b
                            else result d $ ans + a * (x - d)
              where (d,r) = divMod x k


module Main where

import Data.Array.Unboxed
import Data.List
import Control.Monad
import Data.Ix

main = do
    [n, m] <- liftM (map read . words) getLine
    board <- liftM (listArray ((1,1),(n,m)) . join) $ replicateM n getLine :: IO (UArray (Int,Int) Char)

    let res = length $
            filter (\(r,c) ->
                    any (\pos -> board ! pos == 'P') $
                    filter valid $
                    [(r-1,c)
                    ,(r+1,c)
                    ,(r,c-1)
                    ,(r,c+1)
                    ]
                ) $
            filter (\pos -> board ! pos == 'W')
            (range ((1,1),(n,m)))
        valid = inRange ((1,1),(n,m))

    putStrLn $ show res


solve scale ws | z >= diff && (z - diff) `mod` 2 == 0 = xs2 ++ "|" ++ ys2
               | otherwise                            = "Impossible"
    where
        (ls, rs) = break (=='|') scale
        x = length ls
        y = length $ tail rs
        diff = abs(x - y)
        z = length ws
        xs = if x < y then ls ++ take diff ws else ls
        ys = if y < x then tail rs ++ take diff ws else tail rs
        ws2 = drop diff ws
        n = length ws2 `div` 2
        xs2 = if n > 0 then xs ++ take n ws2 else xs
        ys2 = if n > 0 then ys ++ drop n ws2 else ys

main = do
    scale <- getLine
    ws <- getLine
    putStrLn $ solve scale ws


import Data.Char
main = do
  n <- readLn
  t <- fmap (map digitToInt) getLine
  let (a,b) = splitAt (n `div` 2) t
  putStrLn $ if all lucky t && sum a == sum b
             then "YES"
             else "NO"
lucky 4 = True
lucky 7 = True
lucky _ = False


disjoint :: Eq a => [a] -> [a] -> Integer
disjoint [] [] = 0
disjoint (x:xs) (y:ys) = if x /= y then 1 + disjoint xs ys else disjoint xs ys

solve :: String -> Bool
solve s = (l `mod` 2 == 1 && c == 0) || (1 <= c && c <= 2) where
  l = length s
  c = disjoint s $ reverse s

main = do
  s <- getLine
  if solve s then
    putStrLn "YES"
  else
    putStrLn "NO"


{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

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

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

getInts :: IO [Int]
getInts = map readInt . words <$> getLine

-- nie numerujemy od zera
solve :: Integer -> Integer
solve n = (solve' n 1 0)
solve' n l acc =
  if n >= ile l
  then solve' (n - ile l) (l + 1) (acc + (l * ile l))
  else n * l + acc

ile x = 9 * (10 ^ (x - 1))

main = do
  [n] <- getInts
  print (solve (toInteger n))


import Control.Monad
import Data.Array
import Data.Bits
import Data.List

main = do
  [x0, y0] <- fmap (map read . words) getLine
  n <- fmap read getLine
  (x,y) <- fmap (unzip . map ((\[xs,ys] -> (xs,ys)) . map read . words)) $ replicateM n getLine
  let d = array ((0,0), (n-1,n-1))
          [((i,j), dist (x!!i) (y!!i) (x!!j) (y!!j)) | i <- [0..n-1], j <- [0..n-1]]
      dist xi yi xj yj = hypot2 xi yi x0 y0 + hypot2 xj yj x0 y0 - hypot2 xi yi xj yj
      hypot2 x1 y1 x2 y2 = (x2-x1)*(x2-x1) + (y2-y1)*(y2-y1)
      mx :: Int
      mx = (1 `shift` n) - 1
      dp = array (0,mx) [(mask, f mask) | mask <- [0..mx]]

      getBits mask = filter (testBit mask) [0..n-1]

      f 0 = (0, -1, -1)
      f mask = case getBits mask of
          [b] -> (0, -1, -1)
          (b:bs) -> let
            cases = [(d!(b,i) + next, b, i) | i<-bs, let (next, _, _) = dp!(mask `clearBit` b `clearBit` i)]
            in maximum ((dp!(mask `clearBit` b)):cases)

      path = takeWhile (>=0) $ iterate step mx
      step mask =
        if i >= 0
          then mask `clearBit` i `clearBit` j
          else -1
       where (_, i, j) = dp!mask

      (best, _, _) = dp!mx
      time = 2 * sum [hypot2 x1 y1 x0 y0 | (x1,y1) <- zip x y] - best

      res1 = concatMap segment . zipWith xor path $ tail path
      segment diff = [0, i+1, j+1]
       where [i,j] = getBits diff

      res2 = concatMap (:[0]) . map (+1) . getBits $ last path

  print time
  putStrLn . unwords . map show $ res1 ++ [0] ++ res2


import Data.Ratio
type LatticePos = (Int,Int)
type Triangle = (LatticePos, LatticePos, LatticePos)
main = do
    token <- return . words =<< getContents
    let x1:y1:x2:y2:x3:[y3] = read `map` take 6 token
	triangle = (p1,p2,p3)
	p1 = (x1,y1)
	p2 = (x2,y2)
	p3 = (x3,y3)
	isRight t@(p1,p2,p3) = isTriangle t  && any right [(p1,p2,p3), (p2,p3,p1), (p3,p1,p2)]
	    where
		isTriangle (p1@(x1,y1),p2@(x2,y2),p3@(x3,y3)) =
		    if p1/=p2 && p2/=p3 && p3/=p1
			then if x3/=x1
				then (fromIntegral y2)-(fromIntegral y1) /= (x2-x1)*((fromIntegral y3)-y1)%(x3-x1)
				else x1/=x2
			else False
		right ((x1,y1),(x2,y2),(x3,y3)) =
		    (x1-x2)*(x3-x2) + (y1-y2)*(y3-y2) == 0
    if isRight triangle
	then putStr "RIGHT"
	else if any isRight $ shifts triangle
	    then putStr "ALMOST"
	else putStr "NEITHER"
	where
	    shifts t = concat [shift1x t, shift1y t, shift2x t, shift2y t, shift3x t, shift3y t]

shift1x, shift2x, shift3x,
    shift1y, shift2y, shift3y::Triangle -> [Triangle]
shift1x ((x,y),p2,p3) = (\x'->return ((x',y),p2,p3)) =<< [x-1,x+1]
shift1y ((x,y),p2,p3) = (\y'->return ((x,y'),p2,p3)) =<< [y-1,y+1]

shift2x (p1,(x,y),p3) = (\x'->return (p1,(x',y),p3)) =<< [x-1,x+1]
shift2y (p1,(x,y),p3) = (\y'->return (p1,(x,y'),p3)) =<< [y-1,y+1]

shift3x (p1,p2,(x,y)) = (\x'->return (p1,p2,(x',y))) =<< [x-1,x+1]
shift3y (p1,p2,(x,y)) = (\y'->return (p1,p2,(x,y'))) =<< [y-1,y+1]


--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

digprod :: Int -> Int
digprod n = product $ map ((subtract 48) . ord) $ show n

solve a = f n
  where
    !n = head a
    f 0 = 1
    f m
      | m < 10 = m
      | otherwise = max (digprod m) $ 9 * f (pred $ (div m 10))

main :: IO ()
main = print . solve . map ri . C.words =<< C.getContents


months = ["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"]

-- 13月以降の場合は来年として、1月からに戻す。
nextYear x
  | x > 12 = if x `mod` 12 == 0 then 12 else x `mod` 12
  | otherwise = x

search elem list = search' elem list 0
  where
    search' elem [] index = index
    search' elem (x:xs) index = if elem == x
                                  then index
                                  else search' elem xs (index + 1)

main = do current <- getLine
          appear <- getLine
          putStrLn $ months !! (nextYear ((search current months + 1) + read appear) - 1)


xmod::Integer->Integer
xmod n = n `mod` (4*1000000007)

p3::Integer->Integer
p3 0 = 1
p3 n | n `mod` 2 == 0
		= let
		k = n `div` 2
		x = p3 k
		in  xmod (x*x)
p3 n | n `mod` 2 == 1
		= let
		k = n `div` 2
		x = p3 k
		in xmod (3*x*x)

frb2::Integer->Integer
frb2 n | n `mod` 2 == 1
		= let
		k = n `div` 2
		in
		(p3 (k+1)) - 1
frb2 n | n `mod` 2 == 0
		= let
		k = n `div` 2
		in
		2 * (p3 k - 1)

frb::Integer->Integer
frb 0 = 0
frb 1 = 2
frb n = (frb2 n) +  (frb2 (n-1))

fbw::Integer->Integer
fbw 0 = 0
fbw n = 2 + 2*frb (n-1)

fs::Integer->Integer
fs 0 = 0
fs 1 = 4
fs 2 = 4
fs n | n `mod` 2 == 1
		= let
		k = n `div` 2
		in
		2*(frb k) + 3*(fbw k) `div` 2 +  5
fs n = fs (n-1)

fall::Integer->Integer
fall n = (frb n) + (fbw n)

f::Integer->Integer
f 0 = 0
f 1 = 4
f n = 	let
		s = (fs n)
		all = (fall n)
		in
		xmod (s + ((all - s) `div` 2))

solve::[Integer]->Integer
solve [l,r] =  ((f r) - (f (l-1))) `mod` (1000000007)

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


import Control.Applicative
import Control.Monad

main = sol <$> readLn >>= print

sol n
    | m*m == n      = 4*m
    | m*(m+1) >= n  = 2*(2*m+1)
    | otherwise     = 4*(m+1)
    where
    m = floor . sqrt $ fromIntegral n


{-# 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
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	[ n, m ] <- readInts
	print $ if
		| m <= 1 -> 1
		| m <= n `div` 2 -> m
		| otherwise -> n `div` 2 - ( m - n `div` 2 ) + n `mod` 2


main = do
    [n_, k_] <- return . map (read::String->Integer) . words =<< getLine
    let bSearch n k = let v = k - 2^(n-1)
			in if v==0 then n
			    else if 0<v then bSearch (n-1) v
			    else bSearch (n-1) k
    print $ bSearch n_ k_


len 0 = 0
len 1 = 1
len a = 1 + 2 * len (div a 2)
pre :: Integer -> Integer -> Integer
pre _ 0 = 0
pre 0 _ = 0
pre n r
  | r <= len q     = pre q r
  | r == len q + 1 = q + m
  | otherwise      = q + m + pre q (r - len q - 1)
  where q = div n 2
        m = mod n 2
main = do
  n:l:r:[] <- getLine >>= return. map read. words :: IO [Integer]
  print $ pre n r - pre n (l - 1)


main = do
  _ <- getLine
  input <- getLine
  putStrLn (solve input)

solve :: String -> String
solve "0" = "0"
solve s   = '1' : filter (=='0') s


solve :: Integer -> Integer -> Integer
solve m b = foldl max' 0 [0..b]
  where
    max' a h = max a $ div (let w = m*(b-h) in w*(w+1)*(h+1) + h*(h+1)*(w+1)) 2

main = do
  line <- getLine
  let m = read (head $ words line) :: Integer
  let b = read (head $ tail $ words line) :: Integer
  putStr $ show $ solve m b


main = getLine >>= putStrLn . show . count . parseInput

parseInput :: String -> (Int, Int)
parseInput str = (read n, read m)
  where [n, m] = words str

count :: (Int, Int) -> Int
count (n, m)
  | n == m = 0
  | m < n = n - m
  | otherwise = go n 0
  where m' = fromIntegral m
        go n ans = if n == m
                then ans
                else go target (ans + hits)
          where n' = fromIntegral n
                target = findTarget m'
                findTarget currentTarget = if nextTarget <= n'
                                    then ceiling currentTarget
                                    else findTarget nextTarget
                  where nextTarget = currentTarget * 0.5
                lowerTarget = (ceiling $ (fromIntegral target) * 0.5 :: Int)
                backwards = (n - lowerTarget) + (lowerTarget + lowerTarget - target) + 1
                forwards = n + n - target + 1
                hits = min backwards forwards


import Control.Applicative

solve s v1 v2 t1 t2
  | first < second = "First"
  | first > second = "Second"
  | otherwise = "Friendship"
  where first = calTime s v1 t1
        second = calTime s v2 t2
        calTime s v t = 2 * t + v * s

main = do
  (s:v1:v2:t1:t2:_) <- map read <$> words <$> getLine :: IO [Int]
  putStrLn $ solve s v1 v2 t1 t2


{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

process :: [Int] -> Int
process xs = if nPos >= half then 1 else if nNeg >= half then -1 else 0 where
    half = ceiling $ fromIntegral (length xs) / 2
    nPos = length $ filter (0 <) xs
    nNeg = length $ filter (0 >) xs

main = do
    n <- getInt
    xs <- getInts
    print $ process xs


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

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

main :: IO ()
main = do
  [x1,y1,x2,y2] <- getInts
  [x,y] <- getInts
  let  dx = x1 - x2
       dy = y1 - y2
       xx = steps (x1 - x2) x
       yy = steps (y1 - y2) y
       xy = (-) <$> xx <*> yy
       res  = zeros dx x && isJust xx ||
              zeros dy y && isJust yy ||
              maybe False even xy
  putStrLn  (if res then "YES" else "NO")
  where steps 0 0 = Just 0
        steps _ 0 = Nothing
        steps x y | mod x y == 0 = Just $  quot x y
                  | otherwise    = Nothing
        zeros x y = x == 0 && y == 0


module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

import qualified Data.Array as Array
import qualified Data.Set as Set
import qualified Data.List as List
import qualified Data.Map as Map

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [Int]
readInts = map parse . C8.words
  where parse s = let Just (x,_) = C8.readInt s in x

main :: IO ()
main = do
  n <- fmap read getLine
  let denominations = reverse [1, 5, 10, 20, 100]
      bills = foldl (\(total, remaining) bill -> let
                        (count, remaining') = divMod remaining bill
                        in (total + count, remaining'))
              (0, n) denominations
  print $ fst bills


import Data.List (sort)

main = interact (show . length . pile . map read . words . (!! 1) . lines)

pile = foldr add [] . reverse . sort

add y [] = [[y]]
add y (x:xs)
  | canAdd y x = (y:x):xs
  | otherwise  = x:add y xs
  where canAdd y x = y >= length x


main = interact $ (++"\n") . go . read
  where
    go :: Integer -> String
    go n = concatMap (uncurry replicate) $ zip (map fromInteger $ replicate less (max-1) ++ (replicate (10-less) max)) "codeforces"
      where
        max = bs n 0 100
        less = head $ filter (\x -> (max-1)^x * max^(10-x) >= n) [9,8..0]

    bs t lo hi | lo + 1 >= hi = hi
               | m^10 < t     = bs t m hi
               | otherwise    = bs t lo m
      where
        m = lo + ((hi - lo) `div` 2)


main = do
    (y:x:_) <- fmap (map read . words) getLine :: IO [Integer]
    let m = x - 1
    let n = (y-x+1) `div` 2
    putStrLn (if (y-x+1) `mod` 2 /= 0 || (n >= 1 && m < 1) || n < 0 || m < 0 then "No" else "Yes")


import Control.Applicative
import Control.Monad

main :: IO ()
main = putStrLn . unwords . fmap show =<< sol <$> readLn

sol :: (Integral a, Integral b) => a -> [b]
sol n
  | n==2^p    = [p+1]
  | otherwise = (p+1):sol (n - 2^p)
  where
  p = floor (log (fromIntegral n)/log 2)


main :: IO ()
main = do
    nStr <- getLine
    numsStr <- getLine
    let
        n = read nStr :: Int
        nums = [read x :: Int | x <- words numsStr]
    putStrLn (show (max (maxDifficulty nums) (minSkippingDifficulty nums)))

maxDifficulty :: [Int] -> Int
maxDifficulty (x:y:[]) = y - x
maxDifficulty (x:y:rest) = max (y - x) (maxDifficulty (y:rest))

minSkippingDifficulty :: [Int] -> Int
minSkippingDifficulty (x:y:z:[]) = z - x
minSkippingDifficulty (x:y:z:rest) = min (z-x) (minSkippingDifficulty (y:z:rest))


import Control.Applicative
import Data.Char

main= do
	n<- read<$>     getLine ::IO Integer
	let x = mod n 360
	let y= (div x 90) + if (mod x 90)>45 then 1 else 0
	let z= if (mod x 90 ==45 ) && ( y==3) then 0 else y
	print $ mod z 4


import Data.List
import Data.Int

readInts :: IO [Integer]
readInts = fmap (map read . words) getLine

modOp :: Integer -> (Integer -> Integer -> Integer) -> Integer -> Integer -> Integer
modOp p op x y = mod (op x y) p

bigprime = 10^9 + 7
modP = modOp bigprime

fexp :: Integer -> Integer -> Integer
fexp _ 0 = 1
fexp a e = modP (*) (if mod e 2 == 0 then 1 else a) (fexp (modP (*) a a) (div e 2))

solveP :: Integer -> Integer -> Integer
solveP p n =
    let
        powers = takeWhile (<= n) $ (map (p^) [1..])
        exps   = (map (div n) powers)
        exp    = foldl' (modOp (bigprime - 1) (+)) 0 exps
    in fexp p exp

factor :: Integer -> [Integer]
factor n = f 2 n
    where
    f p k
        | k < p * p    = [k]
        | mod k p == 0 = p : (f p (div k p))
        | otherwise    = f (p + 1) k

primes = ((map head) . group . factor)

solve :: Integer -> Integer -> Integer
solve x n = foldl' (modP (*)) 1 $ map (flip solveP n) (primes x)

main = do
    [x, n] <- readInts
    putStrLn $ show $ solve x n

testcase = solve 666010979 443570624148538441


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

main = do
		a<-read <$> getLine ::IO Int
		print $ if a<3 then 7 else ( a-2)


{-#LANGUAGE NPlusKPatterns #-}

module Main where

import Data.List

main :: IO ()
main = do
	n <- getInt
	coos <- getCoos n
	print $ process n coos

getInt :: IO Integer
getInt = readLn

type Coo = (Integer, Integer)

getCoo :: IO Coo
getCoo = do
	s <- getLine
	let [x, y] = words s
	return (read x, read y)

getCoos :: Integer -> IO [Coo]
getCoos 0 = return []
getCoos (n + 1) = do
	coo <- getCoo
	coos <- getCoos n
	return (coo : coos)

process :: Integer -> [Coo] -> Integer
-- process 0 _ = -1
-- process 1 _ = -1
-- process
process _ coos = let xs = exes coos
                     ys = wyes coos
                 in judge (nub xs) (nub ys)

judge :: [Integer] -> [Integer] -> Integer
judge xs ys = let m = length (nub xs)
                  n = length (nub ys)
              in if m < 2 || n < 2 then - 1 else compute xs ys

compute :: [Integer] -> [Integer] -> Integer
compute (x1 : x2 : _) (y1 : y2 : _) = side x1 x2 * side y1 y2

side :: Integer -> Integer -> Integer
side a b = abs (a - b)

exes, wyes :: [Coo] -> [Integer]
exes = map fst
wyes = map snd


module Main where

import Control.Monad
import Data.List

checkGuess answer guess =
    let a = length $ filter id $ zipWith (==) answer guess
        ab = length $ intersect answer guess
    in (a, ab-a)

initGuess = filter (\[a,b,c,d] ->
        a /= b && a /= c && a /= d &&
        b /= c && b /= d &&
        c /= d
    ) $ map (\n -> if n < 1000 then '0':show n else show n) $ [123..9876]

main = do
    n <- read `liftM` getLine
    final <- foldM (\remain _ -> do
            (guess, a, b) <- do
                [guess, a, b] <- words `liftM` getLine
                return (guess, read a, read b)
            return $ filter (\answer -> checkGuess answer guess == (a, b)) remain
        ) initGuess [1..n]

    putStrLn $ case length final of
        0 -> "Incorrect data"
        1 -> head final
        _ -> "Need more data"


findPos :: [Char] -> Char -> Int
findPos s ch = length (takeWhile (\cur -> cur /= ch) s)

fwd :: Char -> Char -> Int
fwd from to = findPos ([from..'z'] ++ ['a'..to]) to

genDec :: Char -> Char -> [Char]
genDec from to =
  if from == to
    then [from]
    else [from, (pred from)..to]

bck :: Char -> Char -> Int
bck from to = findPos ((genDec from 'a') ++ (genDec 'z' to)) to

main = do
  s <- getLine
  let s2 = 'a':s
  let pairs = zip s2 s
  let dist = foldr (+) 0 (map (\(f, s) -> min (fwd f s) (bck f s)) pairs)
  putStrLn (show dist)


isPrime 1 = False
isPrime x =
  all (/= 0) mods
  where
    mods = map (x `mod`) cand
    cand = takeWhile (\y -> y * y <= x) [2..]

g a k = a - sum [f a i | i <- [2..k - 1]]
f a k
  | (not . isPrime) k = 0
  | a < k * k = if a >= k then 1 else 0
  | otherwise = g (a `div` k) k

solve a b k = f b k - f (a - 1) k

main = do
  [a,b,k] <- (map read . words) `fmap` getLine :: IO [Integer]
  putStrLn $ show $ solve a b k


main = getLine >>= print. max 0. (\[a, b, c] -> (a*c - b*c) `div` b + if (a*c-b*c) `mod` b == 0 then 0 else 1). map read. words


import Data.List
import Data.Ord
import Data.Array

dp=array ('A','Z')[(k,(-1,-1))|k<-['A'..'Z']]

buildDP [] dp _ = dp
buildDP (x:xs) dp index
	|start /= (-1) 	= buildDP xs (dp//[(x,(start,index))]) (index+1)
	|otherwise 		= buildDP xs (dp//[(x,(index,index))]) (index+1)
	where
		start=fst $ dp!x

checkSeq_new x = map (\(_,x)->x) $ filter (\(_,(s,_))->s>=0) $ assocs $ buildDP x dp 0

createSigns [] = []
createSigns ((l,r):xs) = [(l,1),(r+1,-1)]++createSigns xs

s [] = 0
s ((x,y):xs)= y+s xs

sumAll t@((x,y):xs) = (x,s t)

f x = map sumAll $ groupBy (\x y -> (fst x) == (fst y)) $ sortBy (comparing fst) (createSigns $ checkSeq_new x)

solve [] c= [c]
solve ((_,n):xs) c=(n+c):solve xs (n+c)

isJust (Just _)=True
isJust _ = False

answer k text
	|isJust jj = "YES"
	|otherwise = "NO"
	where
		jj=find (>k) $ solve (f text) 0
main=do
	num<-getLine
	let (_:m:_)= map (\x->read x::Int) (words num)
	text<-getLine
	putStrLn (answer m text)


import Data.Array
import Text.Printf

solve w b = dp ! (w,b,1)
    where
        dp  = listArray ((0,0,0),(w,b,1)) [ f i j d | i <- [0..w], j <- [0..b], d <- [0,1] ]
        f 0 j _ = 0.0 :: Double
        f i j d | d == 1 = fromIntegral i / fromIntegral (i+j) + fromIntegral j / fromIntegral (i+j)  * check (i,j-1,0)
                | True = if j > 0 then fromIntegral j / fromIntegral (i+j) * escape i (j-1) else 0.0
        escape i j = fromIntegral i / fromIntegral (i+j) * check (i-1,j,1) + fromIntegral j / fromIntegral (i+j) * check (i,j-1,1)
        check p@(i,j,d) | i <= 0 || j < 0 = 0.0
                        | True = dp ! p

main = do
    (w:b:_)  <- (fmap (map read . words) getLine) :: IO [Int]
    printf "%.9f\n" $ solve w b


import Control.Monad
main = do
    a <- liftM read getLine
    putStrLn $ show $ 1 + (a+1)`mod`2


{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Data.Array.Unboxed

type State = (Bool, Int, Int, Int)

(+%) :: Int -> Int -> Int
a +% b = if c >= m then c - m else c
  where
    c = a + b
    m = 1000000009

gao :: Int -> Int -> UArray State Int
gao h n = go n $ newArray [((True, 0, 0, 0), 4)]
  where
    newArray = accumArray (+%) 0 ((False, 0, 0, 0), (True, h, h, h))
    state = [(f, i, j, k) |
      f <- [False, True], i <- [0 .. h], j <- [i .. h], k <- [j .. h]]
    go 1 dp = dp
    go m dp = go (m - 1) $ newArray $ concat [next i $ dp!i | i <- state]
      where
        next (f, i, j, k) e
          | f         = [
              ((i < h, 0, j', k'), e),
              ((j < h, 0, i', k'), e),
              ((k < h, 0, i', j'), e),
              ((True, i', j', k'), e)]
          | otherwise = [
              ((i < h, j', k', h), e),
              ((j < h, i', k', h), e),
              ((k < h, i', j', h), e),
              ((False, i', j', k'), e)]
          where
            [i', j', k'] = map (min h . succ) [i, j, k]

main :: IO ()
main = do
  [n, h] <- fmap (map read . words) getLine
  let h' = h - 1
      ans = gao h' n
  print $ foldl1 (+%) [e | ((f, i, _, _), e) <- assocs ans, f || i < h']


main :: IO()
main = print . solve . map read . words =<< getLine

solve :: [Integer] -> Integer
solve [n, a, b, c, d] = n * (iter 1)
    where iter :: Integer -> Integer
          iter i | i > n = 0
                 | otherwise = (valid i) + iter (i + 1)
          valid :: Integer -> Integer
          valid x1 = let sum = a + b + x1
                         x2 = sum - a - c
                         x3 = sum - b - d
                         x4 = sum - c - d
                     in if 1 <= x2 && x2 <= n &&
                           1 <= x3 && x3 <= n &&
                           1 <= x4 && x4 <= n
                        then 1 else 0


main = interact (format . solve . parse)

parse s = case words s of
  (x:y:z:a:b:c:[]) -> (read x :: Integer,
    read y :: Integer,
    read z :: Integer,
    read a :: Integer,
    read b :: Integer,
    read c :: Integer)
  _ -> (0, 0, 0, 0, 0, 0)

solve (x, y, z, a, b, c) = (x <= a) && (x + y <= a + b) && (x + y + z <= a + b + c)

format True = "YES"
format False = "NO"


import Data.List

-- import Debug.Trace

-- debug = flip trace
debug = const

calc ('+':ops) (a:b:nums) =
  search ops ((a+b):nums) `debug` (show a ++ "+" ++ show b ++ "=" ++ show (a+b) ++ ":" ++ show nums)
calc ('*':ops) (a:b:nums) =
  search ops ((a*b):nums) `debug` (show a ++ "*" ++ show b ++ "=" ++ show (a*b) ++ ":" ++ show nums)

search [] (num:[]) = [num]
search ops nums = do
  let numsA = permutations nums
  ns <- numsA
  calc ops ns

readInts :: IO [Integer]
readInts = (map read . words) `fmap` getLine

main = do
  nums <- readInts
  opts <- (filter (/= ' ')) `fmap` getLine
  putStrLn $ (show (minimum (search opts nums)))


import Control.Monad

answer :: String -> Int -> Int -> Bool
answer [] 0 _ = True
answer [] _ _ = False
answer x 0 y = answer x y y
answer (x:xs) a b
	| a < 0 = False
	| otherwise = answer xs (a - read (x:"")) b

f :: String -> Bool
f number = let s = sum . map (read . (:"")) $ number
					 in if s == 0 then length number > 1 else any (answer (filter (/= '0') number) 0) $ filter ((==0) . (s `mod`)) [1..s - 1]

f' s = if f s then "YES" else "NO"

main = getLine >> getLine >>= putStrLn . f'


main :: IO()
main = print . solve . map read . words =<< getContents

solve :: [Integer] -> Integer
solve [n, a, b, c] = let m = max 0 (div (n - c) (b - c))
                     in  max (div n a) (m + (div (n - m * (b - c)) a))


bicolorable :: String -> Bool
bicolorable s =  coloredCorrectly s && canBicolor s
  where coloredCorrectly xs = and $ zipWith (\x y -> x  /= y || x == '?' || y == '?') xs (tail xs)
        canBicolor [] = False
        canBicolor ('?':_) = True
        canBicolor (l:'?':rest@(r:_)) = l == r || canBicolor rest
        canBicolor (_:rest) = canBicolor rest

main = getLine >> getLine >>= return . toAnswer >>= putStrLn
  where toAnswer s = if bicolorable s then "Yes" else "No"


gao :: Int -> Int -> Int
gao a b = 2 * c + diff a' b'
  where
    c = min a b `div` 2
    a' = a - 2 * c
    b' = b - 2 * c
    same 0 y = max 0 $ y - 1
    same x y = 1 + diff y (x - 1)
    diff 0 y = y
    diff x y = same (x - 1) y

main :: IO ()
main = do
  [n, m] <- fmap (map read . words) getLine
  let x = max (gao m $ n - 1) (gao n $ m - 1)
  print $ x
  print $ n + m - 1 - x


import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = putStr "Karen"
   -- n:_ <- readInts
    --l1 <- readInts
    --l2 <- readInts
    --let set  = Set.fromList $ l1 ++ l2
      --  zz = foldl' (\x y -> foldl' (\xx yy -> if Set.member (xor y yy) set then xx+1 else xx) x l2) 0 l1
       --ww = foldl' (\x y -> foldl' (\xx yy -> if Set.member (xor y yy) set then xx+1 else xx) x l1) zz l2
    --if even zz
      --  then putStr "Karen"
        --else putStr "Koyomi"

--kind
--по-бавно решение с глобален параметър
--индексиране на памет
--dolna granica na slojnost


{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
class Scan a where scan' :: String -> a
instance Scan Int where scan' n = read n
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' f = read f
instance Scan Double where scan' d = read d
instance Scan Integer where scan' n = read n
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = scan'' (words x)
                                                 where
                                                   scan'' (x:y:_) = (scan' x,scan' y)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = scan'' (words x)
                                                          where
                                                            scan'' (x:y:z:_) = (scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = scan'' (words x)
                                                                   where
                                                                     scan'' (w:x:y:z:_) = (scan' w,scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = scan'' (words x)
                                                                            where
                                                                              scan'' (v:w:x:y:z:_) = (scan' v,scan' w,scan' x,scan' y,scan' z)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scan :: (Scan a) => IO a
scan = do n <- getLine
          return (scan' n)

scans :: (Scan a) => Int -> IO [a]
scans 0 = return []
scans n = do x <- scan
             xs <- scans (n-1)
             return (x:xs)

scanlist :: (Scan a) => IO [a]
scanlist = do l <- getLine
              return [scan' x|x<-words l]

scanlists :: (Scan a) => Int -> IO [[a]]
scanlists 0 = return []
scanlists n = do x <- scanlist :: (Scan a) => IO [a]
                 xs <- scanlists (n-1)
                 return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

solve :: Int -> Int -> Int -> String
solve n' x y = let n = div n' 2 in
               if (x==n||x==n+1)&&(y==n||y==n+1) then
                   "NO"
               else
                   "YES"

main = do (n',x,y) <- scan::IO (Int,Int,Int)
          putAnsLn (solve n' x y)


import Char (ord)

data Phigure  =  King Int Int | Rook Int Int

damage :: Phigure -> Phigure -> Bool
damage (King x1 y1) (King x2 y2)  =  abs (x1 - x2) < 2 && abs (y1 - y2) < 2

damageWithKing :: Phigure -> Phigure -> Phigure -> Bool
damageWithKing (King x1 y1) (Rook x2 y2) (King x3 y3)
  | x2 == x3 && y2 == y3  =  False
  | x2 == x3 && x1 == x2  =  not $ abs (y2 - y3) > abs (y2 - y1) && abs (y2 - y3) > abs (y3 - y1)
  | y2 == y3 && y1 == y2  =  not $ abs (x2 - x3) > abs (x2 - x1) && abs (x2 - x3) > abs (x3 - x1)
  | otherwise  =  x2 == x3 || y2 == y3

check :: [Phigure] -> Phigure -> Bool
check [wKing, rook1, rook2] bKing
  =  damage wKing bKing
  || damageWithKing wKing rook1 bKing
  || damageWithKing wKing rook2 bKing

checkMate :: [Phigure] -> Phigure -> Bool
checkMate ws (King x1 y1)
  =  all (check ws) $ filter coord [King (x1 + dx) (y1 + dy) | dx <- [-1..1], dy <- [-1..1]]
  where
    coord (King x y)  =  x > 0 && x < 9 && y > 0 && y < 9
    coord (Rook x y)  =  x > 0 && x < 9 && y > 0 && y < 9

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

parse :: String -> (Int, Int)
parse [x, y]  =  (ord x - ord 'a' + 1, ord y - ord '0')

main :: IO ()
main  =  do
    [(x1, y1), (x2, y2), (x3, y3), (x4, y4)]  <-  fmap (map parse . words) getLine
    putStrLn $ "CHECKMATE" <?> "OTHER" $ checkMate [King x3 y3, Rook x1 y1, Rook x2 y2] (King x4 y4)


main = interact (unwords.map show.takeWhile(>0).iterate f.read)
f 1 = 0
f n = div n $ head [i|i<-[2..], mod n i==0]


module Main where

import Control.Monad
import Data.Array

maxNumber = 1000000

digits :: Array Int Int
digits = dv
    where dv = listArray (0, maxNumber) $ 6:2:5:5:4:5:6:3:7:6:[gen i | i <- [10 .. maxNumber]]
          gen i = (dv ! m) + (dv ! d)
              where (d, m) = divMod i 10

solve :: Int -> Int -> Int
solve a b = sum $ [digits ! i | i <- [a .. b]]

main :: IO ()
main = do
  [a, b] <- liftM (map read . words) getLine
  print $ solve a b


main = do
    x <- readLn :: IO Int
    print $ if x == 2 then 2 else 1


solve = check . take 4 . map fromEnum . concat where
  check [a, b, c, d] = show l : ds where
    cx = c - a
    cy = d - b
    (wch, w) = (if signum cx >= 0 then "R" else "L", abs cx)
    (hch, h) = (if signum cy >= 0 then "U" else "D", abs cy)
    l = max w h
    ds = take l $ zipWith (++) (replicate w wch ++ repeat "") (replicate h hch ++ repeat "")

main = interact $ unlines . solve . lines


main = interact $ show . g . lines

count n = length . filter (==n)
factorial n = product [1..n]
c n r = (factorial n) `div` ((factorial r)*(factorial (n-r)))

probablity :: Int -> Int -> Double
probablity x a = (fromIntegral (a `c` x)) / (fromIntegral (2^a))

g :: [String] -> Double
g (x:y:[])
  | c > a || d > b = 0.0
  | otherwise = probablity (a-c) q
  where l = length x
        a = count '+' x
        b = l - a
        c = count '+' y
        d = count '-' y
        q = count '?' y


main = do
    [n_, m_, k_] <- return . map read . words =<< getLine
    let (dv,md) = k_ `divMod` (2*m_)
	lane
	  | md/=0	= dv+1
	  | otherwise	= dv
	(dv',md') = md `divMod` 2
	desk
	  | md'==0	= if dv' == 0 then m_ else dv'
	  | otherwise	= dv' + 1
	lr
	 | md'==0	= "R"
	 | otherwise	= "L"
    putStr $ (show lane) ++ " " ++ (show desk) ++ " " ++ lr


import Data.List

findBall' :: [Int] -> Int -> Int -> Int -> [Int]
findBall' [] _ _ _ = [];
findBall' balls color count acc = if replicate count color `isPrefixOf` balls
									then acc:(findBall' (tail balls) color count (acc+1))
									else findBall' (tail balls) color count (acc+1)

findBall :: [Int] -> Int -> Int -> [Int]
findBall [] _ _ = [];
findBall balls color count = findBall' balls color count 0

dropBalls :: [Int] -> Int -> Int
dropBalls list acc = if dropped > 0 then nextStep else acc
			where
				dropped = fst (calcStep list)
				nextStep = dropBalls (snd (calcStep list) ) (acc+dropped)

calcStep :: [Int] -> (Int, [Int])
calcStep [] = (0, [])
calcStep list = if len < 3 then (0+fst next, (take len list)++(snd next) ) else (len+fst next, snd next )
			where
				len = length $ takeWhile (==(head list)) list
				next = calcStep (drop len list)

main = do
	dataStr <- getLine
	ballStr <- getLine
	let dataList = map (read:: String -> Int) $ words dataStr
	let balls = map read $ words ballStr
	let colors = dataList!!1
	let ballColor = dataList!!2
	let positions = findBall balls ballColor 2
	let variants = map (\ pos -> (fst (splitAt pos balls) ++ [ballColor] ++ snd (splitAt pos balls)) ) positions
	let answer = if null variants then 0 else maximum ( map (flip dropBalls 0) variants ) -1
	putStrLn $ show answer


import Control.Applicative
import Control.Monad
import Data.Array
import Data.Graph
import Data.Maybe
import Data.Tree
import Data.Tuple
import qualified Data.ByteString.Char8 as B

readEdge = do
	[i, j] <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
	return (i, j)

unordered edges = edges ++ map swap edges

solve n friends dislikes =
		if null counts
			then Nothing
			else Just $ maximum counts
	where
		likes = accumArray (&&) True ((1, 1), (n, n)) $ map (\d -> (d, False)) $ unordered dislikes
		g = buildG (1, n) $ unordered friends
		cs = map flatten $ components g
		allLikes c = and [likes ! (i, j) | i <- c, j <- c]
		counts = map length $ filter allLikes cs

main = do
	n <- readLn
	m <- readLn
	friends <- replicateM m readEdge
	m2 <- readLn
	dislikes <- replicateM m2 readEdge
	let r = solve n friends dislikes
	if isJust r
		then print $ fromJust r
		else print 0


import Data.List

main = do
  a <- getLine
  b <- getLine
  t <- getLine

  putStrLn $ if sort (a ++b ) == sort t then "YES" else "NO"


import qualified Data.Set as I
import Control.Monad
type State = (I.Set Int, I.Set Int, I.Set Int, I.Set Int)
-- Candidate, On, Off, Indeterminant

data Log = On Int
         | Off Int deriving(Show)

simulate :: [Log] -> State -> State
simulate [] x = x
simulate (On i:r) x@(cand,on,off,ind)
  | I.null cand  = x
  | I.null on = simulate r (cand' , on', off', ind) -- I.foldr I.delete cand off'
  | otherwise = simulate r (cand, on' , off', ind)
  where off' = I.delete i off
        on' = I.insert i on
        cand' = if I.size cand > I.size off' then I.foldr I.delete cand off'
                                             else I.filter (`I.notMember` off') cand
simulate (Off i:r) (cand,on,off,ind)
  | I.null cand'  = (cand',on,off,ind)
  | otherwise = simulate r (cand',on',off',ind)
    where on' = I.delete i on
          off' = if i `I.member` cand' then I.insert i off else off
          cand' = if not (I.null on')  then I.delete i cand
                                      else cand

readLog :: [String] -> Log
readLog ["+", i] = On (read i)
readLog [_, i] = Off (read i)
readLog _ = undefined

buildState :: [Log]-> (I.Set Int, I.Set Int, I.Set Int)-> (I.Set Int, I.Set Int, I.Set Int)
buildState [] x = x
buildState (On i:r) (on,off,vi)
  | i `I.notMember` vi = buildState r (on, off,vi)
  | otherwise = buildState r (on, I.insert i off, I.delete i vi)
buildState (Off i:r) (on,off,vi)
  | i `I.notMember` vi = buildState r (on,off,vi)
  | otherwise = buildState r (I.insert i on, off, I.delete i vi)

main :: IO ()
main = do
  n:l:_ <- fmap (map read . words) getLine
  let m = I.fromDistinctAscList [1..n]
  logs <- fmap (map (readLog . words))  (replicateM l getLine)
  let (on,off,ind) = buildState logs (I.empty,I.empty,m)
  let (On k) = head logs
  let off' = I.intersection off (on `I.union` ind)
  let (c,_,_,_) = simulate logs (if I.null on then I.insert k ind else on`I.union`ind,on,off',ind)
  let cl = unwords $ map show (I.toList c)
  print $ I.size c
  unless (I.null c) (putStrLn cl)


f (num, m) x
    | isVowel x = (0, max (num+1) m)
    | otherwise = (num+1,m)

isVowel a = elem a "AEIOUY "

g2 (xs) = snd $ foldl f (0,0) xs

main :: IO ()
main = do
    xs <- getLine
    print $ g2 (xs ++ " ")


import System.IO
import Control.Monad
import Data.List
import Data.Bits
import Data.Word
import Data.Maybe

main :: IO ()
main = do
    [x,y] <- map read <$> words <$> getLine
    let bitlist = (uncurry solve (equalizeLengths (toBits y) (toBits x))) >>= (fixfilter . reverse . solvefix . reverse)
    let numbers = fromMaybe [-1] (bitlist >>= genNums)
    case numbers == [-1] of
      True  -> putStrLn "-1"
      _     -> do
          putStrLn (show . length $ numbers)
          putStr (unwords . map show $ numbers)

toBits :: Integer -> [Word8]
toBits x = toBits' [] x

toBits' :: [Word8] -> Integer -> [Word8]
toBits' lst 0 = 0 : lst
toBits' lst 1 = 1 : lst
toBits' lst x = toBits' ((fromIntegral (x `mod` 2)) : lst) (x`div`2)

equalizeLengths :: [Word8] -> [Word8] -> ([Word8],[Word8])
equalizeLengths xs ys   = let   lx = length xs
                                ly = length ys
                         in case (lx - ly) < 0 of
                          True  -> ((replicate (ly - lx) 0) ++ xs , ys)
                          _     -> (xs, (replicate(lx - ly) 0) ++ ys)

solve :: [Word8] -> [Word8] -> Maybe [Word8]
solve [] [] = Just []
solve [x] [y] = case (odd x `xnor` odd y) of
                  True  -> Just [x]
                  _     -> Nothing

solve (x:xs) (y:ys)
    | odd x `xnor` odd y    = (x:) <$> (solve xs ys)
    | otherwise             = ((x-1):) <$> (solve (((+2) . head$xs) : (tail xs)) ys)

solvefix :: [Word8] -> [Word8]
solvefix [] = []
solvefix [x] = [x]
solvefix (x1:xs)
    | x1 > 128     = (x1+4) : solvefix ( (head xs - 2) : (tail xs))
    | otherwise     = x1 : solvefix xs

fixfilter :: [Word8] -> Maybe [Word8]
fixfilter xs
    | any (> 250) xs = Nothing
    | otherwise = Just xs

xnor x y = complement (xor x y)

genNums :: [Word8] -> Maybe [Integer]
genNums xs
    | all (==0) xs  = Just []
    | otherwise = let   (num, list') = foldl' f (0,[]) xs
                  in    (num :) <$> genNums (reverse list')
             where  f :: (Integer, [Word8]) -> Word8 -> (Integer, [Word8])
                    f (s,l') 0 = (s*2, 0 : l')
                    f (s,l') i = (s*2 + 1, (i-1) : l')

c1 = 293341698588646512
c2 = 496573494755010944

aa = toBits c2
ab = toBits c1

testt i = solve (take i aa) (take i ab)


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

import Data.Array.IArray
import Data.Array.Unboxed
import Data.Char
import Data.Functor
import Data.List
import Data.Int
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

allSublists :: [a] -> [[a]]
allSublists = concatMap (tail . inits) . init . tails

solve :: Int -> Int -> [Int] -> Int
solve n d a = n - (maximum $ map length $ filter ((<= d) . liftM2 (-) last head) $ allSublists $ sort a)

main :: IO ()
main = do [n, d] <- getInts
          a <- getInts
          print (solve n d a)


main = getLine
  >>= putStrLn . show . countFactors . read

countFactors :: Int -> Int
countFactors n = case calcCombinations n 2 of
  (c, 1) -> c - 1
  (c, n) -> calcPrimeCombinations n 3 * c - 1
  where calcCombinations n m = case n `mod` m of
                                  0 -> (fst res + 1, snd res)
                                  _ -> (1, n)
          where res = calcCombinations (n `div` m) m
        calcPrimeCombinations n m
    	  | limit < m  = 2
    	  | otherwise = case calcCombinations n m of
    	                  (c, 1) -> c
    	                  (c, n) -> calcPrimeCombinations n (m + 2) * c
    	  where limit = isqrt n

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


import qualified Data.ByteString.Char8 as BS
import Debug.Trace
main = do input <- BS.getLine
          putStrLn $ show $ solve $ getInput (map BS.unpack (BS.words input))

solve :: (Integer,Int) -> Int
solve (1,_) = 0
solve (n,k) | (n > (toInteger k)*((toInteger k)-1) `div` 2 + 1) = -1
            | otherwise = binarySearch 1 k (n,k)

getInput :: [String] -> (Integer,Int)
getInput [n,k] = (read n, read k)

binarySearch :: Int -> Int -> (Integer,Int) -> Int
binarySearch min max (n,k) | min == max = min
                           | (((toInteger (2*k - ind - 1)) * (toInteger ind)) `div` 2 + 1) >= n = binarySearch min ind (n,k)
                           | otherwise = binarySearch (ind+1) max (n,k)
                           where ind = (min+max) `div` 2

showTrace str x = trace (str ++ show x) x


import Control.Monad

main = do
    n <- readLn :: IO Int
    winner <- replicateM n readLn :: IO [Int]
    let ans = simulate winner
    if ans == True
        then putStrLn "YES"
        else putStrLn "NO"

simulate :: [Int] -> Bool
simulate = game 1 2 3
    where
        game _ _ _ [] = True
        game play_1 play_2 spec (x:xs)
            | x == play_1   = game play_1 spec play_2 xs
            | x == play_2   = game spec play_2 play_1 xs
            | otherwise = False


userInt :: IO Int
userInt = do
	intStr <- getLine
	return $ read intStr

levelSteps buttons level =
	buttonsOnThisLevel * level + levelFix
	where
		buttonsOnThisLevel = buttons - level + 1
		levelFix = -(level - 1)

steps buttons =
	sum $ map (levelSteps buttons) [1..buttons]

main :: IO ()
main = do
	buttons <- userInt
	print $ steps buttons


import Control.Monad
import Data.List

main = do
    (a:b:c:d:_) <- map read . words <$> getLine
    print $ solve a b c d

triangle n
    | n < 0 = 0
    | otherwise = (n * (n + 1)) `div` 2

solve a b c d =
    sum [ triangle (b - c + y) - triangle (a + y - c - 1) - triangle (b + y - d - 1) + triangle (a - d + y - 2)
        | y <- [b .. c]
        ]


import Data.List

main =do
      e<-getLine
      let xs=filter ((== 0) . ((flip mod) 2)) $ map length $ group e
      print $ length xs


f n
    | (mod n 4 == 0) = (div n 4) - 1
    | (mod n 2 == 0) = (div n 4)
    | otherwise = 0

main = do
    n <- readLn
    print (f n)


{-
Two positive integers a and b have a sum of s and a bitwise XOR of x. How many
possible values are there for the ordered pair (a, b)?

Input
The first line of the input contains two integers s and x
(2 ≤ s ≤ 1012, 0 ≤ x ≤ 1012), the sum and bitwise xor of the pair of positive
integers, respectively.

Output
Print a single integer, the number of solutions to the given conditions. If no
solutions exist, print 0.

Found at: http://codeforces.com/contest/635/problem/C
-}

module Main where
import qualified Data.Array as Array
import Data.Array ((!))
import Data.Bits ((.&.))

solve :: Integer -> Integer -> Integer
solve s x = let (abCombinations, aOfZerosPossible, bOfZerosPossible) = arr ! (n,0)
            in abCombinations
               - (if aOfZerosPossible then 1 else 0)
               - (if bOfZerosPossible then 1 else 0)
  where [sBitsRaw, xBitsRaw] = [num2bits s, num2bits x]
        n = max (length sBitsRaw) (length xBitsRaw)
        [sBits, xBits] = map (padL 0 n) [sBitsRaw, xBitsRaw]
        arr = Array.listArray arrBounds [dp len carry | (len,carry) <- Array.range arrBounds]
        arrBounds = ((1,0),(n,1))
        -- dp l c ~ what is the number of A,B combinations to get number
        --          of length 'l' so that their sum results with 'c' carry
        dp :: Int -> Int -> (Integer, Bool, Bool)
        dp len carry
          -- TODO simplify all the checks for len == 1
          -- | len == 0 = if carry == 0
          --                then (1, True, True)
          --                else (0, False, False)
          | (s,x,carry) == (0,0,0) = -- (a,b,cPrev) in {(0,0,0)}
                                     if len == 1
                                       then (1, True, True)
                                       else let (combs_c0, a0s_c0, b0s_c0) = arr ! (len - 1, 0)
                                            in (combs_c0, a0s_c0, b0s_c0)
          | (s,x,carry) == (0,1,0) = (0, False, False)
          | (s,x,carry) == (1,0,0) = -- (a,b,cPrev) in {(0,0,1)}
                                     if len == 1
                                       then (0, False, False)
                                       else let (combs_c1, a0s_c1, b0s_c1) = arr ! (len - 1, 1)
                                            in (combs_c1, a0s_c1, b0s_c1)
          | (s,x,carry) == (1,1,0) = -- (a,b,cPrev) in {(0,1,0),(1,0,0)}
                                     if len == 1
                                       then (2, True, True)
                                       else let (combs_c0, a0s_c0, b0s_c0) = arr ! (len - 1, 0)
                                            in (2 * combs_c0, a0s_c0, b0s_c0)
          | (s,x,carry) == (0,0,1) = -- (a,b,cPrev) in {(1,1,0)}
                                     if len == 1
                                       then (1, False, False)
                                       else let (combs_c0, a0s_c0, b0s_c0) = arr ! (len - 1, 0)
                                            in (combs_c0, False, False)
          | (s,x,carry) == (0,1,1) = -- (a,b,cPrev) in {(0,1,1),(1,0,1)}
                                     if len == 1
                                       then (0, False, False)
                                       else let (combs_c1, a0s_c1, b0s_c1) = arr ! (len - 1, 1)
                                            in (2 * combs_c1, a0s_c1, b0s_c1)
          | (s,x,carry) == (1,0,1) = -- (a,b,cPrev) in {(1,1,1)}
                                     if len == 1
                                       then (0, False, False)
                                       else let (combs_c1, a0s_c1, b0s_c1) = arr ! (len - 1, 1)
                                            in (combs_c1, False, False)
          | (s,x,carry) == (1,1,1) = (0, False, False)
          where s = sBits !! (n - len)
                x = xBits !! (n - len)

num2bits :: Integer -> [Int]
num2bits 0 = [0]
num2bits n = reverse $ num2bits' n
  where num2bits' :: Integer -> [Int]
        num2bits' 0 = []
        num2bits' n = (if (n .&. 1 == 1) then 1 else 0) : num2bits' (n `div` 2)

padL padItem targetLen xs = (replicate (targetLen - length xs) padItem) ++ xs

main :: IO ()
main = do
  line <- getLine
  let [s,x] = map read (words line) :: [Integer]
  putStrLn $ show (solve s x)


main = do
	(n1:b1:_) <- getLine>>=return.(map read).words
	a <- getLine >>= return.(map read).words
	let x = sum $ zipWith (*) a (pows n1 b1)
	(n2:b2:_) <- getLine>>=return.(map read).words
	b <- getLine >>= return.(map read).words
	let y = sum $ zipWith (*) b (pows n2 b2)
	putStrLn $ comp x y

pows n m = reverse $ map (m^) [0..n-1]

comp x y
	| x<y = "<"
	| x>y = ">"
	| True= "="


toFloat s = read s :: Float
to4tuple [a, b, c, d] = (a, b, c, d)

calc (d, l, v1, v2) =
    let movable = l - d;
        speed = v1 + v2
    in movable / speed

main = do
    input <- getLine
    putStrLn . show . calc . to4tuple . (map toFloat) . words $ input


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

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  m <- poi
  show `fmap` liftM2 solve (replicateM n poi) (replicateM m poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve xs ys
  | not $ null zs = head zs
  | x > y = y * 10 + x
  | otherwise = x * 10 + y
  where
    (x, y) = (minimum xs, minimum ys)
    zs = sort $ xs `intersect` ys


solve n m | n == m = 0
          | m `mod` n /= 0 = -1
          | otherwise = pows23 $ m `div` n

pows23 1 = 0
pows23 m | m `mod` 2 == 0 = inc1 . pows23 $ m `div` 2
         | m `mod` 3 == 0 = inc1 . pows23 $ m `div` 3
         | otherwise = -1
         where
            inc1 x = if x == -1 then -1 else x + 1

main = do
    line <- getLine
    let [n, m] = map read $ words line
    putStrLn . show $ solve n m


main = interact $ unlines . map (show  . pred . ((^)2)) . map (read :: String -> Int) . tail .  lines


main = do
  l <- getLine
  let a = readInt l
  let t = a !! 0
  let s = a !! 1
  let x = a !! 2
  putStrLn $ if or [and [t + s <= x, (x - t) `mod` s < 2], t == x]
    then "YES" else "NO"

readInt :: String -> [Int]
readInt l = map read (words l)


#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  runghc
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package vector
  --
  -hide-all-packages
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)

type N = Integer
toNum = toInte

answer n as bs = as `elem` map (skip bs) [0 .. n]
  where skip xs x = let xs' = map (subtract x) xs
                        (is, js) = L.partition (< 0) xs'
                     in map (`mod` n) $ js ++ is

handleInput :: ByteString -> ByteString
handleInput = lines .- map (words .- map toNum)
            .- coerceInput answer
            .- toOut .- pack

toOut False = "NO"
toOut True = "YES"

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f ((_:a:_):as:bs:xs) = f a as bs
coerceInput _ _ = error "invalid input"

main :: IO ()
main = interact handleInput

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-


main=readLn>>=print.(ans!!).pred

ans :: [GFp]
ans = map (\x->2^(x-1)-1) [2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, 19937, 21701, 23209, 44497, 86243, 110503, 132049, 216091, 756839, 859433, 1257787, 1398269, 2976221, 3021377, 6972593, 13466917, 20996011]

data GFp = GFp {-# UNPACK #-} !Int deriving (Eq,Ord)

gfOrder :: Int -- prime number
gfOrder = 1000000007 -- 10^9+7

instance Num GFp where
  (GFp x)+(GFp y) = GFp $ (x+y)`rem`gfOrder
  (GFp x)*(GFp y) = GFp $ fromInteger $ (x' * y')`rem`p
   where
     x' = toInteger x
     y' = toInteger y
     p = toInteger gfOrder
  negate (GFp 0) = GFp 0
  negate (GFp x) = GFp $ gfOrder - x
  abs x = x
  signum _ = GFp 1
  fromInteger x = GFp $ fromInteger $ x`mod`(toInteger gfOrder)

instance Show GFp where
  show (GFp n) = show n


exgcd a b = if b == 0 then (a, 1, 0) else (ret, y, x - a `div` b * y) where (ret, x, y) = exgcd b (a `mod` b)
pmod x y = ((x `mod` y) + y) `mod` y

-- Bezout's Lemma -- min. ax+b s.t. ax+b = cy+d, x, y >= 0
bezout a b c d | r /= 0 = -1
               | otherwise = until (>= d) (+ (a * p)) (b + a * ((x * q) `pmod` p)) where
    p = c `div` g
    (q, r) = (d - b) `divMod` g
    (g, x, y) = exgcd a c

main = do
    [n, m, x, y, vx, vy] <- fmap (map read . words) getLine
    let f x y 0 vy | x == 0 || x == n = [x, if vy > 0 then m else 0] | otherwise = [-1, -1]
        f x y vx 0 | y == 0 || y == m = [if vx > 0 then n else 0, y] | otherwise = [-1, -1]
        f x y (-1) vy = let [a, b] = f (n - x) y 1 vy in if a == -1 then [a, b] else [n - a, b]
        f x y vx (-1) = let [a, b] = f x (m - y) vx 1 in if a == -1 then [a, b] else [a, m - b]
        f x (-1) 1 1 | k == -1 = [-1, -1] | otherwise = [if odd p then n else 0, if odd q then 0 else m]
            where (k, p, q) = (bezout m x n 0, k `div` n, (k - x) `div` m)
        f x y 1 1 = f (x + m - y) (-1) 1 1
        r = f x y vx vy
    putStrLn $ if head r == -1 then "-1" else unwords . map show $ r


import Data.List
import qualified Data.Map.Strict as Map

toint s = (read s) :: Int

doit x [] = (-1,-1)
doit x ((a,b):xs) =
  if (mod a b == 0) && (a*b > x) && (div a b < x) then
    (a,b)
  else
    doit x xs

solve::String -> String
solve ss =
  let x:_ = map toint $ words ss in
  let (a,b) = doit x $ zip [1..x] [1..x] in
  if a <= 0 then
    "-1\n"
  else
    show(a)++" "++show(b)++"\n"

main = do
  interact $ solve


import Data.List

main = do
    input <- getLine
    putStrLn $ solve $ input

solve x
    | p == 0 = "YES"
    | (l `mod` p) == 0 = "YES"
    | otherwise = "NO"
    where
        l = length $ filter (== '-') x
        p = length $ filter (== 'o') x


module Main where

import Control.Monad
import Data.List (minimumBy)
import Data.Function (on)

data Activity = Sport | Contest | Rest
    deriving (Show, Eq)

type Candidate = (Activity, Int)

goodFor :: Activity -> Candidate -> Bool
goodFor Sport (Sport, _) = False
goodFor Contest (Contest, _) = False
goodFor _ _ = True

mkCandidate :: [Candidate] -> Activity -> Candidate
mkCandidate cs a | a == Rest = (a, d + 1)
                 | otherwise = (a, d)
    where d = minimum . map snd $ filter (goodFor a) cs

solve :: [Int] -> Int
solve = go [(Rest, 0)] . reverse
    where go :: [Candidate] -> [Int] -> Int
          go cs [] = minimum $ map snd cs
          go cs (a:as) = case a of
                           0 -> go (map (mkCandidate cs) [Rest]) as
                           1 -> go (map (mkCandidate cs) [Rest, Contest]) as
                           2 -> go (map (mkCandidate cs) [Rest, Sport]) as
                           3 -> go (map (mkCandidate cs) [Rest, Sport, Contest]) as

test0 = [1, 3, 2, 0] :: [Int]
test1 = [1, 3, 3, 2, 1, 2, 3] :: [Int]
test2 = [2, 2] :: [Int]

main :: IO ()
main = do
  _ <- getLine
  as <- liftM (map read . words) getLine
  print $ solve as


import Control.Applicative
import Data.Int

main = do
  [n, m, k] <- readLs
  putStrLn . unwords . map show $ solve n m k

readLs = map read . words <$> getLine

solve :: Int64 -> Int64 -> Int64 -> [Int64]
solve n _ k | k < n = [k+1, 1]
solve n m k = [n-d1, if even d1 then 2+d2 else m-d2 ]
  where d1 = div (k-n) (m-1)
        d2 = mod (k-n) (m-1)


main = do
  input <- getLine
  putStrLn $ (show . wave . readNumbers) input

readNumbers :: String -> [Int]
readNumbers = map read . words

wave :: [Int] -> Int
wave [n, k, t]
  | t<=k      = t
  | t<=n      = k
  | otherwise = k-(t-n)


wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

main = interact $ f . last . words

g [] condi temp lstpar lstopar = (lstpar, lstopar)
g ('(':xs) condi temp lstpar lstopar = g xs True [] (temp:lstpar) ('_':lstopar)
g (')':xs) condi temp lstpar lstopar= g xs False [] (temp:lstpar) lstopar
g (x:xs) condi temp lstpar lstopar
  | condi = g xs condi (x:temp) lstpar lstopar
  | otherwise = g xs condi temp lstpar (x:lstopar)

f x = (show (fun1 b)) ++ " " ++ (show (fun2 a 0))
  where i = g x False "" [] []
        a = fst i
        b = snd i

sanmaximum x
  | x == [] = 0
  | otherwise = maximum x

fun1 a = (sanmaximum (map length (wordsWhen (=='_') a)))

fun2 [] ans = ans
fun2 (b:xs) ans = fun2 xs (ans + (length (filter (/="") (wordsWhen (=='_') b))))


import List
import Char
isMore ::[Int] -> [Int] -> Bool
isMore [] [] = True
isMore (x:xs) (y:ys) | x < y = isMore xs ys
                     | otherwise = False
getAns::[Int] -> String
getAns a | isMore (sort (take l2 a)) (sort (drop l2 a)) = "YES"
         | isMore (sort (drop l2 a)) (sort (take l2 a)) = "YES"
         | otherwise = "NO"
	 where l2 = (length a) `div` 2
main=interact$getAns.(map digitToInt).last.words


#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  runghc
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package vector
  --
  -hide-all-packages
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)

type N = Integer
toNum = toInte

answer :: [(N, String)] -> Bool
answer = go' 0
  where go 0 (x, "South")
          | x <= 20000 = Just x
          | otherwise = Nothing
        go 20000 (x, "North")
          | x <= 20000 = Just (20000 - x)
          | otherwise = Nothing
        go 0 (_, dir)
          | dir /= "South" = Nothing
        go 20000 (_, dir)
          | dir /= "North" = Nothing
        go s (x, "North")
          | s >= x = Just (s - x)
          | otherwise = Nothing
        go s (x, "South")
          | s + x <= 20000 = Just (s + x)
          | otherwise = Nothing
        go s _ = Just s
        go' 0 [] = True
        go' _ [] = False
        go' s (i:is) = case go s i of
                         Just s' -> go' s' is
                         Nothing -> False

handleInput :: ByteString -> ByteString
handleInput = lines
            .- coerceInput answer
            .- toOut .- pack

toOut False = "NO"
toOut True = "YES"

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f (a:xs) = f (take (toInt a) (map (words .- toInst) xs))
coerceInput _ _ = error "invalid input"

toInst (a:b:_) = (toNum a, unpack b)
toInst _ = error "invalid instruction"

main :: IO ()
main = interact handleInput

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-


1#r=r
n#r=r+r/sin(pi/n)
s[n,q,r]|q+1e-5>=n#r="YES"|1>0="NO"
main=interact$s.map read.words


main = do
	pass<-getLine
	rest<-getContents
	putStrLn $ concat $ map show $ solve (lines rest) pass

solve dict cryptPass = map (replace dict 0) $ divide cryptPass

replace [] i n  = 256
replace dict i n = if head dict == n then i else replace (tail dict) (i+1) n
divide [] = []
divide cryptPass = [take 10 cryptPass]++divide (drop 10 cryptPass)


import Data.List
main=interact$show.f 3.reverse.map read.words
f 0 _=1
f n(k:x)=(l+1)*f(n-1)(k-l:z)
 where
 y:z=sort x
 l=min(y-1)(div k n)


module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe

readInt = fst . fromJust . B.readInt
readInts = fmap readInt . B.words

solve p x y = (\k -> max 0 $ (k + 1) `div` 2) $ fromJust $ find (\k -> elem (p - 26) $ take 25 $ tail $ iterate (\i -> (96 * i + 42) `mod` 475) ((x + 50 * k) `div` 50 `mod` 475)) [(y - x + 49) `div` 50..] :: Int

main = do
  [p, x, y] <- fmap readInts B.getLine
  print $ solve p x y


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

maxPossible as m = m + maximum as
minPossible as m =
    let aMax = maximum as
        as'  = delete aMax as
        as'diff = map (aMax-) as'
    in if sum as'diff >= m
            then aMax
            else let extra = m - sum as'diff
                     n = length as
                 in aMax + extra `div` n + (if extra `rem` n == 0 then 0 else 1)
main = do
    let toInt x = read x :: Int
        getInt = getLine >>= return . toInt
    n <- getInt
    m <- getInt
    as <- replicateM n getInt
    putStrLn $ concat $ intersperse " " $ map show $ [minPossible,maxPossible] <*>  [as] <*> [m]


module Main where

import Control.Monad
import Data.Int
import Data.List

main = do
    n <- read `liftM` getLine

    let n' = ( 2 * combine (2*n-1) n - n ) `mod` modulo

    putStrLn $ show n'

modulo = 1000000007

mul a b = a * b `mod` modulo

combine a b =
    foldl' (\c n -> c `mul` inverse n) (foldl' (\c n -> c `mul` n) 1 [b+1..a]) [2..a-b]

inverse n =
    let (^^^) :: Integral a => Int64 -> a -> Int64
        a ^^^ 0 = 1
        a ^^^ b =
            let b' = b `div` 2
                a' = a ^^^ b'
                a'' = a' `mul` a' in
            if b `mod` 2 == 0
                then a''
                else a'' `mul` a
    in fromIntegral $ fromIntegral n ^^^ (modulo-2)


import Data.Char (digitToInt)
import Data.List ((\\), minimumBy, nub, sort)
import Data.Monoid (mconcat)

type Team = String
type Score = (Int, Int)
data Game = Game Team Team Score
data Stat = Stat Team Int Int Int
    deriving (Show, Eq)

instance Ord Stat where
    compare (Stat t1 s1 d1 g1) (Stat t2 s2 d2 g2) = mconcat [compare s1 s2, compare d1 d2, compare g1 g2, compare t2 t1]

getTeams = nub . concatMap (\(Game a b _) -> [a, b])

countStats games = let getScore x y | x > y     = 3
                                    | x == y    = 1
                                    | otherwise = 0
                       countStat stat@(Stat team score diff goal) (Game t1 t2 (x, y)) | team == t1 = Stat team (score + (getScore x y)) (diff + x - y) (goal + x)
                                                                                | team == t2 = Stat team (score + (getScore y x)) (diff + y - x) (goal + y)
                                                                                | otherwise  = stat
                   in reverse $ sort $ map (\team -> foldl countStat (Stat team 0 0 0) games) $ getTeams games

checkWin games = let ((Stat first _ _ _):(Stat second _ _ _):_) = countStats games
                 in first == "BERLAND" || second == "BERLAND"

main = do
    games <- fmap (map readGame . lines) getContents
    let teams = getTeams games
    let opponent = head $ teams \\ (getTeams $ filter (\(Game a b _) -> a == "BERLAND" || b == "BERLAND") games)
    let goodScores = filter (checkWin . flip (:) games . Game "BERLAND" opponent) [(x, y) | x <- [1..100], y <- [0..x-1]]
    case goodScores of
        [] -> putStr "IMPOSSIBLE"
        _  -> printAnswer $ minimumBy compareAnswers goodScores
    where
        readGame s = let [a, b, x:':':y:""] = words s
                     in Game a b (digitToInt x, digitToInt y)
        compareAnswers (x1, y1) (x2, y2) = if (x1 - y1) == (x2 - y2)
                                                then compare y1 y2
                                                else compare (x1 - y1) (x2 - y2)
        printAnswer (x, y) = putStr (show x) >> putStr ":" >> putStr (show y)


-- 2019-10-30 01:49:09.502708352 UTC
import Data.Maybe
import Control.Monad
import Text.Read
nat_para :: Integral i => i -> a -> (i -> a -> a) -> a
nat_para i x f = np (abs i)
             where np 0 = x
                   np i = let i' = i - 1
                           in f i' (np i')
hd :: [a] -> Maybe a
hd ([]) = Nothing
hd (x : _) = Just x
tl = drop 1
nat_cata :: Integral i => i -> a -> (a -> a) -> a
nat_cata i x f = nc (abs i)
             where nc 0 = x
                   nc i = f (nc (i - 1))
iF :: Bool -> a -> a -> a
iF (True) t f = t
iF (False) t f = f
list_para :: [b] -> a -> (b -> [b] -> a -> a) -> a
list_para ([]) x f = x
list_para (y : ys) x f = f y ys (list_para ys x f)
magiciF :: Bool -> String
magiciF b = if b then "EASY" else "HARD"
uncurry' f (a, b, c) = f a b c
parser :: String -> (Int, Int, Int)
parser = fromJust . parse2Input
parse2Input :: String -> Maybe (Int, Int, Int)
parse2Input i = do {when (length (lines i) /= 1) Nothing;
                    ns <- mapM readMaybe $ words i :: Maybe ([Int]);
                    when (length ns /= 3) Nothing;
                    let {[a, b, c] = ns};
                    return (a, b, c)}
solve = \a b c -> iF ((c >= a) && (b >= a)) "Yes" "No"
main = getContents >>= (\c -> putStrLn (uncurry' solve (parser c)))


import Data.List

solve :: String -> String
solve s
    | null $ intersect s "HQ9" = "NO"
    | otherwise = "YES"

main :: IO ()
main = interact solve


countLetters :: String -> Char -> Int
countLetters str c = length $ filter (== c) str

main :: IO ()
main = do
  input_str <- getLine
  -- let input_str = "nmehhjrhirniitshjtrrtitsjsntjhrstjehhhrrerhemehjeermhmhjejjesnhsiirheijjrnrjmminneeehtm"
  -- let input_str = "ihimeitimrmhriemsjhrtjtijtesmhemnmmrsetmjttthtjhnnmirtimne"
  -- print input_str
  let n = countLetters input_str 'n'
  let e = countLetters input_str 'e'
  let i = countLetters input_str 'i'
  let t = countLetters input_str 't'

  -- print n
  -- print e
  -- print i
  -- print t

  let z = if div (n-1) 2 < 0 then 0 else div (n-1) 2

  let ncount = min ( min ( min z (div e 3) ) i ) t
  print ncount
  -- print min ( min ( min ( n `mod` 3 ) ( e `mod` 3 ) i ) t )


import Control.Applicative
import Data.List

main = do
	[n,d]<- map read.words <$> getLine ::IO [Int]
	a<- map read.words <$> getLine ::IO [Int]
	m<-   read  <$> getLine ::IO Int
	print $ if m < n then sum(take m ( sort a)) else (sum a) - d*(m-n)


fastpow :: Integer -> Integer
fastpow 0 = 1
fastpow timer = (((fastpow (timer - 1) * 4) `mod` 1000000007) ^ 2) `mod` 1000000007

main = do
  entry <- getContents
  let n = read (head . lines $ entry) :: Integer
  let ans = (fastpow (n - 1) * 6) `mod` 1000000007
  print(ans)


import Control.Applicative
import Data.List
import Data.Array

proc1 n ((a,b),c) | a==1 && b==n = ((a,b),c)
                  | a==1 = ((a,b+1),c+1)
                  | b==n = ((a-1,b),c+1)
                  |otherwise = ((a-1,b+1),c+2)

--map proc2 $ map (proc1 n ) e
process::Int->[Int]->Int
process n ss =  (sum ss) + snd e
  where d = array ((1,1),(n,n)) $ [((i,j),-1)| i<-[1..n],j<-[1..(i-1)]] ++ [((i,i),s!!(i-1))| i<-[1..n]] ++ [((i,j), d!(i,j-1)+s!!(j-1))|i<-[1..n],j<-[(i+1)..n]]
        s = map (\z-> if z==1 then -1 else 1) ss
        m = maximum $ elems d
        e= head $ filter (\z-> snd z ==m) $ assocs d

main=do
  n<- read  <$> getLine ::IO Int
  s<-map read <$> words<$> getLine ::IO [Int]
  print $ process n s


import Data.Char
import Data.List
main=getLine>>getLine>>=putStrLn.solve
solve c|n==26="YES"|otherwise="NO"where n=length$nub$map toLower c


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

main = do
		[n,a]<-map read <$> words <$> getLine ::IO [Int]
		let x = mod n a
		let y = div n a
		putStrLn $ intercalate " " $ map show $ (replicate x (y+1)) ++ (replicate (a-x) y)


main = do
        input <- getLine
        let list = map read (words input) :: [Int]
            a = list !! 0
            b = list !! 1
        putStrLn (if abs (a - b) > 1 || (a == 0 && b == 0) then "NO" else "YES")


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

main = putStr . evalState app . B.words =<< B.getContents

app = (unlines . map show) `fmap` liftM2 solve poi poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined (to64 . fst) . B.readInt

to64 x = fromIntegral x :: Int64

solve n k = map (min (n - k)) [if k == 0 then 0 else 1, 2 * k]


main = do
    getLine
    s <- getLine
    print $ maximum $ map length $ map (filter (\c -> 'A' <= c && c <= 'Z')) $ words s


import Control.Arrow

f p = let n = length p in last $ "OK" : ["BUG" | i <- [1 .. n - 1], (a, b) <- [p!!i], (c, d) <- take (i - 1) p, abs (a - c) + abs (b - d) <= 1]

g d = case d of
	'L' -> id *** pred
	'R' -> id *** succ
	'U' -> succ *** id
	'D' -> pred *** id

main = do getLine >>= putStrLn . f . scanl (flip g) (0, 0)


f x = ((maximum x) - (minimum x))  `div` 2

main = do
    s <- getLine
    x <- getLine
    let y = map read $ words  x
    putStrLn $ show $ (minimum y) + (f y)


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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
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 qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  [x, m] <- getInts

  let m' = until odd (`div` 2) m

  putStrLn $ if x `mod` m' == 0 then "Yes" else "No"


{-# LANGUAGE NPlusKPatterns #-}
module Main where

isBW :: [[Char]] -> Bool
isBW = all (all (flip elem "BWG"))

messageBW :: Bool -> String
messageBW = bool "#Black&White" "#Color"

bool :: a -> a -> Bool -> a
bool t _ True = t
bool _ f False = f

main :: IO ()
main = do
    [n, m] <- getInts
    rows <- iterm n getLetters
    putStrLn $ messageBW $ isBW rows

getLetters :: IO [Char]
getLetters = fmap (concat . words) getLine

iterm :: (Functor m, Monad m) => Int -> m a -> m [a]
iterm 0 p = return []
iterm (n + 1) p = p >>= (\a -> fmap (a:) (iterm n p))

getInts :: IO [Int]
getInts = fmap (map read . words) getLine


main = readLn >>= putStrLn . solve

solve 0 = "1"
solve n
    | n > 36 = "-1"
    | odd n = replicate (n `div` 2) '8' ++ "9"
    | otherwise = replicate (n `div` 2) '8'


import Control.Applicative
import Data.Int

main = do
  m <- (read :: String -> Int64) <$> getLine
  print $ bs m 0 4949100894494448

f :: Int64 -> Int64
f n = sum [n `div` x ^ 3 | x <- [2..(ceiling $ fromIntegral n ** (1/3))] ]

bs :: Int64 -> Int64 -> Int64 -> Int64
bs m l r
    | r - l == 1 = if f r == m then r else -1
    | f c < m = bs m c r
    | otherwise = bs m l c
      where c = (l + r) `div` 2


import Data.List
import Data.Maybe
import Data.Char
import Data.Function
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve. map read.words.head. lines
solve :: [Integer]->String
solve [x,y] = unwords [show fx,show fy] where
  fx = minimum [x,y]
  fy = maximum [abs x-fx,abs y-fx] `div` 2


import qualified Data.Map as Map

main :: IO()
main = print . solve . map read . words =<< getLine

data Queue a = Queue {
  inbox :: [a],
  outbox :: [a]
} deriving (Eq, Show)

initQueue :: Queue a
initQueue = Queue [] []

push :: a -> Queue a -> Queue a
push e (Queue inb out) = Queue (e:inb) out

pop :: Queue a -> (a, Queue a)
pop q@(Queue inb []) = pop $ Queue [] (reverse inb)
pop (Queue inb outb) = (head outb, Queue inb (tail outb))

isEmptyQueue :: Queue a -> Bool
isEmptyQueue (Queue inbox outbox) = null inbox && null outbox

initMap :: Int -> Map.Map (Int, Int) Double
initMap n = Map.fromList [((i, j), 0.0) | i <- [1..n], j <- [1..i]]

removeMaybe :: Maybe Double -> Double
removeMaybe (Just x) = x

tryPush :: Int -> (Int, Int) -> Queue (Int, Int) -> Queue (Int, Int)
tryPush n p@(i, j) q | i > n || j > i = q
                     | otherwise = push p q

tryAdjust :: (Double -> Double) -> (Int, Int) -> Map.Map (Int, Int) Double -> Map.Map (Int, Int) Double
tryAdjust f (i, j) m | Map.member (i, j) m = Map.adjust f (i, j) m
                     | otherwise = m

solve :: [Int] -> Int
solve [n, t] = Map.size $ Map.filter (== 1.0) $ dumping (initMap n) t
    where dumping :: Map.Map (Int, Int) Double -> Int -> Map.Map (Int, Int) Double
          dumping m 0 = m
          dumping m t = let nextMap = Map.adjust (+ 1.0) (1, 1) m
                            nextQueue = push (1, 1) initQueue
                        in dumping (flow nextQueue nextMap) (t - 1)

          flow :: Queue (Int, Int) -> Map.Map (Int, Int) Double -> Map.Map (Int, Int) Double
          flow q m | isEmptyQueue q = m
                   | otherwise = let ((i, j), nextQueue) = pop q
                                     volumn = removeMaybe $ Map.lookup (i, j) m
                                     halfVol = (volumn - 1.0) * 0.5
                                 in if volumn > 1.0
                                    then let nextMap1 = Map.adjust (const 1.0) (i, j) m
                                             nextMap2 = tryAdjust (+ halfVol) (i + 1, j) nextMap1
                                             nextMap3 = tryAdjust (+ halfVol) (i + 1, j + 1) nextMap2
                                             nextQueue1 = tryPush n (i + 1, j) nextQueue
                                             nextQueue2 = tryPush n (i + 1, j + 1) nextQueue1
                                         in flow nextQueue2 nextMap3
                                    else flow nextQueue m


solve s = s' s 0 0
    where s' (p:ps) x y
              | p == 'U' = s' ps x (y + 1)
              | p == 'D' = s' ps x (y - 1)
              | p == 'R' = s' ps (x + 1) y
              | otherwise =  s' ps (x - 1) y
          s' [] x y = (length s) - ((abs x) + (abs y))

main = do
    getLine
    getLine >>= print.solve


{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n1 <- readInt
    n2 <- readInt
    k1 <- readInt
    k2 <- readInt
    return (n1, n2, k1, k2)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (n1, n2, k1, k2) = countWays (n1, n2, 0, True) `mod` (10^8)
  where
    countWays :: (Int, Int, Int, Bool) -> Integer
    countWays (_, _, c, True) | c > k1 = 0
    countWays (_, _, c, False) | c > k2 = 0
    countWays (a, b, c, flag) = cache ! (a, b, c, flag)
      where
        bnds = ((0, 0, 0, False), (100, 100, 10, True))
        cache = listArray bnds $ map go $ range bnds :: Array (Int, Int, Int, Bool) Integer

        go (0, 0, _, _) = 1
        go (a, b, c, flag) = goA + goB
          where
            goA | a == 0    = 0
                | otherwise = countWays (a - 1, b, c + 1, flag)
            goB | b == 0    = 0
                | otherwise = countWays (b - 1, a, 1, not flag)

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


import Control.Applicative
import Data.List

f a b = case (a,b) of
    ((-1), 1 ) -> 1
    (1, (-1))  -> 1
    (1,1) -> 2
    _ -> 0

main = do
    [n,a] <- map (read :: String -> Int) . words <$> getLine
    ts <- map (read :: String -> Int) . words <$> getLine
    print $ let
                (b',c) = splitAt a ts
                b = reverse b'
                d = sum $ zipWith f(tail b ++ replicate (length c) (-1)) (c ++ replicate (length b) (-1))
            in d + head b


import Data.List

main = do
  _ <- getLine
  roboCoderIdx <- (elemIndices "1" . words) <$> getLine :: IO [Int]
  bionicSolverIdx <- (elemIndices "1" . words) <$> getLine :: IO [Int]
  putStrLn $ show $ solve roboCoderIdx bionicSolverIdx

solve :: [Int] -> [Int] -> Int
solve roboCoderIdx bionicSolverIdx =
  let distance = length $ bionicSolverIdx \\ roboCoderIdx
      superiority = length $ roboCoderIdx \\ bionicSolverIdx
  in  if superiority == 0 then -1 else distance `div` superiority + 1


import Control.Applicative
import Data.List
import Data.Maybe
-- import Debug.Trace

-- debug = flip trace

isPossible :: String -> String -> Bool
isPossible a b = sortedA <= b
    where sortedA = sort a

solve' :: String -> String -> String
solve' [] [] = []
solve' as (b:bs)
    | found == False = hiChar : (reverse . sort $ pre ++ rem) -- `debug` "not found = " ++ pre ++ " " ++ rem
    | poss == False = hiChar : (reverse . sort $ pre ++ rem) -- `debug` "not pos = " ++  pre ++ " " ++ rem
    | otherwise = b : (solve' remList bs) -- `debug` "otherwise = " ++  pre ++ " " ++ rem
    where found = b `elem` as
          hiChar = maximum $ filter (< b) as
          hiPos = fromJust $ findIndex (== hiChar) as
          (pre, suf) = splitAt hiPos as
          rem = tail suf
          pos = fromJust $ elemIndex b as
          (pre', suf') = splitAt pos as
          remList = pre' ++ (tail suf')
          poss = isPossible remList bs

solve :: String -> String -> String
solve a b
    | length a < length b = reverse . sort $ a
    | otherwise = solve' a b

main :: IO ()
main = do
    a <- getLine
    b <- getLine
    putStrLn $ solve a b


import Data.Ratio

solve :: Int -> Ratio Int
solve x = (6 - x + 1) % 6

main = do
  toBeat <- maximum <$> fmap read <$> words <$> getLine
  let ans = solve toBeat
  putStrLn $ mconcat [(show $ numerator ans), "/", (show $ denominator ans)]


import Debug.Trace

type Input  = (Int, [Int], [Int])
type Output = Maybe (Int, Int)

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

parse :: String -> Input
parse content =
    let [n, a, b] = lines content
        readLine  = map read . tail . words
    in  (read n, readLine a, readLine b)

data Queue = Queue ([Int], [Int])

instance Show Queue where
    show (Queue (a, b)) = show (a ++ [0] ++ (reverse b))

empty :: Queue -> Bool
empty (Queue ([], _)) = True
empty otherwise       = False

balance :: ([Int], [Int]) -> Queue
balance ([], c) =
    let n      = length c
        (a, b) = splitAt (n `div` 2) c
    in Queue (reverse b, a)
balance queue = Queue queue

push :: Queue -> Int -> Queue
push (Queue (a, b)) k = balance (a, k : b)

pop :: Queue -> (Int, Queue)
pop (Queue (a : as, b)) = (a, balance (as, b))

fromList :: [Int] -> Queue
fromList a = Queue (a, [])

solve :: Input -> Output
solve (n, a, b) =
    let bound = (product [1..n])
        simulate step a b
            | step > bound = Nothing
            | empty a      = Just (step, 2)
            | empty b      = Just (step, 1)
            | otherwise    =
                let (x, as) = pop a
                    (y, bs) = pop b
                in if x > y
                   then simulate (step + 1) (as `push` y `push` x) bs
                   else simulate (step + 1) as (bs `push` x `push` y)
    in simulate 0 (fromList a) (fromList b)

format :: Output -> String
format Nothing       = "-1"
format (Just (a, b)) = unwords . map show $ [a, b]


import Control.Monad;
import Control.Applicative;

simplify a b = show (a' `div` k) ++ "/" ++ show (b `div` k)
  where k = gcd a' b
        a' = max 0 (min a b)

solve t w b = simplify ((t `div` lcm) * n + min n (rest + 1) - 1) t
  where lcm = (w * b) `div` gcd w b
        rest = t `mod` lcm
        n = min w b

main = do
    [t, w, b] <- ((map (read) . words) <$> getLine) :: IO [Integer]
    putStrLn(solve t w b)


f a o b | a == 0 && o < b = [] | otherwise = (a + (o `div` b)):(f ((a + (o `div` b)) `div` b) (o `mod` b + (a + (o `div` b)) `mod` b) b)
main = do
	str <- getLine
	let [frs, scn] = words str
	print . sum $ f (read frs) 0 (read scn)


import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve . map read.take (5) . lines
solve :: [Int]->Int
solve [a,b,c,d,e] =sum [y| x<-[1..e], let y=if x `mod` a ==0|| x `mod` b ==0||x `mod` c ==0 ||x `mod` d ==0 then 1 else 0 ]


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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  let divisors = [id, (n `div`)] <*> filter ((== 0) . (n `mod`)) [1 .. ceiling $ sqrt $ fromIntegral n]
  (\(a, b) -> putStrLn $ show a ++ " " ++ show b) $ minimumBy (comparing $ uncurry lcm) [(d, n - d) | d <- divisors, d /= n]


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

solve :: Int -> [Int] -> [Int]
solve i (n:p) | null p = [-1]
              | otherwise = let ([a, b, c, d], ps) = splitAt 4 p
                                m1 = min a b
                                m2 = min c d
                            in if m1 + m2 <= n
                               then [i, m1, n - m1]
                               else solve (i + 1) (n:ps)


{-# 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
  let
    read = do
      a <- getLine
      b <- getLine
      return $ filter (/= 'X') $ a ++ reverse b

  a <- read
  b <- read

  let
    rotate s = tail s ++ [head s]

    as = take 3 $ iterate rotate a

  putStrLn $ if b `elem` as then "YES" else "NO"


import Control.Monad
main = do
    a <- liftM read getLine
    putStrLn $ show $ (1 + a*(a+1)*3)


module Main (main) where

import Control.Monad
import Control.Applicative

solve :: Int -> Int -> Int
solve 0 _ = 0
solve n k = go n k 0 0
    where
        go _ 0 _ c = c
        go 0 _ d _ = d - 1
        go n k d c =
            let (q, r) = n `quotRem` 10 in
                if r == 0 then go q (k-1) (d+1) c
                          else go q k (d+1) (c+1)

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


import Prelude
import List
import Char
import Data.Ord
import Data.List

main = interact q

q = func.lines

func::[[Char]]->String
func    = solve.map f'
    where
      f'::[Char]->(Char,Char)
      f' (a:b:c:[]) | b == '>' = (a,c)
                    | b == '<' = (c,a)

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::[(Char,Char)]->String
solve a | length a' == 2 && b = reverse ((fst$head$head a'):(fst$head$(!!) a' 1):(snd$head$(!!) a' 1):[])
        | otherwise           = "Impossible"
    where
      a' = reverse$sortBy (\a b->compare (length a) (length b))$groupBy (\(a,_) (b,_) -> a == b) $ sortBy (\(a,_) (b,_) -> compare a b) a
      b = ((fst$head$head a') /= (fst$head$(!!) a' 1)) && ((fst$head$head a') /= (snd$head$(!!) a' 1))


main = (print . solve) =<< readLn

solve :: Integer -> Integer
solve n = go 1 n cs
  where cs = 2 : takeWhile ((n >=) . (^ 2)) [3, 5..]
        go acc 1 _ = acc
        go acc x [] = acc * x
        go acc x (p:ps) | x `mod` p == 0 = go (acc * p) (x `divs` p) ps
        go acc x (_:ps) = go acc x ps

divs x y | x `mod` y == 0 = (x `div` y) `divs` y
divs x _ = x


main = interact $ show . solve . map read . words
solve [n,k] = sum [f 2,f 5,f 8] where
  f i = (i*n+k-1) `div` k


getInt = read `fmap` getLine :: IO Integer
getInts = (map read . words) `fmap` getLine :: IO [Integer]

main = do
    ary@[d,k,a,b,t] <- getInts
    print $ solve ary

solve :: [Integer] -> Integer
solve [d,k,a,b,t]
    | d <= k = d*a
    | t + k*a >= k*b = k*a + (d-k)*b
    | otherwise = car_time + f (d - k*m) where
        m = d `div` k
        car_time = (m-1)*t + m*a*k
        f d
            | d == 0 = 0
            | otherwise = min (d*a + t) (d*b)