You are given a positive integer $$$n$$$. Your task is to find any three integers $$$a$$$, $$$b$$$ and $$$c$$$ ($$$0 \le a, b, c \le 10^9$$$) for which $$$(a\oplus b)+(b\oplus c)+(a\oplus c)=n$$$, or determine that there are no such integers.Here $$$a \oplus b$$$ denotes the bitwise XOR of $$$a$$$ and $$$b$$$. For example, $$$2 \oplus 4 = 6$$$ and $$$3 \oplus 1=2$$$.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The following lines contain the descriptions of the test cases. The only line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^9$$$).

For each test case, print any three integers $$$a$$$, $$$b$$$ and $$$c$$$ ($$$0 \le a, b, c \le 10^9$$$) for which $$$(a\oplus b)+(b\oplus c)+(a\oplus c)=n$$$. If no such integers exist, print $$$-1$$$.

NoteIn the first test case, $$$a=3$$$, $$$b=3$$$, $$$c=1$$$, so $$$(3 \oplus 3)+(3 \oplus 1) + (3 \oplus 1)=0+2+2=4$$$.In the second test case, there are no solutions.In the third test case, $$$(2 \oplus 4)+(4 \oplus 6) + (2 \oplus 6)=6+2+4=12$$$.

module Main where

import Control.Monad (liftM2, replicateM_)
import Data.Bits
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String
import qualified Data.ByteString.Char8 as C

type D = (String, String, String)

a110 :: D -> D
a110 (a, b, c) = ('1' : a, '1' : b, '0' : c)

a000 :: D -> D
a000 (a, b, c) = ('1' : a, '1' : b, '1' : c)

prIntegerAns :: D -> IO ()
prIntegerAns (a, b, c) = putStrLn $ unwords $ show <$> toDec <$> reverse <$> [a, b, c]

toBin :: Integer -> String
toBin a = reverse $ go a
  where
    go x
      | x == 0 = ""
      | odd x = '1' : go (x `div` 2)
      | otherwise = '0' : go (x `div` 2)

toDec :: String -> Integer
toDec = foldl (\acc x -> acc * 2 + fromIntegral (digitToInt x)) 0

solve :: Integer -> IO ()
solve x =
  -- print (x `div` 2, a) >>
  if odd x then do print (-1) else prIntegerAns (go a True ("", "", ""))
  where
    a = toBin $ x `div` 2
    go :: String -> Bool -> D -> D
    go "" _ x = x
    go ('0' : xs) b d = go xs b (a000 d)
    go (x : xs) True d = go xs False (a110 d)
    go (x : xs) False d = go xs False (a110 d)

parseInteger :: String -> Integer
parseInteger = fromIntegral . fst . fromJust . C.readInt . fromString

main :: IO ()
main = do
  n <- parseInteger <$> getLine
  replicateM_ (fromIntegral n) (solve =<< parseInteger <$> getLine)

module Main where

import Control.Monad (liftM2, replicateM_)
import Data.Bits
import Data.Char (digitToInt)
import Data.Maybe (fromJust)
import Data.String
import qualified Data.ByteString.Char8 as C

type D = (String, String, String)

a110 :: D -> D
a110 (a, b, c) = ('1' : a, '1' : b, '0' : c)

a001 :: D -> D
a001 (a, b, c) = ('1' : a, '0' : b, '1' : c)

a000 :: D -> D
a000 (a, b, c) = ('1' : a, '1' : b, '1' : c)

prIntegerAns :: D -> IO ()
prIntegerAns (a, b, c) = do
  -- print $ (a, b, c)
  -- print $ check (a, b, c)
  putStrLn $ unwords $ show <$> toDec <$> reverse <$> [a, b, c]

toBin :: Integer -> String
toBin a = reverse $ go a
  where
    go x
      | x == 0 = ""
      | odd x = '1' : go (x `div` 2)
      | otherwise = '0' : go (x `div` 2)

toDec :: String -> Integer
toDec = foldl (\acc x -> acc * 2 + fromIntegral (digitToInt x)) 0

solve :: Integer -> IO ()
solve x =
  -- print (x `div` 2, a) >>
  if odd x then do print (-1) else prIntegerAns (go a True ("", "", ""))
  where
    a = toBin $ x `div` 2
    go :: String -> Bool -> D -> D
    go "" _ x = x
    go ('0' : xs) b d = go xs b (a000 d)
    go (x : xs) True d = go xs False (a110 d)
    go (x : xs) False d = go xs False (a001 d)

parseInteger :: String -> Integer
parseInteger = fromIntegral . fst . fromJust . C.readInt . fromString

-- check' :: (Integer, Integer, Integer) -> Integer
-- check' (a, b, c) = (a `xor` b) + (b `xor` c) + (a `xor` c)

-- check :: D -> Integer
-- check (a, b, c) = check' (toDec $ reverse a, toDec $ reverse  b, toDec $ reverse c)

main :: IO ()
main = do
  n <- parseInteger <$> getLine
  replicateM_ (fromIntegral n) (solve =<< parseInteger <$> getLine)

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

showL = unwords . map show

solve n = ans
  where
    ans | n `mod` 2 /= 0  = [-1 :: Int]
        | otherwise       = [0, 0, n `div` 2]

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# 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.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

m :: Int64
m = 998_244_353

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> Maybe (Int, Int, Int)
solve x
    | even x = Just (x `div` 2, 0, 0)
    | odd x = Nothing

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        x <- B8.getLine <&> readIntB8
        let answer = solve x
        case answer of
            Nothing -> putStrLn "-1\n"
            Just (a, b, c) -> printf "%d %d %d\n" a b c

(>>>) = flip (.)

main :: IO ()
main =
  interact $
    lines
      >>> tail
      >>> map (read >>> solve >>> map show >>> unwords)
      >>> unlines

solve :: Int -> [Int]
solve n
  | even n = [0, 0, n `div` 2]
  | otherwise = [-1]

solveCase :: IO ()
solveCase = do
    s_num <- getLine
    let num = read s_num :: Int
    if num `mod` 2 == 0 then
        putStrLn $ "0 0 " ++ ( show $ num `quot` 2 )
    else
        putStrLn "-1"

solve :: Int -> IO ()
solve cases_left = do
    if cases_left == 1 then
        solveCase
    else do
        solveCase
        solve $ cases_left - 1

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

solve :: Int -> [Int]
solve n = if even n
          then [n `div` 2, n `div` 2, 0]
          else [-1]

testCaseMain :: Int -> IO ()
testCaseMain t = do n <- (readLn :: IO Int)
                    putStrLn $ unwords $ map show $ solve n
                    if t > 1
                    then testCaseMain (t - 1)
                    else return ()

main :: IO ()
main = do t <- (readLn :: IO Int)
          testCaseMain t

