You are given string s. Let's call word any largest sequence of consecutive symbols without symbols ',' (comma) and ';' (semicolon). For example, there are four words in string "aba,123;1a;0": "aba", "123", "1a", "0". A word can be empty: for example, the string s=";;" contains three empty words separated by ';'.You should find all words in the given string that are nonnegative INTEGER numbers without leading zeroes and build by them new string a. String a should contain all words that are numbers separating them by ',' (the order of numbers should remain the same as in the string s). By all other words you should build string b in the same way (the order of numbers should remain the same as in the string s).Here strings "101", "0" are INTEGER numbers, but "01" and "1.0" are not.For example, for the string aba,123;1a;0 the string a would be equal to "123,0" and string b would be equal to "aba,1a".

The only line of input contains the string s (1 ≤ |s| ≤ 105). The string contains only symbols '.' (ASCII 46), ',' (ASCII 44), ';' (ASCII 59), digits, lowercase and uppercase latin letters.

Print the string a to the first line and string b to the second line. Each string should be surrounded by quotes (ASCII 34). If there are no words that are numbers print dash (ASCII 45) on the first line. If all words are numbers print dash on the second line.

NoteIn the second example the string s contains five words: "1", "", "01", "a0", "".

import Text.Printf
import Data.List
import Data.Char

main = do
    s <- getLine
    let (nums, other) = solve (splitWhen (\c -> c == ',' || c == ';') s)
    printf "%s\n%s\n" (pad nums) (pad other)

pad :: [String] -> String
pad [] = "-"
pad xs = "\"" ++ (intercalate "," xs) ++ "\""

solve :: [String] -> ([String], [String])
solve [] = ([], [])
solve (x:xs)
    | isNonNegativeNumber x = let (nums,rest) = solve xs in (x:nums, rest)
    | otherwise  = let (nums,rest) = solve xs in (nums, x:rest)

isNonNegativeNumber :: String -> Bool
isNonNegativeNumber [] = False
isNonNegativeNumber "0" = True
isNonNegativeNumber s  = let (lead,rest) = span (\c -> c == '0') s
                             (_,junk) = span isDigit rest
                         in lead == [] && junk == []

splitWhen :: Eq a => (a -> Bool) -> [a] -> [[a]]
splitWhen _ [] = [[]]
splitWhen f xs = let (prefix,rest) = span (\y -> not (f y)) xs in if rest /= [] then prefix:(splitWhen f (drop 1 rest)) else [prefix]

import Data.List
import Data.List.Split
import Data.Char

main = do
    s <- getLine
    let
        l = splitOneOf ",;" s
        a = filter check l
        b = filter (not . check) l
        check s = s == "0" || (not (null s) && head s /= '0' && all isDigit s)

    if null a then putStrLn "-" else print (intercalate "," a)
    if null b then putStrLn "-" else print (intercalate "," b)

import Control.Arrow
import Data.Char
import Data.List

main = interact $ f . mySplit . filter (/= '\n')

mySplit [] = [[]]
mySplit s = let (x, y) = span (\c -> c /= ',' && c /= ';') s in if null y then [x] else x : mySplit (tail y)

f ws = let (w1, w2) = partition (\s -> if null s then False else s == "0" || (head s /= '0' && all isDigit s)) ws in (g w1) ++ "\n" ++ (g w2)
g w = if null w then "-" else (show . concat $ intersperse "," w)

{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isDigit)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

