{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]

process 0 = return ()
process t = do
    [n,m] <- getIntList
    cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    let delta = scanl (\p c -> (move p c)) [0,0] cmds
    let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show

    process (t-1)

main = do
    t <- getInt
    process t

{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]
    _ -> [x,y]

process 0 = return ()
process t = do
    [n,m] <- getIntList
    --cmds <- getLine
    cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    let delta = scanl (\p c -> (move p c)) [0,0] cmds
    let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show

    process (t-1)

main = do
    t <- getInt
    process t

-- https://codeforces.com/contest/1607/problem/E

move command (row, col, minRow, maxRow, minCol, maxCol)
    | command == 'U' = (row-1, col, min (row-1) minRow, maxRow, minCol, maxCol)
    | command == 'D' = (row+1, col, minRow, max (row+1) maxRow, minCol, maxCol)
    | command == 'L' = (row, col-1, minRow, maxRow, min (col-1) minCol, maxCol)
    | command == 'R' = (row, col+1, minRow, maxRow, minCol, max (col+1) maxCol)
    | otherwise = (row, col, minRow, maxRow, minCol, maxCol)

solve _ (_,_, minRow,_, minCol,_) [] = show(2-minRow) ++ " " ++ show(2-minCol)
solve (height, width) (row, col, minRow, maxRow, minCol, maxCol) (command:rest)
    | newMaxCol-newMinCol + 1 > width || newMaxRow-newMinRow + 1 > height =
        if command == 'U' then show(1-newMinRow)++" "++show(2-newMinCol) else
        if command == 'L' then show(2-newMinRow)++" "++show(1-newMinCol) else
                               show(2-newMinRow)++" "++show(2-newMinCol)
    | otherwise = solve (height, width) newPos rest
    where
        newPos = move command (row, col, minRow, maxRow, minCol, maxCol)
        (_, _, newMinRow, newMaxRow, newMinCol, newMaxCol) = newPos

run 0 = return 0
run n = do
    size <- words <$> getLine
    commands <- getLine
    putStrLn $ solve (read $ size!!0, read $ size!!1) (1,1,1,1,1,1) commands
    run $ n-1
main = getLine >>= run . read

-- https://codeforces.com/contest/1607/problem/E

-- move :: Char -> (Int, Int, Int, Int, Int, Int) -> (Int, Int, Int, Int, Int, Int)
move command (row, col, minRow, maxRow, minCol, maxCol)
    | command == 'U' = (row-1, col, min (row-1) minRow, maxRow, minCol, maxCol)
    | command == 'D' = (row+1, col, minRow, max (row+1) maxRow, minCol, maxCol)
    | command == 'L' = (row, col-1, minRow, maxRow, min (col-1) minCol, maxCol)
    | command == 'R' = (row, col+1, minRow, maxRow, minCol, max (col+1) maxCol)
    | otherwise = (row, col, minRow, maxRow, minCol, maxCol)

-- solve :: (Int, Int) -> (Int, Int, Int, Int, Int, Int) -> String -> String
solve _ (_, _, minRow, _, minCol, _) [] = show(2-minRow)++" "++show(2-minCol)
solve (height, width) (row, col, minRow, maxRow, minCol, maxCol) (command:rest)
    | newMaxCol-newMinCol+1>width || newMaxRow-newMinRow+1>height =
        if command == 'U' then show(1-newMinRow)++" "++show(2-newMinCol) else
        if command == 'L' then show(2-newMinRow)++" "++show(1-newMinCol) else
        show(2-minRow)++" "++show(2-minCol)
    | otherwise = solve (height, width) newPos rest
    where
        newPos = move command (row, col, minRow, maxRow, minCol, maxCol)
        (_, _, newMinRow, newMaxRow, newMinCol, newMaxCol) = newPos

run 0 = return 0
run n = do
    size <- words <$> getLine
    commands <- getLine
    putStrLn $ solve (read $ size!!0, read $ size!!1) (1,1,1,1,1,1) commands
    run $ n-1
main = getLine >>= run . read

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.Maybe (fromJust)

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

main :: IO ()
main = do
  t <- fst . fromJust . B.readInt <$> B.getLine
  replicateM_ t $ do
    [n, m] <- readInts
    s <- strip . B.unpack <$> B.getLine
    let pos = scanl bound (0, 0, 0, 0) $ scanl move (0, 0) s
        (x, _, y, _) = head $ dropWhile (\(a, b, c, d) -> b - a >= n || d - c >= m) $ reverse pos
    B.putStrLn $ B.pack $ show (1 - x) ++ " " ++ show (1 - y)
  where
    move (x, y) c
      | c == 'R' = (x, y + 1)
      | c == 'L' = (x, y - 1)
      | c == 'U' = (x - 1, y)
      | c == 'D' = (x + 1, y)
    bound (x_min, x_max, y_min, y_max) (x, y) = (min x_min x, max x_max x, min y_min y, max y_max y)

strip :: String -> String
strip = f . f
  where
    f = reverse . dropWhile isSpace

import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n, m] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let move (x, y) 'L' = (x, y - 1)
        move (x, y) 'R' = (x, y + 1)
        move (x, y) 'U' = (x - 1, y)
        move (x, y) 'D' = (x + 1, y)
        move xy     'O' = xy
        move _      _   = error "!"
        go ((x, y), (x1, y1, x2, y2)) c = ((xy, z), (ok, start))  where
            xy@(x', y') = move (x, y) c
            z@(x1', y1', x2', y2') = (min x1 x', min y1 y', max x2 x', max y2 y')
            ok = y2' - y1' < m && x2' - x1' < n
            start = (-x1', -y1')
        (x, y) = snd $ last $ takeWhile fst $ snd $ mapAccumL go ((0, 0), (0, 0, 0, 0)) $ 'O':s
    putStrLn $ show (x + 1) ++ " " ++ show (y + 1)

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]
    _ -> [x,y]

process 0 = return ()
process t = do
    [n,m] <- getIntList
    --cmds <- getLine
    --cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    cmds0 <- BS.unpack <$> BS.getLine
    let cmds = init cmds0
    let cmds2 = takeWhile (not . isSpace)  cmds
    let c1 = map ord cmds
    let c2 = map ord cmds2

    let [x0,y0] = [[-2,-1],[-1,0],[0,-1],[0,0]] !! (mod (t-1) 4)
    putStr (if (t<=4) then ((tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show) ++ "\n") else if (cmds==cmds2) then "" else ((show c1) ++ "###" ++ (show c2) ++ "\n"))

    --let delta = scanl (\p c -> (move p c)) [0,0] cmds
    --let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    --let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    --let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    --let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    --putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show

    process (t-1)

main = do
    t <- getInt
    process t

{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]
    _ -> [x,y]

process 0 = return ()
process t = do
    [n,m] <- getIntList
    --cmds <- getLine
    --cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    cmds <- BS.unpack <$> BS.getLine
    let cmds2 = takeWhile (not . isSpace)  cmds
    let c1 = map ord cmds
    let c2 = map ord cmds2

    let [x0,y0] = [[-2,-1],[-1,0],[0,-1],[0,0]] !! (mod (t-1) 4)
    putStr (if (t<=4) then ((tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show) ++ "\n") else if (cmds==cmds2) then "" else ((show c1) ++ "###" ++ (show c2) ++ "\n"))

    --let delta = scanl (\p c -> (move p c)) [0,0] cmds
    --let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    --let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    --let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    --let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    --putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show

    process (t-1)

main = do
    t <- getInt
    process t

{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]
    _ -> [x,y]

process 0 = return ()
process t = do
    [n,m] <- getIntList
    --cmds <- getLine
    --cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    cmds <- BS.unpack <$> BS.getLine
    let cmds2 = takeWhile (not . isSpace)  cmds
    let [x0,y0] = [[-2,-1],[-1,0],[0,-1],[0,0]] !! (mod (t-1) 4)
    putStr (if (t<=4) then ((tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show) ++ "\n") else if (cmds==cmds2) then "" else (cmds ++ "###" ++ cmds2 ++ "\n"))

    --let delta = scanl (\p c -> (move p c)) [0,0] cmds
    --let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    --let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    --let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    --let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    --putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show

    process (t-1)

main = do
    t <- getInt
    process t

{-
-}

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

move :: [Int] -> Char -> [Int]
move [x,y] c = case c of
    'L' -> [x,y-1]
    'R' -> [x,y+1]
    'U' -> [x-1,y]
    'D' -> [x+1,y]

{-
getMaxCmds :: [[Int]] -> [Int] -> Int -> Int -> [Int]
getMaxCmds [] curr n m = curr
getMaxCmds ([x0,x1,y0,y1]:delta) curr n m
    | (x1-x0+1 <= n) && (y1-y0+1 <= m) = getMaxCmds delta [x0,x1,y0,y1] n m
    | otherwise = curr
-}

process 0 = return ()
process t = do
    [n,m] <- getIntList
    cmds <- takeWhile (not . isSpace) . BS.unpack <$> BS.getLine
    --let delta = scanl (\p c -> (move p c)) [0,0] cmds
    --let bound = scanl (\[x0,x1,y0,y1] [x,y] -> [min x0 x, max x1 x, min y0 y, max y1 y]) [0,0,0,0] delta
    --let xxx = [[x1-x0+1, y1-y0+1] | [x0,x1,y0,y1] <- bound]
    --let yyy = filter (\x -> ((x!!0)<=n) && ((x!!1)<=m) ) xxx
    --let [x0,x1,y0,y1] = bound !! ((length yyy) -1)
    --let [x0,x1,y0,y1] = getMaxCmds bound [0,0,0,0] n m
    -- putStrLn $ tail $ [(-x0+1), (-y0+1)] >>= (' ':) . show
    --let [k0,k1] = last delta
    let [x0,y0] = [[-2,-1],[-1,0],[0,-1],[0,0]] !! (mod (t-1) 4)
    putStr $ show (-x0+1)
    putStr " "
    putStrLn $ show (-y0+1)

    process (t-1)