{-# LANGUAGE CPP #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
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
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

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

solve :: SP Builder
solve = do
  n <- getInt
  pure $ if not (even n) then putInts [-1] else putInts [div n 2, div n 2, 0]

for :: Int -> IO ()
for 0 = pure ()
for i = do
  a <- readLn :: IO Int
  if a `mod` 2 == 0
    then putStrLn $ "0 0 " ++ show (a `div` 2)
    else print (-1)
  for $ i - 1

main :: IO ()
main = do
  n <- readLn :: IO Int
  for n


Mishka is a little polar bear. As known, little bears loves spending their free time playing dice for chocolates. Once in a wonderful sunny morning, walking around blocks of ice, Mishka met her friend Chris, and they started playing the game.Rules of the game are very simple: at first number of rounds n is defined. In every round each of the players throws a cubical dice with distinct numbers from 1 to 6 written on its faces. Player, whose value after throwing the dice is greater, wins the round. In case if player dice values are equal, no one of them is a winner.In average, player, who won most of the rounds, is the winner of the game. In case if two players won the same number of rounds, the result of the game is draw.Mishka is still very little and can't count wins and losses, so she asked you to watch their game and determine its result. Please help her!

The first line of the input contains single integer n n (1 ≤ n ≤ 100) — the number of game rounds. The next n lines contains rounds description. i-th of them contains pair of integers mi and ci (1 ≤ mi,  ci ≤ 6) — values on dice upper face after Mishka's and Chris' throws in i-th round respectively.

If Mishka is the winner of the game, print "Mishka" (without quotes) in the only line. If Chris is the winner of the game, print "Chris" (without quotes) in the only line. If the result of the game is draw, print "Friendship is magic!^^" (without quotes) in the only line.

NoteIn the first sample case Mishka loses the first round, but wins second and third rounds and thus she is the winner of the game.In the second sample case Mishka wins the first round, Chris wins the second round, and the game ends with draw with score 1:1.In the third sample case Chris wins the first round, but there is no winner of the next two rounds. The winner of the game is Chris.

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

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

main = do
    n <- getInt
    dices <- replicateM n getInts
    let (x,y) = solve dices
    if x == y
    then putStrLn "Friendship is magic!^^"
    else if x > y
    then putStrLn "Mishka"
    else putStrLn "Chris"

solve ds = f ds (0,0) where
    f [] res = res
    f ([d1,d2]:ds) (x,y) = f ds (x',y') where
        x' = if d1 > d2 then x+1 else x
        y' = if d2 > d1 then y+1 else y

import Control.Monad

sol :: [[Int]] -> Int -> Int -> String
sol [] a b = if a > b
  then "Mishka"
  else if b > a
  then "Chris"
  else "Friendship is magic!^^"

sol res a b = if (head (head res)) > (last (head res))
  then (sol (tail res) (a+1) b)
  else if (head (head res)) < (last (head res))
  then (sol (tail res) a (1+b))
  else (sol (tail res) a b)

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [String]
  let input_i = fmap (map read.words) inputs :: [[Int]]
  putStrLn (sol input_i 0 0)

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

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

main = do
	getLine
	ps :: [ ( Int, Int ) ] <- map ( mp . map read . words ) . lines <$> getContents

	let
		m = length $ filter ( f (>) ) ps
		c = length $ filter ( f (<) ) ps

	if m == c
		then putStrLn "Friendship is magic!^^"
		else putStrLn $ which "Mishka" "Chris" $ m > c

f g ( a, b ) = g a b

{-# LANGUAGE NPlusKPatterns #-}
module Main where

main :: IO ()
main = communicate track

track :: [(Int, Int)] -> Ordering
track = stat . map (uncurry compare)

stat :: [Ordering] -> Ordering
stat = categ . assess

categ :: Int -> Ordering
categ n | n < 0 = LT
        | n > 0 = GT
        | otherwise = EQ

assess :: [Ordering] -> Int
assess = sum . map value

value :: Ordering -> Int
value LT = -1
value EQ =  0
value GT =  1

communicate :: ([(Int, Int)] -> Ordering) -> IO ()
communicate f = do
    n <- (readLn :: IO Int)
    ps <- iter n getPair
    putStrLn $ report $ track ps

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

getPair :: IO (Int, Int)
getPair = fmap ((\pl -> (head pl, (head . tail) pl)) . map read . words) getLine

report :: Ordering -> String
report LT = "Chris"
report EQ = "Friendship is magic!^^"
report GT = "Mishka"

import Control.Monad

main :: IO()
main = do
  n <- getLine
  inputs <- replicateM (read n) getLine
  let ds = map convert (map words inputs) where
        convert :: [String] -> (Int, Int)
        convert (x:xs) = (read x :: Int, read (head xs) :: Int)
  putStrLn (winner ds)

winner :: [(Int, Int)] -> String
winner xs = winner' 0 0 xs where
  winner' :: Int -> Int -> [(Int, Int)] -> String
  winner' a b []
    | a > b     = "Mishka"
    | a < b     = "Chris"
    | otherwise = "Friendship is magic!^^"
  winner' a b (x:xs)
    | fst x > snd x = winner' (a+1) b xs
    | fst x < snd x = winner' a (b+1) xs
    | otherwise     = winner' a b xs

main = do
    n <- readLn
    let for x y []
            |x==y = putStrLn "Friendship is magic!^^"
            |x>y  = putStrLn "Mishka"
            |otherwise = putStrLn "Chris"
        for x y (i:is) = do
                [a,b] <- fmap ((map read) . words) getLine :: IO [Int]
                if a==b then for x y is
                else if a<b then for x (y+1) is else for (x+1) y is
    for 0 0 [1..n]

module Main where

import Data.List
import Data.Function

main = do
  count <- read <$> getLine
  inputs <- sequence $ replicate count getLine

  let (mishka, chris) = inputs
                        & map (map read . words)
                        & map (\[x,y] -> x - y)
                        & filter (/= 0)
                        & partition (> 0)

  putStrLn $ case compare (length mishka) (length chris) of
            GT -> "Mishka"
            LT -> "Chris"
            EQ -> "Friendship is magic!^^"

main = interact $ f.tail.lines
f inp = g (map (\x -> map read (words x) :: [Integer]) inp) 0 0

g [] m c
  | m > c = "Mishka"
  | m < c = "Chris"
  | otherwise = "Friendship is magic!^^"

g (x:xs) m c
  | (head x) > (head (tail x)) = g xs (m + 1) c
  | (head x) == (head (tail x)) = g xs m c
  | otherwise = g xs m (c+1)

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

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

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

main = do
  n <- readLn
  ps <- replicateM n getInts

  let
    c1 = length $ filter id $ zipWith (<) (map (!!0) ps) (map (!!1) ps)
    c2 = length $ filter id $ zipWith (>) (map (!!0) ps) (map (!!1) ps)

  putStrLn $ case compare c1 c2 of
    LT -> "Mishka"
    EQ -> "Friendship is magic!^^"
    GT -> "Chris"

main = do
    n <- fmap read getLine :: IO Int
    a <- fmap (map (map read . words)) . sequence $ replicate n getLine :: IO [[Int]]
    putStrLn . getAns . solve $ a

solve :: [[Int]] -> Int
solve = sum . map (trans . (\[x, y] -> x `compare` y))

trans :: Ordering -> Int
trans LT = -1
trans EQ = 0
trans GT = 1

getAns :: Int -> String
getAns n
    | n > 0 = "Mishka"
    | n < 0 = "Chris"
    | otherwise = "Friendship is magic!^^"

module Main where
import Data.List
import Data.Char
main :: IO ()
main = interact $ solve . lines

solve :: [String] -> String
solve xs = let n = read . head $ xs :: Integer
               xs1 = take (fromInteger n) . tail $ xs
               xs2 :: [(Int, Int)]
               xs2 = map (\(a:' ':c:"") -> (ord a - 48, ord c - 48)) xs1
               sctup = foldr (\(a,b) (za, zb) -> if a > b
                                                 then (za+1, zb)
                                                 else if a == b
                                                 then (za, zb)
                                                 else (za, zb+1)) (0,0) xs2
            in case sctup of
                 (a, b) | a > b -> "Mishka"
                        | a == b -> "Friendship is magic!^^"
                        | otherwise -> "Chris"

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = readLn >>= \n-> solve =<< forM [1..n] (\i -> map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = let s= sum $ map (\[a1,a2]-> signum (a2-a1) ) xs in if s<0 then putStr "Mishka" else if s>0 then putStr "Chris" else putStr "Friendship is magic!^^"

import Control.Monad

main = readInput >>= putStrLn . decide . count

readInput :: IO [(Int, Int)]
readInput = getLine >>= readLines . read >>= return . (map toTuple)
  where readLines n = mapM (\_ -> getLine) [1..n]
        toTuple str = (parse 0, parse 1)
          where strs = words str
                parse i = read $ strs !! i

count :: [(Int, Int)] -> Int
count plays = foldr count' 0 plays
  where count' (m, c) tally
          | m < c = tally - 1
          | c < m = tally + 1
          | otherwise = tally

decide :: Int -> String
decide tally
  | tally < 0 = "Chris"
  | 0 < tally = "Mishka"
  | otherwise = "Friendship is magic!^^"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

main :: IO ()
main = do
    n <- readB8Int <$> B8.getLine
    qs <- replicateM n $ do
        [a, b] <- (map readB8Int . B8.words) <$> B8.getLine
        return [a, b]
    let delta = sum . map (\[a, b] -> signum (a - b)) $ qs
        answer
            | delta > 0 = "Mishka"
            | delta < 0 = "Chris"
            | otherwise = "Friendship is magic!^^"
    printf "%s" answer

import Control.Applicative
import Data.List

process   r1 r2 | x==y = "Friendship is magic!^^"
                | x>y = "Mishka"
                | otherwise = "Chris"
  where x = length $ filter (\(z1, z2) ->z1 >z2) $ zip   r1 r2
        y = length $ filter (\(z1, z2) ->z1 >z2) $ zip   r2 r1

main = do
  n<-read <$> getLine ::IO Int
  [r1,r2]<- transpose <$> map (map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
  putStrLn $ process   r1 r2

main = interact $ format . uncurry compare . foldl resolve (0,0) . parse
format GT = "Mishka"
format LT = "Chris"
format EQ = "Friendship is magic!^^"
parse = pairs . map read . tail . words where
  pairs (a:b:xs) = (a,b :: Int) : pairs xs
  pairs [] = []
resolve (a,b) (c,d) = case compare c d of
  GT -> (a+1,b)
  LT -> (a,b+1)
  EQ -> (a,b)

main = getContents >>= putStrLn . solve . map (map read . words) . tail . lines

solve :: [[Int]] -> String
solve ls
    | 0 < x = "Mishka"
    | 0 > x = "Chris"
    | otherwise = "Friendship is magic!^^"
    where x = sum $ map (\[m, c] -> if m > c then 1 else if m < c then -1 else 0) ls

module Main where
  import Data.List
  import Control.Monad

  winnerCounter :: Int -> Int -> (Int, Int) -> (Int, Int)
  winnerCounter x y (a, b)
    | x < y = (a, b + 1)
    | x > y = (a + 1, b)
    | x == y = (a, b)

  winnerCounterLoop :: [(Int, Int)] -> (Int, Int) -> (Int, Int)
  winnerCounterLoop [] result = result
  winnerCounterLoop ((p, q):xs) acc  = winnerCounterLoop xs $ winnerCounter p q acc

  winner :: (Int, Int) -> String
  winner (x, y)
    | x > y = "Mishka"
    | x < y = "Chris"
    | x == y = "Friendship is magic!^^"

  readInt :: String -> Int
  readInt s = read s :: Int

  toTuple :: [Int] -> (Int, Int)
  toTuple [x, y] = (x, y)

  main :: IO ()
  main = do
    n <- getLine >>= return . readInt
    inputs <- replicateM n (getLine >>= return . toTuple . map readInt . words)
    putStrLn $ winner $ winnerCounterLoop inputs (0, 0)

import Control.Monad( replicateM)
data Winner = Mishka | Chrith deriving Eq
main = do
    n <- readLn
    let inning = do
	    [m,c] <- return . map (read::String->Int) . words =<< getLine
	    if m<c
		then return $ Just Chrith
		else if m>c
		    then return $ Just Mishka
		    else return Nothing
    wins <- replicateM n inning
    let ws = filter (/= Nothing) wins
	chris = length $ filter (==Just Chrith) ws
	mishka = length $ filter (==Just Mishka) ws
    if chris>mishka
	then putStrLn "Chris"
	else if chris<mishka
	    then putStrLn "Mishka"
	    else putStrLn "Friendship is magic!^^"

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

process n x	| x==[] = if n>0 then "Mishka" else if n==0 then "Friendship is magic!^^" else "Chris"
     		| otherwise = process n1 (tail x)
	where 	aa= head x
		n1 | aa!!0>aa!!1 = n+1
                   | aa!!0==aa!!1 = n
                   | otherwise = n-1

main = do

	n<-  read <$> getLine ::IO Int
	x<-map(map read) <$> map words <$> lines <$> getContents:: IO [[Int]]
	putStrLn $ process 0  x

--ghc 7.10

winnerStr = ["Chris","Friendship is magic!^^","Mishka"]

result :: (Ord a) => (a,a) -> Int
result (a,b)
    | a < b = 1
    | a > b = -1
    | otherwise = 0

winner :: (Ord a) => [(a,a)] -> String
winner g = (!!) winnerStr . fromEnum . compare 0 . sum .map result $ g

readPair :: (Read a) => String -> (a,a)
readPair str = (a,b)
    where [a,b] = map read . words $ str

main = do
    nStr <- getLine
    gStr <- getContents
    let g = map (readPair) . lines $ gStr :: [(Int,Int)]
    putStrLn $ winner g

import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List
import Data.Maybe

btoi :: B.ByteString -> Int
btoi = fst . fromJust . B.readInt

process_case :: Int -> Int -> [[Int]] -> String
process_case m c []
  | m > c     = "Mishka"
  | m < c     = "Chris"
  | otherwise = "Friendship is magic!^^"
process_case m c ([m', c']:rest)
  | m' > c'   = process_case (m+1) c rest
  | m' < c'   = process_case m (c+1) rest
  | otherwise = process_case m c rest

process :: B.ByteString -> B.ByteString
process str =
  let (sn:rest) = B.lines str
      n         = btoi sn
  in B.pack $ process_case 0 0 (map (map btoi . B.words) $ take n rest)

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

module Main where

import Control.Monad

type Result = (Int, Int)

solve :: [Result] -> String
solve rs | m < c = "Chris"
         | m > c = "Mishka"
         | otherwise = "Friendship is magic!^^"
    where update (m, c) (m', c') | m' < c' = (m, c + 1)
                                 | m' > c' = (m + 1, c)
                                 | otherwise = (m + 1, c + 1)
          (m, c) = foldl update (0, 0) rs

main :: IO ()
main = do
  n <- liftM read getLine
  rs <- replicateM n $ do
          [n, m] <- liftM (map read . words) getLine
          return (n, m)
  putStrLn $ solve rs

import Control.Monad

sol :: [[Int]] -> Int -> Int -> String
sol [] a b = if a > b
  then "Mishka"
  else if b > a
  then "Chris"
  else "Friendship is magic!^^"

sol res a b = if (head (head res)) > (last (head res))
  then (sol (tail res) (a+1) b)
  else (sol (tail res) a (1+b))

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [String]
  let input_i = fmap (map read.words) inputs :: [[Int]]
  putStrLn (sol input_i 0 0)

module Main where

import Data.List
import Data.Function

main = do
  count <- read <$> getLine
  inputs <- sequence $ replicate count getLine

  let (mish, chris) =
        inputs
        & map (map read . words)
        & map (\[x,y] -> compare x (y::Int))
        & filter (/= EQ)
        & partition (== LT)
      mishLen = length mish
      chrisLen = length chris

  print $ if mishLen > chrisLen
            then "Mishka"
            else if mishLen < chrisLen
                  then "Chris"
                  else "Friendship is magic!^^"

module Main where

import Data.List
import Data.Function

main = do
  count <- read <$> getLine
  inputs <- sequence $ replicate count getLine

  let (mishka, chris) = inputs
                        & map (map read . words)
                        & map (\[x,y] -> x - y)
                        & filter (/= 0)
                        & partition (> 0)

  print $ case compare (length mishka) (length chris) of
            GT -> "Mishka"
            LT -> "Chris"
            EQ -> "Friendship is magic!^^"

import Control.Applicative
import Data.List

process   r1 r2 | x==y = "Friendship is magic!^^"
                | x>y = "Mishka"
                | otherwise = "Chris"
  where x = zipWith (\z1 z2 ->z1 >z2) r1 r2
        y = zipWith (\z1 z2 ->z1 >z2) r2 r1

main = do
  n<-read <$> getLine ::IO Int
  [r1,r2]<- transpose <$> map (map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
  putStrLn $ process   r1 r2

import Control.Applicative
import Data.List

process   r1 r2 | x==y = "Friendship is magic!^^"
                | x<y = "Mishka"
                | otherwise = "Chris"
  where x = zipWith (\z1 z2 ->z1 >z2) r1 r2
        y = zipWith (\z1 z2 ->z1 >z2) r2 r1

main = do
  n<-read <$> getLine ::IO Int
  [r1,r2]<- transpose <$> map (map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
  putStrLn $ process   r1 r2

module Main where
  import Data.List
  import Control.Monad

  winnerCounter :: Int -> Int -> (Int, Int) -> (Int, Int)
  winnerCounter x y (a, b)
    | x < y = (a, b + 1)
    | x > y = (a + 1, b)
    | x == y = (a, b)

  winnerCounterLoop :: [(Int, Int)] -> (Int, Int) -> (Int, Int)
  winnerCounterLoop [] result = result
  winnerCounterLoop ((p, q):xs) acc  = winnerCounterLoop xs $ winnerCounter p q acc

  readInt :: String -> Int
  readInt s = read s :: Int

  toTuple :: [Int] -> (Int, Int)
  toTuple [x, y] = (x, y)

  main :: IO ()
  main = do
    n <- getLine >>= return . readInt
    inputs <- replicateM n (getLine >>= return . toTuple . map readInt . words)
    putStrLn $ show $ winnerCounterLoop inputs (0, 0)

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

process n x	| x==[] = if n>0 then "Mishka" else if n==0 then "Friendship is magic!^^" else "Chris"
     		| otherwise = process n1 (tail x)
	where 	aa= head x
		n1 | aa!!0<aa!!1 = n+1
                   | aa!!0==aa!!1 = n
                   | otherwise = n-1

main = do

	n<-  read <$> getLine ::IO Int
	x<-map(map read) <$> map words <$> lines <$> getContents:: IO [[Int]]
	putStrLn $ process 0  x


Let's call an integer array $$$a_1, a_2, \dots, a_n$$$ good if $$$a_i \neq i$$$ for each $$$i$$$.Let $$$F(a)$$$ be the number of pairs $$$(i, j)$$$ ($$$1 \le i < j \le n$$$) such that $$$a_i + a_j = i + j$$$.Let's say that an array $$$a_1, a_2, \dots, a_n$$$ is excellent if:   $$$a$$$ is good;  $$$l \le a_i \le r$$$ for each $$$i$$$;  $$$F(a)$$$ is the maximum possible among all good arrays of size $$$n$$$. Given $$$n$$$, $$$l$$$ and $$$r$$$, calculate the number of excellent arrays modulo $$$10^9 + 7$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases.  The first and only line of each test case contains three integers $$$n$$$, $$$l$$$, and $$$r$$$ ($$$2 \le n \le 2 \cdot 10^5$$$; $$$-10^9 \le l \le 1$$$; $$$n \le r \le 10^9$$$). It's guaranteed that the sum of $$$n$$$ doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print the number of excellent arrays modulo $$$10^9 + 7$$$.

NoteIn the first test case, it can be proven that the maximum $$$F(a)$$$ among all good arrays $$$a$$$ is equal to $$$2$$$. The excellent arrays are:   $$$[2, 1, 2]$$$;  $$$[0, 3, 2]$$$;  $$$[2, 3, 2]$$$;  $$$[3, 0, 1]$$$.

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
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.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             foldl', intersect, isPrefixOf, nub,
                                             sort, sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (for, forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

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

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

readIntegralB8 :: (Integral a) => B8.ByteString -> a
readIntegralB8 = B8.readInteger >>> fst . fromJust >>> fromInteger

newtype Cache = Cache {
    factorialMods :: A.Array Int Int64
}

md :: Int64
md = 1_000_000_007

powMod :: Int64 -> Int64 -> Int64 -> Int64
powMod md _ 0 = 1 `mod` md
powMod md a 1 = a `mod` md
powMod md a n | even n =
    let sqrtResult = powMod md a (n `div` 2)
    in (sqrtResult ^ 2) `mod` md
powMod md a n | odd n =
    let prevPowMod = powMod md a (n - 1)
    in (prevPowMod * a) `mod` md

factorialMod :: Cache -> Int64 -> Int64
factorialMod cache n = factorialMods' A.! fromIntegral n
    where
        factorialMods' :: A.Array Int Int64
        factorialMods' = factorialMods cache

combinationsMod :: Cache -> Int64 -> (Int64, Int64) -> Int64
combinationsMod _ _ (n, _) | n < 0 = 0
combinationsMod _ _ (n, k) | k < 0 = 0
combinationsMod _ _ (n, k) | n < k = 0
combinationsMod cache md (n, k) =
        nFactorial * denomInverse `mod` md
    where
        nFactorial = factorialMod cache n
        kFactorial = factorialMod cache k
        n_kFactorial = factorialMod cache (n - k)

        denomInverse = powMod md (n_kFactorial * kFactorial `mod` md) (md - 2)

buildCache :: Int -> Int64 -> Cache
buildCache maxN md =
        Cache factorialMods'
    where
        factorialMods' = A.listArray (0, maxN) . scanl (\prod e -> prod * fromIntegral e `mod` md) 1 $ [1 .. maxN]

solve :: Cache -> Int -> (Int64, Int64) -> Int64
solve cache n (l, r) = (`mod` md) $
        (trailingK - fromK) * subtaskSolve 1 +
        (sum . map subtaskSolve $ [trailingK .. toK])
    where
        fromK = 1
        trailingK = max fromK . (+ (-10)) $ min (r - fromIntegral n) (1 - l)
        toK = 1 + min (r - 1) (fromIntegral n - l)

        subtaskSolve k =
                subarraySolve (usedMinus, usedPlus)
            where
                usedPlus  = max 0 $ l + k - 1
                usedMinus = max 0 $ fromIntegral n - (r - k)

        subarraySolve (usedMinus, usedPlus) | even n =
                combinationsMod cache md (minusCount + plusCount, plusCount)
            where
                minusCount = fromIntegral n `div` 2 - usedMinus
                plusCount  = fromIntegral n `div` 2 - usedPlus

        subarraySolve (usedMinus, usedPlus) | odd n = (`mod` md) $
                combinationsMod cache md (minusCount + plusCount + 1, plusCount) +
                combinationsMod cache md (minusCount + plusCount + 1, minusCount)
            where
                minusCount = fromIntegral (n `div` 2) - usedMinus
                plusCount  = fromIntegral (n `div` 2) - usedPlus

main :: IO ()
main = do
    tests <- B8.getLine <&> readIntB8
    let cache = buildCache 300_000 md
    replicateM_ tests $ do
        [n, l, r] :: [Int64] <- B8.getLine <&> map readIntegralB8 . B8.words

        let answer = solve cache (fromIntegral n) (l, r)

        printf "%lld\n" answer

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Monad
import Data.Int
import Data.Array

p :: Int64
p = 10^9 + 7

newtype Mod = Mod { rsdu :: Int64 }
  deriving (Enum, Eq)

instance Num Mod where
  (Mod a) + (Mod b) = Mod $ if c < p then c else c - p
    where c = a + b
  (Mod a) * (Mod b) = Mod $ c `mod` p
    where c = a * b
  abs = id
  signum (Mod a) = Mod $ if a /= 0 then 1 else 0
  fromInteger a = Mod $ fromInteger $ a `mod` toInteger p
  negate (Mod a) = Mod $ if a /= 0 then p - a else 0

invmod a = a ^ (p-2)

fact :: Int -> Mod
fact = (a !)
  where
    a = listArray (0, maxn) $ scanl (*) 1 [1 .. fromIntegral maxn]
    maxn = 2 * 10^5 + 5

ifact = invmod . fact

n `choose` k
  | k < 0 || n-k < 0 = 0
  | otherwise = fact n * ifact k * ifact (n-k)

cs n
  | odd n = offset [0, 1]
  | otherwise = offset [0]
  where offset = map (+ n `div` 2)

solve n l r c = fromIntegral k' * calc 0 0 + sum (takeWhile (/= 0) $ zipWith calc lo ro)
  where
    k' = min (1-l) (r-n)
    ks = [k'+1..]

    lo = map (max 0 . subtract (1-l)) ks
    ro = map (max 0 . subtract (r-n)) ks

    calc lo ro = (n - lo - ro) `choose` (c - lo)

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [n, l, r] <- map read . words <$> getLine
    print $ rsdu $ sum $ map (solve n l r) $ cs n

import Control.Monad ( replicateM_ )
import Data.Array.IArray ( (!), amap, listArray, Array )
import Data.Int ( Int64 )

m :: Int64
m = 1000000007

newtype MInt = MInt Int64 deriving Show

toInt64 :: MInt -> Int64
toInt64 (MInt a) = a

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

inv :: MInt -> MInt
inv a = a ^ (m - 2)

choose :: Int -> Int -> MInt
choose = c where
    c n k | k < 0 || k > n = 0
          | otherwise      = (fac!n) * (ifac!k) * (ifac!(n - k))
    fac' = 1 : zipWith ((*) . fromIntegral) [1..] fac'
    fac = listArray (0, 2 * 10^5) fac' :: Array Int MInt
    ifac = amap inv fac

solve :: IO ()
solve = do
    [n, l, r] <- readMany :: IO [Int]
    let h = n `div` 2
        p = min (1 - l) (r - n)
        ans1 = choose n h * (if odd n then 2 else 1) * fromIntegral p
        calc k = if rem < 0 then 0 else c where
            c = choose rem (h - fl) + if odd n then choose rem (h - fl + 1) else 0
            fl = max 0 $ k - 1 + l
            fr = max 0 $ k - r + n
            rem = n - fl - fr
        ans2 = sum $ map calc [p + 1 .. p + n]
    print $ toInt64 $ ans1 + ans2

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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


DZY loves Fast Fourier Transformation, and he enjoys using it.Fast Fourier Transformation is an algorithm used to calculate convolution. Specifically, if a, b and c are sequences with length n, which are indexed from 0 to n - 1, andWe can calculate c fast using Fast Fourier Transformation.DZY made a little change on this formula. NowTo make things easier, a is a permutation of integers from 1 to n, and b is a sequence only containing 0 and 1. Given a and b, DZY needs your help to calculate c.Because he is naughty, DZY provides a special way to get a and b. What you need is only three integers n, d, x. After getting them, use the code below to generate a and b.//x is 64-bit variable;function getNextX() {    x = (x * 37 + 10007) % 1000000007;    return x;}function initAB() {    for(i = 0; i < n; i = i + 1){        a[i] = i + 1;    }    for(i = 0; i < n; i = i + 1){        swap(a[i], a[getNextX() % (i + 1)]);    }    for(i = 0; i < n; i = i + 1){        if (i < d)            b[i] = 1;        else            b[i] = 0;    }    for(i = 0; i < n; i = i + 1){        swap(b[i], b[getNextX() % (i + 1)]);    }}Operation x % y denotes remainder after division x by y. Function swap(x, y) swaps two values x and y.

The only line of input contains three space-separated integers n, d, x (1 ≤ d ≤ n ≤ 100000; 0 ≤ x ≤ 1000000006). Because DZY is naughty, x can't be equal to 27777500.

Output n lines, the i-th line should contain an integer ci - 1.

NoteIn the first sample, a is [1 3 2], b is [1 0 0], so c0 = max(1·1) = 1, c1 = max(1·0, 3·1) = 3, c2 = max(1·0, 3·0, 2·1) = 2.In the second sample, a is [2 1 4 5 3], b is [1 1 1 0 1].In the third sample, a is [5 2 1 4 3], b is [1 1 1 1 0].

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List hiding (find, insert)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
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
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
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 #-}

unsafeSwap :: (MArray a e m, Ix i) => a i e -> Int -> Int -> m ()
unsafeSwap arr i j = do
        ai <- unsafeRead arr i
        aj <- unsafeRead arr j
        unsafeWrite arr i aj
        unsafeWrite arr j ai
{-# INLINE unsafeSwap #-}

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

initAB :: Int -> Int -> Int -> (UArray Int Int, UArray Int Bool)
initAB n d x = runST $ do
  xref <- newSTRef (fromIntegral x) :: ST s (STRef s Int64)
  let getNextX = do
        x <- readSTRef xref
        let !newX = (x * 37 + 10007) `rem` 1000000007
        writeSTRef xref newX
        return $! (fromIntegral newX :: Int)

  arrA <- newListArray (0,n-1) [1..n] :: ST s (STUArray s Int Int)
  rep n $ \i -> do
    !j <- (`rem` (i+1)) <$> getNextX
    unsafeSwap arrA i j

  arrB <- newListArray (0,n-1) (replicate d True ++ repeat False) :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    !j <- (`rem` (i+1)) <$> getNextX
    unsafeSwap arrB i j

  (,) <$> unsafeFreeze arrA <*> unsafeFreeze arrB

solve :: [Int] -> [Int]
solve [n,d,x]
  | d < 500 = solveDsmall n d arrA arrB
  | otherwise = solveDlarge n d arrA arrB
   where
     (arrA, arrB) = initAB n d x

solveDsmall :: Int -> Int -> UArray Int Int -> UArray Int Bool -> [Int]
solveDsmall n d arrA arrB = map c [0..n-1]
   where
     !ids = filter (unsafeAt arrB) [0..n-1]
     c i = foldl' max 0 . map (\j->unsafeAt arrA $ i-j) $takeWhile (<=i) ids

solveDlarge :: Int -> Int -> UArray Int Int -> UArray Int Bool -> [Int]
solveDlarge n d arrA arrB = map c [0..n-1]
   where
     invA :: UArray Int Int
     !invA = unsafeArray (0,n) $ (0,n) : [(unsafeAt arrA i, i)|i<-[0..n-1]]
     c i = go n
      where
        go !aj
          | ij >= 0 && unsafeAt arrB ij = aj
          | aj > 0 = go (aj - 1)
          | otherwise = 0
           where
             !ij = i - unsafeAt invA aj

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List hiding (find, insert)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
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
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
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 #-}

unsafeSwap :: (MArray a e m, Ix i) => a i e -> Int -> Int -> m ()
unsafeSwap arr i j = do
        ai <- unsafeRead arr i
        aj <- unsafeRead arr j
        unsafeWrite arr i aj
        unsafeWrite arr j ai
{-# INLINE unsafeSwap #-}

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

initAB :: Int -> Int -> Int -> (UArray Int Int, UArray Int Bool)
initAB n d x = runST $ do
  xref <- newSTRef (fromIntegral x) :: ST s (STRef s Int64)
  let getNextX = do
        x <- readSTRef xref
        let !newX = (x * 37 + 10007) `rem` 1000000007
        writeSTRef xref newX
        return $! (fromIntegral newX :: Int)

  arrA <- newListArray (0,n-1) [1..n] :: ST s (STUArray s Int Int)
  rep n $ \i -> do
    !j <- (`rem` (i+1)) <$> getNextX
    unsafeSwap arrA i j

  arrB <- newListArray (0,n-1) (replicate d True ++ repeat False) :: ST s (STUArray s Int Bool)
  rep n $ \i -> do
    !j <- (`rem` (i+1)) <$> getNextX
    unsafeSwap arrB i j

  (,) <$> unsafeFreeze arrA <*> unsafeFreeze arrB

solve :: [Int] -> [Int]
solve [n,d,x]
  | d < 500 = solveDsmall n d arrA arrB
  | otherwise = solveDlarge n d arrA arrB
   where
     (arrA, arrB) = initAB n d x

solveDsmall :: Int -> Int -> UArray Int Int -> UArray Int Bool -> [Int]
solveDsmall n d arrA arrB = map c [0..n-1]
   where
     !ids = filter (unsafeAt arrB) [0..n-1]
     c i = foldl' max 0 . map (\j->unsafeAt arrA $ i-j) $takeWhile (<=i) ids

solveDlarge :: Int -> Int -> UArray Int Int -> UArray Int Bool -> [Int]
solveDlarge n d arrA arrB = map c [0..n-1]
   where
     invA :: UArray Int Int
     !invA = unsafeArray (0,n) $ (0,n) : [(unsafeAt arrA i, i)|i<-[0..n-1]]
     c i = go n
      where
        go !aj
          | ij >= 0 && unsafeAt arrB ij = aj
          | otherwise = go (aj - 1)
           where
             !ij = i - unsafeAt invA aj


You are given some Tetris field consisting of $$$n$$$ columns. The initial height of the $$$i$$$-th column of the field is $$$a_i$$$ blocks. On top of these columns you can place only figures of size $$$2 \times 1$$$ (i.e. the height of this figure is $$$2$$$ blocks and the width of this figure is $$$1$$$ block). Note that you cannot rotate these figures.Your task is to say if you can clear the whole field by placing such figures.More formally, the problem can be described like this:The following process occurs while at least one $$$a_i$$$ is greater than $$$0$$$:  You place one figure $$$2 \times 1$$$ (choose some $$$i$$$ from $$$1$$$ to $$$n$$$ and replace $$$a_i$$$ with $$$a_i + 2$$$);  then, while all $$$a_i$$$ are greater than zero, replace each $$$a_i$$$ with $$$a_i - 1$$$. And your task is to determine if it is possible to clear the whole field (i.e. finish the described process), choosing the places for new figures properly.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The next $$$2t$$$ lines describe test cases. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of columns in the Tetris field. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$), where $$$a_i$$$ is the initial height of the $$$i$$$-th column of the Tetris field.

For each test case, print the answer — "YES" (without quotes) if you can clear the whole Tetris field and "NO" otherwise.

NoteThe first test case of the example field is shown below:Gray lines are bounds of the Tetris field. Note that the field has no upper bound.One of the correct answers is to first place the figure in the first column. Then after the second step of the process, the field becomes $$$[2, 0, 2]$$$. Then place the figure in the second column and after the second step of the process, the field becomes $$$[0, 0, 0]$$$.And the second test case of the example field is shown below:It can be shown that you cannot do anything to end the process.In the third test case of the example, you first place the figure in the second column after the second step of the process, the field becomes $$$[0, 2]$$$. Then place the figure in the first column and after the second step of the process, the field becomes $$$[0, 0]$$$.In the fourth test case of the example, place the figure in the first column, then the field becomes $$$[102]$$$ after the first step of the process, and then the field becomes $$$[0]$$$ after the second step of the process.

import Control.Monad
import Data.List
main = readLn >>= (`replicateM` solve)
solve = do
  getLine
  a <- map read.words <$> getLine
  putStrLn $ if (==1).length.group.map(`mod`2) $ a then "YES" else "NO"

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

main = getLine >>= test.read
test 0 = return ()
test i = do
  getLine
  as <- map read.words <$> getLine
  putStrLn $ if all ((== odd (head as)).odd) as then "YES" else "NO"
  test (i - 1)

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        getLine
        xs <- map ((`mod` 2) . read) . words <$> getLine
        if allEqual xs then
            putStrLn "YES"
        else
            putStrLn "NO"

allEqual [] = True
allEqual [x] = True
allEqual (x:y:zs) = x == y && allEqual (y:zs)

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

onecase = do
		getLine
		d<-map read <$> words <$> getLine ::IO [Integer]
		putStrLn $ if all even d || all odd d then "YES" else "NO"

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

import Control.Monad

solve [] = return ()
solve (ts:tss) = do
  putStrLn res
  solve tss
  where
    res
      | anye && anyo = "NO"
      | otherwise = "YES"
    anye = any even ts
    anyo = any odd ts

main = do
  t <- readLn :: IO Int
  tss <- replicateM t $ do
    getLine
    xs <- map read  . words <$> getLine :: IO [Int]
    return xs
  solve tss

process :: [Int] -> Bool
process xs@(x:_) = and.map even.map (subtract x) $ xs

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    as <- fmap (map readInt.words) getLine
    if process as
        then putStrLn "YES"
        else putStrLn "NO"
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

main :: IO ()

main = interact (format' . solve . format)

solve :: [[Int]] -> [String]
solve = map solver

format' = unlines

solver :: [Int] -> String
solver xs
    | all odd xs    = "YES"
    | all even xs   = "YES"
    | otherwise         = "NO"

format :: String -> [[Int]]
format xs = map (map read . words . snd) . filter (odd . fst) . (zip [0..]) . tail . lines $ xs

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
{-# LANGUAGE MultiWayIf #-}
main = getLine >>= test.read
test 0 = return ()
test i = do
  n <- read <$> getLine
  as <- map read.words <$> getLine
  putStrLn $ if
    | odd n || even (sum as) -> "YES"
    | otherwise -> "NO"
  test (i - 1)

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

onecase = do
		getLine
		d<-map read <$> words <$> getLine ::IO [Integer]
		putStr $ if all even d || all odd d then "YES" else "NO"

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

import Control.Monad

solve [] = return ()
solve (ts:tss) = do
  putStrLn res
  solve tss
  where
    res
      | even (maximum ts - minimum ts) = "YES"
      | otherwise = "NO"

main = do
  t <- readLn :: IO Int
  tss <- replicateM t $ do
    getLine
    xs <- map read  . words <$> getLine :: IO [Int]
    return xs
  solve tss


There are n kangaroos with pockets. Each kangaroo has a size (integer number). A kangaroo can go into another kangaroo's pocket if and only if the size of kangaroo who hold the kangaroo is at least twice as large as the size of kangaroo who is held.Each kangaroo can hold at most one kangaroo, and the kangaroo who is held by another kangaroo cannot hold any kangaroos.The kangaroo who is held by another kangaroo cannot be visible from outside. Please, find a plan of holding kangaroos with the minimal number of kangaroos who is visible.

The first line contains a single integer — n (1 ≤ n ≤ 5·105). Each of the next n lines contains an integer si — the size of the i-th kangaroo (1 ≤ si ≤ 105).

Output a single integer — the optimal number of visible kangaroos.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.List
import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.MArray

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

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'

-- rsort = sortBy (flip compare)

median3 :: Ord a => a -> a -> a -> Int -> Int -> Int -> Int
median3 a b c ka kb kc = if a <= b then go a b ka kb else go b a kb ka
  where go a b ka kb
          | c <= a    = ka
          | c <= b    = kc
          | otherwise = kb

divide :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> m Int
divide a lo hi = do
  let lscan p h i
          | i < h = do
              v <- readArray a i
              if p < v then return i else lscan p h (i+1)
          | otherwise = return i
      rscan p l i
          | l < i = do
              v <- readArray a i
              if v < p then return i else rscan p l (i-1)
          | otherwise = return i
      swap i j = do
          v <- readArray a i
          readArray a j >>= writeArray a i
          writeArray a j v
      sloop p l h
          | l < h = do
              l1 <- lscan p h l
              h1 <- rscan p l1 h
              if (l1 < h1) then (swap l1 h1 >> sloop p l1 h1) else return l1
  let mid = (lo+hi) `div` 2
  piv1 <- readArray a hi
  piv2 <- readArray a lo
  piv3 <- readArray a mid
  let kpiv = median3 piv1 piv2 piv3 hi lo mid
  if kpiv /= hi
    then swap kpiv hi
    else return ()
  piv <- readArray a hi
  i <- sloop piv lo hi
  swap i hi
  return i

qsort :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> m ()
qsort arr lo hi
  | lo < hi = do mid <- divide arr lo hi
                 qsort arr lo (mid-1)
                 qsort arr (mid+1) hi
  | otherwise = return ()

qsortRange :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> Int -> Int -> m ()
qsortRange arr lo hi a b
  | a > b = return ()
  | lo+1 >= hi = do -- sort lo and lo+1
                    x <- readArray arr lo
                    y <- readArray arr (lo+1)
                    if x > y then do writeArray arr lo y
                                     writeArray arr (lo+1) x
                             else return ()
  | otherwise = do mid <- divide arr lo hi
                   if | mid <= a  -> qsortRange arr (mid+1) hi (max (mid+1) a) b
                      | b <= mid  -> qsortRange arr lo (mid-1) a (min b (mid-1))
                      | otherwise -> do qsortRange arr lo (mid-1) a (mid-1)
                                        qsortRange arr (mid+1) hi (mid+1) b

main = do
  n <- fmap read getLine
  arr' <- newArray (1,n) 0 :: IO (IOUArray Int Int)
  let go i | i > n = return ()
      go i = do v <- readInt; writeArray arr' i v; go (i+1)
  go 1
  qsort arr' 1 n
  arr <- freeze arr' :: IO (UArray Int Int)

  let lasti = div n 2
  let loop !c i j
        | i > lasti = c
        | j > n     = c
        | otherwise = if 2*(arr!i) <= arr!j
                         then loop (c+1) (i+1) (j+1)
                         else loop c i (j+1)
  let  pocketed = loop 0 1 (lasti+1)
  let answer = n - pocketed
  print answer

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}

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

main = do
  n <- fmap read getLine
  xs <- fmap sort $ replicateM n $ fmap read getLine
  let xarr = listArray (1,n) xs :: UArray Int Int

  let adv x j | j > n = Nothing
              | (xarr!j) >= x = Just j
              | otherwise = adv x (j+1)
      loop c i j = do
        if | j > n                  ->  c
           | (xarr!j) >= 2*(xarr!i) -> loop (c+1) (i+1) (j+1)
           | otherwise              -> case adv (2*(xarr!i)) j of
                                         Nothing -> c
                                         Just j' -> loop (c+1) (i+1) (j'+1)
  let pocketed = loop 0 1 2
  let answer = n - pocketed
  print answer

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MultiWayIf #-}

import Control.Monad
import Data.List
import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.MArray

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

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'

-- rsort = sortBy (flip compare)

median3 :: Ord a => a -> a -> a -> Int -> Int -> Int -> Int
median3 a b c ka kb kc = if a <= b then go a b ka kb else go b a kb ka
  where go a b ka kb
          | c <= a    = ka
          | c <= b    = kc
          | otherwise = kb

divide :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> m Int
divide a lo hi = do
  let lscan p h i
          | i < h = do
              v <- readArray a i
              if p < v then return i else lscan p h (i+1)
          | otherwise = return i
      rscan p l i
          | l < i = do
              v <- readArray a i
              if v < p then return i else rscan p l (i-1)
          | otherwise = return i
      swap i j = do
          v <- readArray a i
          readArray a j >>= writeArray a i
          writeArray a j v
      sloop p l h
          | l < h = do
              l1 <- lscan p h l
              h1 <- rscan p l1 h
              if (l1 < h1) then (swap l1 h1 >> sloop p l1 h1) else return l1
  let mid = (lo+hi) `div` 2
  piv1 <- readArray a hi
  piv2 <- readArray a lo
  piv3 <- readArray a mid
  let kpiv = median3 piv1 piv2 piv3 hi lo mid
  if kpiv /= hi
    then swap kpiv hi
    else return ()
  piv <- readArray a hi
  i <- sloop piv lo hi
  swap i hi
  return i

qsort :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> m ()
qsort arr lo hi
  | lo < hi = do mid <- divide arr lo hi
                 qsort arr lo (mid-1)
                 qsort arr (mid+1) hi
  | otherwise = return ()

qsortRange :: (Ord t, MArray a t m) => a Int t -> Int -> Int -> Int -> Int -> m ()
qsortRange arr lo hi a b
  | a > b = return ()
  | lo+1 >= hi = do -- sort lo and lo+1
                    x <- readArray arr lo
                    y <- readArray arr (lo+1)
                    if x > y then do writeArray arr lo y
                                     writeArray arr (lo+1) x
                             else return ()
  | otherwise = do mid <- divide arr lo hi
                   if | mid <= a  -> qsortRange arr (mid+1) hi (max (mid+1) a) b
                      | b <= mid  -> qsortRange arr lo (mid-1) a (min b (mid-1))
                      | otherwise -> do qsortRange arr lo (mid-1) a (mid-1)
                                        qsortRange arr (mid+1) hi (mid+1) b

main = do
  n <- fmap read getLine
  arr' <- newArray (1,n) 0 :: IO (IOUArray Int Int)
  let go i | i > n = return ()
      go i = do v <- readInt; writeArray arr' i v; go (i+1)

  arr <- freeze arr' :: IO (UArray Int Int)

  let lasti = div n 2
  let loop !c i j
        | i > lasti = c
        | j > n     = c
        | otherwise = if 2*(arr!i) <= arr!j
                         then loop (c+1) (i+1) (j+1)
                         else loop c i (j+1)
  let pocketed = loop 0 1 (lasti+1)
  let answer = n - pocketed
  print answer


The Berland language consists of words having exactly two letters. Moreover, the first letter of a word is different from the second letter. Any combination of two different Berland letters (which, by the way, are the same as the lowercase letters of Latin alphabet) is a correct word in Berland language.The Berland dictionary contains all words of this language. The words are listed in a way they are usually ordered in dictionaries. Formally, word $$$a$$$ comes earlier than word $$$b$$$ in the dictionary if one of the following conditions hold:  the first letter of $$$a$$$ is less than the first letter of $$$b$$$;  the first letters of $$$a$$$ and $$$b$$$ are the same, and the second letter of $$$a$$$ is less than the second letter of $$$b$$$. So, the dictionary looks like that:  Word $$$1$$$: ab  Word $$$2$$$: ac  ...  Word $$$25$$$: az  Word $$$26$$$: ba  Word $$$27$$$: bc  ...  Word $$$649$$$: zx  Word $$$650$$$: zy You are given a word $$$s$$$ from the Berland language. Your task is to find its index in the dictionary.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 650$$$) — the number of test cases. Each test case consists of one line containing $$$s$$$ — a string consisting of exactly two different lowercase Latin letters (i. e. a correct word of the Berland language).

For each test case, print one integer — the index of the word $$$s$$$ in the dictionary.

import Data.Char (ord)

solve :: IO ()
solve = map ((\c -> c - ord 'a') . ord) <$> getLine >>= \ [a, b] ->
    print $ a * 25 + if b < a then b + 1 else b

main :: IO ()
main =
    let f 0 = return ()
        f t = solve >> f (t - 1)
    in readInt <$> getLine >>= f

readInt :: String -> Int
readInt = read

import Control.Monad
import Data.Char
import Data.List

encodeChar x = ord x - ord 'a'

solve (x:y:z) = encodeChar x * 25 + encodeChar y + 1 - if x < y then 1 else 0

main = do
  t <- readInt
  lines <- replicateM t getLine
  putStrLn $ intercalate "\n" (map (\x -> show $ solve x) lines)

-- Just IO
readInt = do
  line <- getLine
  return (read line :: Int)


Vasya takes part in the orienteering competition. There are n checkpoints located along the line at coordinates x1, x2, ..., xn. Vasya starts at the point with coordinate a. His goal is to visit at least n - 1 checkpoint in order to finish the competition. Participant are allowed to visit checkpoints in arbitrary order.Vasya wants to pick such checkpoints and the order of visiting them that the total distance travelled is minimized. He asks you to calculate this minimum possible value.

The first line of the input contains two integers n and a (1 ≤ n ≤ 100 000,  - 1 000 000 ≤ a ≤ 1 000 000) — the number of checkpoints and Vasya's starting position respectively. The second line contains n integers x1, x2, ..., xn ( - 1 000 000 ≤ xi ≤ 1 000 000) — coordinates of the checkpoints.

Print one integer — the minimum distance Vasya has to travel in order to visit at least n - 1 checkpoint.

NoteIn the first sample Vasya has to visit at least two checkpoints. The optimal way to achieve this is the walk to the third checkpoints (distance is 12 - 10 = 2) and then proceed to the second one (distance is 12 - 7 = 5). The total distance is equal to 2 + 5 = 7.In the second sample it's enough to visit only one checkpoint so Vasya should just walk to the point  - 10.

import Data.List

main :: IO ()

main = do
	firstVals <- fmap (map read . words) getLine :: IO [Int]
	controlPoints <- fmap (map read . words) getLine :: IO [Int]
	print (calcAllButOne (sort controlPoints) (firstVals !! 1))

calcAll :: (Integral a) => [a] -> a -> a
calcAll [] stpoint = 0
calcAll points stpoint
	| stpoint < firstelem = lastelem - stpoint
	| stpoint > lastelem = stpoint - firstelem
	| otherwise = min (stpoint - firstelem) (lastelem - stpoint) + lastelem - firstelem
	where 	firstelem = head points
		lastelem = last points

calcAllButOne :: (Integral a) => [a] -> a -> a
calcAllButOne [] stpoint = 0
calcAllButOne points stpoint = min (calcAll (tail points) stpoint) (calcAll (init points) stpoint)

-- quicksort works
--quicksort :: (Ord a) => [a] -> [a]
--quicksort [] = []
--quicksort (x:xs) =
--	let smallerSorted = quicksort [a | a <- xs, a <= x]
--	    biggerSorted = quicksort [a | a <- xs, a > x]
--	in smallerSorted ++ [x] ++ biggerSorted

import Data.List

import Numeric

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

main = interact $ show.f.parse.words
parse = map fastRead

g [] cur ans = ans
g (x:xs) cur ans = g xs x (ans + (abs (cur-x)))

f (cnt:x:xs) = minimum [(g (aa++ba) x 0),
                        (g (ca++da) x 0),
                        (g (ab++bb) x 0),
                        (g (cb++db) x 0)]
  where y = (sort xs)
        i = init y
        j = tail y

        aa = (reverse (filter (<=x) i))
        ba = (filter (>x) i)
        ca = (reverse (filter (<=x) j))
        da = (filter (>x) j)

        ab = (filter (>=x) i)
        bb = (reverse (filter (<x) i))
        cb = (filter (>=x) j)
        db = (reverse (filter (<x) j))

import Data.List

dist :: Int -> Int -> Int
dist x y = abs $ x - y

process' :: Int -> [Int] -> Int
process' a [_] = 0
process' a x =
  let (fst: snd: _) = x
      (ufst:usnd:_) = reverse x
  in minimum
      [
        dist a fst  + dist fst  usnd,
        dist a snd  + dist snd  ufst,
        dist a ufst + dist ufst snd,
        dist a usnd + dist usnd fst
      ]

process :: String -> String
process str =
  let [header, body] = lines str
      [n, a]         = map read . words $ header
      x              = sort . map read . take n . words  $ body
  in show $ process' a x

main :: IO ()
main = interact process

main :: IO ()

main = do
        firstVals <- fmap (map read . words) getLine :: IO [Int]
        controlPoints <- fmap (map read . words) getLine :: IO [Int]
        print (calcAllButOne (quicksort controlPoints) (firstVals !! 1))

walkleft :: (Integral a) => [a] -> a -> a
walkleft [] stpoint = 0
walkleft (firstElem: points) stpoint
        | firstElem < stpoint = stpoint - firstElem
        | firstElem >= stpoint = 0

walkright :: (Integral a) => [a] -> a -> a
walkright [] stpoint = 0
walkright points stpoint
        | lastElem > stpoint = lastElem - stpoint
        | lastElem <= stpoint = 0
        where lastElem = last points

calcAllButOne :: (Integral a) => [a] -> a -> a
calcAllButOne [] stpoint = 0
calcAllButOne points stpoint
        | leftFull == 0 = rightm1
        | rightFull == 0 = leftm1
        | leftm1 == 0 || rightm1 == 0 = min
                                        (min (2 * leftFull + rightm1) rightFull)
                                        (min (2 * rightFull + leftm1) leftFull)
        | otherwise = min (2 * leftFull + rightm1) (2 * rightFull + leftm1)
        where leftFull = walkleft points stpoint
              rightFull = walkright points stpoint
              leftm1 = walkleft (tail points) stpoint
              rightm1 = walkright (init points) stpoint

-- quicksort works
quicksort :: (Ord a) => [a] -> [a]
quicksort [] = []
quicksort (x:xs) =
        let smallerSorted = quicksort [a | a <- xs, a <= x]
            biggerSorted = quicksort [a | a <- xs, a > x]
        in smallerSorted ++ [x] ++ biggerSorted

import Data.List

import Numeric

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

main = interact $ show.f.parse.words
parse = map fastRead

g [] cur ans = ans
g (x:xs) cur ans = g xs x (ans + (abs (cur-x)))

f (cnt:x:xs) = minimum [(g (aa++ba) x 0),
                        (g (ca++da) x 0),
                        (g (ab++bb) x 0),
                        (g (cb++db) x 0)]
  where y = (sort xs)
        i = init y
        j = tail y

        aa = (reverse (filter (<=x) i))
        ba = (filter (>x) i)
        ca = (reverse (filter (<=x) j))
        da = (filter (>x) j)

        ab = (reverse (filter (>=x) i))
        bb = (filter (<x) i)
        cb = (reverse (filter (>=x) j))
        db = (filter (<x) j)

import Data.List

import Numeric

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

main = interact $ show.f.parse.words
parse = map fastRead

g i j cur ans 0 = ans
g [] (y:ys) cur ans cnt = g [] ys y (ans + (abs (cur-y))) (cnt-1)
g (x:xs) [] cur ans cnt = g xs [] x (ans + (abs (cur-x))) (cnt-1)
g i@(x:xs) j@(y:ys) cur ans cnt
  | (abs (cur-x)) <= (abs (cur-y)) = g xs j x (ans + (abs (cur-x))) (cnt-1)
  | otherwise = g i ys y (ans + (abs (cur-y))) (cnt-1)

f (cnt:x:xs) = g (reverse (filter (<=x) y)) (filter (>x) y) x 0 (cnt-1)
  where y = (sort xs)


You are given an array $$$a$$$ of $$$2n$$$ distinct integers. You want to arrange the elements of the array in a circle such that no element is equal to the the arithmetic mean of its $$$2$$$ neighbours.More formally, find an array $$$b$$$, such that: $$$b$$$ is a permutation of $$$a$$$.For every $$$i$$$ from $$$1$$$ to $$$2n$$$, $$$b_i \neq \frac{b_{i-1}+b_{i+1}}{2}$$$, where $$$b_0 = b_{2n}$$$ and $$$b_{2n+1} = b_1$$$. It can be proved that under the constraints of this problem, such array $$$b$$$ always exists.

The first line of input contains a single integer $$$t$$$ $$$(1 \leq t \leq 1000)$$$ — the number of testcases. The description of testcases follows. The first line of each testcase contains a single integer $$$n$$$ $$$(1 \leq n \leq 25)$$$. The second line of each testcase contains $$$2n$$$ integers $$$a_1, a_2, \ldots, a_{2n}$$$ $$$(1 \leq a_i \leq 10^9)$$$ — elements of the array. Note that there is no limit to the sum of $$$n$$$ over all testcases.

For each testcase, you should output $$$2n$$$ integers, $$$b_1, b_2, \ldots b_{2n}$$$, for which the conditions from the statement are satisfied.

{-# LANGUAGE ViewPatterns #-}

import Data.List ( sort )
import Control.Monad ( replicateM_ )

solve :: Int -> [Int] -> [Int]
solve n (sort -> nums)
    = take n nums `zip` drop n nums >>= \(a, b) -> [a, b]

getInt = read <$> getLine
getInts = map read . words <$> getLine
putInts = putStrLn . unwords . map show

main = do n <- getInt
          replicateM_ n (solve <$> getInt <*> getInts >>= putInts)

import Data.List ( sort, transpose )
import Control.Monad ( replicateM_ )

solve :: Int -> [Int] -> [Int]
solve n ints = concat (transpose [take n nums, drop n nums]) where
    nums = sort ints

getInt = read <$> getLine
getInts = map read . words <$> getLine
putInts = putStrLn . unwords . map show
main = do
    n <- getInt
    replicateM_ n (solve <$> getInt <*> getInts >>= putInts)

import Data.List ( sort )
import Control.Monad ( replicateM_ )

solve :: Int -> [Int] -> [Int]
solve n ints = concat $ zipWith (++) rotated nums where
    nums = pure <$> sort ints
    rotated = drop n nums

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
    n <- getInt
    replicateM_ n (solve <$> getInt <*> getInts >>= putStrLn . unwords . map show)

{-# LANGUAGE ViewPatterns #-}

import Data.List ( sort )

solve :: Int -> [Int] -> [Int]
solve n ints = concat $ zipWith (++) rotated nums where
    nums = pure <$> sort ints
    rotated = drop n nums

main = interact $ unlines . loop . tail . lines where
    loop ((read -> n) : (map read . words -> nums) : rest)
           = unwords (map show $ solve n nums) : loop rest
    loop _ = mempty

{-# LANGUAGE ViewPatterns #-}

import Data.List ( sort )

solve :: [Int] -> [Int]
solve ints = take n $ concat $ zipWith (\a b -> [a, b]) rotated nums where
    rotated = drop (n `div` 2) nums
    n = length ints
    nums = sort ints

main = interact $ unlines . map (unwords . map show) . loop . tail . lines where
    loop (_ : (map read . words -> nums) : rest) = solve nums : loop rest
    loop _ = []

import Data.List (transpose, sort)

odds (x:xs) = x : evens xs
odds [] = []

evens (_:xs) = odds xs
evens [] = []

split a = [take l a, drop l a]
  where l = length a `div` 2

solve :: [Int] -> [Int]
solve = concat . transpose . split . sort

solveLine =
  unwords . map show . solve . map read . words

main = interact $ unlines . map solveLine . evens . tail . lines

import Data.List
import Control.Monad

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

print1 [] [] = ""
print1 (x:xs) (y:ys) = (show x)++" "++(show y)++" " ++ print1 xs ys

main = do
  entry <- getLine
  let timer = read entry :: Int
  forM_ [1..timer] $ \_ -> do
    n <- readLn :: IO Int
    array <- readInts
    let sorted = sort array
        b = take n sorted
        c = take n $ reverse sorted
    let ans = print1 b c
    putStrLn(ans)

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

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

print1 [] [] = ""
print1 (x:xs) (y:ys) = (show x)++" "++(show y)++" " ++ print1 xs ys

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let sorted = sort a
        b = take n sorted
        c = reverse $ drop n sorted
    putStrLn $ print1 b c

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

import Control.Monad
import Data.List (sort)

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- sort . map read . words <$> getLine :: IO [Int]
        putStrLn $ unwords $ [0 .. n - 1] >>= \x -> show . (a !!) <$> [x, x + n]

import Control.Monad
import Data.List
main = do
    t <- (read <$> getLine) :: IO Int
    --putStrLn $ show t

    replicateM_ t $ do
        n <- (read <$> getLine) :: IO Int
        xs <- (sort . map read . words <$> getLine) :: IO [Int]
        let ys = reverse xs
        forM_ (take n $ zip xs ys) $ (\(x, y) -> putStr $ show x ++ " " ++ show y ++ " ")
        putStrLn ""
       -- putStrLn $ show xs

import Control.Monad
import Data.Maybe
import Data.List
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
    [n] <- getInts
    as <- getInts
    let (xs, ys) = splitAt n $ sort as
        str = mconcat $ intersperse (charUtf8 ' ') $ map intDec $ concatMap (\(x, y) -> [x, y]) $ zip xs ys
    return $ str `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Data.List ( sort, transpose )
import Control.Monad ( replicateM_ )

solve :: Int -> [Int] -> [Int]
solve n ints = concat (transpose [nums, rotated]) where
    nums = sort ints
    rotated = drop n nums

getInt = read <$> getLine
getInts = map read . words <$> getLine
putInts = putStrLn . unwords . map show
main = do
    n <- getInt
    replicateM_ n (solve <$> getInt <*> getInts >>= putInts)

import Data.List (transpose)

odds (x:xs) = x : evens xs
odds [] = []

evens (_:xs) = odds xs
evens [] = []

split a = [take l a, drop l a]
  where l = length a `div` 2

solve :: [Int] -> [Int]
solve = concat . transpose . split

solveLine =
  unwords . map show . solve . map read . words

main = interact $ unlines . map solveLine . evens . tail . lines


You have three piles of candies: red, green and blue candies:  the first pile contains only red candies and there are $$$r$$$ candies in it,  the second pile contains only green candies and there are $$$g$$$ candies in it,  the third pile contains only blue candies and there are $$$b$$$ candies in it. Each day Tanya eats exactly two candies of different colors. She is free to choose the colors of eaten candies: the only restriction that she can't eat two candies of the same color in a day.Find the maximal number of days Tanya can eat candies? Each day she needs to eat exactly two candies.

The first line contains integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case is given as a separate line of the input. It contains three integers $$$r$$$, $$$g$$$ and $$$b$$$ ($$$1 \le r, g, b \le 10^8$$$) — the number of red, green and blue candies, respectively.

Print $$$t$$$ integers: the $$$i$$$-th printed integer is the answer on the $$$i$$$-th test case in the input.

NoteIn the first example, Tanya can eat candies for one day only. She can eat any pair of candies this day because all of them have different colors.In the second example, Tanya can eat candies for two days. For example, she can eat red and green candies on the first day, and green and blue candies on the second day.In the third example, Tanya can eat candies for two days. For example, she can eat red and green candies on the first day, and red and blue candies on the second day. Note, that two red candies will remain uneaten.

import Data.List
import Control.Monad

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

getNLists :: (Read a) => Int -> IO [[a]]
getNLists n = sequence $ replicate n getList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [a, b, c] <- sort <$> getList
        print $ f a b c

f :: Int -> Int -> Int -> Int
f a b c
    | a + b <= c = a + b
    | otherwise = div (a + b + c) 2

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

main = getLine >>= test.read
test 0 = return ()
test i = do
  (r:g:b:_) <- sort.map read.words <$> getLine
  print $ solve r g b
  test (i - 1)

solve r g b
  | r + g < b = r + g
  | otherwise = div (r + g + b) 2

import Control.Monad

solve :: [Int] -> Int
solve l = min (div (sum l) 2) (sum l - (maximum l))

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

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


It is given a positive integer $$$n$$$. In $$$1$$$ move, one can select any single digit and remove it (i.e. one selects some position in the number and removes the digit located at this position). The operation cannot be performed if only one digit remains. If the resulting number contains leading zeroes, they are automatically removed.E.g. if one removes from the number $$$32925$$$ the $$$3$$$-rd digit, the resulting number will be $$$3225$$$. If one removes from the number $$$20099050$$$ the first digit, the resulting number will be $$$99050$$$ (the $$$2$$$ zeroes going next to the first digit are automatically removed).What is the minimum number of steps to get a number such that it is divisible by $$$25$$$ and positive? It is guaranteed that, for each $$$n$$$ occurring in the input, the answer exists. It is guaranteed that the number $$$n$$$ has no leading zeros.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing one integer $$$n$$$ ($$$25 \le n \le 10^{18}$$$). It is guaranteed that, for each $$$n$$$ occurring in the input, the answer exists. It is guaranteed that the number $$$n$$$ has no leading zeros.

For each test case output on a separate line an integer $$$k$$$ ($$$k \ge 0$$$) — the minimum number of steps to get a number such that it is divisible by $$$25$$$ and positive.

NoteIn the first test case, it is already given a number divisible by $$$25$$$.In the second test case, we can remove the digits $$$1$$$, $$$3$$$, and $$$4$$$ to get the number $$$75$$$.In the third test case, it's enough to remove the last digit to get the number $$$325$$$.In the fourth test case, we can remove the three last digits to get the number $$$50$$$.In the fifth test case, it's enough to remove the digits $$$4$$$ and $$$7$$$.

import Data.Function (on)
import Data.List

yesNo False = "NO"
yesNo True = "YES"

readInt :: String -> Int
readInt = read

readBigInt :: String -> Integer
readBigInt = read

solve_task :: String -> String
solve_task line = let number = readBigInt line
                      kToS xs n   | n == 0               = 0
                                  | n `mod` 10 `elem` xs = 0
                                  | otherwise            = 1 + kToS xs (n `div` 10)
                      k0 = kToS [0] number
                      k5 = kToS [5] number
                      in show $ min (k0 + kToS [0,5] (number `div` 10^(k0+1))) (k5 + kToS [2,7] (number `div` 10^(k5+1)))

solve_tasks (t:tasks) = map solve_task tasks

solve = unlines . solve_tasks . lines

main = interact solve

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

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

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {s :: String}

input :: Scanner TC
input = do
  s <- str
  return TC {..}

output = showB

solve :: TC -> Int
solve TC {..} = minimum $ map (cost $ reverse s) ["00", "52", "05", "57"]
  where
    cost _ [] = 0
    cost [] _ = 10^5
    cost (x:xs) (p:ps)
      | p == x = cost xs ps
      | otherwise = 1 + cost xs (p:ps)

-------------------------- Template ------------------------------------------
-- 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

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t getLine

    (putStr . unlines . map solve) tcs

solve xs = show $ (length xs -) . maximum . map length . filter ((>=2).length) . map drop2 . filter (not.null.snd) . map (dropTail xs) $ "05"

dropTail xs c = (,) c . reverse . dropWhile (/= c) . reverse $ xs

drop2 (c, xs) = reverse . (c:) . dropPref2 (next c) . tail . reverse $ xs

dropPref2 cs xs = dropWhile (not . (`elem` cs)) xs

next '5' = "27"
next '0' = "05"
next  _  = error "Internal: bad char"

import Control.Monad (replicateM_, forM_, forM)
import Control.Applicative ()

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

go :: [Char] -> Char -> Char -> Int -> Int -> Int
go _ _ _ (-1) _ = -20
go arr first second current state =
    case state of
        0 -> if first == (arr !! current) then go arr first second (current - 1) 1 else go arr first second (current - 1) 0
        1 -> if second == (arr !! current) then current else go arr first second (current - 1) 1
        _ -> 0

solve = do
    n <- getLine
    let ans = [go n '0' '0' (length n - 1) 0
             , go n '5' '2' (length n - 1) 0
             , go n '0' '5' (length n - 1) 0
             , go n '5' '7' (length n - 1) 0]
    print $ length n - maximum ans - 2
    return ()

main = do
    [t] <- nextList
    replicateM_ t solve


Gerald found a table consisting of n rows and m columns. As a prominent expert on rectangular tables, he immediately counted the table's properties, that is, the minimum of the numbers in the corners of the table (minimum of four numbers). However, he did not like the final value — it seemed to be too small. And to make this value larger, he decided to crop the table a little: delete some columns on the left and some on the right, as well as some rows from the top and some from the bottom. Find what the maximum property of the table can be after such cropping. Note that the table should have at least two rows and at least two columns left in the end. The number of cropped rows or columns from each of the four sides can be zero.

The first line contains two space-separated integers n and m (2 ≤ n, m ≤ 1000). The following n lines describe the table. The i-th of these lines lists the space-separated integers ai, 1, ai, 2, ..., ai, m (0 ≤ ai, j ≤ 109) — the m numbers standing in the i-th row of the table.

NoteIn the first test case Gerald cannot crop the table — table contains only two rows and only two columns.In the second test case if we'll crop the table, the table will contain zero in some corner cell. Also initially it contains two zeros in the corner cells, so the answer is 0.

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

import Data.Array.MArray
import Data.Array.ST

import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

main = putStrLn . show . solve . readInput =<< B.getContents

readInput s = let n:m:xs = map (fst . fromJust . B.readInt) $ B.words s
              in (n, m, xs)

solve (n, m, xs0) =
    let xs1 = sortBy (flip compare) . zip xs0 $ map (`divMod` m) [0..length xs0 - 1]
    in runST $ do
        row <- newArray (0, n-1) [] :: ST s (STArray s Int [Int])
        col <- newArray ((0, 0), (m-1, m-1)) False :: ST s (STUArray s (Int, Int) Bool)

        let go [] = return 0
            go ((x, (r, c)):xs) = do
                cs <- readArray row r

                res <- forM cs $ \c1 -> do
                    got <- readArray col (c, c1)
                    if got
                        then return True
                        else do
                            writeArray col (c, c1) True
                            writeArray col (c1, c) True
                            return False

                if or res
                    then return x
                    else do
                        writeArray row r (c:cs)
                        go xs
        go xs1

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

import Data.Array.MArray
import Data.Array.ST

import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

a ! i = readArray a i
a !< i = \e -> writeArray a i e

main = putStrLn . show . solve . readInput =<< B.getContents

readInput s = let n:m:xs = map (fst . fromJust . B.readInt) $ B.words s
              in (n, m, xs)

solve (n, m, xs0) =
    let xs1 = sortBy (flip compare) . zip xs0 $ map (`divMod` m) [0..length xs0 - 1]
    in runST $ do
        row <- newArray (0, n-1) [] :: ST s (STArray s Int [Int])
        col <- newArray ((0, 0), (m-1, m-1)) False :: ST s (STUArray s (Int, Int) Bool)

        let go [] = return 0
            go ((x, (r, c)):xs) = do
                cs <- row ! r

                res <- forM cs $ \c' -> do
                    got <- col ! (c, c')
                    if got
                        then return True
                        else do
                            col !< (c, c') $ True
                            col !< (c', c) $ True
                            return False

                if or res
                    then return x
                    else do
                        row !< r $ c:cs
                        go xs
        go xs1


After too much playing on paper, Iahub has switched to computer games. The game he plays is called "Block Towers". It is played in a rectangular grid with n rows and m columns (it contains n × m cells). The goal of the game is to build your own city. Some cells in the grid are big holes, where Iahub can't build any building. The rest of cells are empty. In some empty cell Iahub can build exactly one tower of two following types:  Blue towers. Each has population limit equal to 100.  Red towers. Each has population limit equal to 200. However, it can be built in some cell only if in that moment at least one of the neighbouring cells has a Blue Tower. Two cells are neighbours is they share a side. Iahub is also allowed to destroy a building from any cell. He can do this operation as much as he wants. After destroying a building, the other buildings are not influenced, and the destroyed cell becomes empty (so Iahub can build a tower in this cell if needed, see the second example for such a case).Iahub can convince as many population as he wants to come into his city. So he needs to configure his city to allow maximum population possible. Therefore he should find a sequence of operations that builds the city in an optimal way, so that total population limit is as large as possible.He says he's the best at this game, but he doesn't have the optimal solution. Write a program that calculates the optimal one, to show him that he's not as good as he thinks.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 500). Each of the next n lines contains m characters, describing the grid. The j-th character in the i-th line is '.' if you're allowed to build at the cell with coordinates (i, j) a tower (empty cell) or '#' if there is a big hole there.

Print an integer k in the first line (0 ≤ k ≤ 106) — the number of operations Iahub should perform to obtain optimal result. Each of the following k lines must contain a single operation in the following format:   «B x y» (1 ≤ x ≤ n, 1 ≤ y ≤ m) — building a blue tower at the cell (x, y);  «R x y» (1 ≤ x ≤ n, 1 ≤ y ≤ m) — building a red tower at the cell (x, y);  «D x y» (1 ≤ x ≤ n, 1 ≤ y ≤ m) — destroying a tower at the cell (x, y).  If there are multiple solutions you can output any of them. Note, that you shouldn't minimize the number of operations.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Arrow
import Control.Monad
import Data.Array
import Data.Graph
import Data.Maybe
import Data.Tree
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [r, c] <- fmap (map readInt . C.words) C.getLine
  a <- fmap (listArray (0, r-1)) $ replicateM r $ C.getLine
  let e = [(i * c + j, i' * c + j') |
        i <- [0 .. r-1], j <- [0 .. c-1],
        a!i `C.index` j /= '#',
        k <- [id *** pred, id *** succ, pred *** id, succ *** id],
        let (i', j') = k (i, j),
        0 <= i' && i' < r && 0 <= j' && j' < c,
        a!i' `C.index` j' /= '#']
      g = buildG (0, r*c-1) e
      ans = concat [reverse $ snd $ runState (gao c k) [] |
        k <- dff g,
        let (i, j) = rootLabel k `quotRem` c,
        a!i `C.index` j /= '#']
  print $ length ans
  putStr $ unlines ans

gao :: Int -> Tree Int -> State [String] ()
gao c f = do
  let (i, j) = rootLabel f `quotRem` c
  modify $ (concat ["B ", show (i+1), " ", show (j+1)]:)
  forM_ (subForest f) $ \k -> do
    gao c k
    let (i', j') = rootLabel k `quotRem` c
        s' = concat [" ", show (i'+1), " ", show (j'+1)]
    modify $ (('D':s'):)
    modify $ (('R':s'):)

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)