AquaMoon had $$$n$$$ strings of length $$$m$$$ each. $$$n$$$ is an odd number.When AquaMoon was gone, Cirno tried to pair these $$$n$$$ strings together. After making $$$\frac{n-1}{2}$$$ pairs, she found out that there was exactly one string without the pair!In her rage, she disrupted each pair of strings. For each pair, she selected some positions (at least $$$1$$$ and at most $$$m$$$) and swapped the letters in the two strings of this pair at the selected positions.For example, if $$$m = 6$$$ and two strings "abcdef" and "xyzklm" are in one pair and Cirno selected positions $$$2$$$, $$$3$$$ and $$$6$$$ she will swap 'b' with 'y', 'c' with 'z' and 'f' with 'm'. The resulting strings will be "ayzdem" and "xbcklf".Cirno then stole away the string without pair and shuffled all remaining strings in arbitrary order.AquaMoon found the remaining $$$n-1$$$ strings in complete disarray. Also, she remembers the initial $$$n$$$ strings. She wants to know which string was stolen, but she is not good at programming. Can you help her?

This problem is made as interactive. It means, that your solution will read the input, given by the interactor. But the interactor will give you the full input at the beginning and after that, you should print the answer. So you should solve the problem, like as you solve the usual, non-interactive problem because you won't have any interaction process. The only thing you should not forget is to flush the output buffer, after printing the answer. Otherwise, you can get an "Idleness limit exceeded" verdict. Refer to the interactive problems guide for the detailed information about flushing the output buffer. The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$, $$$m$$$ ($$$1 \leq n \leq 10^5$$$, $$$1 \leq m \leq 10^5$$$) — the number of strings and the length of each string, respectively. The next $$$n$$$ lines each contain a string with length $$$m$$$, describing the original $$$n$$$ strings. All string consists of lowercase Latin letters. The next $$$n-1$$$ lines each contain a string with length $$$m$$$, describing the strings after Cirno exchanged and reordered them. It is guaranteed that $$$n$$$ is odd and that the sum of $$$n \cdot m$$$ over all test cases does not exceed $$$10^5$$$. Hack format: The first line should contain a single integer $$$t$$$. After that $$$t$$$ test cases should follow in the following format: The first line should contain two integers $$$n$$$ and $$$m$$$. The following $$$n$$$ lines should contain $$$n$$$ strings of length $$$m$$$, describing the original strings. The following $$$\frac{n-1}{2}$$$ lines should describe the pairs. They should contain, in the following order: the index of the first string $$$i$$$ ($$$1 \leq i \leq n$$$), the index of the second string $$$j$$$ ($$$1 \leq j \leq n$$$, $$$i \neq j$$$), the number of exchanged positions $$$k$$$ ($$$1 \leq k \leq m$$$), and the list of $$$k$$$ positions that are exchanged ($$$k$$$ distinct indices from $$$1$$$ to $$$m$$$ in any order). The final line should contain a permutation of integers from $$$1$$$ to $$$n$$$, describing the way the strings should be reordered. The strings will be placed in the order indices placed in this permutation, the stolen string index will be ignored.

For each test case print a single line with the stolen string.

3
3 5
aaaaa
bbbbb
ccccc
aaaaa
bbbbb
3 4
aaaa
bbbb
cccc
aabb
bbaa
5 6
abcdef
uuuuuu
kekeke
ekekek
xyzklm
xbcklf
eueueu
ayzdem
ukukuk

NoteIn the first test case, "aaaaa" and "bbbbb" exchanged all positions, and "ccccc" is the stolen string.In the second test case, "aaaa" and "bbbb" exchanged two first positions, and "cccc" is the stolen string.This is the first test in the hack format: 33 5aaaaabbbbbccccc1 2 5 1 2 3 4 52 1 33 4aaaabbbbcccc1 2 2 1 22 1 35 6abcdefuuuuuukekekeekekekxyzklm1 5 3 2 3 62 4 3 2 4 65 4 1 2 3

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  _ <- let a = B.transpose $ _s2
           b = B.transpose $ _s3
           sol = if n == 1 then head _s2 else B.pack $ zipWith subtr a b
       in sequence [B.putStr sol,  putStrLn "", hFlush stdout]
  return ()

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

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

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,
                                             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           (forM, for)
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

solve :: Int -> Int -> [String] -> [String] -> String
solve n m initA resultA = result
    where
        initAB8 :: [B8.ByteString]
        initAB8 = map B8.pack initA

        resultAB8 :: [B8.ByteString]
        resultAB8 = map B8.pack resultA

        result :: String
        result = flip map [0 .. m - 1] $ \i ->
                let
                    emptyMap :: M.Map Char Int
                    emptyMap = M.empty

                    inclusiveMap :: M.Map Char Int
                    inclusiveMap = foldr (\s m -> M.insertWith (+) (s `B8.index` i) 1 m) emptyMap initAB8

                    resultMap :: M.Map Char Int
                    resultMap = foldr (\s m -> M.insertWith (+) (s `B8.index` i) (-1) m) inclusiveMap resultAB8

                in fst . head . filter (\(k, v) -> v > 0) . M.toList $ resultMap

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> map readIntB8 . B8.words
        initA <- replicateM n $ B8.getLine <&> B8.unpack
        resultA <- replicateM (n - 1) $ B8.getLine <&> B8.unpack

        let answer = solve n m initA resultA

        putStrLn answer
        hFlush stdout

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List (transpose, group, sort)

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

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

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

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

(><) = times

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

main :: IO ()
main = C.interact $ runScanner (numberOf testCase) >>> unlines >>> C.pack

testCase :: Scanner String
testCase = do
  (n, _) <- pair int int
  ss <- (2 * n - 1) >< str
  return $ map findOdd (transpose ss)

findOdd :: [Char] -> Char
findOdd = head . head . filter (odd . length) . group . sort

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

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

import Data.Array.Unboxed

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    orig <- replicateM n (P.toStrict <$> readLine)
    scr <- replicateM (n-1) (P.toStrict <$> readLine)
    let
      outStr = (++ "\n") $ do
        i <- [0 .. fromIntegral (m - 1)]
        let
          [oi, si] = map (map (`SP.index` i)) [orig, scr]
          cts :: UArray Char Int
          cts = accumArray (+) 0 ('a', 'z')
            $ zip oi (repeat 1) ++ zip si (repeat (0-1))
        [c | c <- ['a' .. 'z'], cts ! c /= 0]
    lift $ B.hPutBuilder stdout $ B.string7 outStr

type SIO = StateT P.ByteString IO

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

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  _ <- let a = B.transpose $ _s2
           b = B.transpose $ _s3
           sol = if n == 1 then [B.head $ head a] else zipWith subtr a b
       in sequence [B.putStr $ B.pack sol, putStrLn "", hFlush stdout]
  return ()

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  let a = B.transpose $ _s2
      b = B.transpose $ _s3
      sol = zipWith subtr a b
    in sequence [B.putStr $ B.pack sol, putStrLn ""]
  return ()

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

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n B.getLine :: IO [B.ByteString]
  _s3 <- sequence $ replicate (n-1) B.getLine :: IO [B.ByteString]
  let a = B.transpose $ _s2
      b = B.transpose $ _s3
      sol = zipWith subtr a b
    in sequence [B.putStr $ B.pack sol, putStrLn "", hFlush stdout]
  return ()

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


Valera loves his garden, where n fruit trees grow.This year he will enjoy a great harvest! On the i-th tree bi fruit grow, they will ripen on a day number ai. Unfortunately, the fruit on the tree get withered, so they can only be collected on day ai and day ai + 1 (all fruits that are not collected in these two days, become unfit to eat).Valera is not very fast, but there are some positive points. Valera is ready to work every day. In one day, Valera can collect no more than v fruits. The fruits may be either from the same tree, or from different ones. What is the maximum amount of fruit Valera can collect for all time, if he operates optimally well?

The first line contains two space-separated integers n and v (1 ≤ n, v ≤ 3000) — the number of fruit trees in the garden and the number of fruits that Valera can collect in a day.  Next n lines contain the description of trees in the garden. The i-th line contains two space-separated integers ai and bi (1 ≤ ai, bi ≤ 3000) — the day the fruits ripen on the i-th tree and the number of fruits on the i-th tree.

Print a single integer — the maximum number of fruit that Valera can collect.

NoteIn the first sample, in order to obtain the optimal answer, you should act as follows.   On the first day collect 3 fruits from the 1-st tree.  On the second day collect 1 fruit from the 2-nd tree and 2 fruits from the 1-st tree.  On the third day collect the remaining fruits from the 2-nd tree.  In the second sample, you can only collect 60 fruits, the remaining fruit will simply wither.

import Data.List
import Data.Function

main=interact $ show . getAns . getArrays

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

getAns :: [Int] -> Int
getAns (v:xs) = getMax 1 0 v $ (map (\l@(x:xs) -> (fst x, (sum . map snd) l)) . groupBy (\x y -> fst x == fst y) . sort . toPairs) xs

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

getMax :: Int -> Int -> Int -> [(Int, Int)] -> Int
getMax _ 0 _ [] = 0
getMax d r v ((y, x):xs) | y == d =
	let gets = min (r + x) v
	    nr = if gets >= r then x + r - gets else x
	in gets + getMax (d + 1) nr v xs
getMax d r v xs = min v r + getMax (d + 1) 0 v xs

