Pinkie Pie has bought a bag of patty-cakes with different fillings! But it appeared that not all patty-cakes differ from one another with filling. In other words, the bag contains some patty-cakes with the same filling.Pinkie Pie eats the patty-cakes one-by-one. She likes having fun so she decided not to simply eat the patty-cakes but to try not to eat the patty-cakes with the same filling way too often. To achieve this she wants the minimum distance between the eaten with the same filling to be the largest possible. Herein Pinkie Pie called the distance between two patty-cakes the number of eaten patty-cakes strictly between them.Pinkie Pie can eat the patty-cakes in any order. She is impatient about eating all the patty-cakes up so she asks you to help her to count the greatest minimum distance between the eaten patty-cakes with the same filling amongst all possible orders of eating!Pinkie Pie is going to buy more bags of patty-cakes so she asks you to solve this problem for several bags!

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 100$$$): the number of bags for which you need to solve the problem. The first line of each bag description contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$): the number of patty-cakes in it. The second line of the bag description contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$): the information of patty-cakes' fillings: same fillings are defined as same integers, different fillings are defined as different integers. It is guaranteed that each bag contains at least two patty-cakes with the same filling.  It is guaranteed that the sum of $$$n$$$ over all bags does not exceed $$$10^5$$$.

For each bag print in separate line one single integer: the largest minimum distance between the eaten patty-cakes with the same filling amongst all possible orders of eating for that bag.

NoteFor the first bag Pinkie Pie can eat the patty-cakes in the following order (by fillings): $$$1$$$, $$$6$$$, $$$4$$$, $$$7$$$, $$$1$$$, $$$6$$$, $$$4$$$ (in this way, the minimum distance is equal to $$$3$$$).For the second bag Pinkie Pie can eat the patty-cakes in the following order (by fillings): $$$1$$$, $$$4$$$, $$$6$$$, $$$7$$$, $$$4$$$, $$$1$$$, $$$6$$$, $$$4$$$ (in this way, the minimum distance is equal to $$$2$$$).

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

solve :: Int -> [Int] -> Int
solve n as = let
  occs = reverse . sort . map length . group $ sort as
  cap = head occs
  ct = length . head $ group occs
  in  div (n - ct) (cap - 1) - 1

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    n <- read <$> getLine :: IO Int
    as <- map read . words <$> getLine :: IO [Int]
    print (solve n as)


Given a positive integer $$$k$$$, two arrays are called $$$k$$$-similar if:  they are strictly increasing;  they have the same length;  all their elements are positive integers between $$$1$$$ and $$$k$$$ (inclusive);  they differ in exactly one position. You are given an integer $$$k$$$, a strictly increasing array $$$a$$$ and $$$q$$$ queries. For each query, you are given two integers $$$l_i \leq r_i$$$. Your task is to find how many arrays $$$b$$$ exist, such that $$$b$$$ is $$$k$$$-similar to array $$$[a_{l_i},a_{l_i+1}\ldots,a_{r_i}]$$$.

The first line contains three integers $$$n$$$, $$$q$$$ and $$$k$$$ ($$$1\leq n, q \leq 10^5$$$, $$$n\leq k \leq 10^9$$$) — the length of array $$$a$$$, the number of queries and number $$$k$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots,a_n$$$ ($$$1 \leq a_i \leq k$$$). This array is strictly increasing  — $$$a_1 < a_2 < \ldots < a_n$$$. Each of the following $$$q$$$ lines contains two integers $$$l_i$$$, $$$r_i$$$ ($$$1 \leq l_i \leq r_i \leq n$$$).

Print $$$q$$$ lines. The $$$i$$$-th of them should contain the answer to the $$$i$$$-th query.

NoteIn the first example:In the first query there are $$$4$$$ arrays that are $$$5$$$-similar to $$$[2,4]$$$: $$$[1,4],[3,4],[2,3],[2,5]$$$.In the second query there are $$$3$$$ arrays that are $$$5$$$-similar to $$$[4,5]$$$: $$$[1,5],[2,5],[3,5]$$$.

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import Data.Int
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] $ map fromIntegral as
    f :: Int -> Int64
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k' + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    k' = fromIntegral k
    solve :: Int -> Int -> Int64
    solve l r
      | l == r = k' - 1
      | l + 1 == r = a ! r - 2 + k' - a ! l - 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k' - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  ~[n, q, k] <- popInts
  a <- listArray (0, n - 1) <$> popInts
  qq <- replicateM q ((\[l, r] -> (l - 1, r - 1)) <$> popInts)
  return $ B.unlines $ map bshow (solve n k a qq)

