There's a chessboard of size $$$n \times n$$$. $$$m$$$ rooks are placed on it in such a way that:   no two rooks occupy the same cell;  no two rooks attack each other. A rook attacks all cells that are in its row or column.Is it possible to move exactly one rook (you can choose which one to move) into a different cell so that no two rooks still attack each other? A rook can move into any cell in its row or column if no other rook stands on its path.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of testcases. The first line of each testcase contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 8$$$) — the size of the chessboard and the number of the rooks. The $$$i$$$-th of the next $$$m$$$ lines contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, y_i \le n$$$) — the position of the $$$i$$$-th rook: $$$x_i$$$ is the row and $$$y_i$$$ is the column. No two rooks occupy the same cell. No two rooks attack each other.

For each testcase, print "YES" if it's possible to move exactly one rook into a different cell so that no two rooks still attack each other. Otherwise, print "NO".

NoteIn the first testcase, the rooks are in the opposite corners of a $$$2 \times 2$$$ board. Each of them has a move into a neighbouring corner, but moving there means getting attacked by another rook.In the second testcase, there's a single rook in a middle of a $$$3 \times 3$$$ board. It has $$$4$$$ valid moves, and every move is fine because there's no other rook to attack it.

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import qualified Data.Set as S
import qualified Text.Parsec as P
import qualified Text.Parsec.Text as P
import qualified Data.ByteString as B
import qualified Data.Text as T

data Chessboard = Chessboard
  { size :: Int
  , rookPositions :: [(Int, Int)]
  }

main :: IO ()
main = interact solve