{-# LANGUAGE BangPatterns #-}

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

solve maxi v !s d i rarr | i > maxi =
  let s1 = min v d in s+s1

solve maxi v !s d i rarr =
  -- v - picking capacilty
  -- s - total fruit picked
  -- maxi - maximum value of i
  -- d - amount of day-old fruit
  -- i - day number
  -- rarr - array of ripened fruit
  let r = rarr!i
      s1 = min v (d+r)      -- amount of day-old fruit picked
      d' = min (d+r-s1) r   -- new amount of day-old fruit
  in solve maxi v (s+s1) d' (i+1) rarr

main = do
  (n:v:_) <- fmap (map read . words) getLine
  rarr <- newArray (1,3001) 0 :: IO (IOUArray Int Int)
  replicateM_ n $ do
    (a:b:_) <- fmap (map read . words) getLine
    x <- readArray rarr a
    writeArray rarr a (b+x)
  rarr <- freeze rarr  :: IO (UArray Int Int)
  let answer = solve 3001 v 0 0 1 rarr
  print answer

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List (sort, insertBy)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Debug.Trace

readInts :: B.ByteString -> [Int]
readInts = map fst . mapMaybe B.readInt . B.words

getInts :: IO [Int]
getInts = readInts <$> B.getLine

main = do
  [n, v] <- getInts
  ts <- replicateM n $ do {[a, c] <- getInts; return (a, 0, c);}
  let
    comp (x1,y1,_) (x2,y2,_) = (x1 `compare` x2) `mappend` (y2 `compare` y1)
    f [] _ _ = 0
    f ts@((a,b,c):rs) day limit
      | b == 2 || c == 0 = f rs day limit
      | a == day = let fruit = min c limit in fruit + f (insertBy comp (a+1, b+1, c-fruit) rs) day (limit-fruit)
      | otherwise = f ts (day+1) v
    in print $ f (sort ts) 1 v

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List

main = do
  [_, v] <- map read.words <$> getLine
  xys <- parse.map read.words <$> getContents
  print $ solve v xys

parse (x:y:xys) = (x, y) : parse xys
parse _ = []

solve :: Int -> [(Int, Int)] -> Int
solve v xys = go 0 1 v $ sort xys
   where
     go !res !day !num ((a,b):rest)
       | day < a = go res (day+1) v $ (a,b):rest
       | a + 1 < day = go res day num rest
       | num <= b = go (res+num) (day+1) v $ (a,b-num) : rest
       | otherwise = go (res+b) day (num-b) rest
     go res _ _ _ = res

import Data.List
import Data.Function

main=interact $ show . getAns . getArrays

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

getAns :: [Int] -> Int
getAns (v:xs) = getMax 1 0 v $ (sort . toPairs) xs

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

getMax :: Int -> Int -> Int -> [(Int, Int)] -> Int
getMax _ 0 _ [] = 0
getMax d r v ((y, x):xs) | y == d =
	let gets = min (r + x) v
	    tr = if gets >= r then x - (gets - r) else 0
	    nr = if tr > 0 then tr else 0
	in gets + getMax (d + 1) nr v xs
getMax d r v xs = min v r + getMax (d + 1) 0 v xs

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List

main = do
  [_, v] <- map read.words <$> getLine
  xys <- parse.map read.words <$> getContents
  print $ solve v xys

parse (x:y:xys) = (x, y) : parse xys
parse _ = []

solve :: Int -> [(Int, Int)] -> Int
solve v xys = go 0 1 v (sort xys)
   where
     go !res !day !num ((a,b):rest)
       | day < a = go res a v rest
       | a + 1 < day = go res day num rest
       | num <= b = go (res+num) (day+1) v $ (a,b-num) : rest
       | otherwise = go (res+b) day (num-b) rest
     go res _ _ _ = res


Nikolay got a string $$$s$$$ of even length $$$n$$$, which consists only of lowercase Latin letters 'a' and 'b'. Its positions are numbered from $$$1$$$ to $$$n$$$.He wants to modify his string so that every its prefix of even length has an equal amount of letters 'a' and 'b'. To achieve that, Nikolay can perform the following operation arbitrary number of times (possibly, zero): choose some position in his string and replace the letter on this position with the other letter (i.e. replace 'a' with 'b' or replace 'b' with 'a'). Nikolay can use no letters except 'a' and 'b'.The prefix of string $$$s$$$ of length $$$l$$$ ($$$1 \le l \le n$$$) is a string $$$s[1..l]$$$.For example, for the string $$$s=$$$"abba" there are two prefixes of the even length. The first is $$$s[1\dots2]=$$$"ab" and the second $$$s[1\dots4]=$$$"abba". Both of them have the same number of 'a' and 'b'.Your task is to calculate the minimum number of operations Nikolay has to perform with the string $$$s$$$ to modify it so that every its prefix of even length has an equal amount of letters 'a' and 'b'.

The first line of the input contains one even integer $$$n$$$ $$$(2 \le n \le 2\cdot10^{5})$$$ — the length of string $$$s$$$. The second line of the input contains the string $$$s$$$ of length $$$n$$$, which consists only of lowercase Latin letters 'a' and 'b'.

In the first line print the minimum number of operations Nikolay has to perform with the string $$$s$$$ to modify it so that every its prefix of even length has an equal amount of letters 'a' and 'b'. In the second line print the string Nikolay obtains after applying all the operations. If there are multiple answers, you can print any of them.

NoteIn the first example Nikolay has to perform two operations. For example, he can replace the first 'b' with 'a' and the last 'b' with 'a'. In the second example Nikolay doesn't need to do anything because each prefix of an even length of the initial string already contains an equal amount of letters 'a' and 'b'.

data S=A|B deriving Eq
data SL = SL [S]

readS::Char->S
readS 'a' = A
readS 'b' = B

readSL::String->[S]
readSL str = map readS str

showS::S->Char
showS A = 'a'
showS B = 'b'

showSL::[S]->String
showSL str = map showS str

beat2::[S]->[(S,S)]
beat2 [] = []
beat2 (x:y:xs) = (x,y):(beat2 xs)

inv::(S,S)->(Int,(S,S))
inv (A,A) = (1,(A,B))
inv (B,B) = (1,(B,A))
inv a=(0,a)

backConc::[(a,a)]->[a]
backConc [] =[]
backConc ((x,y):xs)=x:y:(backConc xs)

getFinal::[S]->(Int,[S])
getFinal str = let
   (ns,fs) = unzip $ map inv (beat2 str)
    in (sum ns,backConc fs)

main::IO()
main = do
   n <- getLine
   str <- getLine
   let (n,str') = getFinal (readSL str)
   print n
   putStrLn (showSL str')

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

tr "aa" = "ab"
tr "bb" = "ab"
tr x = x

chunksOf n [] = []
chunksOf n s = (take n s): (chunksOf n (drop n s))

main = do
	n<- read <$> getLine ::IO Int
	s<-chunksOf 2 <$> getLine
	print $  length $ filter (\z-> elem z ["aa","bb"]) s
	putStrLn $ concat $ map tr s


Sho has an array $$$a$$$ consisting of $$$n$$$ integers. An operation consists of choosing two distinct indices $$$i$$$ and $$$j$$$ and removing $$$a_i$$$ and $$$a_j$$$ from the array.For example, for the array $$$[2, 3, 4, 2, 5]$$$, Sho can choose to remove indices $$$1$$$ and $$$3$$$. After this operation, the array becomes $$$[3, 2, 5]$$$. Note that after any operation, the length of the array is reduced by two.After he made some operations, Sho has an array that has only distinct elements. In addition, he made operations such that the resulting array is the longest possible. More formally, the array after Sho has made his operations respects these criteria:   No pairs such that ($$$i < j$$$) and $$$a_i = a_j$$$ exist.  The length of $$$a$$$ is maximized. Output the length of the final array.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 50$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$1 \leq a_i \leq 10^4$$$) — the elements of the array.

For each test case, output a single integer — the length of the final array. Remember that in the final array, all elements are different, and its length is maximum.

NoteFor the first test case Sho can perform operations as follows:   Choose indices $$$1$$$ and $$$5$$$ to remove. The array becomes $$$[2, 2, 2, 3, 3, 3] \rightarrow [2, 2, 3, 3]$$$.  Choose indices $$$1$$$ and $$$4$$$ to remove. The array becomes $$$[2, 2, 3, 3] \rightarrow [2, 3]$$$.  The final array has a length of $$$2$$$, so the answer is $$$2$$$. It can be proven that Sho cannot obtain an array with a longer length.For the second test case Sho can perform operations as follows:   Choose indices $$$3$$$ and $$$4$$$ to remove. The array becomes $$$[9, 1, 9, 9, 1] \rightarrow [9, 1, 1]$$$.  Choose indices $$$1$$$ and $$$3$$$ to remove. The array becomes $$$[9, 1, 1] \rightarrow [1]$$$.  The final array has a length of $$$1$$$, so the answer is $$$1$$$. It can be proven that Sho cannot obtain an array with a longer length.

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let cntEven = length $ filter (even . length) blocks

        let answer = (-) (length blocks) (if odd cntEven then 1 else 0)

        putStrLn $ show answer

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let cntEven = length $ filter (even . length) blocks

        let answer = length blocks

        answer <- return (if odd cntEven then answer - 1 else answer)

        putStrLn $ show answer

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

listToCountListMod2 :: [Int] -> [Int]
listToCountListMod2 = map (`mod` 2) . M.elems . M.fromListWith (+) . flip zip (repeat 1)

oneAndTwoToAnswer :: [Int] -> Int
oneAndTwoToAnswer lst = oneCount + twoCount - twoCount `mod` 2
  where
    oneAndTwoCount = M.fromListWith (+) $ zip lst (repeat 1)
    oneCount = fromMaybe 0 $ oneAndTwoCount !? 1
    twoCount = fromMaybe 0 $ oneAndTwoCount !? 0

solution :: IO ()
solution = do
  [_] <- getNumbers
  nums <- getNumbers
  print $ oneAndTwoToAnswer $ listToCountListMod2 nums

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

listToCountListMod2 :: [Int] -> [Int]
listToCountListMod2 = map (`mod` 2) . M.elems . M.fromListWith (+) . flip zip (repeat 1)

oneAndTwoToAnswer :: [Int] -> Int
oneAndTwoToAnswer lst = oneCount + (if twoCount `mod` 2 == 1 then twoCount - 1 else twoCount)
  where
    oneAndTwoCount = M.fromListWith (+) $ zip lst (repeat 1)
    oneCount = fromMaybe 0 $ oneAndTwoCount !? 1
    twoCount = fromMaybe 0 $ oneAndTwoCount !? 0

solution :: IO ()
solution = do
  [_] <- getNumbers
  nums <- getNumbers
  print $ oneAndTwoToAnswer $ listToCountListMod2 nums

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import Control.Monad.State.Class
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.Functor.Identity
import qualified Data.IntMap as M
import Data.Maybe
import Debug.Trace

type ParserT = StateT C.ByteString

type ComputationT m = StateT (M.IntMap Bool) (ParserT m)

-- A computation is a monadic action with an input string and an intmap "variable" as state.
type Computation = ComputationT Identity

runComputation :: Computation a -> C.ByteString -> a
runComputation computation = runIdentity . evalStateT (evalStateT computation M.empty)

main :: IO ()
main = do
  t <- int <$> C.getLine
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- int <$> C.getLine
  C.getLine >>= output . runComputation (replicateM_ n populateTree >> eliminateTree)

eliminateTree :: Computation Int
eliminateTree = do
  list <- gets M.toList
  return $ length list - ((`mod` 2) . length . filter id . map snd $ list)

populateTree :: Computation ()
populateTree = do
  val <- lift getInt
  modify $ M.alter (pure . maybe False not) val

getInt :: Monad m => ParserT m Int
getInt = StateT $ pure . fromJust . C.readInt . C.dropWhile isSpace

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

output :: Int -> IO ()
output = L.putStrLn . B.toLazyByteString . B.intDec

module Main where

import Data.List

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let inputs = map ((map read) . words) $ take t $ dropOdd $ lines input
  mapM_ (print . solve) inputs
    where dropOdd [] = []
          dropOdd (_:x:xs) = x:(dropOdd xs)

solve :: [Int] -> Int
solve xs = unique - abs ((length xs + unique) `mod` 2)
  where unique = length $ nub xs

{-# LANGUAGE ScopedTypeVariables #-}

import Data.List
import Control.Monad
--import Control.Monad.State.Strict

-- parseLine = fmap (map read . words)

toSpaced :: Show a => [a] -> String
toSpaced = intercalate " " . map show

printSpaced :: Show a => [a] -> IO ()
printSpaced = putStrLn . toSpaced

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

f :: Int -> Int -> Int
f x y = mod (x - y + 10) 10

main :: IO ()
main = do
    t <- readInt
    forM_ [1..t] $ \t -> do
        n <- readInt
        a <- readInts

        let fs = map length (group $ sort a)

        {-
        offsets <- (forM [1..n] $ \i -> do
            line <- getLine;
            let [b_i_s, s_i] = words line;
            -- print $ (b_i_s, s_i)
            let b_i :: Int = read b_i_s;
            let up_count = (length . filter (=='U')) s_i;
            let down_count = (length . filter (=='D')) s_i;
            return $ up_count - down_count)

        let res :: [Int] = zipWith f a offsets
        -}

        let o = length $ filter (\x -> (x `mod` 2) == 1) fs
        let e = length $ filter (\x -> (x `mod` 2) == 0) fs

        -- printSpaced fs
        print $ o + e - (e `mod` 2)

        return ()

import Data.List (sort)

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

checkH :: Int -> Int -> [Int] -> (Int, Int)
checkH _ c [] = if c `mod` 2 == 0
  then (1, 0)
  else (0, 1)
checkH a c (x: xs) = if x == a
  then checkH a (c + 1) xs
  else let (r, l) = checkH x 1 xs in if c `mod` 2 == 0
    then (r + 1, l)
    else (r, l + 1)

check :: [Int] -> (Int, Int)
check a = checkH (head a) 0 a

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  n <- readLn :: IO Int
  a <- readArr
  let (x, y) = check $ sort a
  print $ (x - x `mod` 2) + y
  solve $ i - 1

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

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let lengths = sum $ map length blocks

        putStrLn $ show $ (length blocks) - (fromEnum $ odd lengths)

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)
    let blocks = group $ sort as
    let lengths = sum $ map length blocks

    putStrLn $ show $ (length blocks) - (fromEnum $ odd lengths)

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) solve

{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import Control.Monad.State.Class
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.Functor.Identity
import qualified Data.IntMap as M
import Data.Maybe

type ParserT = StateT C.ByteString

type ComputationT m = StateT (M.IntMap Int) (ParserT m)

-- A computation is a monadic action with an input string and an intmap "variable" as state.
type Computation = ComputationT Identity

runComputation :: Computation a -> C.ByteString -> a
runComputation computation = runIdentity . evalStateT (evalStateT computation M.empty)

main :: IO ()
main = do
  t <- int <$> C.getLine
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- int <$> C.getLine
  C.getLine >>= output . runComputation (replicateM_ n populateTree >> eliminateTree)

eliminateTree :: Computation Int
eliminateTree = (length . filter odd . map snd . M.toList) <$> get

populateTree :: Computation ()
populateTree = do
  val <- lift getInt
  modify $ M.alter (pure . maybe 1 succ) val

getInt :: Monad m => ParserT m Int
getInt = StateT $ pure . fromJust . C.readInt . C.dropWhile isSpace

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

output :: Int -> IO ()
output = L.putStrLn . B.toLazyByteString . B.intDec


Ilya is working for the company that constructs robots. Ilya writes programs for entertainment robots, and his current project is "Bob", a new-generation game robot. Ilya's boss wants to know his progress so far. Especially he is interested if Bob is better at playing different games than the previous model, "Alice". So now Ilya wants to compare his robots' performance in a simple game called "1-2-3". This game is similar to the "Rock-Paper-Scissors" game: both robots secretly choose a number from the set {1, 2, 3} and say it at the same moment. If both robots choose the same number, then it's a draw and noone gets any points. But if chosen numbers are different, then one of the robots gets a point: 3 beats 2, 2 beats 1 and 1 beats 3. Both robots' programs make them choose their numbers in such a way that their choice in (i + 1)-th game depends only on the numbers chosen by them in i-th game. Ilya knows that the robots will play k games, Alice will choose number a in the first game, and Bob will choose b in the first game. He also knows both robots' programs and can tell what each robot will choose depending on their choices in previous game. Ilya doesn't want to wait until robots play all k games, so he asks you to predict the number of points they will have after the final game.

The first line contains three numbers k, a, b (1 ≤ k ≤ 1018, 1 ≤ a, b ≤ 3).  Then 3 lines follow, i-th of them containing 3 numbers Ai, 1, Ai, 2, Ai, 3, where Ai, j represents Alice's choice in the game if Alice chose i in previous game and Bob chose j (1 ≤ Ai, j ≤ 3).  Then 3 lines follow, i-th of them containing 3 numbers Bi, 1, Bi, 2, Bi, 3, where Bi, j represents Bob's choice in the game if Alice chose i in previous game and Bob chose j (1 ≤ Bi, j ≤ 3).

Print two numbers. First of them has to be equal to the number of points Alice will have, and second of them must be Bob's score after k games.

NoteIn the second example game goes like this:The fourth and the seventh game are won by Bob, the first game is draw and the rest are won by Alice.

{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}
import Data.Int (Int64)
import Data.Array.IArray (Array, listArray, (!))
import Data.List (elemIndex)
import Control.Monad (replicateM)

main = do
    (map read . words -> ((k :: Int64):(map fromIntegral -> [a, b]))) <- getLine
    (map (listArray ((1, 1), (3, 3)) . concatMap (map read . words)) -> [ma, mb]) <- replicateM 2 $ replicateM 3 getLine
    let f (uncurry (-) -> c) [px, py] | c == 1 || c == -2 = [px + 1, py] | c == -1 || c == 2 = [px, py + 1] | otherwise = [px, py]
        run x cts (pt:ps) = case x `elemIndex` cts of
            Just (succ -> i) -> (reverse $ take i (pt:ps), reverse $ drop i (pt:ps))
            Nothing -> run (ma ! x, mb ! x) (x:cts) (f x pt:pt:ps)
        (ca@(fromIntegral . length -> la), cb@(fromIntegral . length -> lb)) = run (a, b) [] [[0, 0]]
        _ = ma :: Array (Int, Int) Int
    let cap = map (zipWith (flip (-)) (last cb)) ca
    putStrLn . unwords . map show $ if k < lb then cb !! fromIntegral k else
        zipWith (+) (last cb) $
        zipWith (+) (map (* ((k - lb) `div` la)) (last cap)) (cap !! fromIntegral ((k - lb) `mod` la))


The average miner Vaganych took refresher courses. As soon as a miner completes the courses, he should take exams. The hardest one is a computer test called "Testing Pants for Sadness".The test consists of n questions; the questions are to be answered strictly in the order in which they are given, from question 1 to question n. Question i contains ai answer variants, exactly one of them is correct. A click is regarded as selecting any answer in any question. The goal is to select the correct answer for each of the n questions. If Vaganych selects a wrong answer for some question, then all selected answers become unselected and the test starts from the very beginning, from question 1 again. But Vaganych remembers everything. The order of answers for each question and the order of questions remain unchanged, as well as the question and answers themselves.Vaganych is very smart and his memory is superb, yet he is unbelievably unlucky and knows nothing whatsoever about the test's theme. How many clicks will he have to perform in the worst case?

The first line contains a positive integer n (1 ≤ n ≤ 100). It is the number of questions in the test. The second line contains space-separated n positive integers ai (1 ≤ ai ≤ 109), the number of answer variants to question i.

Print a single number — the minimal number of clicks needed to pass the test it the worst-case scenario.  Please do not use the %lld specificator to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specificator.

NoteNote to the second sample. In the worst-case scenario you will need five clicks:   the first click selects the first variant to the first question, this answer turns out to be wrong.  the second click selects the second variant to the first question, it proves correct and we move on to the second question;  the third click selects the first variant to the second question, it is wrong and we go back to question 1;  the fourth click selects the second variant to the first question, it proves as correct as it was and we move on to the second question;  the fifth click selects the second variant to the second question, it proves correct, the test is finished.

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

main = do
	n <- read `fmap` getLine
	a <- ri
	let a' = map (+(-1)) a
	putStrLn $ show $ n + sum (zipWith (*) a' [1..])

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

solve = fst . foldl' f (0,1)
    where f (c,p) n = c' `seq` p' `seq` (c',p')
              where c' = c + 1 + (n-1)*p
                    p' = p + 1

main = print . solve . map (fst . fromJust . B.readInteger) . tail . B.words =<< B.getContents

import Control.Arrow ((>>>), second)
main = getLine >> getLine >>= print . sum . zipWith (curry (second (subtract 1) >>> uncurry (*) >>> (1+))) [1..] . map read . words

solve :: [Integer] -> Integer
solve = sum . zipWith (\i x -> (x - 1) * i + 1) [1..]
main = putStrLn.show.solve.map read.tail.words =<< getContents

readInteger :: String -> Integer
readInteger token = read token :: Integer

solve :: [Integer] -> Integer
solve ans = sum $ zipWith (*) [1 ..] $ (map pred begin) ++ [end]
            where begin = init ans
                  end   = last ans

main :: IO ()
main = interact (show . solve . map readInteger . tail . words)

module Main where

import Control.Monad

main = do
    n <- read `liftM` getLine
    a <- ( map read . words ) `liftM` getLine :: IO [Integer]
    putStrLn $ show $ n + ( sum $ zipWith (\a k -> (a-1) * k) a [1..] )

solve :: [Integer] -> Integer
solve (n:xs) = foldl (\dp (x, i) -> dp + (x - 1) * i + 1) 0 $ zip xs $ iterate (+1) 1

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

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

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

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

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

solve :: [Integer] -> Integer
solve a = sum a' + fromIntegral n
  where
    n = length a
    a' = zipWith (*) [1..] (map pred a)

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

s w=sum[(x-1)*i|(i,x)<-zip[1..](w++[2])]-1
main=interact$show.s.map read.tail.words

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Integer) (words ss)

solve [n] = n
solve nums = loop 0 1 nums

loop total _ [] = total
loop total last (n:ums) = loop (total + last*(n-1) + 1) (last+1) ums

main = interact (show . solve . parse)

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

solve = fst . foldl' f (0,1)
    where f (c,p) n = c' `seq` p' `seq` (c',p')
              where c' = c + 1 + (n-1)*p
                    p' = p + 1

main = print . solve . map (fst . fromJust . B.readInt) . tail . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n:xs) = foldl (\dp (x, i) -> dp + (x - 1) * i + 1) 0 $ zip xs $ iterate (+1) 1

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

s w=sum[x*(i-1)|(i,x)<-zip[1..](w++[2])]-1
main=interact$show.s.map read.tail.words

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Int) (words ss)