solve :: Int -> Int -> UArray Int Int -> [(Int, Int)] -> [Int]
solve n k as qs = map solve1 qs
  where
    bs :: UArray Int Int
    bs = listArray (0, n - 1) $ map makeB [0 .. n - 1]

    makeB i = let low | i == 0 = 0
                      | otherwise = as ! (i - 1)
                  high | i == n - 1 = k + 1
                       | otherwise = as ! (i + 1) in
                high - low - 2

    segs :: [UArray Int Int]
    segs = reverse $ makeSegs n [bs]

    makeSegs 1 sss = sss
    makeSegs n sss@(ss : _) =
      let n' = (n + 1) `quot` 2
          p i | i == n - 1 = ss ! i
              | otherwise = ss ! i + ss ! (i + 1)
          nss = listArray (0, n' - 1) $
                map (p . (* 2)) [0 .. n' - 1] in
        makeSegs n' (nss : sss)

    bsum l r | l > r = 0
             | otherwise = bsum' segs l (r + 1)

    bsum' (ss : sss) l r = case r - l of
      (-1) -> 0
      0 -> 0
      1 -> ss ! l
      _ -> let (lv, l') = case l `quotRem` 2 of
                            (q, 0) -> (0, q)
                            (q, _) -> (ss ! l, q + 1)
               (rv, r') = case r `quotRem` 2 of
                            (q, 0) -> (0, q)
                            (q, _) -> (ss ! (r - 1), q) in
             lv + rv + bsum' sss l' r'

    solve1 (l, r) | l == r = k - 1
                  | otherwise = (as ! (l + 1) - 2) +
                                (k - as ! (r - 1) - 1) +
                                bsum (l + 1) (r - 1)

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Int

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q, k] <- readInts
  a <- readInts
  let
    los = 1 : zipWith min a (tail a)
    his = zipWith max a (tail a) ++ [k]
    opts = zipWith (\x y -> x - y - 2) his los
    optPrefSums = tail $ scanl (\x y -> x + fromIntegral y) 0 opts
    optArr :: UArray Int Int64
    optArr = listArray (1, n) optPrefSums
    aArr :: UArray Int Int64
    aArr = listArray (1, n) $ map fromIntegral a
    k64 :: Int64
    k64 = fromIntegral k
  --lift $ print aArr
  --lift $ print los
  --lift $ print his
  --lift $ print optArr
  replicateM_ q $ do
    [li, ri] <- readInts
    if  li == ri
      then  putInts [k64 - 1]
      else  let
      midOpts = optArr ! (ri - 1) - optArr ! li
      endOpt =  k64 - aArr ! (ri - 1) - 1
      startOpt = aArr ! (li + 1) - 2
      in  do
      --lift $ print startOpt
      --lift $ print midOpts
      --lift $ print endOpt
      --lift $ putStr "tot = "
      putInts [startOpt + midOpts + endOpt]

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

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

putInts :: [Int64] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.int64Dec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import Data.Int
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] $ map fromIntegral as
    f :: Int -> Int64
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k' + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    k' = fromIntegral k
    solve :: Int -> Int -> Int64
    solve l r
      | l == r = k' - 1
      | l + 1 == r = a' ! r - 2 + k' - a' ! l + 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k' - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r

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

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] as
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    solve l r
      | l == r = k - 1
      | l + 1 == r = a' ! r - 2 + k - a' ! l + 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r


Phoenix is playing with a new puzzle, which consists of $$$n$$$ identical puzzle pieces. Each puzzle piece is a right isosceles triangle as shown below.    A puzzle piece The goal of the puzzle is to create a square using the $$$n$$$ pieces. He is allowed to rotate and move the pieces around, but none of them can overlap and all $$$n$$$ pieces must be used (of course, the square shouldn't contain any holes as well). Can he do it?

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$1 \le n \le 10^9$$$) — the number of puzzle pieces.

For each test case, if Phoenix can create a square with the $$$n$$$ puzzle pieces, print YES. Otherwise, print NO.

NoteFor $$$n=2$$$, Phoenix can create a square like this:    For $$$n=4$$$, Phoenix can create a square like this:    For $$$n=6$$$, it is impossible for Phoenix to create a square.

import Control.Monad

isSquare n = sq * sq == n where sq = floor $ sqrt $ fromIntegral n
check n k = mod n k == 0 && isSquare (div n k)

printResult = do
    n <- readLn :: IO Int
    putStrLn $ if check n 2 || check n 4 then "YES" else "NO"

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

import Control.Arrow

solve :: Int -> Bool
solve 1 = True
solve x = even x && (isSquare (x `div` 2) || solve (x `div` 2))
    where
        isSquare :: Int -> Bool
        isSquare n = sq * sq  == n
            where
                sq = floor $ sqrt (fromIntegral n::Double)

main :: IO()
main = interact $ lines >>> tail >>> map ((\x -> read x :: Int) >>> (\x -> x > 1 && solve x) >>> repr) >>> unlines
    where
        repr True = "YES"
        repr False = "NO"

import GHC.Float (float2Int, int2Float)

f :: Int -> String
f n
  | mod n 4 == 0 && isSquare (div n 4) = "YES"
  | mod n 2 == 0 && isSquare (div n 2) = "YES"
  | otherwise = "NO"

isSquare :: Int -> Bool
isSquare n = float2Int (sqrt (int2Float n)) ^ 2 == n

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

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

sq :: Int -> Bool
sq n =
    let s = floor . sqrt. fromIntegral $ n
    in
        s * s == n

solve :: Int -> Bool
solve n = (even n && sq (n `div` 2)) || (n `mod` 4 == 0 && sq (n `div` 4))

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        putStrLn (if solve n then "YES" else "NO")

isSqrt :: Int -> Bool
isSqrt x = y * y == x
    where
        y = round $ sqrt $ fromIntegral  x

getAns :: Int -> String
getAns x
  | x `mod` 2 == 0 && isSqrt (x `div` 2) = "YES"
  | x `mod` 4 == 0 && isSqrt (x `div` 4) = "YES"
  | otherwise = "NO"

solve (x:xs) = map getAns $ map read xs

main = do
  interact $ unlines . solve . lines

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

isqrt :: Int -> Int
isqrt v = round $ sqrt (fromIntegral v :: Double)

ok :: Int -> Int -> Bool
ok w x = case  divMod x w  of
  (q, 0) -> q == isqrt q * isqrt q
  _ -> False

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    lift $ P.putStr $ if  ok 2 n || ok 4 n
      then  P.pack "YES\n"
      else  P.pack "NO\n"

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad
import Data.Bits
readInt = readLn :: IO Int
solve n = putStrLn r where r = if n .&. (n-1) == 0 && n > 1 then "YES" else "NO"
main = do
    n <- readInt
    a <- replicateM n readInt
    mapM solve a

import Control.Monad
import Data.Bits
readInt = readLn :: IO Int
solve n = putStrLn r where r = if n .&. (n-1) == 0 then "YES" else "NO"
main = do
    n <- readInt
    a <- replicateM n readInt
    mapM solve a

import Control.Arrow

pows :: [Int]
pows = iterate (*2) 2

solve :: [Int] -> Int -> Bool
solve _ 1 = True
solve (n:ns) x = even x && (isSquare (x `div` n) || solve ns (x `div` n))
    where
        isSquare :: Int -> Bool
        isSquare n = sq * sq  == n
            where
                sq = floor $ sqrt (fromIntegral n::Double)

main :: IO()
main = interact $ lines >>> tail >>> map ((\x -> read x :: Int) >>> solve pows >>> repr) >>> unlines
    where
        repr True = "YES"
        repr False = "NO"


You are given a table consisting of n rows and m columns.Numbers in each row form a permutation of integers from 1 to m.You are allowed to pick two elements in one row and swap them, but no more than once for each row. Also, no more than once you are allowed to pick two columns and swap them. Thus, you are allowed to perform from 0 to n + 1 actions in total. Operations can be performed in any order.You have to check whether it's possible to obtain the identity permutation 1, 2, ..., m in each row. In other words, check if one can perform some of the operation following the given rules and make each row sorted in increasing order.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 20) — the number of rows and the number of columns in the given table.  Each of next n lines contains m integers — elements of the table. It's guaranteed that numbers in each line form a permutation of integers from 1 to m.

If there is a way to obtain the identity permutation in each row by following the given rules, print "YES" (without quotes) in the only line of the output. Otherwise, print "NO" (without quotes).

NoteIn the first sample, one can act in the following way:   Swap second and third columns. Now the table is 1 2 3 4 1 4 3 2  In the second row, swap the second and the fourth elements. Now the table is 1 2 3 4 1 2 3 4

import Data.List

main :: IO()
main = output . solve . map read . words =<< getContents

output :: Bool -> IO()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> Bool
solve (n:m:a) = let b = splitToTwoD m a
                    c = (0, 0) : [(i, j) | i <- [0..(m-2)], j <- [(i+1)..(m-1)]]
                in any (checkSwapCol b) c

splitToTwoD :: Int -> [Int] -> [[Int]]
splitToTwoD _ [] = []
splitToTwoD m a = let (b, c) = splitAt m a
                  in b : splitToTwoD m c

swapCol :: Int -> Int -> [Int] -> [Int]
swapCol i j a = let ei = a !! i
                    ej = a !! j
                in swapCol' ei ej 0 a
                where swapCol' :: Int -> Int -> Int -> [Int] -> [Int]
                      swapCol' _ _ _ [] = []
                      swapCol' ei ej c (a:s) | c == i = ej : swapCol' ei ej (c + 1) s
                                             | c == j = ei : swapCol' ei ej (c + 1) s
                                             | otherwise = a : swapCol' ei ej (c + 1) s

checkSwapCol :: [[Int]] -> (Int, Int) -> Bool
checkSwapCol b (i, j) = all (checkSwappedCol 1 0 . swapCol i j) b

checkSwappedCol :: Int -> Int -> [Int] -> Bool
checkSwappedCol _ c [] = c <= 2
checkSwappedCol i c (b:bs) | i == b = checkSwappedCol (i + 1) c bs
                           | otherwise = checkSwappedCol (i + 1) (c + 1) bs

import Data.List

main :: IO()
main = output . solve . map read . words =<< getContents

output :: Bool -> IO()
output True = putStrLn "YES"
output False = putStrLn "NO"

solve :: [Int] -> Bool
solve (n:m:a) = let b = splitToTwoD m a
                    c = [(i, j) | i <- [0..(m-2)], j <- [(i+1)..(m-1)]]
                in all (checkSwappedCol 1 0) b || any (checkSwapCol b) c

splitToTwoD :: Int -> [Int] -> [[Int]]
splitToTwoD _ [] = []
splitToTwoD m a = let (b, c) = splitAt m a
                  in b : splitToTwoD m c

swapCol :: Int -> Int -> [a] -> [a]
swapCol i j xs = let elemI = xs !! i
                     elemJ = xs !! j
                     left = take (i - 1) xs
                     middle = take (j - i - 1) (drop i xs)
                     right = drop j xs
                 in  left ++ [elemJ] ++ middle ++ [elemI] ++ right

checkSwapCol :: [[Int]] -> (Int, Int) -> Bool
checkSwapCol b (i, j) = all (checkSwappedCol 1 0 . swapCol i j) b

checkSwappedCol :: Int -> Int -> [Int] -> Bool
checkSwappedCol _ c [] = c <= 2
checkSwappedCol i c (b:bs) | i == b = checkSwappedCol (i + 1) c bs
                           | otherwise = checkSwappedCol (i + 1) (c + 1) bs


Walking along a riverside, Mino silently takes a note of something."Time," Mino thinks aloud."What?""Time and tide wait for no man," explains Mino. "My name, taken from the river, always reminds me of this.""And what are you recording?""You see it, tide. Everything has its own period, and I think I've figured out this one," says Mino with confidence.Doubtfully, Kanno peeks at Mino's records. The records are expressed as a string $$$s$$$ of characters '0', '1' and '.', where '0' denotes a low tide, '1' denotes a high tide, and '.' denotes an unknown one (either high or low).You are to help Mino determine whether it's possible that after replacing each '.' independently with '0' or '1', a given integer $$$p$$$ is not a period of the resulting string. In case the answer is yes, please also show such a replacement to Mino.In this problem, a positive integer $$$p$$$ is considered a period of string $$$s$$$, if for all $$$1 \leq i \leq \lvert s \rvert - p$$$, the $$$i$$$-th and $$$(i + p)$$$-th characters of $$$s$$$ are the same. Here $$$\lvert s \rvert$$$ is the length of $$$s$$$.

The first line contains two space-separated integers $$$n$$$ and $$$p$$$ ($$$1 \leq p \leq n \leq 2000$$$) — the length of the given string and the supposed period, respectively. The second line contains a string $$$s$$$ of $$$n$$$ characters — Mino's records. $$$s$$$ only contains characters '0', '1' and '.', and contains at least one '.' character.

Output one line — if it's possible that $$$p$$$ is not a period of the resulting string, output any one of such strings; otherwise output "No" (without quotes, you can print letters in any case (upper or lower)).

NoteIn the first example, $$$7$$$ is not a period of the resulting string because the $$$1$$$-st and $$$8$$$-th characters of it are different.In the second example, $$$6$$$ is not a period of the resulting string because the $$$4$$$-th and $$$10$$$-th characters of it are different.In the third example, $$$9$$$ is always a period because the only constraint that the first and last characters are the same is already satisfied.Note that there are multiple acceptable answers for the first two examples, you can print any of them.

import qualified Data.List as L (elem)

main = do
    [n, p] <- fmap (map read . words) getLine
    xs <- fmap (take n) getLine
    let h x | x == '1' = '0' | otherwise = '1'
        f (x, y) | x == '.' && y == '.' = "01" | x == '.' = [h y, y] | y == '.' = [x, h x] | otherwise = [x, y]
        g x | x == '.' = '1' | otherwise = x
        qs = map f $ zip xs (drop p xs)
        (rs, ts) = unzip $ map (\[a, b] -> (a, b)) qs
    if any (not . (`L.elem` ["00", "11"])) qs then
        if n - p <= p then
            putStrLn $ rs ++ map g (take (n - (n - p) - (n - p)) (drop (n - p) xs)) ++ ts
        else
            putStrLn $ rs ++ drop (n - p - p) ts
    else
        putStrLn "No"

import qualified Data.List as L (elem)

main = do
    [n, p] <- fmap (map read . words) getLine
    xs <- fmap (take n) getLine
    let h x | x == '1' = '0' | otherwise = '1'
        f (x, y) | x == '.' && y == '.' = "01" | x == '.' = [h y, y] | y == '.' = [x, h x] | otherwise = [x, y]
        g x | x == '.' = '1' | otherwise = x
        qs = map f $ zip xs (drop p xs)
        (rs, ts) = unzip $ map (\[a, b] -> (a, b)) qs
        pp = min p (n - p)
    if any (not . (`L.elem` ["00", "11"])) qs || length qs == 0 then
        putStrLn $ rs ++ map g (take (n - pp - pp) (drop pp xs)) ++ ts
    else
        putStrLn "No"

import qualified Data.List as L (elem)

main = do
    [n, p] <- fmap (map read . words) getLine
    xs <- fmap (take n) getLine
    let h x | x == '1' = '0' | otherwise = '1'
        f (x, y) | x == '.' && y == '.' = "01" | x == '.' = [h y, y] | y == '.' = [x, h x] | otherwise = [x, y]
        g x | x == '.' = '1' | otherwise = x
        qs = map f $ zip xs (drop p xs)
        (rs, ts) = unzip $ map (\[a, b] -> (a, b)) qs
        pp = min p (n - p)
    if any (not . (`L.elem` ["00", "11"])) qs then
        putStrLn $ rs ++ map g (take (n - pp - pp) (drop pp xs)) ++ ts
    else
        putStrLn "No"

import qualified Data.List as L (elem)

main = do
    [n, p] <- fmap (map read . words) getLine
    xs <- fmap (take n) getLine
    let h x | x == '1' = '0' | otherwise = '1'
        f (x, y) | x == '.' = [h y, y] | y == '.' = [x, h x] | otherwise = [x, y]
        g x | x == '.' = '1' | otherwise = x
        qs = map f $ zip xs (drop p xs)
        (rs, ts) = unzip $ map (\[a, b] -> (a, b)) qs
        pp = min p (n - p)
    if any (not . (`L.elem` ["00", "11"])) qs then
        putStrLn $ rs ++ map g (take (n - pp - pp) (drop pp xs)) ++ ts
    else
        putStrLn "No"


The only difference between easy and hard versions is the length of the string. You can hack this problem only if you solve both problems.Kirk has a binary string $$$s$$$ (a string which consists of zeroes and ones) of length $$$n$$$ and he is asking you to find a binary string $$$t$$$ of the same length which satisfies the following conditions: For any $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq n$$$) the length of the longest non-decreasing subsequence of the substring $$$s_{l}s_{l+1} \ldots s_{r}$$$ is equal to the length of the longest non-decreasing subsequence of the substring $$$t_{l}t_{l+1} \ldots t_{r}$$$; The number of zeroes in $$$t$$$ is the maximum possible.A non-decreasing subsequence of a string $$$p$$$ is a sequence of indices $$$i_1, i_2, \ldots, i_k$$$ such that $$$i_1 < i_2 < \ldots < i_k$$$ and $$$p_{i_1} \leq p_{i_2} \leq \ldots \leq p_{i_k}$$$. The length of the subsequence is $$$k$$$.If there are multiple substrings which satisfy the conditions, output any.