extract :: ByteString -> (ByteString, ByteString)
extract s0  = go s0 [] [] False False
  where
    isOK c = c /= ';' && c /= ','
    go s xs ys last_empty has_empty
      | BS.null s =
          let ys' | last_empty = "":ys | otherwise = ys
              as = BS.intercalate "," (reverse xs)
              bs = BS.intercalate "," (reverse ys')
              as' | BS.null as = "-" | otherwise = surround '"' as
              bs' | BS.null bs && not has_empty && not last_empty = "-" | otherwise = surround '"' bs
          in (as', bs')
      | not (BS.null wd)
        && (BS.head wd /= '0' || BS.length wd == 1)
        && BS.all isDigit wd = go rest (wd:xs) ys last_empty' has_empty
      | otherwise = go rest xs (wd:ys) last_empty' (has_empty || BS.null wd)
      where
        (wd, rest') = BS.span isOK s
        last_empty' = rest' == "," || rest' == ";"
        rest | BS.null rest' = rest'
             | otherwise = BS.tail rest'

surround :: Char -> ByteString -> ByteString
surround c bs = BS.cons c (BS.snoc bs c)

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  s <- BS.getLine
  let (xs, ys) = extract (darnit s)
  BS.putStrLn xs
  BS.putStrLn ys

-- A. Exact Numbers

import Data.Char(isDigit)
import Data.List(intercalate)

split :: String -> [String]
split []      = [""]
split (',':t) = "" : split t
split (';':t) = "" : split t
split (h:t)   = (h : (head . split) t) : (tail . split) t

isInteger :: String -> Bool
isInteger x = all isDigit x && (not . null) x && x == show (read x :: Integer)

myConcat :: [String] -> String
myConcat [] = "-"
myConcat x = '\"' : (intercalate "," x) ++ "\""

process :: String -> (String, String)
process x = (myConcat (filter isInteger (split x)), myConcat (filter (not . isInteger) (split x)))

main :: IO()
main =
    do  line <- getLine
        let (a, b) = process line
        putStrLn a
        putStrLn b
        return ()

import Data.List

main = do
    s <- getLine
    let ns = split s
        (nums, other) = partition isNum ns
    putStrLn $ if null nums then "-" else show $ intercalate "," nums
    putStrLn $ if null other then "-" else show $ intercalate "," other

split :: String -> [String]
split
    = foldr (\v (a : as) ->
        if v `elem` delim then [] : a : as else (v : a) : as) [[]]
    where delim = ",;"

isNum :: String -> Bool
isNum []
    = False
isNum "0"
    = True
isNum (x : xs)
    = isDigit x && x /= '0' && all isDigit xs

isDigit :: Char -> Bool
isDigit c
    = '0' <= c && c <= '9'

sol a b
    | a `mod` b == 0 = a `div` b
    | otherwise = a `div` b + sol b (a `mod` b)

import Data.List

main = do
    s <- getLine
    let ns = split s
        (nums, other) = partition isNum ns
    putStrLn $ if null nums then "-" else show $ intercalate "," nums
    putStrLn $ if null other then "-" else show $ intercalate "," other
    where isNum []
            = False
          isNum "0"
              = True
          isNum (x : xs)
              = isDigit x && x /= '0' && all isDigit xs
          isDigit c
              = '0' <= c && c <= '9'

split
    = foldr (\v (a : as) ->
        if v `elem` delim then [] : a : as else (v : a) : as) [[]]
    where delim = ",;"

import Data.List

main = do
	s <- getLine >>= return.split
	putStrLn $ display $ filter isNumber s
	putStrLn $ display $ filter (not.isNumber) s

display [] = "-"
display x = "\""++(concat $ intersperse "," x)++"\""

isNumber "0" = True
isNumber x = isNumber' False x

isNumber' ok [] = ok
isNumber' ok (x:xs)
	| x=='0'			= if ok then isNumber' ok xs else False
	| x`elem`['1'..'9'] = isNumber' True xs
	| otherwise 		= False

split = split' ""

split' :: String -> String -> [String]
split' cur [] = [reverse cur]
split' cur (x:xs)
	| x`elem`";," = (reverse cur):(split' "" xs)
	| otherwise   = split' (x:cur) xs

import Data.List

main = do
	s <- getLine
	let ss = sp "" s
	putStrLn $ display $ filter isNum ss
	putStrLn $ display $ filter (not.isNum) ss

display [] = "-"
display x = "\"" ++ (concat $ intersperse "," x) ++ "\""

isNum "0" = True
isNum x
	|	x==""	= False
	|	head x=='0'	=	False
	|	otherwise = all (\y -> y `elem` ['0'..'9']) x

sp x [] = [reverse x]
sp x (y:ys)
	| y==',' || y==';'	= (reverse x) : (sp "" ys)
	| otherwise			= sp (y:x) ys

import Text.Printf
import Data.List
import Data.Char

main = do
    s <- getLine
    let (nums, other) = solve (splitWhen (\c -> c == ',' || c == ';') s)
    printf "%s\n%s\n" (pad nums) (pad other)

pad :: [String] -> String
pad [] = "-"
pad xs = "\"" ++ (intercalate "," xs) ++ "\""

solve :: [String] -> ([String], [String])
solve [] = ([], [])
solve (x:xs)
    | isNonNegativeNumber x = let (nums,rest) = solve xs in (x:nums, rest)
    | otherwise  = let (nums,rest) = solve xs in (nums, x:rest)

isNonNegativeNumber :: String -> Bool
isNonNegativeNumber [] = False
isNonNegativeNumber "0" = True
isNonNegativeNumber s  = let (lead,rest) = span (\c -> c == '0') s
                             (_,junk) = span isDigit rest
                         in lead == [] && junk == []

splitWhen :: Eq a => (a -> Bool) -> [a] -> [[a]]
splitWhen _ [] = []
splitWhen f xs = let (prefix,rest) = span (\y -> not (f y)) xs in if rest /= [] then prefix:(splitWhen f (drop 1 rest)) else [prefix]

{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isDigit)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

extract :: ByteString -> (ByteString, ByteString)
extract s0  = (as', bs')
  where
    isOK c = c /= ';' && c /= ','
    (as, bs) = go s0 [] []
    as' | BS.null as = "-" | otherwise = surround '"' as
    bs' | BS.null bs = "-" | otherwise = surround '"' bs
    go s xs ys
      | BS.null s = (BS.intercalate "," (reverse xs), BS.intercalate "," (reverse ys))
      | not (BS.null wd)
        && (BS.head wd /= '0' || BS.length wd == 1)
        && BS.all isDigit wd = go rest (wd:xs) ys
      | otherwise = go rest xs (wd:ys)
      where
        (wd, rest') = BS.span isOK s
        rest | BS.null rest' = rest' | otherwise = BS.tail rest'

surround :: Char -> ByteString -> ByteString
surround c bs = BS.cons c (BS.snoc bs c)

main :: IO ()
main = do
  s <- BS.getLine
  let (xs, ys) = extract s
  BS.putStrLn xs
  BS.putStrLn ys

{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isDigit)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

extract :: ByteString -> (ByteString, ByteString)
extract s0  = go s0 [] [] False
  where
    isOK c = c /= ';' && c /= ','
    go s xs ys last_empty
      | BS.null s =
          let ys' | last_empty = "":ys | otherwise = ys
              as = BS.intercalate "," (reverse xs)
              bs = BS.intercalate "," (reverse ys')
              as' | BS.null as = "-" | otherwise = surround '"' as
              bs' | BS.null bs && not last_empty = "-" | otherwise = surround '"' bs
          in (as', bs')
      | not (BS.null wd)
        && (BS.head wd /= '0' || BS.length wd == 1)
        && BS.all isDigit wd = go rest (wd:xs) ys last_empty'
      | otherwise = go rest xs (wd:ys) last_empty'
      where
        (wd, rest') = BS.span isOK s
        last_empty' = rest' == "," || rest' == ";"
        rest | BS.null rest' = rest'
             | otherwise = BS.tail rest'

surround :: Char -> ByteString -> ByteString
surround c bs = BS.cons c (BS.snoc bs c)

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  s <- BS.getLine
  let (xs, ys) = extract (darnit s)
  BS.putStrLn xs
  BS.putStrLn ys

{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isDigit)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

extract :: ByteString -> (ByteString, ByteString)
extract s0  = go s0 [] [] False False
  where
    isOK c = c /= ';' && c /= ','
    go s xs ys last_empty has_empty
      | BS.null s =
          let ys' | last_empty = "":ys | otherwise = ys
              as = BS.intercalate "," (reverse xs)
              bs = BS.intercalate "," (reverse ys')
              as' | BS.null as = "-" | otherwise = surround '"' as
              bs' | BS.null bs && not has_empty = "-" | otherwise = surround '"' bs
          in (as', bs')
      | not (BS.null wd)
        && (BS.head wd /= '0' || BS.length wd == 1)
        && BS.all isDigit wd = go rest (wd:xs) ys last_empty' has_empty
      | otherwise = go rest xs (wd:ys) last_empty' (has_empty || BS.null wd)
      where
        (wd, rest') = BS.span isOK s
        last_empty' = rest' == "," || rest' == ";"
        rest | BS.null rest' = rest'
             | otherwise = BS.tail rest'

surround :: Char -> ByteString -> ByteString
surround c bs = BS.cons c (BS.snoc bs c)

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  s <- BS.getLine
  let (xs, ys) = extract (darnit s)
  BS.putStrLn xs
  BS.putStrLn ys

{-# LANGUAGE OverloadedStrings #-}
import Data.Char (isDigit)
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

extract :: ByteString -> (ByteString, ByteString)
extract s0  = (as', bs')
  where
    isOK c = c /= ';' && c /= ','
    (as, bs) = go s0 [] [] False
    as' | BS.null as = "-" | otherwise = surround '"' as
    bs' | BS.null bs = "-" | otherwise = surround '"' bs
    go s xs ys last_empty
      | BS.null s && last_empty = fmap (`BS.snoc` ',') (go "" xs ys False)
      | BS.null s = (BS.intercalate "," (reverse xs), BS.intercalate "," (reverse ys))
      | not (BS.null wd)
        && (BS.head wd /= '0' || BS.length wd == 1)
        && BS.all isDigit wd = go rest (wd:xs) ys last_empty'
      | otherwise = go rest xs (wd:ys) last_empty'
      where
        (wd, rest') = BS.span isOK s
        last_empty' = rest' == "," || rest' == ";"
        rest | BS.null rest' = rest'
             | otherwise = BS.tail rest'

surround :: Char -> ByteString -> ByteString
surround c bs = BS.cons c (BS.snoc bs c)

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  s <- BS.getLine
  let (xs, ys) = extract (darnit s)
  BS.putStrLn xs
  BS.putStrLn ys

import Data.List

main = do
	s <- getLine >>= return.split
	putStrLn $ display $ filter isNumber s
	putStrLn $ display $ filter (not.isNumber) s

display [] = "-"
display x = "\""++(concat $ intersperse "," x)++"\""

isNumber "0" = True
isNumber x = isNumber' False x

isNumber' ok [] = ok
isNumber' ok (x:xs)
	| x=='0'			= if ok then isNumber' ok xs else False
	| x`elem`['1'..'9'] = isNumber' True xs
	| otherwise 		= False

split = split' ""

split' :: String -> String -> [String]
split' cur [] = [cur]
split' cur (x:xs)
	| x`elem`";," = (reverse cur):(split' "" xs)
	| otherwise   = split' (x:cur) xs

main = do
	s <- getLine
	let f = gg [] s ""
	let a = gi [] [] f
	if head a == []
	then
		putStrLn "-"
	else
		putStrLn $ ['"'] ++ (foldl (\x y -> x ++ [','] ++ y) (head $ head $ a) (tail  $ head $ a)) ++ ['"']
	if last	a == []
	then
		putStrLn "-"
	else
		putStrLn $ ['"'] ++ (foldl (\x y -> x ++ [','] ++ y) (head $ last $  a) (tail $ last $  a) )++ ['"']

gi x z [] = [x,z]
gi x z (y:ys)
	| y == "" = gi x (z++[y]) ys
	| head y == '0' && y/="0" = gi x (z++[y]) ys
	| all (\x -> x `elem` ['0','1','2','3','4','5','6','7','8','9']) y == True = gi (x ++ [y]) z ys
	| otherwise = gi x (z++[y]) ys

gg x [] z
	|	z==[]	=	x
	|	otherwise = x ++ [z]
gg x (y:ys)	z
	|	y==',' || y==';'	= gg (x ++ [z]) ys []
	|	otherwise			= gg x ys (z++[y])

main = do
	s <- getLine
	let f = gg [] s ""
	let a = gi [] [] f
	if head a == []
	then
		putStrLn "\45"
	else
		putStrLn $ ['"'] ++ (foldl (\x y -> x ++ [','] ++ y) (head $ head $ a) (tail  $ head $ a)) ++ ['"']
	if last	a == []
	then
		putStrLn "\45"
	else
		putStrLn $ ['"'] ++ (foldl (\x y -> x ++ [','] ++ y) (head $ last $  a) (tail $ last $  a) )++ ['"']

gi x z [] = [x,z]
gi x z (y:ys)
	| y == "" = gi x (z++[y]) ys
	| head y == '0' && y/="0" = gi x (z++[y]) ys
	| all (\x -> x `elem` ['0','1','2','3','4','5','6','7','8','9']) y == True = gi (x ++ [y]) z ys
	| otherwise = gi x (z++[y]) ys

gg x [] z
	|	z==[]	=	x
	|	otherwise = x ++ [z]
gg x (y:ys)	z
	|	y==',' || y==';'	= gg (x ++ [z]) ys []
	|	otherwise			= gg x ys (z++[y])


You are given a integer $$$n$$$ ($$$n > 0$$$). Find any integer $$$s$$$ which satisfies these conditions, or report that there are no such numbers:In the decimal representation of $$$s$$$:   $$$s > 0$$$,  $$$s$$$ consists of $$$n$$$ digits,  no digit in $$$s$$$ equals $$$0$$$,  $$$s$$$ is not divisible by any of it's digits.

The input consists of multiple test cases. The first line of the input contains a single integer $$$t$$$ ($$$1 \leq t \leq 400$$$), the number of test cases. The next $$$t$$$ lines each describe a test case. Each test case contains one positive integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$). It is guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$10^5$$$.

For each test case, print an integer $$$s$$$ which satisfies the conditions described above, or "-1" (without quotes), if no such number exists. If there are multiple possible solutions for $$$s$$$, print any solution.

f :: Int -> String
f 1 = "-1"
f n =
  let a = replicate (n - 1) 5 ++ [3]
      b = replicate (n - 2) 5 ++ [3, 3]
  in  if sum a `mod` 3 /= 0 then concatMap show a else concatMap show b

main = interact $ unlines . map (f . read) . tail . lines

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

main = getLine >>= test.read
test 0 = return ()
test i = do
  n <- read <$> getLine
  if n == 1
    then print $ -1
    else putStrLn $ replicate (n - 1) '5' ++ "8"
  test (i - 1)

import Control.Monad (replicateM_)

main = readLn >>= flip replicateM_ (readLn >>= print . f)

f :: Int -> Integer
f 1 = -1
f n = read $ "2" ++ replicate (n-1) '7'

module Main where

import Control.Monad

generator :: Int -> String
generator n | n <= 1         = "-1"
            | n `mod` 3 == 1 = (take m $ repeat '9') ++ "8"
            | otherwise      = (take m $ repeat '8') ++ "3"
    where m = n - 1

readInt :: IO Int
readInt = read <$> getLine

main :: IO ()
main = do
    n <- readInt
    s <- replicateM n $ readInt
    let s' = generator <$> s
    forM_ s' putStrLn

import Control.Monad

main = do
    numTests <- readLn
    inputs <- replicateM numTests readLn
    mapM_ (putStrLn . ans) inputs

ans :: Int -> String
ans 1 = "-1"
ans n = '2' : (replicate (n - 1) '3')


You are given sequence a1, a2, ..., an and m queries lj, rj (1 ≤ lj ≤ rj ≤ n). For each query you need to print the minimum distance between such pair of elements ax and ay (x ≠ y), that:  both indexes of the elements lie within range [lj, rj], that is, lj ≤ x, y ≤ rj;  the values of the elements are equal, that is ax = ay. The text above understands distance as |x - y|.

The first line of the input contains a pair of integers n, m (1 ≤ n, m ≤ 5·105) — the length of the sequence and the number of queries, correspondingly.  The second line contains the sequence of integers a1, a2, ..., an ( - 109 ≤ ai ≤ 109).  Next m lines contain the queries, one per line. Each query is given by a pair of numbers lj, rj (1 ≤ lj ≤ rj ≤ n) — the indexes of the query range limits.

Print m integers — the answers to each query. If there is no valid match for some query, please print -1 as an answer to this query.

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as M

main :: IO ()
main = do
  (n:m:_) <- readInts
  a <- readInts
  b <- forM [1..m] $ \i -> do
    (l:r:_) <- readInts
    return $ (r, ((l, i):))
  let q = force [(i, e []) | (i, e) <- assocs $ accumArray (.) id (1, n) b]
      r = gao M.empty M.empty (zip a q) []
      ans = elems $ array (1, m) r
  putStr $ unlines $ map show ans
  where
  readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine
  gao _ _ [] ans = ans
  gao !dist !prev ((k, (r, q)): t) ans = gao dist' prev' t $ go q ans
    where
    prev' = M.insert k r prev
    dist' = case M.lookup k prev of
      Just l -> insert l (r-l) dist
      Nothing -> dist
    go [] ret = ret
    go ((l, i): q') ret = go q' $ (i, minDist): ret
      where
      minDist = case M.lookupGE l dist' of
        Just (_, v) -> v
        Nothing -> -1
  insert !k !v !dist = case M.lookupGE k dist of
    Just (_, v') | v' <= v -> dist
    _ -> M.insert k v $ strip dist
    where
    strip m = case M.lookupLE k m of
      Just (k', v') | v' >= v -> strip $ M.delete k' m
      _ -> m

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as M

main :: IO ()
main = do
  (n:m:_) <- readInts
  a <- readInts
  q <- forM [1..m] $ \i -> do
    (l:r:_) <- readInts
    return $ (r, (l, i))
  let ans = gao M.empty M.empty (zip [1..] a) (sort q) []
  putStr $ unlines [show i | (_, i) <- sort ans]
  where
  readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine
  gao _ _ [] _ ans = ans
  gao _ _ _ [] ans = ans
  gao !dist !prev ((i, k): a') q ans = gao dist' prev' a' q' ans'
    where
    prev' = M.insert k i prev
    dist' = case M.lookup k prev of
      Just j -> insert j (i-j) dist
      Nothing -> dist
    (q', ans') = go q ans
    go ((r, (l, t)): q') ans | r == i = case M.lookupGE l dist of
      Just (_, v) -> go q' $ (t, v): ans
      Nothing -> go q' $ (t, -1): ans
    go q ans = (q, ans)
  insert !k !v !dist = case M.lookupGE k dist of
    Just (_, v') | v' <= v -> dist
    _ -> M.insert k v $ strip dist
    where
    strip m = case M.lookupLE k m of
      Just (k', v') | v' >= v -> strip $ M.delete k' m
      _ -> m


There is a field divided into $$$n$$$ rows and $$$m$$$ columns. Some cells are empty (denoted as E), other cells contain robots (denoted as R).You can send a command to all robots at the same time. The command can be of one of the four types:  move up;  move right;  move down;  move left. When you send a command, all robots at the same time attempt to take one step in the direction you picked. If a robot tries to move outside the field, it explodes; otherwise, every robot moves to an adjacent cell in the chosen direction.You can send as many commands as you want (possibly, zero), in any order. Your goal is to make at least one robot reach the upper left corner of the field. Can you do this without forcing any of the robots to explode?

The first line contains one integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. Each test case starts with a line containing two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 5$$$) — the number of rows and the number of columns, respectively. Then $$$n$$$ lines follow; each of them contains a string of $$$m$$$ characters. Each character is either E (empty cell} or R (robot). Additional constraint on the input: in each test case, there is at least one robot on the field.

If it is possible to make at least one robot reach the upper left corner of the field so that no robot explodes, print YES. Otherwise, print NO.

6

1 3

ERR

2 2

ER

RE

2 2

ER

ER

1 1

R

4 3

EEE

EEE

ERR

EER

3 3

EEE

EER

REE

NoteExplanations for test cases of the example:  in the first test case, it is enough to send a command to move left.  in the second test case, if you try to send any command, at least one robot explodes.  in the third test case, it is enough to send a command to move left.  in the fourth test case, there is already a robot in the upper left corner.  in the fifth test case, the sequence "move up, move left, move up" leads one robot to the upper left corner;  in the sixth test case, if you try to move any robot to the upper left corner, at least one other robot explodes.

module Main
where

import           Data.List (words, all, intercalate)

main :: IO ()
main = intercalate "\n" <$> map yesNo <$> map feasible <$> (read <$> getLine >>= readNCordFields) >>= putStrLn

data Square = E | R deriving (Show, Read, Eq)
type Field = [[Square]]

  {- stdin section -}
    {- all functions trust on stdin validity -}

readNCordFields :: Int -> IO [Field]
readNCordFields n = sequence $ replicate n readOneCordField

readOneCordField :: IO Field
readOneCordField = readField <$> (fst <$> readCord <$> getLine >>= readNLines)

readNLines :: Int -> IO [String]
readNLines n = sequence $ replicate n getLine

readCord :: String -> (Int, Int)
readCord str = toPair $ map (read) $ words str

readField :: [String] -> Field
readField [] = []
readField (x:xs) = (readln x):(readField xs)
  where readln :: [] Char -> [] Square
        readln str = (read . singleton) <$> str

  {- Parsing field section -}

-- constrain: must be >= 1 robot on the field
feasible :: Field -> Bool
feasible f
  | topLeftR f = True
  | topE f = feasible (noTop f)
  | leftmostE f = feasible (noLeftmost f)
  | otherwise = False

noLeftmost :: Field -> Field
noLeftmost f = (drop 1) <$> f

leftmostE :: Field -> Bool
leftmostE f = all (\ln -> ln !! 0 == E) f

noTop :: Field -> Field
noTop f = drop 1 f

topE :: Field -> Bool
topE f = all (== E) $ f !! 0

topLeftR :: Field -> Bool
topLeftR f = f !! 0 !! 0 == R

  {- Output fmt section -}

yesNo :: Bool -> String
yesNo True = "YES"
yesNo False = "NO"

  {- util functions section -}

toPair :: [a] -> (a, a)
toPair [x, y] = (x, y)
toPair _      = undefined

singleton :: a -> [a]
singleton a = [a]

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> Int -> UA.UArray (Int, Int) Char -> Bool
solve n m arr = (arr UA.! (minI, minJ)) == 'R'
    where
        rIndexes = L.map fst . L.filter (\(i, e) -> e == 'R') $ UA.assocs arr
        (minI, minJ) = foldr (\(minI, minJ) (i, j) -> (min i minI, min j minJ)) (n - 1, m - 1) rIndexes

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> readIntB8s
        arr <- MA.newArray ((0, 0), (n - 1, m - 1)) '_' :: IO (IOA.IOArray (Int, Int) Char)
        forM_ [0 .. n - 1] $ \i -> do
            line <- B8.getLine <&> B8.filter (\c -> c `L.elem` ['R', 'E'])
            forM_ [0 .. m - 1] $ \j -> do
                MA.writeArray arr (i, j) (line `B8.index` j)
        farr <- MA.freeze arr

        let answer = solve n m farr
        putsYesNo answer

indexOf :: Char -> [Char] -> Int
indexOf k a = search 0 k a
 where
  search _ _ [] = (-1)
  search i k (x : xs)
   | (k == x) = i
   | otherwise = search (i + 1) k xs

readLine = do
 input <- getLine
 return input

ans = do
 nmInput <- getLine
 let (n : m : []) = [read x :: Int | x <- words nmInput]
 grid <- sequence (replicate n readLine)
 let pos = [indexOf 'R' line | line <- grid]
 let (first : rest) = [x | x <- pos, x > (-1)]
 let beforeFirst = [x | x <- rest, x < first]
 let result = if (length beforeFirst > 0) then "NO" else "YES"
 return result

main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (unwords results)


You are given an array $$$a$$$ consisting of $$$n$$$ integers.In one move, you can choose two indices $$$1 \le i, j \le n$$$ such that $$$i \ne j$$$ and set $$$a_i := a_j$$$. You can perform such moves any number of times (possibly, zero). You can choose different indices in different operations. The operation := is the operation of assignment (i.e. you choose $$$i$$$ and $$$j$$$ and replace $$$a_i$$$ with $$$a_j$$$).Your task is to say if it is possible to obtain an array with an odd (not divisible by $$$2$$$) sum of elements.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of test cases. The next $$$2t$$$ lines describe test cases. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2000$$$) — the number of elements in $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 2000$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$ ($$$\sum n \le 2000$$$).

For each test case, print the answer on it — "YES" (without quotes) if it is possible to obtain the array with an odd sum of elements, and "NO" otherwise.

import Control.Monad

getInts = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- getInts
    replicateM_ t $ do
        [n] <- getInts
        a <- getInts
        if all even a || (even n && all odd a)
            then putStrLn "NO"
            else putStrLn "YES"

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

solve :: [Int] -> Bool
solve xs
    | odd $ sum xs  = True
    | otherwise = not $ null e || null o
    where
        (e, o) = L.partition even xs

solvetc :: Int -> IO ()
solvetc 0 = do return ()

solvetc t = do
    n <- getLine
    xs <- getLine
    let ans = solve . map read . words $ xs
    putStrLn $ id (if ans == True then "YES" else "NO")
    solvetc(t - 1)

main = do
    t <- getLine
    solvetc (read t)

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

process a c d | odd a && c==a = "YES"
	      | c==a || d==a = "NO"
	      | otherwise = "YES"

onecase = do
		n<- read <$> getLine::IO Int
		a<- map read <$> words <$> getLine ::IO [Int]
		let c = length $ filter odd a
		let d= length $ filter even a
		putStrLn $ process n c d

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

process:: [Int] -> String
process xs
    | all even xs = "NO"
    | all odd (length xs+1:xs) = "NO"
    | otherwise = "YES"

readInt :: String -> Int
readInt = read

readCases :: [String] -> [[Int]]
readCases (n:a:xs) = map readInt (words a):readCases xs
readCases _ = []

main :: IO ()
main = do
    t <- fmap readInt getLine
    as <- fmap (readCases . lines) getContents
    putStrLn . unlines $ map process as

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

sol :: [Int] -> [Char]
sol xx | odd $ sum xx = "YES"
       | any (odd) xx && any (even) xx = "YES"
       | otherwise = "NO"

loop :: Int -> IO ()
loop 0 = return ()
loop n = do
  i_dont_care <- getLine
  inputs <- readInts
  putStrLn $ sol inputs
  loop $ n - 1

main = do
  input1 <- getLine
  let t = (read input1 :: Int)
  loop t

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

sol :: [Int] -> [Char]
sol xx | odd len && any (odd) xx = "YES"
       | even len && any (odd) xx && any (even) xx = "YES"
       | otherwise = "NO"
  where len = length xx

loop 0 = return ()
loop n = do
  i_dont_care <- getLine
  inputs <- readInts
  putStrLn $ sol inputs
  loop $ n - 1

main = do
  input1 <- getLine
  let t = (read input1 :: Int)
  loop t

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

onecase = do
		getLine
		a<- map read <$> words <$> getLine ::IO [Int]
		let c = take 1 $ filter odd a
		putStrLn $ if length c==1 then "YES" else "NO"

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

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

onecase = do
		n<- read <$> getLine::IO Int
		a<- map read <$> words <$> getLine ::IO [Int]
		let c = length $ filter odd a
		let d= length $ filter even a
		putStrLn $ if (c==n || d==n)  then "NO" else "YES"

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

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

sol :: [Int] -> [Char]
sol xx | odd len && any (odd) xx = "YES"
       | even len && any (odd) xx && any (even) xx = "YES"
       | otherwise = "NO"
  where len = length xx

main = do
  inputs <- readInts
  putStrLn $ sol inputs


Arkady's code contains $$$n$$$ variables. Each variable has a unique name consisting of lowercase English letters only. One day Arkady decided to shorten his code.He wants to replace each variable name with its non-empty prefix so that these new names are still unique (however, a new name of some variable can coincide with some old name of another or same variable). Among such possibilities he wants to find the way with the smallest possible total length of the new names.A string $$$a$$$ is a prefix of a string $$$b$$$ if you can delete some (possibly none) characters from the end of $$$b$$$ and obtain $$$a$$$.Please find this minimum possible total length of new names.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of variables. The next $$$n$$$ lines contain variable names, one per line. Each name is non-empty and contains only lowercase English letters. The total length of these strings is not greater than $$$10^5$$$. The variable names are distinct.

Print a single integer — the minimum possible total length of new variable names.

NoteIn the first example one of the best options is to shorten the names in the given order as "cod", "co", "c".In the second example we can shorten the last name to "aac" and the first name to "a" without changing the other names.

{-# LANGUAGE FlexibleInstances #-}

import Control.Monad
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.State.Strict

import Data.Char (ord)
import Data.Maybe (fromMaybe)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM

import Data.Monoid
import Data.Foldable (fold)

data Trie = Trie Bool (IntMap Trie)

empty :: Trie
empty = Trie False IM.empty

insert :: [Int] -> Trie -> Trie
insert [] (Trie n ts) = Trie True ts
insert (x : xs) (Trie n ts) = Trie n (IM.alter (Just . insert xs . fromMaybe empty) x ts)

foldTrie :: (Bool -> IntMap a -> a) -> Trie -> a
foldTrie f = g where
  g (Trie b ts) = f b (IM.map g ts)

newtype Series a = Series { fromSeries :: [a] }

add :: [Int] -> [Int] -> [Int]
add [] ys = ys
add xs [] = xs
add (x : xs) (y : ys) = (x + y) : add xs ys

-- #if MIN_VERSION_base(4,9,0)
-- instance Semigroup (Series Int) where
--   Series xs <> Series ys = Series (add xs ys)
-- #endif

instance Monoid (Series Int) where
  mempty = Series []
  Series xs `mappend` Series ys = Series (add xs ys)

truncLast :: Int -> [Int] -> [Int]
truncLast n [] = if n > 1 then (n-1) : [] else []
truncLast n (n' : ns) = n : truncLast n' ns

merge :: Bool -> IntMap (Series Int) -> Series Int
merge b nss =
  let
    -- Series ns = traceShowId $ fold (traceShowId nss)
    Series ns = fold nss
  in
    if b then
      Series (1 : ns)
    else
      Series (truncLast 1 ns)

solve :: Trie -> Int
solve = sum . zipWith (*) [0..] . fromSeries . foldTrie merge

main :: IO ()
main = do
  n <- readLn
  t <- flip execStateT (insert [] empty) $ replicateM_ n $ do
    s <- lift getLine
    modify (insert (map (\c -> ord c - 97) s))
  print (solve t)


Ringo found a string $$$s$$$ of length $$$n$$$ in his yellow submarine. The string contains only lowercase letters from the English alphabet. As Ringo and his friends love palindromes, he would like to turn the string $$$s$$$ into a palindrome by applying two types of operations to the string. The first operation allows him to choose $$$i$$$ ($$$2 \le i \le n-1$$$) and to append the substring $$$s_2s_3 \ldots s_i$$$ ($$$i - 1$$$ characters) reversed to the front of $$$s$$$.The second operation allows him to choose $$$i$$$ ($$$2 \le i \le n-1$$$) and to append the substring $$$s_i s_{i + 1}\ldots s_{n - 1}$$$ ($$$n - i$$$ characters) reversed to the end of $$$s$$$.Note that characters in the string in this problem are indexed from $$$1$$$.For example suppose $$$s=$$$abcdef. If he performs the first operation with $$$i=3$$$ then he appends cb to the front of $$$s$$$ and the result will be cbabcdef. Performing the second operation on the resulted string with $$$i=5$$$ will yield cbabcdefedc.Your task is to help Ringo make the entire string a palindrome by applying any of the two operations (in total) at most $$$30$$$ times. The length of the resulting palindrome must not exceed $$$10^6$$$It is guaranteed that under these constraints there always is a solution. Also note you do not have to minimize neither the number of operations applied, nor the length of the resulting string, but they have to fit into the constraints.

The only line contains the string $$$S$$$ ($$$3 \le |s| \le 10^5$$$) of lowercase letters from the English alphabet.

The first line should contain $$$k$$$ ($$$0\le k \le 30$$$)  — the number of operations performed. Each of the following $$$k$$$ lines should describe an operation in form L i or R i. $$$L$$$ represents the first operation, $$$R$$$ represents the second operation, $$$i$$$ represents the index chosen. The length of the resulting palindrome must not exceed $$$10^6$$$.

NoteFor the first example the following operations are performed:abac $$$\to$$$ abacab $$$\to$$$ abacabaThe second sample performs the following operations: acccc $$$\to$$$ cccacccc $$$\to$$$ ccccaccccThe third example is already a palindrome so no operations are required.

import Control.Arrow ((>>>))

main :: IO ()
main = interact $ lines >>> head >>> process >>> unlines

process :: String -> [String]
process xs = show (length ys) : map pr ys
  where
    ys = solve xs
    pr (o, i) = o : " " ++ show i

solve :: String -> [(Char, Int)]
solve xs = [('R', n - 1), ('R', n - 1), ('L', n + 2), ('L', 2)]
  where
    n = length xs

data Operation = L Int | R Int
instance Show Operation where
    show (L n) = "L "++(show n)
    show (R n) = "R "++(show n)

solve :: String -> [Operation]
solve string = [R (l-2), L (l-1), (L 2)]
    where l = length string

showSolution :: [Operation] -> [String]
showSolution op = (show $ length op):(map (show) op)

main :: IO()
main = do
    interact $ unlines . showSolution . solve

main :: IO ()
main = do
  s <- getLine
  let
    n = length s
  putStrLn "3"
  putStrLn "L 2"
  putStrLn "R 2"
  putStr "R "
  print $ 2 * n - 1

data Operation = L Int | R Int
instance Show Operation where
    show (L n) = "L "++(show n)
    show (R n) = "R "++(show n)

solve :: String -> [Operation]
solve string = [R (l-1), L (l-1), (R 2)]
    where l = length string

showSolution :: [Operation] -> [String]
showSolution op = (show $ length op):(map (show) op)

main :: IO()
main = do
    interact $ unlines . showSolution . solve

data Operation = L Int | R Int
instance Show Operation where
    show (L n) = "L "++(show n)
    show (R n) = "R "++(show n)

solve :: String -> [Operation]
solve string = [R (l-1), L (l-1), (R 2)]
    where l = length string

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

data Operation = L Int | R Int
instance Show Operation where
    show (L n) = "L "++(show n)
    show (R n) = "R "++(show n)

solve :: String -> [Operation]
solve string = [R (l-1), L (l-2), (L 2)]
    where l = length string

showSolution :: [Operation] -> [String]
showSolution op = (show $ length op):(map (show) op)

main :: IO()
main = do
    interact $ unlines . showSolution . solve


You are given two integers $$$l$$$ and $$$r$$$, $$$l\le r$$$. Find the largest possible value of $$$a \bmod b$$$ over all pairs $$$(a, b)$$$ of integers for which $$$r\ge a \ge b \ge l$$$.As a reminder, $$$a \bmod b$$$ is a remainder we get when dividing $$$a$$$ by $$$b$$$. For example, $$$26 \bmod 8 = 2$$$.

Each test contains multiple test cases. The first line contains one positive integer $$$t$$$ $$$(1\le t\le 10^4)$$$, denoting the number of test cases. Description of the test cases follows. The only line of each test case contains two integers $$$l$$$, $$$r$$$ ($$$1\le l \le r \le 10^9$$$).

For every test case, output the largest possible value of $$$a \bmod b$$$ over all pairs $$$(a, b)$$$ of integers for which $$$r\ge a \ge b \ge l$$$.

NoteIn the first test case, the only allowed pair is $$$(a, b) = (1, 1)$$$, for which $$$a \bmod b = 1 \bmod 1 = 0$$$.In the second test case, the optimal choice is pair $$$(a, b) = (1000000000, 999999999)$$$, for which $$$a \bmod b = 1$$$.

import Control.Monad

calc l r | l <= (r `div` 2 + 1) =
           (r-1) `div` 2

calc l r | otherwise = r-l

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b] = map read $ words line :: [Int]
    print $ calc a b

{-# LANGUAGE LambdaCase #-}

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

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

type Input = (Int, Int)
type Output = Int

input :: Scanner Input
input = pair int int

output :: Output -> C.ByteString
output = showB

solve :: Input -> Output
solve (l, r)
  | l <= (r `div` 2) + 1 = (r - 1) `div` 2
  | otherwise = r - l

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

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

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

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

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

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

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

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

(><) = times

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

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

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

import Control.Monad

solve :: Int -> Int -> Int
solve l r = if a >= l
                then a - 1
                else r - l
        where a = (r + 1) `div` 2

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

testCase :: IO ()
testCase = do
  (l:r:_) <- fmap (map (read :: String -> Int) . words) getLine
  let ans = solve l r
  putStrLn $ show ans

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = (Int, Int)
type OutType = Int

inpLines :: Int
inpLines = 1

solve :: InType -> OutType
solve (l, r) = if l' >= l
               then l' - 1
               else r - l
    where l' = (r + 1) `div` 2

receive :: [String] -> InType
receive [s] = case toArr s of
                [l, r] -> (l, r)
                _      -> error "unexpected input"
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (show . solve . receive) . chunksOf inpLines . tail . lines


You are given N points on a plane. Write a program which will find the sum of squares of distances between all pairs of points.

The first line of input contains one integer number N (1 ≤ N ≤ 100 000) — the number of points. Each of the following N lines contain two integer numbers X and Y ( - 10 000 ≤ X, Y ≤ 10 000) — the coordinates of points. Two or more points may coincide.

The only line of output should contain the required sum of squares of distances between all pairs of points.

import Char (ord)
import Control.Monad (liftM)

solve :: Integer -> [(Int, Int)] -> Integer
solve n ps  =  solve' ps 0 0 0 0
  where
    solve' :: [(Int, Int)] -> Integer -> Integer -> Integer -> Integer -> Integer
    solve' [] _ _ acc1 acc2  =  (n-1) * acc1 - 2 * acc2
    solve' ((x,y) : ps) sX sY acc1 acc2  =  solve' ps sX' sY' acc1' acc2'
      where
        x'  =  fromIntegral x
        y'  =  fromIntegral y
        sX'  =  sX + x'
        sY'  =  sY + y'
        acc1'  =  acc1 + x' * x' + y' * y'
        acc2'  =  acc2 + sX * x' + sY * y'

readPoint :: String -> (Int, Int)
readPoint line  =  readPoint' line 1 0
  where
    readPoint' (' ':s) z a  =  readPoint'' s (z * a) 1 0
    readPoint' ('-':s) _ _  =  readPoint' s (-1) 0
    readPoint' (c:s) z a  =  readPoint' s z (10*a + (ord c - ord '0'))
    readPoint'' [] a z b  =  (a, z * b)
    readPoint'' ('-':s) a _ _  =  readPoint'' s a (-1) 0
    readPoint'' (c:s) a z b  =  readPoint'' s a z (10*b + (ord c - ord '0'))

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let n  =  read $ head lines'
    let points  =  map readPoint $ take (fromIntegral n) $ tail lines'
    print $ solve n points

{-# OPTIONS_GHC -O2 -optc-O2 #-}

-- solution for: http://codeforces.com/problemset/problem/76/E

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

compute :: [Integer]->Integer->Integer->Integer->Integer->Integer
compute [] _ _ _ acc = acc
compute (x:xs) i s ss acc = compute xs (i + 1) (s + x) (ss + x*x) (acc + (i-1)*x*x - 2*x*s + ss)

solve :: [Integer]->[Integer]->Integer
solve x y = (compute x 1 0 0 0) + (compute y 1 0 0 0)

main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let (x, y) = readMany readInteger r1 [] []
     print (solve x y)
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readMany readf s xs ys = case readf s of
          Just (t, r) -> readMany readf r ys (t:xs)
          Nothing     -> (xs, ys)

import Data.Char

import Control.Monad
import Data.Int(Int64)
import Data.List
import Data.Maybe
import Control.Applicative
import qualified Data.ByteString.Char8 as B

mkPt [a, b] = Pt a b

data Pt = Pt !Int64 !Int64

addPt (Pt x1 y1) (Pt x2 y2) = Pt (x1+x2) (y1+y2)
sumPt = foldl' addPt (Pt 0 0)

sqPt (Pt x y) = x*x+y*y

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

int64s :: IO [Int64]
int64s = map (fromInteger . toInteger) <$> ints

data State = State !Pt !Int64

gogogo :: Int -> IO State
gogogo n = gogo n (State (Pt 0 0) 0)

gogo :: Int -> State -> IO State
gogo 0 state = return $ state
gogo i (State sum sumSq) = do
    pt <- mkPt <$> int64s
    (gogo $! (i-1)) $! (State (addPt sum pt) (sumSq + sqPt pt))

main  = do
    [n] <- ints
    (State sum sumSq) <- gogogo n
--    input <- map mkPt <$> replicateM n int64s
--    let sumSq = sum (map sqPt input)
--    let sum = sumPt input
    let res = ((fromInteger $ toInteger $ n) * sumSq - sqPt sum)
    putStrLn $ unlines [show $ res]

inputGen = do
    putStrLn "100000"
    forM_ [1..100000] $ \i -> putStrLn "10000 10000"

 -- with readInt:
 --
 -- !Int64 = 385ms
 -- !Integer = 414
 -- Int64 = 427ms
 -- Integer = 669ms

 -- with read:
 --
 -- !Int64 = 1570
 -- !Integer = 1564
 -- Int64 = 1599
 -- Integer = 3821

import Data.Char

import Control.Monad(forM_)
import Data.Int(Int64)
import Data.List

mkPt [a, b] = Pt a b

readPt = mkPt . map readInt . words

readInt = fromInteger . toInteger . readIntRec 0
readIntRec :: Int -> String -> Int
readIntRec val "" = val
readIntRec val ('-': str) = negate $ readIntRec val str
readIntRec val (ch : str) = readIntRec (val*10 + (ord ch - ord '0')) str

data Pt = Pt !Int64 !Int64

addPt (Pt x1 y1) (Pt x2 y2) = Pt (x1+x2) (y1+y2)
sumPt = foldl' addPt (Pt 0 0)

sqPt (Pt x y) = x*x+y*y

interactor :: String -> String
interactor str = let (hl : ol) = lines str
                     n = read hl
                     input = map readPt $ ol
                     result = unlines [show $ (n * sum (map sqPt input) - sqPt (sumPt input))]
                 in result

main  = interact interactor

inputGen = do
    putStrLn "100000"
    forM_ [1..100000] $ \i -> putStrLn "10000 10000"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

sumPoints ::[Integer] -> Integer -> Integer -> Integer -> Integer -> Integer
sumPoints [] _ _ _ acc = acc
sumPoints (x:xs) sum sqsum i acc = let newval = ((i-1) * (x*x) - (2*x*sum) + sqsum) in
          sumPoints xs (sum+x) (sqsum + (x*x)) (i+1) (acc+newval)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n,r1) = readInt all
     let Just ((xs,ys),_) = readTuples n r1
     let result = (sumPoints xs 0 0 1 0)+(sumPoints ys 0 0 1 0)
     putStrLn $ show result ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readTuples 0 s = do return (([],[]),s)
        readTuples n s = do (x, r) <- readInt s
                            (y, z) <- readInt r
                            ((l1,l2),t) <- readTuples (n-1) z
                            return ((((toInteger x) : l1),((toInteger y) : l2)),t)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

sumPoints ::[Integer] -> Integer -> Integer -> Integer -> Integer -> Integer
sumPoints [] _ _ _ acc = acc
sumPoints (x:xs) sum sqsum i acc = let newval = ((i-1) * (x*x) - (2*x*sum) + sqsum) in
          sumPoints xs (sum+x) (sqsum + (x*x)) (i+1) (acc+newval)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n,r1) = readInt all
     let Just ((xs,ys),_) = readTuples n r1
     let result = (sumPoints xs 0 0 1 0)+(sumPoints ys 0 0 1 0)
     putStrLn $ show result ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readTuples 0 s = do return (([],[]),s)
        readTuples n s = do (x, r) <- readInteger s
                            (y, z) <- readInteger r
                            ((l1,l2),t) <- readTuples (n-1) z
                            return (((x : l1),(y : l2)),t)

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

compute :: [Integer] -> Integer -> Integer -> Integer -> Integer ->Integer
compute [] _ acc suma sumasq = acc
compute (x:xs) i acc suma sumasq = if i == 1 then compute xs (i+1) acc x (x*x) else  compute xs (i+1) (acc+(i-1)*x*x - 2*x*(suma) + sumasq) (suma+x) (sumasq+x*x)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let (xs, ys)  = getPoints n r1 ([],[])
     print ((compute xs 1 0 0 0 ) + (compute ys 1 0 0 0))
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (x, r) <- readInteger s
                             (l, t) <- readIntList (n-1) r
                             return (x : l, t)
        getPoints 0 _ (accx, accy) = (accx, accy)
        getPoints n s (accx, accy) =
          let Just (pt, r2) = readIntList 2 s
            in  getPoints (n-1) r2 (((head pt):accx), ((last pt):accy))

import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe
import IO

readInt = fst . fromJust . C.readInteger

main = do
	(h:t) <- fmap C.lines $ C.hGetContents stdin
	let
		n = readInt h
		a = map (map readInt . C.words) t
	print $ let x = map head a; y = map last a in gao n x + gao n y

gao n x = toInteger n * sum (map (^2) x) - (sum x) ^ 2

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

-- compute [] _ acc inp = acc
-- compute (x:xs) i acc inp = compute xs (i+1) (acc+(i - 1)*x*x - 2*x*(suma inp (i-1) 0) + (sumasq inp (i-1) 0)) (inp)

-- compute :: [Integer] -> Integer -> Integer -> [Integer] -> Integer
-- compute [] _ acc inp = acc
-- compute (x:xs) i acc inp = compute xs (i+1) (acc+(i - 1)*x*x - 2*x*(suma inp (i-1) 0) + (sumasq inp (i-1) 0)) (inp)
compute :: [Integer] -> Integer -> Integer -> Integer -> Integer ->Integer
compute [] _ acc suma sumasq = acc
compute (x:xs) i acc suma sumasq = if i == 1 then compute xs (i+1) acc x (x*x) else  compute xs (i+1) (acc+(i-1)*x*x - 2*x*(suma) + sumasq) (suma+x) (sumasq+x*x)

-- suma :: [Integer] -> Integer -> Integer -> Integer
-- suma x 0 acc = acc
-- suma (x:xs) n acc = suma xs (n-1) (acc+x)

-- sumasq :: [Integer] -> Integer -> Integer -> Integer
-- sumasq x 0 acc = acc
-- sumasq (x:xs) n acc = sumasq xs (n-1) (acc+x*x)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let (xs, ys)  = getPoints n r1 ([],[])
     print ((compute xs 1 0 0 0 ) + (compute ys 1 0 0 0))
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readInteger s = BSC.readInteger (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (x, r) <- readInteger s
                             (l, t) <- readIntList (n-1) r
                             return (x : l, t)
        getPoints 0 _ (accx, accy) = (accx, accy)
        getPoints n s (accx, accy) =
          let Just (pt, r2) = readIntList 2 s
            in  getPoints (n-1) r2 (((head pt):accx), ((last pt):accy))

import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe
import IO

getLines :: IO [[Integer]]
getLines = do
	fmap C.lines (C.hGetContents stdin) >>= return . map (map (fst . fromJust . C.readInteger) . C.words)

sxx = sum . map ((^2) . head)
syy = sum . map ((^2) . last)
sx = sum . map head
sy = sum . map last

main = do
	n <- getLine >>= return . read :: IO Integer
	xys <- getLines
	putStrLn . show $ n * ((sxx xys) + (syy xys)) - (sx xys) ^ 2 - (sy xys) ^ 2

import Data.Char

import Control.Monad(forM_)
import Data.Int(Int64)
import Data.List

mkPt [a, b] = Pt a b

readPt = mkPt . map readInt . words

readInt = fromInteger . toInteger . readIntRec 0
readIntRec :: Int -> String -> Int
readIntRec val "" = val
readIntRec val (ch : str) = readIntRec (val*10 + (ord ch - ord '0')) str

data Pt = Pt !Int64 !Int64

addPt (Pt x1 y1) (Pt x2 y2) = Pt (x1+x2) (y1+y2)
sumPt = foldl' addPt (Pt 0 0)

sqPt (Pt x y) = x*x+y*y

interactor :: String -> String
interactor str = let (hl : ol) = lines str
                     n = read hl
                     input = map readPt $ ol
                     result = unlines [show $ (n * sum (map sqPt input) - sqPt (sumPt input))]
                 in result

main  = interact interactor

inputGen = do
    putStrLn "100000"
    forM_ [1..100000] $ \i -> putStrLn "10000 10000"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

sumPoints [] _ _ _ acc = acc
sumPoints (x:xs) sum sqsum i acc = let newval = ((i-1) * (x*x) - (2*x*sum) + sqsum) in
          sumPoints xs (sum+x) (sqsum + (x*x)) (i+1) (acc+newval)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n,r1) = readInt all
     let Just ((xs,ys),_) = readTuples n r1
     let result = (sumPoints xs 0 0 1 0)+(sumPoints ys 0 0 1 0)
     putStrLn $ show result ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readTuples 0 s = do return (([],[]),s)
        readTuples n s = do (x, r) <- readInt s
                            (y, z) <- readInt r
                            ((l1,l2),t) <- readTuples (n-1) z
                            return (((x : l1),(y : l2)),t)

import Control.Monad;

main = do
	n <- fmap read getLine
	a <- replicateM n $ fmap (map read . words) getLine
	print $ let x = map head a; y = map last a in gao x + gao y

gao x = length x * sum (map (^2) x) - (sum x) ^ 2 where

import Control.Monad;

main = do
	n <- fmap read getLine
	a <- replicateM n $ fmap (map read . words) getLine
	print $ let x = map head a; y = map last a in gao x + gao y

gao x = length x * sum (map (^2) x) - (sum x) ^ (2::Integer) where

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

compute :: [Int] -> Int -> Int -> [Int] -> Int
compute [] _ acc inp = acc
compute (x:xs) i acc inp = compute xs (i+1) (acc+(i - 1)*x*x - 2*x*(suma inp (i-1) 0) + (sumasq inp (i-1) 0)) (inp)

suma :: [Int] -> Int -> Int -> Int
suma x 0 acc = acc
suma (x:xs) n acc = suma xs (n-1) (acc+x)

sumasq :: [Int] -> Int -> Int -> Int
sumasq x 0 acc = acc
sumasq (x:xs) n acc = sumasq xs (n-1) (acc+x*x)

main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let (xs, ys)  = getPoints n r1 ([],[])
     print ((compute xs 1 0  xs) + (compute ys 1 0 ys))
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (x, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return (x : l, t)
        getPoints 0 _ (accx, accy) = (accx, accy)
        getPoints n s (accx, accy) =
          let Just (pt, r2) = readIntList 2 s
            in  getPoints (n-1) r2 (((head pt):accx), ((last pt):accy))

getLines :: Int -> IO [(Int, Int)]
getLines 0 = return []
getLines n = do
	x <- getLine >>= return . (\(x:y:_) -> (read x, read y)) . words
	xs <- getLines (n-1)
	return (x:xs)

sxx xys = sum [(fst xy) ^ 2 | xy <- xys]
syy xys = sum [(snd xy) ^ 2 | xy <- xys]
sx xys = sum [fst xy | xy <- xys]
sy xys = sum [snd xy | xy <- xys]

main = do
	n <- getLine >>= return . read :: IO Int
	xys <- getLines n
	putStrLn . show $ length xys * (sxx xys + syy xys) - ((sx xys) ^ 2) - ((sy xys) ^ 2)

import Char (ord)
import Control.Monad (liftM)

solve :: Integer -> [(Int, Int)] -> Integer
solve n ps  =  solve' ps 0 0 0 0
  where
    solve' :: [(Int, Int)] -> Integer -> Integer -> Integer -> Integer -> Integer
    solve' [] _ _ acc1 acc2  =  (n-1) * acc1 - 2 * acc2
    solve' ((x,y) : ps) sX sY acc1 acc2  =  solve' ps sX' sY' acc1' acc2'
      where
        x'  =  fromIntegral x
        y'  =  fromIntegral y
        sX'  =  sX + x'
        sY'  =  sY + y'
        acc1'  =  acc1 + x' * x' + y' * y'
        acc2'  =  acc2 + sX * x' + sY * y'

readPoint :: String -> (Int, Int)
readPoint line  =  readPoint' line 0
  where
    readPoint' (' ':s) a  =  readPoint'' s a 0
    readPoint' (c:s) a  =  readPoint' s (10*a + (ord c - ord '0'))
    readPoint'' [] a b  =  (a, b)
    readPoint'' (c:s) a b  =  readPoint'' s a (10*b + (ord c - ord '0'))

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let n  =  read $ head lines'
    let points  =  map readPoint $ take (fromIntegral n) $ tail lines'
    print $ solve n points

solve :: Integer -> [Int] -> [Int] -> Integer
solve n xs ys  =  solve' 0 xs 0 0 + solve' 0 ys 0 0
  where
    solve' :: Int -> [Int] -> Integer -> Integer -> Integer
    solve' _ [] acc1 acc2  =  (n-1) * acc1 - (acc2 + acc2)
    solve' s (x:xs) acc1 acc2  =  s' `seq` acc1' `seq` acc2' `seq` solve' s' xs acc1' acc2'
      where
        s'  =  s + x
        acc1'  =  acc1 + fromIntegral (x * x)
        acc2'  =  acc2 + fromIntegral (s * x)

readPoint :: IO (Int, Int)
readPoint  =  do
    [x, y]  <-  getLine >>= return . map read . words
    return (x, y)

main :: IO ()
main  =  do
    n  <-  readLn
    points  <-  mapM (const readPoint) [1..n]
    print $ solve n (map fst points) (map snd points)


You are given a permutation p of length n. Remove one element from permutation to make the number of records the maximum possible.We remind that in a sequence of numbers a1, a2, ..., ak the element ai is a record if for every integer j (1 ≤ j < i) the following holds: aj < ai.

The first line contains the only integer n (1 ≤ n ≤ 105) — the length of the permutation. The second line contains n integers p1, p2, ..., pn (1 ≤ pi ≤ n) — the permutation. All the integers are distinct.

Print the only integer — the element that should be removed to make the number of records the maximum possible. If there are multiple such elements, print the smallest one.

NoteIn the first example the only element can be removed.

module Main where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = case maximum $ map (liftM2 (,) (subtract 1 . sum . map (\(m, m2, x) -> fromEnum $ x /= m && x > m2)) ((\(m, _, _) -> -m) . head)) $ groupBy (\(m, _, _) (m', _, _) -> m == m') $ zip3 pmaxs (0:pmax2s) xs of
  (d, _) | d <= 0 -> maybe (minimum xs) id $ minimumMay $ map fst $ filter (uncurry (/=)) $ zip xs pmaxs
  (_, x) -> -x
  where
  pmaxs = scanl1 max xs
  pmax2s = snd $ mapAccumL (\p (pm, cm, x) -> if cm /= pm then (pm, pm) else if p < x && x < cm then (x, x) else (p, p)) 0 $ zip3 (0:pmaxs) pmaxs xs

minimumMay [] = Nothing
minimumMay xs = Just $ minimum xs

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  script
  --optimize
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package time
  --package vector
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Array.Unboxed (UArray)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap, forM_)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)
import           Data.Time.Clock
import           System.IO (stderr)

type N = Int
toNum = toInt

fromDown :: Down a -> a
fromDown (Down a) = a

-- answer :: [(Int, Int)] -> Int
answer xs = incs' $$ IM.toList .- L.maximumBy (comparing snd <> comparing (fst .- Down))
         .- fst
  where
    seens = scanl' (flip S.insert) S.empty xs
    greaters = zipWith S.split xs seens $$ map snd .- map toTwos
    isRec = greaters $$ map null
    zs = zip xs isRec
    incs = greaters $$ concatMap toOnes .- sort .- group .- map (head &&& length)
                    .- IM.fromList
    incs' = foldl' doOne incs zs
    toTwos = S.toList .- take 2
    toOnes [_, _] = []
    toOnes ys = ys
    doOne m (x, rec'')  = let rec' = toChange rec''
                              alt Nothing = Just $ rec'
                              alt (Just v) = Just $ v + rec'
                           in IM.alter alt x m
    toChange True = -1
    toChange _ = 0

handleInput :: ByteString -> ByteString
handleInput = words .- drop 1 .- map toNum
            .- answer
            .- show .- pack
            -- .- map (show .- pack) .- unlines

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f (a:b:xs) = f a b xs
coerceInput _ _ = error "invalid input"

main :: IO ()
main = do
  st <- getCurrentTime
  st `seq` interact handleInput
  ed <- getCurrentTime
  BS.hPutStrLn stderr $ pack ""
  BS.hPutStrLn stderr . pack $ show (ed `diffUTCTime` st)

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-

($$) :: a -> (a -> b) -> b
($$) = flip ($)
infixl 0 $$

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' f !z [] = [z]
scanl' f !z (x:xs) = z : scanl' f (f z x) xs

import Data.List

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [_, perm'] = sol perm
  where
    perm = fn $ words perm'
    fn :: [String] -> [Int]
    fn xs = map read xs

sol :: [Int] -> [String]
sol perm = [ show $ select list ]
  where
    list' = recc 0 0 perm
    list = 1 : list' ++ list'
    select xs = head $ maximumBy cmplen $ group $ sortBy (flip compare) xs
    cmplen x y = compare (length x) (length y)

recc _ _ [] = []
recc nd st (x:xs)
  | st < x    = recc st x xs
  | nd < x    = st : x : recc x st xs
  | otherwise = x : recc nd st xs

list = [4,4,3,3,1,0,3,4]

module Main where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Ord

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = fst $ maximumBy (comparing snd) $ map (liftM2 (,) ((\(m, _, _) -> m) . head) (sum . map (\(_, m2, x) -> fromEnum $ x > m2))) $ groupBy (\(m, _, _) (m', _, _) -> m == m') $ zip3 pmaxs (0:pmax2s) xs
  where
  pmaxs = scanl1 max xs
  pmax2s = snd $ mapAccumL (\p (pm, cm, x) -> if cm /= pm then (pm, pm) else if p < x && x < cm then (x, x) else (p, p)) 0 $ zip3 (0:pmaxs) pmaxs xs

module Main where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = case maximum $ map (liftM2 (,) (subtract 1 . sum . map (\(m, m2, x) -> fromEnum $ x /= m && x > m2)) ((\(m, _, _) -> -m) . head)) $ groupBy (\(m, _, _) (m', _, _) -> m == m') $ zip3 pmaxs (0:pmax2s) xs of
  (d, _) | d <= 0 -> minimum xs
  (_, x) -> -x
  where
  pmaxs = scanl1 max xs
  pmax2s = snd $ mapAccumL (\p (pm, cm, x) -> if cm /= pm then (pm, pm) else if p < x && x < cm then (x, x) else (p, p)) 0 $ zip3 (0:pmaxs) pmaxs xs

minimumMay [] = Nothing
minimumMay xs = Just $ minimum xs

module Main where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = case maximum $ map (liftM2 (,) (subtract 1 . sum . map (\(m, m2, x) -> fromEnum $ x /= m && x > m2)) ((\(m, _, _) -> -m) . head)) $ groupBy (\(m, _, _) (m', _, _) -> m == m') $ zip3 pmaxs (0:pmax2s) xs of
  (d, x) | d <= 0 -> maybe (-x) id $ minimumMay $ filter (/= (-x)) xs
  (_, x) -> -x
  where
  pmaxs = scanl1 max xs
  pmax2s = snd $ mapAccumL (\p (pm, cm, x) -> if cm /= pm then (pm, pm) else if p < x && x < cm then (x, x) else (p, p)) 0 $ zip3 (0:pmaxs) pmaxs xs

minimumMay [] = Nothing
minimumMay xs = Just $ minimum xs

module Main where
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve xs = case maximum $ map (liftM2 (,) (subtract 1 . sum . map (\(m, m2, x) -> fromEnum $ x /= m && x > m2)) ((\(m, _, _) -> -m) . head)) $ groupBy (\(m, _, _) (m', _, _) -> m == m') $ zip3 pmaxs (0:pmax2s) xs of
  (0, x) -> minimum $ map fst $ filter (\(x', m) -> x' /= m && x' < -x) $ zip xs pmaxs
  (_, x) -> -x
  where
  pmaxs = scanl1 max xs
  pmax2s = snd $ mapAccumL (\p (pm, cm, x) -> if cm /= pm then (pm, pm) else if p < x && x < cm then (x, x) else (p, p)) 0 $ zip3 (0:pmaxs) pmaxs xs

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  script
  --optimize
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package time
  --package vector
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Array.Unboxed (UArray)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap, forM_)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)
import           Data.Time.Clock
import           System.IO (stderr)

type N = Int
toNum = toInt

fromDown :: Down a -> a
fromDown (Down a) = a

-- answer :: [(Int, Int)] -> Int
answer xs = greaters $$ sort .- group .- map (length &&& head)
         .- ((0, 1) :) .- L.maximumBy (comparing fst <> comparing (snd .- Down))
         .- snd
  where
    seens = scanl' (flip S.insert) S.empty xs
    greaters = zipWith S.split xs seens $$ map snd .- concatMap toOnes
    toOnes x
      | S.size x == 1 = S.toList x
      | otherwise = []

handleInput :: ByteString -> ByteString
handleInput = words .- drop 1 .- map toNum
            .- answer
            .- show .- pack
            -- .- map (show .- pack) .- unlines

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f (a:b:xs) = f a b xs
coerceInput _ _ = error "invalid input"

main :: IO ()
main = do
  st <- getCurrentTime
  st `seq` interact handleInput
  ed <- getCurrentTime
  BS.hPutStrLn stderr $ pack ""
  BS.hPutStrLn stderr . pack $ show (ed `diffUTCTime` st)

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-

($$) :: a -> (a -> b) -> b
($$) = flip ($)
infixl 0 $$

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' f !z [] = [z]
scanl' f !z (x:xs) = z : scanl' f (f z x) xs

#!/usr/bin/env stack
{- stack
  --resolver lts-2.22
  script
  --optimize
  --package aeson
  --package array
  --package base
  --package bytestring
  --package containers
  --package hashmap
  --package hashtables
  --package lens
  --package logict
  --package mtl
  --package mwc-random
  --package parsec
  --package pipes
  --package time
  --package vector
-}
{-# LANGUAGE BangPatterns, TupleSections, RankNTypes, ScopedTypeVariables #-}
module Main
( main
) where

import           Prelude hiding (interact, lines, unlines, words, unwords,
                                 sequence, foldr)
import           Data.ByteString.Char8 (pack, unpack, ByteString, lines, words,
                                        unlines, unwords, interact, readInt,
                                        readInteger)
import qualified Data.ByteString.Char8 as BS
import           Data.List (foldl', sort, sortBy, group, groupBy, inits, tails,
                            unfoldr)
import qualified Data.List as L
import qualified Data.IntSet as IS
import           Data.IntSet (IntSet)
import qualified Data.IntMap.Strict as IM
import           Data.IntMap.Strict (IntMap)
import qualified Data.Map.Strict as M
import           Data.Map.Strict (Map)
import qualified Data.Set as S
import           Data.Set (Set)
import qualified Data.Array.IArray as A
import           Data.Array.IArray ((!), Array, listArray, array)
import           Data.Array.Unboxed (UArray)
import           Data.Maybe (fromJust, isJust, fromMaybe, maybe, mapMaybe,
                             catMaybes)
import           Data.Either (either)
import           Control.Applicative (Applicative, pure,
                                      (<$>), (<*>), (<|>), liftA2, liftA3)
import           Control.Monad (unless, when, void, filterM, ap, forM_)
import           Control.Arrow ((***), (&&&), first, second)
import           Data.Traversable (sequence, sequenceA, traverse,
                                   Traversable)
import           Data.Ord (comparing, Down(..))
import           Data.Function (on)
import           Data.Bits (complement, xor, (.|.), (.&.), testBit, zeroBits,
                            bit, shiftR, shiftL, Bits)
import qualified Data.Bits as B
import           Data.Word (Word32)
import           Control.Monad.State (State, get, put, gets, modify,
                                      evalState, execState, runState)
import           Text.Parsec (char, space, parse, Parsec)
import qualified Text.Parsec as P
import           Data.Tuple (swap)
import           Data.Foldable (Foldable, foldr)
import           Data.Monoid ((<>), Monoid, mappend, mempty)
import           Data.Time.Clock
import           System.IO (stderr)

type N = Int
toNum = toInt

fromDown :: Down a -> a
fromDown (Down a) = a

-- answer :: [(Int, Int)] -> Int
answer xs = incs' $$ IM.toList .- L.maximumBy (comparing snd <> comparing (fst .- Down))
         .- fst
  where
    seens = scanl' (flip S.insert) S.empty xs
    greaters = zipWith S.split xs seens $$ map snd .- map toTwos
    isRec = greaters $$ map null
    zs = zip xs isRec
    incs = greaters $$ concatMap toOnes .- sort .- group .- map (head &&& length)
                    .- IM.fromList
    incs' = foldl' doOne incs zs
    toTwos x
      | S.size x <= 2 = S.toList x
      | otherwise = []
    toOnes [_, _] = []
    toOnes ys = ys
    doOne m (x, rec'')  = let rec' = toChange rec''
                              alt Nothing = Just $ rec'
                              alt (Just v) = Just $ v + rec'
                           in IM.alter alt x m
    toChange True = -1
    toChange _ = 0

handleInput :: ByteString -> ByteString
handleInput = words .- drop 1 .- map toNum
            .- answer
            .- show .- pack
            -- .- map (show .- pack) .- unlines

toInt = readInt .- fromJust .- fst
toInte = readInteger .- fromJust .- fst
toX :: Read a => ByteString -> a
toX = unpack .- read

coerceInput f (a:b:xs) = f a b xs
coerceInput _ _ = error "invalid input"

main :: IO ()
main = do
  st <- getCurrentTime
  st `seq` interact handleInput
  ed <- getCurrentTime
  BS.hPutStrLn stderr $ pack ""
  BS.hPutStrLn stderr . pack $ show (ed `diffUTCTime` st)

-- Util stuff --
(.-) :: (a -> b) -> (b -> c) -> a -> c
(.-) = flip (.)
infixl 9 .-

($$) :: a -> (a -> b) -> b
($$) = flip ($)
infixl 0 $$

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral

scanl' :: (b -> a -> b) -> b -> [a] -> [b]
scanl' f !z [] = [z]
scanl' f !z (x:xs) = z : scanl' f (f z x) xs

import Data.List

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [_, perm'] = sol perm
  where
    perm = fn $ words perm'
    fn :: [String] -> [Int]
    fn xs = map read xs

sol :: [Int] -> [String]
sol perm = [ show $ select list ]
  where
    list' = recc 0 0 perm
    list = 1 : list' ++ list'
    select xs = head $ maximumBy cmplen $ group $ sortBy (flip compare) xs
    cmplen x y = compare (length x) (length y)

recc _ _ [] = []
recc nd st (x:xs)
  | st < x    = recc st x xs
  | nd < x    = st : recc x st xs
  | otherwise = recc nd st xs

list = [4,4,3,3,1,0,3,4]

import Data.List

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [_, perm'] = sol perm
  where
    perm = fn $ words perm'
    fn :: [String] -> [Int]
    fn xs = map read xs

sol :: [Int] -> [String]
sol perm = [ show $ select list ]
  where
    list' = recc 0 0 perm
    list = 1 : list' ++ list'
    select xs = head $ maximumBy cmplen $ group $ sortBy (flip compare) xs
    cmplen x y = compare (length x) (length y)

recc _ _ [] = []
recc nd st (x:xs)
  | st < x    = recc st x xs
  | nd < x    = st : x : recc x st xs
  | otherwise = recc nd st xs

list = [4,4,3,3,1,0,3,4]


You have a string $$$s_1 s_2 \ldots s_n$$$ and you stand on the left of the string looking right. You want to choose an index $$$k$$$ ($$$1 \le k \le n$$$) and place a mirror after the $$$k$$$-th letter, so that what you see is $$$s_1 s_2 \ldots s_k s_k s_{k - 1} \ldots s_1$$$. What is the lexicographically smallest string you can see?A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds:   $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$;  in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 10\,000$$$): the number of test cases. The next $$$t$$$ lines contain the description of the test cases, two lines per a test case. In the first line you are given one integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$): the length of the string. The second line contains the string $$$s$$$ consisting of $$$n$$$ lowercase English characters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print the lexicographically smallest string you can see.

4
10
codeforces
9
cbacbacba
3
aaa
4
bbaa

NoteIn the first test case choose $$$k = 1$$$ to obtain "cc".In the second test case choose $$$k = 3$$$ to obtain "cbaabc".In the third test case choose $$$k = 1$$$ to obtain "aa".In the fourth test case choose $$$k = 1$$$ to obtain "bb".

import Control.Monad (replicateM_)

solve :: String -> String
solve (a:[]) = [a, a]
solve (a:b:xs) =
  if b >= a
    then [a, a]
    else iter [a] a (b:xs)
  where
    iter acc a [] = reverse acc ++ acc
    iter acc a (b:xs) =
      if b <= a
        then iter (b:acc) b xs
        else reverse acc ++ acc

main :: IO ()
main = do
  tc <- readInt <$> getLine
  replicateM_ tc gao
  where
    readInt s = read s :: Int
    gao = do
      n <- readInt <$> getLine
      s <- getLine
      putStrLn $ solve s

{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Monad
import Data.Maybe
import Data.List

removeElem :: Int -> [a] -> [a]
removeElem i xs = take i xs <> tail (drop i xs)

main = do
  n <- read @Int <$> getLine
  replicateM n $ do
    void getLine
    str <- getLine
    let go (x:xs) c = if x < c || (x == c && head str > x)
                      then x : go xs x
                      else []
        go [] c = []
    let res = go str maxBound
    putStrLn $ res ++ reverse res

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    _ <- getInts
    str <- filter (not . isSpace) . C.unpack <$> C.getLine
    let (g : gs) = group str
        result
          | length g >= 2 = [head g]
          | otherwise = concat $ either id id $ foldM acc [g] gs
          where acc ts xs
                  | head (head ts) > head xs = Right $ xs : ts
                  | otherwise = Left ts
    return $ string8 (reverse result ++ result) `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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

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

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    ~[s] <- getNext 1
    let
      sLi = P.unpack s
      s2 = toEnum 255 : sLi
      toUse = case  sLi  of
        x : y : zs | x <= y  -> [x]
        _ -> map fst $ takeWhile (uncurry (<=)) $ zip sLi s2
    pure $ string7 $ toUse ++ reverse toUse ++ "\n"

type SP = State [P.ByteString]

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

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

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

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

import Control.Monad (replicateM_)

solve :: String -> String
solve s =
  iter [head s] (head s) (tail s)
  where
    iter acc curr "" = reverse acc ++ acc
    iter acc curr rem =
      let
        next_ = head rem
      in
        if curr > next_
          then iter (next_:acc) next_ (tail rem)
          else reverse acc ++ acc

main :: IO ()
main = do
  tc <- readInt <$> getLine
  replicateM_ tc gao
  where
    readInt s = read s :: Int
    gao = do
      n <- readInt <$> getLine
      s <- getLine
      putStrLn $ solve s

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C

solve :: Int -> C.ByteString -> String
solve 1 s = [C.head s, C.head s]
solve _ s =
  iter [C.head s] (C.head s) (C.tail s)
  where
    iter acc curr "" = reverse acc ++ acc
    iter acc curr rem =
      let
        next_ = C.head rem
      in
        if curr > next_
          then iter (next_:acc) next_ (C.tail rem)
          else reverse acc ++ acc

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    gao = do
      n <- readInt <$> C.getLine
      s <- C.getLine
      putStrLn $ solve n s

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C

solve :: Int -> C.ByteString -> String
solve 1 s = [C.head s, C.head s]
solve _ s =
  iter [C.head s] (C.head s) (C.tail s)
  where
    iter acc curr "" = reverse acc ++ acc
    iter acc curr rem =
      let
        next = C.head rem
      in
        if curr > next
          then iter (next:acc) next (C.tail rem)
          else reverse acc ++ acc

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    gao = do
      n <- readInt <$> C.getLine
      s <- C.getLine
      putStrLn $ solve n s

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C

solve :: Int -> C.ByteString -> C.ByteString
solve 1 s = C.append s s
solve _ s =
  iter (C.singleton $ C.head s) (C.head s) (C.tail s)
  where
    iter acc curr "" = C.append (C.reverse acc) acc
    iter acc curr rem =
      let
        next = C.head rem
      in
        if curr > next
          then iter (C.cons next acc) next (C.tail rem)
          else C.append (C.reverse acc) acc

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    gao = do
      n <- readInt <$> C.getLine
      s <- C.getLine
      C.putStrLn $ solve n s

{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C

solve :: Int -> C.ByteString -> C.ByteString
solve 1 s = s
solve _ s =
  iter (C.singleton $ C.head s) (C.head s) (C.tail s)
  where
    iter acc curr "" = C.append (C.reverse acc) acc
    iter acc curr rem =
      let
        next = C.head rem
      in
        if curr > next
          then iter (C.cons next acc) next (C.tail rem)
          else C.append (C.reverse acc) acc

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    gao = do
      n <- readInt <$> C.getLine
      s <- C.getLine
      C.putStrLn $ solve n s

{-# LANGUAGE TypeApplications #-}

module Main where

import Control.Monad
import Data.Maybe
import Data.List

removeElem :: Int -> [a] -> [a]
removeElem i xs = take i xs <> tail (drop i xs)

main = do
  n <- read @Int <$> getLine
  replicateM n $ do
    void getLine
    str <- getLine
    let go (x:xs) c = if x < c
                      then x : go xs x
                      else []
        go [] c = []
    let res = go str maxBound
    putStrLn $ res ++ reverse res


You are given a cube of size k × k × k, which consists of unit cubes. Two unit cubes are considered neighbouring, if they have common face.Your task is to paint each of k3 unit cubes one of two colours (black or white), so that the following conditions must be satisfied:  each white cube has exactly 2 neighbouring cubes of white color;  each black cube has exactly 2 neighbouring cubes of black color.

The first line contains integer k (1 ≤ k ≤ 100), which is size of the cube.

Print -1 if there is no solution. Otherwise, print the required painting of the cube consequently by layers. Print a k × k matrix in the first k lines, showing how the first layer of the cube should be painted. In the following k lines print a k × k matrix — the way the second layer should be painted. And so on to the last k-th layer. Note that orientation of the cube in the space does not matter. Mark a white unit cube with symbol "w" and a black one with "b". Use the format of output data, given in the test samples. You may print extra empty lines, they will be ignored.

import Data.List (intersperse)

solve :: Int -> IO ()
solve n
  | odd n  =  print (-1)
  | even n  =  sequence_ $ intersperse (putStrLn "") $ map solve' [1..n]
  where
    solve' k  =  sequence_ [solve'' k i >> putStrLn "" | i <- [1..n]]
    solve'' k i  =  mapM_ (solve''' k i) [1..n]
    solve''' k i j
      | odd (div (i-1) 2 + div (j-1) 2 + k)  =  putChar 'b'
      | otherwise  =  putChar 'w'

main :: IO ()
main  =  readLn >>= solve