solve [n] = n
solve nums = loop 0 1 nums

loop total _ [] = total
loop total last (n:ums) = loop (total + last*(n-1) + 1) (last+1) ums

main = interact (show . solve . parse)

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Int) (words ss)

solve [n] = n
solve nums = length ones + (if rest /= [] then sum rest + 1 else 0 )
    where
      (ones, rest) = partition ((==) 1) nums

main = interact (show . solve . parse)


Given an array of $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 1000$$$). Find the maximum value of $$$i + j$$$ such that $$$a_i$$$ and $$$a_j$$$ are coprime,$$$^{\dagger}$$$ or $$$-1$$$ if no such $$$i$$$, $$$j$$$ exist.For example consider the array $$$[1, 3, 5, 2, 4, 7, 7]$$$. The maximum value of $$$i + j$$$ that can be obtained is $$$5 + 7$$$, since $$$a_5 = 4$$$ and $$$a_7 = 7$$$ are coprime.$$$^{\dagger}$$$ Two integers $$$p$$$ and $$$q$$$ are coprime if the only positive integer that is a divisor of both of them is $$$1$$$ (that is, their greatest common divisor is $$$1$$$).

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 2\cdot10^5$$$) — the length of the array. The following line contains $$$n$$$ space-separated positive integers $$$a_1$$$, $$$a_2$$$,..., $$$a_n$$$ ($$$1 \leq a_i \leq 1000$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

For each test case, output a single integer  — the maximum value of $$$i + j$$$ such that $$$i$$$ and $$$j$$$ satisfy the condition that $$$a_i$$$ and $$$a_j$$$ are coprime, or output $$$-1$$$ in case no $$$i$$$, $$$j$$$ satisfy the condition.

NoteFor the first test case, we can choose $$$i = j = 3$$$, with sum of indices equal to $$$6$$$, since $$$1$$$ and $$$1$$$ are coprime.For the second test case, we can choose $$$i = 7$$$ and $$$j = 5$$$, with sum of indices equal to $$$7 + 5 = 12$$$, since $$$7$$$ and $$$4$$$ are coprime.

import Data.List

enumerate :: Int -> [Int] -> [(Int, Int)]
enumerate n [] = []
enumerate n (x:xs) = (x, n):enumerate (n+1) xs

eliminate :: [(Int, Int)] -> [(Int, Int)]
eliminate [] = []
eliminate [a] = [a]
eliminate (a:b:xs) = if fst a == fst b then eliminate (a:xs) else a:eliminate (b:xs)

compress :: [Int] -> [(Int,Int)]
compress xs = eliminate(reverse.sort $ enumerate 1 xs)

solve :: [Int] -> String
solve [] = "-1"
solve xs = show $ maximum $ [maximum[if gcd (fst x) (fst y) == 1 then snd x + snd y else -1 | y <- compressed] | x <- compressed]
    where compressed = compress xs

testCase = do
    n <- getLine
    wordList <- words `fmap` getLine
    let numList = read `fmap` wordList
    putStrLn $ solve numList

repeatDo 0 m = return []

repeatDo n m = do
    x1 <- m
    x2 <- repeatDo (n - 1) m
    return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatDo n testCase

import Data.List

enumerate :: Int -> [Int] -> [(Int, Int)]
enumerate n [] = []
enumerate n (x:xs) = (x, n):enumerate (n+1) xs

eliminate :: [(Int, Int)] -> [(Int, Int)]
eliminate [] = []
eliminate [a] = [a]
eliminate (a:b:xs) = if fst a == fst b then eliminate (a:xs) else a:eliminate (b:xs)

compress :: [Int] -> [(Int,Int)]
compress xs = eliminate(reverse.sort $ enumerate 1 xs)

solve :: [Int] -> String
solve [] = "-1"
solve xs = if length compressed < 1100 then show $ maximum $ [maximum[if gcd (fst x) (fst y) == 1 then snd x + snd y else -1 | y <- compressed] | x <- compressed] else error "11"
    where compressed = compress xs

testCase = do
    n <- getLine
    wordList <- words `fmap` getLine
    let numList = read `fmap` wordList
    putStrLn $ solve numList

repeatDo 0 m = return []

repeatDo n m = do
    x1 <- m
    x2 <- repeatDo (n - 1) m
    return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatDo n testCase


$$$n$$$ students attended the first meeting of the Berland SU programming course ($$$n$$$ is even). All students will be divided into two groups. Each group will be attending exactly one lesson each week during one of the five working days (Monday, Tuesday, Wednesday, Thursday and Friday), and the days chosen for the groups must be different. Furthermore, both groups should contain the same number of students.Each student has filled a survey in which they told which days of the week are convenient for them to attend a lesson, and which are not. Your task is to determine if it is possible to choose two different week days to schedule the lessons for the group (the first group will attend the lesson on the first chosen day, the second group will attend the lesson on the second chosen day), and divide the students into two groups, so the groups have equal sizes, and for each student, the chosen lesson day for their group is convenient.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The first line of each testcase contains one integer $$$n$$$ ($$$2 \le n \le 1\,000$$$) — the number of students. The $$$i$$$-th of the next $$$n$$$ lines contains $$$5$$$ integers, each of them is $$$0$$$ or $$$1$$$. If the $$$j$$$-th integer is $$$1$$$, then the $$$i$$$-th student can attend the lessons on the $$$j$$$-th day of the week. If the $$$j$$$-th integer is $$$0$$$, then the $$$i$$$-th student cannot attend the lessons on the $$$j$$$-th day of the week.  Additional constraints on the input: for each student, at least one of the days of the week is convenient, the total number of students over all testcases doesn't exceed $$$10^5$$$.

For each testcase print an answer. If it's possible to divide the students into two groups of equal sizes and choose different days for the groups so each student can attend the lesson in the chosen day of their group, print "YES" (without quotes). Otherwise, print "NO" (without quotes).

NoteIn the first testcase, there is a way to meet all the constraints. For example, the first group can consist of the first and the third students, they will attend the lessons on Thursday (the fourth day); the second group can consist of the second and the fourth students, and they will attend the lessons on Tuesday (the second day).In the second testcase, it is impossible to divide the students into groups so they attend the lessons on different days.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, cs::[[Int]]}
data Output = Output Bool deriving Show

