Ayush, Ashish and Vivek are busy preparing a new problem for the next Codeforces round and need help checking if their test cases are valid.Each test case consists of an integer $$$n$$$ and two arrays $$$a$$$ and $$$b$$$, of size $$$n$$$. If after some (possibly zero) operations described below, array $$$a$$$ can be transformed into array $$$b$$$, the input is said to be valid. Otherwise, it is invalid.An operation on array $$$a$$$ is:   select an integer $$$k$$$ $$$(1 \le k \le \lfloor\frac{n}{2}\rfloor)$$$  swap the prefix of length $$$k$$$ with the suffix of length $$$k$$$ For example, if array $$$a$$$ initially is $$$\{1, 2, 3, 4, 5, 6\}$$$, after performing an operation with $$$k = 2$$$, it is transformed into $$$\{5, 6, 3, 4, 1, 2\}$$$.Given the set of test cases, help them determine if each one is valid or invalid.

The first line contains one integer $$$t$$$ $$$(1 \le t \le 500)$$$ — the number of test cases. The description of each test case is as follows. The first line of each test case contains a single integer $$$n$$$ $$$(1 \le n \le 500)$$$ — the size of the arrays. The second line of each test case contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ $$$(1 \le a_i \le 10^9)$$$ — elements of array $$$a$$$. The third line of each test case contains $$$n$$$ integers $$$b_1$$$, $$$b_2$$$, ..., $$$b_n$$$ $$$(1 \le b_i \le 10^9)$$$ — elements of array $$$b$$$.

For each test case, print "Yes" if the given input is valid. Otherwise print "No". You may print the answer in any case.

NoteFor the first test case, we can swap prefix $$$a[1:1]$$$ with suffix $$$a[2:2]$$$ to get $$$a=[2, 1]$$$.For the second test case, $$$a$$$ is already equal to $$$b$$$.For the third test case, it is impossible since we cannot obtain $$$3$$$ in $$$a$$$.For the fourth test case, we can first swap prefix $$$a[1:1]$$$ with suffix $$$a[4:4]$$$ to obtain $$$a=[2, 2, 3, 1]$$$. Now we can swap prefix $$$a[1:2]$$$ with suffix $$$a[3:4]$$$ to obtain $$$a=[3, 1, 2, 2]$$$.For the fifth test case, it is impossible to convert $$$a$$$ to $$$b$$$.

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Char8 as BS
import Data.Set as S
import Data.List as L

perm xs n =
  let (i, t) = L.splitAt n xs
      (j, k) = L.splitAt (length xs - 2 * n) t
   in k ++ j ++ i

go :: [Int] -> State (Set [Int]) ()
go l = do
  seen <- get
  unless (member l seen) do
    modify' $ S.insert l
    mapM_ go [perm l i | i <- [1 .. quot (length l) 2]]

varl :: Int -> Integer
varl = genericLength . S.toList . flip execState S.empty . go . enumFromTo 1

pairs :: Int -> [Int] -> [[Int]]
pairs k xs = let u = L.take k xs
                 v = L.take k $ reverse xs
                 sp x y = sort [x, y]
                 ps = zipWith sp u v
             in sort ps

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    [n] <- getInts
    a <- getInts
    b <- getInts
    let k = n `quot` 2
        good = pairs k a == pairs k b && (even n || a !! k == b !! k)
    putStrLn $ if good then "Yes" else "No"

getInts :: IO [Int]
getInts = go <$> BS.getLine
  where
    go s = case BS.readInt s of
      Nothing -> []
      Just (x, s') -> x : go (BS.drop 1 s')

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Char8 as BS
import Data.Set as S
import Data.List as L

perm xs n =
  let (i, t) = L.splitAt n xs
      (j, k) = L.splitAt (length xs - 2 * n) t
   in k ++ j ++ i

go :: [Int] -> State (Set [Int]) ()
go l = do
  seen <- get
  unless (member l seen) do
    modify' $ S.insert l
    mapM_ go [perm l i | i <- [1 .. quot (length l) 2]]

varl :: Int -> Integer
varl = genericLength . S.toList . flip execState S.empty . go . enumFromTo 1

pairs :: Int -> [Int] -> [[Int]]
pairs k xs = let u = L.take k xs
                 v = L.take k $ reverse xs
                 sp x y = sort [x, y]
                 ps = zipWith sp u v
             in sort ps

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    [n] <- getInts
    a <- getInts
    b <- getInts
    let k = (n + 1) `quot` 2
        good = pairs k a == pairs k b
    putStrLn $ if good then "Yes" else "No"

getInts :: IO [Int]
getInts = go <$> BS.getLine
  where
    go s = case BS.readInt s of
      Nothing -> []
      Just (x, s') -> x : go (BS.drop 1 s')

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.List (sort)

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    getLine
    a <- getInts
    b <- getInts
    let n = length a
        k = quot n 2
        good = sort a == sort b && (even n || a !! k == b !! k)
    putStrLn $ if good then "Yes" else "No"

getInts :: IO [Int]
getInts = go <$> BS.getLine
  where
    go s = case BS.readInt s of
      Nothing -> []
      Just (x, s') -> x : go (BS.drop 1 s')


You are given two arrays A and B, each of size n. The error, E, between these two arrays is defined . You have to perform exactly k1 operations on array A and exactly k2 operations on array B. In one operation, you have to choose one element of the array and increase or decrease it by 1.Output the minimum possible value of error after k1 operations on array A and k2 operations on array B have been performed.

The first line contains three space-separated integers n (1 ≤ n ≤ 103), k1 and k2 (0 ≤ k1 + k2 ≤ 103, k1 and k2 are non-negative) — size of arrays and number of operations to perform on A and B respectively. Second line contains n space separated integers a1, a2, ..., an ( - 106 ≤ ai ≤ 106) — array A. Third line contains n space separated integers b1, b2, ..., bn ( - 106 ≤ bi ≤ 106)— array B.

Output a single integer — the minimum possible value of  after doing exactly k1 operations on array A and exactly k2 operations on array B.

NoteIn the first sample case, we cannot perform any operations on A or B. Therefore the minimum possible error E = (1 - 2)2 + (2 - 3)2 = 2. In the second sample case, we are required to perform exactly one operation on A. In order to minimize error, we increment the first element of A by 1. Now, A = [2, 2]. The error is now E = (2 - 2)2 + (2 - 2)2 = 0. This is the minimum possible error obtainable.In the third sample case, we can increase the first element of A to 8, using the all of the 5 moves available to us. Also, the first element of B can be reduced to 8 using the 6 of the 7 available moves. Now A = [8, 4] and B = [8, 4]. The error is now E = (8 - 8)2 + (4 - 4)2 = 0, but we are still left with 1 move for array B. Increasing the second element of B to 5 using the left move, we get B = [8, 5] and E = (8 - 8)2 + (4 - 5)2 = 1.

import Data.List

main = do
          l1 <- getLine
          let (n:k1:k2:s) = map read.words $ l1
          let k = k1 + k2
          l2 <- getLine
          l3 <- getLine
          let a = map read.words $ l2
          let b = map read.words $ l3
          putStrLn.show.calc a b $ k

diff :: Integral a => a -> a -> a
diff x y | x < y = y - x
         | otherwise = x - y

calc2 :: Integral a => a -> [a] -> a
calc2 x = foldr (\ a b -> a + b - x) 0.filter (> x)

calc3 :: Integral a => [a] -> a -> a -> [a]
calc3 d k x = l ++ (map (const (x-1)).take y $ r) ++ (map (const x).drop y $ r)
              where (l, r) = span (< x) d
                    y = fromIntegral (k - calc2 x d)

sumerror :: Integral a => [a] -> a
sumerror = foldr (\ a b -> if a < 0 then b else a^2 + b) 0

bs :: Integral a => a -> a -> a -> [a] -> a
bs l r k d | l == r = mid
           | calc2 mid d > k = bs (mid + 1) r k d
           | otherwise = bs l mid k d
             where mid = (l + r) `div` 2

calc :: Integral a => [a] -> [a] -> a -> a
calc a b k | y `mod` 2 == 1 && elem (-1) z = (1 +).sumerror $ z
           | otherwise = sumerror z
             where d = sort.zipWith diff a $ b
                   x = bs 0 (last d) k d
                   y = fromIntegral (k - calc2 x d)
                   z = calc3 d k x

import Data.List

main = do
          l1 <- getLine
          let (n:k1:k2:s) = map read.words $ l1
          let k = k1 + k2
          l2 <- getLine
          l3 <- getLine
          let a = map read.words $ l2
          let b = map read.words $ l3
          putStrLn.show.calc a b $ k

diff :: Integral a => a -> a -> a
diff x y | x < y = y - x
         | otherwise = x - y

calc2 :: Integral a => a -> [a] -> a
calc2 x = foldr (\ a b -> a + b - x) 0.filter (> x)

calc3 :: Integral a => [a] -> a -> a -> [a]
calc3 d k x = l ++ (map (const (x-1)).take y $ r) ++ (map (const x).drop y $ r)
              where (l, r) = span (< x) d
                    y = fromIntegral (k - calc2 x d)

sumerror :: Integral a => [a] -> a
sumerror = foldr (\ a b -> if a < 0 then b else a^2 + b) 0

bs :: Integral a => a -> a -> a -> [a] -> a
bs l r k d | l == r = mid
           | calc2 mid d > k = bs (mid + 1) r k d
           | otherwise = bs l mid k d
             where mid = (l + r) `div` 2

calc :: Integral a => [a] -> [a] -> a -> a
calc a b k = sumerror.calc3 d k.bs 0 (last d) k $ d
             where d = sort.zipWith diff a $ b

import Data.List

main = do
          l1 <- getLine
          let (n:k1:k2:s) = map read.words $ l1
          let k = k1 + k2
          l2 <- getLine
          l3 <- getLine
          let a = map read.words $ l2
          let b = map read.words $ l3
          putStrLn.show.calc a b $ k

diff :: Integral a => a -> a -> a
diff x y | x < y = y - x
         | otherwise = x - y

calc2 :: Integral a => a -> [a] -> a
calc2 x = foldr (\ a b -> a + b - x) 0.filter (> x)

calc3 :: Integral a => [a] -> a -> a -> [a]
calc3 d k x = l ++ (map (const (x-1)).take y $ r) ++ (map (const x).drop y $ r)
              where (l, r) = span (< x) d
                    y = fromIntegral (k - calc2 x d)

sumerror :: Integral a => [a] -> a
sumerror = foldr (\ a b -> if a < 0 then b else a^2 + b) 0

bs :: Integral a => a -> a -> a -> [a] -> a
bs l r k d | l == r = mid
           | calc2 mid d > k = bs (mid + 1) r k d
           | otherwise = bs l mid k d
             where mid = (l + r) `div` 2

calc :: Integral a => [a] -> [a] -> a -> a
calc a b k | (k - calc2 x d) `mod` 2 == 1 = (1 +).sumerror.calc3 d k $ x
           | otherwise = sumerror.calc3 d k $ x
             where d = sort.zipWith diff a $ b
                   x = bs 0 (last d) k d

import Data.List

main = do
          l1 <- getLine
          let (n:k1:k2:s) = map read.words $ l1
          let k = k1 + k2
          l2 <- getLine
          l3 <- getLine
          let a = map read.words $ l2
          let b = map read.words $ l3
          putStrLn.show.calc a b $ k

diff :: Integral a => a -> a -> a
diff x y | x < y = y - x
         | otherwise = x - y

calc2 :: Integral a => a -> [a] -> a
calc2 x = foldr (\ a b -> a + b - x) 0.filter (> x)

calc3 :: Integral a => [a] -> a -> a -> [a]
calc3 d k x = l ++ (map (const (x-1)).take y $ r) ++ (map (const x).drop y $ r)
              where (l, r) = span (< x) d
                    y = fromIntegral (k - calc2 x d)

sumerror :: Integral a => [a] -> a
sumerror = foldr (\ a b -> if a < 0 then b else a^2 + b) 0

bs :: Integral a => a -> a -> a -> [a] -> a
bs l r k d | l == r = mid
           | calc2 mid d > k = bs (mid + 1) r k d
           | otherwise = bs l mid k d
             where mid = (l + r) `div` 2

calc :: Integral a => [a] -> [a] -> a -> a
calc a b k | y `mod` 2 == 1 && y > (length.dropWhile (< x) $ d) = (1 +).sumerror.calc3 d k $ x
           | otherwise = sumerror.calc3 d k $ x
             where d = sort.zipWith diff a $ b
                   x = bs 0 (last d) k d
                   y = fromIntegral (k - calc2 x d)

import Data.List

main = do
          l1 <- getLine
          let (n:k1:k2:s) = map read.words $ l1
          let k = k1 + k2
          l2 <- getLine
          l3 <- getLine
          let a = map read.words $ l2
          let b = map read.words $ l3
          putStrLn.show.calc a b $ k

diff :: Integral a => a -> a -> a
diff x y | x < y = y - x
         | otherwise = x - y

calc2 :: Integral a => a -> [a] -> a
calc2 x = foldr (\ a b -> a + b - x) 0.filter (> x)

calc3 :: Integral a => [a] -> a -> a -> [a]
calc3 d k x = l ++ (map (const (x-1)).take y $ r) ++ (map (const x).drop y $ r)
              where (l, r) = span (< x) d
                    y = fromIntegral (k - calc2 x d)

sumerror :: Integral a => [a] -> a
sumerror = foldr (\ a b -> a^2 + b) 0

bs :: Integral a => a -> a -> a -> [a] -> a
bs l r k d | l == r = mid
           | calc2 mid d > k = bs (mid + 1) r k d
           | otherwise = bs l mid k d
             where mid = (l + r) `div` 2

calc :: Integral a => [a] -> [a] -> a -> a
calc a b k = sumerror.calc3 d k.bs 0 (last d) k $ d
             where d = sort.zipWith diff a $ b


There will be a launch of a new, powerful and unusual collider very soon, which located along a straight line. n particles will be launched inside it. All of them are located in a straight line and there can not be two or more particles located in the same point. The coordinates of the particles coincide with the distance in meters from the center of the collider, xi is the coordinate of the i-th particle and its position in the collider at the same time. All coordinates of particle positions are even integers.You know the direction of each particle movement — it will move to the right or to the left after the collider's launch start. All particles begin to move simultaneously at the time of the collider's launch start. Each particle will move straight to the left or straight to the right with the constant speed of 1 meter per microsecond. The collider is big enough so particles can not leave it in the foreseeable time.Write the program which finds the moment of the first collision of any two particles of the collider. In other words, find the number of microseconds before the first moment when any two particles are at the same point.

The first line contains the positive integer n (1 ≤ n ≤ 200 000) — the number of particles.  The second line contains n symbols "L" and "R". If the i-th symbol equals "L", then the i-th particle will move to the left, otherwise the i-th symbol equals "R" and the i-th particle will move to the right. The third line contains the sequence of pairwise distinct even integers x1, x2, ..., xn (0 ≤ xi ≤ 109) — the coordinates of particles in the order from the left to the right. It is guaranteed that the coordinates of particles are given in the increasing order.

In the first line print the only integer — the first moment (in microseconds) when two particles are at the same point and there will be an explosion.  Print the only integer -1, if the collision of particles doesn't happen.

NoteIn the first sample case the first explosion will happen in 1 microsecond because the particles number 1 and 2 will simultaneously be at the same point with the coordinate 3. In the second sample case there will be no explosion because there are no particles which will simultaneously be at the same point.

import Data.Maybe
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

main = do
    n <- read `fmap` getLine :: IO Int
    dirs <- BS.getLine
    ps <- BS.getLine
    let ns = (map (fst . fromJust . BS8.readInt) . BS8.words) ps :: [Int]
    print (collide ns dirs)

collide :: [Int] -> BS8.ByteString -> Int
collide ns ds = f ns ds (-1) where
    f (n:n2:ns) ds t
        | d == ord 'R' && d2 == ord 'L' = f (n2:ns) ds' (if t == -1 then t' else min t' t)
        | otherwise = f (n2:ns) ds' t
        where
            d = fromIntegral $ BS.head ds
            d2 = fromIntegral $ BS.head (BS.tail ds)
            ds' = BS.tail ds
            t' = (n2 - n) `div` 2
    f _ _ t = t

module Main where

import Control.Applicative

main = do
    getLine
    s <- getLine
    i <- map (read :: String -> Int) . words <$> getLine
    let m = snd $ foldr (\(x,y) (a,acc) -> case (x,a) of
                            ('R', Just ('L',c)) -> (Nothing, ((c-y)`div`2):acc)
                            ('L', Just ('L',c)) -> (Just('L',y), acc)
                            ('L', Nothing) -> (Just('L',y), acc)
                            _        -> (Nothing, acc)) (Nothing,[])  $ zip s i
    print $ if null m then (-1)  else minimum m

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric
import Data.Maybe(isNothing, fromJust)
-- import Debug.Trace(trace)

trace x y = y

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

main = interact solve

solve input = if isNothing answer then "-1" else show $ fromJust answer
    where
    n_s:pattern:worded' = words input
    n::Int
    n = read n_s
    points::[Int]
    points = map read worded'

    zipped::[(Char, Int)]
    zipped = zip pattern points

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

    answer::Maybe Int
    answer = foldl' foldop Nothing $ bytwo zipped

    foldop current (('L',x), ('R',y)) = current
    foldop current (('L',x), ('L',y)) = current
    foldop current (('R',x), ('R',y)) = current
    foldop current ((xdir, x), (ydir, y))
           | trace (show xdir ++ show x ++ show ydir ++ show y) False = Nothing
           | isNothing current = Just ((y-x) `div` 2)
           | otherwise = Just $ min cur ((y-x) `div` 2)
           where
                Just cur = current
                distance = (y-x) `div` 2

import Control.Applicative
import Control.Monad

solve :: String -> [Int] -> (Maybe Int, Maybe Int)
solve [] [] = (Nothing, Nothing)
solve (c:cs) (x:xs) | c == 'L' = (Just x, b)
                    | c == 'R' = (a, d)
                    where (a, b) = solve cs xs
                          td = do
                                var <- a
                                let timeImpact = (var - x) `div` 2
                                return timeImpact
                          d = (liftM2 min td b) `mplus` td

getInt :: Maybe Int -> Int
getInt Nothing = -1
getInt (Just x) = x

main :: IO ()
main = do
        getLine
        dir <- getLine
        pos <- map read . words <$> getLine
        let soln = solve dir pos
        -- putStrLn . show $ soln
        putStrLn . show . getInt . snd $ solve dir pos

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList
  --
  generatedMemo :: S.Set Int -> S.Set Int -> Int -> [Char] -> [Char]
  generatedMemo _ _ 20 accumulator = accumulator
  generatedMemo locLeft locRight n accumulator
    | n `elemSet` locLeft   = generatedMemo locLeft locRight (n + 1) $ 'L':accumulator
    | n `elemSet` locRight  = generatedMemo locLeft locRight (n + 1) $ 'R':accumulator
    | otherwise             = generatedMemo locLeft locRight (n + 1) $ ' ':accumulator

  mayMeetF :: ((Char, Int), (Char, Int)) -> Bool
  mayMeetF (('R', _), ('L', _)) = True
  mayMeetF _ = False

  diffF :: ((Char, Int), (Char, Int)) -> Int
  diffF (('R', x), ('L', y)) = (y - x) `div` 2

  normalized :: [Int] -> [Int]
  normalized (x:xs) = (x:xs)
  normalized [] = [-1]

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    directions <- getLine
    locations <- getLine >>= return . sort .  (map readInt) . words
    let dirLoc = directions `zip` locations
        dirLoc2 = 1 `drop` dirLoc
        mayMeet = (mayMeetF `filter`) $ dirLoc `zip` dirLoc2
        diffs =  diffF  `map` mayMeet
        normaldiff = normalized diffs
    putStrLn $ show $ minimum normaldiff

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}

main :: IO ()
main = do
    _ <- getLine
    lrs <- getLine
    xs <- map readInt.B.words <$> B.getLine
    print . maybe (-1) id $ solve lrs xs

solve :: String -> [Int] -> Maybe Int
solve lrs xs = go0 lrs xs
  where
    go0 ('R':'L':lrs) (x:y:xys) = go (div (y-x) 2) lrs xys
    go0 (_:r:lrs) (_:y:xys) = go0 (r:lrs) (y:xys)
    go0 _ _ = Nothing
    go !res ('R':'L':lrs) (x:y:xys) = go (min res $ div (y-x) 2) lrs xys
    go res (_:r:lrs) (_:y:xys)  = go res (r:lrs) (y:xys)
    go res _ _ = Just res