main = do
    t <- getInt
    process t

-- https://codeforces.com/contest/1607/problem/E

-- move :: Char -> (Int, Int, Int, Int, Int, Int) -> (Int, Int, Int, Int, Int, Int)
move command (row, col, minRow, maxRow, minCol, maxCol)
    | command == 'U' = (row-1, col, min (row-1) minRow, maxRow, minCol, maxCol)
    | command == 'D' = (row+1, col, minRow, max (row+1) maxRow, minCol, maxCol)
    | command == 'L' = (row, col-1, minRow, maxRow, min (col-1) minCol, maxCol)
    | command == 'R' = (row, col+1, minRow, maxRow, minCol, max (col+1) maxCol)
    | otherwise = (row, col, minRow, maxRow, minCol, maxCol)

-- solve :: (Int, Int) -> (Int, Int, Int, Int, Int, Int) -> String -> String
solve _ (_, _, minRow, _, minCol, _) [] = show(2-minRow)++" "++show(2-minCol)
solve (height, width) (row, col, minRow, maxRow, minCol, maxCol) (command:rest)
    | newMaxCol-newMinCol+1>width || newMaxRow-newMinRow+1>height =
        if command == 'U' then show(1-newMinRow)++" "++show(2-newMinCol) else
        if command == 'L' then show(2-newMinRow)++" "++show(1-newMinCol) else
        show(2-minRow)++" "++show(2-minCol)
    | otherwise = solve (height, width) newPos rest
    where
        newPos = move command (row, col, minRow, maxRow, minCol, maxCol)
        (_, _, newMinRow, newMaxRow, newMinCol, newMaxCol) = newPos

run 0 = return 0
run n = do
    size <- words <$> getLine
    commands <- getLine
    print $ solve (read $ size!!0, read $ size!!1) (1,1,1,1,1,1) commands
    run $ n-1
main = getLine >>= run . read


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

main = do
  getLine
  as <- map read . words <$> getLine
  print $ solve as

solve :: [Integer] -> Integer
solve as = sum $ (^ 2) <$> makeList [length $ filter ((> 0) . (.&. bit i)) as | i <- [0 .. 20]]

makeList vs
  | all (<= 0) vs = []
  | otherwise = sum (zipWith (\a e -> toInteger (fromEnum (a > 0)) * bit e) vs [0 ..]) : makeList (subtract 1 <$> vs)

import Data.Bits
--import Control.Monad
import Data.List

main :: IO ()
main = routine

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

solve :: [Int] -> Integer
solve xs = sum $ map ((^2).toInt) ns
  where
    bs = [ length $ filter (`testBit` n) xs | n <- [0..19::Int] ]
    f :: Int -> [Bool]
    f n = replicate n True ++ repeat False
    bs' = map f bs
    ns = takeWhile or $ transpose bs'

toInt :: [Bool] -> Integer
toInt bs = foldr (\(b,i) n -> if b then setBit n i else n) 0 $ zip bs [0..]

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Data.List
import Data.Tuple

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

split = _split [] ""

(|>) = flip ($)

step ls =
  let count = sum $ (`mod` 2) <$> ls
      rems = (`div` 2) <$> ls
  in (count, rems)

_getCounts acc curr ls
  | curr > (1048576 :: Integer) = acc
  | otherwise =
    let (count, rems) = step ls
        !next = 2 * curr
        acc1 = (curr, count) : acc
    in _getCounts acc1 next rems
getCounts = _getCounts [] 1

_processCounts :: Integer -> Integer -> Integer -> [(Integer, Integer)] -> Integer
_processCounts !acc !val !lv = \case
  []  -> acc
  (x, count) : rest ->
    let acc1 = acc + val^2 * (count - lv)
        val1 = val - x
    in _processCounts acc1 val1 count rest

processCounts :: [(Integer, Integer)] -> Integer
processCounts counts =
  let start = sum $ fst <$> counts
  in _processCounts 0 start 0 counts

main = do
  input <- getContents
  let _:vals = read <$> split input :: [Integer]
      counts = sortOn snd $ getCounts vals
      res = processCounts counts
  putStrLn $ show res

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

main = do
  getLine
  (a : as) <- map read . words <$> getLine
  print $ solve a as

solve :: Integer -> [Integer] -> Integer
solve a [] = a ^ 2
solve a (b : bs) = (a .&. b) ^ 2 + solve (a .|. b) bs

import Data.Bits
--import Control.Monad
import Data.List

main :: IO ()
main = routine

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

solve :: [Int] -> Int
solve xs = sum $ map ((^2).toInt) ns
  where
    bs = [ length $ filter (`testBit` n) xs | n <- [0..19::Int] ]
    f :: Int -> [Bool]
    f n = replicate n True ++ repeat False
    bs' = map f bs
    ns = takeWhile or $ transpose bs'

toInt :: [Bool] -> Int
toInt bs = foldr (\(b,i) n -> if b then setBit n i else n) 0 $ zip bs [0..]


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
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

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 #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
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 #-}

main :: IO ()
main = do
  n <- readLn
  xs <- map digitToInt <$> getLine
  putStrLn.concat.map show $ solve n xs

solve :: Int -> [Int] -> [Int]
solve n xs = minimum [rotate i $ map(y+%)xs|y<-[0..9],i<-[0..n-1]]

rotate :: Int -> [Int] -> [Int]
rotate n xs | (ys,zs)<-splitAt n xs = zs ++ ys

(+%) :: Int -> Int -> Int
x +% y = case (x + y) of
            xy | xy < 10 -> xy
               | otherwise -> xy - 10

import Control.Applicative
import Control.Monad
import qualified Data.List as List
import qualified Data.Char as Char

solve :: Int -> [Int] -> [Int]
solve n arr = List.foldl1' min (pos >>= add)
  where
  	shift s = let (x,y) = List.splitAt s arr
  	          in y ++ x
  	add   x = map (\i -> map ((`mod` 10) . (i+)) x) [0..9]
  	pos     = map shift [1..n]

main :: IO ()
main = do
  n <- read <$> getLine
  digs <- map Char.digitToInt <$> getLine
  putStrLn $ map Char.intToDigit $ solve n digs

import Data.Char

rotate :: [a] -> Int -> [a]
rotate xs n = (drop n xs) ++ (take n xs)

update :: String -> Int -> Int -> String
update s shift inc = map (\c -> intToDigit (((digitToInt c) + inc) `mod` 10))
                         (rotate s ((length s) - shift))

solve' :: String -> Int -> [String]
solve' s n = do
    shift <- [0..n]
    inc <- [0..9]
    return (update s shift inc)

solve :: String -> Int -> String
solve s n = minimum $ solve' s n

main :: IO ()
main = do
    n <- getLine
    s <- getLine
    putStrLn $ solve s (read n :: Int)

rotate :: Int -> [Int] -> [Int]
rotate n number = drop n number ++ take n number

increment :: Int -> [Int] -> [Int]
increment n number = map f number
    where f x = mod (x + n) 10

allRotations :: [Int] -> [[Int]]
allRotations n = map (\x -> rotate x n) [1..length n]

allIncrements :: [Int] -> [[Int]]
allIncrements n = map (\x -> increment x n) [0..9]

solve :: [Int] -> [Int]
solve = minimum . concat . map allIncrements . allRotations

readInt :: Char -> Int
readInt '0' = 0
readInt '1' = 1
readInt '2' = 2
readInt '3' = 3
readInt '4' = 4
readInt '5' = 5
readInt '6' = 6
readInt '7' = 7
readInt '8' = 8
readInt '9' = 9

main = do
    getLine
    getLine >>= putStrLn . concat . map show . solve . fmap (\c -> readInt c)

import Data.Char

main = getContents >>= putStrLn . solve . last . words

solve :: String -> String
solve s = foldl1 min [add k (drop i s ++ take i s) | i <- [1 .. length s], k <- [0 .. 9]]

add v s = map (intToDigit . (`mod` 10) . (+ v) . digitToInt) s

import Control.Applicative
import Control.Monad
import qualified Data.List as List
import qualified Data.Char as Char

arrToInt :: [Int] -> Integer
arrToInt = List.foldl' go 0
  where go x y = 10 * x + toInteger y

solve :: Int -> [Int] -> [Int]
solve n arr = snd $ List.foldl1' min $ map (\x -> (arrToInt x, x)) $ (pos >>= add)
  where
  	shift s = let (x,y) = List.splitAt s arr
  	          in y ++ x
  	add   x = map (\i -> map ((`mod` 10) . (i+)) x) [0..9]
  	pos     = map shift [1..n]

main :: IO ()
main = do
  n <- read <$> getLine
  digs <- map Char.digitToInt <$> getLine
  putStrLn . show $ map Char.intToDigit $ solve n digs


module Main where

import Control.Monad (replicateM_)

solve :: [Char] -> Char -> Int
solve s t = maximum $ map snd $ filter (\(c, v) -> c == t) $ s' `zip` ds
  where s' = s ++ takeWhile (/= 'g') s
        ds = scanr add 0 s'
        add d v = case d of
                    'g' -> 0
                    _   -> v + 1

handleTestCase :: IO ()
handleTestCase = do
  [_, t] <- words <$> getLine
  s <- getLine
  print $ solve s (head t)

main :: IO ()
main = do
  numberTests <- read <$> getLine
  replicateM_ numberTests handleTestCase

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#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

tracingM t x = traceM $ t ++ " = " ++ show x

#else

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

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
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))

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

{- aux -}
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

{- solution -}

solve :: Int -> Char -> B8.ByteString -> Int
solve n c str = L.maximum $ do
   let str2 = B8.concat [str, str]
   let gPositions = IS.fromList $ B8.elemIndices 'g' str2
   tracingM "str" str
   tracingM "rPositions" gPositions
   cIndex <- B8.elemIndices c str
   tracingM "cIndex" cIndex
   let rIndex = fromJust $ IS.lookupGE cIndex gPositions
   return $ rIndex - cIndex

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        line <- B8.getLine
        let [ns, cs] = L.filter (not . (== 0) . B8.length) $ B8.splitWith isSpace line
        let (n, c) = (readIntB8 ns, B8.head cs)
        s <- B8.getLine <&> B8.filter isAlphaNum
        let answer = solve n c s
        printf "%d\n" answer