solve :: String -> String
solve s = T.unpack $ case P.parse problemDefinition "" (T.pack s) of
            (Left parseError) -> "Could not parse problem definition: " <> T.pack (show parseError)
            (Right chessboards) -> T.intercalate "\n" $ map (formatAnswer . solve') chessboards

formatAnswer :: Bool -> T.Text
formatAnswer True = "YES"
formatAnswer False = "NO"

cowardlyMoves :: Chessboard -> Bool
cowardlyMoves chessboard@Chessboard{..} = any (cowarldyMoves' chessboard) rookPositions

cowarldyMoves' :: Chessboard -> (Int, Int) -> Bool
cowarldyMoves' Chessboard{..} p@(x, y) = hasXMove || hasYMove
  where movableX = [x' | x' <- [1..size], x' /= x]
        movableY = [y' | y' <- [1..size], y' /= y]
        otherRooks = [p' | p' <- rookPositions, p' /= p]
        blockedX = S.fromList $ map fst otherRooks
        blockedY = S.fromList $ map snd otherRooks
        hasXMove = not (S.member y blockedY) && any (\x' -> not (S.member x' blockedX)) movableX
        hasYMove = not (S.member x blockedX) && any (\y' -> not (S.member y' blockedY)) movableY

solve' :: Chessboard -> Bool
solve' = cowardlyMoves

intP :: P.Parser Int
intP = do
  read <$> P.many1 P.digit

sepCount :: Int -> P.Parser a -> P.Parser b -> P.Parser [b]
sepCount n sep p
  | n <= 0    = pure []
  | otherwise = do
    f <- p
    rs <- P.count (n - 1) $ do
      sep
      p
    pure $ f : rs

problemDefinition :: P.Parser [Chessboard]
problemDefinition = do
  numTestCases <- intP
  P.newline
  cs <- sepCount numTestCases P.newline chessboard
  P.many P.newline
  pure cs

chessboard :: P.Parser Chessboard
chessboard = do
  size <- intP
  P.many1 P.space
  numRooks <- intP
  P.newline
  rookPositions <- sepCount numRooks P.newline rookPosition
  pure $ Chessboard { size = size, rookPositions = rookPositions }

rookPosition :: P.Parser (Int, Int)
rookPosition = do
  x <- intP
  P.many1 P.space
  y <- intP
  pure (x, y)

import Data.Char
import Control.Monad

solve n m = if (n>m) then "YES" else "NO"

loop = do
  line <- getLine
  let [n,m] = (map read . words) line
  replicateM_ m getLine
  putStrLn (solve n m)
main = do
  t  <- read <$> getLine
  replicateM_ t loop

module Main where

import qualified Data.Set as S

solution a c = let one = S.fromList (fst <$> c); two = S.fromList (snd <$> c) in S.size one == a || S.size two == a

loop :: Int -> IO () -> IO ()
loop 0 act = return ()
loop x act = act >>= (\_ -> loop (x - 1) act)

accum :: Int -> IO a -> IO [a]
accum 0 _ = pure []
accum x get = (:) <$> get <*> accum (x - 1) get

main = do
  times <- read <$> getLine
  loop times $ do
    (a : b : _) <- fmap read . words <$> getLine
    list <- accum b $ (\(a : b : _) -> (a, b)) . fmap read . words <$> getLine :: IO [(Int, Int)]
    putStrLn $ (\x -> if not x then "YES" else "NO") $ solution a list

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> Int -> [(Int, Int)] -> Bool
solve n m rooks = xsCount /= n && ysCount /= n
    where
        xsCount = IS.size . IS.fromList $ L.map fst rooks
        ysCount = IS.size . IS.fromList $ L.map snd rooks

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> readIntB8s
        rooks <- replicateM m $ do
            [x, y] <- B8.getLine <&> readIntB8s
            return (x, y)
        let answer = solve n m rooks
        putsYesNo answer

loop 0 = return ()
loop n =
 do
  x <- getLine
  loop (n-1)

cmp x y = do
    if x==y then "NO"
    else "YES"

solve 0 = return ()
solve n = do
    line <- getLine
    let a = (read (takeWhile (/= ' ') line) :: Int)
    let b = (read (drop 1 (dropWhile (/= ' ') line)) :: Int)
    loop b
    let ans = cmp a b
    putStrLn $ ans
    solve (n-1)

main = do
    t <- getLine
    let n = (read t :: Int)
    solve n

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

----- Solution
data TC = TC { n :: Int, m :: Int }

type Output = Bool

input :: Scanner TC
input = do
  n <- int
  m <- int
  m >< pair int int
  return TC {..}

solve :: TC -> Output
solve TC {..} = m < n

output :: Int -> Output -> C.ByteString
output ix = C.pack . bool "NO" "YES"

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1..] >>> map (uncurry output) >>> C.unlines

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Main where

import qualified Data.Set as S
import qualified Text.Parsec as P
import qualified Text.Parsec.ByteString as P
import qualified Data.ByteString as B

data Chessboard = Chessboard
  { size :: Int
  , rookPositions :: [(Int, Int)]
  }

main :: IO ()
main = B.interact solve

solve :: B.ByteString -> B.ByteString
solve s = case P.parse problemDefinition "" s of
            (Left parseError) -> "Could not parse problem definition."
            (Right chessboards) -> B.intercalate "\n" $ map (formatAnswer . solve') chessboards

formatAnswer :: Bool -> B.ByteString
formatAnswer True = "YES"
formatAnswer False = "NO"

cowardlyMoves :: Chessboard -> Bool
cowardlyMoves chessboard@Chessboard{..} = any (cowarldyMoves' chessboard) rookPositions

cowarldyMoves' :: Chessboard -> (Int, Int) -> Bool
cowarldyMoves' Chessboard{..} p@(x, y) = hasXMove || hasYMove
  where movableX = [x' | x' <- [1..size], x' /= x]
        movableY = [y' | y' <- [1..size], y' /= y]
        otherRooks = [p' | p' <- rookPositions, p' /= p]
        blockedX = S.fromList $ map fst otherRooks
        blockedY = S.fromList $ map snd otherRooks
        hasXMove = not (S.member y blockedY) && any (\x' -> not (S.member x' blockedX)) movableX
        hasYMove = not (S.member x blockedX) && any (\y' -> not (S.member y' blockedY)) movableY

solve' :: Chessboard -> Bool
solve' = cowardlyMoves

intP :: P.Parser Int
intP = do
  read <$> P.many1 P.digit

problemDefinition :: P.Parser [Chessboard]
problemDefinition = do
  numTestCases <- intP
  P.newline
  P.many chessboard

chessboard :: P.Parser Chessboard
chessboard = do
  size <- intP
  P.space
  numRooks <- intP
  P.newline
  rookPositions <- P.count numRooks rookPosition
  pure $ Chessboard { size = size, rookPositions = rookPositions }

rookPosition :: P.Parser (Int, Int)
rookPosition = do
  x <- intP
  P.space
  y <- intP
  P.newline
  pure (x, y)

import Data.Char
import Control.Monad

solve n m = if (n>m) then "YES" else "NO"

loop = do
  line <- getLine
  let [n,m] = (map read . words) line
  replicateM_ m getLine
  print (solve n m)
main = do
  t  <- read <$> getLine
  replicateM_ t loop

module Main where

import qualified Data.Set as S

solution a c = let one = S.fromList (fst <$> c); two = S.fromList (snd <$> c) in S.size one == a || S.size two == a

loop :: Int -> IO () -> IO ()
loop 0 act = return ()
loop x act = act >>= (\_ -> loop (x - 1) act)

accum :: Int -> IO a -> IO [a]
accum 0 _ = pure []
accum x get = (:) <$> get <*> accum (x - 1) get

main = do
  times <- read <$> getLine
  loop times $ do
    (a : b : _) <- fmap read . words <$> getLine
    list <- accum b $ (\(a : b : _) -> (a, b)) . fmap read . words <$> getLine :: IO [(Int, Int)]
    print $ (\x -> if not x then "YES" else "NO") $ solution a list


You are given an integer $$$x$$$. Can you make $$$x$$$ by summing up some number of $$$11, 111, 1111, 11111, \ldots$$$? (You can use any number among them any number of times).For instance,   $$$33=11+11+11$$$  $$$144=111+11+11+11$$$

The first line of input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10000)$$$ — the number of testcases. The first and only line of each testcase contains a single integer $$$x$$$ $$$(1 \leq x \leq 10^9)$$$ — the number you have to make.

For each testcase, you should output a single string. If you can make $$$x$$$, output "YES" (without quotes). Otherwise, output "NO". You can print each letter of "YES" and "NO" in any case (upper or lower).

NoteWays to make $$$33$$$ and $$$144$$$ were presented in the statement. It can be proved that we can't present $$$69$$$ this way.

import Data.Bool ( bool )

solve :: Int -> Bool
solve n = or [(n - k) `mod` 11 == 0 | k <- [0, 111 .. 1110], k <= n]

main = interact $ unlines . map (bool "NO" "YES" . solve . read) . tail . lines

import Data.Bool ( bool )

solve :: Int -> Bool
solve n = 0 `elem` [x `mod` 11 | x <- (n - ) <$> [0, 111 .. 1110], x >= 0]

main = interact $ unlines . map (bool "NO" "YES" . solve . read) . tail . lines

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    x <- fmap (fromIntegral . parseInt) C.getLine :: IO Int64
    let
      func x 11 = x `mod` 11 == 0
      func x y = any id [func (x - k * y) (y `div` 10) | k <- [0 .. min 10 (x `div` y)]]
    return $ (string8 $ if func x 11111111 then "YES" else "NO") `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad

solve x
    | or xs = "YES"
    | otherwise = "NO"
    where xs = [ x `rem` 11 == (111 * d) `rem` 11 && (x - 111 * d) `rem` 11 == 0 | d <- [0..10], x - 111 * d >= 0]

work = do
    x <- getLine

    putStrLn $ solve (read x :: Int)

main = do
    t <- getLine

    replicateM_ (read t :: Int) work

import Control.Applicative
import Control.Monad.Trans.Except
import Control.Monad.Trans.Identity
import Control.Monad.Trans.Maybe
import Control.Monad
import Data.Monoid
import Data.Foldable
import Data.Traversable
import Data.Functor.Identity

go x d
   | (x - d*111) <0 || ((x- d*111) `mod` 11 /= 0)  = False
   | otherwise = True

solve = do
    x <- readLn :: IO Int
    if (any (go x) [0..10]) then putStrLn("YES") else putStrLn ("NO")

main :: IO()
main = do
    test <- readLn :: IO Int
    replicateM_ test solve

import Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t (getLine >>= putStrLn . solve . read)

listSmall :: [Int]
listSmall = [0,111 .. 1110] >>= \x -> map (x +) [0,11 .. 1111]

solve :: Int -> String
solve n
    | n > 11 * 111 - 11 - 111 = "YES"
    | n `elem` listSmall = "YES"
    | otherwise = "NO"

import  Control.Monad

check n = any (\x -> (n - x) `mod` 11 == 0 && x <= n) [0,111..1110]

main = do
  t <- (read <$> getLine) :: IO Int
  replicateM_ t $ do
    x <- (read <$> getLine) :: IO Int
    putStrLn $ if check x then "YES" else "NO"

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    x <- fmap (fromIntegral . parseInt) C.getLine :: IO Int64
    let k = (9 * x + 99) `div` 100
        result = x >= 11 * k
    return $ (string8 $ if result then "YES" else "NO") `mappend` charUtf8 '\n'
  hPutBuilder stdout output


Today the «Z» city residents enjoy a shell game competition. The residents are gathered on the main square to watch the breath-taking performance. The performer puts 3 non-transparent cups upside down in a row. Then he openly puts a small ball under one of the cups and starts to shuffle the cups around very quickly so that on the whole he makes exactly 3 shuffles. After that the spectators have exactly one attempt to guess in which cup they think the ball is and if the answer is correct they get a prize. Maybe you can try to find the ball too?

The first input line contains an integer from 1 to 3 — index of the cup which covers the ball before the shuffles. The following three lines describe the shuffles. Each description of a shuffle contains two distinct integers from 1 to 3 — indexes of the cups which the performer shuffled this time. The cups are numbered from left to right and are renumbered after each shuffle from left to right again. In other words, the cup on the left always has index 1, the one in the middle — index 2 and the one on the right — index 3.

In the first line output an integer from 1 to 3 — index of the cup which will have the ball after all the shuffles.

solve :: String -> String
solve s = check n list
  where
    n = head ls
    list = map words $ tail ls
    ls = lines s

check :: String -> [[String]] -> String
check n ls = foldl f n ls

f :: String -> [String] -> String
f x [a, b]
  | x == a = b
  | x == b = a
  | otherwise = x

main :: IO()
main = do
  s <- readFile "input.txt"
  writeFile "output.txt" $ solve s

func1 :: Int -> [(Int, Int)] -> Int
func1 start [] = start
func1 start ((a,b) : xs) | start == a = func1 b xs
                         | start == b = func1 a xs
                         | otherwise  = func1 start xs

func :: String -> [(Int, Int)]
func str = f $ tail $ lines str
    where f []     = []
          f (x:xs) = ((head $ map read $ words x), (head $ tail $ map read $ words x)) : f xs

main :: IO ()
main = do
       str <- readFile "input.txt"
       writeFile "output.txt" $ show $ func1 (read $ head $ lines str) (func str)

{-
func1 :: Int -> [(Int, Int)] -> Int
func1 start [] = start
func1 start (x : xs) = func1 (chtarget start x) xs
                           where chtarget s (a, b)
                               | s == a = b
                               | s == b = a
                               | otherwise = s
-}

import System.IO

func1 :: Int -> [(Int, Int)] -> Int
func1 start [] = start
func1 start (x : xs) = func1 (chtarget start x) xs
                           where chtarget s (a, b) = if s == a
                                                     then b
                                                     else if s == b
                                                          then a
                                                          else s
list2tupple :: [Int] -> [(Int, Int)]
list2tupple [] = []
list2tupple (x : y : xs) = (x, y) : list2tupple xs

main :: IO ()
main = do
       inh <- openFile "input.txt" ReadMode
       outh <- openFile "output.txt" WriteMode
       startstr <- hGetLine inh
       let start = (read startstr) :: Int

       secondstr <- hGetLine inh
       let secondlist = (map read (words secondstr)) :: [Int]

       thirdstr <- hGetLine inh
       let thirdlist = (map read (words thirdstr)) :: [Int]

       forthstr <- hGetLine inh
       let forthlist = (map read (words forthstr)) :: [Int]

       let list = secondlist ++ thirdlist ++ forthlist

       let shuffled = list2tupple list

       hPutStrLn outh (show (func1 start shuffled))

       hClose inh
       hClose outh

import IO

gao :: [Int] -> Int
gao [a] = a
gao (a:b:c:d) = gao $ (if a == b then c else if a == c then b else a):d

main = do
	hi <- openFile "input.txt" ReadMode
	ho <- openFile "output.txt" WriteMode
	hGetContents hi >>= hPutStr ho . show . gao . map read . words
	hClose ho

{- 人様の解答を参考に -}

test :: [String] -> String
test (i : a : b : xs)
  | i == a    = test (b : xs)
  | i == b    = test (a : xs)
  | otherwise = test (i : xs)
test [i] = i

main :: IO ()
main = do input <- readFile "input.txt"
          writeFile "output.txt" $ test $ words input

import Data.List

test :: String -> [String] -> Int
test "1" xs = loop 1 0 0 xs
test "2" xs = loop 0 1 0 xs
test "3" xs = loop 0 0 1 xs

loop :: Int -> Int -> Int -> [String] -> Int
loop a b c (x1 : x2 : xs)
  | xs' == ["1", "2"] = loop b a c xs
  | xs' == ["1", "3"] = loop c b a xs
  | xs' == ["2", "3"] = loop a c b xs
    where xs' = sort [x1, x2]
loop a b c [] = x + 1
    where Just x = elemIndex 1 [a, b, c]

main :: IO ()
main = do input <- readFile "input.txt"
          let cs = words input
          writeFile "output.txt" $ show $ test (head cs) (tail cs)

{- 人様の解答を参考に -}

test :: String -> [String] -> String
test i (a : b : xs)
  | i == a    = test b xs
  | i == b    = test a xs
  | otherwise = test i xs
test i [] = i

main :: IO ()
main = do input <- readFile "input.txt"
          let xs = words input
          writeFile "output.txt" $ test (head xs) (tail xs)

-- test :: Int -> [[String]] -> Int
test "1" xs = loop 1 0 0 xs
test "2" xs = loop 0 1 0 xs
test "3" xs = loop 0 0 1 xs

-- loop :: Int -> Int -> Int -> [[String]] -> Int
loop 1 _ _ [] = 1
loop _ 1 _ [] = 2
loop _ _ 1 [] = 3
loop a b c (x1 : x2 : xs)
  | (x1, x2) == ("1", "2") || (x1, x2) == ("2", "1") = loop b a c xs
  | (x1, x2) == ("1", "3") || (x1, x2) == ("3", "1") = loop c b a xs
  | (x1, x2) == ("2", "3") || (x1, x2) == ("3", "2") = loop a c b xs

main :: IO ()
main = do input <- readFile "input.txt"
          let ([i], xs) = splitAt 1 $ words input
          writeFile "output.txt" $ show $ test i xs

main = do
  cont <- readFile "input.txt"
  writeFile "output.txt" $ f cont

f str = (show $ f' first ops) ++ "\n"
     where ls = lines str
           first = read $ head ls
           ops :: [(Int, Int)]
           ops = map (fu.words) $ tail ls
           fu (a:b:[]) = (read a, read b)
           fu x = error $ show x

f' n [] = n
f' n ((a,b):xs)
  | n == a = f' b xs
  | n == b = f' a xs
  | otherwise = f' n xs

import IO

solve :: Int -> [[Int]] -> Int
solve x []  =  x
solve x ([a,b]:xs)
  | a == x  =  solve b xs
  | b == x  =  solve a xs
  | otherwise  =  solve x xs

main :: IO ()
main  =  do
    hInput  <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    n  <-  (hGetLine hInput >>= return . read)
    swaps  <-  mapM (\n -> hGetLine hInput >>= return . map read . words) [1..3]
    hPrint hOutput $ solve n swaps

    hClose hInput
    hClose hOutput

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.lines

func::[String]->String
func (a:xs) = toString$solve (toInt a) (map (func'.words) xs)
              where
                func' (a:b:[]) = (toInt a,toInt b)
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve a (b:xs) | (fst b) == a = solve (snd b) xs
               | (snd b) == a = solve (fst b) xs
               | otherwise    = solve a xs
solve a []                    = a

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

main :: IO ()
main = do
  let readData :: String -> [Int]
      readData = map read . words
      writeText = writeFile "output.txt"
  (n : _) : others <- map readData . lines <$> readFile "input.txt"
  let pairs = do
        a : b : _ <- others
        return [min a b, max a b]
      cups = take 3 $ drop (3 - n) [False, False, True, False, False]
      swap [1, 2] (x1 : x2 : x3 : _) = x2 : x1 : x3 : []
      swap [1, 3] (x1 : x2 : x3 : _) = x3 : x2 : x1 : []
      swap [2, 3] (x1 : x2 : x3 : _) = x1 : x3 : x2 : []
      ans = (+ 1) . head . findIndices id $ foldr swap cups pairs
  writeText $ printf "%d\n" ans

main = do
  input <- readFile "input.txt"
  writeFile "output.txt" (solve input)
solve :: String -> String
solve input = output where
  [init]:shuffle = map words $ lines input
  output = answer $ reverse shuffle
  answer [] = init
  answer ([x,y]:xs)
    | z == x    = y
    | z == y    = x
    | otherwise = z
    where z = answer xs

main =
  do
    input <- readFile "input.txt"
    writeFile "output.txt" (solve input)
  where
    solve :: String -> String
    solve s
      = show $ process init (tail nums)
      where
        nums = map (read::String->Integer) (words s)
        init = head nums
        process init (x:y:rest)
          | init == 6-x-y
          = process init rest
          | otherwise
          = process (x+y-init) rest
        process init []
          = init

{-# LANGUAGE ForeignFunctionInterface #-}

import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe (fromJust)
import Data.List (foldl')

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
{-# INLINE unsafeReadDouble #-}
readDouble = unsafeReadDouble . SB.concat . LB.toChunks
readInt = fst . fromJust . LB.readInt

main = readFile "input.txt" >>= (writeFile "output.txt" . show . solve . parse . lines)

parse :: [String] -> (Int, [[Int]])
parse str =
  let n = read (head str)
      lst = map (map read . words) . tail $ str
  in (n, lst)

solve (n, lst) = foldl' f n lst
    where f acc [x,y]  | acc == x = y
                       | acc == y = x
                       | otherwise = acc

import System.IO

main = do
    handle <- openFile "input.txt" ReadMode
    cupStr <- hGetLine handle
    let cup = read cupStr :: Int
    first <- hGetLine handle
    second <- hGetLine handle
    third <- hGetLine handle
    let commands = map (map read . words) [first,second,third] :: [[Int]]
    writeFile "output.txt" $ show $ fullShuffle commands cup

fullShuffle :: [[Int]] -> Int -> Int
fullShuffle commands cup = foldl oneShuffle cup commands

oneShuffle :: Int -> [Int] -> Int
oneShuffle cup command
    | cup == head command = last command
    | cup == last command = head command
    | otherwise = cup


There are $$$n$$$ points and $$$m$$$ segments on the coordinate line. The initial coordinate of the $$$i$$$-th point is $$$a_i$$$. The endpoints of the $$$j$$$-th segment are $$$l_j$$$ and $$$r_j$$$ — left and right endpoints, respectively.You can move the points. In one move you can move any point from its current coordinate $$$x$$$ to the coordinate $$$x - 1$$$ or the coordinate $$$x + 1$$$. The cost of this move is $$$1$$$.You should move the points in such a way that each segment is visited by at least one point. A point visits the segment $$$[l, r]$$$ if there is a moment when its coordinate was on the segment $$$[l, r]$$$ (including endpoints).You should find the minimal possible total cost of all moves such that all segments are visited.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 2 \cdot 10^5$$$) — the number of points and segments respectively. The next line contains $$$n$$$ distinct integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$) — the initial coordinates of the points. Each of the next $$$m$$$ lines contains two integers $$$l_j$$$, $$$r_j$$$ ($$$-10^9 \le l_j \le r_j \le 10^9$$$) — the left and the right endpoints of the $$$j$$$-th segment. It's guaranteed that the sum of $$$n$$$ and the sum of $$$m$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print a single integer — the minimal total cost of all moves such that all segments are visited.

NoteIn the first test case the points can be moved as follows:  Move the second point from the coordinate $$$6$$$ to the coordinate $$$5$$$.  Move the third point from the coordinate $$$14$$$ to the coordinate $$$13$$$.  Move the fourth point from the coordinate $$$18$$$ to the coordinate $$$17$$$.  Move the third point from the coordinate $$$13$$$ to the coordinate $$$12$$$.  Move the fourth point from the coordinate $$$17$$$ to the coordinate $$$16$$$. The total cost of moves is $$$5$$$. It is easy to see, that all segments are visited by these movements. For example, the tenth segment ($$$[7, 13]$$$) is visited after the second move by the third point.Here is the image that describes the first test case:

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

solve :: IO ()
solve = do
    ~[n, m] <- readInts
    as <- readInts
    lrs <- replicateM m readInts
    let veryLeft = -10^9 - 1 :: Int64
        big      =  10^16    :: Int64

        a :: Array Int Int64
        a = listArray (0, n) $ (veryLeft:) $ map fromIntegral $ sort as

        b :: Array Int [(Int64, Int64)]
        b = accumArray (flip (:)) [] (0, n) lrs'  where
            lrs' = mapMaybe (f . map fromIntegral) $ reverse $ sort lrs
            f ~[l, r]
                | i <= n && a!i <= r = Nothing
                | otherwise = Just (i - 1, (l, r))
                where i = binSearchA (>=l) a
        sz = listArray (0, n) $ map length $ elems b

        la :: Array Int (Array Int Int64)
        la = listArray (0, n) $
            [ listArray (1, sz!i) $ map (fromIntegral . fst) lrs
            | (i, lrs) <- assocs b
            ]
        rmin :: Array Int [Int64]
        rmin = listArray (0, n) $
            [ scanr1 min $ map (fromIntegral . snd) lrs
            | (i, lrs) <- assocs b
            ]

        dp :: Array Int [Int64]
        dp = fArray (0, n) f where
            f 0 = take (1 + sz!0) $ 0 : repeat big
            f i = map g [0..sz!i] where
                (rminPrv, szPrv, dpPrv) = (rmin!(i - 1), sz!(i - 1), dp!(i - 1))
                pre = listArray (0, szPrv - 1) $ scanl1 min $ zipWith (-) dpPrv rminPrv
                suf = listArray (0, szPrv - 1) $ scanr1 min $ zipWith (-) dpPrv $ map (*2) rminPrv
                (rminaPrv, dpaPrv) = (listArray (1, szPrv) rminPrv, listArray (0, szPrv) dpPrv)
                g 0 = minimum $ dpaPrv!szPrv : [a!i + dx - rx | (dx, rx) <- zip dpPrv rminPrv]
                g j = onlyRight `min` left `min` right where
                    onlyRight    = la!i!j - a!i + dpaPrv!szPrv
                    rightFirst k = 2 * la!i!j - a!i - rminaPrv!(k + 1)
                    leftFirst  k = a!i + la!i!j - 2 * rminaPrv!(k + 1)
                    k            = binSearch (\k -> leftFirst k < rightFirst k) 0 (szPrv - 1)
                    right | k - 1 < 0     = big
                          | otherwise     = pre!(k - 1) + 2 * la!i!j - a!i
                    left  | szPrv - 1 < k = big
                          | otherwise     = suf!k + a!i + la!i!j

    print $ last $ dp!n

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

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

solve :: IO ()
solve = do
    ~[n, m] <- readInts
    as <- readInts
    lrs <- replicateM m readInts
    let veryLeft = -10^9 - 1 :: Int64
        big      =  10^16    :: Int64

        a :: Array Int Int64
        a = listArray (0, n) $ (veryLeft:) $ map fromIntegral $ sort as

        b :: Array Int [(Int64, Int64)]
        b = accumArray (flip (:)) [] (0, n) lrs'  where
            lrs' = mapMaybe (f . map fromIntegral) $ reverse $ sort lrs
            f ~[l, r]
                | i <= n && a!i <= r = Nothing
                | otherwise = Just (i - 1, (l, r))
                where i = binSearchA (>=l) a
        sz = listArray (0, n) $ map length $ elems b

        la :: Array Int (Array Int Int64)
        la = listArray (0, n) $
            [ listArray (1, sz!i) $ map (fromIntegral . fst) lrs
            | (i, lrs) <- assocs b
            ]
        rmin :: Array Int [Int64]
        rmin = listArray (0, n) $
            [ scanr1 min $ map (fromIntegral . snd) lrs
            | (i, lrs) <- assocs b
            ]

        stepDp :: [Int64] -> Int -> [Int64]
        stepDp dpPrv i = map f [0..sz!i] where
            (rminPrv, szPrv) = (rmin!(i - 1), sz!(i - 1))
            pre = listArray (0, szPrv - 1) $ scanl1 min $ zipWith (-) dpPrv rminPrv
            suf = listArray (0, szPrv - 1) $ scanr1 min $ zipWith (-) dpPrv $ map (*2) rminPrv
            (rminaPrv, dpaPrv) = (listArray (1, szPrv) rminPrv, listArray (0, szPrv) dpPrv)
            f 0 = minimum $ dpaPrv!szPrv : [a!i + dx - rx | (dx, rx) <- zip dpPrv rminPrv]
            f j = onlyRight `min` left `min` right where
                onlyRight    = la!i!j - a!i + dpaPrv!szPrv
                rightFirst k = 2 * la!i!j - a!i - rminaPrv!(k + 1)
                leftFirst  k = a!i + la!i!j - 2 * rminaPrv!(k + 1)
                k            = binSearch (\k -> leftFirst k < rightFirst k) 0 (szPrv - 1)
                right | k - 1 < 0     = big
                      | otherwise     = pre!(k - 1) + 2 * la!i!j - a!i
                left  | szPrv - 1 < k = big
                      | otherwise     = suf!k + a!i + la!i!j

    print $ last $ foldl' stepDp (take (1 + sz!0) $ 0 : repeat big) [1..n]

binSearch :: Integral i => (i -> Bool) -> i -> i -> i
binSearch f = go where
    go l h
        | l > h     = l
        | f m       = go l (m - 1)
        | otherwise = go (m + 1) h
        where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l h where (l, h) = bounds a

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

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.Arrow ((&&&), (***))
import Control.Monad.Trans.State
import Data.Bifunctor (bimap)
import Data.Function (on)
import Data.Maybe
import Data.Semigroup (Min(..))
import Data.Tuple (swap)
import qualified Data.Set as Set

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

import Debug.Trace

type Cost = Maybe (Min Int)
type Range = (Int, Int)
type Pos = (Range, Maybe Int,  (Cost, Cost))

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n,m] <- getInts 2
    ps <- Set.fromList <$> getInts n
    rs <- fmap concat $ replicateM m $ do
      ~[l, r] <- getInts 2
      pure $! do
        guard $! Set.null
          $ Set.takeWhileAntitone (<=r)
          $ Set.dropWhileAntitone (<l)
          $ ps
        pure $! (l, r)
    let
      rs' = foldl' excludeCover Set.empty $ sortOn swap rs
      excludeCover :: Set.Set Range -> Range -> Set.Set Range
      excludeCover s x@(l, r) =
        if Set.null $ Set.dropWhileAntitone ((<l) . fst) s
          then (Set.insert x s) else s
      run :: Set.Set Range -> [(Set.Set Range, Set.Set Range)]
      run s = let s0 = (s, Set.empty)
        in go s0
        where
          go s'@(sl, sr) = s':case Set.maxView sl of
            Just (v, sl') -> go (sl', Set.insert v sr)
            _ -> []
      getBest :: (Int, Int) -> Int -> Set.Set Range -> Int -> (Int, Int)
      getBest (c1, c2) l s r = foldl1' (\(x1, y1) (x2,y2)->(min x1 x2, min y1 y2)) $ map step $  run s
        where
          gol sl = case Set.lookupMax sl of
            Just (l', _) -> let dl = l' - l in min (c1 + 2 * dl) (c2 + dl)
            otherwise -> min c1 c2
          gor cl sr = case Set.lookupMin sr of
            Just (_, r') -> let dr = r - r' in (cl + dr, cl + 2 * dr)
            otherwise -> (cl, cl)
          step (sl, sr) = let cl = gol sl in gor cl sr
      best =
        let
          Just (a0, ps') = Set.minView ps
          s0 = case Set.lookupMin rs' of
            Just (_, r0) -> if r0 < a0 then (a0 - r0, 2 * (a0 - r0)) else (0, 0)
            _ -> (0,0)
          step (l, s) r = let
            ss' = Set.takeWhileAntitone ((<=r).snd) $ Set.dropWhileAntitone ((<=l).snd) $ rs'
            in (r, getBest s l ss' r)
          (lastl, (lastcl, lastcr)) = Set.foldl' step (a0, s0) ps'
        in case Set.lookupMax rs' of
          Just (maxl, _) -> if maxl <= lastl
            then min lastcl lastcr
            else let
              dl = maxl - lastl
              in min (lastcl + 2 * dl) (lastcr + dl)
          _ -> 0
    pure $! putInts [best]

type SP = State [P.ByteString]

readInt :: P.ByteString -> Int
readInt = fst . fromJust . P.readInt

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

getInts :: Int -> SP [Int]
getInts k = map 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.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Int

suffMins :: UArray Int Int -> UArray Int Int
suffMins arr = let
  (p, q) = bounds arr
  step (ix, val) = (ix - 1, min val (arr ! (ix - 1)))
  in  array (p, q + 1) $ take (rangeSize (p, q + 1))
  $ iterate step (q + 1, maxBound)

binSearch :: Integral t => (t -> Bool) -> t -> t -> t
binSearch fun = let
  go li ri = if  li == ri
    then  li
    else  let
    mi = li + quot (ri - li) 2
    in  if  fun mi
    then  go li mi
    else  go (mi+1) ri
  in  go

type UA = UArray Int Int
data Info = Info !Int64 !Int64 deriving (Eq, Ord, Show)

getCost :: Info -> Int -> Int -> Int64
getCost (Info c2 c1) pos tarPos = let
  rdist = fromIntegral $ tarPos - pos
  in  if  rdist <= 0
  then  c2
  else  min (c2 + 2 * rdist) (c1 + rdist)

solve :: UA -> UA -> UA -> Int64
solve as startPts necessities = let
  (1, n) = bounds as
  (_, stopPt) = bounds necessities
  leftPos = as ! 1
  leftTar = necessities ! 1
  leftDist = fromIntegral $ max 0 $ leftPos - leftTar
  startInfo = Info leftDist $ 2 * leftDist
  step :: Info -> Int -> Info
  step prevInfo ix = let
    oldPos = as ! (ix - 1)
    newPos = as ! ix
    oldRix = binSearch (\j -> startPts ! j > oldPos) 1 stopPt
    newRix = binSearch (\j -> startPts ! j > newPos) 1 stopPt
    newC !k = foldl' min maxBound $ do
      let
        leftOpts = oldPos : map (startPts !) [oldRix .. newRix - 1]
        rightOpts = map (necessities !) [oldRix .. newRix]
      (ltar, rtar) <- zip leftOpts rightOpts
      pure $ getCost prevInfo oldPos ltar
        + k * fromIntegral (newPos - min newPos rtar)
    in  Info (newC 1) (newC 2)
  finalInfo = foldl' step startInfo [2 .. n]
  in  getCost finalInfo (as ! n) (startPts ! (stopPt - 1))

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    aLi <- getInts n
    lr <- replicateM m $ do
      ~[lj, rj] <- getInts 2
      lj `seq` rj `seq` pure (lj, rj)
    let
      intArr :: Array Int (Int, Int)
      intArr = listArray (1, m) $ sort lr
      startPts = listArray (1, m) $ map fst $ elems intArr
      necessity = suffMins $ listArray (1, m) $ map snd $ elems intArr
      a = listArray (1, n) $ sort aLi
    pure $ putInt64s [solve a startPts necessity]

type SP = State [P.ByteString]
type SO = SP Builder

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

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

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec 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


Jeff got 2n real numbers a1, a2, ..., a2n as a birthday present. The boy hates non-integer numbers, so he decided to slightly "adjust" the numbers he's got. Namely, Jeff consecutively executes n operations, each of them goes as follows:  choose indexes i and j (i ≠ j) that haven't been chosen yet;  round element ai to the nearest integer that isn't more than ai (assign to ai: ⌊ ai ⌋);  round element aj to the nearest integer that isn't less than aj (assign to aj: ⌈ aj ⌉). Nevertheless, Jeff doesn't want to hurt the feelings of the person who gave him the sequence. That's why the boy wants to perform the operations so as to make the absolute value of the difference between the sum of elements before performing the operations and the sum of elements after performing the operations as small as possible. Help Jeff find the minimum absolute value of the difference.

The first line contains integer n (1 ≤ n ≤ 2000). The next line contains 2n real numbers a1, a2, ..., a2n (0 ≤ ai ≤ 10000), given with exactly three digits after the decimal point. The numbers are separated by spaces.

In a single line print a single real number — the required difference with exactly three digits after the decimal point.

NoteIn the first test case you need to perform the operations as follows: (i = 1, j = 4), (i = 2, j = 3), (i = 5, j = 6). In this case, the difference will equal |(0 + 0.5 + 0.75 + 1 + 2 + 3) - (0 + 0 + 1 + 1 + 2 + 3)| = 0.25.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLine
    as <- readsLine
    printf "%.3f\n" $ solve n as

solve :: Int -> [Double] -> Double
solve n as = minimum [ abs $ itof z - y | z <- [max 0 (n-k)..n]]
    where
    as' = map (\x -> x - itof (floor x)) as
    k   = length $ filter (==0) as'
    y   = sum as'

import Control.Monad
import Text.Printf

g :: Double -> Double
g x  = x - fromIntegral (floor x)

delta = foldl (\acc x -> acc + (g x)) 0.0

fracs = foldl (\acc x -> if (g x > 0.0001) then (acc + 1) else acc) 0

iter del = foldl (\acc x -> min acc (abs (fromIntegral(x)-del))) (read "Infinity")

limits n xs = let count = fracs xs in
  if (count >= n) then (count-n, n) else (0, count)

ans n xs = iter (delta xs) ys
  where ys = [fst(limits n xs)..snd(limits n xs)]

main = do
  n <- readLn :: IO Int
  x <- getLine
  let xs = map read $ words x :: [Double]
  printf "%.3f" (ans n xs)

import Control.Monad
import Text.Printf

g :: Double -> Double
g x  = x - fromIntegral (floor x)

delta = foldl (\acc x -> acc + (g x)) 0.0

fracs = length . filter (\x -> g x > 0)

iter del = foldl (\acc x -> min acc (abs (fromIntegral(x)-del))) (read "Infinity")

limits n xs = let count = fracs xs in
  if (count >= n) then (count-n, n) else (0, count)

ans n xs = iter (delta xs) ys
  where ys = [fst(limits n xs)..snd(limits n xs)]

main = do
  n <- readLn :: IO Int
  x <- getLine
  let xs = map read $ words x :: [Double]
  printf "%.3f" (ans n xs)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLine
    as <- readsLine
    printf "%.3f\n" $ solve n as

solve :: Int -> [Double] -> Double
solve n as | even k = abs y
           | odd  k = min (abs y) (abs (1+y))
    where
    as' = map (\x -> x - itof (floor x)) as
    k   = length $ filter (/=0) as'
    y   = itof (div k 2) - sum as'


You are given an array $$$a_1, a_2, \dots a_n$$$. Count the number of pairs of indices $$$1 \leq i, j \leq n$$$ such that $$$a_i < i < a_j < j$$$.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 2 \cdot 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \leq a_i \leq 10^9$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the number of pairs of indices satisfying the condition in the statement. Please note, that the answer for some test cases won't fit into 32-bit integer type, so you should use at least 64-bit integer type in your programming language (like long long for C++).

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

fromJust Nothing = 0
fromJust (Just x) = x

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> (fromJust $ Map.lookup (i-2) cnt) * b)
        $ filter (\(i, b) -> 1 < i && i < n)
        $ zip tl (count tl 1)
    where
        tl = tail arr
        cntArr = pref' $ count' arr
        cnt = Map.fromList $ zip [0..(n-1)] cntArr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ solve arr n
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe, catMaybes)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, nub, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.String (fromString)
import Data.Bits (shift)
import Data.Binary (encode, decode)

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

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

printAns :: CoDomain -> IO ()
printAns xs = putStrLn $ show xs

parse :: IO Domain
parse = do
  [n] <- readChar8
  xs <- readChar8
  return xs

-- eliminate duplicate
cal :: Int -> Int
cal n = (n-1) * n `div` 2

solve :: Solver
solve xs = ans - beta
  where ys = sort $ filter (\(x, y)-> x < y) $ zip xs [1..]
        ans = fst $ foldl insertCount (0, Set.empty) ys
        insertCount :: (Int, Set Int) -> (Int, Int) -> (Int, Set Int)
        insertCount (c, s) (a, i) = (Set.findIndex a (Set.insert a s) + c, Set.insert i s)
        beta = 0

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

import           Data.List
import qualified Data.Char as DC
import qualified Data.Set as Set
import qualified Data.Map as Map
import Control.Monad (replicateM)

tSecond (_, z, _) = z
tFirst (o, _, _) = o
tThird (_, _, v) = v

mapLookup e m = unwrap $ Map.lookup e m
unwrap (Just x) = x
unwrap Nothing = 0

solveCase :: IO ()
solveCase = do
    n <- fmap (read :: String -> Int) getLine
    rarr <- fmap (map (read :: String -> Int) . words) getLine
    putStrLn $ show $ tSecond $ foldl (\tp el -> if (fst el) > (snd el) then (Set.insert (fst el) (tFirst tp), (tSecond tp) + (Set.findIndex (mapLookup ((snd el) - 1) (tThird tp)) (tFirst tp)), Map.insert (fst el) (fst el) (tThird tp)) else ((tFirst tp), (tSecond tp), Map.insert (fst el) (mapLookup (fst el - 1) (tThird tp)) (tThird tp) )) (Set.singleton 0, 0, Map.singleton 0 0) $ zip [1..n] rarr

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

{-# LANGUAGE NumericUnderscores #-}

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

skipWhitespace :: BS.ByteString -> BS.ByteString
skipWhitespace = BS.dropWhile (`elem` " \r\n\t")

readInts :: BS.ByteString -> [Int]
readInts line = case BS.readInt line of Just (x, t) -> x : (readInts (skipWhitespace t))
                                        Nothing -> []
readInt :: BS.ByteString -> Int
readInt line = let [x] = readInts line in x

data Node = Null | Node { leftBound :: Int, rightBound :: Int, sum :: Int, leftChild :: Node, rightChild :: Node }
    deriving (Show, Eq)

isLeaf :: Node -> Bool
isLeaf node = leftBound node == rightBound node

middle :: Node -> Int
middle node = (leftBound node + rightBound node) `div` 2

inside :: Node -> Int -> Bool
inside node pos = leftBound node <= pos && pos <= rightBound node

ensureLeftChild :: Node -> Node
ensureLeftChild node | isLeaf node = node
                     | leftChild node == Null = Node (leftBound node) (rightBound node) (Main.sum node) (makeLeftChild node) (rightChild node)
                     | otherwise = node
    where makeLeftChild :: Node -> Node
          makeLeftChild node = Node (leftBound node) (middle node) 0 Null Null

ensureRightChild :: Node -> Node
ensureRightChild node | isLeaf node = node
                      | rightChild node == Null = Node (leftBound node) (rightBound node) (Main.sum node) (leftChild node) (makeRightChild node)
                      | otherwise = node
    where makeRightChild :: Node -> Node
          makeRightChild node = Node (middle node + 1) (rightBound node) 0 Null Null

emptyRoot :: Node
emptyRoot = Node 0 1_000_000_000 0 Null Null

increment :: Int -> Node -> Node
increment position node | isLeaf node = makeNode Null Null
                        | position <= middle node = let node' = ensureLeftChild node
                                                    in makeNode (increment position (leftChild node')) (rightChild node')
                        | otherwise = let node' = ensureRightChild node
                                      in makeNode (leftChild node') (increment position (rightChild node'))
    where makeNode = Node (leftBound node) (rightBound node) (Main.sum node + 1)

getSum :: Int -> Int -> Node -> Int
getSum l r Null = 0
getSum l r node | l > r = 0
                | l <= leftBound node && rightBound node <= r = Main.sum node
                | r < leftBound node || rightBound node < l = 0
                | otherwise = getSum l r (leftChild node) + getSum l r (rightChild node)

solve :: [Int] -> Int
solve = go emptyRoot 1
    where go :: Node -> Int -> [Int] -> Int
          go node _ [] = 0
          go node i (x:xs) = if x < i
                             then let node' = increment i node in (getSum 0 (x - 1) node') + go node' (i + 1) xs
                             else go node (i + 1) xs

testCaseMain :: Int -> IO ()
testCaseMain _ = do n <- readInt <$> BS.getLine
                    a <- readInts <$> BS.getLine
                    print (solve a)

main :: IO ()
main = do t <- readInt <$> BS.getLine
          forM_ [1 .. t] testCaseMain

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

fromJust Nothing = 0
fromJust (Just x) = x

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> (fromJust $ Map.lookup (i-2) cnt) * b)
        $ filter (\(i, b) -> 1 < i && i < n)
        $ zip tl (count tl 1)
    where
        tl = tail arr
        cntArr = pref' $ count' arr
        cnt = Map.fromList $ zip [0..(n-1)] cntArr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show $ (solve arr n) `mod` 1000000007
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t

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

count :: [Int] -> Int -> [Int]
count [] i = []
count (x:xs) i = (if x <= i then 1 else 0) : (count xs $ i + 1)
count' arr = count arr 0

pref :: [Int] -> Int -> [Int]
pref [] prev = []
pref (x:xs) prev = (x + prev) : (pref xs (x + prev))
pref' arr = pref arr 0

solve :: [Int] -> Int -> Int
solve arr n =
    sum $ map (\(i, b) -> if 1 < i && i < n then cnt !! (i-2) * b else 0) $ zip tl (count tl 1)
    where
        tl = tail arr
        cnt = pref' $ count' arr

testcase 0 = return ()
testcase t = do
    n <- readLn :: IO Int
    arr <- map (read :: String -> Int) <$> words <$> getLine
    putStrLn $ show arr
    putStrLn $ show $ count arr 0
    putStrLn $ show $ pref (count arr 0) 0
    putStrLn $ show $ (solve arr n) `mod` 1000000007
    testcase (t - 1)

main :: IO ()
main = do
    t <- read <$> getLine
    testcase t


Gregor is learning about RSA cryptography, and although he doesn't understand how RSA works, he is now fascinated with prime numbers and factoring them.Gregor's favorite prime number is $$$P$$$. Gregor wants to find two bases of $$$P$$$. Formally, Gregor is looking for two integers $$$a$$$ and $$$b$$$ which satisfy both of the following properties.  $$$P \bmod a = P \bmod b$$$, where $$$x \bmod y$$$ denotes the remainder when $$$x$$$ is divided by $$$y$$$, and  $$$2 \le a < b \le P$$$. Help Gregor find two bases of his favorite prime number!

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Each subsequent line contains the integer $$$P$$$ ($$$5 \le P \le {10}^9$$$), with $$$P$$$ guaranteed to be prime.

Your output should consist of $$$t$$$ lines. Each line should consist of two integers $$$a$$$ and $$$b$$$ ($$$2 \le a < b \le P$$$). If there are multiple possible solutions, print any.

NoteThe first query is $$$P=17$$$. $$$a=3$$$ and $$$b=5$$$ are valid bases in this case, because $$$17 \bmod 3 = 17 \bmod 5 = 2$$$. There are other pairs which work as well.In the second query, with $$$P=5$$$, the only solution is $$$a=2$$$ and $$$b=4$$$.

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  !t <- readLn
  replicateM_ t
    $ do
      !p <- getLine
      let b=let n=read p::Int in show (n-1)
      putStrLn $ '2':' ':b

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  t <- readLn
  replicateM_ t
    $ do
      p <- getLine
      let (a, b) = ("2",let n=read p::Int in show (n-1))
      putStrLn $ a ++ (' ':b)

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import Control.Monad.State ( replicateM_ )

main :: IO ()
main = do
  t <- readLn
  replicateM_ t
    $ do
      p <- readLn
      let (a, b) = solve p
      putStr $ show a
      putStrLn $ ' ':show b

ints :: [LC.ByteString] -> [Int]
ints !str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve !p = (2, p - 1)

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\(a, b) -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints !str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve !p = (2, p - 1)

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\(a, b) -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints str = fst . fromJust . LC.readInt <$> str

solve :: Int -> (Int, Int)
solve p = (2, p - 1)

import qualified Data.ByteString.Lazy.Char8 as LC
import qualified Data.ByteString as P
import           Data.Maybe (fromJust)
import           Control.Applicative (liftA2)
import           Control.Monad.State ()

main :: IO ()
main = getLine >> LC.getContents
  >>= mapM_ ((\[a, b] -> putStr (show a) >> putStrLn (' ':show b)) . solve)
  . ints
  . LC.lines

ints :: [LC.ByteString] -> [Int]
ints str = fst . fromJust . LC.readInt <$> str

solve :: Int -> [Int]
solve p = [2, p - 1]

import Control.Monad

main = do
    t <- readLn :: IO Int
    replicateM_ t subMain

subMain = do
    p <- readLn :: IO Int
    putStrLn $ "2 " ++ show (p - 1)

module Main where

main :: IO ()
main = do
    t <- readLn :: IO Int
    mapM_ subMain [1,2 .. t]

subMain :: Int -> IO ()
subMain test = do
    p <- readLn :: IO Int
    putStrLn ("2 " ++ show (p - 1))

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    n <- read <$> getLine :: IO Int
    putStrLn $ show ((n - 1) `quot` 2) ++ " " ++ show (n - 1)

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> map (read >>> subtract 1 >>> show >>> ("2 " ++))
      >>> unlines

import Control.Monad

solve 5 = [2,4]
solve x = [2,b] where b = div x 2

printResult = do
    p <- readLn :: IO Int
    putStrLn . unwords . map show $ solve p

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult