import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Maybe
import Data.Ord
import Text.Printf

readInt = fst . fromJust . BS.readInt <$> BS.getLine

main :: IO ()
main = do
   n <- readInt
   values <- replicateM n readInt
   f values

f :: [Int] -> IO ()
f xs | nv xs == 1 = putStrLn "Exemplary pages."
     | mod (maxs - mins) 2 == 0 && (nv ds == 0 || (nv ds == 1 && (div (maxs+mins) 2) == head ds)) = printf "%d ml. from cup #%d to cup #%d.\n" amount (minl + 1) (maxl + 1)
     | otherwise = putStrLn "Unrecoverable configuration."
   where nv = length.nub
         maxs = maximum xs
         mins = minimum xs
         maxl = fromJust $ elemIndex maxs xs
         minl = fromJust $ elemIndex mins xs
         amount = div (maxs - mins) 2
         ds = xs \\ [maxs, mins]

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine
    cups <- replicateM n $ read `liftM` getLine

    let minCup = minimum cups
        maxCup = maximum cups
        meanCup = ( minCup + maxCup ) `div` 2
        diffCup = ( maxCup - minCup ) `div` 2
        meanCupCount = length $ filter ( == meanCup ) cups
        minCupIndex = case elemIndex minCup cups of
            Just n -> n+1
        maxCupIndex = case elemIndex maxCup cups of
            Just n -> n+1

    putStrLn $ if minCup == maxCup
        then "Exemplary pages."
        else if ( minCup + maxCup ) `mod` 2 /= 0 || meanCupCount /= n - 2
            then "Unrecoverable configuration."
            else show diffCup ++ " ml. from cup #" ++ show minCupIndex ++ " to cup #" ++ show maxCupIndex ++ "."

import Control.Monad (replicateM)
import Data.List (nubBy, sortBy)

type Result  =  Either String (Int, Int, Int)

solve :: [(Int, Int)] -> Result
solve xs
  | length xs' > 3  =  Left "Unrecoverable configuration."
  | otherwise  =  solve' xs'
  where
    xs'  =  nubBy (\a b -> snd a == snd b) $ sortBy (\a b -> compare (snd a) (snd b)) xs
    solve' [_]  =  Left "Exemplary pages."
    solve' [(n1, a), (n2, b)]
      | odd (b - a)  =  Left "Unrecoverable configuration."
      | length xs == 2  =  Right (n1, n2, div (b - a) 2)
      | otherwise  =  Left "Unrecoverable configuration."
    solve' [(n1, a), (n2, b), (n3, c)]
      | c - b /= b - a  =  Left "Unrecoverable configuration."
      | length (filter (\(n, x) -> x == a) xs) > 1  =  Left "Unrecoverable configuration."
      | length (filter (\(n, x) -> x == c) xs) > 1  =  Left "Unrecoverable configuration."
      | otherwise  =  Right (n1, n3, b - a)

showResult :: Result -> String
showResult (Left s)  =  s
showResult (Right (n, m, x))  =
    concat [show x, " ml. from cup #", show n, " to cup #", show m, "."]

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  (replicateM n readLn) :: IO [Int]
    let result  =  solve $ zip [1..] as
    putStrLn $ showResult result

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine
    cups <- replicateM n $ read `liftM` getLine

    let minCup = minimum cups
        maxCup = maximum cups
        meanCup = ( minCup + maxCup ) `div` 2
        diffCup = ( maxCup - minCup ) `div` 2
        meanCupCount = length $ filter ( == meanCup ) cups
        minCupIndex = case elemIndex minCup cups of
            Just n -> n+1
        maxCupIndex = case elemIndex maxCup cups of
            Just n -> n+1

    putStrLn $ if minCup == maxCup
        then "Exemplary pages."
        else if ( minCup + maxCup ) `mod` 2 /= 0 || meanCupCount /= n - 2
            then "Unrecoverable configuration."
            else show diffCup ++ " ml. from cup #" ++ show maxCupIndex ++ " to cup #" ++ show minCupIndex ++ "."


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

buildPairs :: [(Char, Char)] -> Array Char Char
buildPairs list = listArray ('a', 'z') [findPair c | c <- ['a'..'z']] where
    findPair c = case find ((== c) . fst) list of
        Nothing -> 'Z'
        Just c' -> snd c'

present :: Array Char Char -> Char -> (Int, Int)
present ps a =
   let a' = ps ! a
   in if a < a' then (1, 0)
                else (0, 1)

split :: Array Char Char -> [Char] -> [(Int, Int)]
split ps [c] = present ps c : []
split ps (a:b:str') = let
    (a1, a2) = present ps a
    ret@((r1, r2):ret') = split ps (b:str')
  in if ps ! a == b || a == b
       then (r1 + a1, r2 + a2) : ret'
       else (a1, a2) : ret

solve ps str = sum $ map (uncurry min) $ split ps str

main = do
    str <- getLine

    n <- liftM read getLine
    list <- liftM concat $ replicateM n $ do
        [a, b] <- getLine
        return [(a, b), (b, a)]

    let ans = solve (buildPairs list) str

    print ans

import qualified Data.Map as Map
import Data.List
s (m : _ : t) = minimum $ foldl' step (replicate 26 0) m where
  enemies = Map.fromList (map (\[a,b]->(a,b)) t ++ map (\[a,b]->(b,a)) t)
  enemy a = Map.lookup a enemies
  step acc ch = sum acc `seq` case enemy ch of
    Nothing -> [if a == ch then minimum acc else n+1 |(a, n) <- zip ['a'..] acc]
    Just nme -> [if a == ch then minimum (map snd $ filter (\(b, n) -> b /= nme) $ zip ['a'..] acc) else n+1 |(a, n) <- zip ['a'..] acc]
main = interact $ show . s . lines

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.Map.Strict as M

match !n !m _ _ [] = (min n m,[])
match !n !m c d xs@(x:xt)
  | x == c    = match (n+1) m c d xt
  | x == d    = match n (m+1) c d xt
  | otherwise = (min n m, xs)

next pairs str = go str
  where
    go [] = (0,[])
    go (c:cs) = case M.lookup c pairs of
                  Nothing -> go cs
                  Just d  -> match 1 0 c d cs

toMap plist = M.fromList (concatMap f plist)
  where f (a:b:_) = [(a,b),(b,a)]

solve pairs [] = []
solve pairs str =
  let (k,str') = next pairs str
  in k : solve pairs str'

test1 = solve (toMap ["pg","nb"]) "pgpgppgggpbbnnn"

main = do
  str <- getLine
  n <- fmap read getLine
  plist <- replicateM n getLine
  let pairs = toMap plist
      answer = sum $ solve pairs str :: Int
  print answer

import Data.List
import Data.Map(Map)
import qualified Data.Map as M
import Control.Applicative

main = do cs <- getLine
          _  <- getLine
          mcc <- M.fromList . concatMap (\[x,y]->[(x,y),(y,x)]). lines <$> getContents
          print $ solve cs mcc

solve :: String -> Map Char Char -> Int
solve cs mcc = solve' mcc 0 [] cs

solve' :: Map Char Char -> Int -> String -> String -> Int
solve' mcc i _ [] = i
-- solve' mcc i _ [r] = i
solve' mcc i [] (r:rs) = solve' mcc i [r] rs
solve' mcc i (c:cs) (r:rs)
  | Just r == M.lookup c mcc = let (xs,xs') = span (c==) (c:cs)
                                   (ys,ys') = span (flip elem [c,r]) (r:rs)
				   (j,zs)   = f. partition (c==) $ xs++ys
			       in solve' mcc (i+j) (zs++xs') ys'
  | otherwise = solve' mcc i (r:c:cs) rs

f (cs,rs)
  | lc <= lr  = (lc,rs)
  | otherwise = (lr,cs)
  where lc = length cs
        lr = length rs

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.Map.Strict as M

match !k d c [] = (k,[])
match !k d c xs@(x:xt)
  | x == d    = match (k+1) c d xt
  | otherwise = (k,xs)

next pairs str = go str
  where
    go [] = (0,[])
    go (c:cs) = case M.lookup c pairs of
                  Nothing -> go cs
                  Just d  -> match 1 d c cs

toMap plist = M.fromList (concatMap f plist)
  where f (a:b:_) = [(a,b),(b,a)]

solve pairs [] = []
solve pairs str =
  let (k,str') = next pairs str
  in k : solve pairs str'

main = do
  str <- getLine
  n <- fmap read getLine
  plist <- replicateM n getLine
  let pairs = toMap plist
      answer = sum $ map (`div` 2) $ solve pairs str :: Int
  print answer


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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Integer). words $ line
		--arr = if k == 0 then [(1::Integer)..n] else [(1::Integer)..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
		arr = [k+1, k..1] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x  ++ " ")) $ arr

main=interact$unwords.map show.f.map read.words
f [n,k] = [k+1,k..1]++[k+2..n]

printNumbers :: [Int] -> IO ()
printNumbers [] = return ()
printNumbers (x:[]) = do
    putStrLn    (show x)
printNumbers (x:xs) = do
    putStr      (show x)
    putStr      " "
    printNumbers xs

toNumbers :: String -> [Int]
toNumbers []    = []
toNumbers x     = val : (toNumbers xs)
                where
                    [(val,xs)] = reads x :: [(Int, String)]

main = do
    ns <- getLine
    let
        [n,k] = toNumbers ns
        in
        let
            (a,b) = splitAt (n-k) [1..n]
            in
            printNumbers ((reverse b) ++ a)
    return ()

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

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

solve :: [Int] -> [Int]
solve [n, k]  =  [n, n-1 .. n-k+1] ++ [1 .. n-k]

main :: IO ()
main  =  reads >>= putStrLn . intercalate " " . map show . solve

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

solve :: [Integer] -> [Integer]
solve [ n, k ] = [ n, n - 1 .. n - k + 1 ] ++ [ 1 .. n - k ]
solve _ = undefined

main=interact$unwords.map show.f.map read.words
f[n,k]=[n,n-1..n-k+1]++[1..n-k]

import Data.List
solve [n, k] = [n, n-1 .. n-k+1] ++ [1..n-k]
main = fmap (map read . words) getLine >>= putStrLn . intercalate " " . map show . solve

main=interact$unwords.map show.f.map read.words
f[n,k]=[k+1,k..1]++[k+2..n]

import Control.Applicative
import Data.List

process _ _ _ _ _ [] = -1
process a b sums cs n (s:ss)  | and [ cs>=a,cs <=b, sums-cs >=a, sums-cs <=b] = n
                              | otherwise = process a b sums (cs+s) (n+1) ss

main= do
	[a,b]<- map read. words <$> getLine ::IO [Int]
	putStrLn $ intercalate " " $ map show $  [b+1,b..1] ++ [b+2..a]

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. n - k]
    r . map show . intercalate " " . putStr

import Data.List

main = interact $ intercalate " " . (map show) . solve . map read . words

solve :: [Int] -> [Int]
solve (n:k:_) = [1..(n-k-1)] ++ reverse [(n-k)..n]

import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: [Int] -> [Int]
solve [n, k]  =  [n, n-1 .. n-k+1] ++ [1 .. n-k]

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

main=interact$unwords.map show.f.map read.words
f[n,k]=xs++n:ys
   where
     (xs,ys)=splitAt (k-1)[1..n-1]

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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Int). words $ line
		arr = if k == 0 then [1..n] else [1..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x ++ " ")) $ arr

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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Integer). words $ line
		arr = if k == 0 then [(1::Integer)..n] else [(1::Integer)..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x  ++ " ")) $ arr

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. k + 1]
    r . map show . intercalate " " . putStr

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. k + 1]
    r . map show . intercalate " " . print