solve :: Input -> Output
solve (Input n cs)
  | odd n = Output False
  | otherwise = Output $ solve' n cs

solve' :: Int -> [[Int]] -> Bool
solve' n cs' = foldr (||) False $ [works c1 c2 | (c1:c3:cs3) <- L.tails cs, c2<-(c3:cs3)] where
  majority ds = sum ds >= (n `div` 2)
  cs = filter majority cs'
  works x y = all (>0) $ zipWith (+) x y

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  rs <- replicateM n $ getIntegrals 5
  return $ Input n (L.transpose rs)

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output False) = str "NO" <> nl
  go (Output True) = str "YES" <> nl

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

----------------------------- library -------------------------------
modp :: Integral t=>t->t
modp = (`mod` (10^9+7))

fastPow :: Integral t=>(t->t)->t->t->t
fastPow modf base' p' = go base' p' where
  go base 0 = base
  go base p = go (base`times`base) (p`div`2)  `times`  base^(p`mod`2)
  times = (modf.).(*)

primeFac :: Integral t=> t -> [(t,Int)]
primeFac  = map (\xs-> (head xs,length xs)).L.group.tryDiv 2 where
  tryDiv d n
    | n `mod` d == 0 = d : tryDiv d (n `div` d)
    | n == 1 = []
    | d*d < n = tryDiv (d+1+d`mod`2) n
    | otherwise = tryDiv n n

umakeset xs = (M.fromList (zip xs xs), M.fromList (zip xs (repeat 0)))
ufind uf@(parents,ranks) x = if parents M.! x == x then x else ufind uf (parents M.! x)
uunion uf@(parents, ranks) x y = if fx==fy then (False,uf) else (True, (parents1, ranks1)) where
  (fx, fy) = (ufind uf x, ufind uf y)
  [(r0,f0), (r1,f1)] = L.sort [(ranks M.! fx, fx), (ranks M.! fy, fy)]
  parents1 = M.insert f0 f1 parents
  ranks1 = if r0 /= r1 then ranks else M.insert f1 (r1+1) ranks

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.List
import qualified Data.IntMap as M
import qualified Data.IntSet as S

type Students = S.IntSet
type Days = M.IntMap Students

calc :: Int -> Days -> Bool
calc n tree =
  let days = [(i,j) | i <- [1..5], j <- [i+1..5]]
  in
    any (\(i,j) ->
         let left = M.findWithDefault S.empty i tree
             right = M.findWithDefault S.empty j tree
             intersectionSize = S.size $ S.intersection left right
             leftDifSize = S.size $ S.difference left right
             rightDifSize = S.size $ S.difference right left
         in
           leftDifSize <= (n `div` 2) &&
           rightDifSize <= (n `div` 2) &&
           intersectionSize >= n - leftDifSize - rightDifSize
        ) days

updateStudent :: Int -> Maybe Students -> Maybe Students
updateStudent i Nothing = Just (S.insert i S.empty)
updateStudent i (Just s) = Just (S.insert i s)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    daysMap <- foldM (\tree i -> do
      line <- getLine
      let days = map (\(i,j) -> i) $ filter (\(i,j) -> j>0) $ zip [1..] $ map read $ words line :: [Int]
      let newTree = foldl (\t d -> M.alter (updateStudent i) d t) tree days
      return newTree) M.empty [1..n]
    if (calc n daysMap) then
      putStrLn "YES"
    else
      putStrLn "NO"