import Data.List( minimum)
main = do
    n <- getLine
    lrs <- getLine
    xs <- return . map (read::String->Integer) . words =<< getLine
    let distxs = zip lrs xs
	filt [] = []
	filt [p] = []
	filt ((dir1,x1):tl@((dir2,x2):ps)) =
	    if dir1=='R' && dir2=='L'
		then ((x2-x1)`div`2):filt ps
		else filt tl
	candidate = filt distxs
    if candidate == [] then print $ negate 1
			else print . minimum $ filt distxs

import Control.Arrow
import Control.Applicative
import Data.Int

solve :: [Char] -> [Int64] -> Int64
solve dirs coords = case impacttimes of
                      [] -> -1
                      x -> minimum x
  where
    impacttimes = solve' dirs coords []
    solve' :: [Char] -> [Int64] -> [Int64] -> [Int64]
    solve' ('R':ds@('L':_)) (n1:cs@(n2:_)) acc = solve' ds cs (((n2 - n1) `div` 2):acc)
    solve' (_:ds) (_:cs) acc = solve' ds cs acc
    solve' _ _ acc = acc

main :: IO()
main = do
  _ <- getLine
  dirs <- getLine
  coords <- (map read . words) <$> getLine
  print $ solve dirs coords

import Data.List

get_min :: Maybe Integer -> Integer -> [(Char, Integer)] -> Integer
get_min _                 acum []              = acum
get_min _                 acum (('R', n):rest) = get_min (Just n) acum rest
get_min Nothing           acum (('L', n):rest) = get_min Nothing acum rest
get_min (Just last_right) acum (('L', n):rest) = get_min (Just last_right) (min acum (div (n - last_right) 2)) rest

myShow :: Integer -> String
myShow n
  | n >= 10^10 = "-1"
  | otherwise  = show n

process :: String -> String
process str =
  let [_, dirs, nums] = lines str
      parts  = zip dirs (map read $ words nums)
  in myShow $ get_min Nothing (10^10) parts

main :: IO ()
main = interact process

import Data.List