{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds #-}

import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Traversable
import System.IO

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

getInt = fst . fromJust . B.readInt . dropCR <$> B.getLine

bshow = B.pack . show

query i = do
  B.putStrLn $ "? " <> bshow i
  hFlush stdout
  getInt

answer i = do
  B.putStrLn $ "! " <> bshow i
  hFlush stdout

main = do
  n <- getInt
  let m = (n + 1) `quot` 2
      inf = n + 1
  mv <- query m
  go 0 inf m mv (n + 1) inf

go l lv m mv r rv = assert (l < m && m < r) $
                    assert (lv > mv && mv < rv) $
                    case (m - l, r - m) of
  (1, 1) -> answer m
  (lw, rw) | lw > rw -> do let m' = (l + m) `quot` 2
                           mv' <- query m'
                           if mv' > mv
                             then go m' mv' m mv r rv
                             else go l lv m' mv' m mv
           | otherwise -> do let m' = (m + r) `quot` 2
                             mv' <- query m'
                             if mv' > mv
                               then go l lv m mv m' mv'
                               else go m mv m' mv' r rv

import System.IO
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

solve :: (Int, Int) -> (Int, Int) -> IO Int
solve (l, x) (r, y)
  | l == r = return l
  | l + 1 == r = return $ if x < y then l else r
  | l + 2 == r = get m >>= return . g
  | otherwise = f
  where
  m = (l + r) `quot` 2
  g z | z > x = l
      | z > y = r
      | otherwise = m
  f = do
    z1 <- get m
    z2 <- get (m + 1)
    if z1 < z2
      then solve (l, x) (m, z1)
      else solve (m + 1, z2) (r, y)

main :: IO ()
main = do
  [n] <- getInts
  x <- get 1
  y <- get n
  result <- solve (1, x) (n, y)
  C.putStrLn $ C.pack $ "! " ++ show result

-- For completeness, I will test the other output
-- methods provided by bytestring, though I expect
-- them to get ILE even despite NoBuffering and "flush"

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import Data.ByteString.Builder.Extra (flush)
import System.IO

import Control.Monad
import Control.Monad.Trans.State
--import Control.Monad.Trans.Class
import Data.Semigroup

query :: Int -> B.Builder
query pos = B.string7 "? " <> B.intDec pos <> B.char7 '\n'

solve :: Int -> Int -> State [P.ByteString] B.Builder
solve li ri
  | li == ri = pure $ B.string7 "! " <> B.intDec li <> B.char7 '\n'
  | otherwise = do
    let  mi = li + div (ri - li) 2
    ~[v1, v2] <- getInts 2
    (\rest -> query mi <> query (mi + 1) <> flush <> rest) <$> if  v1 < v2
      then  solve li mi
      else  solve (mi + 1) ri

mainFun :: State [P.ByteString] B.Builder
mainFun = do
  ~[n] <- getInts 1
  solve 1 n

type SP = StateT [P.ByteString]

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> B.Builder
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  --forM_ (P.toChunks $ B.toLazyByteString outp) S.putStr
  P.putStr $ B.toLazyByteString outp

-- TODO: clean up the imports a little if possible

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import Data.ByteString.Builder.Extra (flush)
import System.IO

import Control.Monad
import Control.Monad.Trans.State
--import Control.Monad.Trans.Class
import Data.Semigroup

query :: Int -> B.Builder
query pos = B.string7 "? " <> B.intDec pos <> B.char7 '\n'

solve :: Int -> Int -> State [P.ByteString] B.Builder
solve li ri
  | li == ri = pure $ B.string7 "! " <> B.intDec li <> B.char7 '\n'
  | otherwise = do
    let  mi = li + div (ri - li) 2
    ~[v1, v2] <- getInts 2
    (\rest -> query mi <> query (mi + 1) <> flush <> rest) <$> if  v1 < v2
      then  solve li mi
      else  solve (mi + 1) ri

mainFun :: State [P.ByteString] B.Builder
mainFun = do
  ~[n] <- getInts 1
  solve 1 n

type SP = StateT [P.ByteString]

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> B.Builder
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  forM_ (P.toChunks $ B.toLazyByteString outp) S.putStr

-- This is the result of my testing out a possible rework of my code
-- placeholder: Solving an interactive problem with purely functional
-- time travel. Unfortunately, the overhead of this incarnation is
-- unacceptably high. See the notes near main at the bottom.

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Applicative
import Control.Monad
import Control.Monad.Fail
import Data.Semigroup

query :: Int -> SIO Int
query pos = do
  ~[ans] <- getInts 1 -- Does it look dangerous to do this "before" printing?
  putBuilder $ B.string7 "? " <> B.intDec pos <> B.char7 '\n'
  ans <$ flush

solve :: Int -> Int -> SIO Int
solve li ri
  | li == ri = pure ri
  | otherwise = do
    let  mi = li + div (ri - li) 2
    v1 <- query mi
    v2 <- query $ mi + 1 -- Ask yourself: Why can't this be n+1?
    if  v1 < v2  then  solve li mi  else  solve (mi + 1) ri

mainFun :: SIO ()
mainFun = do
  [n] <- getInts 1
  ans <- solve 1 n
  putBuilder $ B.string7 "! " <> B.intDec ans <> B.char7 '\n'

newtype TwoState x y v = TwoState { runTwoState :: x -> y -> (v, x, y) }
type SIO = TwoState [P.ByteString] [B.Builder]

instance  Functor (TwoState x y)  where
  fmap fun act = TwoState $ \x y -> let
    (v, rx, ry) = runTwoState act x y
    in  (fun v, rx, ry)

  v <$ act = TwoState $ \x y -> let
    (_, rx, ry) = runTwoState act x y
    in  (v, rx, ry)

instance  Applicative (TwoState x y)  where
  pure v = TwoState $ \x y -> (v, x, y)

  act1 <*> act2 = TwoState $ \x0 y2 -> let
    (fun, x1, y0) = runTwoState act1 x0 y1
    (arg, x2, y1) = runTwoState act2 x1 y2
    in  (fun arg, x2, y0)

  liftA2 fun act1 act2 = TwoState $ \x0 y2 -> let
    (v1, x1, y0) = runTwoState act1 x0 y1
    (v2, x2, y1) = runTwoState act2 x1 y2
    in  (fun v1 v2, x2, y0)

instance  Monad (TwoState x y)  where
  act >>= fun = TwoState $ \x0 y2 -> let
    (arg, x1, y0) = runTwoState act x0 y1
    (res, x2, y1) = runTwoState (fun arg) x1 y2
    in  (res, x2, y0)

  act1 >> act2 = TwoState $ \x0 y2 -> let
    (_,   x1, y0) = runTwoState act1 x0 y1
    (res, x2, y1) = runTwoState act2 x1 y2
    in  (res, x2, y0)

  return = pure

instance  MonadFail (TwoState x y)  where
  fail = error

putBuilder :: B.Builder -> SIO ()
putBuilder v = TwoState $ \inp (c : cs) -> ((), inp, v <> c : cs)

flush :: SIO ()
flush = TwoState $ \inp cs -> ((), inp, mempty : cs)

getNext :: Int -> SIO [P.ByteString]
getNext k = TwoState $ \inp outp -> let
  (res, remInp) = splitAt k inp
  in  (res, remInp, outp)

getInts :: Int -> SIO [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putIntsB :: [Int] -> B.Builder
putIntsB li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

putInts :: [Int] -> SIO ()
putInts = putBuilder . putIntsB

main :: IO ()
main = do
  inpLi <- P.words <$> P.getContents
  let  ((), _remInput, output) = runTwoState mainFun inpLi [mempty]
  forM_ output $ \v -> B.hPutBuilder stdout v >> hFlush stdout

ns :: [Int]
ns = [1 .. 3000000]

-- Below are several alternate versions of main that each print every
-- number in ns to stdout. Most are acceptable, but one is not: the
-- one that accumulates its result via the time travel monad.

-- This version took 140ms on Codeforces custom invocation. It's
-- probably close to ideal in terms of output speed in Haskell.  It's
-- only around 30% slower at this task than the fast hand-rolled
-- fwrite-buffer and putchar C++ implementations at the blog
-- https://codeforces.com/blog/entry/74544 and exceeds the "good
-- enough" threshold by a lot.
--main = B.hPutBuilder stdout $ putIntsB ns

-- This version took 218ms on Codeforces custom invocation. It's
-- probably the fastest version that makes for a fair comparison,
-- since it combines the results of many different putIntsB calls.
--main = B.hPutBuilder stdout $ mconcat [putIntsB [i] | i <- ns]

-- This version took 404ms on Codeforces custom invocation. It's the
-- base-line, representing something very close to what my current
-- StateT-based template can typically achieve. For comparison,
-- std::cout with C++17 (64) took 343ms, which should make clear that
-- this is still very much "good enough" and then some.
--main = forM_ ns $ \i -> B.hPutBuilder stdout $ putIntsB [i]

-- This version took 2199ms on Codeforces custom invocation and used 377684KB,
-- which would MLE on most Codeforces problems. This is unacceptable.
-- Obviously, some things are lingering longer than they should.
{-
main = do
  inpLi <- P.words <$> P.getContents
  let  fun = forM_ ns $ \i -> putInts [i]
  let  ((), _remInput, output) = runTwoState fun inpLi [mempty]
  forM_ output $ \v -> B.hPutBuilder stdout v >> hFlush stdout
-}

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import System.IO

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

outLine :: String -> SIO ()
outLine = lift . P.putStrLn . P.pack

solve :: Int -> Int -> SIO ()
solve li ri
  | li == ri = outLine ("! " ++ show li) >> lift (hFlush stdout)
  | otherwise = do
      let  mi = div (li + ri) 2
      outLine ("? " ++ show mi)
      outLine ("? " ++ show (mi+1))
      lift $ hFlush stdout
      [p] <- readInts
      [q] <- readInts
      if  p < q  then  solve li mi  else  solve (mi+1) ri

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  solve 1 n

import System.IO
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

solve :: Int -> Int -> IO ()
solve l r
  | r - l <= 10 = func1 l r >>= \i -> C.putStrLn $ C.pack $ "! " ++ show i
  | otherwise = func (l + 1) (r - 1)

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

func1 :: Int -> Int -> IO Int
func1 l r = do
  xs <- forM [l .. r] get
  return $ fst $ head $ filter (\(i, x) -> (i == l || x < xs !! (i - l - 1)) && (i == r || x < xs !! (i - l + 1))) $ zip [l .. r] xs

func :: Int -> Int -> IO ()
func l r = do
  x <- get l
  y <- get r
  let m1 = l + (r - l) `div` 3
      m2 = l + (r - l) * 2 `div` 3
  z1 <- get m1
  z2 <- get m2
  let f | z1 > x = solve l m1
        | z2 > y = solve m2 r
        | z1 < z2 = solve l m2
        | otherwise = solve m1 r
  f

main :: IO ()
main = do
  [n] <- getInts
  solve 1 n

import System.IO
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

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

solve :: Int -> Int -> IO ()
solve l r
  | r - l <= 3 = func1 l r >>= \i -> C.putStrLn $ C.pack $ "! " ++ show i
  | otherwise = func (l + 1) (r - 1)

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

func1 :: Int -> Int -> IO Int
func1 l r = do
  xs <- forM [l .. r] get
  return $ fst $ head $ filter (\(i, x) -> (i == l || x < xs !! (i - l - 1)) && (i == r || x < xs !! (i - l + 1))) $ zip [l .. r] xs

func :: Int -> Int -> IO ()
func l r = do
  x <- get l
  y <- get r
  let m1 = l + (r - l) `div` 3
      m2 = l + (r - l) * 2 `div` 3
  z1 <- get m1
  z2 <- get m2
  let f | z1 > x = solve l m1
        | z2 > y = solve m2 r
        | z1 < z2 = solve l m2
        | otherwise = solve m1 r
  f

main :: IO ()
main = do
  [n] <- getInts
  solve 1 n


import Monad (liftM)

used :: Int -> Int -> Int
used  =  (*)

notUsed :: (Int, Int, Int) -> (Int, Int) -> Int -> Int
notUsed (p1, p2, p3) (t1, t2) t
  | t <= t1  =  p1 * t
  | t <= t1 + t2  =  p1 * t1 + p2 * (t - t1)
  | otherwise  =  p1 * t1 + p2 * t2 + p3 * (t - t1 - t2)

solve :: (Int, Int, Int) -> (Int, Int) -> [(Int, Int)] -> Int
solve (p1, _, _) _ [(l, r)]  =  used p1 (r - l)
solve (p1, p2, p3) (t1, t2) ((l, r):xs)
    =  used p1 (r - l)
    +  notUsed (p1, p2, p3) (t1, t2) (fst (head xs) - r)
    +  solve (p1, p2, p3) (t1, t2) xs

readPair :: String -> (Int, Int)
readPair line  =  case words line of
    [a, b]  ->  (read a, read b)

main :: IO ()
main  =  do
    [n, p1, p2, p3, t1, t2]  <-  liftM (map read . words) getLine
    xs  <-  liftM (map readPair . take n . lines) getContents
    print $ solve (p1, p2, p3) (t1, t2) xs

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

process p1 p2 p3 t1 t2 [[a,b]] = (b-a)*p1
process p1 p2 p3 t1 t2 ([a,b]:[c,d]:es) = (((b-a)+ (min (c-b) t1))*p1 + (max 0 ((min  (c-b-t1) t2)*p2)) + (max 0 ( (c-b-t1-t2)  *p3))) + (process p1 p2 p3 t1 t2 ([c,d]:es) )

main = do
		[n,p1,p2,p3,t1,t2]<-map read <$> words <$> getLine ::IO [Int]
		a<-map (map read) <$> map words <$> replicateM n getLine ::IO [[Int]]
		let x = process p1 p2 p3 t1 t2 a
		print  x

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Numeric
fastRead !s = case readDec s of [(n, "")] -> n

parse :: String -> ((Int, Int, Int), (Int, Int), [Int])
parse foo = case map (map fastRead . words) $ lines foo of
              [_,p1,p2,p3,t1,t2]:xs -> ((p1,p2,p3), (t1,t2), concat xs)
              _ -> error "dupa"

solve ((p1,p2,p3), (t1,t2), xs@(x:_)) =
    loop x xs (p1,p2,p3) (t1,t2) 0

loop _ [] _ _ acc = acc
loop old (l:r:xs) ps@(p1,p2,p3) ts@(t1,t2) acc =
    loop r xs ps ts (acc + p1 * (min (l - old) t1) + (r - l)*p1 + m (p2 * (min (l - old - t1) t2)) + m (p3 * (l - old - t2 - t1)))

m = (max 0)

main = (print . solve . parse =<< getContents)

read_array = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    let l:r:_ = read_array s
    xs <- getLines (n-1)
    return ((l,r):xs)

get_delay len p1 p2 p3 t1 t2 = (min len t1)*p1 +
    (f (len-t1) t2)*p2 +
    (max (len-t1-t2) 0)*p3
        where f = \a b -> max 0 $ min a b

count _ [] _ _ _ _ _ _ = 0
count last_r ((l,r):xs) n p1 p2 p3 t1 t2= (r-l)*p1 +
    get_delay (l-last_r) p1 p2 p3 t1 t2 +
    count r xs n p1 p2 p3 t1 t2

main = do
    s <- getLine
    let n:p1:p2:p3:t1:t2:_ = read_array s
    lines <- getLines n
    let cost = count (fst $ head lines) lines n p1 p2 p3 t1 t2
    putStrLn $ show cost

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

solve :: [String] -> [String]
solve = fmap return $ do
  let readInts = map read . words
  [n, p1, p2, p3, t1, t2] <- readInts . head
  [l1, r1] : xs <- map readInts . take n . drop 1
  let f (t, total) [l, r] = (r, total + (r - l + d1) * p1 + d2 * p2 + d3 * p3)
        where interval = l - t
              d1 = min t1 interval
              d2 = min t2 (max 0 (interval - d1))
              d3 = max 0 (interval - d1 - d2)
  return . show . snd $ foldl' f (r1, (r1 - l1) * p1) xs

main :: IO ()
main = interact $ unlines . solve . lines

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

process p1 p2 p3 t1 t2 [[a,b]] = (b-a)*p1
process p1 p2 p3 t1 t2 ([a,b]:[c,d]:es) = (((b-a)+ (min (c-b) t1))*p1 + (min (c-b-t1) t2)*p2 + ( (c-b-t1-t2)  *p3)) + (process p1 p2 p3 t1 t2 ([c,d]:es) )

main = do
		[n,p1,p2,p3,t1,t2]<-map read <$> words <$> getLine ::IO [Int]
		a<-map (map read) <$> map words <$> replicateM n getLine ::IO [[Int]]
		print $ process p1 p2 p3 t1 t2 a


import Data.List

calculate :: Int -> [Int] -> Int -> Int -> Int -> Int
calculate _ _ _ 0 _ = 0
calculate x (first : rest) total len dayTotal = do
 let day = if (x < total) then 0 else (x - total) `div` len + 1
 let dayTotalNew = dayTotal + day
 let pack = day * len
 let totalNew = (total + len * day) - (first + dayTotalNew)
 pack + calculate x rest totalNew (len - 1) dayTotalNew

join :: String -> [String] -> String
join _ [x] = x
join delimiter (x : xs) = x ++ delimiter ++ join delimiter xs

ans :: IO String
ans = do
 nxInput <- getLine
 aInput <- getLine
 let [n, x] = [read e :: Int | e <- words nxInput]
 let a = [read e :: Int | e <- words aInput]
 let total = sum a
 let aSortedDescending = sortBy (flip compare) a
 let result = calculate x aSortedDescending total (length a) 0
 return (show result)

main :: IO ()
main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (join "\r\n" results)

import Data.List

calculate :: Int -> [Int] -> Int -> Int -> Int -> Int
calculate _ _ _ 0 _ = 0
calculate x (first : rest) total len dayTotal = do
 let day = if (x < total) then 0 else (x - total) `div` len + 1
 let dayTotalNew = dayTotal + day
 let pack = day * len
 let totalNew = (total + len * day) - (first + dayTotalNew)
 pack + calculate x rest totalNew (len - 1) dayTotalNew

join :: String -> [String] -> String
join _ [x] = x
join delimiter (x : xs) = x ++ delimiter ++ join delimiter xs

ans :: IO String
ans = do
 nxInput <- getLine
 aInput <- getLine
 let [n, x] = [read e :: Int | e <- words nxInput]
 let a = [read e :: Int | e <- words aInput]
 let total = sum a
 let aSorted = sort a
 let result = calculate x (reverse aSorted) total (length a) 0
 return (show result)

main :: IO ()
main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (join "\r\n" results)


import Data.Char

main :: IO()
main = print . solve =<< getLine

toBase64 :: Char -> Int
toBase64 c | '0' <= c && c <= '9' = ord c - ord '0'
           | 'A' <= c && c <= 'Z' = ord c - ord 'A' + 10
           | 'a' <= c && c <= 'z' = ord c - ord 'a' + 36
           | c == '-' = 62
           | c == '_' = 63

numOf0 :: Int -> Integer
numOf0 = numOf0' 6
    where numOf0' :: Int -> Int -> Integer
          numOf0' 0 _ = 0
          numOf0' n x | even x = 1 + numOf0' (n - 1) (x `div` 2)
                      | otherwise = numOf0' (n - 1) (x `div` 2)

modC :: Integer
modC = 1000000007

pow :: Integer -> Integer -> Integer
x `pow` y | y == 0 = 1
          | y == 1 = x `mod` modC
          | odd y = x * (x `pow` (y - 1)) `mod` modC
          | even y = let x' = x `pow` (y `div` 2)
                 in x' * x' `mod` modC

solve :: String -> Integer
solve s = let m = sum $ map (numOf0 . toBase64) s
          in 3 `pow` m

import qualified Data.Bits as B
import qualified Data.Map  as M
alphabet = ['0'..'9']++['A'..'Z']++['a'..'z']++"-_"
countNil :: Int -> Int
countNil x = 6 - B.popCount x
nullBits = M.fromList (zip alphabet $ map countNil [0..63])
solve :: String -> Integer
solve s = 3 ^ (sum $ map (nullBits M.!) s) `mod` (10^9 + 7)
main = putStrLn.show.solve =<< getLine


main :: IO ()
main = readLn >>= (\xs -> print (length xs) >> putStrLn (unwords (map show xs))). solve

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve 4 = [2, 4, 1, 3]
solve n = take n (concatMap (\k -> [k, k + (n + 1) `div` 2]) [1..])

-- Codeforces 534A

import Data.List
import Data.Maybe

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    let result = solve n
    putStrLn $ (show $ length result) ++ "\n" ++ concatMap (\x -> show x ++ " ") result

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve n = (reverse $ filter odd [1..n]) ++ (reverse $ filter even [1..n])

main=readLn>>=(\x->print(length x)>>putStrLn(unwords(map show x))).f
f n=(if n>3 then[2,4..n]else[])++[1,3..n]

import Data.List

gao' :: [Int] -> [Int] -> [Int] -> [Int]
gao' xs lt rt
  | null lt || null rt = xs
  | otherwise = gao' (xs ++ [head lt] ++ [head rt]) (tail lt) (tail rt)

gao :: Int -> [Int]
gao n
  | n == 1 || n == 2 = [1]
  | n == 3 = [1, 3]
  | n == 4 = [3, 1, 4, 2]
  | otherwise = case n `mod` 2 of 1 -> gao' [(n + 1) `div` 2] [1..n `div` 2] [n `div` 2 + 2..n]
                                  0 -> gao' [] [1..n `div` 2] [n `div` 2 + 1..n]

main :: IO()
main = do
  n <- getLine
  let res = gao $ read n
  print $ length res
  putStrLn . unwords $ map show res

import Data.List

solve :: [Int] -> [Int] -> [Int] -> [Int]
solve xs lt rt
  | null lt || null rt = xs
  | otherwise = solve (xs ++ [head lt] ++ [head rt]) (tail lt) (tail rt)

gao :: Int -> [Int]
gao n
  | n == 1 || n == 2 = [1]
  | n == 3 = [1, 3]
  | n == 4 = [3, 1, 4, 2]
  | otherwise = case n `mod` 2 of 1 -> solve [(n + 1) `div` 2] [1..n `div` 2] [n `div` 2 + 2..n]
                                  0 -> solve [] [1..n `div` 2] [n `div` 2 + 1..n]

main :: IO()
main = do
  n <- getLine
  let res = gao $ read n
  print $ length res
  putStrLn . unwords $ map show res

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  n <- readLn
  let (k, xs) = solve n
  print k
  putStrLn.unwords $ map show xs

solve :: Int -> (Int, [Int])
solve 1 = (1, [1])
solve 2 = (1, [1])
solve 3 = (2, [1, 3])
solve n = (n, go [3,1,4,2] [] [5..n])
   where
     go ls rs (x:y:xs) = go (x:ls) (y:rs) xs
     go ls rs [x] = x:ls ++ rs
     go ls rs [] = ls ++ rs

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import Control.Applicative
import Data.List

solve :: Int -> (Int, [Int])
solve 1 = (1, [1])
solve 2 = (1, [1])
solve 3 = (2, [1, 3])
solve n = (n, concat $ transpose [y, x])
          where
             (x, y) = splitAt (n `div` 2) [1..n]

main :: IO ()
main = do
  n <- read <$> getLine
  let (k, ks) = solve n
  putStrLn $ show k
  putStrLn $ unwords . map show $ ks

ans :: Int -> [Int]
ans 1 = [1]
ans 2 = [1]
ans 3 = [1, 3]
ans 4 = [3, 1, 4, 2]
ans n = [1, 3 .. n] ++ [2, 4 .. n]

main = getLine >>= \s' -> do
    let s = ans (read s')
    putStrLn . show $ length s
    putStrLn . unwords $ map show s

import Control.Applicative
import Data.List
import Data.Char

process 1 = (1, [1])
process 2 = ( 1,[1])
process 3 = (2,[1,3])
process 4 = (4, [3,1,4,2])
process n = (n, (filter (odd ) [1..n]) ++ (filter (even ) [1..n]))

myprint ( x,y) = do
			putStrLn $ show x
			putStrLn $ intercalate " " $ map show $ y

main= do
	n<- read <$>getLine  :: IO Int
	myprint $ process n

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

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

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

main = do
  n <- readLn

  let
    s = case n of
          1 -> [1]
          2 -> [1]
          3 -> [1, 3]
          4 -> [3, 1, 4, 2]
          n -> [1,3..n] ++ [2,4..n]

  print $ length s
  putStrLn $ unwords $ map show s

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = c:a:h b d

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

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

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

main = do
  n <- readLn

  let
    s = case n of
          1 -> [1]
          2 -> [1]
          3 -> [1, 3]
          4 -> [1, 4, 2]
          n -> [1,3..n] ++ [2,4..n]

  print $ length s
  putStrLn $ unwords $ map show s

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f 4 = [1, 4, 2]
f 5 = [1, 4, 2, 5, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = a:c:h b d

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f 4 = [1, 4, 2]
f 5 = [1, 4, 2, 5, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = c:a:h b d

main :: IO ()
main = readLn >>= (\xs -> print (length xs) >> putStrLn (unwords (map show xs))). solve

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve 4 = [1, 4, 2]
solve n = take n (concatMap (\k -> [k, k + (n + 1) `div` 2]) [1..])


import Control.Monad
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- filter (not . isSpace) . C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      getIndex (Node Nothing _ _) = 0
      getIndex (Node (Just (i, _)) _ _) = i
      step node@(Node (Just (idx, prev)) [] _) _ = Left (idx - getIndex prev)
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "~")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k

import Control.Monad
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- filter (not . isSpace) . C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      step node@(Node (Just (idx, _)) [] _) _ = Left idx
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
              getIndex (Node Nothing _ _) = 0
              getIndex (Node (Just (i, _)) _ _) = i
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      step node@(Node (Just (idx, _)) [] _) _ = Left idx
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
              getIndex (Node Nothing _ _) = 0
              getIndex (Node (Just (i, _)) _ _) = i
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "^")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "^")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhile isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k


import Data.List
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ show . fst . foldr work (0.0, 1.0) . sort . map read . tail . words

import Data.List

main=interact $ (++ "\n") . show . getAns 0 1. getArray

getArray :: String -> [Double]
getArray = reverse . sort . tail . map read . words

getAns :: Double -> Double -> [Double] -> Double
getAns x _ [] = x
getAns a b (x:xs) =
	let na = a * (1 - x) + b * x
	    nb = b * (1 - x)
	in if na > a then getAns na nb xs else a

import Data.List
import Text.Printf
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ printf "%.11f" . fst . foldr work (0 :: Double, 1) . sort . map read . tail . words

import Data.List
import Text.Printf

f :: [Double] -> Double
f x = let y = map (1.0-) x
      in (foldl1' (*) y) * (foldl1' (+) $ zipWith (/) x y)

main = do
             _ <- getLine
             l <- getLine
             let inp = reverse . sort $ map (\y -> read y :: Double) $ words l
             let ans = if head inp >= 1.0 then 1.0 else foldl1' max $ map f $ map (\y -> take y $ inp) [1..(length inp)]
             printf "%.10f\n" ans

import Data.List
import Text.Printf

g :: Double -> [Double] -> [Double] -> [Double]
g s l [] = l
g s l (x:xs) =
           if s >= 1.0 then l
           else g (s+x/(1.0 - x)) (x:l) xs
f x = let y = map (1.0-) x
      in (product y) * (sum $ zipWith (/) x y)

main = do
             _ <- getLine
             l <- getLine
             let inp = reverse . sort $ map (\y -> read y :: Double) $ words l
             let ans = if head inp >= 1.0 then 1.0 else f $ g 0.0 [] inp
             printf "%.10f\n" ans

import Data.List
import Text.Printf

f :: [Double] -> Double
f x = let y = map (1.0-) x
      in (foldl1' (*) y) * (foldl1' (+) $ zipWith (/) x y)

main = do
       _ <- getLine
       l <- getLine
       let inp = map (\y -> read y :: Double) $ words l
       printf "%.10f\n" $ foldl1' max $ map f $ map (\y -> take y $ reverse inp) [1..(length inp)]

import Data.List
import Text.Printf
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ printf "%.11f" . fst . foldr work (0 :: Float, 1) . sort . map read . tail . words


module Main where

import Control.Monad

f :: (Int, Int, Int) -> Double
f (m, w, x) =
    max (0.3 * fromIntegral x) ( (1.0 - fromIntegral m / 250.0) * fromIntegral x - 50.0 * fromIntegral w  )

main :: IO ()
main = do
    ms <- liftM (map (\c -> read c::Int) . words) getLine
    ws <- liftM (map (\c -> read c::Int) . words) getLine
    [h', h''] <- liftM (map (\c -> read c::Int) . words) getLine
    let r' = sum (map f (zip3 ms ws [500, 1000, 1500, 2000, 2500]))
        r'' = 100 * h' - 50 * h''
    putStrLn $ show $ floor (r' + fromIntegral r'')

module Main where

import Control.Monad
import Data.Ratio

getScore :: Integer -> Integer -> Integer -> Rational
getScore x m w = max ((3 * x) % 10) ((1 - m % 250) * (x % 1) - ((50 * w) % 1))

readIntegers :: IO [Integer]
readIntegers = liftM (map read . words) getLine

main :: IO ()
main = do
     let xs = [500, 1000, 1500, 2000, 2500] :: [Integer]
     ms <- readIntegers
     ws <- readIntegers
     [hs, hu] <- readIntegers

     let result = (sum $ zipWith3 getScore xs ms ws) + (100 * hs) % 1 - (50 * hu) % 1
     print $ numerator result

module Main where

    import Data.Ratio

    calcRes :: [(Integer,Integer,Integer)] -> Integer -> Integer -> Ratio Integer
    calcRes ts hs hu = sum (map (\(m,w,p) -> max (p*3%10) ((1-(m%250))*(p%1) - (50*w%1))) ts) +  (hs*100%1) - (hu*50%1)

    main :: IO ()
    main = do
      ms <- getLine
      ws <- getLine
      h <- getLine
      let ts = zip3 (map (read::String->Integer) $ words ms) (map (read::String->Integer) $ words ws) [500,1000,1500,2000,2500]
      let [hs,hu] = map (read::String->Integer) (words h)
      putStrLn $ head $ words $ show $ calcRes ts hs hu

calc :: Int -> Int -> Int -> Int
calc a b c =  max (a*150) ( a* (500 - (b*2)) - 50 * c)

solve :: [Int] -> Int
solve x = (calc 1 (x!!0) (x!!5)) + (calc 2 (x!!1) (x!!6))+ (calc 3 (x!!2) (x!!7))+ (calc 4 (x!!3) (x!!8))+ (calc 5 (x!!4) (x!!9)) + (x!!10) * 100 - (x!!11) * 50

readInt :: String -> Int
readInt = read

parse :: String -> String
parse x = show $ solve a where a = map readInt $ words x

main = interact parse

import Control.Applicative

points :: [Integer]
points = [500, 1000, 1500, 2000, 2500]

solve :: [Integer] -> [Integer] -> Integer -> Integer -> Integer
solve ms ws hs hu = sum (zipWith3 score points ms ws) + hs * 100 - hu * 50
                    where
                      score x m w = round $ max (0.3 * fi x) ((1 - fi m / 250) * fi x - 50 * fi w)
                      fi = fromIntegral

main :: IO ()
main = do
  ms <- map read . words <$> getLine
  ws <- map read . words <$> getLine
  [hs, hu] <- map read . words <$> getLine
  print $ solve ms ws hs hu

(|>) a b = b a

f x m w =
  max (0.3 * x) ((1 - m / 250) * x - 50 * w)

r s1 s2 s3 =
  let ms = s1 |> words |> map (read :: String -> Int)
      ws = s2 |> words |> map (read :: String -> Int)
      hs = s3 |> words |> map (read :: String -> Int)
      xs = [500, 1000, 1500, 2000, 2500]
      g zs y = fromIntegral (zs !! y)
      sum1 = [0..4] |> map (\y -> round $ f (g xs y) (g ms y) (g ws y)) |> sum
  in
      sum1 + (hs !! 0) * 100 - (hs !! 1) * 50

main = do
  s1 <- getLine
  s2 <- getLine
  s3 <- getLine
  print (r s1 s2 s3)

import System.IO

max_points :: [Int]
max_points = [500, 1000, 1500, 2000, 2500]

formula :: (Int, Int, Int) -> Int
-- x - max points, m - time, w - count of submissions
formula (x, m, w) = round $ max (0.3 * fromIntegral x) ((1 - fromIntegral m / 250.0) * fromIntegral x - 50 * fromIntegral w)

cnt_tasks :: Integer
cnt_tasks = 5

getPoints :: [Int] -> [Int] -> Int
getPoints a b = (sum . (map formula)) (zip3 max_points a b)

parseList :: String -> [Int]
parseList = (map read) . words

main :: IO ()
main = do
    let fin = stdin
--    fin <- openFile "tmp" ReadMode
    time_line <- hGetLine fin
    submissions_line <- hGetLine fin
    hacks_line <- hGetLine fin

    let [hacks_good, hacks_bad] = parseList hacks_line
    print $ getPoints (parseList time_line) (parseList submissions_line) + hacks_good * 100 - hacks_bad * 50

parseInput :: String -> ([Int], [Int], [Int])
parseInput input = (xs, ys, zs) where
    ls = lines input
    ws = map words ls
    xs = map read $ head ws
    ys = map read $ head $ tail ws
    zs = map read $ last ws

score :: [Int] -> [Int] -> Int
score ms ws = sum [max ((3*x) `div` 10) ((250 - m)*(x `div` 250) - 50*w) | (x, m, w) <- ds] where
    ps = [500, 1000, 1500, 2000, 2500]
    ds = zip3 ps ms ws

hacks :: [Int] -> Int
hacks hs = sum [h*p | (h, p) <- zip hs ps] where
    ps = [100, -50]

solve :: [Int] -> [Int] -> [Int] -> Int
solve ms ws hs = score ms ws + hacks hs

main :: IO ()
main = do
    input <- getContents
    let (ms, ws, hs) = parseInput input
    print $ solve ms ws hs


import System.IO
import Control.Monad
import Data.List
import Data.Maybe
import Data.Function
import qualified Data.Set as Set
main = do
    [t] <- ri
    tcs <- replicateM t rtc
    mapM (putStrLn . show . solve) tcs
ri = map read . words <$> getLine :: IO [Int]
rtc = do
    [_n] <- ri
    ri
solve xs = length xs - length suff
  where
    suff = tail . takeWhile (not.snd) . scanl' addElem (Set.empty, False) . reverse $ xs

    addElem (set, True ) _ = (set, True)
    addElem (set, False) newElem
        | ((==) `on` Set.size) set newSet  = (Set.empty, True )
        | otherwise                        = (newSet   , False)
      where
        newSet = newElem `Set.insert` set

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |nList==1 =0
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(nList-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |nList==1 =0
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(nList-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=reverse list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |r-l==1 =1
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(r-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=reverse list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

module Main
    where
import Control.Monad
import Data.List
myfind::Int->Int->Int->[Int]->Maybe Bool
myfind x ns ne y
    |ne==(-1)=Nothing
    |x==y!!ns =Just True
    |(ns+1)<ne =myfind x (ns+1) ne y
    |otherwise=Nothing

remainList::Int->Int->[Int]->Bool
remainList x ne y
    |(myfind x 0 ne y)==Nothing =True
    |otherwise=False

remainList2::Int->[Int]->[Int]
remainList2 _ []=[]
remainList2 n x
    |n==ne =x
    |remainList (x!!n) (n-1) x= remainList2 (n+1) x
    |otherwise=(take n x)
    where ne=length x
main::IO()
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line1<-getLine
    let nList=read line1::Int
    -- list length
    line2<-getLine
    let list=map read (words line2)::[Int]
    let listNew=reverse list
    print$nList-(length$remainList2 0 listNew)
    -- input list

import System.IO
import Control.Monad
import Data.List
import Data.Maybe
import Data.Function
import qualified Data.Set as Set
main = do
    [t] <- ri
    tcs <- replicateM t rtc
    mapM (putStrLn . show . solve) tcs
ri = map read . words <$> getLine :: IO [Int]
rtc = do
    [_n] <- ri
    ri
solve xs = length xs - length suff
  where
    suff = takeWhile (not.snd) . scanl' addElem (Set.empty, False) . reverse $ xs

    addElem (set, True ) _ = (set, True)
    addElem (set, False) newElem
        | ((==) `on` Set.size) set newSet  = (Set.empty, True )
        | otherwise                        = (newSet   , False)
      where
        newSet = newElem `Set.insert` set


main = do
	input <- getLine
	let n = read input :: Int
	fin <- getContents
	let size = map (map read) (map words (take n (lines fin))) :: [[Int]]
	let result = [x*y `div` 2 + x*y `mod` 2 | [x,y] <- size]
	mapM print result

divideAndCeil :: Int -> Int
divideAndCeil n
  | mod n 2 == 0 = div n 2
  | otherwise = div (n+1) 2

solve :: Int -> Int -> Int
solve n m
  | m == 1 = divideAndCeil n
  | m == 2 = n
  | otherwise = (solve n 2) + (solve n (m-2))

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

parse :: String -> String
parse input = show $ solve n m
  where [n, m] = map (\x -> read x :: Int) $ words input

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

infixl 0 >$>
(>$>) = flip ($)

main = C.interact $
  C.lines >>> drop 1 >>> map (C.words >>> map readInt >>> solve >>> show >>> C.pack) >>> C.unlines

readInt = C.readInt >>> fromJust >>> fst

solve [n,m]
  | even (n*m) = (n*m) `div` 2
  | otherwise  = (n*m) `div` 2 + 1

import           Control.Arrow
import           Control.Monad.State
import           Data.Array
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = C.interact $
  C.lines >>> drop 1 >>> map (C.words >>> map readInt >>> solve >>> show >>> C.pack) >>> C.unlines

readInt = C.readInt >>> fromJust >>> fst

solve [n,m]
  | even (n*m) = (n*m) `div` 2
  | otherwise  = (n*m) `div` 2 + 1

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:_) <- map read . words <$> getLine
    print $ (n * m + 1) `div` 2

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let (_:tokens) = split input
      vals = read <$> tokens :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []          -> Nothing
          (n:m:rest)  ->
            let numCells = n*m
                subres = (numCells + 1) `div` 2
            in  Just (subres, rest)
        ) vals
  sequence_ (putStrLn <$> (show <$> res))

import Control.Monad

parse :: [String] -> [[Integer]]
parse = map (\l -> map read . words $ l)

solve :: [Integer]->Integer
solve (n:m:[])
  | (even n) && (odd m) = n*(div m 2) + (div n 2)
  | (even n) && (even m) = n*(div m 2)
  | (odd n) && (n>=m) = (solve [(n-1),m])+ (div m 2)+(mod m 2)
  | otherwise = solve [m,n]

main :: IO ()
main = do
  n <- getLine
  content <- replicateM (read n :: Int) getLine
  putStrLn . unlines . map show . map solve . parse $ content

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

onecase = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		print $ div ((a*b) +1 ) 2

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

main :: IO ()
main = interact (unlines . map (show . solve) . parse)

parse :: String -> [(Int, Int)]
parse inp = [(x, y) | [x, y] <- map (map read . words) . tail $ lines inp]

solve :: (Int, Int) -> Int
solve (x, y) = quot (x*y + 1) 2


data Child = Child { index  :: Integer
                   , office :: Integer
                   , hall   :: Integer
                   , confid :: Integer
} deriving (Eq, Show)

decrease :: Integer -> [Child] -> [Child]
decrease vol = zipWith f [vol, vol - 1 .. ]
    where f x c = if x > 0 then c {confid = confid c - x} else c

simplify :: Integer -> [Child] -> [Child]
simplify _ [] = []
simplify vol (c:cs) =
    if confid c < vol
    then simplify (vol + hall c) cs
    else c {confid = confid c - vol} : simplify vol cs

gennady :: [Child] -> [Integer]
gennady [] = []
gennady (c:cs) = index c : gennady (simplify 0 $ decrease (office c) cs)

convert :: [[Integer]] -> [Child]
convert = zipWith (\i [v, d, p] -> Child i v d p) [1..]

parse = convert . map (map read . words) . tail . lines
ans xs = unlines [show (length xs), unwords (map show xs)]

main = putStr . ans . gennady . parse =<< getContents

import qualified Data.ByteString.Lazy.Char8 as B

data Child = Child { index  :: Integer
                   , office :: Integer
                   , hall   :: Integer
                   , confid :: Integer
} deriving (Eq, Show)

decrease :: Integer -> [Child] -> [Child]
decrease vol = zipWith f [vol, vol - 1 .. ]
    where f x c = if x > 0 then c {confid = confid c - x} else c

simplify :: Integer -> [Child] -> [Child]
simplify _ [] = []
simplify vol (c:cs) =
    if confid c < vol
    then simplify (vol + hall c) cs
    else c {confid = confid c - vol} : simplify vol cs

gennady :: [Child] -> [Integer]
gennady [] = []
gennady (c:cs) = index c : gennady (simplify 0 $ decrease (office c) cs)

convert :: [[Integer]] -> [Child]
convert = zipWith (\i [v, d, p] -> Child i v d p) [1..]

parse = convert . map (map read' . B.words) . tail . B.lines
    where read' s = case B.readInteger s of Just (n, _) -> n
ans xs = unlines [show (length xs), unwords (map show xs)]

main = putStr . ans . gennady . parse =<< B.getContents

module Main where

data Kid a = Kid {
    position :: a
  , vDoctor :: a
  , vHall :: a
  , confidence :: a
  }
  deriving (Show)

exit :: (Num a, Ord a) => a -> [Kid a] -> [Kid a]
exit _ [] = []
exit v (kid:kids)
  | conf' >= 0 = kid {confidence = conf'} : exit v kids
  | otherwise  = exit (v + vHall kid) kids
  where
    conf' = confidence kid - v

propagate :: (Num a, Eq a) => a -> [Kid a] -> [Kid a]
propagate _ []         = []
propagate 0 kids       = kids
propagate v (kid:kids) = kid {confidence = conf'} : propagate (v-1) kids
  where
    conf' = confidence kid - v

treat :: (Num a, Ord a) => [Kid a] -> [a]
treat (kid:kids) = position kid:(treat . exit 0 . propagate (vDoctor kid)) kids
treat [] = []

input1 :: [Kid Int]
input1 = [Kid 1 4 2 2, Kid 2 4 1 2, Kid 3 5 2 4, Kid 4 3 3 5, Kid 5 5 1 2]

input2 :: [Kid Int]
input2 =
    [Kid 1 4 5 1
    ,Kid 2 5 3 9
    ,Kid 3 4 1 2
    ,Kid 4 2 1 8
    ,Kid 5 4 1 9]

main :: IO ()
main = do
    contents <- getContents
    putStr (readAndTreat contents)

readAndTreat :: String -> String
readAndTreat input =
    let (first:allLines) = lines input
        n = read first
        kids = readAll n 1 allLines
        treated = treat kids
        resultLines = [show $ length treated, unwords $ map show treated]
        result = unlines resultLines
    in result

readAll :: (Num a, Read a, Show a, Ord a) => a -> a -> [String] -> [Kid a]
readAll n i _ | i > n = []
readAll _ i [] = error $ "End of file reached but only " ++ show i ++ " lines read."
readAll n i (l:ls) = Kid i vD vH c : readAll n (i+1) ls
  where [vD,vH,c] = map read $ words l

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (forM)
import Data.Maybe (catMaybes)

data Child = Child
    { i  :: !Int
    , vi :: !Integer
    , di :: !Integer
    , pi :: !Integer
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Integer -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Integer -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (pure, (<$>))
import Control.Monad (forM)

data Child = Child
    { i  :: !Int
    , vi :: !Integer
    , di :: !Integer
    , pi :: !Integer
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Integer -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Integer -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read <$> getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) <$> getLine
        pure $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

import           Control.Monad         (replicateM)
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS8
import           Data.Functor          ((<$>))
import           Data.List             (foldl', transpose)
import           Data.Maybe            (fromJust)
import Data.Int

update
  :: Int
  -> Int64
  -> [Int]
  -> [Int]
  -> [(Int64, Int)]
  -> ([Int], [Int], [(Int64, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + fromIntegral d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - val, snd p) : ps')
  where
    val =
      if x > 0
        then fromIntegral x + t
        else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int64, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- (fst . fromJust . BS8.readInt) <$> BS.getLine
  ls <- map (map (fst . fromJust . BS8.readInt) . BS8.words) <$> replicateM n BS.getLine
  let [vs, ds, ps] = transpose ls
      r = solve vs ds (zip (map fromIntegral ps) [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

type VHall = Int
type VDoctor = Int

data Kid = Kid {
    position :: Int
  , vDoctor :: Int
  , vHall :: Int
  , confidence :: Int
  }
  deriving (Show)

exit :: VHall -> [Kid] -> [Kid]
exit _ [] = []
exit v (kid:kids)
  | conf' >= 0 = kid {confidence = conf'} : exit v kids
  | otherwise  = exit (v + vHall kid) kids
  where
    conf' = confidence kid - v

propagate :: VDoctor -> [Kid] -> [Kid]
propagate _ []         = []
propagate 0 kids       = kids
propagate v (kid:kids) = kid {confidence = conf'} : propagate (v-1) kids
  where
    conf' = confidence kid - v

treat :: [Kid] -> [Int]
treat (kid:kids) = position kid:(treat . exit 0 . propagate (vDoctor kid)) kids
treat [] = []

input1 :: [Kid]
input1 = [Kid 1 4 2 2, Kid 2 4 1 2, Kid 3 5 2 4, Kid 4 3 3 5, Kid 5 5 1 2]

input2 :: [Kid]
input2 =
    [Kid 1 4 5 1
    ,Kid 2 5 3 9
    ,Kid 3 4 1 2
    ,Kid 4 2 1 8
    ,Kid 5 4 1 9]

main :: IO ()
main = do
    contents <- getContents
    putStr (readAndTreat contents)

readAndTreat :: String -> String
readAndTreat input =
    let (first:allLines) = lines input
        n = read first
        kids = readAll n 1 allLines
        treated = treat kids
        resultLines = [show $ length treated, unwords $ map show treated]
        result = unlines resultLines
    in result

readAll :: Int -> Int -> [String] -> [Kid]
readAll n i _ | i > n = []
readAll _ i [] = error $ "End of file reached but only " ++ show i ++ " lines read."
readAll n i (l:ls) = Kid i vD vH c : readAll n (i+1) ls
  where [vD,vH,c] = map read $ words l

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (forM)
import Data.Maybe (catMaybes)

data Child = Child
    { i  :: !Int
    , vi :: !Int
    , di :: !Int
    , pi :: !Int
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Int -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Int -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (replicateM)

data Child = Child
    { vi :: Int
    , di :: Int
    , pi :: Int
    } deriving (Show)

go :: Int -> [Child] -> [Int]
go i [] = []
go i (c@Child{..} : cs) =
    if pi < 0 then
        go (i + 1) $ map (\(Child vj dj pj) -> Child vj dj (pj - di)) cs
    else
        let other = map (\(delta, Child vj dj pj) -> Child vj dj (pj - (vi - delta))) $ zip [0..] cs
        in i : (go (i + 1) other)

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- replicateM n $ do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child v d p
    let ans = go 1 children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (replicateM)

data Child = Child
    { vi :: Int
    , di :: Int
    , pi :: Int
    } deriving (Show)

go :: Int -> [Child] -> [Int]
go i [] = []
go i (c@Child{..} : cs) =
    if pi < 0 then
        go (i + 1) $ map (\(Child vj dj pj) -> Child vj dj (pj - di)) cs
    else
        let other =
                map (\(delta, Child vj dj pj) -> Child vj dj (pj - max 0 (vi - delta)))
                $ zip [0..] cs
        in i : (go (i + 1) other)

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- replicateM n $ do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child v d p
    let ans = go 1 children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - val, snd p) : ps')
  where
    val = if x > 0 then x + t else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad
import           Data.Functor  ((<$>))
import           Data.List

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update 0 _ _ _ _ = ([], [], [])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - (x + t) < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', p : ps')
  where
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - x, snd p) : ps')
  where
    val = if x > 0 then x + t else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update 0 _ _ _ _ = ([], [], [])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - (x + t) < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - x, snd p) : ps')
  where
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r


import Data.List

main :: IO()
main = do
--	line <- getLine
	getLine >>= print . sum .  map ((\x -> x*x). toInteger . length) .  group . sort

import Data.List;
main = do getLine >>= putStr . show . sum . map ((^2) . toInteger . length) . group . sort

import List
main = interact(show.sum.map ((^2).toInteger.length).group.sort.head.lines)

import Data.List
main = interact (show.sum.map s.map length.group.sort.head.lines)
s :: Int -> Integer
s x = (fromIntegral x)^2

import Data.Map (elems, empty, insertWith')

solve :: String -> Integer
solve s  =  sum $ map (^2) $ map fromIntegral $ elems map'
  where
    map'  =  foldl (\map'' c -> insertWith' (+) c 1 map'') empty s

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

import List

main = getLine >>= print.solve

solve :: String -> Integer
solve = sum.map ((^2).genericLength).group.sort

import qualified Data.Map as Map
import qualified Data.List as List
import Data.Char

solve ss =
  List.foldl' (\ans (_, a) -> ans + a * (a - 1) + a) 0 $ Map.toList $ List.foldl' f (Map.empty) $ filter (not.isSpace) ss
    where f m x = Map.insertWith (+) x 1 m

main = interact (show.solve)

import List

main :: IO ()
main = do
    string <- getLine
    print (sum (map (\x -> (toInteger (length x)) ^ 2) (group (sort string))))

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

-- import Debug.Trace

-- debug = flip trace

debug = const

fact :: Integer -> Integer
fact 0 = 1
fact n = let prev = fact (n-1)
         in  prev `seq` n * prev

product' = foldl' (*) 1

perm n k =
  product' [n-k+1 .. n]

accStr arr (c:cs) =
  let val = arr ! (ind c)
  in arr `seq`  val `seq` accStr (arr // [ (ind c, val + 1) ]) cs
accStr arr [] = arr

empArr = listArray (ind 'a', ind '9') (repeat 0)

ind c
  | c `elem` ['a'..'z'] = ord c - ord 'a'
  | c `elem` ['0'..'9'] = ord c - ord '0' + ord 'z' - ord 'a' + 1

solve str =
  let arr = elems $ accStr empArr str
      cnt n | n >= 2 = perm n 2 + n
            | otherwise = n
      perms = map cnt arr
      sum' = foldl1' (+)
  in  sum' perms `debug` (show arr)

main = do
  str <- getLine
  print $ solve str

import Data.Map (Map)
import qualified Data.Map as Map
main = interact solve
solve input = show $ sum $ map (^2) $ map snd $ Map.toList $ count input
count [] = Map.fromList $ zip (['0'..'9']++['a'..'z']) [0,0..]
count (x:xs) = Map.adjust (+1) x (count xs)

import qualified Data.Map as Map

main :: IO()
main = do
	line <- getLine
	let	x = foldl (\acc x -> add x acc) [] line
		y = foldl (\acc (a, b) -> acc + (b*b)) 0 x
	print $ y

add :: Char -> [(Char, Integer)] -> [(Char, Integer)]
add ch [] = [(ch, 1)]
add ch ( (a, b) : xs  )
 | a == ch = (a, b+1) : xs
 | otherwise = (a, b) : add ch xs

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

import qualified Data.List as L
import qualified Data.Function as F
import qualified Data.Set as S
import qualified Data.Map as M

solve = sum . map count . L.group . L.sort . filter (/= '\n')
  where count x= let n = toInteger $ length x in n * (n - 1) + n

main = interact $ show . solve

type Mapa = [(Char, Integer)]

kapPoKap :: String -> String
kapPoKap = show . foldr (\x acc -> acc + x * x) 0 . mrmPoMrm

dodaj :: Char -> Mapa -> Mapa
dodaj c xs
  | c == '\n' = xs
  | notElem c $ fst $ unzip xs = (c, 1) : xs
  | otherwise = map (\(x, b) -> if x == c then (x, b + 1) else (x, b)) xs

mrmPoMrm :: String -> [Integer]
mrmPoMrm = snd . unzip . foldr dodaj []

main = interact $ kapPoKap

type Mapa = [(Char, Int)]

kapPoKap :: String -> String
kapPoKap = show . foldr (\x acc -> acc + x * x) 0 . mrmPoMrm

dodaj :: Char -> Mapa -> Mapa
dodaj c xs
  | c == '\n' = xs
  | notElem c $ fst $ unzip xs = (c, 1) : xs
  | otherwise = map (\(x, b) -> if x == c then (x, b + 1) else (x, b)) xs

mrmPoMrm :: String -> [Int]
mrmPoMrm = snd . unzip . foldr dodaj []

main = interact $ kapPoKap

kapPoKap :: String -> String
kapPoKap xs = show . length $ filter (\(x, y) -> x == y) [(x, y)|x <- xs, y <- xs]

main = interact $ kapPoKap

import Data.Map (elems, empty, insertWith')

solve :: String -> Int
solve s  =  sum $ map (^2) $ elems map'
  where
    map'  =  foldl (\map'' c -> insertWith' (+) c 1 map'') empty s

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

import qualified Data.Map as Map

main :: IO()
main = do
	line <- getLine
	let	x = foldl (\acc x -> add x acc) [] line
		y = foldl (\acc (a, b) -> max acc b) 0 x
	print $ fromIntegral(y)*fromIntegral(y)

add :: Char -> [(Char, Int)] -> [(Char, Int)]
add ch [] = [(ch, 1)]
add ch ( (a, b) : xs  )
 | a == ch = (a, b+1) : xs
 | otherwise = (a, b) : add ch xs

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

import qualified Data.List as L
import qualified Data.Function as F
import qualified Data.Set as S
import qualified Data.Map as M

solve = sum . map count . L.group . L.sort . filter (/= '\n')
  where count x= let n = length x in n * (n - 1) + n

main = interact $ show . solve

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

import qualified Data.List as L
import qualified Data.Function as F
import qualified Data.Set as S
import qualified Data.Map as M

solve = sum . map count . L.group . L.sort
  where count x= let n = length x in n * (n - 1) + n

main = interact $ show . solve

import Data.List;
main = do getLine >>= putStr . show . sum . map ((^2) . length) . group . sort

import List

main = getLine >>= print.solve

solve = sum.map ((^2).length).group.sort

import List

main :: IO ()
main = do
    string <- getLine
    print (sum (map (\x -> (length x) ^ 2) (group (sort string))))


--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        ri
    mapM_ (putStrLn.show.solve) tcs

solve [a,b,c] = ans
  where
    t1 = abs (a-1)
    t2 = abs (b-c) + abs (c-1)
    ans | t1 < t2    = 1 :: Int
        | t1 > t2    = 2
        | otherwise  = 3
solve _       = error "Triple expected."

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure
#endif

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> Int -> Int -> Int
solve a b c = choice
    where
        distanceA = abs $ a - 1
        distanceB = abs (b - c) + abs (c - 1)

        choice = case compare distanceA distanceB of
                LT -> 1
                GT -> 2
                EQ -> 3

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [a, b, c] <- B8.getLine <&> readIntB8s
        let answer = solve a b c
        printf "%d\n" answer

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[a, b, c] -> print (choice a b c)

choice :: Int -> Int -> Int -> Int
choice a b c = case compare (a-1) ((abs (b-c)) + c - 1) of
                 EQ -> 3
                 LT -> 1
                 GT -> 2

import Data.Function
import Control.Monad

stringToInt :: String -> Int
stringToInt = read

readInt :: IO Int
readInt = readNumbers >>= (return . head)

readNumbers :: IO [Int]
readNumbers = getLine >>= (return . map stringToInt . words)

solve a b c = let second = (c + (abs (b - c)))
    in if a < second then 1 else if a > second then 2 else 3

main = readInt >>= (\t ->
    forM [1..t] (\_ -> do
        numbers <- readNumbers
        let [a, b, c] = numbers
        putStrLn $ show (solve a b c)))

import Data.Function
import Control.Monad

stringToInt :: String -> Int
stringToInt = read

readInt :: IO Int
readInt = readNumbers >>= (return . head)

readNumbers :: IO [Int]
readNumbers = getLine >>= (return . map stringToInt . words)

solve a b c = min a (c + (abs (b - c)))

main = readInt >>= (\t ->
    forM [1..t] (\_ -> do
        numbers <- readNumbers
        let [a, b, c] = numbers
        putStrLn $ show (solve a b c)))