import System.IO

solve :: [Int] -> [String]
solve ~(n:xs) = go 0 n xs where
    go l r _ | l + 1 == r = ["! " ++ show l]
    go l r ~(x:xs) = ("+ " ++ show out) : go (l' + out) (r' + out) xs where
        m = (r + l) `div` 2
        out = n - m `mod` n
        (l', r') | x == l `div` n = (l, m)
                 | otherwise      = (m, r)

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    interact $ unlines . solve . map read . lines

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mkQuery :: Int -> Builder
mkQuery c = string7 "+ " <> putInts [c] <> flush

solve :: Int -> Int -> Int -> SP Builder
solve n lv rv = if  lv == rv
  then  pure $ string7 "! " <> putInts [lv]
  else  let
  mv = lv + (rv - lv) `quot` 2
  c = (n - 1 - mv `rem` n)
  in  (mkQuery c <>) <$> do
  ~[resp] <- getInts 1
  let
    nr = n * resp
    nlv = max nr (lv + c)
    nrv = min (nr + n - 1) (rv + c)
  solve n nlv nrv

mainFun :: SP Builder
mainFun = do
  ~[n] <- getInts 1
  solve n 1 (n - 1)

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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

import System.IO

solve :: [Int] -> [String]
solve ~(n:xs) = go 1 n 0 0 0 xs where
    go l r mul _   total _ | l + 1 == r = ["! " ++ show (l + total)]
    go l r mul off total ~(x:xs) = ("+ " ++ show out) : rest where
        d = (r - l) `div` 2
        d' = (r - l + 1) `div` 2
        out = off + d
        total' = total + out
        rest | x == mul  = go l        (l + d') x 0       total' xs
             | otherwise = go (l + d') r        x (n - d) total' xs

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    interact $ unlines . solve . map read . lines

import System.IO

solve :: [Int] -> [String]
solve ~(n:xs) = go 1 n 0 0 0 xs where
    go l r mul _   total _ | l + 1 == r = ["! " ++ show (l + total)]
    go l r mul off total ~(x:xs) = ("+ " ++ show (off + d)) : rest where
        d = (r - l) `div` 2
        total' = total + off + d
        rest | x == mul  = go l       (l + d) x 0       total' xs
             | otherwise = go (l + d) r       x (n - d) total' xs

main :: IO ()
main = do
    hSetBuffering stdout LineBuffering
    interact $ unlines . solve . map read . lines


import Data.Int (Int64)

main :: IO ()
main = do
  n <- read <$> getLine
  let ans = solve n
  print $ length ans
  putStrLn $ unwords $ map show ans

solve :: Int64 -> [Int64]
solve n = if foldl (\x y -> x * y `rem` n) 1 nums == 1 then nums else init nums
  where
    nums = filter ((== 1) . gcd n) [1 .. n - 1]

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import Data.List(delete)

inv :: Integer -> Integer -> Maybe Integer
inv n x = case bezout n x of
	Just (i, j) -> if i*n+j*x == 1 then Just $ mod j n else Nothing
	Nothing -> Nothing

bezout :: Integer -> Integer -> Maybe (Integer, Integer)
bezout _ 0 = Nothing
bezout _ 1 = Just (0, 1)
bezout a b = do
	(x', y') <- bezout b r
	return $ (y', x' - y' * q)
	where (q,  r) = a `divMod` b

main = do
	n <- getLine >>= return . read :: IO Integer
	putStrLn $ showResult $ result n

result :: Integer -> [Integer]
result n = list' where
	aux (x:xs) = case inv n x of
		Just y
			| y == x -> x:aux xs
			| otherwise -> x:aux xs
		Nothing -> aux xs
	aux [] = []

	list' = if prodMod list == 1 then list else delete (prodMod list) list

	prodMod [] = 1
	prodMod (x:xs) = mod (x * prodMod xs) n
	list = 1 : aux [2..(n-1)]

showResult :: [Integer] -> String
showResult list = (show $ length list) ++ "\n" ++ aux list where
	aux (x:xs) = show x ++ " " ++ aux xs
	aux [] = []

to_int :: String -> Integer
to_int = read

solve n = do
  print $ length ans
  putStrLn  $ unwords $ map show ans
  where
    filtered = filter (\x -> gcd x n == 1) [1..(n-1)]
    prod = foldl (\x y -> (x * y) `mod` n) 1 filtered
    ans =
      if prod /= 1
      then filter (\x -> x /= prod) filtered
      else filtered

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

to_int :: String -> Integer
to_int = read

solve n = do
  print $ length ans
  putStrLn  $ unwords $ map show ans
  where
    arr = [1..(n-1)]
    filtered = filter (\x -> gcd x n == 1) arr
    prod = foldl (\x y -> (x * y) `mod` n) 1 filtered
    ans =
      if prod /= 1
      then filter (\x -> x /= prod) filtered
      else filtered

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

to_int :: String -> Integer
to_int = read

solve n = do
  print $ length ans
  putStrLn  $ unwords $ map show ans
  where
    arr = [1..(n-1)]
    filtered = filter (\x -> gcd x n == 1) arr
    prod = foldl (\x y -> (x * y) `mod` n) 0 filtered
    ans =
      if prod /= 1
      then filter (\x -> x /= prod) filtered
      else filtered

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

main :: IO ()
main = do
  n <- read <$> getLine
  let ans = solve n
  print $ length ans
  putStrLn $ unwords $ map show ans

solve :: Int -> [Int]
solve n = if foldl (\x y -> x * y `rem` n) 1 nums == 1 then nums else init nums
  where
    nums = filter ((== 1) . gcd n) [1 .. n - 1]

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S

inv :: Integer -> Integer -> Maybe Integer
inv n x = case bezout n x of
	Just (i, j) -> if i*n+j*x == 1 then Just $ mod j n else Nothing
	Nothing -> Nothing

bezout :: Integer -> Integer -> Maybe (Integer, Integer)
bezout _ 0 = Nothing
bezout _ 1 = Just (0, 1)
bezout a b = do
	(x', y') <- bezout b r
	return $ (y', x' - y' * q)
	where (q,  r) = a `divMod` b

main = do
	n <- getLine >>= return . read :: IO Integer
	putStrLn $ showResult $ result n

result :: Integer -> [Integer]
result n = if (n > 2) && prodMod list > 1 then (n-1):list else list where
	aux (x:xs) = case inv n x of
		Just _ -> x:aux xs
		Nothing -> aux xs
	aux [] = []

	prodMod [] = 1
	prodMod (x:xs) = mod (x * prodMod xs) n
	list = 1 : aux [2..(n-2)]

showResult :: [Integer] -> String
showResult list = (show $ length list) ++ "\n" ++ aux list where
	aux (x:xs) = show x ++ " " ++ aux xs
	aux [] = []


import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)

type Long = Int

solveForI :: Int -> UArray Int Int -> Int -> IntMap Int
solveForI n sizes i
    | i == n        = IM.singleton n 1
    | otherwise     = IM.insert i (nextMax + 1) cache
    where
        cache = solveForI n sizes (i+1)
        nexts = filter (\i1 -> sizes Ar.! i1 > sizes Ar.! i) $ takeWhile (<= n) $ map (* i) [2..]
        nextSizes = map (cache IM.!) nexts
        nextMax = maximum $ 0:nextSizes

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readWords
    sizes <- readWords
    print $ maximum $ IM.elems $ solveForI n (Ar.listArray (1,n) sizes) 1
    testCases (t-1)

test :: IntMap Int
test = solveForI 4 (Ar.listArray (1,4) [5,3,4,6]) 1

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

import Data.Array
import Control.Monad
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
    n <- readLn
    ss <- (map read.words) <$> getLine
    print $ solve n ss

solve :: Int -> [Int] -> Int
solve n ss = maximum cArr
  where
    sArr = mkSizeArray n ss
    pJArr = mkPossibleJumpsArray n sArr
    cArr = mkCostsArray n pJArr

mkSizeArray :: Int -> [Int] -> Array Int Int
mkSizeArray n ss = listArray (1,n) ss

mkPossibleJumpsArray :: Int -> Array Int Int -> Array Int [Int]
mkPossibleJumpsArray n sizeArray = listArray (1,n) $ map f [1..n]
  where
    f i =filter (\j -> (sizeArray!j)>(sizeArray!i)) [i,2*i..n]

mkCostsArray :: Int -> Array Int [Int] -> Array Int Int
mkCostsArray n possibleJumpsArray = arr
  where
    arr = array (1,n) [ (i,g i) | i <- [n,n-1..1]]
    g i =1 + maximum (0:map (\j -> arr!j) (possibleJumpsArray!i))


import Control.Monad

data State = State { height :: Int, bag :: Int, canGo :: Bool }

continue :: State -> Int -> Int -> State
continue state@(State { height = h, bag = b, canGo = go }) step nextHeight
    | go == False = state
    | h + b + step < nextHeight = State { height = h, bag = b, canGo = False }
    | otherwise =
        let minHeight = max 0 (nextHeight - step)
            blockDiff = h - minHeight
        in State { height = nextHeight, bag = b + blockDiff, canGo = True }

canTraverse :: Int -> Int -> [Int] -> Bool
canTraverse blocks step heights =
    let start = State { height = (head heights), bag = blocks, canGo = True }
        columns = tail heights
        finalState = foldl (\state -> continue state step) start columns
    in canGo finalState

readAndSolve :: Int -> IO String
readAndSolve _ = do
    [cols, blocks, step] <- readInts
    heights <- readInts
    return (if (canTraverse blocks step heights) then "YES" else "NO")
    where readInts = map (\tok -> read tok :: Int) . words <$> getLine

main = do
    tests <- (\str -> read str :: Int) <$> getLine
    results <- forM [1..tests] readAndSolve
    putStrLn . unlines $ results

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = do
	t <- readInt
	replicateM_ t $ do
		[ n, m, k ] <- readInts
		hs <- readInts
		putStrLn $ which "YES" "NO" $ solve m k hs

solve _ _ [_] = True
solve m k (h1:h2:hs)
	| h1 >= max 0 ( h2 - k ) = let d = h1 - max 0 ( h2 - k ) in solve ( m + d ) k (h2:hs)
	| h1 + m >= max 0 ( h2 - k ) = let d = max 0 ( h2 - k ) - h1 in solve ( m - d ) k (h2:hs)
	| otherwise = False

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = do
	t <- readInt
	replicateM_ t $ do
		[ n, m, k ] <- readInts
		hs <- readInts
		putStrLn $ which "YES" "NO" $ solve m k hs

solve m k [_] = True
solve m k (h1:h2:hs)
	| h1 >= h2 - k = let d = h1 - ( h2 - k ) in solve ( m + d ) k (h2:hs)
	| h1 + m >= h2 - k = let d = ( h2 - k ) - h1 in solve ( m - d ) k (h2:hs)
	| otherwise = False


module Main where

main :: IO ()
main = do
    [n, l, v1, v2, k] <- fmap (map read . words) getLine
    print $ totalT n l v1 v2 k

totalT :: Float -> Float -> Float -> Float -> Float -> Float
totalT n l v1 v2 k = let {  alpha = fromIntegral $ ceiling (n / k);
                          beta  = (v2 - v1) / (v2 + v1);
                          t = l / (v2 + v1 * (alpha - 1) * (beta + 1));
                     } in t * (alpha + alpha * beta - beta)

main = do
    ps@[n, l, v1, v2, k] <- (map read . words) `fmap` getLine :: IO [Int]
    let ps' = map fromIntegral ps :: [Double]
    print $ solve ps'

solve :: [Double] -> Double
solve [n, l, v1, v2, k] = t1 + x where
    m = fromIntegral (ceiling (n / k)) :: Double
    v3 = (v2 - v1) / (v2 + v1)
    x = l / (v2 + (m-1)*(v1 * (1+ v3)))
    t1 = (l - v2*x) / v1

import Control.Applicative

solve :: Int -> Double -> Double
solve 1 v = 1
solve n v = let x = solve (n-1) v
            in (x*(v+1))/(2*x+v+1)

main :: IO ()
main = do
    [n,li,v1i,v2i,k] <- map read . words <$> getLine
    let l = realToFrac li
        v1 = realToFrac v1i
        v2 = realToFrac v2i
        v = v2/v1
        trips = (n+k-1) `div` k
        x = l * (solve trips v)
    putStrLn .show $ (x/v2) + ((l - x)/v1)
    -- putStrLn $ "trips = " ++ show trips ++ " v = " ++ show v
    -- putStrLn .show $ solve trips v

main = do
    ps@[n, l, v1, v2, k] <- (map read . words) `fmap` getLine :: IO [Int]
    let ps' = map fromIntegral ps :: [Double]
    print $ solve ps'

solve :: [Double] -> Double
solve [n, l, v1, v2, k] = t1 + x where
    m = fromIntegral (ceiling (n / k)) :: Double
    x = l / (v2 + (m-1)*(v1 + (v2-v1)/(v2+v1)))
    t1 = (m-1) * x * (1 + (v2-v1)/(v2+v1))

import Control.Applicative

solve :: Int -> Double -> Double
solve 1 v = 1
solve n v = let x = solve (n-1) v
            in (x*(v+1))/(2*x+v+1)

main :: IO ()
main = do
    [n,li,v1i,v2i,k] <- map read . words <$> getLine
    let l = realToFrac li
        v = (realToFrac v2i) / (realToFrac v1i)
        trips = (n+k-1) `div` k
        x = l * (solve trips v)
    putStrLn .show $ (x/v) + (l - x)


main = do
	a <- fmap (gao . read) getLine
	putStrLn $ show $ length a
	mapM_ (putStrLn . unwords . map show) a

gao n = [[i, j] | m <- [div n 2], i <- [1 .. m], j <- [m + 1 .. n]]

main = interact solve
solve input = output where
  n = read input :: Int
  output = unlines $ map (unwords.(map show)) $ [length a]:a
    where a = answer n
  answer n = [[x,y]|x<-[1..min (n-1) (div (n+3) 2)],
    y <- if x == 1 then [2..min n (div (n+3) 2)] else [div (n+5) 2..n]]

main = do
    n <- fmap read getLine :: IO Int
    if n == 1
        then print 0
        else do
            let m = n `div` 2
            print $ m * (n - m)
            putStrLn $ foldl1 (++) [(show x ++ " " ++ show y ++ "\n") | x <- [1..m], y <- [m+1..n]]

main = do
	a <- fmap (gao . read) getLine
	putStrLn $ show $ length a
	mapM_ (putStrLn . unwords . map show) a

gao 1 = []
gao 2 = [[1, 2]]
gao n = concat [[[1, i], [2, i]] | i <- [3 .. n]]

main = do
	a <- fmap (gao . read) getLine
	putStrLn $ show $ length a
	mapM_ (putStrLn . unwords . map (show . succ)) a

gao n = [[i, j] |
			d <- takeWhile (<n) $ scanl (*) 1 [4,4..],
			s <- takeWhile (<n) $ map (*(4*d)) [0..],
			(i, j) <- [(s, s + d), (s + d, s + d + d), (s + 2 * d, s + 3 * d), (s + 3 * d, s)],
			i < n,
			j < n]


import Control.Monad ( void, replicateM_ )
import Data.Foldable ( foldr' )

main = do
  n <- readLn
  replicateM_ n $ do
    void $ getLine
    a <- fmap (fmap (read :: String -> Int) . words) getLine
    print $ snd $ foldr' (\next (min, cnt) -> (if next < min then next else min, if next > min then cnt + 1 else cnt)) (maxBound, 0) a

import Control.Monad ( void, replicateM_ )

main = do
  n <- readLn
  replicateM_ n $ do
    void $ getLine
    a <- fmap (fmap (read :: String -> Int) . words) getLine
    print $ snd $ foldr (\next (min, cnt) -> (if next < min then next else min, if next > min then cnt + 1 else cnt)) (maxBound, 0) a

import Control.Monad

constructRising :: Int -> [Int] -> [Int]
constructRising n [] = [n]
constructRising n (x : xs)
  | n >= x = n : x : xs
  | otherwise = constructRising n xs

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    print =<< (n-) . length . foldl (flip ($)) [] . map (constructRising . (read :: String -> Int) ). words<$> getLine

import Control.Monad

type Test = [Int]

findBadDays :: [Test] -> [Int]
findBadDays [] = []
findBadDays (first:rest) = (process $ reverse first) : findBadDays rest

process :: Test -> Int
process test = _process test 10000000

_process :: Test -> Int -> Int
_process [] _ = 0
_process (first:rest) smallest = (if first > smallest
                                  then 1
                                  else 0) + _process rest (min first smallest)

getTests :: Int -> IO [Test]
getTests count = replicateM count readTest

readTest :: IO Test
readTest = do
    _ <- getLine
    days <- getLine
    return $ map read (words days)

main :: IO ()
main = do
    count <- getLine
    tests <- getTests $ read count
    let badDays = findBadDays tests
    mapM_ print badDays

import           Control.Arrow
import           Control.Monad (replicateM)
import           Prelude

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  x <- replicateM n solve
  return ()

solve :: IO ()
solve = do
  n <- read <$> getLine :: IO Int
  xs <- (words >>> map read) <$> getLine :: IO [Int]
  print $ findSmall xs

findSmall :: [Int] -> Int
findSmall = reverse >>> findSmallWalk 1000001
  where
    findSmallWalk m [] = 0
    findSmallWalk m (y:ys) = findSmallWalk (min y m) ys +  if y > m then 1 else 0

import           Control.Arrow
import           Control.Monad (replicateM)
import           Prelude

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  x <- replicateM n solve
  return ()

solve :: IO ()
solve = do
  n <- read <$> getLine :: IO Int
  xs <- (words >>> map read) <$> getLine :: IO [Int]
  print $ findSmall xs

findSmall :: [Int] -> Int
findSmall = reverse >>> findSmallWalk 150001
  where
    findSmallWalk m [] = 0
    findSmallWalk m (y:ys) = findSmallWalk (min y m) ys +  if y > m then 1 else 0


main = getContents >>= putStr.solve

solve :: [Char] -> [Char]
solve [] = []
solve [a,'\n'] = ['\n']
solve s = if (head s) == '0' then (tail s) else (head s):(solve (tail s))

removeFirstZero :: String -> String
removeFirstZero binary = if onlyOnes binary
                         then tail binary
                         else remove binary

onlyOnes :: String -> Bool
onlyOnes [] = True
onlyOnes (first:rest) = if first == '0'
                        then False
                        else onlyOnes rest

remove :: String -> String
remove [] = []
remove (first:rest) = if first == '1'
                      then first: remove rest
                      else rest

main :: IO ()
main = do
    binary <- getLine
    putStrLn $ removeFirstZero binary

module Main where

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

main = getLine >>= (putStrLn . solve)

import Control.Applicative
import Data.List

main= do
	s<-getLine
	let s1 =  takeWhile (>'0') s
	let s2 = dropWhile (>'0') s
	let s3 = if s2 =="" then "" else tail s2
	putStrLn $  (if s2=="" then tail s1 else s1 )++s3

import Data.List
main = interact $ \l-> take (length l -2) $ delete '0' l

module Main where
solve :: String -> String
solve "0" = ""
solve "1" = ""
solve ('0' : xs) = xs
solve ('1' : xs) = '1' : solve xs

main = getLine >>= (putStrLn . solve)

module Main where

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

main = getLine >>= (putStrLn . solve)

import Data.Char

solve :: [Int] -> Int -> Int
solve [] k = 1
solve (0:xs) k = k
solve (1:ys) k = solve ys (k+1)

outt :: [Int] -> Int -> Int -> IO()
outt [] k n = return()
outt (x:xs) k n = do
    if k /= n then putChar $ chr $ (x+48) else return ()
    outt xs (k+1) n

convert :: [Char] -> [Int]
convert xs = foldr (\cur acc -> (digitToInt $ cur):acc) [] xs

main =  do
    str <- getLine
    outt (convert str) 1 (solve (convert str) 1)

import Data.List
add0 "" = "0"
add0 x = x
main = interact $ add0 . \l -> dropWhile (=='0') . take (length l -2) $ delete '0' l

solve :: String -> String
solve s
  | any (== '0') s  =  takeWhile (== '1') s ++ tail (dropWhile (== '1') s)
  | otherwise  =  tail s

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

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

solve :: String -> String
solve xs | all (=='1') xs = tail xs
         | otherwise = takeWhile (=='1') xs ++ tail (dropWhile (=='1') xs)

main=interact f
f(x:y)|x:y<"10"=y|0<1=x:f y

main = do
        str <- getLine
        putStrLn (doSolve str)

findPos :: String ->Int -> Int
findPos [] _ = 0
findPos (x:xs) n
        | x == '0' = n
        | otherwise = findPos xs n+1

doSolve :: String -> String
doSolve x = if pos > 0
               then
                                if pos == 1 then drop pos x
                                        else (take (pos-1) x) ++ (drop pos x)
                           else init x
                        where pos = findPos x 1

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (s:ss) = f s
  where
    f (a:b:cs) = if b == '0' then a:cs else a:f (b:cs)
    f (a:cs) = cs

removeZero [] = []
removeZero (x:l) = if x == '0' then l else x:removeZero l

main = do
  bin <- getLine
  if any (\x -> x == '0') bin
    then putStrLn $ removeZero bin
    else putStrLn $ tail bin

import Data.List
main = putStrLn . solve =<< getLine
solve s | all (== '1') s = tail s
        | otherwise = delete '0' s

import Data.Char

solve :: [Int] -> Int -> Int
solve [] k = 1
solve (0:xs) k = k
solve (1:ys) k = solve ys (k+1)

outt :: [Int] -> Int -> Int -> IO()
outt [] k n = return()
outt (x:xs) k n = do
    if k /= n then print $ x else return ()
    outt xs (k+1) n

convert :: [Char] -> [Int]
convert xs = foldl (\acc cur -> (digitToInt $ cur):acc) [] xs

main =  do
    str <- getLine
    outt (convert str) 1 (solve (convert str) 1)

import Data.Char

solve :: [Int] -> Int -> Int
solve [] k = 1
solve (0:xs) k = k
solve (1:ys) k = solve ys (k+1)

outt :: [Int] -> Int -> Int -> IO()
outt [] k n = return()
outt (x:xs) k n = do
    if k /= n then putChar $ chr $ (x+48) else return ()
    outt xs (k+1) n

convert :: [Char] -> [Int]
convert xs = foldl (\acc cur -> (digitToInt $ cur):acc) [] xs

main =  do
    str <- getLine
    outt (convert str) 1 (solve (convert str) 1)

import Data.List
main = interact solve
solve s | all (== '1') s = tail s
        | otherwise = reverse $ delete '0' $ reverse s

import Data.List
main = interact solve
solve s | all (== '1') s = tail s
        | otherwise = delete '0' s

main = getContents >>= print.solve

solve :: [Char] -> [Char]
solve [] = []
solve [a,'\n'] = ['\n']
solve s = if (head s) == '0' then (tail s) else (head s):(solve (tail s))

import Control.Applicative
import Data.List

main= do
	s<-getLine
	let s1 =  takeWhile (>'0') s
	let s2 = dropWhile (>'0') s
	let s3 = if s2 =="" then "" else tail s2
	putStrLn $  s1++s3

import Data.List
add0 "" = "0"
add0 x = x
main = interact $ add0 . \l -> dropWhile (=='0') . take (length l -1) $ delete '0' l

import Data.List
main = interact $ \l -> dropWhile (=='0') . take (length l -1) $ delete '0' l

import Data.List
main = interact $ \l -> take (length l -1) $ delete '0' l


-- -fno-strictness might really hurts memory use and runtime
--  if it interacts badly with foldl'
{-# OPTIONS_GHC
-fno-strictness
-fno-enable-rewrite-rules
-fno-specialise
#-}

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.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Semigroup
import Data.Functor.Identity

import Data.List
import qualified Data.Sequence as Seq
import Data.Sequence ((><), ViewL(..))
import Data.Array.Unboxed
import Data.Int

ineqsForced :: [(Int, Int)] -> Int
ineqsForced insxys = let
  step :: (Int, Seq.Seq Bool) -> (Int, Int) -> (Int, Seq.Seq Bool)
  step (ct, s) (xi, yi) = ct `seq` s `seq` let
    slen = Seq.length s
    tosplit = s >< Seq.replicate (xi - 1 - slen) False
    (pref, suff) = Seq.splitAt (yi - 1) tosplit
    in  case  Seq.viewl suff  of
    val :< rest
      -> (ct + if  val  then  0  else  1,
          pref >< Seq.fromList [False, True] >< rest)
    _ -> error "urk"
  (ans, _res) = foldl' step (0, Seq.empty) insxys
  in  ans -- filter too slow; no sum(n) constraint

p :: Int
p = 998244353

p64 :: Int64
p64 = fromIntegral p

(*!) :: Int -> Int -> Int
infixr 7 *!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral (x64 * y64 `rem` p64)

newtype ProdP = ProdP { unProdP :: Int }
instance  Semigroup ProdP  where
  ProdP x <> ProdP y = ProdP (x *! y)
inv :: Int -> Int
inv = unProdP . stimes (p - 2) . ProdP

getFacts :: Int -> UArray Int Int
getFacts n = listArray (0, n) $ scanl' (*!) 1 [1 .. n]

getIFacts :: UArray Int Int -> UArray Int Int
getIFacts arr = let
  (0, n) = bounds arr
  step (ix, acc) = ix `seq` acc `seq` (ix - 1, acc *! ix)
  in  array (0, n) $ take (n+1) $ iterate step (n, inv (arr ! n))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  let
    -- whoops, misread constraint, not OK to recompute these
    facts = getFacts (2 * 200000)
    ifacts = getIFacts facts
    choose x y = facts ! x *! ifacts ! y *! ifacts ! (x - y)
  replicateM_ t $ do
    [n, m] <- getInts 2
    xys <- liftPure $ replicateM m $ do
      ~[x, y] <- getInts 2
      pure (x, y)
    let maxOpts = n - 1 - ineqsForced xys
    --putInts [n, maxOpts]
    putInts [choose (n + maxOpts) maxOpts]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: SP Identity t -> SIO t
liftPure = mapStateT (pure . runIdentity)

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] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

-- disable all optimization in this module
-- How slow is it, really?
{-# OPTIONS_GHC -O0 #-}

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.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Semigroup
import Data.Functor.Identity

import Data.List
import qualified Data.Sequence as Seq
import Data.Sequence ((><), ViewL(..))
import Data.Array.Unboxed
import Data.Int

ineqsForced :: [(Int, Int)] -> Int
ineqsForced insxys = let
  step :: (Int, Seq.Seq Bool) -> (Int, Int) -> (Int, Seq.Seq Bool)
  step (ct, s) (xi, yi) = ct `seq` s `seq` let
    slen = Seq.length s
    tosplit = s >< Seq.replicate (xi - 1 - slen) False
    (pref, suff) = Seq.splitAt (yi - 1) tosplit
    in  case  Seq.viewl suff  of
    val :< rest
      -> (ct + if  val  then  0  else  1,
          pref >< Seq.fromList [False, True] >< rest)
    _ -> error "urk"
  (ans, _res) = foldl' step (0, Seq.empty) insxys
  in  ans -- filter too slow; no sum(n) constraint

p :: Int
p = 998244353

p64 :: Int64
p64 = fromIntegral p

(*!) :: Int -> Int -> Int
infixr 7 *!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral (x64 * y64 `rem` p64)

newtype ProdP = ProdP { unProdP :: Int }
instance  Semigroup ProdP  where
  ProdP x <> ProdP y = ProdP (x *! y)
inv :: Int -> Int
inv = unProdP . stimes (p - 2) . ProdP

getFacts :: Int -> UArray Int Int
getFacts n = listArray (0, n) $ scanl' (*!) 1 [1 .. n]

getIFacts :: UArray Int Int -> UArray Int Int
getIFacts arr = let
  (0, n) = bounds arr
  step (ix, acc) = ix `seq` acc `seq` (ix - 1, acc *! ix)
  in  array (0, n) $ take (n+1) $ iterate step (n, inv (arr ! n))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  let
    -- whoops, misread constraint, not OK to recompute these
    facts = getFacts (2 * 200000)
    ifacts = getIFacts facts
    choose x y = facts ! x *! ifacts ! y *! ifacts ! (x - y)
  replicateM_ t $ do
    [n, m] <- getInts 2
    xys <- liftPure $ replicateM m $ do
      ~[x, y] <- getInts 2
      pure (x, y)
    let maxOpts = n - 1 - ineqsForced xys
    --putInts [n, maxOpts]
    putInts [choose (n + maxOpts) maxOpts]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: SP Identity t -> SIO t
liftPure = mapStateT (pure . runIdentity)

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] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

-- I intuitively don't expect these to have much effect here.
{-# OPTIONS_GHC
-fno-enable-rewrite-rules
-fno-specialise
#-}

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.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Semigroup
import Data.Functor.Identity

import Data.List
import qualified Data.Sequence as Seq
import Data.Sequence ((><), ViewL(..))
import Data.Array.Unboxed
import Data.Int

ineqsForced :: [(Int, Int)] -> Int
ineqsForced insxys = let
  step :: (Int, Seq.Seq Bool) -> (Int, Int) -> (Int, Seq.Seq Bool)
  step (ct, s) (xi, yi) = ct `seq` s `seq` let
    slen = Seq.length s
    tosplit = s >< Seq.replicate (xi - 1 - slen) False
    (pref, suff) = Seq.splitAt (yi - 1) tosplit
    in  case  Seq.viewl suff  of
    val :< rest
      -> (ct + if  val  then  0  else  1,
          pref >< Seq.fromList [False, True] >< rest)
    _ -> error "urk"
  (ans, _res) = foldl' step (0, Seq.empty) insxys
  in  ans -- filter too slow; no sum(n) constraint

p :: Int
p = 998244353

p64 :: Int64
p64 = fromIntegral p

(*!) :: Int -> Int -> Int
infixr 7 *!
x *! y = let
  x64 = fromIntegral x
  y64 = fromIntegral y
  in  fromIntegral (x64 * y64 `rem` p64)

newtype ProdP = ProdP { unProdP :: Int }
instance  Semigroup ProdP  where
  ProdP x <> ProdP y = ProdP (x *! y)
inv :: Int -> Int
inv = unProdP . stimes (p - 2) . ProdP

getFacts :: Int -> UArray Int Int
getFacts n = listArray (0, n) $ scanl' (*!) 1 [1 .. n]

getIFacts :: UArray Int Int -> UArray Int Int
getIFacts arr = let
  (0, n) = bounds arr
  step (ix, acc) = ix `seq` acc `seq` (ix - 1, acc *! ix)
  in  array (0, n) $ take (n+1) $ iterate step (n, inv (arr ! n))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  let
    -- whoops, misread constraint, not OK to recompute these
    facts = getFacts (2 * 200000)
    ifacts = getIFacts facts
    choose x y = facts ! x *! ifacts ! y *! ifacts ! (x - y)
  replicateM_ t $ do
    [n, m] <- getInts 2
    xys <- liftPure $ replicateM m $ do
      ~[x, y] <- getInts 2
      pure (x, y)
    let maxOpts = n - 1 - ineqsForced xys
    --putInts [n, maxOpts]
    putInts [choose (n + maxOpts) maxOpts]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: SP Identity t -> SIO t
liftPure = mapStateT (pure . runIdentity)

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] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'


module Main where

import Control.Applicative
import Control.Monad

data Problem = Problem { target :: Integer
                       , parts :: [Integer]
                       } deriving (Show, Eq)

singleton :: Problem -> Bool
singleton (Problem n []) = True
singleton (Problem n ps) = sum ps + (pred . fromIntegral $ length ps) == n

test0 = Problem{target = 4, parts = [1, 3]}
test1 = Problem{target = 10, parts = [3, 3, 2]}
test2 = Problem{target = 10, parts = [1, 3]}

main :: IO ()
main = do
  [n, t] <- map read . words <$> getLine
  ps <- map read . words <$> getLine
  let problem = Problem { target = t, parts = ps }
  putStrLn $ if singleton problem then "YES" else "NO"

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

getInts = (map parseInteger . BS8.words) `fmap` BS8.getLine :: IO [Integer]
parseInteger = fst . fromJust . BS8.readInteger

main = do
    [n,x] <- getInts
    as <- getInts
    if (sum as + (n-1) == x)
    then putStrLn "YES"
    else putStrLn "NO"

import Data.Bool
main = getContents >>= putStr . exec
exec = bool "NO" "YES" . solve . map read . words
solve (n:k:xs) = sum xs - (1 :: Int) + n == k

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

solve :: [Int] -> IO ()
solve (n:x:a) = putStrLn (if x == sum a + n - 1 then  "YES" else "NO")

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

getInts = (map parseInteger . BS8.words) `fmap` BS8.getLine :: IO [Integer]
parseInteger = fst . fromJust . BS8.readInteger

main = do
    [n,x] <- getInts
    as <- getInts
    if (sum as + (n-1) == x) || (sum as + (n+1) == x)
    then putStrLn "YES"
    else putStrLn "NO"

import Data.Bool
main = getContents >>= print . exec
exec = bool "NO" "YES" . solve . map read . words
solve (n:k:xs) = sum xs - (1 :: Int) + n == k


import Data.Char (ord)
import Data.List
import Debug.Trace

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

readInt :: String -> Int
readInt = foldl' (\s d -> s * 10 + ord d - 48) 0

parse :: String -> Input
parse contents = (k, a)
                 where [[_, k], a] = map (map readInt . words) . lines $ contents

sum' :: [[Maybe Bool]] -> Bool
sum' = last . foldl' byRow (repeat False)
       where byRow p          = tail . scanl f True . zip p
             f _ (_, Just b)  = b
             f s (b, Nothing) = not s || not b

initVal :: Int -> Int -> Int -> Int -> Maybe Bool
initVal k p i j
    | i < 0 || j < 0 || i + j < k = Just True
    | i + j == k                  = Just (odd (j + p))
    | otherwise                   = Nothing

fastReduce :: Int -> Int -> Int -> Bool
fastReduce k n m
    | n >= 2 && m >= 2 && n + m >= k + 4 = fastReduce k (n - 1) (m - 1)
    | otherwise                          = sum' initVals
    where initVals = [[initVal k (n + m - k) i j | j <- [m0 .. m]] | i <- [n0 .. n]]
          n0       = max 0 (k - m) - 1
          m0       = max 0 (k - n) - 1

solve :: Input -> Output
solve (k, a) = fastReduce k (count even a) (count odd a)
               where count f = length . filter f

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

main :: IO ()
main = putStrLn . bool "Daenerys" "Stannis" . solve . parse =<< getContents

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve _ ones 0 = if even ones then p2 else p1
solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | zeroes <= moves `div` 2, odd (ones - (moves - zeroes)) -> p1
  | even moves -> p2
  | otherwise -> p1

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

readInt = fst . fromJust . B.readInt

solve (_ : k : cities) =
  if k == length cities
  then
    if odd odds then stannis else daenerys
  else
  let totalMoves = length cities - k in
  let stannisMoves = (totalMoves + 1) `div` 2 in
  let daenerysMoves = totalMoves - stannisMoves in
  if even totalMoves
  then
    -- Daenerys' last move: she wins if number of towns is even or if any even town remain
    if even k || stannisMoves < evens then daenerys else stannis
  else
    if (if even k
    then
      daenerysMoves < evens && daenerysMoves < odds
    else
      daenerysMoves < odds) then stannis else daenerys
  where
    odds = length (filter odd cities)
    evens = length (filter even cities)

stannis = B.pack "Stannis"
daenerys = B.pack "Daenerys"

main = B.interact $ solve . map readInt . B.words

import Control.Applicative ((<$>), liftA)
import Data.Bits ((.&.))
import Data.Foldable (foldl')
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

stan = "Stannis" :: String  -- goes first
dan = "Daenerys" :: String  -- even

parity :: Int -> Int -> Int -> String
parity n k odd
    | n == k = if odd .&. 1 == 1 then stan else dan -- end of game
    | odd < j + 1 = dan -- remove all odds
    | k .&. 1 == 1 && n - odd < i + 1 = stan  -- remove all even
    | k .&. 1 == 0 && n - odd < j + 1 = dan  -- remove all even
    | odd .&. 1 == 0 && n .&. 1 == 0 && i == j = dan  -- dan can pair out
    | j < i  && j < min n (n - odd) = stan -- stan will decide ultimately
    | j == i && i < n - odd = dan -- dan will decide ultimately
    | otherwise = stan
    where
    j = (n - k) `div` 2
    i = n - k - j

parse :: C8.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

oddCount :: [Int] -> Int
oddCount = foldl' loop 0
    where
    loop n i | i .&. 1 == 1 = n + 1
             | otherwise = n

main :: IO ()
main = fmap read . words <$> getLine >>= \[n, k] ->
     liftA oddCount . parse <$> B.getLine >>= \(Just odd) ->
        putStrLn $ parity n k odd

import Control.Applicative ((<$>), liftA)
import Data.Bits ((.&.))
import Data.Foldable (foldl')
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

stan = "Stannis" :: String  -- goes first
dan = "Daenerys" :: String  -- even

parity :: Int -> Int -> Int -> String
parity n k odd
    | k .&. 1 == 0 || odd < j + 1 = dan -- remove all odds | k is even
    | n - odd < i + 1 = stan  -- remove all even
    | odd .&. 1 == 0 && n .&. 1 == 0 && i == j = dan  -- dan can pair out
    | j < i  && j < min n (n - odd) = stan -- stan will decide ultimately
    | j == i && i < min n (n - odd) = dan -- dan will decide ultimately
    | otherwise = stan
    where
    j = (n - k) `div` 2
    i = n - k - j

parse :: C8.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

oddCount :: [Int] -> Int
oddCount = foldl' loop 0
    where
    loop n i | i .&. 1 == 1 = n + 1
             | otherwise = n

main :: IO ()
main = fmap read . words <$> getLine >>= \[n, k] ->
     liftA oddCount . parse <$> B.getLine >>= \(Just odd) ->
        putStrLn $ parity n k odd

import Control.Applicative ((<$>), liftA)
import Data.Bits ((.&.))
import Data.Foldable (foldl')
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

stan = "Stannis" :: String  -- goes first
dan = "Daenerys" :: String  -- even

parity :: Int -> Int -> Int -> String
parity n k odd
    | n == k = if odd .&. 1 == 1 then stan else dan -- end of game
    | k .&. 1 == 0 && odd < j + 1 = dan -- remove all odds & k is even
    | k .&. 1 == 1 && n - odd < i + 1 = stan  -- remove all even
    | odd .&. 1 == 0 && n .&. 1 == 0 && i == j = dan  -- dan can pair out
    | j < i  && j < min n (n - odd) = stan -- stan will decide ultimately
    | j == i && i < n - odd = dan -- dan will decide ultimately
    | otherwise = stan
    where
    j = (n - k) `div` 2
    i = n - k - j

parse :: C8.ByteString -> Maybe [Int]
parse = liftA (fst <$>) . sequence . fmap C8.readInt . C8.words

oddCount :: [Int] -> Int
oddCount = foldl' loop 0
    where
    loop n i | i .&. 1 == 1 = n + 1
             | otherwise = n

main :: IO ()
main = fmap read . words <$> getLine >>= \[n, k] ->
     liftA oddCount . parse <$> B.getLine >>= \(Just odd) ->
        putStrLn $ parity n k odd

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

readInt = fst . fromJust . B.readInt

solve (_ : k : cities) =
  let totalMoves = length cities - k in
  let stannisMoves = (totalMoves + 1) `div` 2 in
  let daenerysMoves = totalMoves - stannisMoves in
  if even totalMoves
  then
    -- Daenerys' last move: she wins if number of towns is even or if any even town remain
    if even k || stannisMoves < evens then daenerys else stannis
  else
    if (if even k
    then
      daenerysMoves < evens && daenerysMoves < odds
    else
      daenerysMoves < odds) then stannis else daenerys
  where
    odds = length (filter odd cities)
    evens = length (filter even cities)

stannis = B.pack "Stannis"
daenerys = B.pack "Daenerys"

main = B.interact $ solve . map readInt . B.words

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

parse :: String -> Input
parse contents = (k, a)
                 where [[_, k], a] = map (map read . words) . lines $ contents

solveCase :: Int -> Bool -> Int -> Int -> Bool
solveCase k f e o
    | e < 0 || o < 0 = True
    | t == k         = f /= even o
    | t >= k + 4     = s (e - 1) (o - 1)
    | otherwise      = any not [s (e - 1) o, s e (o - 1)]
    where s = solveCase k (not f)
          t = e + o

solve :: Input -> Output
solve (m, a) = solveCase m True (count even a) (count odd a)
               where count f = length . filter f

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

main :: IO ()
main = putStrLn . bool "Daenerys" "Stannis" . solve . parse =<< getContents

import Data.Char (ord)
import Data.List
import Debug.Trace

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

readInt :: String -> Int
readInt = foldl' (\s d -> s * 10 + ord d - 48) 0

parse :: String -> Input
parse contents = (k, a)
                 where [[_, k], a] = map (map readInt . words) . lines $ contents

sum' :: [[Maybe Bool]] -> Bool
sum' = last . foldl' byRow (repeat False)
       where byRow p          = tail . scanl f True . zip p
             f _ (_, Just b)  = b
             f s (b, Nothing) = not s || not b

initVal :: Int -> Int -> Int -> Int -> Maybe Bool
initVal k p i j
    | i < 0 || j < 0 || i + j < k = Just True
    | i + j == k                  = Just (even (j + p))
    | otherwise                   = Nothing

fastReduce :: Int -> Int -> Int -> Bool
fastReduce k n m
    | n >= 2 && m >= 2 && n + m >= k + 4 = fastReduce k (n - 1) (m - 1)
    | otherwise                          = sum' initVals
    where initVals = [[initVal k (n + m) i j | j <- [k - n - 1 .. m]] | i <- [k - m - 1 .. n]]

solve :: Input -> Output
solve (k, a) = fastReduce k (count even a) (count odd a)
               where count f = length . filter f

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

main :: IO ()
main = putStrLn . bool "Daenerys" "Stannis" . solve . parse =<< getContents

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

parse :: String -> Input
parse contents = (k, a)
                 where [[_, k], a] = map (map read . words) . lines $ contents

solveCase :: Int -> Bool -> Int -> Int -> Bool
solveCase k f e o
    | t == k                         = f /= even o
    | t >= k + 4 && e >= 2 && o >= 2 = s (e - 1) (o - 1)
    | otherwise                      = any not moves
    where s     = solveCase k (not f)
          t     = e + o
          moves = [s (e - 1) o | e >= 1] ++ [s e (o - 1) | o >= 1]

solve :: Input -> Output
solve (m, a) = solveCase m True (count even a) (count odd a)
               where count f = length . filter f

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

main :: IO ()
main = putStrLn . bool "Daenerys" "Stannis" . solve . parse =<< getContents

import Data.Char (ord)

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

readInt :: String -> Int
readInt = foldr (\d s -> s * 10 + ord d - 48) 0

parse :: String -> Input
parse contents = (k, a)
                 where [[_, k], a] = map (map readInt . words) . lines $ contents

solveCase :: Int -> Bool -> Int -> Int -> Bool
solveCase k f e o
    | t == k                         = f /= even o
    | t >= k + 4 && e >= 2 && o >= 2 = solveCase k f (e - 1) (o - 1)
    | otherwise                      = any not moves
    where s     = solveCase k (not f)
          t     = e + o
          moves = [s (e - 1) o | e >= 1] ++ [s e (o - 1) | o >= 1]

solve :: Input -> Output
solve (m, a) = solveCase m True (count even a) (count odd a)
               where count f = length . filter f

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

main :: IO ()
main = putStrLn . bool "Daenerys" "Stannis" . solve . parse =<< getContents

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | otherwise -> p1

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve _ ones 0 = if even ones then p2 else p1
solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | otherwise -> p1

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve _ ones 0 = if even ones then p2 else p1
solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | even moves -> p2
  | otherwise -> p1

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve _ _ 0 = p2
solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | otherwise -> p1

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

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

import qualified Numeric as N

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

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

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

count acc [] = acc
count (a, b) (x:xs) = count (if even x then (a + 1, b) else (a, b + 1)) xs

main = do
  [n, k] <- getInts
  (zeroes, ones) <- count (0, 0) <$> getInts
  putStrLn $ solve zeroes ones (n - k)

p2 = "Daenerys"
p1 = "Stannis"

solve _ ones 0 = if even ones then p2 else p1
solve zeroes ones moves =
  if
  | ones <= moves `div` 2 -> p2
  | zeroes <= moves `div` 2, even (ones - (moves - zeroes)) -> p2
  | moves `div` 2 == 0 -> p2
  | otherwise -> p1


module Main where

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Tuple
import Prelude
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

updateTwoMax :: (Int, Int) -> Int -> (Int, Int)
updateTwoMax (m1, m2) x | x >= m1   = (x, m1)
                        | x >= m2   = (m1, x)
                        | otherwise = (m1, m2)

combine :: (Int, Int, Int) -> (Int, Int, Int) -> (Int, Int, Int)
combine (s1, m11, m12) (s2, m21, m22) = (maxSum, max1, max2)
    where maxSum = s1 `max` s2 `max` (max1 + max2)
          (max1, max2) = (m11, m12) `updateTwoMax` m21

dfs :: Array Int [Int] -> Array Int Int -> Int -> Int -> (Int, Int, Int)
dfs g col root parent = foldl combine (0, 0, 0) (zipWith addEdge childrenRes childrenEdges)
    where childrenRes = [(dfs g col child root) | child <- g!root, child /= parent]
          childrenEdges = [f child root | child <- g!root, child /= parent]
          f u v | col!u == col!v = 0
                | otherwise      = 1
          addEdge (m, m1, m2) x = (m, m1 + x, m2 + x)

solve :: Tokenizer Int
solve = do
    n <- nextInt
    col <- listArray (0, n - 1) <$> replicateM n nextInt
    edges <- replicateM (n - 1) $ do
             u <- nextInt
             v <- nextInt
             return (u - 1, v - 1)
    let g = accumArray (flip (:)) [] (0, n - 1) (edges ++ (map swap edges))
    let (ans, _, _) = dfs g col 0 (-1)
    return $ (ans + 1) `div` 2

main = do
    contents <- L.getContents
    print $ evalState solve (L.words contents)

-- Codeforces Round #379 (Div. 2)
-- http://codeforces.com/contest/734

-- ID: 734E (Anton and Tree)

import Control.Monad
import qualified Data.Sequence as Seq
import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple (swap)
import Data.Foldable (toList)
import qualified Data.IntSet as Set
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt
type Graph = Array Int [Int]

main = do
    n <- getInt
    colors <- listArray (1,n) `fmap` getInts
    edges <- replicateM (n-1) $ do
        [u,v] <- getInts
        return (u,v)
    let edges' = edges ++ (map swap edges)
    let g = accumArray (flip (:)) [] (1,n) edges'
    print $ (diameter g colors n + 1) `div` 2

preorder :: Graph -> Int -> [(Int,Int)]
preorder g start = toList $ bfs Seq.empty [(start,start)] where
    bfs nodes [] = nodes
    bfs nodes queue = bfs (nodes Seq.>< Seq.fromList queue) (concatMap nexts queue)
    nexts (v,parent) = map (\u -> (u,v)) $ filter (/= parent) (g ! v)

levels :: Graph -> Array Int Int -> Int -> Int -> Array Int Int
levels g colors start n = a where
    a = array (1, n) [findLevel v | v <- order]
    findLevel (v, parent)
        | v == parent = (v, 0)
        | colors ! v == colors ! parent = (v, a ! parent)
        | otherwise = (v, (a ! parent) + 1)
    order = preorder g start

maxLevel g colors start n
    = maximumBy (\a b -> compare (snd a) (snd b)) $ assocs $ levels g colors start n

diameter :: Graph -> Array Int Int -> Int -> Int
diameter g colors n = snd $ maxLevel g colors (fst $ maxLevel g colors 1 n) n


{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import Data.Bits
import Data.Int
import Data.Semigroup

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(-!) :: Int -> Int -> Int
infixl 6 -!
x -! y = cv $ x + p - y

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = fromIntegral $ fromIntegral x * fromIntegral y `rem` p64

newtype ProdP = ProdP { unProdP :: Int }
instance Semigroup ProdP where
  ProdP x <> ProdP y = ProdP (x *! y)
  stimes = stimesMonoid
instance Monoid ProdP where
  mempty = ProdP 1

powP :: Int -> Int -> Int
powP x k = unProdP $ stimes k $ ProdP x

suffSums :: UArray Int Int -> UArray Int Int
suffSums arr = let
  (p, q) = bounds arr
  in  array (p, q) $ flip unfoldr (q, 0) $ \w@(!ii, !s) -> do
  guard $ ii >= p
  let  !ni = ii - 1
  pure (w, (ni, s + arr ! ii))

mainFun :: SP Builder
mainFun = do
  ~[n] <- getInts 1
  a <- getInts n
  let
    maxk = finiteBitSize (0 :: Int)
    cts = accumArray (+) 0 (0, maxk)
      $ [(countTrailingZeros ai, 1) | ai <- a]
    his = suffSums cts
    bad i = case  cts ! i  of
      0 -> 0
      q -> powP 2 (his ! i + q - 1) -- choose any ODD # with i trailing zeros
    good = foldl' (-!) (powP 2 n) [bad i | i <- [1 .. maxk]]
  pure $ putInts [good -! 1] -- "nonempty"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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

import Control.Monad
import Data.Maybe
import Data.Bits
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- readInts
    let oc = length $ filter odd xs
        withOdd = (2 ^ oc - 1) * 2 ^ (n - oc)
        ecs = M.elems $ M.fromListWith (+) [(countTrailingZeros x, 1 :: Int) | x <- xs, even x]
        withoutOdd = sum $ zipWith f ecs (tail $ scanr (+) 0 ecs) where
            f c c' = 2 ^ c' * (2 ^ (c - 1) - 1)
    print $ toInt $ withOdd + withoutOdd

m :: Int
m = 1000000007

newtype MInt = MInt { toInt :: Int } deriving (Eq, Show)

instance Num MInt where
    MInt a + MInt b = MInt $ let c = a + b in if c >= m then c - m else c
    MInt a - MInt b = MInt $ let c = a - b in if c < 0 then c + m else c
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum          = MInt . signum . toInt
    fromInteger     = MInt . fromInteger . (`mod` fromIntegral m)

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

main :: IO ()
main = solve

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import Data.Bits
import Data.Int
import Data.Semigroup

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(-!) :: Int -> Int -> Int
infixl 6 -!
x -! y = cv $ x + p - y

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = fromIntegral $ fromIntegral x * fromIntegral y `rem` p64

newtype ProdP = ProdP { unProdP :: Int }
instance Semigroup ProdP where
  ProdP x <> ProdP y = ProdP (x *! y)
  stimes = stimesMonoid
instance Monoid ProdP where
  mempty = ProdP 1

powP :: Int -> Int -> Int
powP x k = unProdP $ stimes k $ ProdP x

suffSums :: UArray Int Int -> UArray Int Int
suffSums arr = let
  (p, q) = bounds arr
  in  array (p, q) $ flip unfoldr (q, 0) $ \w@(!ii, !s) -> do
  guard $ ii >= p
  let  !ni = ii - 1
  pure (w, (ni, s + arr ! ii))

mainFun :: SP Builder
mainFun = do
  ~[n] <- getInts 1
  a <- getInts n
  let
    maxk = finiteBitSize (0 :: Int)
    cts = accumArray (+) 0 (0, maxk)
      $ [(countTrailingZeros ai, 1) | ai <- a]
    his = suffSums cts
    bad i = cts ! i *! powP 2 (his ! i)
    good = foldl' (-!) (powP 2 n) [bad i | i <- [1 .. maxk]]
  pure $ putInts [good -! 1] -- "nonempty"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import Data.Bits
import Data.Int
import Data.Semigroup

p :: Int
p = 10 ^ (9 :: Int) + 7

p64 :: Int64
p64 = fromIntegral p

cv :: Int -> Int
cv x = x - if  x >= p  then  p  else  0

(+!) :: Int -> Int -> Int
infixl 6 +!
x +! y = cv $ x + y

(-!) :: Int -> Int -> Int
infixl 6 -!
x -! y = cv $ x + p - y

(*!) :: Int -> Int -> Int
infixl 7 *!
x *! y = fromIntegral $ fromIntegral x * fromIntegral y `rem` p64

newtype ProdP = ProdP { unProdP :: Int }
instance Semigroup ProdP where
  ProdP x <> ProdP y = ProdP (x *! y)
  stimes = stimesMonoid
instance Monoid ProdP where
  mempty = ProdP 1

powP :: Int -> Int -> Int
powP x k = unProdP $ stimes k $ ProdP x

suffSums :: UArray Int Int -> UArray Int Int
suffSums arr = let
  (p, q) = bounds arr
  in  array (p, q) $ flip unfoldr (q, 0) $ \w@(!ii, !s) -> do
  guard $ ii >= p
  let  !ni = ii - 1
  pure (w, (ni, s + arr ! ii))

mainFun :: SP Builder
mainFun = do
  ~[n] <- getInts 1
  a <- getInts n
  let
    maxk = finiteBitSize (0 :: Int)
    cts = accumArray (+) 0 (0, maxk)
      $ [(countTrailingZeros ai, 1) | ai <- a]
    his = suffSums cts
    bad i = cts ! i *! powP 2 (his ! i)
    good = foldl' (-!) (powP 2 n) [bad i | i <- [1 .. maxk]]
  pure $ putInts (elems cts) <> putInts [good -! 1] -- "nonempty"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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


import Data.List
fx::[[Int]]->[Int]
fx []=[]
fx ((x:y:[]):xs)=x:fx xs

fy::[[Int]]->[Int]
fy []=[]
fy ((x:y:[]):xs)=y:fy xs

main =do
      e<-getLine
      es<-getContents
      let xs=lines es
          ys=map (map read ) (map words xs)::[[Int]]
      print $ min (length (nub (fx ys))) (length (nub (fy ys)))

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import qualified Data.IntSet as S

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

diffCount xs = go 0 S.empty xs
  where go !c seen [] = c
        go c seen (x:xs) = if S.member x seen then go c seen xs else go (c+1) (S.insert x seen) xs

main = do
  n <- fmap read getLine
  clocks <- replicateM n $ fmap (parseInts 2) BS.getLine
  let v = diffCount $ map head clocks
      h = diffCount $ map (head . tail) clocks
  print $ (min v h :: Int)

import Data.List
fx::[[Int]]->[Int]
fx []=[]
fx ((x:y:[]):xs)=x:fx xs

fy::[[Int]]->[Int]
fy []=[]
fy ((x:y:[]):xs)=y:fx xs

main =do
      e<-getLine
      es<-getContents
      let xs=lines es
          ys=map (map read ) (map words xs)::[[Int]]
      print $ min (length (nub (fx ys))) (length (nub (fy ys)))


module Main where

import Control.Monad (replicateM_)

solve :: Int -> Int
solve 2 = 2
solve _ = 3

handleProblem :: IO ()
handleProblem = do
  input <- read <$> getLine
  print $ solve input

main :: IO ()
main = do
  numberProblems <- read <$> getLine
  replicateM_ numberProblems handleProblem

main :: IO ()
main = interact $ unwords . tail . words

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

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

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

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

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

sieve :: Int -> UArray Int Bool
sieve n = runSTUArray $ do
  sieve <- newArray (2, n) True
  forM_ [2..n] $ \p -> do
    isPrime <- readArray sieve p
    when isPrime $ do
      forM_ [p*2, p*3 .. n] $ \k -> do
        writeArray sieve k False
  return sieve

primesUpto :: Int -> [Int]
primesUpto n = [p | (p, True) <- assocs $ sieve n]

solve n primes primeSet = head $ [m | m <- primes, Set.notMember (n+m) primeSet]

isPrime x = all (\i -> x `mod` i /= 0) [2..x-1]

main = do
  let primes = primesUpto 200000
  let primeSet = Set.fromList primes
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    print $ solve n primes primeSet


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

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

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

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted (x: []) = True
isSorted (x: y: xs) = x <= y && isSorted (y: xs)

solve :: IO ()
solve = do
    n   <- readInt
    arr <- readIntArr
    if (isSorted arr)
        then putStrLn "NO"
        else putStrLn "YES"

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

main :: IO ()
main = do
    n <- readInt
    readLoop n

main = interact $ unlines . map p . chunk 2 . drop 1 . lines

chunk n [] = []
chunk n xs = take n xs : chunk n (drop n xs)

check = foldl (\b c -> if (b == (-1)) || (c < b) then (-1) else c) 0

p xs = let ((n:_):s:_) = fmap (fmap read . words) xs :: [[Int]]
        in if check s == (-1) then "YES" else "NO"

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    pure $ string7 $ if  and $ zipWith (<=) a (tail a)
      then  "NO\n"
      else  "YES\n"

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

import Control.Monad (forM_)
import Data.List (sort)
import Data.Maybe ( isNothing )

nonDec :: Ord a => [a] -> Bool
nonDec arr = helper arr 0 (length arr)
  where
    helper arr i l
        | i < l - 1 = arr !! i > arr !! (i + 1) || helper arr (i + 1) l
        | otherwise = False

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        l <- getLine
        let arr = map read (words l) :: [Int]
        putStrLn $ if nonDec arr then "YES" else "NO"

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe
import Data.Bits
import Data.List
import Debug.Trace

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

enumerate = zip [0..]

argmin :: [Int] -> Int
argmin a = let t = enumerate a in
  fst $ foldl (\(mni, mn) (i, x) -> if x < mn then (i, x) else (mni, mn)) (0, 999999999) t

solve :: SP Builder
solve = do
  n <- getInt
  a <- replicateM n getInt
  let
    sorta = sort a
    sorted = (==) a sorta
  pure . str $  if sorted then "NO\n" else "YES\n"

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

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

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

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted (x: []) = True
isSorted (x: y: xs) = x <= y && isSorted (y: xs)

solve :: IO ()
solve = do
    n   <- readInt
    arr <- readIntArr
    if (isSorted arr)
        then print "NO"
        else print "YES"

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

main :: IO ()
main = do
    n <- readInt
    readLoop n