Alice has a grid with $$$2$$$ rows and $$$n$$$ columns. She fully covers the grid using $$$n$$$ dominoes of size $$$1 \times 2$$$ — Alice may place them vertically or horizontally, and each cell should be covered by exactly one domino.Now, she decided to show one row of the grid to Bob. Help Bob and figure out what the other row of the grid looks like!

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 5000$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the width of the grid. The second line of each test case contains a string $$$s$$$ consisting of $$$n$$$ characters, each of which is either L, R, U, or D, representing the left, right, top, or bottom half of a domino, respectively (see notes for better understanding). This string represents one of the rows of the grid.  Additional constraint on the input: each input corresponds to at least one valid tiling.

For each test case, output one string — the other row of the grid, using the same format as the input string. If there are multiple answers, print any.

NoteIn the first test case, Alice shows Bob the top row, the whole grid may look like:   In the second test case, Alice shows Bob the bottom row, the whole grid may look like:   In the third test case, Alice shows Bob the bottom row, the whole grid may look like:   In the fourth test case, Alice shows Bob the top row, the whole grid may look like:

readLnInt = readLn :: IO Int

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

main = do
  t <- readLnInt
  loop t $ do
    n <- readLnInt
    s <- getLine
    putStrLn $ map (\c -> if c == 'U' then 'D' else if c == 'D' then 'U' else c) s

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >> map f  <$> getLine >>= putStrLn

f 'U' = 'D'
f 'D' = 'U'
f c = c

import Data.Maybe

getHalf :: Char -> Char
getHalf c
  | c == 'L' || c == 'R'  = c
  | c == 'U'              = 'D'
  | c == 'D'              = 'U'

solve = do
  n <- readLnInt
  row <- getLine
  putStrLn (map getHalf row)

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

readLnInt :: IO Int
readLnInt = readLn :: IO Int

main = do
  tests <- readLnInt
  loop tests $ do
    solve

import Control.Monad

calc :: String -> String
calc [] = []
calc ['U'] = ['D']
calc ['D'] = ['U']
calc ('L':'R':xs) = ('L':'R':(calc xs))
calc ('R':'L':xs) = ('R':'L':(calc xs))
calc ('U':xs) = ('D':(calc xs))
calc ('D':xs) = ('U':(calc xs))

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    unused <- getLine
    line <- getLine
    putStrLn $ calc line

solve ys []  = reverse ys
solve ys ('U':xs)      = solve('D' : ys ) xs
solve ys ('D':xs)      = solve ('U' : ys ) xs
solve ys ('L':'R':xs)  = solve ('R':'L': ys ) xs
solve ys ('R':'L':xs)  = solve ('L':'R': ys ) xs
main = interact $ unlines . map (solve [] . snd) . filter (odd . fst )  . zip [0..] . tail  . lines