You are given a number $$$k$$$ and a string $$$s$$$ of length $$$n$$$, consisting of the characters '.' and '*'. You want to replace some of the '*' characters with 'x' characters so that the following conditions are met:   The first character '*' in the original string should be replaced with 'x';  The last character '*' in the original string should be replaced with 'x';  The distance between two neighboring replaced characters 'x' must not exceed $$$k$$$ (more formally, if you replaced characters at positions $$$i$$$ and $$$j$$$ ($$$i < j$$$) and at positions $$$[i+1, j-1]$$$ there is no "x" symbol, then $$$j-i$$$ must be no more than $$$k$$$). For example, if $$$n=7$$$, $$$s=$$$.**.*** and $$$k=3$$$, then the following strings will satisfy the conditions above:   .xx.*xx;  .x*.x*x;  .xx.xxx.  But, for example, the following strings will not meet the conditions:   .**.*xx (the first character '*' should be replaced with 'x');  .x*.xx* (the last character '*' should be replaced with 'x');  .x*.*xx (the distance between characters at positions $$$2$$$ and $$$6$$$ is greater than $$$k=3$$$). Given $$$n$$$, $$$k$$$, and $$$s$$$, find the minimum number of '*' characters that must be replaced with 'x' in order to meet the above conditions.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 500$$$). Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 50$$$). The second line of each test case contains a string $$$s$$$ of length $$$n$$$, consisting of the characters '.' and '*'. It is guaranteed that there is at least one '*' in the string $$$s$$$. It is guaranteed that the distance between any two neighboring '*' characters does not exceed $$$k$$$.

For each test case output the minimum number of '*' characters that must be replaced with 'x' characters in order to satisfy the conditions above.

import Control.Monad
import Data.Array
readInts = fmap (map read.words) getLine :: IO [Int]

solve a n k i
            | i >= n = 1
            | a!i == '*' = 1 + solve a n k (i+k)
            | otherwise = solve a n k (i-1)

printResult = do
    [n,k] <- readInts
    s <- getLine
    let a = dropWhile (=='.') s
        b = dropWhile (=='.') $ reverse a
        m = length b
        z = listArray (1,n) b
    print $ solve z m k 1

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

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

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)
import Data.Maybe

result :: Integer -> Integer -> String -> Int
result n k str = length indices where
	starS = S.fromList star
	strM = M.fromList $ zip [0..] str
	star = foldr (\(i, s) l -> if s=='*' then i:l else l) [] $ zip [0..] str

	nextId i = fromJust $ S.lookupLE (i+k) starS

	indices = L.nub $ aux (star !! 0) star where
		aux _ [] = []
		aux v (x:xs)
			| x == v = x : aux (nextId x) xs
			| otherwise = aux v xs

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		[n, k] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		str <- getLine
		print $ result n k str
		loop $ t - 1
	loop t

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe)

main :: IO ()
main = C.interact $ runScanner (numberOf (C.pack <$> testCase)) >>> C.unlines

testCase :: Scanner String
testCase = do
  (n, k) <- pair int int
  s <- str
  return . show $ compute k s

compute :: Int -> String -> Int
compute k s = replace (-10^9) [i | (c, i) <- zip s [1..], c == '*']
  where
    replace _ [] = 0
    replace _ [_] = 1
    replace p (x:x':xs)
      | x' <= p + k = replace p (x':xs)
      | otherwise = 1 + replace x (x':xs)

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

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> cstr

double :: Scanner Double
double = read . C.unpack <$> cstr

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 (,)

import Control.Monad
import Data.Array
readInts = fmap (map read.words) getLine :: IO [Int]

solve a n k i
            | i >= n = 1
            | a!i == '*' = 1 + solve a n k (i+k)
            | otherwise = solve a n k (i-1)

printResult = do
    [n,k] <- readInts
    s <- getLine
    let a = dropWhile (=='.') s
        b = dropWhile (=='.') $ reverse a
        m = length b
        z = listArray (1,n) b
    print b
    print $ solve z m k 1

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

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

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)
import Data.Maybe

result :: Integer -> Integer -> String -> Int
result n k str = length indices where
	starS = S.fromList star
	strM = M.fromList $ zip [0..] str
	star = foldr (\(i, s) l -> if s=='*' then i:l else l) [] $ zip [0..] str

	nextId i = fromJust $ S.lookupLT (i+k) starS

	indices = L.nub $ aux (-1) star where
		aux _ [] = []
		aux _ [x] = [x]
		aux v (x:xs)
			| x > v = x : aux (nextId x) xs
			| otherwise = aux v xs

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		[n, k] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		str <- getLine
		print $ result n k str
		loop $ t - 1
	loop t


The main walking trail in Geraldion is absolutely straight, and it passes strictly from the north to the south, it is so long that no one has ever reached its ends in either of the two directions. The Geraldionians love to walk on this path at any time, so the mayor of the city asked the Herald to illuminate this path with a few spotlights. The spotlights have already been delivered to certain places and Gerald will not be able to move them. Each spotlight illuminates a specific segment of the path of the given length, one end of the segment is the location of the spotlight, and it can be directed so that it covers the segment to the south or to the north of spotlight.The trail contains a monument to the mayor of the island, and although you can walk in either directions from the monument, no spotlight is south of the monument.You are given the positions of the spotlights and their power. Help Gerald direct all the spotlights so that the total length of the illuminated part of the path is as much as possible.

The first line contains integer n (1 ≤ n ≤ 100) — the number of spotlights. Each of the n lines contains two space-separated integers, ai and li (0 ≤ ai ≤ 108, 1 ≤ li ≤ 108). Number ai shows how much further the i-th spotlight to the north, and number li shows the length of the segment it illuminates. It is guaranteed that all the ai's are distinct.

Print a single integer — the maximum total length of the illuminated part of the path.