The first line contains a binary string of length not more than $$$2\: 000$$$.

Output a binary string which satisfied the above conditions. If there are many such strings, output any of them.

NoteIn the first example:  For the substrings of the length $$$1$$$ the length of the longest non-decreasing subsequnce is $$$1$$$;  For $$$l = 1, r = 2$$$ the longest non-decreasing subsequnce of the substring $$$s_{1}s_{2}$$$ is $$$11$$$ and the longest non-decreasing subsequnce of the substring $$$t_{1}t_{2}$$$ is $$$01$$$;  For $$$l = 1, r = 3$$$ the longest non-decreasing subsequnce of the substring $$$s_{1}s_{3}$$$ is $$$11$$$ and the longest non-decreasing subsequnce of the substring $$$t_{1}t_{3}$$$ is $$$00$$$;  For $$$l = 2, r = 3$$$ the longest non-decreasing subsequnce of the substring $$$s_{2}s_{3}$$$ is $$$1$$$ and the longest non-decreasing subsequnce of the substring $$$t_{2}t_{3}$$$ is $$$1$$$; The second example is similar to the first one.

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

answer s = let n = length s in simplify 1 2 (listArray (1, n) s :: UArray Int Char) (listArray (1, n) (replicate n 1000000) :: UArray Int Int)
simplify :: Int -> Int -> UArray Int Char -> UArray Int Int -> String
simplify a b s k
  | b > n = alter s k
  | a < 1 = simplify b (b + 1) s k
  | s ! a == '1' && s ! b == '0' = simplify before (b + 1) s (k // [(a, before), (b, before)])
  | otherwise = simplify b (b + 1) s k
  where n = snd $ bounds s
        before = if a > 1 then min (a - 1) (k ! (a - 1)) else a - 1
alter :: UArray Int Char -> UArray Int Int -> String
alter s k = [if k ! i /= 1000000 then s ! i else '0' | let n = snd $ bounds s, i <- [1..n]]

main = getLine >>= putStrLn.answer.head.words


Polycarp has come up with a new game to play with you. He calls it "A missing bigram".A bigram of a word is a sequence of two adjacent letters in it.For example, word "abbaaba" contains bigrams "ab", "bb", "ba", "aa", "ab" and "ba".The game goes as follows. First, Polycarp comes up with a word, consisting only of lowercase letters 'a' and 'b'. Then, he writes down all its bigrams on a whiteboard in the same order as they appear in the word. After that, he wipes one of them off the whiteboard.Finally, Polycarp invites you to guess what the word that he has come up with was.Your goal is to find any word such that it's possible to write down all its bigrams and remove one of them, so that the resulting sequence of bigrams is the same as the one Polycarp ended up with.The tests are generated in such a way that the answer exists. If there are multiple answers, you can print any of them.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of testcases. The first line of each testcase contains a single integer $$$n$$$ ($$$3 \le n \le 100$$$) — the length of the word Polycarp has come up with. The second line of each testcase contains $$$n-2$$$ bigrams of that word, separated by a single space. Each bigram consists of two letters, each of them is either 'a' or 'b'. Additional constraint on the input: there exists at least one string such that it is possible to write down all its bigrams, except one, so that the resulting sequence is the same as the sequence in the input. In other words, the answer exists.

For each testcase print a word, consisting of $$$n$$$ letters, each of them should be either 'a' or 'b'. It should be possible to write down all its bigrams and remove one of them, so that the resulting sequence of bigrams is the same as the one Polycarp ended up with. The tests are generated in such a way that the answer exists. If there are multiple answers, you can print any of them.

4
7
ab bb ba aa ba
7
ab ba aa ab ba
3
aa
5
bb ab bb

NoteThe first two testcases from the example are produced from the word "abbaaba". As listed in the statement, it contains bigrams "ab", "bb", "ba", "aa", "ab" and "ba".In the first testcase, the $$$5$$$-th bigram is removed. In the second testcase, the $$$2$$$-nd bigram is removed. However, that sequence could also have been produced from the word "abaabaa". It contains bigrams "ab", "ba", "aa", "ab", "ba" and "aa". The missing bigram is the $$$6$$$-th one.In the third testcase, all of "baa", "aab" and "aaa" are valid answers.

-- https://codeforces.com/contest/1618/problem/B
import Control.Monad (replicateM)

answer [b] found = b ++ if not found then "a" else ""
answer (b1:b2:bs) found
    | b1!!1 == b2!!0 || found = b1!!0 : answer (b2:bs) found
    | otherwise = b1 ++ answer (b2:bs) True

main = getLine >>= flip replicateM run . read
run = do
    n <- getLine
    line <- words <$> getLine
    putStrLn $ answer line False

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- words . C.unpack <$> C.getLine
    let gen c1 c2
            | c1 == c2  = [c1]
            | otherwise = [c1, c2]
        s = [head $ head xs] ++ concat (zipWith gen (map last xs) (map head $ tail xs)) ++ [last $ last xs]
    putStrLn $ if length s == n then s else 'a':s

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


There are $$$n$$$ blocks arranged in a row and numbered from left to right, starting from one. Each block is either black or white. You may perform the following operation zero or more times: choose two adjacent blocks and invert their colors (white block becomes black, and vice versa). You want to find a sequence of operations, such that they make all the blocks having the same color. You don't have to minimize the number of operations, but it should not exceed $$$3 \cdot n$$$. If it is impossible to find such a sequence of operations, you need to report it.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 200$$$) — the number of blocks. The second line contains one string $$$s$$$ consisting of $$$n$$$ characters, each character is either "W" or "B". If the $$$i$$$-th character is "W", then the $$$i$$$-th block is white. If the $$$i$$$-th character is "B", then the $$$i$$$-th block is black.

If it is impossible to make all the blocks having the same color, print $$$-1$$$. Otherwise, print an integer $$$k$$$ ($$$0 \le k \le 3 \cdot n$$$) — the number of operations. Then print $$$k$$$ integers $$$p_1, p_2, \dots, p_k$$$ $$$(1 \le p_j \le n - 1)$$$, where $$$p_j$$$ is the position of the left block in the pair of blocks that should be affected by the $$$j$$$-th operation. If there are multiple answers, print any of them.

NoteIn the first example, it is possible to make all blocks black in $$$3$$$ operations. Start with changing blocks $$$6$$$ and $$$7$$$, so the sequence is "BWWWWBBB". Then change blocks $$$2$$$ and $$$3$$$, so the sequence is "BBBWWBB". And finally, change blocks $$$4$$$ and $$$5$$$, so all blocks are black.It is impossible to make all colors equal in the second example.All blocks are already white in the third example.In the fourth example it is possible to make all blocks white in two operations: first operation is to change blocks $$$2$$$ and $$$3$$$ (so the sequence is "BBW"), and then change blocks $$$1$$$ and $$$2$$$ (so all blocks are white).

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

solve i (True:b:bs) = (i:) <$> solve (i + 1) (not b:bs)
solve i (False:bs) = solve (i + 1) bs
solve i (True:_) = Nothing
solve i _ = Just []

main = do
  getLine
  row <- getLine
  let
    blocks = map ('B' ==) row
  case solve 1 blocks of
    Just ps -> do
      print $ length ps
      putStrLn $ unwords $ map show ps
    Nothing -> case solve 1 $ map not blocks of
      Just ps -> do
        print $ length ps
        putStrLn $ unwords $ map show ps
      Nothing -> print (-1)


Carol is currently curling.She has n disks each with radius r on the 2D plane. Initially she has all these disks above the line y = 10100.She then will slide the disks towards the line y = 0 one by one in order from 1 to n. When she slides the i-th disk, she will place its center at the point (xi, 10100). She will then push it so the disk’s y coordinate continuously decreases, and x coordinate stays constant. The disk stops once it touches the line y = 0 or it touches any previous disk. Note that once a disk stops moving, it will not move again, even if hit by another disk. Compute the y-coordinates of centers of all the disks after all disks have been pushed.

The first line will contain two integers n and r (1 ≤ n, r ≤ 1 000), the number of disks, and the radius of the disks, respectively. The next line will contain n integers x1, x2, ..., xn (1 ≤ xi ≤ 1 000) — the x-coordinates of the disks.

Print a single line with n numbers. The i-th number denotes the y-coordinate of the center of the i-th disk. The output will be accepted if it has absolute or relative error at most 10 - 6. Namely, let's assume that your answer for a particular value of a coordinate is a and the answer of the jury is b. The checker program will consider your answer correct if  for all coordinates.

NoteThe final positions of the disks will look as follows:  In particular, note the position of the last disk.

import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
main = B.interact exec
exec = B.pack . unwords . map show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve (r0:xs) = snd $ mapAccumL (\bs x -> let y = fromMaybe r $ collide r x bs in ((x, y):bs, y)) [] $ map fromIntegral xs
  where r = fromIntegral (r0 :: Int) :: Double

collide r x = maximumMay . map (\(x', y') -> let t = sqrt $ 4 * r * r - (x - x') * (x - x') in max (y' - t) (y' + t)) . filter (\(x', _) -> overlap (x - r, x + r) (x' - r, x' + r))

maximumMay [] = Nothing
maximumMay xs = Just $ maximum xs

overlap a b = go a b || go b a
  where go (x1, x2) (y1, y2) = x1 <== y2 && y1 <== x2

a <== b = a < b || abs (a - b) <= 1e-5

import System.IO
import Data.List (sort)

join s xs = foldr (\a b -> a++s++b) "" xs

iLn :: IO [Double]
iLn = getLine >>= (return . fmap (read) . words)

main = do
  [_,r] <- iLn
  xs <- iLn
  putStrLn $ join " " . fmap show . reverse $ solve r ( xs) []
--solve :: Double -> [Double] -> [(Double,Double)] -> [Double]
solve r [] ps = fmap fst ps
solve r (x:xs) a = solve r xs $ d r x
  (filter ((<=2*r).abs.(x-).snd) a) : a
d r x [] = (r,x)
d r x ps =
  foldr1 max.fmap (\(h,xx)->
                (h+(sqrt.abs$4*r*r-(x-xx)^2),x)
             )$ps

import           Data.List
import           Data.Bifunctor
import           Data.Function
-- import           Debug.Trace

circleStick :: Int -> Int -> Int -> Double
circleStick r x1 x2 =
  let dx = fromIntegral $ abs (x1 - x2)
  in sqrt $ (fromIntegral (2*r))^2 - dx^2

folder :: Int -> [(Int, Double)] -> Int -> [(Int, Double)]
folder r prevs new =
  let
    isCandidate a = 2 * r >= abs (a - new)
    candidates = filter (isCandidate . fst) prevs
  in if null candidates then (new, fromIntegral r):prevs
  else let height = maximum . map (uncurry (+) . first (circleStick r new) ) $ candidates
    in (new, height):prevs

main :: IO ()
main = do
  [n, r] <- map (read :: String -> Int) . words <$> getLine
  mapM_ (print . snd) =<< reverse. foldl' (folder r) [] . map (read :: String -> Int) . words <$> getLine
  return ()

import System.IO

merge xs [] = xs
merge [] xs = xs
merge xx@(x:xs) yy@(y:ys) =
  if (x<y)
  then x:(merge xs yy)
  else y:(merge xx ys)
msort xs = case xs of
  [] -> []
  [a] -> [a]
  _   -> uncurry merge $ (\(x, y)-> (msort x,msort y) ) $ splitAt ((length xs) `div` 2) xs
join s xs = foldr (\a b -> a++s++b) "" xs

main = do
  [_,r] <- getLine >>= (return . fmap (read) . words)
  xs <- getLine >>= (return . fmap (read) . words)
  putStrLn $ join " " . fmap show . reverse $ solve r ( xs) []

--solve :: Double -> [Double] -> [(Double,Double)] -> [Double]
solve r [] ps = fmap fst ps
solve r (x:xs) a = solve r xs $ dro r x a : a
dro r x ps = d r x $ filter ((<=2*r).abs.(x-).snd) ps
d r x [] = (r,x)
d r x ps = (\(h,xx)->
              (h+(sqrt.abs$4*r*r-(x-xx)^2),x)
              )
           $last.msort$ps


Piegirl got bored with binary, decimal and other integer based counting systems. Recently she discovered some interesting properties about number , in particular that q2 = q + 1, and she thinks it would make a good base for her new unique system. She called it "golden system". In golden system the number is a non-empty string containing 0's and 1's as digits. The decimal value of expression a0a1...an equals to .Soon Piegirl found out that this system doesn't have same properties that integer base systems do and some operations can not be performed on it. She wasn't able to come up with a fast way of comparing two numbers. She is asking for your help.Given two numbers written in golden system notation, determine which of them has larger decimal value.

Input consists of two lines — one for each number. Each line contains non-empty string consisting of '0' and '1' characters. The length of each string does not exceed 100000.

Print ">" if the first number is larger, "<" if it is smaller and "=" if they are equal.

NoteIn the first example first number equals to , while second number is approximately 1.6180339882 + 1.618033988 + 1 ≈ 5.236, which is clearly a bigger number.In the second example numbers are equal. Each of them is  ≈ 2.618.

import Control.Monad

main :: IO ()
main = do
    s1 <- getLine
    s2 <- getLine
    putStrLn $ case cmp s1 s2 of
        LT -> "<"
        EQ -> "="
        GT -> ">"

cmp :: String -> String -> Ordering
cmp a b = compare sa sb where
    na = length a
    nb = length b
    n = max na nb
    a' = take (n-na) (repeat '0') ++ a
    b' = take (n-nb) (repeat '0') ++ b
    sa = normalize a'
    sb = normalize b'

normalize :: String -> String
normalize ('1':'1':cs) = '1':normalize ('0':cs)
normalize ('1':cs) = case normalize cs of
    '0':'1':cs' -> '1':'0':'0':cs'
    '0':cs'     -> '0':'1':cs'
normalize ('0':cs)   = '0':normalize cs
normalize []  = "0"
{-
q = (1+ sqrt(5)) / 2
eval :: String -> Double
eval = foldl (\e ch -> e*q + if ch == '0' then 0 else 1) 0

prop_normalize = forAll gens $ \s -> 1 + length s == length (normalize s) && abs (eval s  - eval (normalize s))/ (eval s + 1) < 1.0e-9
prop = forAll gen $ \(a,b) -> cmp a b == naiveCmp a b
gens = sized $ \n -> do
    n <- choose (0,n)
    replicateM n (choose ('0','1'))

gen = liftM2 (,) gens gens

naiveCmp a b | otherwise = compare x y where
    x = eval a
    y = eval b

-}

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

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import           Data.Bool
import qualified Data.ByteString.Char8       as C
import           Data.Char
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as IM
import           Data.IORef
import           Data.List
import qualified Data.Map                    as M
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Tuple
import           Data.Word
import           Debug.Trace
import           System.IO
import           Text.Printf                 (printf)

-- I/O

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

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

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral
{-# INLINE cast #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep i j m = go i where
  go !i
    | i < j = m i >> go (i+1)
    | otherwise = return ()
{-# INLINE rep #-}

rrep :: Int -> Int -> (Int -> IO ()) -> IO ()
rrep i j m = go i where
  go !i
    | i > j = m (i-1) >> go (i-1)
    | otherwise = return ()
{-# INLINE rrep #-}

-----

main :: IO ()
main = do
  s <- getLine
  t <- getLine

  let d = cnv s
      e = cnv t

  if d == e
    then putStrLn "="
    else do
    if cmp d e
      then putStrLn "<"
      else putStrLn ">"

cmp (a, b) (c, d) =
  cast (a-c) * (sqrt 5 + 1) / 2 < cast (d-b)

cnv :: String -> (Integer, Integer)
cnv s = go 0 1 (reverse s) 0 0 where
  q = (sqrt 5+1)/2

  go !a !b (c:cs) !v !w  =
    go (a+b) (a) cs
      (v+(if c == '1' then a else 0))
      (w+(if c == '1' then b else 0))

  go _ _ _ v w = (v, w)

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

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import           Data.Bool
import qualified Data.ByteString.Char8       as C
import           Data.Char
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as IM
import           Data.IORef
import           Data.List
import qualified Data.Map                    as M
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Tuple
import           Data.Word
import           Debug.Trace
import           System.IO
import           Text.Printf                 (printf)

-- I/O

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

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

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral
{-# INLINE cast #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep i j m = go i where
  go !i
    | i < j = m i >> go (i+1)
    | otherwise = return ()
{-# INLINE rep #-}

rrep :: Int -> Int -> (Int -> IO ()) -> IO ()
rrep i j m = go i where
  go !i
    | i > j = m (i-1) >> go (i-1)
    | otherwise = return ()
{-# INLINE rrep #-}

-----

main :: IO ()
main = do
  s <- getLine
  t <- getLine

  let d = cnv s
      e = cnv t

  if abs (d-e) < 1e-10
    then putStrLn "="
    else do
    if d < e
      then putStrLn "<"
      else putStrLn ">"

cnv s = go 1 (reverse s) 0 where
  q = (sqrt 5+1)/2

  go !d (c:cs) !acc =
    go (d*q) cs $ acc+(if c == '1' then d else 0)

  go _ _ !acc = acc


This is yet another problem on regular bracket sequences.A bracket sequence is called regular, if by inserting "+" and "1" into it we get a correct mathematical expression. For example, sequences "(())()", "()" and "(()(()))" are regular, while ")(", "(()" and "(()))(" are not. You have a pattern of a bracket sequence that consists of characters "(", ")" and "?". You have to replace each character "?" with a bracket so, that you get a regular bracket sequence.For each character "?" the cost of its replacement with "(" and ")" is given. Among all the possible variants your should choose the cheapest.

The first line contains a non-empty pattern of even length, consisting of characters "(", ")" and "?". Its length doesn't exceed 5·104. Then there follow m lines, where m is the number of characters "?" in the pattern. Each line contains two integer numbers ai and bi (1 ≤ ai,  bi ≤ 106), where ai is the cost of replacing the i-th character "?" with an opening bracket, and bi — with a closing one.

Print the cost of the optimal regular bracket sequence in the first line, and the required sequence in the second. Print -1, if there is no answer. If the answer is not unique, print any of them.

-- import Debug.Trace
import qualified Data.Set as S
import Data.Int
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int64]] -> String -> [Int] -> S.Set (Int64,Int) -> Int64 -> Int -> Int
   ->  Maybe (Int64,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a d _ = guard (d == 0) >> Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show, Eq)

instance Ord Adjust where
  compare = comparing cost <> comparing position

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: !Int64,
    balance :: !Int,
    adjustedPositions :: ![Int],
    adjusts :: !(S.Set Adjust),
    costs :: ![Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: !Int64,
    closeCost :: !Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: !Int,
    cost :: !Int64
  } deriving (Show, Eq)

instance Ord Adjust where
  compare = comparing cost <> comparing position

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

import qualified Data.Set as Set
import Data.List
import Control.Arrow

data Cost = Cost Integer Integer deriving (Show, Eq, Ord)
impossible = Cost 1 0
instance Num Cost where
  Cost x1 y1 + Cost x2 y2 = Cost (x1 + x2) (y1 + y2)
  negate (Cost x1 y1) = Cost (negate x1) (negate y1)
  fromInteger x = Cost 0 x

zipp ('?' : t) (c : cs) = (ob, cb) : zipp t cs where
  [ob, cb] = map (fromInteger . read) $ words c
zipp ('(' : t) cs = (0, impossible) : zipp t cs
zipp (')' : t) cs = (impossible, 0) : zipp t cs
zipp [] _ = []

hoho (h : t) = [h] : gogo t where
  gogo (a:b:c) = [a, b] : gogo c
  gogo _ = []

swap (x, y) = (y, x)

go costs = (sum . map fst &&& mkString . sort . map snd) . snd . mapAccumL step Set.empty $ hoho (zip costs [0..]) where
  mkString = go 0 where
    len = length costs
    go i _ | i == len = []
    go i (j : js) | i == j = '(' : go (i + 1) js
    go i js = ')' : go (i + 1) js
  step m cis = swap . Set.deleteFindMin . Set.union m $ Set.fromList cis

solve (inp : costs) = case res of
  res | res < 0 -> error "too good to be true"
  Cost 0 x -> unlines $ [show x, best]
  _ -> "-1"
  where
  z = zipp inp costs
  (min, best) = go (map (uncurry (-)) z)
  res = sum (map snd z) + min

main=interact$solve.lines

import Data.Set hiding(map)
import Data.List(mapAccumL)
z('?':t)(c:d)=c:z t d
z('(':t)d=(0,9^13):z t d
z(')':t)d=(9^13,0):z t d
z[]_=[]
g(a:b:c)=[a,b]:g c
g _=[]
h(a:b)=[a]:g b
b q|q='('|1>0=')'
m l p=map(b.(`member`fromList p))[0..l-1]
w(x,y)=(y,x)
t[a,b]=(a,b)
p m=w.deleteFindMin.union m.fromList
solve(a:b)|r<9^12=unlines[show r,m(length a)i]|1>0="-1"where
 (x,y)=unzip.z a.map(t.map read.words)$b
 (c,i)=unzip.snd.mapAccumL p empty.h.(`zip`[0..])$zipWith(-)x y
 r=sum$y++c
main=interact$solve.lines

-- import Debug.Trace
import qualified Data.Set as S
import Data.Int
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int64]] -> String -> [Int] -> S.Set (Int64,Int) -> Int64 -> Int -> Int
   ->  Maybe (Int64,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a _ _ = Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

-- import Debug.Trace
import qualified Data.Set as S
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int]] -> String -> [Int] -> S.Set (Int,Int) -> Int -> Int -> Int
   ->  Maybe (Int,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a _ _ = Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap,(!))
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Foldable (sum)
import Data.Traversable (mapM)
import Control.Monad (guard)
import Prelude hiding (sum,mapM)

--import Debug.Trace
--tr x = traceShow x x
tr = id
traceShow = curry snd

main :: IO ()
main = do
  str <- getLine
  let seq = IM.fromList (zip [0..] str)
  unknown <- mapM (const readPair) (IM.filter (== '?') seq)
  let s = tr $ solve seq unknown
  case s of
    Nothing -> print (-1)
    Just s -> do
      let cost = sum $ IM.intersectionWith f s unknown
          f '(' (o,_) = o
          f ')' (_,c) = c
      print cost
      putStrLn $ IM.elems s

solve :: IntMap Char -> IntMap (Int,Int) -> Maybe (IntMap Char)
solve seq unknown = do
  let len = IM.size seq
      startOpen = IM.size (IM.filter (== '(') seq)
      startClose = IM.size (IM.filter (== ')') seq)
      target = len `div` 2
      needOpen = target - startOpen
      needClose = target - startClose
  guard (needOpen >= 0)
  guard (needClose >= 0)
  let first = IM.fromList $
              flip zip (replicate needOpen '(' ++ replicate needClose ')') $
              map fst $ sortBy (comparing firstCost) (IM.assocs unknown)
      firstCost (i,(co,cc)) = (co-cc,i)
  let closesLeft = S.empty
      opensRight = S.fromList $ map toOR $ IM.keys $ IM.filter (== '(') first
      toOR i = (c-o,-i) where (o,c) = unknown ! i
  let go cl or s i l
        | traceShow (IM.elems s,i,l,map snd (S.elems cl), map snd (S.elems or)) False = undefined
        | i == len = return s
        | l' >= 0 = go cl' or' s (i+1) l'
        | otherwise = exchange cl' or' s (i+1) l'
        where
          l' = l + if s ! i == '(' then 1 else -1
          (e,~(o,c)) = case IM.lookup i unknown of
                         Nothing -> ('?', undefined)
                         Just v -> (s ! i,v)
          cl' | e == ')' = S.insert (o-c,i) cl
              | otherwise = cl
          or' | e == '(' = S.delete (c-o,-i) or
              | otherwise = or
      exchange cl or s i lv = do
        ((_,l),cl') <- guard (not $ S.null cl) >> return (S.deleteFindMin cl)
        ((_,_r),or') <- guard (not $ S.null or) >> return (S.deleteFindMin or)
        traceShow (l,_r) $ go cl' or' (IM.insert l '(' $ IM.insert (-_r) ')' s) i (lv+2)
  go closesLeft opensRight (IM.union first seq) 0 0

readPair :: IO (Int,Int)
readPair = do
   [a,b] <- fmap words getLine
   return (read a,read b)

import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap,(!))
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Foldable (sum)
import Data.Traversable (mapM)
import Control.Monad (guard)
import Prelude hiding (sum,mapM)

-- import Debug.Trace
-- tr x = traceShow x x
tr = id

main :: IO ()
main = do
  str <- getLine
  let seq = IM.fromList (zip [0..] str)
  unknown <- mapM (const readPair) (IM.filter (== '?') seq)
  let s = tr $ solve seq unknown
  case s of
    Nothing -> print (-1)
    Just s -> do
      let cost = sum $ IM.intersectionWith f s unknown
          f '(' (o,_) = o
          f ')' (_,c) = c
      print cost
      putStrLn $ IM.elems s

solve :: IntMap Char -> IntMap (Int,Int) -> Maybe (IntMap Char)
solve seq unknown = do
  let len = IM.size seq
      startOpen = IM.size (IM.filter (== '(') seq)
      startClose = IM.size (IM.filter (== ')') seq)
      target = len `div` 2
      needOpen = target - startOpen
      needClose = target - startClose
  guard (needOpen >= 0)
  guard (needClose >= 0)
  let first = tr $ IM.fromList $
              flip zip (replicate needOpen '(' ++ replicate needClose ')') $
              map fst $ sortBy (comparing firstCost) (IM.assocs unknown)
      firstCost (i,(co,cc)) = (co-cc,i)
  let closesLeft = S.empty
      opensRight = S.fromList $ map toOR $ IM.keys $ IM.filter (== '(') first
      toOR i = (c-o,-i) where (o,c) = unknown ! i
  let go cl or s i l
        | i == len = return s
        | l' >= 0 = go cl' or' s (i+1) l'
        | otherwise = exchange cl' or' s (i+1) l'
        where
          l' = l + if s ! i == '(' then 1 else -1
          (e,~(o,c)) = case IM.lookup i unknown of
                         Nothing -> ('?', undefined)
                         Just v -> (s ! i,v)
          cl' | e == '(' = S.insert (o-c,i) cl
              | otherwise = cl
          or' | e == '(' = S.delete (c-o,-i) or
              | otherwise = or
      exchange cl or s i l = do
        ((_,l),cl') <- guard (not $ S.null cl) >> return (S.deleteFindMin cl)
        ((_,_r),or') <- guard (not $ S.null or) >> return (S.deleteFindMin or)
        go cl' or' (IM.insert l '(' $ IM.insert (-_r) ')' s) i (l+2)
  go closesLeft opensRight (IM.union first seq) 0 0

readPair :: IO (Int,Int)
readPair = do
   [a,b] <- fmap words getLine
   return (read a,read b)

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  -- let expr = "(??)"
  -- let costs = ["1 2", "3 6"]
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show)

instance Eq Adjust where
  Adjust _ c1 == Adjust _ c2 = c1 == c2

instance Ord Adjust where
  Adjust _ c1 <= Adjust _ c2 = c1 <= c2

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show)

instance Eq Adjust where
  Adjust _ c1 == Adjust _ c2 = c1 == c2

instance Ord Adjust where
  Adjust _ c1 <= Adjust _ c2 = c1 <= c2

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

import Data.Set hiding(map)
import Data.List(mapAccumL)
z('?':t)(c:d)=c:z t d
z('(':t)d=(0,9^13):z t d
z(')':t)d=(9^13,0):z t d
z[]_=[]
g(a:b:c)=[a,b]:g c
g _=[]
h(a:b)=[a]:g b
b q|q='('|1>0=')'
m l p=map(b.(`member`fromList p))[0..l-1]
w(x,y)=(y,x)
t[a,b]=(a,b)
p m=w.deleteFindMin.union m.fromList
solve(a:b)|r<9^12=unlines[show r,m(length b)i]|1>0="-1"where
 (x,y)=unzip.z a.map(t.map read.words)$b
 (c,i)=unzip.snd.mapAccumL p empty.h.(`zip`[0..])$zipWith(-)x y
 r=sum$y++c
main=interact$solve.lines

import qualified Data.Map as Map
import Data.List
import Control.Arrow

data Cost = Cost Integer Integer deriving (Show, Eq, Ord)
impossible = Cost 1 0
instance Num Cost where
  Cost x1 y1 + Cost x2 y2 = Cost (x1 + x2) (y1 + y2)
  negate (Cost x1 y1) = Cost (negate x1) (negate y1)
  fromInteger x = Cost 0 x

zipp ('?' : t) (c : cs) = (ob, cb) : zipp t cs where
  [ob, cb] = map (fromInteger . read) $ words c
zipp ('(' : t) cs = (0, impossible) : zipp t cs
zipp (')' : t) cs = (impossible, 0) : zipp t cs
zipp [] _ = []

hoho (h : t) = [h] : gogo t where
  gogo (a:b:c) = [a, b] : gogo c
  gogo _ = []

swap (x, y) = (y, x)

go costs = (sum . map fst &&& mkString . sort . map snd) . snd . mapAccumL step Map.empty $ hoho (zip costs [0..]) where
  mkString = go 0 where
    len = length costs
    go i js | i == len = []
    go i (j : js) | i == j = '(' : go (i + 1) js
    go i js = ')' : go (i + 1) js
  step m cis = swap (Map.deleteFindMin $ Map.union (Map.fromList cis) m)

solve (inp: costs) = case res of
  Cost 0 x -> unlines $ [show x, best]
  Cost i _ | i > 0 -> "-1"
    | otherwise -> error "too good to be true"
  where
  z = zipp inp costs
  (min, best) = go (map (uncurry (-)) z)
  res = sum (map snd z) + min

main=interact$solve.lines


The process of mammoth's genome decoding in Berland comes to its end!One of the few remaining tasks is to restore unrecognized nucleotides in a found chain s. Each nucleotide is coded with a capital letter of English alphabet: 'A', 'C', 'G' or 'T'. Unrecognized nucleotides are coded by a question mark '?'. Thus, s is a string consisting of letters 'A', 'C', 'G', 'T' and characters '?'.It is known that the number of nucleotides of each of the four types in the decoded genome of mammoth in Berland should be equal.Your task is to decode the genome and replace each unrecognized nucleotide with one of the four types so that the number of nucleotides of each of the four types becomes equal.

The first line contains the integer n (4 ≤ n ≤ 255) — the length of the genome. The second line contains the string s of length n — the coded genome. It consists of characters 'A', 'C', 'G', 'T' and '?'.

If it is possible to decode the genome, print it. If there are multiple answer, print any of them. If it is not possible, print three equals signs in a row: "===" (without quotes).

NoteIn the first example you can replace the first question mark with the letter 'A', the second question mark with the letter 'G', the third question mark with the letter 'T', then each nucleotide in the genome would be presented twice.In the second example the genome is already decoded correctly and each nucleotide is exactly once in it.In the third and the fourth examples it is impossible to decode the genom.

module Main where

f a c g t [] = (a,c,g,t)
f a c g t ('A':cs) =  f (a+1) c g t cs
f a c g t ('C':cs) =  f  a (c+1) g t cs
f a c g t ('G':cs) =  f a c (g+1) t cs
f a c g t ('T':cs) =  f a c g (t+1) cs
f a c g t (_:cs) =  f a c g t cs

h [] [] cs = reverse cs
h [] _ cs = "==="
h (a:as) [] cs = if a == '?' then "===" else h as [] (a:cs)
h (a:as) (b:bs) cs = if a == '?' then h as bs (b:cs) else h as (b:bs) (a:cs)

main = do
    n <- readLn :: IO Int
    s <- getLine
    if n `mod` 4 /= 0
        then putStrLn "==="
        else
            let (a,c,g,t) = f 0 0 0 0 s
                acgt = [a,c,g,t]
                m = maximum acgt
                acgt' = map (m - ) acgt
                r = n - 4*m
                acgt'' = if r `mod` 4 == 0 then map (+(r`div`4)) acgt' else [0,0,0,0]
                acgt''' = concat $ zipWith replicate acgt'' "ACGT"
            in putStrLn $ h s acgt''' []


You are given $$$n - 1$$$ integers $$$a_2, \dots, a_n$$$ and a tree with $$$n$$$ vertices rooted at vertex $$$1$$$. The leaves are all at the same distance $$$d$$$ from the root. Recall that a tree is a connected undirected graph without cycles. The distance between two vertices is the number of edges on the simple path between them. All non-root vertices with degree $$$1$$$ are leaves. If vertices $$$s$$$ and $$$f$$$ are connected by an edge and the distance of $$$f$$$ from the root is greater than the distance of $$$s$$$ from the root, then $$$f$$$ is called a child of $$$s$$$.Initially, there are a red coin and a blue coin on the vertex $$$1$$$. Let $$$r$$$ be the vertex where the red coin is and let $$$b$$$ be the vertex where the blue coin is. You should make $$$d$$$ moves. A move consists of three steps:   Move the red coin to any child of $$$r$$$.  Move the blue coin to any vertex $$$b'$$$ such that $$$dist(1, b') = dist(1, b) + 1$$$. Here $$$dist(x, y)$$$ indicates the length of the simple path between $$$x$$$ and $$$y$$$. Note that $$$b$$$ and $$$b'$$$ are not necessarily connected by an edge.  You can optionally swap the two coins (or skip this step). Note that $$$r$$$ and $$$b$$$ can be equal at any time, and there is no number written on the root.After each move, you gain $$$|a_r - a_b|$$$ points. What's the maximum number of points you can gain after $$$d$$$ moves?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \leq n \leq 2 \cdot 10^5$$$) — the number of vertices in the tree. The second line of each test case contains $$$n-1$$$ integers $$$v_2, v_3, \dots, v_n$$$ ($$$1 \leq v_i \leq n$$$, $$$v_i \neq i$$$)  — the $$$i$$$-th of them indicates that there is an edge between vertices $$$i$$$ and $$$v_i$$$. It is guaranteed, that these edges form a tree. The third line of each test case contains $$$n-1$$$ integers $$$a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the numbers written on the vertices. It is guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print a single integer: the maximum number of points you can gain after $$$d$$$ moves.

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Int

type SIO = StateT P.ByteString IO

type Graph = Array Int [Int]
treeDFS :: Graph -> Int -> [(Int, Int)]
treeDFS arr = let
  go par curr = foldr (.) ((curr, par) :)
    [go curr next | next <- arr ! curr, next /= par]
  in  \root -> go minBound root []

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    rawEdges <- readInts
    aLi <- readInts
    let
      edges = do
        (i, v) <- zip [2..n] rawEdges
        [(i, v), (v, i)]
      adj :: Graph
      adj = accumArray (flip (:)) [] (1, n) edges
      pars :: UArray Int Int
      pars = array (1, n) $ treeDFS adj 1
      depths :: Array Int Int
      depths = listArray (1, n) $ 0 : [1 + depths ! (pars ! i) | i <- [2..n]]
      maxDepth = maximum $ elems depths
      a :: UArray Int Int64
      a = listArray (2, n) $ map fromIntegral aLi
      layerMin :: UArray Int Int64
      layerMin = accumArray min maxBound (1, maxDepth)
        [(depths ! i, a ! i) | i <- [2..n]]
      layerMax :: UArray Int Int64
      layerMax = accumArray max minBound (1, maxDepth)
        [(depths ! i, a ! i) | i <- [2..n]]
      layerOccs :: Array Int [Int]
      layerOccs = accumArray (flip (:)) [] (1, maxDepth) [(depths ! i, i) | i <- [2..n]]
      cscore :: Array Int Int64
      cscore = listArray (1, n) $ map cscoreFun [1..n]
      cscoreFun :: Int -> Int64
      cscoreFun i = foldl' max 0 [score v | v <- adj ! i, v /= pars ! i]
      layerAugMin :: Array Int Int64
      layerAugMin = listArray (1, maxDepth) $ do
        j <- [1..maxDepth]
        pure $ foldl' min maxBound [a ! i - cscore ! i | i <- layerOccs ! j]
      layerAugMax :: Array Int Int64
      layerAugMax = listArray (1, maxDepth) $ do
        j <- [1..maxDepth]
        pure $ foldl' max minBound [a ! i + cscore ! i | i <- layerOccs ! j]
      score :: Int -> Int64
      score i = let
        layer = depths ! i
        o1 = layerMax ! layer - a ! i + cscore ! i
        o2 = a ! i - layerMin ! layer + cscore ! i
        o3 = layerAugMax ! layer - a ! i
        o4 = a ! i - layerAugMin ! layer
        in  maximum [o1, o2, o3, o4]
    {-
    lift $ print layerAugMax
    lift $ print [(i, score i) | i <- [2..n]]
    lift $ print a
    -}
    putInts [cscore ! 1]

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

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

putInts :: [Int64] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.int64Dec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad
import Data.Maybe
import Data.Array
import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.IntMap.Strict as IM
import qualified Data.IntSet as IS

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    let prepend xs x = x : xs
    edges <- accumArray prepend [] (1, n) . concat . map (\(i, v) -> [(i, v), (v, i)]) . zip [2..] <$> getInts
    values <- array (1, n) . ((1, 0):) . zip [2..] . map fromIntegral <$> getInts
    let
      dfs :: [(Int, [Int])] -> Int -> Int -> [(Int, [Int])]
      dfs adjs f u =
        foldl' (\as v -> dfs as u v) ((u, vs) : adjs) vs
        where vs = filter (/= f) $ edges ! u
      childs = accumArray (\_ vs -> vs) [] (1, n) $ dfs [] 0 1
      getChilds u = childs ! u
      getValue u = values ! u
      getMinMax :: [Int64] -> (Int64, Int64)
      getMinMax list = case list of
        [] -> error ""
        [x] -> (x, x)
        (x : xs) -> let (minValue, maxValue) = getMinMax xs in (min x minValue, max x maxValue)
      calc :: [Int] -> [(Int, Int64)]
      calc us
        | null us = error ""
        | null (childs ! head us) = map (\u -> (u, 0)) us
        | otherwise = func (noSwapOptimals, sort leftOptimals, sort rightOptimals)
        where
        vs = sort $ concat $ map getChilds us
        nexts = calc vs
        nextsMap = IM.fromAscList nexts
        (low, high) = getMinMax $ map getValue vs
        calcNoSwapOptimal v = let val = getValue v in max (val - low) (high - val) + nextsMap IM.! v
        noSwapOptimals = zip us $ map (\u -> maximum $ map calcNoSwapOptimal $ getChilds u) us
        parents = sort $ map (\u -> let (l, r) = getMinMax $ map getValue $ getChilds u in ((l + r) `quot` 2, l, r, u)) us
        children = sort $ map (\(v, opt) -> (getValue v, opt)) nexts
        accLeft _ [] _ = []
        accLeft maxPart allPs@((m, _, r, u) : ps) allCs
          | null allCs || m < val = (u, maxPart + r) : accLeft maxPart ps allCs
          | otherwise = accLeft (max maxPart (opt - val)) allPs cs
          where
          ((val, opt) : cs) = allCs
        leftOptimals = accLeft (-10^17) parents children
        accRight _ [] _ = []
        accRight maxPart allPs@((m, l, _, u) : ps) allCs
          | null allCs || m > val = (u, maxPart - l) : accRight maxPart ps allCs
          | otherwise = accRight (max maxPart (opt + val)) allPs cs
          where
          ((val, opt) : cs) = allCs
        rightOptimals = accRight (-10^17) (reverse parents) (reverse children)
        func ([], [], []) = []
        func ((i, x) : xs, (_, y) : ys, (_, z) : zs) = (i, max (max x y) z) : func (xs, ys, zs)
      result = snd $ head $ calc [1]
    C.putStrLn $ C.pack $ show result

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Int

type SIO = StateT P.ByteString IO

type Graph = Array Int [Int]
treeDFS :: Graph -> Int -> [(Int, Int)]
treeDFS arr = let
  go par curr = foldr (.) ((curr, par) :)
    [go curr next | next <- arr ! curr, next /= par]
  in  \root -> go minBound root []

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    rawEdges <- readInts
    aLi <- readInts
    let
      edges = do
        (i, v) <- zip [2..n] rawEdges
        [(i, v), (v, i)]
      adj :: Graph
      adj = accumArray (flip (:)) [] (1, n) edges
      pars :: UArray Int Int
      pars = array (1, n) $ treeDFS adj 1
      depths :: Array Int Int
      depths = listArray (1, n) $ 0 : [1 + depths ! (pars ! i) | i <- [2..n]]
      maxDepth = maximum $ elems depths
      a :: UArray Int Int64
      a = listArray (2, n) $ map fromIntegral aLi
      layerMin :: UArray Int Int64
      layerMin = accumArray min maxBound (1, maxDepth)
        [(depths ! i, a ! i) | i <- [2..n]]
      layerMax :: UArray Int Int64
      layerMax = accumArray max minBound (1, maxDepth)
        [(depths ! i, a ! i) | i <- [2..n]]
      layerOccs :: Array Int [Int]
      layerOccs = accumArray (flip (:)) [] (1, maxDepth) [(depths ! i, i) | i <- [2..n]]
      cscore :: Array Int Int64
      cscore = listArray (1, n) $ map cscoreFun [1..n]
      cscoreFun :: Int -> Int64
      cscoreFun i = foldl' max 0 [score v | v <- adj ! i, v /= pars ! i]
      layerAugMin :: Array Int Int64
      layerAugMin = listArray (1, n) $ do
        j <- [1..maxDepth]
        pure $ foldl' min maxBound [a ! i - cscore ! i | i <- layerOccs ! j]
      layerAugMax :: Array Int Int64
      layerAugMax = listArray (1, n) $ do
        j <- [1..maxDepth]
        pure $ foldl' max minBound [a ! i - cscore ! i | i <- layerOccs ! j]
      score :: Int -> Int64
      score i = let
        layer = depths ! i
        o1 = layerMax ! layer - a ! i + cscore ! i
        o2 = a ! i - layerMin ! layer + cscore ! i
        o3 = layerAugMax ! layer - a ! i
        o4 = a ! i - layerAugMin ! layer
        in  maximum [o1, o2, o3, o4]
    putInts [cscore ! 1]

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

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

putInts :: [Int64] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.int64Dec li)
  in  lift $ B.hPutBuilder stdout outBuilder


Some number of people (this number is even) have stood in a circle. The people stand in the circle evenly. They are numbered clockwise starting from a person with the number $$$1$$$. Each person is looking through the circle's center at the opposite person.    A sample of a circle of $$$6$$$ persons. The orange arrows indicate who is looking at whom. You don't know the exact number of people standing in the circle (but this number is even, no doubt). It is known that the person with the number $$$a$$$ is looking at the person with the number $$$b$$$ (and vice versa, of course). What is the number associated with a person being looked at by the person with the number $$$c$$$? If, for the specified $$$a$$$, $$$b$$$, and $$$c$$$, no such circle exists, output -1.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing three distinct integers $$$a$$$, $$$b$$$, $$$c$$$ ($$$1 \le a,b,c \le 10^8$$$).

For each test case output in a separate line a single integer $$$d$$$ — the number of the person being looked at by the person with the number $$$c$$$ in a circle such that the person with the number $$$a$$$ is looking at the person with the number $$$b$$$. If there are multiple solutions, print any of them. Output $$$-1$$$ if there's no circle meeting the given conditions.

NoteIn the first test case, there's a desired circle of $$$8$$$ people. The person with the number $$$6$$$ will look at the person with the number $$$2$$$ and the person with the number $$$8$$$ will look at the person with the number $$$4$$$.In the second test case, there's no circle meeting the conditions. If the person with the number $$$2$$$ is looking at the person with the number $$$3$$$, the circle consists of $$$2$$$ people because these persons are neighbors. But, in this case, they must have the numbers $$$1$$$ and $$$2$$$, but it doesn't meet the problem's conditions.In the third test case, the only circle with the persons with the numbers $$$2$$$ and $$$4$$$ looking at each other consists of $$$4$$$ people. Therefore, the person with the number $$$10$$$ doesn't occur in the circle.

opposite :: Int -> Int -> Int -> Int
opposite a b c =
  let full = 2 * abs (a - b) in
    if any (> full) [a, b, c] then
        -1
      else
        let r = c + full `div` 2 in
          if r <= full then r else r - full

loop :: Int -> IO()
loop 0 = return ()
loop n = do
    line <- getLine
    let [a, b, c] = map read (words line) :: [Int]
    print (opposite a b c)
    loop $ n - 1

main :: IO()
main = do
    input <- getLine
    let n = read input :: Int
    loop n

import Control.Monad

restoreThirdOppositeIndex :: Integer -> Integer -> Integer -> Integer
restoreThirdOppositeIndex a b c = result
    where result = if input_is_valid then potential_result else -1
          input_is_valid = maximum [a, b, c] < circle_size
          potential_result = (c - circle_half) `mod` circle_size
          circle_size = 2 * circle_half
          circle_half = abs (a - b)

process_test :: String -> String
process_test input = show result
    where [a, b, c] = map read (words input)
          raw_result = restoreThirdOppositeIndex (a-1) (b-1) (c-1)
          result = if raw_result >= 0 then raw_result + 1 else raw_result

main :: IO()
main = do
    tests_n_input <- getLine
    let tests_n = read tests_n_input
    tests_inputs <- replicateM tests_n getLine
    let outputs = map process_test tests_inputs
    mapM_ putStrLn outputs

--
-- 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 -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t (map read . words <$> getLine) :: IO [[Integer]]

    (putStr . unlines . map (show . solveC)) tcs

solveC [a,b,c] | (a < b)   = solve (a,b,c)
               | (a > b)   = solve (b,a,c)
               | otherwise = error "distinct a,b expected"
solveC _
    = error "three integers expected"

solve (a,b,c) | (a >= m)  = -1
              | (b <  m)  = -1
              | (a <  1)  = -1
              | (b >  x)  = -1
              | (c <  1)  = -1
              | (c >  x)  = -1
              | (c <  m)  = c + d
              | otherwise = c - d
  where
    d = abs (a - b)
    m = 1 + d
    x = 2 * d

import Control.Monad
import Data.List

-- 1 2  3 4 5 6
--        7 1 2 3 4 5 1

calc :: Int -> Int -> Int -> Int
calc a b c =
  let half = abs (a-b)
      count = 2 * half
  in
    if (count < a) || (count < b) || (count < c) then -1
    else (((c-1)+half) `mod` count)+1

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

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

main':: Int -> IO ()
main' _ = do
    [a, b, c] <- map read . words <$> getLine :: IO [Int]
    print $ solve a b c

solve :: Int -> Int -> Int -> Int
solve a b c
    | n < a || n < b || n < c  = -1
    | otherwise                = (c - 1 + half) `mod` n + 1
    where
        half = abs $ a - b
        n = 2 * half

module Main where

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

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

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

inpLines :: Int
inpLines = 1

solve :: InType -> OutType
solve (a, b, c) = if maximum [a,b,c] > n
                  then Nothing
                  else Just d
  where n  = 2 * abs (b - a)
        d' = c + n `div` 2
        d  = if d' > n
            then d' - n
            else d'

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

main :: IO ()
main = interact $
  unlines . map (showb . solve . receive) . chunksOf inpLines . tail . lines
    where showb Nothing  = "-1"
          showb (Just x) = show x

import Control.Monad

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

routine :: IO ()
routine = do
  [a,b,c] <- (map read.words) <$> getLine
  print $ solve a b c

solve :: Int -> Int -> Int -> Int
solve a b c
  | any (\x -> x>size*2) [a,b,c] = -1
  | otherwise= if c > size then c-size else c+size
  where
    size = abs (a-b)

module Main where

import           Control.Monad (replicateM_)

main = do
  t <- read <$> getLine
  replicateM_
    t
    (getLine >>= print . (\[a, b, c] -> solve a b c) . map read . words)

solve :: Int -> Int -> Int -> Int
solve a b c = if c <= 2 * hSize && (max a b <=2* hSize)
              then if c + hSize > 2 * hSize
                   then (c + hSize) `rem` (2 * hSize)
                   else c + hSize
              else -1
  where
    hSize = abs (b - a)
{-
>>>solve 6 2 4
8
>>>solve 2 5 4
1

1

-1

-1
-}

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

printResult = do
    [a,b,c] <- readInts
    let
        n = min a b
        m = max a b
        l = m - n
        r = if c > l then c - l else c + l
        d = if c > 2 * l then -1 else r
        e = if m > 2 * l then -1 else d
    print e

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

opposite :: Int -> Int -> Int -> Int
opposite a b c =
  let full = 2 * abs (a - b) in
    if any (> full) [a, b] then
        -1
      else
        let r = c + full `div` 2 in
          if r <= full then r else r - full

loop :: Int -> IO()
loop 0 = return ()
loop n = do
    line <- getLine
    let [a, b, c] = map read (words line) :: [Int]
    print (opposite a b c)
    loop $ n - 1

main :: IO()
main = do
    input <- getLine
    let n = read input :: Int
    loop n


Before the start of the football season in Berland a strange magic ritual is held. The most experienced magicians have to find a magic matrix of the size n × n (n is even number). Gods will never allow to start the championship without it. Matrix should contain integers from 0 to n - 1, main diagonal should contain only zeroes and matrix should be symmetric. Moreover, all numbers in each row should be different. Magicians are very tired of the thinking process, so they ask you to write a program to find such matrix.

The first line contains one integer n (2 ≤ n ≤ 1000), n is even.

Output n lines with n numbers each — the required matrix. Separate numbers with spaces. If there are several solutions, output any.

main = do
	line <- getLine
	putStrLn $ unlines $ [unwords [show $ gao n i j | j <- [0 .. n - 1]] | n <- [read line], i <- [0 .. n - 1]]
	where gao n i j
		| i > j			= gao n j i
		| i == j		= 0
		| i + j < n		= i + j
		| j == pred n	= if i + i < n then i + i else i + i + 1 - n
		| otherwise		= i + j + 1 - n

main = do
  n <- fmap read getLine
  putStrLn $ unlines $ [unwords [show $ gao n i j | j <- [0 .. n - 1]] | i <- [0 .. n - 1]]
  where
    gao n i j
      | i > j = gao n j i
      | i == j = 0
      | j == pred n = check i i n
      | otherwise = check i j n
    check x y n =
      let
	t = (x + y) `mod` (n - 1)
      in
	if t == 0 then n - 1 else t

line :: Int -> Int -> [Int]
line n x = [x..n - 1] ++ [0..x-1]

get :: Int -> Int -> [[Int]]
get n 1 = [line n 1]
get n x = line n x : get n (x - 1)

solve :: Int -> [String]
solve n =
  let
    a = get n n
  in
    map (unwords . (map show)) a

main = do
  n <- fmap read getLine
  let
    s = solve n
  mapM_ putStrLn s