maybe_min :: Maybe Integer -> Integer -> Maybe Integer
maybe_min Nothing n   = Just n
maybe_min (Just n') n = Just $ min n' n

get_min :: Maybe Integer -> Maybe Integer -> [(Char, Integer)] -> Maybe Integer
get_min _                 acum []              = acum
get_min _                 acum (('R', n):rest) = get_min (Just n) acum rest
get_min Nothing           acum (('L', n):rest) = get_min Nothing acum rest
get_min (Just last_right) acum (('L', n):rest) = get_min (Just last_right) (maybe_min acum (div (n - last_right) 2)) rest

myShow :: Maybe Integer -> String
myShow n = case n of
  Nothing   -> "-1"
  (Just n') -> show n'

process :: String -> String
process str =
  let [_, dirs, nums] = lines str
      parts  = zip dirs (map read $ words nums)
  in myShow $ get_min Nothing Nothing parts

main :: IO ()
main = interact process

import Data.Maybe
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

main = do
    n <- read `fmap` getLine :: IO Int
    dirs <- BS.getLine
    ps <- BS.getLine
    let ns = (map (fst . fromJust . BS8.readInt) . BS8.words) ps :: [Int]
    print (collide ns dirs)

collide :: [Int] -> BS8.ByteString -> Int
collide ns ds = f ns ds (-1) where
    f (n:n2:ns) ds t
        | d == ord 'R' && d2 == ord 'L' = f (n2:ns) ds' (if t == -1 then t' else min t' t)
        | otherwise = f ns ds' t
        where
            d = fromIntegral $ BS.head ds
            d2 = fromIntegral $ BS.head (BS.tail ds)
            ds' = BS.tail ds
            t' = (n2 - n) `div` 2
    f _ _ t = t

import Data.List

get_min :: [Integer] -> [Integer] -> Integer
get_min _  [] = -1
get_min xs (y:ys) =
  let xs' = dropWhile (< y) xs
  in if null xs' then -1 else div (head xs' - y) 2

process :: String -> String
process str =
  let [_, dirs, nums] = lines str
      parts  = zip dirs (map read $ words nums)
      lefts  = sort . map snd . filter (\(n,_) -> n == 'L') $ parts
      rights = sort . map snd . filter (\(n,_) -> n == 'R') $ parts
  in show $ get_min lefts rights

main :: IO ()
main = interact process


Today, as a friendship gift, Bakry gave Badawy $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ and challenged him to choose an integer $$$X$$$ such that the value $$$\underset{1 \leq i \leq n}{\max} (a_i \oplus X)$$$ is minimum possible, where $$$\oplus$$$ denotes the bitwise XOR operation.As always, Badawy is too lazy, so you decided to help him and find the minimum possible value of $$$\underset{1 \leq i \leq n}{\max} (a_i \oplus X)$$$.

The first line contains integer $$$n$$$ ($$$1\le n \le 10^5$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 2^{30}-1$$$).

Print one integer — the minimum possible value of $$$\underset{1 \leq i \leq n}{\max} (a_i \oplus X)$$$.

NoteIn the first sample, we can choose $$$X = 3$$$.In the second sample, we can choose $$$X = 5$$$.

import Data.Bits
import Data.List

doit :: Int -> [Int] -> Int
doit _    [] = -1
doit (-1) _  = 0
doit b xs = min (max (combine al) ar) (max al (combine ar))
  where mask = 1 `shift` b
        (ls, rs) = partition (\x -> x .&. mask == 0) xs
        al = doit (b-1) ls
        ar = doit (b-1) rs
        combine val | val == -1 = val
        combine val             = val .|. mask

main :: IO ()
main = doit 29 . map read . words <$> (getLine >> getLine) >>= print

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

main = getLine >> getLine >>= print.solve 31.map read.words

solve :: Int -> [Int] -> Int
solve (-1) _ = 0
solve _ [] = bit 31
solve p xs
	| all (flip testBit p) xs || all (not.flip testBit p) xs = solve p' (f xs)
	| otherwise = bit p .|. min (solve p' $ f $ filter (flip testBit p) xs) (solve p' $ f $ filter (not.flip testBit p) xs)
	where
		p' = p - 1
		f = map (.&. complement (bit p))

import           Data.Bits
import           Data.List
import           Data.Word

main = do
  _ <- getLine
  ns <- fmap read . words <$> getLine :: IO [Word32]
  print $ solve 32 ns
data Bit = O | I

bitStringToWord :: (Bits a, Num a) => [Bit] -> a
bitStringToWord bs = go 0 bs
  where
    go acc []     = acc
    go acc (I:bs) = go ((shiftL acc 1) .|. 1) bs
    go acc (O:bs) = go (shiftL acc 1) bs

data BTree = Node BTree BTree | Leaf Bit

solve :: Int -> [Word32] -> Word32
solve 0 _ = 0
solve i [] = 0
solve i ns = go (i-1) zs os
  where
    go i [] [] = 0
    go i [] on = solve i ns
    go i zs [] = solve i zs
    go i zs os = min (solve i zs) (solve i os) + 2^i
    (zs,os) = partition (\x -> ((bit (i-1)) .&. x) /= 0) ns

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Bits
--import           Data.Functor.Foldable
import           Data.List
import           Data.Word

main = do
  _ <- getLine
  ns <- fmap read . words <$> getLine :: IO [Word32]
  let bs = w2bs <$> ns
  -- print $ ixRecurse 32 ns
  -- print . bs2w $ structuralRecurse bs
  print . bs2w $ hyloRecurse bs

ixRecurse :: Int -> [Word32] -> Word32
ixRecurse 0 _ = 0
ixRecurse i [] = 0
ixRecurse i ns = go (i-1) zs os
  where
    go i [] [] = 0
    go i [] on = ixRecurse i ns
    go i zs [] = ixRecurse i zs
    go i zs os = min (ixRecurse i zs) (ixRecurse i os) + 2^i
    (zs,os) = partition (\x -> ((bit (i-1)) .&. x) /= 0) ns

data Bit = O | I
  deriving (Show, Eq, Ord)

structuralRecurse :: [[Bit]] -> [Bit]
structuralRecurse ns = go (zs,os)
  where
    (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns
    go :: ([[Bit]], [[Bit]]) -> [Bit]
    go ([],[]) = []
    go ([],os) = O:structuralRecurse (tail <$> os)
    go (zs,[]) = O:structuralRecurse (tail <$> zs)
    go (zs,os) = I:min (structuralRecurse . fmap tail $ zs) (structuralRecurse . fmap tail $ os)

data BTree = Node (BTree) (BTree) | Empty
data BTreeF b = NodeF b b | EmptyF
  deriving (Functor, Show)

hyloRecurse :: [[Bit]] -> [Bit]
hyloRecurse = init . hylo alg coalg
  where
    alg :: BTreeF [Bit] -> [Bit]
    alg EmptyF        = []
    alg (NodeF [] os) = O:os
    alg (NodeF zs []) = O:zs
    alg (NodeF zs os) = I:min os zs

    coalg :: [[Bit]] -> BTreeF [[Bit]]
    coalg [] = EmptyF
    coalg ns = NodeF (tail <$> zs) (tail <$> os)
        where
          (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

bs2w :: [Bit] -> Word32
bs2w bs = go 0 bs
  where
    go acc []     = acc
    go acc (I:bs) = go ((shiftL acc 1) .|. 1) bs
    go acc (O:bs) = go (shiftL acc 1) bs

w2bs :: Word32 -> [Bit]
w2bs w = fmap (\n -> if (bit n .&. w) /= 0 then I else O) [31,30..0]

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Bits
import           Data.List
import           Data.Word

main = do
  _ <- getLine
  ns <- fmap read . words <$> getLine :: IO [Word32]
  let bs = w2bs <$> ns
  -- print $ ixRecurse 32 ns
  print . bs2w $ structuralRecurse bs
  -- print . bs2w $ hyloRecurse bs

ixRecurse :: Int -> [Word32] -> Word32
ixRecurse 0 _ = 0
ixRecurse i [] = 0
ixRecurse i ns = go (i-1) zs os
  where
    go i [] [] = 0
    go i [] on = ixRecurse i ns
    go i zs [] = ixRecurse i zs
    go i zs os = min (ixRecurse i zs) (ixRecurse i os) + 2^i
    (zs,os) = partition (\x -> ((bit (i-1)) .&. x) /= 0) ns

data Bit = O | I
  deriving (Show, Eq, Ord)

structuralRecurse :: [[Bit]] -> [Bit]
structuralRecurse ns = go zs os
  where
    go [] [] = []
    go [] os = O:structuralRecurse (tail <$> os)
    go zs [] = O:structuralRecurse (tail <$> zs)
    go zs os = I:min (structuralRecurse . fmap tail $ zs) (structuralRecurse . fmap tail $ os)
    (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

data BTreeF b = NodeF b b | EmptyF
  deriving (Functor, Show)

hyloRecurse :: [[Bit]] -> [Bit]
hyloRecurse = hylo alg coalg
  where
--    alg :: BTreeF a [Bit] -> [Bit]
alg EmptyF        = return O
alg (NodeF zs os) = I:min (zs) (os)
--    coalg :: [[Bit]] -> BTreeF [a] [[Bit]]
coalg [] = EmptyF
coalg ns = fmap tail <$> (NodeF zs os)
      where
        (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

bs2w :: [Bit] -> Word32
bs2w bs = go 0 bs
  where
    go acc []     = acc
    go acc (I:bs) = go ((shiftL acc 1) .|. 1) bs
    go acc (O:bs) = go (shiftL acc 1) bs

w2bs :: Word32 -> [Bit]
w2bs w = fmap (\n -> if (bit n .&. w) /= 0 then I else O) [31,30..0]

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Bits
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
-- for io performance comparison from @Russell_Emerine's code
main_ = get >>= flip replicateM get >>= putln . solve 31

solve :: Int -> [Int] -> Int
solve (-1) _ = 0
solve _ [] = bit 31
solve p xs
	| all (flip testBit p) xs || all (not.flip testBit p) xs = solve p' (f xs)
	| otherwise = bit p .|. min (solve p' $ f $ filter (flip testBit p) xs) (solve p' $ f $ filter (not.flip testBit p) xs)
	where
		p' = p - 1
		f = map (.&. complement (bit p))

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Bits
import           Data.List
import           Data.Word

main = do
  _ <- getLine
  ns <- fmap read . words <$> getLine :: IO [Word32]
  let bs = w2bs <$> ns
  -- print $ ixRecurse 32 ns
  print . bs2w $ structuralRecurse bs
  -- print . bs2w $ hyloRecurse bs

ixRecurse :: Int -> [Word32] -> Word32
ixRecurse 0 _ = 0
ixRecurse i [] = 0
ixRecurse i ns = go (i-1) zs os
  where
    go i [] [] = 0
    go i [] on = ixRecurse i ns
    go i zs [] = ixRecurse i zs
    go i zs os = min (ixRecurse i zs) (ixRecurse i os) + 2^i
    (zs,os) = partition (\x -> ((bit (i-1)) .&. x) /= 0) ns

data Bit = O | I
  deriving (Show, Eq, Ord)

structuralRecurse :: [[Bit]] -> [Bit]
structuralRecurse ns = go zs os
  where
    go [] [] = []
    go [] os = O:structuralRecurse (tail <$> os)
    go zs [] = O:structuralRecurse (tail <$> zs)
    go zs os = I:min (structuralRecurse . fmap tail $ zs) (structuralRecurse . fmap tail $ os)
    (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

data BTreeF b = NodeF b b | EmptyF
  deriving (Functor, Show)

hyloRecurse :: [[Bit]] -> [Bit]
hyloRecurse = hylo alg coalg
  where
--    alg :: BTreeF a [Bit] -> [Bit]
alg EmptyF        = return O
alg (NodeF zs os) = I:min (zs) (os)
--    coalg :: [[Bit]] -> BTreeF [a] [[Bit]]
coalg [] = EmptyF
coalg ns = fmap tail <$> (NodeF zs os)
      where
        (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

bs2w :: [Bit] -> Word32
bs2w bs = go 0 bs
  where
    go acc []     = acc
    go acc (I:bs) = go ((shiftL acc 1) .|. 1) bs
    go acc (O:bs) = go (shiftL acc 1) bs

w2bs :: Word32 -> [Bit]
w2bs w = fmap (\n -> if (bit n .&. w) /= 0 then I else O) [4,3..0]

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g

{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies  #-}

import           Data.Bits
import           Data.List
import           Data.Word

main = do
  _ <- getLine
  ns <- fmap read . words <$> getLine :: IO [Word32]
  let bs = w2bs <$> ns
  -- print $ ixRecurse 32 ns
  -- print . bs2w $ structuralRecurse bs
  print . bs2w $ hyloRecurse bs

ixRecurse :: Int -> [Word32] -> Word32
ixRecurse 0 _ = 0
ixRecurse i [] = 0
ixRecurse i ns = go (i-1) zs os
  where
    go i [] [] = 0
    go i [] on = ixRecurse i ns
    go i zs [] = ixRecurse i zs
    go i zs os = min (ixRecurse i zs) (ixRecurse i os) + 2^i
    (zs,os) = partition (\x -> ((bit (i-1)) .&. x) /= 0) ns

data Bit = O | I
  deriving (Show, Eq, Ord)

structuralRecurse :: [[Bit]] -> [Bit]
structuralRecurse ns = go zs os
  where
    go [] [] = return O
    go [] os = structuralRecurse (tail <$> os)
    go zs [] = structuralRecurse (tail <$> zs)
    go zs os = I:min (structuralRecurse zs) (structuralRecurse os)
    (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

data BTreeF a b = NodeF a b b | EmptyF
  deriving (Functor, Show)

hyloRecurse :: [[Bit]] -> [Bit]
hyloRecurse = hylo alg coalg
  where
    alg EmptyF          = return O
    alg (NodeF a zs os) = I:min zs os
    coalg [] = EmptyF
    coalg ns = NodeF [] zs os
      where
        (zs, os) = partition (\x -> head x == O) . filter (not . null) $ ns

bs2w :: [Bit] -> Word32
bs2w bs = go 0 bs
  where
    go acc []     = acc
    go acc (I:bs) = go ((shiftL acc 1) .|. 1) bs
    go acc (O:bs) = go (shiftL acc 1) bs

w2bs :: Word32 -> [Bit]
w2bs w = fmap (\n -> if (bit n .&. w) /= 0 then I else O) [31,30..0]

hylo :: Functor f => (f b -> b) -> (a -> f a) -> a -> b
hylo f g = h where h = f . fmap h . g


After celebrating the midcourse the students of one of the faculties of the Berland State University decided to conduct a vote for the best photo. They published the photos in the social network and agreed on the rules to choose a winner: the photo which gets most likes wins. If multiple photoes get most likes, the winner is the photo that gets this number first.Help guys determine the winner photo by the records of likes.

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the total likes to the published photoes.  The second line contains n positive integers a1, a2, ..., an (1 ≤ ai ≤ 1 000 000), where ai is the identifier of the photo which got the i-th like.

Print the identifier of the photo which won the elections.

NoteIn the first test sample the photo with id 1 got two likes (first and fifth), photo with id 2 got two likes (third and fourth), and photo with id 3 got one like (second). Thus, the winner is the photo with identifier 2, as it got:  more likes than the photo with id 3;  as many likes as the photo with id 1, but the photo with the identifier 2 got its second like earlier.

import Control.Applicative
import Data.List
import Data.Array

del _ [] = []
del x (m:ms) | x==m = ms
             | otherwise = m : ( del x ms)

process [s] _ = s
process x (a:as) = process (del a x) as

main = do
	getLine
	a<- map read.words <$> getLine ::IO [Int]
	let b = accumArray (+) 0 (1,1000000) $ zip a (repeat 1)
	let c =  elems b
	let d = maximum c
	let e =map fst $  filter (\z-> snd z ==d) $ assocs b
	print $ process e (reverse a)

import Control.Applicative
import Data.List
import qualified Data.IntMap as I
import qualified Data.ByteString.Char8 as C
import Data.Maybe

del _ [] = []
del x (m:ms) | x==m = ms
             | otherwise = m : ( del x ms)

process [s] _ = s
process x (a:as) = process (del a x) as

main = do
	getLine
	a<- map (fst.fromJust.C.readInt).C.words <$> C.getLine ::IO [Int]
	let b = foldl (\acc z-> I.insertWith (+) z 1 acc) I.empty a
	let e =  I.keys $  I.filter (==( I.foldl max 0 b))  b
	print $ process e (reverse a)

import Control.Applicative
import Data.List
import qualified Data.IntMap as I

del _ [] = []
del x (m:ms) | x==m = ms
             | otherwise = m : ( del x ms)

process [s] _ = s
process x (a:as) = process (del a x) as

main = do
	getLine
	a<- map read.words <$> getLine ::IO [Int]
	let b = foldl (\acc z-> I.insertWith (+) z 1 acc) I.empty a
	let c =  I.elems b
	let d = maximum c
	let e =map fst $  filter (\z-> snd z ==d) $ I.assocs b
	print $ process e (reverse a)

module Main where

-- (num,likes,step)
red :: ([(Int, Int,Int)], Int) -> Int -> ([(Int,Int,Int)], Int)
red (list, step) like =
        let
                addLike num step st [] = (num,1,step):st
                addLike num step st ((n,l,s):xs) | n == num = ((n,l+1,step):st)++xs
                                                 | otherwise = addLike num step ((n,l,s):st) xs
        in (addLike like step [] list, step + 1)

findBest (x:xs) =
        let
                helper best [] = best
                helper best@(n,l,s) ((n',l',s'):xs) | l' > l = helper (n',l',s') xs
                                                    | l' == l && s > s' = helper (n',l',s') xs
                                                    | otherwise = helper best xs
                (bst,_,_) = helper x xs
        in
                bst

main = do
        n <-(getLine >>= (return.read)) :: IO Int
        likes <- (getLine >>= (return . words) >>= (return . (map read))) :: IO [Int]
        let (formatted, _) = foldl red ([],0) likes
--      putStrLn $ show formatted
        putStrLn $ show $ findBest  formatted

import Data.List
import Data.Functor
import Data.Function (on)

main :: IO()
main = do
    _ <- getLine
    a <- words <$> getLine
    let ai = sort $ zip a [1..]
        gai = groupBy ((==) `on` fst) ai
        lai = map (\x -> (negate (length x), (snd (last x), fst (head x)))) gai
        sai = sort lai
    putStrLn $ snd $ snd $ head sai

import Data.List
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO[Int]
    let arr = nub a
        (_,ans) = maximum . map (\x -> ((fn (0,0) x (zip a [1..])),x)) $ arr
    print ans

fn :: (Int,Int) -> Int -> [(Int,Int)] -> (Int,Int)
fn ans _ [] = ans
fn (mx,ls) e ((x,i):xs)
 |e==x = fn (mx+1,-i) e xs
 |otherwise = fn (mx,ls) e xs

import Data.List
import Data.Ord

main = interact $ show . go . map read . words . head . tail . lines

go :: [Int] -> Int
go al = let ids = nub al
            lks = zip al [1..]
            il = map (\i -> filter ((i==). fst) lks) ids
            mxl = maximum $ map length il
        in fst . minimumBy (comparing snd) . map (maximumBy (comparing snd)) $ filter ((mxl==). length) il

module Main where

import Data.Ord
import Data.List
import Data.Function

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

solve :: [Int] -> Int
solve list = maximumBy comparator list where
				comparator = \x y -> case compare (count x list) (count y list) of
					LT -> LT
					GT -> GT
					EQ -> compare (lastIndexOf y list) (lastIndexOf x list)

lastIndexOf :: Int -> [Int] -> Int
lastIndexOf x = fst . last . filter ((==) x . snd) . zip [0..]

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


Polycarp has an array $$$a$$$ consisting of $$$n$$$ integers.He wants to play a game with this array. The game consists of several moves. On the first move he chooses any element and deletes it (after the first move the array contains $$$n-1$$$ elements). For each of the next moves he chooses any element with the only restriction: its parity should differ from the parity of the element deleted on the previous move. In other words, he alternates parities (even-odd-even-odd-... or odd-even-odd-even-...) of the removed elements. Polycarp stops if he can't make a move.Formally:   If it is the first move, he chooses any element and deletes it;  If it is the second or any next move:   if the last deleted element was odd, Polycarp chooses any even element and deletes it;  if the last deleted element was even, Polycarp chooses any odd element and deletes it.   If after some move Polycarp cannot make a move, the game ends. Polycarp's goal is to minimize the sum of non-deleted elements of the array after end of the game. If Polycarp can delete the whole array, then the sum of non-deleted elements is zero.Help Polycarp find this value.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2000$$$) — the number of elements of $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^6$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

Print one integer — the minimum possible sum of non-deleted elements of the array after end of the game.

import Data.List
process o e
  | (length e) > (length o) = sum (drop ((length o) + 1) e)
  | otherwise = sum (drop ((length e) + 1) o)
main = do
  _ <- getLine
  line <- getLine
  let
    a = map read $ words $ line
    o = reverse $ sort $ filter odd a
    e = reverse $ sort $ filter even a
  putStrLn $ show $ process o e

import Data.Bifunctor
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.List
import Control.Arrow

solve x =
    let f x = (length x, sort x)
        (a,b) =  arr (uncurry min) &&& arr (uncurry max)  $ bimap f f $ partition ((/=0).(`mod`2)) x
    in sum $ drop (succ $ fst a) $ reverse $ snd b

main = print =<< solve . map (fst . fromJust . B.readInt) . B.words <$> (getLine >> B.getLine)

import Data.List
import System.IO

readInteger:: IO Int
readInteger = readLn

readIntegers 0 = return []
readIntegers n = do
    x <- readInteger
    rest <- readIntegers (n - 1)
    return (x : rest)

process e o = if el > ol
    then take (max (el - ol - 1) 0) e
    else take (max (ol - el - 1) 0) o
    where
        ol = length o
        el = length e

solve l = sum (process (sort (filter even l)) (sort (filter odd l)))

sanitize = map read . words

main = do
    readInteger
    input <- getLine
    putStrLn (show (solve (sanitize input)))

import Data.List
main = interact $ show . solve . map read . tail . words
solve as | le > lo = sum (drop (lo+1) e)
         | otherwise = sum (drop (le+1) o)
  where (e,o) = partition even (reverse (sort as))
        le = length e
        lo = length o

import Data.List ( sortOn, partition )
import Data.Ord  ( Down(..))

main :: IO ()
main = interact $ show . parity . fmap read . tail . words

parity :: [Integer] -> Integer
parity = minimize . leftover . partition even . sortOn Down

minimize :: [Integer] -> Integer
minimize [] = 0
minimize ns = sum $ tail ns

leftover :: ([Integer], [Integer]) -> [Integer]
leftover (evens, odds) | length evens > length odds = annihilate evens odds
                       | otherwise = annihilate odds evens

annihilate :: [a] -> [a] -> [a]
annihilate bigger smaller = drop (length smaller) bigger

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve (n:a) = sum x' + sum y'
  where
    (b, c) = partition odd a
    x = reverse $ sort b
    y = reverse $ sort c
    lx = length x
    ly = length y
    l = succ $ min lx ly
    x' = drop l x
    y' = drop l y

main :: IO ()
main = print . solve . map ri . C.words =<< C.getContents


Xenia the beginner programmer has a sequence a, consisting of 2n non-negative integers: a1, a2, ..., a2n. Xenia is currently studying bit operations. To better understand how they work, Xenia decided to calculate some value v for a.Namely, it takes several iterations to calculate value v. At the first iteration, Xenia writes a new sequence a1 or a2, a3 or a4, ..., a2n - 1 or a2n, consisting of 2n - 1 elements. In other words, she writes down the bit-wise OR of adjacent elements of sequence a. At the second iteration, Xenia writes the bitwise exclusive OR of adjacent elements of the sequence obtained after the first iteration. At the third iteration Xenia writes the bitwise OR of the adjacent elements of the sequence obtained after the second iteration. And so on; the operations of bitwise exclusive OR and bitwise OR alternate. In the end, she obtains a sequence consisting of one element, and that element is v.Let's consider an example. Suppose that sequence a = (1, 2, 3, 4). Then let's write down all the transformations (1, 2, 3, 4)  →  (1 or 2 = 3, 3 or 4 = 7)  →  (3 xor 7 = 4). The result is v = 4.You are given Xenia's initial sequence. But to calculate value v for a given sequence would be too easy, so you are given additional m queries. Each query is a pair of integers p, b. Query p, b means that you need to perform the assignment ap = b. After each query, you need to print the new value v for the new sequence a.

The first line contains two integers n and m (1 ≤ n ≤ 17, 1 ≤ m ≤ 105). The next line contains 2n integers a1, a2, ..., a2n (0 ≤ ai < 230). Each of the next m lines contains queries. The i-th line contains integers pi, bi (1 ≤ pi ≤ 2n, 0 ≤ bi < 230) — the i-th query.

Print m integers — the i-th integer denotes value v for sequence a after the i-th query.

NoteFor more information on the bit operations, you can follow this link: http://en.wikipedia.org/wiki/Bitwise_operation

import           Data.Bits
import           Data.Array.ST.Safe
import           Data.Array
import           Data.Array.MArray.Safe
import           Control.Monad.ST.Safe
--import           Debug.Trace
import           Control.Monad

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

build :: [[Int]] -> Bool -> [[Int]]
build tree@([t] : ts) fn = tree
build tree@(t : ts) doOr =
    let fn        = if doOr then (.|.) else xor
        nextLevel = map (uncurry fn) (pairs t) :: [Int]
    in  build (nextLevel : tree) (not doOr)

-- Head of tree at position idx is updated to newval.
-- Compute new value for next level of the tree.
update :: [STUArray s Int Int] -> Int -> Int -> Bool -> ST s ()
update [t] 0 newval _ = writeArray t 0 newval
update (t : ts) idx newval doOr = do
    let fn   = if doOr then (.|.) else xor
        idx' = idx `div` 2
    writeArray t idx newval
    i1 <- readArray t (idx' * 2)
    i2 <- readArray t (idx' * 2 + 1)
    let newval' = i1 `fn` i2
    update ts idx' newval' (not doOr)

g :: [STUArray s Int Int] -> [(Int, Int)] -> ST s [Int]
g mtree []                   = return []
g mtree ((idx, newval) : qs) = do
    update mtree idx newval True
    ret  <- readArray (last mtree) 0
    rest <- g mtree qs
    return $ ret : rest

f :: [Int] -> [[Int]] -> [Int]
f as queries =
    let tree     = reverse $ build [as] True
        tree'    = [ listArray (0, length t - 1) t | t <- tree ]
        queries' = [ (idx - 1, val) | [idx, val] <- queries ]
    in  runST $ do
            mtree <- mapM thaw tree'
            g mtree queries'

main'' = do
    let as      = [1 .. 2 ^ 17]
        queries = [ [i, i] | i <- [1 .. 10000] ]
    print $ f as queries

main' = do
    let as      = [1, 6, 3, 5]
        queries = [[1, 4], [3, 4], [1, 2], [1, 2]]
    putStrLn $ (unlines . map show) (f as queries)

main = do
    [n, m]  <- map read . words <$> getLine :: IO [Int]
    as      <- map read . words <$> getLine :: IO [Int]
    queries <- map (map read . words) . lines <$> getContents :: IO [[Int]]
    putStrLn $ (unlines . map show) (f as queries)

import Control.Monad (liftM, replicateM)
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits ((.|.), xor)
import Data.Char (isSpace)
import Prelude hiding (or, reads)

type Tree  =  UArray Int Int

(?) :: Bool -> a -> a -> a
(?) p a b  =  if p then a else b

readPair :: IO (Int, Int)
readPair  =  do
    x  <-  readInt
    y  <-  readInt
    return (x, y)

readInt :: IO Int
readInt  =  do
    c  <-  getChar
    isSpace c ? readInt $ readInt' (fromEnum c - fromEnum '0')
  where
    readInt' a  =  do
        c  <-  getChar
        isSpace c ? return a $ readInt' (10*a + fromEnum c - fromEnum '0')

or :: Int -> Int -> Int
or  =  (.|.)

level :: Int -> Int
level n  =  truncate (1e-07 + log (fromIntegral n) / log 2)

fInLevel :: Int -> Int -> (Int -> Int -> Int)
fInLevel n i
  | odd (n + level i)  =  or
  | otherwise  =  xor

createTree :: Int -> [Int] -> Tree
createTree n as  =  runSTUArray $ do
    tree  <-  newArray_ (1, 2^(n + 1) - 1)
    sequence_ [writeArray tree i x
                | (i, x) <- zip [2^n..] as]
    sequence_
      [
        do
          a  <-  readArray tree (2*i)
          b  <-  readArray tree (2*i+1)
          writeArray tree i (fInLevel n i a b)
        | i <- [2^n-1, 2^n-2 .. 1]
      ]
    return tree

solve :: Int -> [Int] -> [(Int, Int)] -> IO ()
solve n as qs  =  do
    let tree  =  createTree n as
    tree'  <-  unsafeThaw tree
    mapM_ (solve' tree')
        $ map (\(x, y) -> (x + 2^n - 1, y)) qs
  where
    solve' :: IOUArray Int Int -> (Int, Int) -> IO ()
    solve' array (1, d)  =  print d
    solve' array (i1, d1)  =  do
        let i0  =  i1 `div` 2
        let i2  =  if odd i1 then i1 - 1 else i1 + 1
        d2  <-  readArray array i2
        let d0  =  fInLevel n i0 d1 d2
        writeArray array i1 d1
        solve' array (i0, d0)

main :: IO ()
main  =  do
    (n, m)  <-  readPair
    as  <-  replicateM (2^n) readInt
    qs  <-  replicateM m readPair
    solve n as qs

import           Data.Bits
import           Data.Array.ST.Safe
import           Data.Array
import           Data.Array.MArray.Safe
import           Control.Monad.ST.Safe
--import           Debug.Trace
import           Control.Monad

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

build :: [[Int]] -> Bool -> [[Int]]
build tree@([t] : ts) fn = tree
build tree@(t : ts) doOr =
    let fn        = if doOr then (.|.) else xor
        nextLevel = map (uncurry fn) (pairs t) :: [Int]
    in  build (nextLevel : tree) (not doOr)

-- Head of tree at position idx is updated to newval.
-- Compute new value for next level of the tree.
update :: [STArray s Int Int] -> Int -> Int -> Bool -> ST s ()
update [t] 0 newval _ = do
    --tOld <- getElems t
    writeArray t 0 newval
    --tNew <- getElems t
    --traceM $ show tOld ++ " -> " ++ show tNew
    return ()
update (t : ts) idx newval doOr = do
    let fn   = if doOr then (.|.) else xor
        idx' = idx `div` 2
    --tOld <- getElems t
    writeArray t idx newval
    --tNew <- getElems t
    --traceM $ show tOld ++ " -> " ++ show tNew
    i1 <- readArray t (idx' * 2)
    i2 <- readArray t (idx' * 2 + 1)
    let newval' = i1 `fn` i2
    update ts idx' newval' (not doOr)

--g :: [Array Int Int] -> [[Int]] -> [Int]
--g _ [] = []
--g tree ([idx, newval] : qs) =
--    let (ret, tree') = update tree (idx - 1) newval True in ret : g tree' qs

g :: [STArray s Int Int] -> [(Int, Int)] -> ST s [Int]
g mtree []                   = return []
g mtree ((idx, newval) : qs) = do
    update mtree idx newval True
    --t <- mapM getElems mtree
    --traceShowM t
    ret  <- readArray (last mtree) 0
    rest <- g mtree qs
    return $ ret : rest

f :: [Int] -> [[Int]] -> [Int]
f as queries =
    let tree     = reverse $ build [as] True
        tree'    = [ listArray (0, length t - 1) t | t <- tree ]
        queries' = [ (idx - 1, val) | [idx, val] <- queries ]
    in  runST $ do
            mtree <- mapM thaw tree'
            g mtree queries'

--main = do
--    let as      = [1 .. 2 ^ 17]
--        queries = [ [1, 0] | _ <- [1 .. 10000] ]
--    print $ f as queries

main = do
    let as      = [1, 6, 3, 5]
        queries = [[1, 4], [3, 4], [1, 2], [1, 2]]
    putStrLn $ (unlines . map show) (f as queries)

main' = do
    [n, m]  <- map read . words <$> getLine :: IO [Int]
    as      <- map read . words <$> getLine :: IO [Int]
    queries <- map (map read . words) . lines <$> getContents :: IO [[Int]]
    putStrLn $ (unlines . map show) (f as queries)

import           Data.Bits
import           Data.Array.ST.Safe
import           Data.Array
import           Data.Array.MArray.Safe
import           Control.Monad.ST.Safe

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

build :: [[Int]] -> Bool -> [[Int]]
build tree@([t] : ts) fn = tree
build tree@(t : ts) doOr =
    let fn        = if doOr then (.|.) else xor
        nextLevel = map (uncurry fn) (pairs t) :: [Int]
    in  build (nextLevel : tree) (not doOr)

-- Head of tree at position idx is updated to newval.
-- Compute new value for next level of the tree.
update :: [STArray s Int Int] -> Int -> Int -> Bool -> ST s ()
update [t     ] 0   newval _    = writeArray t 0 newval
update (t : ts) idx newval doOr = do
    let fn   = if doOr then (.|.) else xor
        idx' = idx `div` 2
    writeArray t idx newval
    i1 <- readArray t (idx' * 2)
    i2 <- readArray t (idx' * 2 + 1)
    let newval' = i1 `fn` i2
    update ts idx' newval' (not doOr)

--g :: [Array Int Int] -> [[Int]] -> [Int]
--g _ [] = []
--g tree ([idx, newval] : qs) =
--    let (ret, tree') = update tree (idx - 1) newval True in ret : g tree' qs

g :: [STArray s Int Int] -> [[Int]] -> ST s [Int]
g mtree []                   = return []
g mtree ([idx, newval] : qs) = do
    update mtree idx newval True
    ret  <- readArray (last mtree) 0
    rest <- g mtree qs
    return $ ret : rest

f :: [Int] -> [[Int]] -> [Int]
f as queries =
    let tree  = reverse $ build [as] True
        tree' = [ listArray (0, length t - 1) t | t <- tree ]
    in  runST $ do
            mtree <- mapM thaw tree'
            g mtree queries

--main = do
--    let as      = [1 .. 2 ^ 17]
--        queries = [ [1, 0] | _ <- [1 .. 10000] ]
--    print $ f as queries

main = do
    [n, m]  <- map read . words <$> getLine :: IO [Int]
    as      <- map read . words <$> getLine :: IO [Int]
    queries <- map (map read . words) . lines <$> getContents :: IO [[Int]]
    putStrLn $ (unlines . map show) (f as queries)

import           Data.Bits
import           Data.Array.ST.Safe
import           Data.Array
import           Data.Array.MArray.Safe
import           Control.Monad.ST.Safe
--import           Debug.Trace
import           Control.Monad

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

build :: [[Int]] -> Bool -> [[Int]]
build tree@([t] : ts) fn = tree
build tree@(t : ts) doOr =
    let fn        = if doOr then (.|.) else xor
        nextLevel = map (uncurry fn) (pairs t) :: [Int]
    in  build (nextLevel : tree) (not doOr)

-- Head of tree at position idx is updated to newval.
-- Compute new value for next level of the tree.
update :: [STUArray s Int Int] -> Int -> Int -> Bool -> ST s ()
update [t] 0 newval _ = writeArray t 0 newval
update (t : ts) idx newval doOr = do
    let fn   = if doOr then (.|.) else xor
        idx' = idx `div` 2
    writeArray t idx newval
    i1 <- readArray t (idx' * 2)
    i2 <- readArray t (idx' * 2 + 1)
    let newval' = i1 `fn` i2
    update ts idx' newval' (not doOr)

g :: [STUArray s Int Int] -> [(Int, Int)] -> ST s [Int]
g mtree []                   = return []
g mtree ((idx, newval) : qs) = do
    update mtree idx newval True
    ret  <- readArray (last mtree) 0
    rest <- g mtree qs
    return $ ret : rest

f :: [Int] -> [[Int]] -> [Int]
f as queries =
    let tree     = reverse $ build [as] True
        tree'    = [ listArray (0, length t - 1) t | t <- tree ]
        queries' = [ (idx - 1, val) | [idx, val] <- queries ]
    in  runST $ do
            mtree <- mapM thaw tree'
            g mtree queries'

main = do
    let as      = [1 .. 2 ^ 17]
        queries = [ [i, i] | i <- [1 .. 10000] ]
    print $ f as queries

main' = do
    let as      = [1, 6, 3, 5]
        queries = [[1, 4], [3, 4], [1, 2], [1, 2]]
    putStrLn $ (unlines . map show) (f as queries)

main'' = do
    [n, m]  <- map read . words <$> getLine :: IO [Int]
    as      <- map read . words <$> getLine :: IO [Int]
    queries <- map (map read . words) . lines <$> getContents :: IO [[Int]]
    putStrLn $ (unlines . map show) (f as queries)

import Control.Monad (liftM, replicateM)
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits ((.|.), xor)
import Data.Char (isSpace)
import Prelude hiding (or, reads)

type Tree  =  UArray Int Int

(?) :: Bool -> a -> a -> a
(?) p a b  =  if p then a else b

readPair :: IO (Int, Int)
readPair  =  do
    x  <-  readInt
    y  <-  readInt
    return (x, y)

readInt :: IO Int
readInt  =  do
    c  <-  getChar
    isSpace c ? readInt $ readInt' (fromEnum c - fromEnum '0')
  where
    readInt' a  =  do
        c  <-  getChar
        isSpace c ? return a $ readInt' (10*a + fromEnum c - fromEnum '0')

or :: Int -> Int -> Int
or  =  (.|.)

level :: Int -> Int
level n  =  truncate (log (fromIntegral n) / log 2)

fInLevel :: Int -> Int -> (Int -> Int -> Int)
fInLevel n i
  | odd (n + level i)  =  or
  | otherwise  =  xor

createTree :: Int -> [Int] -> Tree
createTree n as  =  runSTUArray $ do
    tree  <-  newArray_ (1, 2^(n + 1) - 1)
    sequence_ [writeArray tree i x
                | (i, x) <- zip [2^n..] as]
    sequence_
      [
        do
          a  <-  readArray tree (2*i)
          b  <-  readArray tree (2*i+1)
          writeArray tree i (fInLevel n i a b)
        | i <- [2^n-1, 2^n-2 .. 1]
      ]
    return tree

solve :: Int -> [Int] -> [(Int, Int)] -> IO ()
solve n as qs  =  do
    let tree  =  createTree n as
    tree'  <-  unsafeThaw tree
    mapM_ (solve' tree')
        $ map (\(x, y) -> (x + 2^n - 1, y)) qs
  where
    solve' :: IOUArray Int Int -> (Int, Int) -> IO ()
    solve' array (1, d)  =  print d
    solve' array (i1, d1)  =  do
        let i0  =  i1 `div` 2
        let i2  =  if odd i1 then i1 - 1 else i1 + 1
        d2  <-  readArray array i2
        let d0  =  fInLevel n i0 d1 d2
        writeArray array i1 d1
        solve' array (i0, d0)

main :: IO ()
main  =  do
    (n, m)  <-  readPair
    as  <-  replicateM (2^n) readInt
    qs  <-  replicateM m readPair
    solve n as qs

import Control.Monad (liftM, replicateM)
import Data.Array.IO
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits ((.|.), xor)
import Prelude hiding (or, reads)

type Tree  =  UArray Int Int

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

readPair :: Read a => IO (a, a)
readPair  =  do
    [x, y]  <-  reads
    return (x, y)

or :: Int -> Int -> Int
or  =  (.|.)

level :: Int -> Int
level n  =  truncate (log (fromIntegral n) / log 2)

fInLevel :: Int -> Int -> (Int -> Int -> Int)
fInLevel n i
  | odd (level i + n)  =  or
  | otherwise  =  xor

createTree :: Int -> [Int] -> Tree
createTree n as  =  runSTUArray $ do
    tree  <-  newArray_ (1, 2^(n + 1) - 1)
    sequence_ [writeArray tree i x
                | (i, x) <- zip [2^n..] as]
    sequence_
      [
        do
          a  <-  readArray tree (2*i)
          b  <-  readArray tree (2*i+1)
          writeArray tree i (fInLevel n i a b)
        | i <- [2^n-1, 2^n-2 .. 1]
      ]
    return tree

solve :: Int -> [Int] -> [(Int, Int)] -> IO ()
solve n as qs  =  do
    let tree  =  createTree n as
    tree'  <-  unsafeThaw tree
    mapM_ (solve' tree')
        $ map (\(x, y) -> (x + 2^n - 1, y)) qs
  where
    solve' :: IOUArray Int Int -> (Int, Int) -> IO ()
    solve' array (1, d)  =  print d
    solve' array (i1, d1)  =  do
        let i0  =  i1 `div` 2
        let i2  =  if odd i1 then i1 - 1 else i1 + 1
        d2  <-  readArray array i2
        let d0  =  fInLevel n i0 d1 d2
        writeArray array i0 d0
        solve' array (i0, d0)

main :: IO ()
main  =  do
    {-
    let n  =  17
    let m  =  100000
    let as  =  [1 .. 2^n]
    let qs  =  take m $ cycle [(i, 0) | i <- as]
    -}
    [n, m]  <-  reads
    as  <-  reads
    qs  <-  replicateM m readPair
    solve n as qs


A card pyramid of height $$$1$$$ is constructed by resting two cards against each other. For $$$h>1$$$, a card pyramid of height $$$h$$$ is constructed by placing a card pyramid of height $$$h-1$$$ onto a base. A base consists of $$$h$$$ pyramids of height $$$1$$$, and $$$h-1$$$ cards on top. For example, card pyramids of heights $$$1$$$, $$$2$$$, and $$$3$$$ look as follows:  You start with $$$n$$$ cards and build the tallest pyramid that you can. If there are some cards remaining, you build the tallest pyramid possible with the remaining cards. You repeat this process until it is impossible to build another pyramid. In the end, how many pyramids will you have constructed?

Each test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. Each test case contains a single integer $$$n$$$ ($$$1\le n\le 10^9$$$) — the number of cards. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^9$$$.

For each test case output a single integer — the number of pyramids you will have constructed in the end.

NoteIn the first test, you construct a pyramid of height $$$1$$$ with $$$2$$$ cards. There is $$$1$$$ card remaining, which is not enough to build a pyramid.In the second test, you build two pyramids, each of height $$$2$$$, with no cards remaining.In the third test, you build one pyramid of height $$$3$$$, with no cards remaining.In the fourth test, you build one pyramid of height $$$3$$$ with $$$9$$$ cards remaining. Then you build a pyramid of height $$$2$$$ with $$$2$$$ cards remaining. Then you build a final pyramid of height $$$1$$$ with no cards remaining.In the fifth test, one card is not enough to build any pyramids.

upperBound n l = last $ takeWhile (<= n) l

cards = scanl (\cum n -> cum + 3 * n - 1) 0 [1..]

f :: Int -> Int
f n | n < 2     = 0
    | otherwise = 1 + f (n - (upperBound n cards))

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

findMaxSize :: Int -> Int
findMaxSize p = floor $ (sqrt (24 * fromIntegral p + 1) -1)/6

size :: Int -> Int
size h = (h * (3*h + 1)) `div` 2

solve :: Int -> Int
solve p
    | m == 0    = 0
    | otherwise = 1 + solve (p- size m)
    where
        m = findMaxSize p

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (p:_) <- readNums
    print $ solve p
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- parseNums <$> getLine
    testCases t

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine


You are given a string $$$s$$$ consisting of lowercase Latin letters "a", "b" and "c" and question marks "?".Let the number of question marks in the string $$$s$$$ be $$$k$$$. Let's replace each question mark with one of the letters "a", "b" and "c". Here we can obtain all $$$3^{k}$$$ possible strings consisting only of letters "a", "b" and "c". For example, if $$$s = $$$"ac?b?c" then we can obtain the following strings: $$$[$$$"acabac", "acabbc", "acabcc", "acbbac", "acbbbc", "acbbcc", "accbac", "accbbc", "accbcc"$$$]$$$.Your task is to count the total number of subsequences "abc" in all resulting strings. Since the answer can be very large, print it modulo $$$10^{9} + 7$$$.A subsequence of the string $$$t$$$ is such a sequence that can be derived from the string $$$t$$$ after removing some (possibly, zero) number of letters without changing the order of remaining letters. For example, the string "baacbc" contains two subsequences "abc" — a subsequence consisting of letters at positions $$$(2, 5, 6)$$$ and a subsequence consisting of letters at positions $$$(3, 5, 6)$$$.

The first line of the input contains one integer $$$n$$$ $$$(3 \le n \le 200\,000)$$$ — the length of $$$s$$$. The second line of the input contains the string $$$s$$$ of length $$$n$$$ consisting of lowercase Latin letters "a", "b" and "c" and question marks"?".

Print the total number of subsequences "abc" in all strings you can obtain if you replace all question marks with letters "a", "b" and "c", modulo $$$10^{9} + 7$$$.

NoteIn the first example, we can obtain $$$9$$$ strings:  "acabac" — there are $$$2$$$ subsequences "abc",  "acabbc" — there are $$$4$$$ subsequences "abc",  "acabcc" — there are $$$4$$$ subsequences "abc",  "acbbac" — there are $$$2$$$ subsequences "abc",  "acbbbc" — there are $$$3$$$ subsequences "abc",  "acbbcc" — there are $$$4$$$ subsequences "abc",  "accbac" — there is $$$1$$$ subsequence "abc",  "accbbc" — there are $$$2$$$ subsequences "abc",  "accbcc" — there are $$$2$$$ subsequences "abc". So, there are $$$2 + 4 + 4 + 2 + 3 + 4 + 1 + 2 + 2 = 24$$$ subsequences "abc" in total.

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> last
      >>> solve 1 0 0 0
      >>> show
      >>> (++ "\n")

myMod :: Integer
myMod = 10 ^ 9 + 7

madd :: Integer -> Integer -> Integer
madd a b = (a + b) `mod` myMod

mmul :: Integer -> Integer -> Integer
mmul a b = (a * b) `mod` myMod

solve :: Integer -> Integer -> Integer -> Integer -> String -> Integer
solve _ _ _ abc [] = abc
solve n a ab abc (x : xs)
  | x == 'a' = solve n (madd a n) ab abc xs
  | x == 'b' = solve n a (madd ab a) abc xs
  | x == 'c' = solve n a ab (madd abc ab) xs
  | x == '?' =
    solve
      (mmul 3 n)
      (madd (mmul 3 a) n)
      (madd (mmul 3 ab) a)
      (madd (mmul 3 abc) ab)
      xs

import Data.List

p :: Int
p = 10^(9 :: Int) + 7

sp :: Int -> Int -> Int
sp x y = rem (x + y) p

trip :: Int -> Int
trip x = sp x (sp x x)

data State = State !Int !Int !Int !Int

step :: State -> Char -> State
step (State w x y z) c = case  c  of
  'a' -> State w (sp w x) y z
  'b' -> State w x (sp x y) z
  'c' -> State w x y (sp y z)
  '?' -> State (trip w) (sp w $ trip x) (sp x $ trip y) (sp y $ trip z)
  _ -> error "invalid char in input"

solve :: [Char] -> Int
solve li = let
  State _ _ _ ans = foldl' step (State 1 0 0 0) li
  in  ans

main :: IO ()
main = do
  _nStr <- getLine
  s <- getLine
  print $ solve s

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> last
      >>> solve 1 0 0 0
      >>> show
      >>> (++ "\n")

myMod :: Int
myMod = 10 ^ 9 + 7

madd :: Int -> Int -> Int
madd a b = (a + b) `mod` myMod

mmul :: Int -> Int -> Int
mmul a b = (a * b) `mod` myMod

solve :: Int -> Int -> Int -> Int -> String -> Int
solve _ _ _ abc [] = abc
solve n a ab abc (x : xs)
  | x == 'a' = solve n (madd a 1) ab abc xs
  | x == 'b' = solve n a (madd ab a) abc xs
  | x == 'c' = solve n a ab (madd abc ab) xs
  | x == '?' =
    solve
      (mmul 3 n)
      (madd (mmul 3 a) n)
      (madd (mmul 3 ab) a)
      (madd (mmul 3 abc) ab)
      xs

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines
      >>> last
      >>> solve 1 0 0 0
      >>> show
      >>> (++ "\n")

myMod :: Int
myMod = 10 ^ 9 + 7

madd :: Int -> Int -> Int
madd a b = (a + b) `mod` myMod

mmul :: Int -> Int -> Int
mmul a b = (a * b) `mod` myMod

solve :: Int -> Int -> Int -> Int -> String -> Int
solve _ _ _ abc [] = abc
solve n a ab abc (x : xs)
  | x == 'a' = solve n (madd a n) ab abc xs
  | x == 'b' = solve n a (madd ab a) abc xs
  | x == 'c' = solve n a ab (madd abc ab) xs
  | x == '?' =
    solve
      (mmul 3 n)
      (madd (mmul 3 a) n)
      (madd (mmul 3 ab) a)
      (madd (mmul 3 abc) ab)
      xs


Alice and Bob are playing a game. The game involves splitting up game pieces into two teams. There are n pieces, and the i-th piece has a strength pi.The way to split up game pieces is split into several steps:  First, Alice will split the pieces into two different groups A and B. This can be seen as writing the assignment of teams of a piece in an n character string, where each character is A or B.  Bob will then choose an arbitrary prefix or suffix of the string, and flip each character in that suffix (i.e. change A to B and B to A). He can do this step at most once.  Alice will get all the pieces marked A and Bob will get all the pieces marked B. The strength of a player is then the sum of strengths of the pieces in the group.Given Alice's initial split into two teams, help Bob determine an optimal strategy. Return the maximum strength he can achieve.

The first line contains integer n (1 ≤ n ≤ 5·105) — the number of game pieces. The second line contains n integers pi (1 ≤ pi ≤ 109) — the strength of the i-th piece. The third line contains n characters A or B — the assignment of teams after the first step (after Alice's step).

Print the only integer a — the maximum strength Bob can achieve.

NoteIn the first sample Bob should flip the suffix of length one.In the second sample Bob should flip the prefix or the suffix (here it is the same) of length 5.In the third sample Bob should do nothing.

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents, unpack)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  getLine
  ps <- fmap (map fromIntegral) readInts :: IO [Int64]
  s <- fmap unpack getLine

  let
    as = scanl (+) 0 $ zipWith (\c p -> if c == 'A' then p else 0) s ps
    bs = scanl (+) 0 $ zipWith (\c p -> if c == 'B' then p else 0) s ps
    s1 = last as
    s2 = last bs

    prefs = zipWith (\a b -> a + s2 - b) as bs
    sufs = zipWith (\a b -> b + s1 - a) as bs

  print $ max (maximum prefs) (maximum sufs)

import qualified Data.ByteString.Char8 as C8
import Data.Maybe

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

suffixScore :: [Integer] -> String -> [Integer] -> [Integer]
suffixScore [] _ xs = xs
suffixScore _ [] xs = xs
suffixScore (score:scores) (piece:pieces) xs =
  let prev = head xs
      adder = flipValueOf score piece
      newValue = prev + adder
      xs' = (newValue:xs)
  in suffixScore scores pieces xs'

flipValueOf :: Integer -> Char -> Integer
flipValueOf n 'A' = n
flipValueOf n 'B' = (-n)

prefixScore :: [Integer] -> String -> [Integer] -> [Integer]
prefixScore scores pieces xs = suffixScore (reverse scores) (reverse pieces) xs

getInitialScore :: [Integer] -> String -> Integer
getInitialScore scores pieces = sum bsVals
  where bs = ((=='B') . snd ) `filter` (scores `zip` pieces)
        bsVals = map fst bs

main :: IO()
main = do
    n <- getLine >>= return . readInteger
    line <- C8.getLine
    pieces <- getLine
    let
        scores = map (fst . fromJust . C8.readInteger) (C8.words line)
        initialScore = getInitialScore scores pieces
        suffixScores = suffixScore scores pieces [initialScore]
        prefixScores = prefixScore scores pieces [initialScore]
    putStrLn $ show $ (foldl1 max) (suffixScores ++ prefixScores)


Om Nom really likes candies and doesn't like spiders as they frequently steal candies. One day Om Nom fancied a walk in a park. Unfortunately, the park has some spiders and Om Nom doesn't want to see them at all.  The park can be represented as a rectangular n × m field. The park has k spiders, each spider at time 0 is at some cell of the field. The spiders move all the time, and each spider always moves in one of the four directions (left, right, down, up). In a unit of time, a spider crawls from his cell to the side-adjacent cell in the corresponding direction. If there is no cell in the given direction, then the spider leaves the park. The spiders do not interfere with each other as they move. Specifically, one cell can have multiple spiders at the same time.Om Nom isn't yet sure where to start his walk from but he definitely wants:  to start walking at time 0 at an upper row cell of the field (it is guaranteed that the cells in this row do not contain any spiders);  to walk by moving down the field towards the lowest row (the walk ends when Om Nom leaves the boundaries of the park). We know that Om Nom moves by jumping. One jump takes one time unit and transports the little monster from his cell to either a side-adjacent cell on the lower row or outside the park boundaries.Each time Om Nom lands in a cell he sees all the spiders that have come to that cell at this moment of time. Om Nom wants to choose the optimal cell to start the walk from. That's why he wonders: for each possible starting cell, how many spiders will he see during the walk if he starts from this cell? Help him and calculate the required value for each possible starting cell.

The first line contains three integers n, m, k (2 ≤ n, m ≤ 2000; 0 ≤ k ≤ m(n - 1)).  Each of the next n lines contains m characters — the description of the park. The characters in the i-th line describe the i-th row of the park field. If the character in the line equals ".", that means that the corresponding cell of the field is empty; otherwise, the character in the line will equal one of the four characters: "L" (meaning that this cell has a spider at time 0, moving left), "R" (a spider moving right), "U" (a spider moving up), "D" (a spider moving down).  It is guaranteed that the first row doesn't contain any spiders. It is guaranteed that the description of the field contains no extra characters. It is guaranteed that at time 0 the field contains exactly k spiders.

Print m integers: the j-th integer must show the number of spiders Om Nom will see if he starts his walk from the j-th cell of the first row. The cells in any row of the field are numbered from left to right.

NoteConsider the first sample. The notes below show how the spider arrangement changes on the field over time:...        ...        ..U       ...R.L   ->   .*U   ->   L.R   ->  ...R.U        .R.        ..R       ...Character "*" represents a cell that contains two spiders at the same time.  If Om Nom starts from the first cell of the first row, he won't see any spiders.  If he starts from the second cell, he will see two spiders at time 1.  If he starts from the third cell, he will see two spiders: one at time 1, the other one at time 2.

import Data.Array.IO
import Data.IORef
import Control.Monad
import Data.Tuple
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

parse :: B.ByteString -> [Int]
parse s = do
	q <- B.splitWith (\x-> x == 13 || x == 10 || x == 32) s
	if B.length q == 0 then
		[]
	else
		return $ foldl' (\a b-> a * 10 + (fromIntegral b) - (ord '0')) 0 (B.unpack q)

main :: IO ()
main = do
	n:m:k:_ <- liftM (map read) $ liftM words getLine
	s <- (((forM (replicate n 0) $ \_ -> getLine >>= (newListArray (0, m-1)))) >>= (newListArray (0, n-1))) :: IO (IOArray Int (IOArray Int Char))
	r <- ((newArray (0, m-1) 0) :: IO (IOArray Int Int))
	forM_ [0..(n-1)] $ \i -> do
		line <- readArray s i
		forM_ [0..(m-1)] $ \j -> do
			p <- readArray line j
			case p of
				'D' -> return ()
				'U' ->
					if i `mod` 2 == 0 then do
						q <- readArray r j
						writeArray r j (q + 1)
					else return ()
				'L' -> do
					let jj = j - i
					if jj >= 0 && jj < m then do
						q <- readArray r jj
						writeArray r jj (q + 1)
					else return ()
				'R' -> do
					let jj = j + i
					if jj >= 0 && jj < m then do
						q <- readArray r jj
						writeArray r jj (q + 1)
					else return ()
				_ -> return ()
			--qqq <- getElems r
			--putStrLn $ show (i, j, i `mod` 2 > 0, p, qqq)
	rr <- getElems r
	putStrLn $ concat $ map (\x -> (show x) ++ " ") rr

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
-- readInt :: B.ByteString -> Int
-- readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,m,k] <- map read.words <$> getLine
  bs <- B.concat.B.words <$> B.getContents
  let !arr = solve n m bs
  putStrLn.unwords $ map (show.unsafeAt arr) [0..m-1]

solve :: Int -> Int -> B.ByteString -> UArray Int Int
solve n m bs = runSTUArray $ do
  marr <- newArray (0, m - 1) 0 :: ST s (STUArray s Int Int)
  rep n $ \i -> do
    rep m $ \j -> do
      case B.index bs (i * m + j) of
        'U' | even i     -> unsafeModify marr j       (1+)
        'R' | j + i < m  -> unsafeModify marr (j + i) (1+)
        'L' | 0 <= j - i -> unsafeModify marr (j - i) (1+)
        _                -> return ()
  return marr

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
-- readInt :: B.ByteString -> Int
-- readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,m,k] <- map read.words <$> getLine
  bs <- B.concat.B.words <$> B.getContents
  let !arr = solve n m bs
  putStrLn.unwords $ map (show.unsafeAt arr) [0..m-1]

solve :: Int -> Int -> B.ByteString -> UArray Int Int
solve n m bs = runSTUArray $ do
  marr <- newArray (0,m-1) 0 :: ST s (STUArray s Int Int)
  rep n $ \i-> do
    rep m $ \j-> do
      case B.index bs (i*m+j) of
        'U' | i > 1           -> unsafeModify marr j     (1+)
        'R' | i+j < m         -> unsafeModify marr (i+j) (1+)
        'L' | 0 <= j-i, j-i<m -> unsafeModify marr (j-i) (1+)
        _                     -> return ()
  return marr

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
-- readInt :: B.ByteString -> Int
-- readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,m,k] <- map read.words <$> getLine
  bs <- B.concat.B.words <$> B.getContents
  let !arr = solve n m bs
  putStrLn.unwords $ map (show.unsafeAt arr) [0..m-1]

solve :: Int -> Int -> B.ByteString -> UArray Int Int
solve n m bs = runSTUArray $ do
  marr <- newArray (0, m - 1) 0 :: ST s (STUArray s Int Int)
  rep n $ \i -> do
    rep m $ \j -> do
      case B.index bs (i * m + j) of
        'U' | i > 1                         -> unsafeModify marr j       (1+)
        'R' | j + i < m, i > 0              -> unsafeModify marr (j + i) (1+)
        'L' | 0 <= j - i, j - i < m, i > 0  -> unsafeModify marr (j - i) (1+)
        _                                   -> return ()
  return marr