{-# LANGUAGE LambdaCase #-}

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

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = str >> str

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

-- solve :: Input -> Output
solve = map conv
  where
    conv 'D' = 'U'
    conv 'U' = 'D'
    conv c = c

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

readLnInt = readLn :: IO Int

loop 0 _ = return ()
loop n action = do
  action
  loop (n - 1) action

main = do
  t <- readLnInt
  loop t $ do
    n <- readLnInt
    s <- getLine
    putStrLn $ map (\c -> if c == 'U' then 'D' else c) s


After Fox Ciel got off a bus, she found that the bus she was on was a wrong bus and she lost her way in a strange town. However, she fortunately met her friend Beaver Taro and asked which way to go to her castle. Taro's response to her was a string s, and she tried to remember the string s correctly.However, Ciel feels n strings b1, b2, ... , bn are really boring, and unfortunately she dislikes to remember a string that contains a boring substring. To make the thing worse, what she can remember is only the contiguous substring of s.Determine the longest contiguous substring of s that does not contain any boring string, so that she can remember the longest part of Taro's response.

In the first line there is a string s. The length of s will be between 1 and 105, inclusive. In the second line there is a single integer n (1 ≤ n ≤ 10).  Next n lines, there is a string bi (1 ≤ i ≤ n). Each length of bi will be between 1 and 10, inclusive. Each character of the given strings will be either a English alphabet (both lowercase and uppercase) or a underscore ('_') or a digit. Assume that these strings are case-sensitive.

Output in the first line two space-separated integers len and pos: the length of the longest contiguous substring of s that does not contain any bi, and the first position of the substring (0-indexed). The position pos must be between 0 and |s| - len inclusive, where |s| is the length of string s. If there are several solutions, output any.

Go_straight_along_this_street
5
str
long
tree
biginteger
ellipse

NoteIn the first sample, the solution is traight_alon.In the second sample, the solution is an empty string, so the output can be «0 0», «0 1», «0 2», and so on.In the third sample, the solution is either nagio or oisii.

{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, ImplicitParams #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Foreign
import Foreign.C
import Data.List
import Data.Ord
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set

main :: IO ()
main = do
  sentence  :: BString    <- input
  let l = BS.length sentence
  n         :: Int        <- input
  keywords  :: [BString]  <- replicateM n input
  best      :: Ptr Int    <- newArray [0, 0]
  let dfs !begin !end (k : ks)
        | begin > end                 = return ()
        | Just (end', begin') <- next = dfs begin end' ks >> dfs begin' end (k : ks)
        | otherwise                   = dfs begin end ks
       where next =  listToMaybe [(i - 1, i - d + 1) | i <- [begin + d .. end :: Int], check i d]
               where d      = BS.length k - 1
                     check !i !j | j < 0                               = True
                                 | BS.index sentence i == BS.index k j = check (i - 1) (j - 1)
                                 | otherwise                           = False
      dfs !begin !end  []
        | begin > end                 = return ()
        | otherwise                   = do
            let v = end - begin + 1
            v' <- peek best
            when (v' <= v) $ do
              pokeElemOff best 0 v
              pokeElemOff best 1 begin
  dfs 0 (l - 1) keywords
  peekElemOff best 0 >>= output
  peekElemOff best 1 >>= output'

--------------------------------------------------
-- Imported C functions
--------------------------------------------------
#define BUFMAX                (100005)

type BString = BS.ByteString

foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i     :: CString -> Ptr Int   -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_i64   :: CString -> Ptr Int64 -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_f     :: CString -> Ptr Float -> IO ()
foreign import ccall unsafe "stdio.h scanf"
  c_scanf_s     :: CString -> CString   -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i    :: CString -> Int       -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_i64  :: CString -> Int64     -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_d    :: CString -> Double    -> IO ()
foreign import ccall unsafe "stdio.h printf"
  c_printf_s    :: CString -> CString   -> IO ()

fmt_i, fmt_i64, fmt_f, fmt_d, fmt_s :: CString
fmt_i   = unsafePerformIO $ newCString "%d"
fmt_i64 = unsafePerformIO $ newCString "%I64d"
fmt_f   = unsafePerformIO $ newCString "%f"
fmt_d   = unsafePerformIO $ newCString "%.16f"
fmt_s   = unsafePerformIO $ newCString "%s"
{-# NOINLINE fmt_i    #-}
{-# NOINLINE fmt_i64  #-}
{-# NOINLINE fmt_f    #-}
{-# NOINLINE fmt_d    #-}
{-# NOINLINE fmt_s    #-}

ptr_i   :: Ptr Int
ptr_i   = unsafePerformIO malloc
ptr_i64 :: Ptr Int64
ptr_i64 = unsafePerformIO malloc
ptr_f   :: Ptr Float
ptr_f   = unsafePerformIO malloc
ptr_d   :: Ptr Double
ptr_d   = unsafePerformIO malloc
ptr_s   :: CString
ptr_s   = unsafePerformIO $ mallocArray BUFMAX
{-# NOINLINE ptr_i    #-}
{-# NOINLINE ptr_i64  #-}
{-# NOINLINE ptr_f    #-}
{-# NOINLINE ptr_d    #-}
{-# NOINLINE ptr_s    #-}

class Input a           where
  input :: IO a

instance Input Int      where
  input = c_scanf_i fmt_i ptr_i >> peek ptr_i
instance Input Int64    where
  input = c_scanf_i64 fmt_i64 ptr_i64 >> peek ptr_i64
instance Input Integer  where
  input = toInteger <$> (input :: IO Int64)
instance Input Double   where
  input = c_scanf_f fmt_f ptr_f >> realToFrac <$> peek ptr_f
instance Input String   where
  input = c_scanf_s fmt_s ptr_s >> peekCString ptr_s
instance Input BString  where
  input = c_scanf_s fmt_s ptr_s >> BS.packCString ptr_s

class Output a          where
  output_   :: a -> IO ()
  output    :: a -> IO ()
  output    = (>> space  ) . output_
  output'   :: a -> IO ()
  output'   = (>> newline) . output_

instance Output Int     where
  output_   = c_printf_i fmt_i
instance Output Int64   where
  output_   = c_printf_i64 fmt_i64
instance Output Integer where
  output_   = output_ . show
instance Output Double  where
  output_   = c_printf_d fmt_d
instance Output String  where
  output_   = flip withCString (c_printf_s fmt_s)
instance Output BString where
  output_   = flip BS.useAsCString (c_printf_s fmt_s)

space   :: IO ()
space   = output_ (" "  :: String)

newline :: IO ()
newline = output_ ("\n" :: String)

for   :: Int -> Int -> (Int -> IO ()) -> IO ()
for !begin !end k = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = k i >> loop (i + 1)

for_  :: Int -> Int -> IO () -> IO ()
for_ !begin !end m = loop begin
  where loop !i | i >= end  = return ()
                | otherwise = m >> loop (i + 1)

rep   :: Int -> (Int -> IO ()) -> IO ()
rep   = for 0

rep_  :: Int -> IO () -> IO ()
rep_  = for_ 0


One day Vasya came up to the blackboard and wrote out n distinct integers from 1 to n in some order in a circle. Then he drew arcs to join the pairs of integers (a, b) (a ≠ b), that are either each other's immediate neighbors in the circle, or there is number c, such that a and с are immediate neighbors, and b and c are immediate neighbors. As you can easily deduce, in the end Vasya drew 2·n arcs.For example, if the numbers are written in the circle in the order 1, 2, 3, 4, 5 (in the clockwise direction), then the arcs will join pairs of integers (1, 2), (2, 3), (3, 4), (4, 5), (5, 1), (1, 3), (2, 4), (3, 5), (4, 1) and (5, 2).Much time has passed ever since, the numbers we wiped off the blackboard long ago, but recently Vasya has found a piece of paper with 2·n written pairs of integers that were joined with the arcs on the board. Vasya asks you to find the order of numbers in the circle by these pairs.

The first line of the input contains a single integer n (5 ≤ n ≤ 105) that shows, how many numbers were written on the board. Next 2·n lines contain pairs of integers ai, bi (1 ≤ ai, bi ≤ n, ai ≠ bi) — the numbers that were connected by the arcs. It is guaranteed that no pair of integers, connected by a arc, occurs in the input more than once. The pairs of numbers and the numbers in the pairs are given in the arbitrary order.

If Vasya made a mistake somewhere and there isn't any way to place numbers from 1 to n on the circle according to the statement, then print a single number "-1" (without the quotes). Otherwise, print any suitable sequence of n distinct integers from 1 to n.  If there are multiple solutions, you are allowed to print any of them. Specifically, it doesn't matter which number you write first to describe the sequence of the order. It also doesn't matter whether you write out the numbers in the clockwise or counter-clockwise direction.

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

comm :: [Int] -> [Int] -> Int
comm [] _ = 0
comm _ [] = 0
comm a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> comm at b
    EQ -> succ $ comm at bt
    GT -> comm a bt

ok :: [Int] -> [Int] -> Bool
ok a b = (==2) $ comm a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 || w == -1 then ret else gao w v (w:ret)
        where
          w = head $ (++[-1]) $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | fmap length e /= listArray (1, n) (repeat 4) = []
        | n <= 8    = head $ (++[[]]) $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  if length ans == n
    then putStrLn $ unwords $ map show $ ans
    else putStrLn "-1"

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    putStrLn $ solve n l

solve :: Int -> [[Int]] -> String
solve n l =
    if precheck g then
        findAnswer n g
    else
        "-1"
    where
        g = mkGraph n l
        precheck g = and [length (g A.! i) == 4 | i <- [1..n]]

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> String
findAnswer n g = M.fromMaybe ("-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        let g' = f 1
        y <- g' A.! x
        return (dfs x y g')
    return . unwords . map show $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [1])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub n
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! (a A.! x)) && elem v (g A.! (a A.! y)) && elem v (g A.!(a A.! z)) && elem v (g A.! (a A.! w)) in
                b `seq` (b && sub (k-1))

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

diff :: [Int] -> [Int] -> [Int]
diff [] _ = []
diff a [] = a
diff a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> ah: diff at b
    EQ -> diff at bt
    GT -> diff a bt

ok :: [Int] -> [Int] -> Bool
ok a b = null $ drop 2 $ diff a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 then ret else gao w v (w:ret)
        where
          w = head $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | n <= 8    = head $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  putStrLn $ unwords $ map show $ ans

import Data.Array
import Data.List
import Data.Maybe
import Data.Tuple
import qualified Data.ByteString.Char8 as C

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

comm :: [Int] -> [Int] -> Int
comm [] _ = 0
comm _ [] = 0
comm a@(ah:at) b@(bh:bt) =
  case compare ah bh of
    LT -> comm at b
    EQ -> succ $ comm at bt
    GT -> comm a bt

ok :: [Int] -> [Int] -> Bool
ok a b = (==2) $ comm a b

fromList :: Int -> [(Int, Int)] -> Array Int [Int]
fromList n el = fmap sort $ accumArray (flip (:)) [] (1, n) $ el ++ map swap el

main :: IO ()
main = do
  (n:el) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let e = fromList n $ pairs el
      gao v p ret = if w == 1 then ret else gao w v (w:ret)
        where
          w = head $ filter (\i -> i /= p && ok (e!v) (e!i)) $ e!v
      ans
        | n <= 8    = head $ filter check $ permutations [1 .. n]
        | otherwise = gao 1 1 [1]
        where
          check p = (==e) $ fromList n $ zip p (rot 1 p) ++ zip p (rot 2 p)
          rot k a = let (l, r) = splitAt k a in r ++ l
  putStrLn $ unwords $ map show $ ans

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        y <- g A.! x
        if x == y then return [] else return (dfs x y (f x))
    return . B.unwords . map (B.pack . show ) $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]
dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
            in
            let b = elem k (g A.! x) && elem k (g A.! y) && elem k (g A.! z) && elem k (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) [dfs 1 x g | x <- g A.! 1]
    return . B.unwords . map (B.pack . show ) $ l

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
            in
            let b = elem k (g A.! x) && elem k (g A.! y) && elem k (g A.! z) && elem k (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) [dfs 1 x g | x <- g A.! 1]
    return . B.unwords . map (B.pack . show ) $ l

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = True

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    B.putStrLn $ solve n l

solve :: Int -> [[Int]] -> B.ByteString
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> B.ByteString
findAnswer n g = M.fromMaybe (B.pack "-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        y <- g A.! x
        if x == y then return [] else return (dfs x y (f x))
    return . B.unwords . map (B.pack . show ) $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]
dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub 0
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! x) && elem v (g A.! y) && elem v (g A.! z) && elem v (g A.! w) in
                b `seq` (b && sub (k-1))

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import qualified Data.Array.ST as STArray
import qualified Data.Maybe as M
import qualified Control.Monad.ST as ST
import qualified Data.List as L
import Control.Monad

type IGraph = A.Array Int [Int]
type MGraph s = ST.ST s (STArray.STArray s Int [Int])

main :: IO ()
main = do
    n <- B.getLine >>= return . M.fromMaybe 0 . fmap fst . B.readInt
    l <- replicateM (2*n) (B.getLine >>= return . map (M.fromMaybe 0 . fmap fst . B.readInt) . B.words)
    putStrLn $ solve n l

solve :: Int -> [[Int]] -> String
solve n l = findAnswer n . mkGraph n $ l

mkGraph :: Int -> [[Int]] -> IGraph
mkGraph n l = STArray.runSTArray $ do
    g <- STArray.newArray (1,n) [] :: MGraph s
    sequence_ [write g a b | [a,b] <- l]
    return g
    where
        write g a b = do
            l <- STArray.readArray g a
            STArray.writeArray g a (b:l)
            l' <- STArray.readArray g b
            STArray.writeArray g b (a:l')

findAnswer :: Int -> IGraph -> String
findAnswer n g = M.fromMaybe ("-1") $ do
    l <- L.find (check n g) $ do
        x <- g A.! 1
        let g' = f x
        y <- g' A.! x
        if y == 1 then return [] else return (dfs x y g')
    return . unwords . map show $ l
    where
        f x = A.accum (flip L.delete) g [(i,x) | i <- g A.! x]

dfs :: Int -> Int -> IGraph -> [Int]
dfs x y graph = ST.runST $ STArray.thaw graph >>= (\g ->sub x y g [1])
    where
        sub :: Int -> Int -> STArray.STArray s Int [Int] -> [Int] -> ST.ST s [Int]
        sub x y g res = do
            l <- STArray.readArray g x
            sequence_ [STArray.readArray g y >>= (\l -> STArray.writeArray g y (L.delete x l) ) | y <- l]
            next <- STArray.readArray g y
            let inter = L.intersect next (graph A.! x)
            if L.null inter then return (y:x:res) else sub y (head inter) g (x:res)

check :: Int -> IGraph -> [Int] -> Bool
check n g l
    | length l /= n  = False
    | otherwise      = sub n
    where
        a = A.listArray (1,n) l
        sub 0 = True
        sub k =
            let x = if k <= 2 then k - 2 + n else k - 2
                y = if k <= 1 then k - 1 + n else k - 1
                z = if k >  n-1 then k - n + 1 else k + 1
                w = if k >  n-2 then k - n + 2 else k + 2
                v = a A.! k
            in
            let b = elem v (g A.! (a A.! x)) && elem v (g A.! (a A.! y)) && elem v (g A.!(a A.! z)) && elem v (g A.! (a A.! w)) in
                b `seq` (b && sub (k-1))


There are three cells on an infinite 2-dimensional grid, labeled $$$A$$$, $$$B$$$, and $$$F$$$. Find the length of the shortest path from $$$A$$$ to $$$B$$$ if:   in one move you can go to any of the four adjacent cells sharing a side;  visiting the cell $$$F$$$ is forbidden (it is an obstacle).

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Before each test case, there is an empty line. Each test case contains three lines. The first one contains two integers $$$x_A, y_A$$$ ($$$1 \le x_A, y_A \le 1000$$$) — coordinates of the start cell $$$A$$$. The second one contains two integers $$$x_B, y_B$$$ ($$$1 \le x_B, y_B \le 1000$$$) — coordinates of the finish cell $$$B$$$. The third one contains two integers $$$x_F, y_F$$$ ($$$1 \le x_F, y_F \le 1000$$$) — coordinates of the forbidden cell $$$F$$$. All cells are distinct. Coordinate $$$x$$$ corresponds to the column number and coordinate $$$y$$$ corresponds to the row number (see the pictures below).

Output $$$t$$$ lines. The $$$i$$$-th line should contain the answer for the $$$i$$$-th test case: the length of the shortest path from the cell $$$A$$$ to the cell $$$B$$$ if the cell $$$F$$$ is not allowed to be visited.

Note    An example of a possible shortest path for the first test case.     An example of a possible shortest path for the second test case.

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

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

import Prelude
import Control.Monad

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

    (putStr . unlines . map solve) tcs

readTC = do
    "" <- getLine
    replicateM 3 readIListLn

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

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

solve [[ax,ay], [bx,by], [fx,fy]] = show $ dx + dy + obstacle
  where
    minX = min ax bx
    minY = min ay by
    maxX = max ax bx
    maxY = max ay by
    dx = maxX - minX
    dy = maxY - minY
    obstacle | (isCLine && isBetween) = 2 | otherwise = 0
    isCLine = (dx == 0) || (dy == 0)
    isBetween = (minX <= fx && fx <= maxX && minY <= fy && fy <= maxY)
solve _ = error "Bad TC input"

import Control.Monad (replicateM_)

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

calcDistance [xa, ya] [xb, yb] [xf, yf]
  | xf == xa && xa == xb &&
    min ya yb < yf && yf < max ya yb
    = 2 + normalDistance
  | yf == ya && ya == yb &&
    min xa xb < xf && xf < max xa xb
    = 2 + normalDistance
  | otherwise = normalDistance
    where normalDistance = abs (xa - xb) + abs (ya - yb)
calcDistance _ _ _ = error "Should never happen"

main = do
  t <- getInt
  replicateM_ t $ do
    _ <- getLine
    a <- getInts
    b <- getInts
    f <- getInts
    print $ calcDistance a b f

import Control.Monad (replicateM_)

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

solve [xa, ya] [xb, yb] [xf, yf]
  | dx > 0 && dy > 0 = dx + dy
  | dy == 0 = if yf == ya && xf `inRange` mkRange xa xb then dx + 2 else dx
  | otherwise = if xf == xa && yf `inRange` mkRange ya yb then dy + 2 else dy
  where
    dx = abs (xa - xb)
    dy = abs (ya - yb)
    mkRange a b = [min a b + 1, max a b - 1]
    inRange x [l, r] = x >= l && x <= r

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    a <- readInts
    b <- readInts
    f <- readInts
    print $ solve a b f

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    getLine
    [xa, ya] <- getIntList
    [xb, yb] <- getIntList
    [xc, yc] <- getIntList
    let d = abs (xa - xb) + abs (ya - yb)
    print $ if xa /= xb && ya /= yb
            then d
            else if xc == xa && xc == xb && yc > min ya yb && yc < max ya yb
                 then d + 2
                 else if yc == ya && yc == yb && xc > min xa xb && xc < max xa xb
                      then d + 2
                      else d

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

solve :: IO ()
solve = do
  [_, sa, sb, sf] <- sequence $ replicate 4 getLine
  let [xa, ya] = getints sa
      [xb, yb] = getints sb
      [xf, yf] = getints sf
      oneline = (xa == xb && xb == xf && yf > min ya yb && yf < max ya yb)
                || (ya == yb && yb == yf && xf > min xa xb && xf < max xa xb)
      dist = abs (xa-xb) + abs (ya-yb)
      res = (if oneline then dist + 2 else dist)
    in print res
  where getints s = map read $ words s :: [Int]

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

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe)

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

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

solve :: [[Int]] -> Int
solve [[xa, ya], [xb, yb], [xf, yf]]
  | xa == xf && xf == xb && min ya yb <= yf && yf <= max ya yb = gap + 2
  | ya == yf && yf == yb && min xa xb <= xf && xf <= max xa xb = gap + 2
  | otherwise = gap
  where
    gap = abs (xa - xb) + abs (ya - yb)

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

printResult = do
    nothing <- getLine
    [xa,ya] <- readInts
    [xb,yb] <- readInts
    [xf,yf] <- readInts
    print $ abs(xa-xb) + abs(ya-yb) + if (xa == xb && xa == xf && (ya-yf)*(yb-yf) < 0) || (ya == yb && ya == yf && (xa-xf)*(xb-xf) < 0) then 2 else 0

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


There are several days left before the fiftieth birthday of a famous Berland's writer Berlbury. In this connection the local library decided to make an exposition of the works of this famous science-fiction writer. It was decided as well that it is necessary to include into the exposition only those books that were published during a particular time period. It is obvious that if the books differ much in size, the visitors will not like it. That was why the organizers came to the opinion, that the difference between the highest and the lowest books in the exposition should be not more than k millimeters.The library has n volumes of books by Berlbury, arranged in chronological order of their appearance. The height of each book in millimeters is know, it is hi. As Berlbury is highly respected in the city, the organizers want to include into the exposition as many books as possible, and to find out what periods of his creative work they will manage to cover. You are asked to help the organizers cope with this hard task.

The first line of the input data contains two integer numbers separated by a space n (1 ≤ n ≤ 105) and k (0 ≤ k ≤ 106) — the amount of books by Berlbury in the library, and the maximum allowed height difference between the lowest and the highest books. The second line contains n integer numbers separated by a space. Each number hi (1 ≤ hi ≤ 106) is the height of the i-th book in millimeters.

In the first line of the output data print two numbers a and b (separate them by a space), where a is the maximum amount of books the organizers can include into the exposition, and b — the amount of the time periods, during which Berlbury published a books, and the height difference between the lowest and the highest among these books is not more than k milllimeters. In each of the following b lines print two integer numbers separated by a space — indexes of the first and the last volumes from each of the required time periods of Berlbury's creative work.

{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Monoid
import Data.Maybe
import Text.Printf

data Max = Max { maxValue :: Int } deriving (Ord, Eq)
data Min = Min { minValue :: Int } deriving (Ord, Eq)

instance Monoid Min where
	mempty = Min maxBound
	mappend = min

instance Monoid Max where
	mempty = Max minBound
	mappend = max

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n - 1) (r + n - 1)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

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

main = do
	[n, k] ← getInts
	as ← getInts

	let maxTree = build $ map Max as
	let minTree = build $ map Min as

	let diff i j = maxValue (query maxTree i j) - minValue (query minTree i j)

	let maxBooksCount i j
		| i == n + 1 = 1
		| otherwise = max (j' - i + 1) (maxBooksCount (i + 1) j')
			where
				j' = last $ takeWhile (\j'' → diff i j'' <= k) [(max i j)..n]

	let m = maxBooksCount 1 1

	let is = [(i, j) | i ← [1..n], let j = i + m - 1, j <= n, diff i j <= k]

	printf "%d %d\n" m (length is)
	sequence $ map (uncurry $ printf "%d %d\n") is

module Main where

import qualified Data.ByteString.Char8 as BS

import Data.Maybe (fromJust)
import Control.Monad (forM_)
import Data.Array.Unboxed
import qualified Data.Set as S

main :: IO ()
main = do
    [n, k] <- ints
    hs <- listArray (1, n) <$> ints
    let (m, series) = solve hs k
    p (m, length series)
    forM_ series p
  where
    p (a, b) = putStrLn $ show a <> " " <> show b

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

solve :: UArray Int Int -> Int -> (Int, [(Int, Int)])
solve hs k = go (from, from + 1) (0, []) $ S.singleton (hs ! from, from)
  where
    (from, to) = bounds hs
    n = to - from + 1

    update i@(l, r) res@(m, s)
      | p > m = (p, [i])
      | p == m = (m, i:s)
      | otherwise = res
      where p = r - l + 1

    go (l, r) res acc
      | r > to = commitPred
      | fst (S.findMax accR) - fst (S.findMin accR) <= k = go (l, r + 1) res accR
      | otherwise = go (l + 1, r) commitPred (S.delete (hs ! l, l) accR)
      where
        commitPred = update (l, r - 1) res
        accR = S.insert (hs ! r, r) acc


This is the hard version of this problem. The difference between easy and hard versions is only the constraints on $$$a_i$$$ and on $$$n$$$. You can make hacks only if both versions of the problem are solved.Burenka is the crown princess of Buryatia, and soon she will become the $$$n$$$-th queen of the country. There is an ancient tradition in Buryatia — before the coronation, the ruler must show their strength to the inhabitants. To determine the strength of the $$$n$$$-th ruler, the inhabitants of the country give them an array of $$$a$$$ of exactly $$$n$$$ numbers, after which the ruler must turn all the elements of the array into zeros in the shortest time. The ruler can do the following two-step operation any number of times:   select two indices $$$l$$$ and $$$r$$$, so that $$$1 \le l \le r \le n$$$ and a non-negative integer $$$x$$$, then  for all $$$l \leq i \leq r$$$ assign $$$a_i := a_i \oplus x$$$, where $$$\oplus$$$ denotes the bitwise XOR operation. It takes $$$\left\lceil \frac{r-l+1}{2} \right\rceil$$$ seconds to do this operation, where $$$\lceil y \rceil$$$ denotes $$$y$$$ rounded up to the nearest integer. Help Burenka calculate how much time she will need.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 500)$$$  — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ $$$(1 \le n \le 10^5)$$$ - the size of the array The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \cdots , a_n$$$ $$$(0 \le a_i < 2^{30})$$$ — elements of the array. It is guaranteed that the sum of $$$n$$$ in all tests does not exceed $$$10^5$$$.

For each test case, output a single number  — the minimum time that Burenka will need.

NoteIn the first test case, Burenka can choose segment $$$l = 1$$$, $$$r = 4$$$, and $$$x=5$$$. so it will fill the array with zeros in $$$2$$$ seconds.In the second test case, Burenka first selects segment $$$l = 1$$$, $$$r = 2$$$, and $$$x = 1$$$, after which $$$a = [0, 2, 2]$$$, and then the segment $$$l = 2$$$, $$$r = 3$$$, and $$$x=2$$$, which fills the array with zeros. In total, Burenka will spend $$$2$$$ seconds.

{-# LANGUAGE FlexibleContexts #-}
import           Data.Bits
import qualified Data.ByteString.Lazy          as B
import qualified Data.ByteString.Lazy.Char8    as BC
import           Data.List
import           Data.Maybe
import qualified Data.Set                      as S

bread = fst . fromJust . BC.readInt

solve (n, xs) =
  let (r, _, _) =
        foldl' solve' (0, 0, S.fromList [0]) (map bread $ BC.words xs)
  in  BC.pack $ show $ bread n - r
 where
  solve' :: (Int, Int, S.Set Int) -> Int -> (Int, Int, S.Set Int)
  solve' (c, xr, s) x = (c', xr', xr' `S.insert` s')
   where
    xr'      = xr `xor` x
    (c', s') = if xr' `S.member` s then (c + 1, S.empty) else (c, s)

pairs (x : y : xs) = (x, y) : pairs xs
pairs _            = []

main = B.interact $ BC.unlines . map solve . pairs . tail . BC.lines

{-# LANGUAGE FlexibleContexts #-}
import           Data.Bits
import           Data.List
import qualified Data.Set                      as S

solve :: (String, String) -> String
solve (n, xs) =
  let (r, _, _) =
        foldl' solve' (0, 0, S.fromList [0]) (map read $ words xs)
  in  show $ read n - r
 where
  solve' :: (Int, Int, S.Set Int) -> Int -> (Int, Int, S.Set Int)
  solve' (c, xr, s) x = (c', xr', xr' `S.insert` s')
   where
    xr'      = xr `xor` x
    (c', s') = if xr' `S.member` s then (c + 1, S.empty) else (c, s)

pairs (x : y : xs) = (x, y) : pairs xs
pairs _            = []

main = interact $ unlines . map solve . pairs . tail . lines


You are given an array $$$a_1, a_2, \dots , a_n$$$, which is sorted in non-decreasing order ($$$a_i \le a_{i + 1})$$$. Find three indices $$$i$$$, $$$j$$$, $$$k$$$ such that $$$1 \le i < j < k \le n$$$ and it is impossible to construct a non-degenerate triangle (a triangle with nonzero area) having sides equal to $$$a_i$$$, $$$a_j$$$ and $$$a_k$$$ (for example it is possible to construct a non-degenerate triangle with sides $$$3$$$, $$$4$$$ and $$$5$$$ but impossible with sides $$$3$$$, $$$4$$$ and $$$7$$$). If it is impossible to find such triple, report it.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$3 \le n \le 5 \cdot 10^4$$$) — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots , a_n$$$ ($$$1 \le a_i \le 10^9$$$; $$$a_{i - 1} \le a_i$$$) — the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print the answer to it in one line. If there is a triple of indices $$$i$$$, $$$j$$$, $$$k$$$ ($$$i < j < k$$$) such that it is impossible to construct a non-degenerate triangle having sides equal to $$$a_i$$$, $$$a_j$$$ and $$$a_k$$$, print that three indices in ascending order. If there are multiple answers, print any of them. Otherwise, print -1.

NoteIn the first test case it is impossible with sides $$$6$$$, $$$11$$$ and $$$18$$$. Note, that this is not the only correct answer.In the second test case you always can construct a non-degenerate triangle.

input :: IO [Int]
input = do
    line <- getLine
    return (map read (words line))

solve 0 = do return ()

solve t = do
    [n] <- input
    a <- input
    putStrLn $
        if a !! 0 + a !! 1 <= a !! (n - 1)
        then "1 2 " ++ show n
        else "-1"
    solve (t - 1)

main = do
    [n] <- input
    solve n

{-# LANGUAGE MultiWayIf #-}
import Control.Monad
import Control.Applicative
import Data.List

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    n <- read <$> getLine :: IO Int
    a0 : a1 : a2 : as <- map read . words <$> getLine :: IO [Int]
    let
      (x0, i0, y0, j0, z0, k0)
        | a0 <= a1 = if
          | a1 <= a2 -> (a0, 1, a1, 2, a2, 3)
          | a0 <= a2 -> (a0, 1, a2, 3, a1, 2)
          | otherwise -> (a2, 3, a0, 1, a1, 2)
        | a0 <= a2 = (a1, 2, a0, 1, a2, 3)
        | a1 <= a2 = (a1, 2, a2, 3, a0, 1)
        | otherwise = (a2, 3, a1, 2, a0, 1)

      (x, i, y, j, z, k) = foldl' f (x0, i0, y0, j0, z0, k0) $ zip as [4..]
      f (x, i, y, j, z, k) (a, l)
        | a > z = (x, i, y, j, a, l)
        | a < x = (a, l, x, i, z, k)
        | a < y = (x, i, a, l, z, k)
      f xxx _ = xxx

    if x + y <= z then
      putStrLn $ show i ++ " " ++ show j ++ " " ++ show k
    else
      putStrLn "-1"

import Data.List

convertToInt :: String -> Int
convertToInt = read

readOneInt :: IO Int
readOneInt = do
    line_ <- getLine
    return $ convertToInt line_

readLineInts :: IO [Int]
readLineInts = do
    line_ <- getLine
    return $ map convertToInt $ words line_

convertIntsToLine :: [Int] -> String
convertIntsToLine [] = ""
convertIntsToLine (x:xs) = (show x) ++ " " ++ (convertIntsToLine xs)

main :: IO ()
main = do
    -- read t
    t <- readOneInt
    for t where
        for 0 = return ()
        for t' = do
            _ <- readOneInt
            ints <- readLineInts
            let nums = zip ints [1,2..]
            let sorted = sortBy (\(a,_) (b,_) -> compare a b) nums
            let (alpha:beta:last_) = sorted
            let theta = last last_
            putStrLn $ if (fst alpha) + (fst beta) <= (fst theta)
                then convertIntsToLine $ sort (snd (unzip [alpha, beta, theta]))
                else "-1"
            for (t'-1)

import Control.Monad

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

routine :: IO ()
routine = do
  n <- readLn
  as <- (map read.words) <$> getLine
  (putStrLn.unwords.map show) $ solve n as

solve :: Int -> [Int] -> [Int]
solve n (a:a':as)
  | a+a' > last as = [-1]
  | otherwise = [1,2,n]

{-# LANGUAGE ViewPatterns #-}

import Data.List

solveOne :: [Int] -> String
solveOne (splitAt 2 -> (s, e)) = maybe "-1" (("1 2 " ++) . show . (+3)) $ findIndex (>= sum s) e

main = interact $ unlines . fmap (solveOne . fmap read . words) . evens . tail . lines

evens (_:x:xs) = x:evens xs
evens a = a

import Data.List
main :: IO ()
main = do
    t <- readLn :: IO Int
    solveCases t
solveCases :: Int -> IO ()
solveCases 0 = return ()
solveCases t = do
    (n, a) <- readCaseData
    putStrLn $ intercalate " " $ map show $ getTestCaseAnswer n a
    solveCases (t - 1)
readCaseData :: IO (Int, [Int])
readCaseData = do
    n <- readLn :: IO Int
    a <- getLine
    return (n, map read (words a))
checkArray :: Int -> [Int] -> Bool
checkArray n a = x + y <= z
    where x = a !! 0
          y = a !! 1
          z = a !! (n - 1)
getTestCaseAnswer :: Int -> [Int] -> [Int]
getTestCaseAnswer n a = if checkArray n a
                        then [1, 2, n]
                        else [-1]

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

isTriangle :: (Int, Int, Int) -> Bool
isTriangle (a, b, c) = c < (a + b)

solve :: [Int] -> Maybe (Int, Int, Int)
solve as =
    if isTriangle triple
        then Nothing
        else Just tripleIndices
    where
        tripleIndices = (1, 2, length as)
        triple = (as !! 0, as !! 1, last as)

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        as <- map readIntB8 <$> B8.words <$> B8.getLine
        let answer = solve as
        case answer of
           Just (i, j, k) -> printf "%d %d %d\n" i j k
           _ -> printf "-1\n"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

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

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b <= c = Just (1,2,fromIntegral $ length xs)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> [Int]
solve p@(x:y:xs)
    | length xs < 1 = [-1, -1, -1]
    | x + y <= last xs = [1, 2, length p]
    | otherwise = [-1, -1, -1]

output :: [Int] -> [String]
output [-1, -1, -1] = ["-1"]
output xs = map show xs

myshow :: [String] -> String
myshow (x:xs)
    | null xs = x
    | otherwise = x ++ " " ++ myshow xs

deal :: IO()
deal = do
    getLine
    x <- map read . words <$> getLine
    putStrLn $ myshow $ output $ solve x

main :: IO()
main = getLine >>= flip replicateM_ deal . read

{-# LANGUAGE TypeApplications, ViewPatterns #-}

import Data.List

solveOne :: [Int] -> String
solveOne (splitAt 2 -> (s, e)) = maybe "-1" (("0 1 " ++) . show . (+2)) $ findIndex (>= sum s) e

main = interact $ unlines . fmap (solveOne . fmap read . words) . evens . tail . lines

evens (_:x:xs) = x:evens xs
evens a = a

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

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

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b < c = Just (1,2,fromIntegral $ length xs)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

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

main = interact solve

solve :: String -> String
solve input = intercalate "\n" answers
    where
        t:rest = map fastRead $ words input
        t :: Int64
        problems = inputreader rest
        answers = map (answerformat . innersolve) problems

answerformat :: Maybe (Int64,Int64,Int64) -> String
answerformat Nothing = "-1"
answerformat (Just (a, b, c)) = (show a) ++ " " ++ (show b) ++ " " ++ (show c)

inputreader :: [Int64] -> [(Int64, [Int64])]
inputreader [] = []
inputreader (x:xs) = ((x,cur)):(inputreader after)
    where
        (cur,after) = splitAt (fromIntegral x) xs

innersolve :: (Int64,[Int64]) -> Maybe (Int64,Int64,Int64)
innersolve (_,xs)
    | a+b < c = Just (a,b,c)
    | otherwise = Nothing
    where
        a:b:_ = xs
        c = last xs


Casimir has a string $$$s$$$ which consists of capital Latin letters 'A', 'B', and 'C' only. Each turn he can choose to do one of the two following actions:  he can either erase exactly one letter 'A' and exactly one letter 'B' from arbitrary places of the string (these letters don't have to be adjacent);  or he can erase exactly one letter 'B' and exactly one letter 'C' from arbitrary places in the string (these letters don't have to be adjacent). Therefore, each turn the length of the string is decreased exactly by $$$2$$$. All turns are independent so for each turn, Casimir can choose any of two possible actions.For example, with $$$s$$$ $$$=$$$ "ABCABC" he can obtain a string $$$s$$$ $$$=$$$ "ACBC" in one turn (by erasing the first occurrence of 'B' and the second occurrence of 'A'). There are also many other options for a turn aside from this particular example.For a given string $$$s$$$ determine whether there is a sequence of actions leading to an empty string. In other words, Casimir's goal is to erase all letters from the string. Is there a way to do this?

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Each test case is described by one string $$$s$$$, for which you need to determine if it can be fully erased by some sequence of turns. The string $$$s$$$ consists of capital letters 'A', 'B', 'C' and has a length from $$$1$$$ to $$$50$$$ letters, inclusive.

Print $$$t$$$ lines, each line containing the answer to the corresponding test case. The answer to a test case should be YES if there is a way to fully erase the corresponding string and NO otherwise. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes, and YES will all be recognized as positive answers).

6
ABACAB
ABBA
AC
ABC
CABCBB
BCBCBCBCBCBCBCBC

    main=let a=length.(filter(=='A'))
             b=length.(filter(=='B'))
             c=length.(filter(=='C'))
             a2bc x=if a x + c x - b x==0 then "YES" else "NO"
            in interact$unlines.map a2bc.tail.lines

solve :: Int -> IO ()
solve _ = do
    s <- getLine
    let cnt_a = length . filter (== 'A') $ s
        cnt_b = length . filter (== 'B') $ s
        cnt_c = length . filter (== 'C') $ s
    if (cnt_a + cnt_c == cnt_b) then putStrLn "YES" else putStrLn "NO"

main = do
    tc <- getLine
    let testcase = read tc :: Int
    mapM_ solve [1..testcase]

count :: Eq a => a -> [a] -> Int
count x = length . filter (x ==)

solve :: Int -> IO ()
solve _ = do
    s <- getLine
    putStrLn $ if (count 'A' s) + (count 'C' s) == (count 'B' s) then "YES" else "NO"

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

import Control.Monad ( replicateM_ )
solve = do
    x <- getLine
    putStrLn $ if length x == 2 * (length . filter (== 'B') $ x) then "YES" else "NO"

main = readLn >>= flip replicateM_ solve

import Control.Monad
import Data.List

calc :: String -> String
calc str =
  let (a,b,c) = foldl (\(a,b,c) x ->
                         if x == 'A' then (a+1,b,c)
                         else if x == 'B' then (a,b+1,c)
                         else (a,b,c+1)
                         ) (0,0,0) str
  in
    if (a+c) == b then "YES"
    else "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    putStrLn $ calc line

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

import Prelude
import System.IO
import Control.Monad
import Data.List

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering

    t <- readLn
    tcs <- replicateM t getLine

    (putStrLn . unlines . map (showB . solve)) tcs

showB False = "NO"
showB True  = "YES"

solve = f . map (flip (-) 1 . length) . group . sort . (++ "ABC")
  where
    f :: [Int] -> Bool
    f [a, b, c] = (b == a + c)
    f _         = error "letter set"

module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    putStrLn . yesOrNo $ (c 'B' s == c 'A' s + c 'C' s)

c :: (Eq a) => a -> [a] -> Int
c e = length . filter (e ==)

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

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- getNext 1
    let
      [ctA, ctB, ctC] = [P.count c s | c <- "ABC"]
    pure $ string7 $ if  ctA + ctC == ctB
      then "YES\n"
      else "NO\n"

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

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

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

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


Are you going to Scarborough Fair?Parsley, sage, rosemary and thyme.Remember me to one who lives there.He once was the true love of mine.Willem is taking the girl to the highest building in island No.28, however, neither of them knows how to get there.Willem asks his friend, Grick for directions, Grick helped them, and gave them a task.Although the girl wants to help, Willem insists on doing it by himself.Grick gave Willem a string of length n.Willem needs to do m operations, each operation has four parameters l, r, c1, c2, which means that all symbols c1 in range [l, r] (from l-th to r-th, including l and r) are changed into c2. String is 1-indexed.Grick wants to know the final string after all the m operations.

The first line contains two integers n and m (1 ≤ n, m ≤ 100). The second line contains a string s of length n, consisting of lowercase English letters. Each of the next m lines contains four parameters l, r, c1, c2 (1 ≤ l ≤ r ≤ n, c1, c2 are lowercase English letters), separated by space.

Output string s after performing m operations described above.

NoteFor the second example:After the first operation, the string is wxxak.After the second operation, the string is waaak.After the third operation, the string is gaaak.

import Data.Array
import Control.Monad
main = do
  [n,m] <- map read . words <$> getLine
  s <- listArray (1,n) <$> getLine
  s' <- foldl f s <$> replicateM m getLine
  putStrLn (elems s')
f s ws = s // map g [read l..read r] where
  [l,r,[c1],[c2]] = words ws
  g i | v == c1 = (i,c2)
      | otherwise = (i,v)
    where v = s!i

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Text as T

process s [l,r,c1,c2] = T.concat [(T.take (ll-1) s) , (T.replace (T.pack c1) (T.pack c2) (T.drop (ll-1) (T.take rr s)) ) , T.drop (rr)  s]
	where	ll= read l ::Int
		rr= read r ::Int

main= do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		s<- T.pack <$> getLine
		c<-  map words <$> replicateM m getLine
		putStrLn$ T.unpack $ foldl process s c

--ghc 7.10

import Data.List(findIndices)

operate :: (Int,Int,Char,Char) -> String -> String
operate (l,r,c1,c2) str = map (\(i,c) -> if c == c1 && i >= l && i <= r then c2 else c) . zip [1..] $ str

operateAll operands str = foldl (\acc x -> operate x acc) str operands

readLine x = (l,r,c1,c2)
    where
        [l',r',c1',c2'] = words x
        l = read l' :: Int
        r = read r' :: Int
        c1 = head c1'
        c2 = head c2'

main = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr :: [Int]
    s <- getLine
    contents <- getContents
    let operands = map readLine . lines $ contents
    putStrLn $ operateAll operands s

main = interact $ unlines . parse . lines

parse (_:s:ops') = sol s ops
  where
    ops = map (fn . words) ops'
    fn :: [String] -> (Int, Int, Char, Char)
    fn [b, e, f, t] = (read b, read e, head f, head t)

sol s ops = [ foldl makeOp s ops ]
  where
    makeOp :: String -> (Int, Int, Char, Char) -> String
    makeOp s (b, e, f, t) = let
        (tmp, end) = splitAt e s
        (beg, mid) = splitAt (b-1) tmp
        midr = map replacer mid
        replacer x = if x == f then t else x
      in beg ++ midr ++ end


There are $$$n$$$ pieces of cake on a line. The $$$i$$$-th piece of cake has weight $$$a_i$$$ ($$$1 \leq i \leq n$$$).The tastiness of the cake is the maximum total weight of two adjacent pieces of cake (i. e., $$$\max(a_1+a_2,\, a_2+a_3,\, \ldots,\, a_{n-1} + a_{n})$$$).You want to maximize the tastiness of the cake. You are allowed to do the following operation at most once (doing more operations would ruin the cake):   Choose a contiguous subsegment $$$a[l, r]$$$ of pieces of cake ($$$1 \leq l \leq r \leq n$$$), and reverse it. The subsegment $$$a[l, r]$$$ of the array $$$a$$$ is the sequence $$$a_l, a_{l+1}, \dots, a_r$$$.If you reverse it, the array will become $$$a_1, a_2, \dots, a_{l-2}, a_{l-1}, \underline{a_r}, \underline{a_{r-1}}, \underline{\dots}, \underline{a_{l+1}}, \underline{a_l}, a_{r+1}, a_{r+2}, \dots, a_{n-1}, a_n$$$.For example, if the weights are initially $$$[5, 2, 1, 4, 7, 3]$$$, you can reverse the subsegment $$$a[2, 5]$$$, getting $$$[5, \underline{7}, \underline{4}, \underline{1}, \underline{2}, 3]$$$. The tastiness of the cake is now $$$5 + 7 = 12$$$ (while before the operation the tastiness was $$$4+7=11$$$).Find the maximum tastiness of the cake after doing the operation at most once.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 50$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 1000$$$) — the number of pieces of cake. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — $$$a_i$$$ is the weight of the $$$i$$$-th piece of cake.

For each test case, print a single integer: the maximum tastiness of the cake after doing the operation at most once.

NoteIn the first test case, after reversing the subsegment $$$a[2, 5]$$$, you get a cake with weights $$$[5, \underline{7}, \underline{4}, \underline{1}, \underline{2}, 3]$$$. The tastiness of the cake is now $$$\max(5+7, 7+4, 4+1, 1+2, 2+3) = 12$$$. This is the maximum possible tastiness of the cake one can obtain by performing the operation at most once.In the second test case, it's optimal not to do any operation. The tastiness is $$$78+78 = 156$$$.In the third test case, after reversing the subsegment $$$a[1, 2]$$$, you get a cake with weights $$$[\underline{54}, \underline{69}, 91]$$$. The tastiness of the cake is now $$$\max(54+69, 69+91) = 160$$$. There is no way to make the tastiness of the cake greater than $$$160$$$ by performing at most one operation.

module Main where

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

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        _ <- getLine
        a <- map read . words <$> getLine
        print $ sum . take 2 . reverse $ sort a


A recently found Ancient Prophesy is believed to contain the exact Apocalypse date. The prophesy is a string that only consists of digits and characters "-".We'll say that some date is mentioned in the Prophesy if there is a substring in the Prophesy that is the date's record in the format "dd-mm-yyyy". We'll say that the number of the date's occurrences is the number of such substrings in the Prophesy. For example, the Prophesy "0012-10-2012-10-2012" mentions date 12-10-2012 twice (first time as "0012-10-2012-10-2012", second time as "0012-10-2012-10-2012").The date of the Apocalypse is such correct date that the number of times it is mentioned in the Prophesy is strictly larger than that of any other correct date.A date is correct if the year lies in the range from 2013 to 2015, the month is from 1 to 12, and the number of the day is strictly more than a zero and doesn't exceed the number of days in the current month. Note that a date is written in the format "dd-mm-yyyy", that means that leading zeroes may be added to the numbers of the months or days if needed. In other words, date "1-1-2013" isn't recorded in the format "dd-mm-yyyy", and date "01-01-2013" is recorded in it.Notice, that any year between 2013 and 2015 is not a leap year.

The first line contains the Prophesy: a non-empty string that only consists of digits and characters "-". The length of the Prophesy doesn't exceed 105 characters.

In a single line print the date of the Apocalypse. It is guaranteed that such date exists and is unique.

import Control.Applicative
import Data.Array.Unboxed
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

dom :: UArray Int Int
dom = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

parse :: C.ByteString -> Maybe C.ByteString
parse s =
  if C.elemIndices '-' s == [2, 5]
      && 2013 <= y && y <= 2015
      && 1 <= m && m <= 12
      && 1 <= d && d <= dom!m
    then Just s
    else Nothing
  where
    readInt = maybe 0 fst . C.readInt
    [d, m, y] = map readInt $ C.split '-' s

main :: IO ()
main = do
  input <- C.getLine
  let date = catMaybes $ map (parse . C.take 10) $ C.tails input
  C.putStrLn $ snd $ maximum $ map (liftA2 (,) length head) $ group $ sort $ date

import qualified Data.ByteString.Char8 as B
import Data.Ix
import Data.Char
import Text.Printf
import qualified Data.List as L
import qualified Data.Array as A

main :: IO()
main = do l <- B.getLine
          putStrLn $ solve l

solve :: B.ByteString -> String
solve = mkDate . snd . last . L.sort . map mkPair . L.group . L.sort . filter correctDate . findDates

findDates :: B.ByteString -> [(Int,Int,Int)]
findDates = L.foldl' accum [] . B.tails
    where
        accum e str = case match str of
                        Nothing   -> e
                        Just date -> date:e
        match str = do day   <- matchDay token0
                       month <- matchMonth token1
                       year  <- matchYear  token2
                       return (day,month,year)
            where (token0,str1) = B.span (/='-') str
                  (token1,str2) = B.span (/='-') (if B.length str1 > 0 then B.tail str1 else B.empty)
                  token2       = B.take 4 (if B.length str2 > 0 then B.tail str2 else B.empty)
        matchDay   = matchToken 2
        matchMonth = matchToken 2
        matchYear  = matchToken 4 . B.take 4
        matchToken n str | B.length str == n && B.all isDigit str = Just (B.foldl' (\ x c -> x*10+ digitToInt c) 0 str)
                         | otherwise = Nothing

correctDate :: (Int,Int,Int) -> Bool
correctDate (day,month,year) = correctDayAndMonth month day && correctYear year

correctDayAndMonth month day = inRange (1,12) month && inRange (1,calendar A.! month) day
    where calendar = A.array (1,12) [(1,31),(2,28),(3,31),(4,30),(5,31),(6,30),
                                     (7,31),(8,31),(9,30),(10,31),(11,30),(12,31)]

correctYear = inRange (2013,2015)

mkPair :: [(Int,Int,Int)] -> (Int,(Int,Int,Int))
mkPair l = (length l,head l)

mkDate :: (Int,Int,Int) -> String
mkDate (day,month,year) = printf "%02d-%02d-%04d" day month year

import Control.Monad (liftM)
import Data.Map (assocs, empty, insertWith, singleton)
import Data.Char (ord)
import Data.List (intercalate, maximumBy)

solve :: String -> String
solve s  =  solve' empty s
  where
    solve' map ""  =  fst $ maximumBy compareSnd $ assocs map
    solve' map ss@(d1:d2:'-':m1:m2:'-':y1:y2:y3:y4:s)
      | any (== '-') [d1, d2, m1, m2, y1, y2, y3, y4]  =  solve' map (tail ss)
      | correctDate y m d  =  solve' map' $ tail ss
      | otherwise  =  solve' map $ tail ss
      where
        d  =  read [d1, d2]
        m  =  read [m1, m2]
        y  =  read [y1, y2, y3, y4]
        map'  =  insertWith (+) (take 10 ss) 1 map
    solve' map ss  =  solve' map $ tail ss
    compareSnd (a, b) (c, d)  =  compare b d
    correctDate y m d
      =  2013 <= y && y <= 2015
      && 1 <= m && m <= 12
      && 1 <= d && d <= mounthDays m
    mounthDays 2  =  28
    mounthDays m
      | m `elem` [4,7,9,11]  =  30
      | otherwise  =  31

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

import qualified Data.Map as Map
import Data.Char
import Data.List

days = [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

correctDate d m y =
  2013 <= y && y <= 2015 &&
  1    <= m && m <= 12   &&
  1    <= d && d <= days !! m

collectDates (d1:d2:t1:m1:m2:t2:y1:y2:y3:y4:rest)
  | correct   = [d1, d2, t1, m1, m2, t2, y1, y2, y3, y4]:collectDates next
  | otherwise = collectDates next
  where correct = [t1, t2] == "--" && allDigits && correctDate d m y
        allDigits = all isDigit [d1, d2, m1, m2, y1, y2, y3, y4]
        d = read [d1, d2]
        m = read [m1, m2]
        y = read [y1, y2, y3, y4]
        next = d2:t1:m1:m2:t2:y1:y2:y3:y4:rest

collectDates _ = []

solve xs = fst $ maximumBy (\(_, x) (_, y) -> compare x y) $ map (\x -> (head x, length x)) $ group dates
  where dates = sort $ collectDates xs

main = interact solve

{-# OPTIONS_GHC -O2 #-}

import Data.Array.Base
import Data.Array.IO (IOUArray)
import Text.Printf

main = getLine >>= solve

isNum c = '0'<=c && c<='9'

solve cs = do
  arr <- newArray (0,50000) 0 :: IO (IOUArray Int Int)
  let f (d1:d2:'-':m1:m2:'-':'2':'0':'1':y4:rest)
        | '3'<=y4 && y4<='5' && all isNum [d1,d2,m1,m2] && isDate m d=unsafeRead arr ymd>>=unsafeWrite arr ymd.(1+)>>f ('1':y4:rest)
       where
         d=read[d1,d2]
         m=read[m1,m2]
         y=read$'2':'0':'1':[y4]
         ymd=(y-2013)*10000+m*100+d
      f (_:cs) = f $ dropWhile ('-'==) cs
      f _ = getElems arr>>=putStrLn.showAns.maximum.(`zip`[0..])
  f cs

showAns :: (Int,Int) -> String
showAns (_,ymd) = printf"%02d-%02d-%4d" d m y
   where
     y = 2013 + ymd`div`10000
     m = ymd`mod`10000`div`100
     d = ymd`mod`100

isDate :: Int -> Int -> Bool
isDate m d = 1<=m && m<=12 && 1<=d && d<=dmax
   where
     dmax = [31,28,31,30,31,30,31,31,30,31,30,31]!!(m-1)

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

mon = [0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

main = getLine >>= putStrLn.snd.maximum.map (\x -> (length x, head x)).group.sort.all_date
--main = getLine >>= putStrLn.show.all_date

get_int s x = foldl (\a b -> a*10 + (ord (s !! b) - 48)) 0 x

valid_date :: String -> Bool
valid_date s = 	2013 <= yy && yy <= 2015 && 1 <= mm && mm <= 12 && 1 <= dd && dd <= (mon !! mm)
			   where
			    dd = get_int s [0,1];
				mm = get_int s [3,4];
				yy = get_int s [6..9];

check :: String -> Maybe String
check s = if length s == 10 && '-' `elemIndices` s == [2,5] then
			if valid_date s then Just s else Nothing
		  else Nothing

all_date :: String -> [String]
all_date x = catMaybes $ filter (\x -> x /= Nothing) $ map (check.take 10) $ tails x

import Data.List (tails, elemIndices, sort, group, maximum)
import Data.Array.Unboxed
import Data.Maybe (catMaybes)

splitHelper c [] = ([], [])
splitHelper c (x:rest) = if x == c
                           then ([], rest)
                           else let (a, r) = splitHelper c rest in (x:a, r)

split c [] = []
split c s = let (a, r) = splitHelper c s
              in a : split c r

findDate :: String -> Maybe [Int]
findDate l = if elemIndices '-' l == [2,5]
               then Just (map (read :: String -> Int) $ split '-' l)
               else Nothing

dmc :: UArray Int Int
dmc = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

validDay :: Int -> Int -> Bool
validDay d m = 1 <= d && d <= (dmc!m)

validDate :: [Int] -> Bool
validDate [d, m, y] = 2013 <= y && y <= 2015 &&
                             1 <= m && m <= 12 &&
                             validDay d m

showD n = let m = (show n) in if (length m == 1) then '0': m else m

prettyDate (_, [d, m, y]) = (showD d) ++ "-" ++ (showD m) ++ "-" ++ (show y)

main = do
  str <- getLine
  putStrLn $ (prettyDate . maximum . map (\x -> (length x, head x)) . group . sort .
              filter validDate . catMaybes . map (findDate . take 10) . tails) str

import Data.List (tails, elemIndices, sort, group, maximum)
import Data.Array.Unboxed
import Data.Maybe (catMaybes)

splitHelper c [] = ([], [])
splitHelper c (x:rest) = if x == c
                           then ([], rest)
                           else let (a, r) = splitHelper c rest in (x:a, r)

split c [] = []
split c s = let (a, r) = splitHelper c s
              in a : split c r

findDate :: String -> Maybe [Int]
findDate l = if elemIndices '-' l == [2,5]
               then Just (map (read :: String -> Int) $ split '-' l)
               else Nothing

dmc :: UArray Int Int
dmc = listArray (1,12) [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31]

validDay :: Int -> Int -> Bool
validDay d m = 1 <= d && d <= (dmc!m)

validDate :: [Int] -> Bool
validDate [d, m, y] = 2013 <= y && y <= 2015 &&
                             1 <= m && m <= 12 &&
                             validDay d m

prettyDate (_, [d, m, y]) = (show d) ++ "-" ++ (show m) ++ "-" ++ (show y)

main = do
  str <- getLine
  putStrLn $ (prettyDate . maximum . map (\x -> (length x, head x)) . group . sort .
              filter validDate . catMaybes . map (findDate . take 10) . tails) str


Petya has got an interesting flower. Petya is a busy person, so he sometimes forgets to water it. You are given $$$n$$$ days from Petya's live and you have to determine what happened with his flower in the end.The flower grows as follows:   If the flower isn't watered for two days in a row, it dies.  If the flower is watered in the $$$i$$$-th day, it grows by $$$1$$$ centimeter.  If the flower is watered in the $$$i$$$-th and in the $$$(i-1)$$$-th day ($$$i > 1$$$), then it grows by $$$5$$$ centimeters instead of $$$1$$$.  If the flower is not watered in the $$$i$$$-th day, it does not grow. At the beginning of the $$$1$$$-st day the flower is $$$1$$$ centimeter tall. What is its height after $$$n$$$ days?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains the only integer $$$n$$$ ($$$1 \leq n \leq 100$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$a_i = 0$$$ or $$$a_i = 1$$$). If $$$a_i = 1$$$, the flower is watered in the $$$i$$$-th day, otherwise it is not watered.

For each test case print a single integer $$$k$$$ — the flower's height after $$$n$$$ days, or $$$-1$$$, if the flower dies.

module Main where

import Text.Parsec

main = do
    getLine
    (Right inp) <- parse parser "" <$> getContents
    mapM_ (print . getHeight 1 . reverse) inp

getHeight h [] = h
getHeight _ (0:0:_) = -1
getHeight h (1:1:xs) = getHeight (h+5) (1:xs)
getHeight h (1:xs) = getHeight (h+1) xs
getHeight h (0:xs) = getHeight h xs

parser :: Parsec String () [[Int]]
parser = (do
         number
         newline
         number `sepBy` char ' ') `sepEndBy` newline

number = read <$> many1 digit

module Main where

import Text.Parsec

main = do
    getLine
    (Right inp) <- parse parser "" <$> getContents
    mapM_ (print . getHeight 1) inp

getHeight h [] = h
getHeight _ (0:0:_) = -1
getHeight h (1:1:xs) = getHeight (h+6) xs
getHeight h (1:xs) = getHeight (h+1) xs
getHeight h (0:xs) = getHeight h xs

parser :: Parsec String () [[Int]]
parser = (do
         number
         newline
         number `sepBy` char ' ') `sepEndBy` newline

number = read <$> many1 digit


Little Petya likes arrays that consist of non-negative integers a lot. Recently his mom has presented him one such array consisting of n elements. Petya immediately decided to find there a segment of consecutive elements, such that the xor of all numbers from this segment was maximal possible. Help him with that.The xor operation is the bitwise exclusive "OR", that is denoted as "xor" in Pascal and "^" in C/C++/Java.

The first line contains integer n (1 ≤ n ≤ 100) — the number of elements in the array. The second line contains the space-separated integers from the array. All numbers are non-negative integers strictly less than 230.

Print a single integer — the required maximal xor of a segment of consecutive elements.

NoteIn the first sample one of the optimal segments is the segment that consists of the first and the second array elements, if we consider the array elements indexed starting from one.The second sample contains only one optimal segment, which contains exactly one array element (element with index three).

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Bits.html

import Data.Bits

maxXor :: [Int] -> Int
maxXor [] = 0
maxXor a = max (maxPrefixXor a 0) (maxXor (tail a))

maxPrefixXor :: [Int] -> Int -> Int
maxPrefixXor [] x = x
maxPrefixXor (a : b) x = max (xor a x) (maxPrefixXor b (xor a x))

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	let list = map read (words str2)
	putStrLn (show (maxXor (list)))

import Data.Bits
import Data.List

main = interact $ show . solve . map read . words . (!! 1) . lines

solve :: [Int] -> Int
solve = maximum . map (maximum . map (foldl xor 0) . tails) . inits

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Data.Bits (xor)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: Int -> [Int] -> Int
solve n xs  =  maximum [foldl1 xor [a ! k | k <- [i .. j]] | i <- [1 .. n], j <- [i .. n]]
  where
    a  =  listArray (1, n) xs

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  reads
    print $ solve n xs

-- Codeforces 252B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

readInt :: BC.ByteString -> Int
readInt !s = case BC.readInt s of Just (n, _) -> n

main :: IO ()
main = do
    (x:xs) <- (map readInt . BC.words) <$> BC.getContents :: IO [Int]
    let ys = scanl1 xor (0:xs)
    print $ maximum [x `xor` y | x <- ys, y <- ys]

import Data.List
import Data.Bits

xorSegment xs i j = foldl xor 0 $ take (j - i + 1) $ drop i xs

solve :: [Int] -> Int
solve xs = maximum [(xorSegment xs i j) | i <- [0 .. n], j <- [i .. n]]
  where n = length xs

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

import Data.List
import Data.Bits

xorSegment xs i j = foldl' xor 0 $ take (j - i + 1) $ drop i xs

solve :: [Int] -> Int
solve xs = foldl' max 0 [(xorSegment xs i j) | i <- [0 .. n], j <- [i .. n]]
  where n = length xs

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

import Data.Bits
main = getContents>>=print.solve.map read.tail.words

solve :: [Int] -> Int
solve xs = maximum $ ys ++ [y1`xor`y2|y1<-ys,y2<-ys]
   where
     ys = scanl1 xor xs

import Data.Bits
main = getContents >>= print.solve.map read.tail.words

solve :: [Int] -> Int
solve [] = 0
solve ls = maximum [(fst (foldl (\(x,y) z -> (maximum [x,y `xor` z], y `xor` z)) (0,0) ls)), (solve (tail ls)) ]

import Data.Bits(xor)

main = do
    n <- getLine
    ar <- getLine
    let ls = map read (words ar) :: [Int]
    print $ foreachXor ls

foreachXor [] = 0
foreachXor xs'@(x:xs) = maxXor (x:xs) 0 `max` foreachXor xs

maxXor [] _ = 0
maxXor (x:xs) s = currentXor `max` maxXor xs currentXor
    where currentXor = xor x s

import Data.Bits
main = do
  (n : input) <- fmap (map read . words) getContents
  let par = scanl1 xor (input :: [Int]) ++ [0]
  print $ maximum [x `xor` y | x <- par, y <- par]

-- Codeforces 252B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

readInt :: BC.ByteString -> Int
readInt !s = case BC.readInt s of Just (n, _) -> n

main :: IO ()
main = do
    (x:xs) <- (map readInt . BC.words) <$> BC.getContents :: IO [Int]
    let ys = scanl1 xor xs
    print $ maximum [x `xor` y | x <- ys, y <- ys]

import Data.Bits(xor)

main = do
    n <- getLine
    ar <- getLine
    let lsAr = map read (words ar) :: [Int]
    print $ maximum $ maximum lsAr : maxXor lsAr 0 ++ maxXor (reverse lsAr) 0

maxXor [] _ = []
maxXor (x:xs) s = currentXor : maxXor xs currentXor
    where currentXor = xor x s

import Data.Bits
main = do
  (n : input) <- fmap (map read . words) getLine
  let par = scanl1 xor (input :: [Int]) ++ [0]
  print $ maximum [x `xor` y | x <- par, y <- par]