{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving, RecordWildCards, FlexibleContexts, TupleSections#-}
module Main where

import Data.Array.ST
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List (sort, find)
import Control.Monad.ST
import Data.Maybe
import Debug.Trace
--import System.Random

newtype Idx = Idx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype PIdx = PIdx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype Score = Score Int deriving (Eq, Ord, Show, Num)
data Token = LeftEnd | Middle | RightEnd deriving (Show, Eq, Ord)

data Point' = Point' {
  ptX' :: Int,
  ptIdx' :: Idx,
  ptToken' :: Token
} deriving (Show, Ord, Eq)

data Point = Point {
  ptX :: !Int,
  ptIdx :: !Idx,
  ptToken :: !Token,
  ptRightEnd :: !(Maybe PIdx)
} deriving (Eq, Show)

type PTArr s = STArray s PIdx Point

getX :: Point -> Int
getX = ptX

instance Ord Point where
  compare x y = compare (getX x) (getX y)

findMax :: PTArr s -> Maybe Idx -> PIdx -> Int -> ST s PIdx
findMax a excl fromIdx' curMax' = go fromIdx' curMax'
 where
   go fromIdx curMax = do
      (_,last) <- getBounds a
      if fromIdx > last then return (pred fromIdx) else do
        Point{..} <- readArray a fromIdx
        if ptX > curMax then return (pred fromIdx) else
          if ptToken /= Middle || Just ptIdx == excl then go (succ fromIdx) curMax else do
            Point{ ptX = newMax } <- readArray a (fromJust ptRightEnd)
            go (succ fromIdx) (max curMax newMax)

findRight :: PTArr s -> PIdx -> Idx -> ST s PIdx
findRight a from what = do
  Point{..} <- readArray a from
  if ptIdx == what then return from else findRight a (succ from) what

genPositions :: PTArr s -> PIdx -> PIdx -> Score -> ST s [(PIdx, PIdx, Score)]
genPositions a i j score = do
  (_,last) <- getBounds a
  if i == last then return [] else do
    if i == j then do
      Point{..} <- readArray a (succ i)
      case ptToken of
        LeftEnd -> do
          newj <- findRight a (succ $ succ i) ptIdx
          Point{ptX = newMax} <- readArray a (fromJust ptRightEnd)
          return [(succ i, newj, score + Score (newMax - ptX)), (succ i, succ i, score)]
        RightEnd -> return [(succ i, succ i, score)]
        Middle -> do
          newj <- findMax a Nothing (succ i) ptX
          Point{ ptX = newjRightEnd } <- readArray a newj
          genFromInterval a (succ i) newj newjRightEnd (score + Score (newjRightEnd - ptX))
    else do
      Point{ ptX = curMax, ptIdx = excl, ptToken = tokenTest } <- readArray a j
      when (tokenTest /= Middle) $ error $ "inconsistent state" ++ show (i, j)
      newj <- findMax a (Just excl) (succ i) curMax
      Point{ ptX = newMax } <- readArray a newj
      when ( newj < j ) $ error "newj should be >= j"
      genFromInterval a i newj newMax (score + Score (newMax - curMax))

genFromInterval :: PTArr s -> PIdx -> PIdx -> Int -> Score -> ST s [(PIdx, PIdx, Score)]
genFromInterval a i j curMax score = go i
 where
    go curi | curi <= j = do
       Point{..} <- readArray a curi
       if ptToken == LeftEnd then do
         Point{ ptX = newRight } <- readArray a (fromJust ptRightEnd)
         if newRight > curMax then
           ((j, fromJust ptRightEnd, score + Score (newRight - curMax)) :) <$> go (succ curi)
         else go (succ curi)
       else go (succ curi)
     | otherwise = return [(j, j, score)]

mkPoints :: (Int, Int, Int) -> [Point']
mkPoints (ai,li,i) = [Point' (ai - li) (Idx i) LeftEnd,
                      Point' ai (Idx i) Middle,
                      Point' (ai + li) (Idx i) RightEnd]
convertPoint :: Maybe PIdx -> Point' -> Point
convertPoint rightEnd Point'{..} = Point ptX' ptIdx' ptToken' rightEnd

ensureType :: STArray s (PIdx, PIdx) Score -> ST s ()
ensureType x = return ()

putPosition :: STArray s (PIdx, PIdx) Score -> (PIdx, PIdx, Score) -> ST s ()
putPosition a (i,j,s)= do
  oldScore <- readArray a (i,j)
  when (oldScore < s) $ writeArray a (i,j) s

--randomInput :: Int -> IO [(Int, Int, Int)]
--randomInput n = mapM (\i -> (,,i) <$> randomRIO (1,100000000) <*> randomRIO (1,100000000)) [1..n]

calc :: [(Int, Bool)] -> Int
calc = go 0 undefined
  where
    go _ pre [] = 0
    go 0 _ ((x, True):xs) = go 1 x xs
    go 0 _ ((x, False):xs) = undefined
    go n pre ((x, True):xs) = (x - pre) + go (n+1) x xs
    go n pre ((x, False):xs) = (x - pre) + go (n-1) x xs

genAll :: [(Int, Int, Int)] -> [[(Int, Bool)]]
genAll [] = [[]]
genAll ((a, l,_):xs) = do
  rec <- genAll xs
  h <- [[(a, True),(a + l, False)], [(a-l, True),(a, False)]]
  return $ h ++ rec

genAllSorted :: [(Int, Int, Int)] -> [[(Int, Bool)]]
genAllSorted = map sort . genAll

naive :: [(Int, Int, Int)] -> Int
naive = maximum . map calc . genAllSorted

main = do
 (n :: Int) <- read <$> getLine
 (inp :: [(Int, Int, Int)]) <- mapM (\i -> do
    [ai, li] <- map read . words <$> getLine
    return (ai, li, i)
    ) [1..n]
 --inp <- randomInput n
 --print inp

 let Score r =
       runST $ do
         let inpArr' :: Array PIdx Point' = listArray (PIdx 1,PIdx $ 3*n) $ sort $ concatMap mkPoints inp
             ass = assocs inpArr'
             points = map (\i ->
               let p@Point'{..} = inpArr' ! i
                   predic (j, Point'{ptX' = x', ptIdx' = idx'}) = ptIdx' == idx' && j > i
               in if ptToken' == RightEnd then convertPoint Nothing p
                  else convertPoint (fst <$> find predic ass) p
              ) rng
         a <- newListArray (PIdx 1, PIdx $ 3 * n) points
         res <- newListArray ((PIdx 1, PIdx 1), (PIdx (3*n), PIdx (3*n))) $ repeat (-1)
         initPos <- genPositions a (PIdx 0) (PIdx 0) 0
         mapM_ (putPosition res) initPos
         mapM_ (\(i, j) -> do
            s <- readArray res (i,j)
            when (s >= 0) $ do
              pos <- genPositions a i j s
              mapM_ (putPosition res) pos
          ) span
         readArray res (PIdx (3*n), PIdx (3*n))
     span = liftM2 (,) rng rng
     rng = [PIdx 1 .. PIdx (3*n)]
 print r
 --print $ naive inp
 --when (r /= naive inp) $ error "Mismatch"

{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving, RecordWildCards, FlexibleContexts, TupleSections#-}
module Main where

import Data.Array.ST
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List (sort, find)
import Control.Monad.ST
import Data.Maybe
import Debug.Trace
--import System.Random

newtype Idx = Idx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype PIdx = PIdx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype Score = Score Int deriving (Eq, Ord, Show, Num)
data Token = LeftEnd | Middle | RightEnd deriving (Show, Eq, Ord)

data Point' = Point' {
  ptX' :: Int,
  ptIdx' :: Idx,
  ptToken' :: Token
} deriving (Show, Ord, Eq)

data Point = Point {
  ptX :: !Int,
  ptIdx :: !Idx,
  ptToken :: !Token,
  ptRightEnd :: !(Maybe PIdx)
} deriving (Eq, Show)

type PTArr s = STArray s PIdx Point

getX :: Point -> Int
getX = ptX

instance Ord Point where
  compare x y = compare (getX x) (getX y)

findMax :: PTArr s -> Maybe Idx -> PIdx -> Int -> ST s PIdx
findMax a excl fromIdx' curMax' = go fromIdx' curMax'
 where
   go fromIdx curMax = do
      (_,last) <- getBounds a
      if fromIdx > last then return (pred fromIdx) else do
        Point{..} <- readArray a fromIdx
        if ptX > curMax then return (pred fromIdx) else
          if ptToken /= Middle || Just ptIdx == excl then go (succ fromIdx) curMax else do
            Point{ ptX = newMax } <- readArray a (fromJust ptRightEnd)
            go (succ fromIdx) (max curMax newMax)

findRight :: PTArr s -> PIdx -> Idx -> ST s PIdx
findRight a from what = do
  Point{..} <- readArray a from
  if ptIdx == what then return from else findRight a (succ from) what

genPositions :: PTArr s -> PIdx -> PIdx -> Score -> ST s [(PIdx, PIdx, Score)]
genPositions a i j score = do
  (_,last) <- getBounds a
  if i == last then return [] else do
    if i == j then do
      Point{..} <- readArray a (succ i)
      case ptToken of
        LeftEnd -> do
          newj <- findRight a (succ $ succ i) ptIdx
          Point{ptX = newMax} <- readArray a (fromJust ptRightEnd)
          return [(succ i, newj, score + Score (newMax - ptX)), (succ i, succ i, score)]
        RightEnd -> genPositions a (succ i) (succ i) score
        Middle -> do
          newj <- findMax a Nothing (succ i) ptX
          Point{ ptX = newjRightEnd } <- readArray a newj
          genFromInterval a (succ i) newj newjRightEnd (score + Score (newjRightEnd - ptX))
    else do
      Point{ ptX = curMax, ptIdx = excl, ptToken = tokenTest } <- readArray a j
      when (tokenTest /= Middle) $ error $ "inconsistent state" ++ show (i, j)
      newj <- findMax a (Just excl) (succ i) curMax
      Point{ ptX = newMax } <- readArray a newj
      when ( newj < j ) $ error "newj should be >= j"
      genFromInterval a i newj newMax (score + Score (newMax - curMax))

genFromInterval :: PTArr s -> PIdx -> PIdx -> Int -> Score -> ST s [(PIdx, PIdx, Score)]
genFromInterval a i j curMax score = go i
 where
    go curi | curi <= j = do
       Point{..} <- readArray a curi
       if ptToken == LeftEnd then do
         Point{ ptX = newRight } <- readArray a (fromJust ptRightEnd)
         if newRight > curMax then
           ((j, fromJust ptRightEnd, score + Score (newRight - curMax)) :) <$> go (succ curi)
         else go (succ curi)
       else go (succ curi)
     | otherwise = return [(j, j, score)]

mkPoints :: (Int, Int, Int) -> [Point']
mkPoints (ai,li,i) = [Point' (ai - li) (Idx i) LeftEnd,
                      Point' ai (Idx i) Middle,
                      Point' (ai + li) (Idx i) RightEnd]
convertPoint :: Maybe PIdx -> Point' -> Point
convertPoint rightEnd Point'{..} = Point ptX' ptIdx' ptToken' rightEnd

ensureType :: STArray s (PIdx, PIdx) Score -> ST s ()
ensureType x = return ()

putPosition :: STArray s (PIdx, PIdx) Score -> (PIdx, PIdx, Score) -> ST s ()
putPosition a (i,j,s)= do
  oldScore <- readArray a (i,j)
  when (oldScore < s) $ writeArray a (i,j) s

--randomInput :: Int -> IO [(Int, Int, Int)]
--randomInput n = mapM (\i -> (,,i) <$> randomRIO (1,100000000) <*> randomRIO (1,100000000)) [1..n]

main = do
 (n :: Int) <- read <$> getLine
 (inp :: [(Int, Int, Int)]) <- mapM (\i -> do
    [ai, li] <- map read . words <$> getLine
    return (ai, li, i)
    ) [1..n]
 --inp <- randomInput n
 --print inp

 let r :: Score =
       runST $ do
         let inpArr' :: Array PIdx Point' = listArray (PIdx 1,PIdx $ 3*n) $ sort $ concatMap mkPoints inp
             ass = assocs inpArr'
             points = map (\i ->
               let p@Point'{..} = inpArr' ! i
                   predic (j, Point'{ptX' = x', ptIdx' = idx'}) = ptIdx' == idx' && j > i
               in if ptToken' == RightEnd then convertPoint Nothing p
                  else convertPoint (fst <$> find predic ass) p
              ) rng
         a <- newListArray (PIdx 1, PIdx $ 3 * n) points
         res <- newListArray ((PIdx 1, PIdx 1), (PIdx (3*n), PIdx (3*n))) $ repeat (-1)
         initPos <- genPositions a (PIdx 0) (PIdx 0) 0
         mapM_ (putPosition res) initPos
         mapM_ (\(i, j) -> do
            s <- readArray res (i,j)
            when (s >= 0) $ do
              pos <- genPositions a i j s
              mapM_ (putPosition res) pos
          ) span
         readArray res (PIdx (3*n), PIdx (3*n))
     span = liftM2 (,) rng rng
     rng = [PIdx 1 .. PIdx (3*n)]
 print r

{-# LANGUAGE ScopedTypeVariables,GeneralizedNewtypeDeriving, RecordWildCards, FlexibleContexts, TupleSections#-}
module Main where

import Data.Array.ST
import Data.Array
import Control.Monad
import Control.Applicative
import Data.List (sort, find)
import Control.Monad.ST
import Data.Maybe
import Debug.Trace
--import System.Random

newtype Idx = Idx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype PIdx = PIdx Int deriving (Eq, Ord, Show, Ix, Enum)
newtype Score = Score Int deriving (Eq, Ord, Show, Num)
data Token = LeftEnd | Middle | RightEnd deriving (Show, Eq, Ord)

data Point' = Point' {
  ptX' :: Int,
  ptIdx' :: Idx,
  ptToken' :: Token
} deriving (Show, Ord, Eq)

data Point = Point {
  ptX :: !Int,
  ptIdx :: !Idx,
  ptToken :: !Token,
  ptRightEnd :: !(Maybe PIdx)
} deriving (Eq, Show)

type PTArr s = STArray s PIdx Point

getX :: Point -> Int
getX = ptX

instance Ord Point where
  compare x y = compare (getX x) (getX y)

findMax :: PTArr s -> Maybe Idx -> PIdx -> Int -> ST s PIdx
findMax a excl fromIdx' curMax' = go fromIdx' curMax'
 where
   go fromIdx curMax = do
      (_,last) <- getBounds a
      if fromIdx > last then return (pred fromIdx) else do
        Point{..} <- readArray a fromIdx
        if ptX > curMax then return (pred fromIdx) else
          if ptToken /= Middle || Just ptIdx == excl then go (succ fromIdx) curMax else do
            Point{ ptX = newMax } <- readArray a (fromJust ptRightEnd)
            go (succ fromIdx) (max curMax newMax)

findRight :: PTArr s -> PIdx -> Idx -> ST s PIdx
findRight a from what = do
  Point{..} <- readArray a from
  if ptIdx == what then return from else findRight a (succ from) what

genPositions :: PTArr s -> PIdx -> PIdx -> Score -> ST s [(PIdx, PIdx, Score)]
genPositions a i j score = do
  (_,last) <- getBounds a
  if i == last then return [] else do
    if i == j then do
      Point{..} <- readArray a (succ i)
      case ptToken of
        LeftEnd -> do
          newj <- findRight a (succ $ succ i) ptIdx
          Point{ptX = newMax} <- readArray a (fromJust ptRightEnd)
          return [(succ i, newj, score + Score (newMax - ptX)), (succ i, succ i, score)]
        RightEnd -> genPositions a (succ i) (succ i) score
        Middle -> do
          newj <- findMax a Nothing (succ i) ptX
          Point{ ptX = newjRightEnd } <- readArray a newj
          genFromInterval a (succ i) newj newjRightEnd (score + Score (newjRightEnd - ptX))
    else do
      Point{ ptX = curMax, ptIdx = excl, ptToken = tokenTest } <- readArray a j
      when (tokenTest /= Middle) $ error $ "inconsistent state" ++ show (i, j)
      newj <- findMax a (Just excl) (succ i) curMax
      Point{ ptX = newMax } <- readArray a newj
      when ( newj < j ) $ error "newj should be >= j"
      genFromInterval a i newj newMax (score + Score (newMax - curMax))

genFromInterval :: PTArr s -> PIdx -> PIdx -> Int -> Score -> ST s [(PIdx, PIdx, Score)]
genFromInterval a i j curMax score = go i
 where
    go curi | curi <= j = do
       Point{..} <- readArray a curi
       if ptToken == LeftEnd then do
         Point{ ptX = newRight } <- readArray a (fromJust ptRightEnd)
         if newRight > curMax then
           ((j, fromJust ptRightEnd, score + Score (newRight - curMax)) :) <$> go (succ curi)
         else go (succ curi)
       else go (succ curi)
     | otherwise = return [(j, j, score)]

mkPoints :: (Int, Int, Int) -> [Point']
mkPoints (ai,li,i) = [Point' (ai - li) (Idx i) LeftEnd,
                      Point' ai (Idx i) Middle,
                      Point' (ai + li) (Idx i) RightEnd]
convertPoint :: Maybe PIdx -> Point' -> Point
convertPoint rightEnd Point'{..} = Point ptX' ptIdx' ptToken' rightEnd

ensureType :: STArray s (PIdx, PIdx) Score -> ST s ()
ensureType x = return ()

putPosition :: STArray s (PIdx, PIdx) Score -> (PIdx, PIdx, Score) -> ST s ()
putPosition a (i,j,s)= do
  oldScore <- readArray a (i,j)
  when (oldScore < s) $ writeArray a (i,j) s

--randomInput :: Int -> IO [(Int, Int, Int)]
--randomInput n = mapM (\i -> (,,i) <$> randomRIO (1,100000000) <*> randomRIO (1,100000000)) [1..n]

main = do
 (n :: Int) <- read <$> getLine
 (inp :: [(Int, Int, Int)]) <- mapM (\i -> do
    [ai, li] <- map read . words <$> getLine
    return (ai, li, i)
    ) [1..n]
 --inp <- randomInput n
 --print inp

 let Score r =
       runST $ do
         let inpArr' :: Array PIdx Point' = listArray (PIdx 1,PIdx $ 3*n) $ sort $ concatMap mkPoints inp
             ass = assocs inpArr'
             points = map (\i ->
               let p@Point'{..} = inpArr' ! i
                   predic (j, Point'{ptX' = x', ptIdx' = idx'}) = ptIdx' == idx' && j > i
               in if ptToken' == RightEnd then convertPoint Nothing p
                  else convertPoint (fst <$> find predic ass) p
              ) rng
         a <- newListArray (PIdx 1, PIdx $ 3 * n) points
         res <- newListArray ((PIdx 1, PIdx 1), (PIdx (3*n), PIdx (3*n))) $ repeat (-1)
         initPos <- genPositions a (PIdx 0) (PIdx 0) 0
         mapM_ (putPosition res) initPos
         mapM_ (\(i, j) -> do
            s <- readArray res (i,j)
            when (s >= 0) $ do
              pos <- genPositions a i j s
              mapM_ (putPosition res) pos
          ) span
         readArray res (PIdx (3*n), PIdx (3*n))
     span = liftM2 (,) rng rng
     rng = [PIdx 1 .. PIdx (3*n)]
 print r


You are given a huge integer $$$a$$$ consisting of $$$n$$$ digits ($$$n$$$ is between $$$1$$$ and $$$3 \cdot 10^5$$$, inclusive). It may contain leading zeros.You can swap two digits on adjacent (neighboring) positions if the swapping digits are of different parity (that is, they have different remainders when divided by $$$2$$$). For example, if $$$a = 032867235$$$ you can get the following integers in a single operation:   $$$302867235$$$ if you swap the first and the second digits;  $$$023867235$$$ if you swap the second and the third digits;  $$$032876235$$$ if you swap the fifth and the sixth digits;  $$$032862735$$$ if you swap the sixth and the seventh digits;  $$$032867325$$$ if you swap the seventh and the eighth digits. Note, that you can't swap digits on positions $$$2$$$ and $$$4$$$ because the positions are not adjacent. Also, you can't swap digits on positions $$$3$$$ and $$$4$$$ because the digits have the same parity.You can perform any number (possibly, zero) of such operations.Find the minimum integer you can obtain.Note that the resulting integer also may contain leading zeros.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. The only line of each test case contains the integer $$$a$$$, its length $$$n$$$ is between $$$1$$$ and $$$3 \cdot 10^5$$$, inclusive. It is guaranteed that the sum of all values $$$n$$$ does not exceed $$$3 \cdot 10^5$$$.

For each test case print line — the minimum integer you can obtain.

NoteIn the first test case, you can perform the following sequence of operations (the pair of swapped digits is highlighted): $$$0 \underline{\textbf{70}} 9 \rightarrow 0079$$$.In the second test case, the initial integer is optimal. In the third test case you can perform the following sequence of operations: $$$246 \underline{\textbf{43}} 2 \rightarrow 24 \underline{\textbf{63}}42 \rightarrow 2 \underline{\textbf{43}} 642 \rightarrow 234642$$$.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = readInt >>= flip replicateM solve >>= mapM_ putStrLn

solve = do
	s <- getLine
	let
		evens = filter ( even . ord ) s
		odds  = filter ( odd  . ord ) s
	return $ merge evens odds

merge as [] = as
merge [] bs = bs
merge la@(a:as) lb@(b:bs)
	| a <= b = a : merge as lb
	| otherwise = b : merge la bs


By 2312 there were n Large Hadron Colliders in the inhabited part of the universe. Each of them corresponded to a single natural number from 1 to n. However, scientists did not know what activating several colliders simultaneously could cause, so the colliders were deactivated.In 2312 there was a startling discovery: a collider's activity is safe if and only if all numbers of activated colliders are pairwise relatively prime to each other (two numbers are relatively prime if their greatest common divisor equals 1)! If two colliders with relatively nonprime numbers are activated, it will cause a global collapse.Upon learning this, physicists rushed to turn the colliders on and off and carry out all sorts of experiments. To make sure than the scientists' quickness doesn't end with big trouble, the Large Hadron Colliders' Large Remote Control was created. You are commissioned to write the software for the remote (well, you do not expect anybody to operate it manually, do you?).Initially, all colliders are deactivated. Your program receives multiple requests of the form "activate/deactivate the i-th collider". The program should handle requests in the order of receiving them. The program should print the processed results in the format described below.To the request of "+ i" (that is, to activate the i-th collider), the program should print exactly one of the following responses:   "Success" if the activation was successful.  "Already on", if the i-th collider was already activated before the request.  "Conflict with j", if there is a conflict with the j-th collider (that is, the j-th collider is on, and numbers i and j are not relatively prime). In this case, the i-th collider shouldn't be activated. If a conflict occurs with several colliders simultaneously, you should print the number of any of them. The request of "- i" (that is, to deactivate the i-th collider), should receive one of the following responses from the program:   "Success", if the deactivation was successful.  "Already off", if the i-th collider was already deactivated before the request. You don't need to print quotes in the output of the responses to the requests.

The first line contains two space-separated integers n and m (1 ≤ n, m ≤ 105) — the number of colliders and the number of requests, correspondingly. Next m lines contain numbers of requests, one per line, in the form of either "+ i" (without the quotes) — activate the i-th collider, or "- i" (without the quotes) — deactivate the i-th collider (1 ≤ i ≤ n).

Print m lines — the results of executing requests in the above given format. The requests should be processed in the order, in which they are given in the input. Don't forget that the responses to the requests should be printed without quotes.

Success
Conflict with 6
Success
Already off
Success
Success
Success
Success
Conflict with 10
Already on

NoteNote that in the sample the colliders don't turn on after the second and ninth requests. The ninth request could also receive response "Conflict with 3".

import Char (ord)
import Control.Monad (liftM)
import Data.List (foldl')
import Data.Map (Map, (!), delete, empty, insert, member)
import Data.Set (Set, delete, empty, insert, member)

import qualified Data.Map as M
import qualified Data.Set as S

isPrime :: Int -> Bool
isPrime n  =  all (\x -> mod n x /= 0) $ takeWhile (\x -> x * x <= n) primes

primes :: [Int]
primes  =  2 : [n | n <- [3,5..], isPrime n]

factorize :: Int -> [Int]
factorize  =  factorize' primes
  where
    factorize' _ 1  =  []
    factorize' ps'@(p:ps) n
      | mod n p == 0  =  p : factorize' ps' (div n p)
      | p * p > n  =  [n]
      | otherwise  =  factorize' ps n

primesDivisors :: Int -> [Int]
primesDivisors  =  delEq . factorize
  where
    delEq []  =  []
    delEq [x]  =  [x]
    delEq (x:y:xs)
      | x == y  =  delEq (y:xs)
      | otherwise  =  x : (delEq (y:xs))

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

readQuery :: String -> Either Int Int
readQuery (c : ' ' : s)  =  readQuery' s (if c == '+' then Right else Left) 0
  where
    readQuery' [] f a  =  f a
    readQuery' (c:s) f a  =  readQuery' s f (10*a + ord c - ord '0')

data OnOff  =  On | Off
data Result  =  Success | Already OnOff | ConflictWith Int

instance Show Result
  where
    show Success  =  "Success"
    show (Already On)  =  "Already on"
    show (Already Off)  =  "Already off"
    show (ConflictWith n)  =  concat ["Conflict with ", show n]

findConflict :: Map Int Int -> [Int] -> Maybe Int
findConflict map divisors  =  findConflict' divisors
  where
    findConflict' []  =  Nothing
    findConflict' (d:ds)
      | M.member d map  =  Just (map ! d)
      | otherwise  =  findConflict' ds

solve :: [Either Int Int] -> [Result]
solve xs  =  solve' (M.empty, S.empty) xs
  where
    solve' _ []  =  []
    solve' (map, set) (Right n : xs)
      | S.member n set  =  Already On : (solve' (map, set) xs)
      | otherwise  =  case findConflict map divisors of
          Nothing  ->  Success : (solve' (map', set') xs)
          Just m   ->  ConflictWith m : (solve' (map, set) xs)
      where
        divisors  =  primesDivisors n
        map'  =  foldl (\map d -> M.insert d n map) map divisors
        set'  =  S.insert n set
    solve' (map, set) (Left n : xs)
      | S.member n set  =  Success : (solve' (map', set') xs)
      | otherwise  =  Already Off : (solve' (map, set) xs)
      where
        map'  =  foldl (\map d -> M.delete d map) map (primesDivisors n)
        set'  =  S.delete n set

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let [n, m]  =  map read $ words $ head lines'
    let qs  =  map readQuery $ take m $ tail lines'
    mapM_ print $ solve qs

import Data.List
import Data.IntMap(IntMap)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do _ <- getLine
          cis <- map ((\[x,y]->(B.head x,read' y)) . B.words) <$> B.lines <$> B.getContents
          putStr $ unlines $ solve cis

read' s = let Just (n,_) = B.readInt s in n

solve :: [(Char,Int)] -> [String]
solve cis = snd $ mapAccumL step state0 cis
   where state0 = IM.empty

step :: IntMap [Int] -> (Char,Int) -> (IntMap [Int], String)
step state ('+',n) = activate state n
step state ('-',n) = deactivate state n

activate :: IntMap [Int] -> Int -> (IntMap [Int], String)
activate state n = case IM.lookup p state of
 		     Just (x:xs)  -> if elem n (x:xs)
				      then (state, "Already on")
                                      else (state, "Conflict with "++(show x))
                     _ -> case isConflict ps of
		             Nothing -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                        in (state', "Success")
			     Just y -> (state, "Conflict with "++(show y))
  where (p:ps) = primeFactors n
        isConflict :: [Int] -> Maybe Int
	isConflict [] = Nothing
	isConflict (x:xs) = case IM.lookup x state of
	                      Just (y:_) -> Just y
			      _ -> isConflict xs

deactivate :: IntMap [Int] -> Int -> (IntMap [Int], String)
deactivate state n = case IM.lookup p state of
 		     Just xs  -> if elem n xs
			           then let state' = IM.unionWith del state $ IM.fromList . zip (p:ps) $ repeat [n]
			                in (state', "Success")
                                   else (state, "Already off")
                     _ -> (state, "Already off")
  where (p:ps) = primeFactors n
        del xs [y] = let (zs,(_:ws)) = span (y/=) xs
	             in zs++ws

primeFactors :: Int -> [Int]
primeFactors 1 = [1]
primeFactors n = primeFactors' n (2:[3,5..])
primeFactors' 1 _ = []
primeFactors' n (p:ps)
  | n < p*p = [n]
  | r == 0 = p:primeFactors' q (p:ps)
  | otherwise = primeFactors' n ps
  where (q,r) = divMod n p

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

factor x = factor' x 2
  where
    factor' x y
        | y * y > x      = if x /= 1 then [(x, 1)] else []
        | x `mod` y == 0 = (y, divTime) : (factor' divFinal (y+1))
        | otherwise      = factor' x (y+1)
        where
          divList = takeWhile ((==0) . snd) $ iterate (\(d,r) -> divMod d y) (x, 0)
          divTime = length divList - 1
          divFinal = fst $ last divList

flist :: [(Int, Int)] -> [Int]
flist [] = [1]
flist lt = map fst lt

type Request = (Char, Int)
type Status = IOUArray Int Int

process :: Status -> Request -> IO ()

process st ('+', num) = do
    let fts = flist $ factor num

    cur <- readArray st (head fts)
    if cur == num
      then putStrLn "Already on"
      else do
        chk <- forM fts $ readArray st
        if all (== 0) chk
          then do
            forM_ fts $ \x -> writeArray st x num
            putStrLn "Success"
          else putStrLn $ "Conflict with " ++ show (fromJust (find (/= 0) chk))

process st ('-', num) = do
    let fts = flist $ factor num

    cur <- readArray st (head fts)
    if cur /= num
      then putStrLn "Already off"
      else do
        forM_ fts $ \x -> writeArray st x 0
        putStrLn "Success"

main = do
    [n, m] <- liftM (map read . words) getLine

    st <- newArray (1, n) 0

    replicateM_ m $ do
        [[c], num] <- liftM words getLine
        process st (c, read num)

import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Control.Arrow
import Data.IntMap(IntMap, (!))
import Data.IntSet(IntSet)
import Data.List

primes :: [Int]
primes = 2 : filter (\c -> all (\p -> c `mod` p /= 0) (takeWhile (\p -> p * p <= c) primes)) [3..]

facts :: Integer -> [Int] -> Int -> [Int] -> [(Int, [Int])]
facts lim p@(h:t) c l | fromIntegral c > lim = []
                      | otherwise = tryH ++ tryT where
  tryH | fromIntegral h * fromIntegral c <= lim = [(h * c, h : l)] ++ facts lim p (h*c) (h : l)
       | otherwise = []
  tryT | fromIntegral h * fromIntegral c <= lim = facts (lim :: Integer) t c l
       | otherwise = []

cache :: IntMap IntSet
cache = Map.fromList $ map (second Set.fromList) $ (1,[]) : facts 100000 primes 1 []

factors :: Int -> [Int]
factors = Set.toList . (cache !)

type State = ( IntSet -- turned on
             , IntMap Int -- taken by
             )

step :: [String] -> State -> (State, String)
step ["+", ns] s@(on,taken)
  | Set.member n on = (s, "Already on")
  | not (null bad) = (s, "Conflict with " ++ show (taken ! head bad))
  | otherwise = ((Set.insert n on, Map.union taken (Map.fromList $ map (\x -> (x, n)) $ factors n)), "Success")
  where
    n = read ns
    bad = filter (`Map.member` taken) (factors n)
step ["-", ns] s@(on, taken)
  | not (Set.member n on) = (s, "Already off")
  | otherwise = ((Set.delete n on, Map.difference taken (Map.fromList $ map (\x -> (x, n)) $ factors n) ), "Success") where
    n = read ns

main = interact $ unlines . snd . mapAccumL (flip step) (Set.empty, Map.empty) . tail . map words . lines

import Data.List
import Data.IntMap(IntMap)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do _ <- getLine
          cis <- map ((\[x,y]->(B.head x,read' y)) . B.words) <$> B.lines <$> B.getContents
          putStr $ unlines $ solve cis

read' s = let Just (n,_) = B.readInt s in n

solve :: [(Char,Int)] -> [String]
solve cis = snd $ mapAccumL step state0 cis
   where state0 = IM.empty

step :: IntMap [Int] -> (Char,Int) -> (IntMap [Int], String)
step state ('+',n) = activate state n
step state ('-',n) = deactivate state n

activate :: IntMap [Int] -> Int -> (IntMap [Int], String)
activate state n = case IM.lookup p state of
                     Nothing -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                in (state', "Success")
                     Just [] -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                in (state', "Success")
		     Just (x:xs)  -> if elem n (x:xs)
				  then (state, "Already on")
                                  else (state, "Conflict with "++(show x))
  where (p:ps) = primeFactors n

deactivate :: IntMap [Int] -> Int -> (IntMap [Int], String)
deactivate state n = case IM.lookup p state of
                     Nothing -> (state, "Already off")
                     Just [] -> (state, "Already off")
		     Just (x:xs)  -> if elem n (x:xs)
				  then let state' = IM.unionWith del state $ IM.fromList . zip (p:ps) $ repeat [n]
				       in (state', "Success")
                                  else (state, "Already off")
  where (p:ps) = primeFactors n
        del xs [y] = let (zs,(_:ws)) = span (y/=) xs
	             in zs++ws

primeFactors :: Int -> [Int]
primeFactors 1 = [1]
primeFactors n = primeFactors' n (2:[3,5..])
primeFactors' 1 _ = []
primeFactors' n (p:ps)
  | n < p*p = [n]
  | r == 0 = p:primeFactors' q (p:ps)
  | otherwise = primeFactors' n ps
  where (q,r) = divMod n p


There are $$$n$$$ programmers that you want to split into several non-empty teams. The skill of the $$$i$$$-th programmer is $$$a_i$$$. You want to assemble the maximum number of teams from them. There is a restriction for each team: the number of programmers in the team multiplied by the minimum skill among all programmers in the team must be at least $$$x$$$.Each programmer should belong to at most one team. Some programmers may be left without a team.Calculate the maximum number of teams that you can assemble.

The first line contains the integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 10^5; 1 \le x \le 10^9$$$) — the number of programmers and the restriction of team skill respectively. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the skill of the $$$i$$$-th programmer. The sum of $$$n$$$ over all inputs does not exceed $$$10^5$$$.

For each test case print one integer — the maximum number of teams that you can assemble.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1  >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process ((n:x:[]) : as : rest) = solve x as : process rest

solve :: Int -> [Int] -> Int
solve x as = rec 0 1 $ sortBy (flip compare) as where
             rec c _ [] = c
             rec c pc (a:as) | pc*a >= x = rec (c+1) 1 as
                            | otherwise = rec c (pc+1) as

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, x] <- map read . words <$> getLine
  as <- reverse . sort . map read . words <$> getLine
  print $ solve 1 x as

solve c x (a : as)
  | c * a >= x = 1 + solve 1 x as
  | otherwise = solve (c + 1) x as
solve _ _ _ = 0