Can the greatest common divisor and bitwise operations have anything in common? It is time to answer this question.Suppose you are given a positive integer $$$a$$$. You want to choose some integer $$$b$$$ from $$$1$$$ to $$$a - 1$$$ inclusive in such a way that the greatest common divisor (GCD) of integers $$$a \oplus b$$$ and $$$a \> \& \> b$$$ is as large as possible. In other words, you'd like to compute the following function:$$$$$$f(a) = \max_{0 < b < a}{gcd(a \oplus b, a \> \& \> b)}.$$$$$$Here $$$\oplus$$$ denotes the bitwise XOR operation, and $$$\&$$$ denotes the bitwise AND operation.The greatest common divisor of two integers $$$x$$$ and $$$y$$$ is the largest integer $$$g$$$ such that both $$$x$$$ and $$$y$$$ are divided by $$$g$$$ without remainder.You are given $$$q$$$ integers $$$a_1, a_2, \ldots, a_q$$$. For each of these integers compute the largest possible value of the greatest common divisor (when $$$b$$$ is chosen optimally).

The first line contains an integer $$$q$$$ ($$$1 \le q \le 10^3$$$) — the number of integers you need to compute the answer for. After that $$$q$$$ integers are given, one per line: $$$a_1, a_2, \ldots, a_q$$$ ($$$2 \le a_i \le 2^{25} - 1$$$) — the integers you need to compute the answer for.

For each integer, print the answer in the same order as the integers are given in input.

NoteFor the first integer the optimal choice is $$$b = 1$$$, then $$$a \oplus b = 3$$$, $$$a \> \& \> b = 0$$$, and the greatest common divisor of $$$3$$$ and $$$0$$$ is $$$3$$$.For the second integer one optimal choice is $$$b = 2$$$, then $$$a \oplus b = 1$$$, $$$a \> \& \> b = 2$$$, and the greatest common divisor of $$$1$$$ and $$$2$$$ is $$$1$$$.For the third integer the optimal choice is $$$b = 2$$$, then $$$a \oplus b = 7$$$, $$$a \> \& \> b = 0$$$, and the greatest common divisor of $$$7$$$ and $$$0$$$ is $$$7$$$.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  q <- read <$> getLine
  as <- take q . unfoldr (runStateT $ rInt) <$> BSL.getContents
  mapM_ (print . query) $ map toI32 as

query :: Int32 -> Int32
query x
  | x /= bitFill = bitFill
  | otherwise    = maybe 1 (div bitFill)
                   $ find ((==0). (bitFill `mod`))
                   [2..ceilI32 $ sqrt $ toDouble bitFill]
  where
    bitFill = (+(-1)) $ bit $ finiteBitSize x - clz x :: Int32

clz :: Int32 -> Int
clz x
   |x == 0 = 32
   |x /= 0 = 31 - ret
  where
    (!v,ret) = foldl' loop (x,0) $ map bit $ [4,3..0]
    loop (!x,!acc) b | x1 /= 0   = (x1,acc .|. b)
                     | otherwise = (x,acc)
      where
        x1 = shiftR x b

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

import Text.Printf
import Control.Monad
import Data.Bits

glwr :: Read a => IO [a]
glwr = fmap (map read . words) getLine

main :: IO ()
main = do
  n <- readLn
  mapM_ process [1..n :: Int]

process _ = do
  n <- readLn
  putStrLn . show $ op n

op :: Int -> Int
op n
  | n == p2*2 - 1 = lDiv
  | True = p2*2 - 1
  where
    p2 = last p2s
    (p2s, _) = break (> n) pow2
    lDiv = div n $ sDiv n

sDiv :: Int -> Int
sDiv n = head $ filter valid [2..sqrtN] ++ [n]
  where
    sqrtN = floor $ sqrt $ toEnum n
    valid x = rem n x == 0

pow2 :: [Int]
pow2 = map (2^) [1..]

import Data.Bits
import Data.List
main = interact $ unlines . map show . map process . tail . map read . words

process :: Int -> Int
process x
    | x /= pw x = pw x
    | elem x primes = 1
    | otherwise = case (find (\z -> mod x z == 0) primes) of
        Just z -> div x z
        Nothing -> 1

pw x = foldl (\v z -> v .|. shiftR v (2^z)) x [0..4]
sieve (n:ns) = n:sieve [ m | m <- ns, m `mod` n /= 0 ]
primes = 2 : (takeWhile (< 2^14) $ sieve [3,5..])

import Text.Printf
import Control.Monad
import Data.Bits

glwr :: Read a => IO [a]
glwr = fmap (map read . words) getLine

main :: IO ()
main = do
  n <- readLn
  mapM_ process [1..n :: Int]

process _ = do
  n <- readLn
  putStrLn . show $ op n

op :: Int -> Int
op n
  | n == p2*2 - 1 = 1
  | True = p2*2 - 1
  where
    p2 = last p2s
    (p2s, _) = break (> n) pow2

pow2 :: [Int]
pow2 = map (2^) [1..]


You are given a graph consisting of $$$n$$$ vertices and $$$m$$$ edges. It is not guaranteed that the given graph is connected. Some edges are already directed and you can't change their direction. Other edges are undirected and you have to choose some direction for all these edges.You have to direct undirected edges in such a way that the resulting graph is directed and acyclic (i.e. the graph with all edges directed and having no directed cycles). Note that you have to direct all undirected edges.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 2 \cdot 10^5$$$, $$$1 \le m \le min(2 \cdot 10^5, \frac{n(n-1)}{2})$$$) — the number of vertices and the number of edges in the graph, respectively. The next $$$m$$$ lines describe edges of the graph. The $$$i$$$-th edge is described with three integers $$$t_i$$$, $$$x_i$$$ and $$$y_i$$$ ($$$t_i \in [0; 1]$$$, $$$1 \le x_i, y_i \le n$$$) — the type of the edge ($$$t_i = 0$$$ if the edge is undirected and $$$t_i = 1$$$ if the edge is directed) and vertices this edge connects (the undirected edge connects vertices $$$x_i$$$ and $$$y_i$$$ and directed edge is going from the vertex $$$x_i$$$ to the vertex $$$y_i$$$). It is guaranteed that the graph do not contain self-loops (i.e. edges from the vertex to itself) and multiple edges (i.e. for each pair ($$$x_i, y_i$$$) there are no other pairs ($$$x_i, y_i$$$) or ($$$y_i, x_i$$$)). It is guaranteed that both sum $$$n$$$ and sum $$$m$$$ do not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$; $$$\sum m \le 2 \cdot 10^5$$$).

For each test case print the answer — "NO" if it is impossible to direct undirected edges in such a way that the resulting graph is directed and acyclic, otherwise print "YES" on the first line and $$$m$$$ lines describing edges of the resulted directed acyclic graph (in any order). Note that you cannot change the direction of the already directed edges. If there are several answers, you can print any.

NoteExplanation of the second test case of the example:Explanation of the third test case of the example:

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, edgeList)

solve (n, graph, edgeList) = forM edgeList $ \[a, b, c] ->
  if a == 0
    then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
    else (if arr ! b < arr ! c then Just (b, c) else Nothing)
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, map (\[a, b, c] -> (a, b, c)) edgeList)

solve (n, graph, edgeList) =
  forM edgeList $
    ( \(a, b, c) ->
        if a == 0
          then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
          else (if arr ! b < arr ! c then Just (b, c) else Nothing)
    )
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.List
import qualified Data.Sequence as S

buildG n el = arr
  where
    arr = foldl (\a (b, c) -> S.adjust (c :) b a) (S.replicate (n + 1) []) el

go :: S.Seq [Int] -> S.Seq Int -> S.Seq Int -> [Int]
go graph ind queue = case S.viewl queue of
  S.EmptyL -> []
  x S.:< rest -> x : (go graph ind' queue')
    where
      ind' = foldl (\ind'' x -> S.adjust (\a -> a - 1) x ind'') ind (graph `S.index` x)
      queue' = rest S.>< S.fromList (filter (\x -> (ind' `S.index` x) == 0) (graph `S.index` x))

topSort n graph = if length res == n then Just res else Nothing
  where
    res = go graph ind queue
    ind = foldl (\ind' x -> foldl (\ind'' y -> S.adjust (+ 1) y ind'') ind' x) (S.replicate (n + 1) 0) graph
    queue = S.fromList $ filter (\x -> (ind `S.index` x) == 0) [1 .. n]

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort n graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, map (\[a, b, c] -> (a, b, c)) edgeList)

solve (n, graph, edgeList) =
  forM edgeList $ \(a, b, c) ->
    if a == 0
      then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
      else (if arr ! b < arr ! c then Just (b, c) else Nothing)
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  let f = \l i -> do
        a <- S.readArray ind i
        S.writeArray ind i (a - 1)
        if a == 1 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\(a : b) -> b) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

uniq :: Eq a => [a] -> [a]
uniq [] = []
uniq [x] = [x]
uniq (a : b : xs) = if a == b then uniq (b : xs) else a : uniq (b : xs)

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  forM_ [1 .. n] $ \i -> do
    x <- S.readArray res i
    S.writeArray res i $ uniq $ sort x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  forM_ (graph ! x) $ \i -> do
    a <- S.readArray ind i
    S.writeArray ind i (a - 1)
  let f = \l i -> do
        a <- S.readArray ind i
        if a == 0 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> [b, c]) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  forM_ (graph ! x) $ \i -> do
    a <- S.readArray ind i
    S.writeArray ind i (a - 1)
  let f = \l i -> do
        a <- S.readArray ind i
        if a == 0 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\(a : b) -> b) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"


Vasya has a grid with $$$2$$$ rows and $$$n$$$ columns. He colours each cell red, green, or blue.Vasya is colourblind and can't distinguish green from blue. Determine if Vasya will consider the two rows of the grid to be coloured the same.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the number of columns of the grid. The following two lines each contain a string consisting of $$$n$$$ characters, each of which is either R, G, or B, representing a red, green, or blue cell, respectively — the description of the grid.

For each test case, output "YES" if Vasya considers the grid's two rows to be identical, and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

6

2

RG

RB

4

GRBG

GBGB

5

GGGGG

BBBBB

7

BBBBBBB

RRRRRRR

8

RGBRRGBR

RGGRRBGR

1

G

G

NoteIn the first test case, Vasya sees the second cell of each row as the same because the second cell of the first row is green and the second cell of the second row is blue, so he can't distinguish these two cells. The rest of the rows are equal in colour. Therefore, Vasya will say that the two rows are coloured the same, even though they aren't.In the second test case, Vasya can see that the two rows are different.In the third test case, every cell is green or blue, so Vasya will think they are the same.

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>
        getLine >>= \s1 -> getLine >>=
        putStrLn . ite "Yes" "No" . isSame s1
ite x y b = if b then x else y
isSame s1 s2 = all (uncurry f) (zip s1 s2)
  where f 'R' 'R' = True
        f 'R' _ = False
        f _ 'R' = False
        f _ _ = True

{-#LANGUAGE ScopedTypeVariables#-}
import Data.Char (isDigit)
import Data.Text (replace)

main = do
    input <- getContents
    let parsed = removeDigits (drop 1 (lines input))
    let result = iteratePairs (map replaceDigits parsed)
    mapM_ putStrLn result

removeDigits :: [String] -> [String]
removeDigits [] = []
removeDigits (x:xs)
    | all isDigit x = removeDigits xs
    | otherwise     = [x] ++ removeDigits xs

replaceDigits :: String -> String
replaceDigits [] = []
replaceDigits (x:xs)
    | x == 'G'  = ['B'] ++ replaceDigits xs
    | otherwise = [x] ++ replaceDigits xs

iteratePairs :: [String] -> [String]
iteratePairs [] = []
iteratePairs (one:two:rest) = [(checkPairs one two)] ++ iteratePairs rest

checkPairs :: String -> String -> String
checkPairs [] [] = "YES"
checkPairs (x:xs) (y:ys)
    | x /= y    = "NO"
    | otherwise = checkPairs xs ys

toOneForm [] = []
toOneForm (x:xs) = if x == 'G'
                   then ('B':) $ (toOneForm xs)
                   else (x:) $ toOneForm xs

decide :: Int -> IO ()
decide 0 = return ()
decide n = do
    getLine
    s1 <- getLine
    s2 <- getLine
    if toOneForm s1 == toOneForm s2
    then putStrLn "YES"
    else putStrLn "NO"
    decide (n - 1)

main :: IO ()
main = do
    t <- getLine >>= (return . (read :: String -> Int))
    decide t

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

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

solve :: String -> String -> String
solve s1 s2
    | answer = "YES"
    | otherwise = "NO"
    where answer = and $ zipWith check s1 s2

check c1 c2
    | c1 == c2 = True
    | c1 == 'G' = c2 == 'B'
    | c1 == 'B' = c2 == 'G'
    | otherwise = False

work = do
    t <- getLine
    s1 <- getLine
    s2 <- getLine

    putStrLn $ solve s1 s2

main = do
    t <- getLine

    replicateM_ (read t :: Int) work

module Main
      ( main )
      where

import Control.Monad (replicateM)

data Color
  = Red
  | Green
  | Blue
  deriving Show

mkColor :: Char -> Maybe Color
mkColor c = case c of
              'R' -> Just Red
              'G' -> Just Green
              'B' -> Just Blue
              _   -> Nothing

lookDistinct :: Color -> Color -> Bool
lookDistinct a b =
  case (a, b) of
    (Red, Red) -> False
    (Red, _)   -> True
    (_, Red)   -> True
    (_,   _)   -> False

readColors :: IO (Maybe [Color])
readColors = do
  l <- getLine
  return (sequence $ map mkColor l)

rowsLookNondistinct :: [Color] -> [Color] -> Bool
rowsLookNondistinct xs ys = all (not . (uncurry lookDistinct)) pairs
  where pairs = zip xs ys

putNondistinct :: [Color] -> [Color] -> IO ()
putNondistinct xs ys = case rowsLookNondistinct xs ys of
                         True  -> putStrLn "YES"
                         False -> putStrLn "NO"

main :: IO ()
main = do
  tests <- readLn
  replicateM tests $ do
    -- unused length of lists
    _ <- getLine
    firstRow <- readColors
    secondRow <- readColors
    case (firstRow, secondRow) of
      (Just xs, Just ys) -> putNondistinct xs ys
      _                -> putStrLn "Invalid Input!"
  return ()

import Control.Monad (forM_)
import Data.List
import Debug.Trace (trace)

readInts = getLine >>= pure . map read . words

same (a:as) (b:bs) = (elem a "GB" == elem b "GB") && same as bs
same [] [] = True

main = do
    [n'] <- readInts
    forM_ [1..n'] (\_ -> do
        getLine
        a <- getLine
        b <- getLine
        putStrLn $ if same a b then "YES" else "NO"
        )

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- getNext
  b <- getNext
  let
    good x y = (x == 'R' && y == 'R') || (x /= 'R' && y /= 'R')
    res = foldl' (\b (x, y) -> (&&) b (good x y)) True (zip (P.unpack a) (P.unpack b))
  pure . str $ if res then "YES\n" else "NO\n"


Merge sort is a well-known sorting algorithm. The main function that sorts the elements of array a with indices from [l, r) can be implemented as follows:  If the segment [l, r) is already sorted in non-descending order (that is, for any i such that l ≤ i < r - 1 a[i] ≤ a[i + 1]), then end the function call;  Let ;  Call mergesort(a, l, mid);  Call mergesort(a, mid, r);  Merge segments [l, mid) and [mid, r), making the segment [l, r) sorted in non-descending order. The merge algorithm doesn't call any other functions. The array in this problem is 0-indexed, so to sort the whole array, you need to call mergesort(a, 0, n).The number of calls of function mergesort is very important, so Ivan has decided to calculate it while sorting the array. For example, if a = {1, 2, 3, 4}, then there will be 1 call of mergesort — mergesort(0, 4), which will check that the array is sorted and then end. If a = {2, 1, 3}, then the number of calls is 3: first of all, you call mergesort(0, 3), which then sets mid = 1 and calls mergesort(0, 1) and mergesort(1, 3), which do not perform any recursive calls because segments (0, 1) and (1, 3) are sorted.Ivan has implemented the program that counts the number of mergesort calls, but now he needs to test it. To do this, he needs to find an array a such that a is a permutation of size n (that is, the number of elements in a is n, and every integer number from [1, n] can be found in this array), and the number of mergesort calls when sorting the array is exactly k.Help Ivan to find an array he wants!

The first line contains two numbers n and k (1 ≤ n ≤ 100000, 1 ≤ k ≤ 200000) — the size of a desired permutation and the number of mergesort calls required to sort it.

If a permutation of size n such that there will be exactly k calls of mergesort while sorting it doesn't exist, output  - 1. Otherwise output n integer numbers a[0], a[1], ..., a[n - 1] — the elements of a permutation that would meet the required conditions. If there are multiple answers, print any of them.

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T
import Control.Monad.State

-- import Debug.Trace

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) + (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (x1:x2:xs) = (x1 <= x2) && (isSorted (x2:xs))

verify :: [Int] -> State Int ()
verify [x] = get >>= put . (+ 1)
verify xs = do
  count <- get
  put $ count + 1
  case isSorted xs of
    True -> return ()
    False -> do
      let m = (div (length xs) 2)
      let xl = take m xs
      let xr = drop m xs
      verify xl
      verify xr

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

main = putStr . maybe "-1" (unwords . map show) . (\[a, b] -> solve a b) . map read . words =<< getLine

solve n k = case gen (k - 1 :: Int) 0 n 1 of
  (0, xs) -> Just $ xs []
  _ -> Nothing

gen k l r lo
  | k <= 0 || d <= 1 = (k, (take d [lo..] ++))
  | otherwise = (k2, xs . ys)
  where
  d = r - l
  m = (r + l) `quot` 2
  (k1, xs) = gen (k - 2) l m (lo + r - m)
  (k2, ys) = gen k1      m r lo

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k < 0          = Nothing
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) - (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) + (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) - (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""


William really likes the cellular automaton called "Game of Life" so he decided to make his own version. For simplicity, William decided to define his cellular automaton on an array containing $$$n$$$ cells, with each cell either being alive or dead.Evolution of the array in William's cellular automaton occurs iteratively in the following way:  If the element is dead and it has exactly $$$1$$$ alive neighbor in the current state of the array, then on the next iteration it will become alive. For an element at index $$$i$$$ the neighbors would be elements with indices $$$i - 1$$$ and $$$i + 1$$$. If there is no element at that index, it is considered to be a dead neighbor.  William is a humane person so all alive elements stay alive. Check the note section for examples of the evolution.You are given some initial state of all elements and you need to help William find the state of the array after $$$m$$$ iterations of evolution.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 10^3, 1 \le m \le 10^9$$$), which are the total number of cells in the array and the number of iterations. The second line of each test case contains a string of length $$$n$$$ made up of characters "0" and "1" and defines the initial state of the array. "1" means a cell is alive and "0" means it is dead. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^4$$$.

In each test case output a string of length $$$n$$$, made up of characters "0" and "1"  — the state of the array after $$$m$$$ iterations of evolution.

NoteSequence of iterations of evolution for the first test case   01000000001  — initial state  11100000011  — first iteration of evolution  11110000111  — second iteration of evolution  11111001111  — third iteration of evolution Sequence of iterations of evolution for the second test case   0110100101  — initial state  1110111101  — first iteration of evolution  1110111101  — second iteration of evolution

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m] <- getInts
    as <- take n . C.unpack <$> C.getLine
    let result = func False (map (\s -> (head s, length s)) $ group as)
        f c
          | 2 * m <= c = replicate m '1' ++ replicate (c - 2 * m) '0' ++ replicate m '1'
          | odd c = replicate (c `div` 2) '1' ++ ['0'] ++ replicate (c `div` 2) '1'
          | otherwise = replicate c '1'
        func _ [] = []
        func True (('0', c) : []) = replicate (min c m) '1' ++ replicate (c - min c m) '0'
        func True (('0', c) : xs) = f c ++ func False xs
        func False (('0', c) : []) = replicate c '0'
        func False (('0', c) : xs) = replicate (c - min c m) '0' ++ replicate (min c m) '1' ++ func False xs
        func _ (('1', c) : xs) = replicate c '1' ++ func True xs
    return $ string7 result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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

qs :: String -> [Int]
qs = let
  step v '0' = v + if  v >= 0  then  1  else  0
  step _ '1' = 0
  step _ _ = error "bad input"
  in  tail . scanl step (0-1)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, m] <- readInts
    s <- P.unpack <$> readLine
    let
      q1 = qs s
      q2 = reverse $ qs $ reverse s
      ok x = 0 <= x && x <= m
      ans = do
        (x, y) <- zip q1 q2
        pure $ if  (ok x || ok y) && (x /= y || x == 0)
          then  '1'
          else  '0'
    lift $ putStrLn ans

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


Peter decided to wish happy birthday to his friend from Australia and send him a card. To make his present more mysterious, he decided to make a chain. Chain here is such a sequence of envelopes A = {a1,  a2,  ...,  an}, where the width and the height of the i-th envelope is strictly higher than the width and the height of the (i  -  1)-th envelope respectively. Chain size is the number of envelopes in the chain. Peter wants to make the chain of the maximum size from the envelopes he has, the chain should be such, that he'll be able to put a card into it. The card fits into the chain if its width and height is lower than the width and the height of the smallest envelope in the chain respectively. It's forbidden to turn the card and the envelopes. Peter has very many envelopes and very little time, this hard task is entrusted to you.

The first line contains integers n, w, h (1  ≤ n ≤ 5000, 1 ≤ w,  h  ≤ 106) — amount of envelopes Peter has, the card width and height respectively. Then there follow n lines, each of them contains two integer numbers wi and hi — width and height of the i-th envelope (1 ≤ wi,  hi ≤ 106).

In the first line print the maximum chain size. In the second line print the numbers of the envelopes (separated by space), forming the required chain, starting with the number of the smallest envelope. Remember, please, that the card should fit into the smallest envelope. If the chain of maximum size is not unique, print any of the answers. If the card does not fit into any of the envelopes, print number 0 in the single line.

import Data.List
import Data.Array.Unboxed
import Data.Function (on)
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.ST as ST
import qualified Data.Array.Unboxed as U
import Data.STRef

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))

    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat 2147483647) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd . foldr folder (maxl, []) $ ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

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

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array.Unboxed
import Data.Function (on)
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.ST as ST
import qualified Data.Array.Unboxed as U
import Data.STRef

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))

    {-
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat 2147483647) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2
    -}

    mainSALF envs = runST $ do
      arr <- ST.thaw (U.listArray (0, n) (repeat 2147483647) :: U.UArray Int Int) :: ST st (ST.STUArray st Int Int)

      let bs v ans l r
            | l > r = return ans
            | otherwise = do
              let m = (l + r) `div` 2
              mVal <- ST.readArray arr m
              if mVal >= v then bs v m l (m-1) else bs v ans (m+1) r

      maxl <- newSTRef (0 :: Int)
      ls <- forM envs $ \(_, h, i) -> do
             maxl' <- readSTRef maxl
             idx <- bs h 1 1 (maxl' + 1)
             ST.writeArray arr idx h
             modifySTRef maxl (max idx)
             return (idx, i)

      maxl' <- readSTRef maxl
      return ((0, maxl'), ls)

    printShit ((_, maxl), ls) = snd . foldr folder (maxl, []) $ ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array.Unboxed
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w > w0 && h > h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf) :: UArray Int Int, 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd . foldl' folder (maxl, []) $ reverse ls
      where folder (curl, acc) (lvl, i) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
import Data.Array
import Control.Monad
import List
data State s a = State {runState :: s->(a,s)}
instance Monad (State s) where
	return = State . (,)
	(State f1) >>= f2 = State $ uncurry (runState . f2) . f1
	(State f1) >> (State f2) = State $ f2 .snd . f1

repeatM a = mapM (const a) (repeat 1)
repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)
readchar = State (\s->(head s,tail s))
readall = State (,"")

runRead x s = fst $ runState x s

solve::[Int]->[Int]->[Int]->[(Int,(Int,Int),[Int])]->[Int]
solve [] _ _ ps = tail chain where (_,_,chain) = head  ps
solve (w:ws) (h:hs) (n:ns) ps = solve  ws hs ns $ (x+1,(w,h),n:chain):ps where
	(x,_,chain) = maximum $ (0,0,[]):[(y,head c,c) | (y,(w',h'),c) <- ps, w'>w && h'>h]

main = reader >>= writer .  solver
reader = getContents
writer = putStr
solver = runRead $ do
	n <- readm
	w <- readm
	h <- readm
	sizes <- mapM (\i-> (liftM3 (,,) readm readm (return i))) [1..n]
	let (ws,hs,ns)::([Int],[Int],[Int]) = unzip3 . sort $ sizes
	let solution = solve (reverse $ w:ws) (reverse $ h:hs) (reverse $ 0:ns) []
	return (show (length solution) ++ "\n" ++ (unwords . map show $ solution))
	--return (unlines . map unwords $ map (map show) [ws,hs,ns])

module Main where

import Control.Monad

pickBestChain chain =
    foldr (\(j, _, _, curr, currChain) (best, bestChain) ->
            if curr > best
                then (curr, currChain)
                else (best, bestChain)
        ) (0, []) chain

main = do
    [n, w0, h0] <- ( map read . words ) `liftM` getLine :: IO [Int]

    envs <- liftM (filter (\(_, w, h) -> w > w0 && h > h0)) $ forM [1..n] $ \i -> do
        [w, h] <- (map read . words ) `liftM` getLine
        return (i, w, h)

    --putStrLn $ show envs

    let chain = map (\(i, w, h) ->
                let (best, bestChain) = pickBestChain $ filter (\(_, w1, h1, _, _) -> w < w1 && h < h1) chain
                in (i, w, h, best+1, i:bestChain)
            ) envs
        (best, bestChain) = pickBestChain chain

    --putStrLn $ show chain
    putStrLn $ show best
    putStrLn $ unwords $ map show bestChain

module Main where

import Data.List (sortOn, foldl', maximumBy)
import Data.Ord (comparing)
import Data.Int (Int64)

main :: IO ()
main = interact $ solve . tail . words

solve :: [String] -> String
solve inputs = showSolution $ bestSolution solutions
  where
    postcard:envelopes = toEnvelopes 0 inputs
    sortedEnvelopes = sortOn square $ filter (`contain` postcard) envelopes
    solutions = foldl' solve0 [Solution 0 postcard []] sortedEnvelopes
    showSolution s = unlines [ show $ len s, unwords . map show . reverse . path $ s]

bestSolution :: [Solution] -> Solution
bestSolution = maximumBy (comparing len)

solve0 :: [Solution] -> Enverlope -> [Solution]
solve0 solutions envelop = case filter (contain envelop . env) solutions of
  [] -> solutions
  ss -> let Solution l _ p = bestSolution ss in Solution (l + 1) envelop (ei envelop:p):solutions

contain :: Enverlope -> Enverlope -> Bool
contain (Enverlope w1 h1 _) (Enverlope w2 h2 _) = w2 < w1 && h2 < h1

square :: Enverlope -> Int64
square (Enverlope w h _) = w * h

toEnvelopes :: Int -> [String] -> [Enverlope]
toEnvelopes _ [] = []
toEnvelopes i (w:h:rest) = Enverlope (read w) (read h) i : toEnvelopes (i + 1) rest

data Solution = Solution {
  len :: !Int,
  env :: Enverlope,
  path :: [Int]
} deriving (Show)

data Enverlope = Enverlope {
    ew :: !Int64,
    eh :: !Int64,
    ei :: !Int
  } deriving (Show, Eq, Ord)

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

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w >= w0 && h >= h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat $ 10 ^ 9), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m > h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

import Data.List
import Data.Array hiding (indices)
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, h0, w0] : xs) =
  indices . foldl' folder initArr . majiqSort . bigEnough . pairIndex $ xs
  where
    pairIndex = zipWith (\i [h, w] -> (h, w, i)) [1..]
    bigEnough = filter (\(h, w, _) -> h > h0 && w > w0)
    majiqSort = sortBy (compare `on` (\(h, w, _) -> (h, -w)))
    indices = reverse . takeWhile (/= -1) . map snd . elems

    initArr = listArray (1, n) (repeat (10 ^ 8, -1)) :: Array Int (Int, Int)
    folder arr (_, w, i) = arr // [(bSearch 1 1 n, (w, i))]
      where bSearch ans l r
              | l > r = ans
              | fst (arr ! m) >= w = bSearch m l (m - 1)
              | otherwise = bSearch ans (m + 1) r
              where m = (l + r) `div` 2

main :: IO ()
main = do
  input <- getContents
  let ans = solve . map (map read . words) . lines $ input
  print $ length ans
  putStrLn $ unwords (map show ans)

import Data.List
import Data.Array hiding (indices)
import Data.Function (on)

solve :: [[Int]] -> [Int]
solve ([n, h0, w0] : xs) =
  indices . foldl' folder initArr . majiqSort . bigEnough . pairIndex $ xs
  where
    pairIndex = zipWith (\i [h, w] -> (h, w, i)) [1..]
    bigEnough = filter (\(h, w, _) -> h > h0 && w > w0)
    majiqSort = sortBy (compare `on` (\(h, w, _) -> (h, -w)))
    indices = takeWhile (/= -1) . map snd . elems

    initArr = listArray (1, n) (repeat (10 ^ 8, -1)) :: Array Int (Int, Int)
    folder arr (_, w, i) = arr // [(bSearch 1 1 n, (w, i))]
      where bSearch ans l r
              | l > r = ans
              | fst (arr ! m) >= w = bSearch m l (m - 1)
              | otherwise = bSearch ans (m + 1) r
              where m = (l + r) `div` 2

main :: IO ()
main = do
  input <- getContents
  let ans = solve . map (map read . words) . lines $ input
  print $ length ans
  putStrLn $ unwords (map show ans)

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

solve :: [[Int]] -> [Int]
solve ([n, w0, h0] : xs) = printShit . mainSALF . majiqSort . bigEnuff . wiffIndices $ xs
  where
    wiffIndices = flip (zipWith (\[w, h] i -> (w, h, i))) [1..]
    bigEnuff = filter $ \(w, h, _) -> w >= w0 && h >= h0
    majiqSort = sortBy (compare `on` \(w, h, _) -> (w, -h))
    inf = 2147483647
    mainSALF = mapAccumL sALFSHIT (listArray (0, n) (repeat inf), 0)

    sALFSHIT (barr, maxl) (_, h, i) = ((barr // [(idx, h)], max maxl idx), (idx, i))
      where
        idx = bs 1 1 (maxl + 1)
        bs ans l r
          | l > r = ans
          | barr ! m >= h = bs m l (m-1)
          | otherwise = bs ans (m+1) r
          where m = (l + r) `div` 2

    printShit ((_, maxl), ls) = snd $ foldr folder (maxl, []) ls
      where folder (lvl, i) (curl, acc) = if curl == lvl then (curl-1, i : acc) else (curl, acc)

main :: IO ()
main = interact $ output . solve . map (map read . words) . lines
  where output xs = show (length xs) ++ "\n" ++ unwords (map show xs)

module Main where

import Data.List (sortOn, foldl', maximumBy)
import Data.Ord (comparing)

main :: IO ()
main = interact $ solve . tail . words

solve :: [String] -> String
solve inputs = showSolution $ bestSolution solutions
  where
    postcard:envelopes = toEnvelopes 0 inputs
    sortedEnvelopes = sortOn square $ filter (`contain` postcard) envelopes
    solutions = foldl' solve0 [Solution 0 postcard []] sortedEnvelopes
    showSolution s = unlines [ show $ len s, unwords . map show . reverse . path $ s]

bestSolution :: [Solution] -> Solution
bestSolution = maximumBy (comparing len)

solve0 :: [Solution] -> Enverlope -> [Solution]
solve0 solutions envelop = case filter (contain envelop . env) solutions of
  [] -> solutions
  ss -> let Solution l _ p = bestSolution ss in Solution (l + 1) envelop (ei envelop:p):solutions

contain :: Enverlope -> Enverlope -> Bool
contain (Enverlope w1 h1 _) (Enverlope w2 h2 _) = w2 < w1 && h2 < h1

square :: Enverlope -> Int
square (Enverlope w h _) = w * h

toEnvelopes :: Int -> [String] -> [Enverlope]
toEnvelopes _ [] = []
toEnvelopes i (w:h:rest) = Enverlope (read w) (read h) i : toEnvelopes (i + 1) rest

data Solution = Solution {
  len :: !Int,
  env :: Enverlope,
  path :: [Int]
} deriving (Show)

data Enverlope = Enverlope {
    ew :: !Int,
    eh :: !Int,
    ei :: !Int
  } deriving (Show, Eq, Ord)


Consider a sequence of digits of length $$$2^k$$$ $$$[a_1, a_2, \ldots, a_{2^k}]$$$. We perform the following operation with it: replace pairs $$$(a_{2i+1}, a_{2i+2})$$$ with $$$(a_{2i+1} + a_{2i+2})\bmod 10$$$ for $$$0\le i<2^{k-1}$$$. For every $$$i$$$ where $$$a_{2i+1} + a_{2i+2}\ge 10$$$ we get a candy! As a result, we will get a sequence of length $$$2^{k-1}$$$.Less formally, we partition sequence of length $$$2^k$$$ into $$$2^{k-1}$$$ pairs, each consisting of 2 numbers: the first pair consists of the first and second numbers, the second of the third and fourth $$$\ldots$$$, the last pair consists of the ($$$2^k-1$$$)-th and ($$$2^k$$$)-th numbers. For every pair such that sum of numbers in it is at least $$$10$$$, we get a candy. After that, we replace every pair of numbers with a remainder of the division of their sum by $$$10$$$ (and don't change the order of the numbers).Perform this operation with a resulting array until it becomes of length $$$1$$$. Let $$$f([a_1, a_2, \ldots, a_{2^k}])$$$ denote the number of candies we get in this process. For example: if the starting sequence is $$$[8, 7, 3, 1, 7, 0, 9, 4]$$$ then:After the first operation the sequence becomes $$$[(8 + 7)\bmod 10, (3 + 1)\bmod 10, (7 + 0)\bmod 10, (9 + 4)\bmod 10]$$$ $$$=$$$ $$$[5, 4, 7, 3]$$$, and we get $$$2$$$ candies as $$$8 + 7 \ge 10$$$ and $$$9 + 4 \ge 10$$$.After the second operation the sequence becomes $$$[(5 + 4)\bmod 10, (7 + 3)\bmod 10]$$$ $$$=$$$ $$$[9, 0]$$$, and we get one more candy as $$$7 + 3 \ge 10$$$. After the final operation sequence becomes $$$[(9 + 0) \bmod 10]$$$ $$$=$$$ $$$[9]$$$. Therefore, $$$f([8, 7, 3, 1, 7, 0, 9, 4]) = 3$$$ as we got $$$3$$$ candies in total.You are given a sequence of digits of length $$$n$$$ $$$s_1, s_2, \ldots s_n$$$. You have to answer $$$q$$$ queries of the form $$$(l_i, r_i)$$$, where for $$$i$$$-th query you have to output $$$f([s_{l_i}, s_{l_i+1}, \ldots, s_{r_i}])$$$. It is guaranteed that $$$r_i-l_i+1$$$ is of form $$$2^k$$$ for some nonnegative integer $$$k$$$.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the sequence. The second line contains $$$n$$$ digits $$$s_1, s_2, \ldots, s_n$$$ ($$$0 \le s_i \le 9$$$). The third line contains a single integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. Each of the next $$$q$$$ lines contains two integers $$$l_i$$$, $$$r_i$$$ ($$$1 \le l_i \le r_i \le n$$$) — $$$i$$$-th query. It is guaranteed that $$$r_i-l_i+1$$$ is a nonnegative integer power of $$$2$$$.

Output $$$q$$$ lines, in $$$i$$$-th line output single integer — $$$f([s_{l_i}, s_{l_i + 1}, \ldots, s_{r_i}])$$$, answer to the $$$i$$$-th query.

NoteThe first example illustrates an example from the statement.$$$f([7, 3, 1, 7]) = 1$$$: sequence of operations is $$$[7, 3, 1, 7] \to [(7 + 3)\bmod 10, (1 + 7)\bmod 10]$$$ $$$=$$$ $$$[0, 8]$$$ and one candy as $$$7 + 3 \ge 10$$$ $$$\to$$$ $$$[(0 + 8) \bmod 10]$$$ $$$=$$$ $$$[8]$$$, so we get only $$$1$$$ candy.$$$f([9]) = 0$$$ as we don't perform operations with it.

{-# LANGUAGE TupleSections #-}

import Control.Monad
import Data.List
import qualified Data.Map as M
import qualified Data.Sequence as S

input :: Read a => IO [a]
input = map read <$> words <$> getLine

output :: Show a => [a] -> IO ()
output = putStrLn <$> unwords <$> map show

step :: (Int, [(Int,Int)]) -> Int -> (Int, [(Int,Int)])
step (d, xcs) d2 = (d2, zipWith f xcs (drop d xcs)) where
  f (x1,c1) (x2,c2) = (x,c) where
    x = (x1 + x2) `mod` 10
    c = c1 + c2 + (if x1 + x2 >= 10 then 1 else 0)

makedb n s = M.fromList [(d, S.fromList db') | (d,db') <- scanl' step s0 powers] where
  powers = takeWhile (<= n) $ map (2^) [1..]
  s0 = (1, map (,0) s)

main = do
  [n] <- input
  s <- input :: IO [Int]
  let db = makedb n s
  [q] <- input
  replicateM_ q $ do
    [l,r] <- input :: IO [Int]
    let Just db' = M.lookup (r-l+1) db
    let Just (_,c) = S.lookup (l-1) db'
    print c

import System.IO
import Control.Monad
import qualified Data.Map as M
import Data.Array

-- LOGIC
getResults input requests = processRequests l requests tree where (tree, l) = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result' : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r <= x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r
middle l r = (r - l) `div` 2 + l

showTree (Leaf v) = show v
showTree (Tree v left right) = showTree left  ++ " + " ++ showTree right ++ " -> " ++ show v

buildTree input add return empty = (buildTree' 1 length', length')
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = middle lb rb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | rb <= m    = queryTree left   clb    m   lb rb add
    | m <  lb    = queryTree right (m + 1) crb lb rb add
    | otherwise  = add
                       (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = middle clb crb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
getResults :: (Array Int Int) -> [(Int, Int)] -> [Int]
getResults input requests = processRequests (length input) requests tree where tree = buildTree input candies asCandy 0

processRequests :: Int -> [(Int, Int)] -> Tree (Int, Int) -> [Int]
processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result : processRequests length rs tree
    where (_, result) = queryTree tree 1 length l r candies

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r < x then myLog' (r*2) else r

asCandy :: Int -> (Int, Int)
asCandy v = (v, 0)
candies (lv, lr) (rv, rr) = (s `mod` 10,  s `div` 10 + lr + rr) where s = lv + rv

buildTree :: (Array Int a) -> (b -> b -> b) -> (a -> b) -> a -> Tree b
buildTree input add return empty = buildTree' 1 length'
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb ((rb - lb) `div` 2 + lb)
                right = buildTree' ((rb - lb) `div` 2 + lb + 1) rb

queryTree :: Tree a -> Int -> Int -> Int -> Int -> (a -> a -> a) -> a
queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | m <  lb    = queryTree right (m+1) crb lb rb add
    | rb <= m    = queryTree left   clb  m   lb rb add
    | otherwise  = add (queryTree left clb m lb m add) (queryTree right (m + 1) crb (m + 1) rb add)
    where m = (crb - clb) `div` 2 + clb
queryTree tree clb crb lb rb _ = nodeValue tree

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
valuePrice :: Int -> Int -> (Int, Int)
valuePrice l r = (sum `mod` 10, sum `div` 10) where sum = l + r

--buildTree :: M.Map (Int, Int) (Int, Int) -> Int -> Int -> Int -> [Int] -> (M.Map (Int, Int) (Int, Int), (Int, Int))
buildTree c _ _ 1  _ = (c, (0, 0))
buildTree c l _ 2  s = (c, valuePrice (s!l) (s!(l+1)))
buildTree c lb rb l s =
    (c'', (v, p + pl + pr))
    where l' = l `div` 2
          (c' , (vl, pl)) = buildTreeCaching c  lb (rb - l') l' s
          (c'', (vr, pr)) = buildTreeCaching c' (lb + l') rb l' s
          (v,  p)  = valuePrice vl vr

buildTreeCaching :: M.Map (Int, Int) (Int, Int) -> Int -> Int -> Int -> Array Int Int -> (M.Map (Int, Int) (Int, Int), (Int, Int))
buildTreeCaching c lb rb l s =
    case M.lookup (lb, rb) c of
        (Just v) -> (c, v)
        Nothing  -> (M.insert (lb, rb) r c', r) where (c', r) = buildTree c lb rb l s

getResult c lb rb l s = (c', p) where (c', (_, p)) = buildTreeCaching c lb rb l s

-- getResults :: M.Map (Int, Int) (Int, Int) -> [Int] -> [(Int, Int)] -> [Int]
getResults c ar [] = []
getResults c ar ((l, r):rs) = result : (getResults c' ar rs)
    where
        length = r - l + 1
        (c', result) = getResult c l r length ar

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int) - 1) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults M.empty (listArray (0, length s - 1) s) (reverse r)

import System.IO
import Control.Monad
import qualified Data.Map as M
-- import Debug.Trace
import Data.Array

-- LOGIC
getResults input requests = processRequests (length input) requests tree where tree = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result' : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r < x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r

buildTree input add return empty = buildTree' 1 length'
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = (rb - lb) `div` 2 + lb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | m <  lb    = queryTree right (m+1) crb lb rb add
    | rb <= m    = queryTree left   clb  m   lb rb add
    | otherwise  = add (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = (crb - clb) `div` 2 + clb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r

import System.IO
import Control.Monad
import qualified Data.Map as M
import Data.Array

-- LOGIC
getResults input requests = processRequests l requests tree where (tree, l) = buildTree input candies asCandy 0

processRequests _ [] _ = []
processRequests length ((l, r):rs) tree = result : processRequests length rs tree
    where result = queryTree tree 1 length l r candies
          result' = result `div` 10

data Tree a = Leaf a | Tree a (Tree a) (Tree a)
nodeValue (Leaf v)     = v
nodeValue (Tree v _ _) = v

myLog x = myLog' 1 where myLog' r = if r <= x then myLog' (r*2) else r

asCandy v = v
candies l r = l + r
middle l r = (r - l) `div` 2 + l

showTree (Leaf v) = show v
showTree (Tree v left right) = showTree left  ++ " + " ++ showTree right ++ " -> " ++ show v

buildTree input add return empty = (buildTree' 1 length', length')
    where
        normalLength = length input
        length' = myLog normalLength
        buildTree' lb rb | lb == rb = Leaf . return $ if normalLength >= lb then input ! lb else empty
        buildTree' lb rb = Tree root left right
            where
                root = add (nodeValue left) (nodeValue right)
                left  = buildTree' lb      m
                right = buildTree' (m + 1) rb
                m = middle lb rb

queryTree  tree                clb crb lb rb _
    | clb == lb && crb == rb = nodeValue tree
queryTree (Tree _ left right)  clb crb lb rb add
    | rb <= m    = queryTree left   clb    m   lb rb add
    | m <  lb    = queryTree right (m + 1) crb lb rb add
    | otherwise  = add
                       (queryTree left  clb     m   lb      m  add)
                       (queryTree right (m + 1) crb (m + 1) rb add)
    where m = middle clb crb

-- IO

readPair input = (list !! 0, list !! 1) where list = map (\x -> (read x :: Int)) (words input)

main = do
    len <- getLine
    let l = read len :: Int
    sequence <- getLine
    let s = take l $ map (\x -> read x :: Int) (words sequence)
    requests <- getLine
    rs <- replicateM (read requests :: Int) getLine
    let r = map (\x -> readPair x) rs
    mapM (putStrLn . show) $ getResults (listArray (1, length s) s) r


Andrew plays a game called "Civilization". Dima helps him.The game has n cities and m bidirectional roads. The cities are numbered from 1 to n. Between any pair of cities there either is a single (unique) path, or there is no path at all. A path is such a sequence of distinct cities v1, v2, ..., vk, that there is a road between any contiguous cities vi and vi + 1 (1 ≤ i < k). The length of the described path equals to (k - 1). We assume that two cities lie in the same region if and only if, there is a path connecting these two cities.During the game events of two types take place:  Andrew asks Dima about the length of the longest path in the region where city x lies.  Andrew asks Dima to merge the region where city x lies with the region where city y lies. If the cities lie in the same region, then no merging is needed. Otherwise, you need to merge the regions as follows: choose a city from the first region, a city from the second region and connect them by a road so as to minimize the length of the longest path in the resulting region. If there are multiple ways to do so, you are allowed to choose any of them. Dima finds it hard to execute Andrew's queries, so he asks you to help him. Help Dima.

The first line contains three integers n, m, q (1 ≤ n ≤ 3·105; 0 ≤ m < n; 1 ≤ q ≤ 3·105) — the number of cities, the number of the roads we already have and the number of queries, correspondingly. Each of the following m lines contains two integers, ai and bi (ai ≠ bi; 1 ≤ ai, bi ≤ n). These numbers represent the road between cities ai and bi. There can be at most one road between two cities. Each of the following q lines contains one of the two events in the following format:   1 xi. It is the request Andrew gives to Dima to find the length of the maximum path in the region that contains city xi (1 ≤ xi ≤ n).  2 xi yi. It is the request Andrew gives to Dima to merge the region that contains city xi and the region that contains city yi (1 ≤ xi, yi ≤ n). Note, that xi can be equal to yi.

For each event of the first type print the answer on a separate line.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow

import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter v = d where
        (_,v1) = dfs [(v,-1,0)] (0,v)
        (d,v2) = dfs [(v1,-1,0)] (0,v1)
    dfs [] acc = acc
    dfs ((v,pv,d):st) !acc = dfs st' (max (d,v) acc) where
        st' = [(v',v,d+1) | v' <- g ! v, v' /= pv ] ++ st

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow

import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import Data.Tuple(swap)
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
l2p :: [Int] -> (Int,Int)
l2p (a:b:_) = (a,b)
l2p _ = undefined

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = liftA2 (==) (findUF x st) (findUF y st)

main :: IO ()
main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

whenM :: Monad m => m Bool -> m () -> m ()
whenM m1 m2 = m1 >>= flip when m2

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i ->
            whenM ((==i) <$> findUF i st) $ writeArray ds i (diameter i)
        let getD x = findUF x st >>= readArray ds
            putD x d = findUF x st >>= flip (writeArray ds) d
            go [] = return []
            go ([1,x]:_qs) = liftA2 (:) (getD x) (go _qs)
            go ([2,x,y]:_qs) = do
                whenM (not <$> sameUF x y st) $ do
                    dx <- getD x
                    dy <- getD y
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                        dz = maximum [dx,dy,rx+ry+1]
                    mergeUF x y st
                    putD x dz
                go _qs
            go _ = undefined
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter = fst . f . snd . f where
        f = uncurry dfs . (((:[]).(,-1,0)) &&& (0,))
    dfs [] acc = acc :: (Int,Int)
    dfs ((v,pv,d):st) acc = dfs ((map (,v,d+1) $ filter (/=pv) (g ! v)) ++ st) (max (d,v) acc)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter v = d where
        (_,v1) = dfs [(v,-1,0)] (0,v)
        (d,v2) = dfs [(v1,-1,0)] (0,v1)
    dfs [] acc = acc
    dfs ((v,pv,d):st) !acc = dfs st' (max (d,v) acc) where
        st' = [(v',v,d+1) | v' <- g ! v, v' /= pv ] ++ st

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

data UFState s = UFState { bounds :: (Int,Int)
                         , parent :: STUArray s Int Int
                         , rank   :: STUArray s Int Int }

initUF :: (Int,Int) -> ST s (UFState s)
initUF b = UFState b <$> newListArray b (range b) <*> newArray b 0

findUF :: Int -> UFState s -> ST s Int
findUF k st = do
    i <- readArray (parent st) k
    if k == i then
        return i
    else do
        j <- findUF i st
        writeArray (parent st) k j
        return j

mergeUF :: Int -> Int -> UFState s -> ST s ()
mergeUF x y st = do
    px <- findUF x st
    py <- findUF y st
    when (px /= py) $ do
        rx <- readArray (rank st) px
        ry <- readArray (rank st) py
        uncurry (writeArray (parent st)) $ if rx < ry then (px,py) else (py,px)
        when (rx == ry) $ writeArray (rank st) px (rx + 1)

sameUF :: Int -> Int -> UFState s -> ST s Bool
sameUF x y st = (==) <$> findUF x st <*> findUF y st

rootUF :: Int -> UFState s -> ST s Bool
rootUF x st = (x==) <$> findUF x st

main = do
    [n,m,_] <- readInts
    ss <- map (map readInt . B.words) . B.lines <$> B.getContents
    putStr $ unlines $ map show $ uncurry (solve n) $ first (map l2p) $ splitAt m ss

solve :: Int -> [(Int,Int)] -> [[Int]] -> [Int]
solve n es qs = doit where
    doit = runST $ do
        st <- initUF (1,n)
        forM_ es $ \(x,y) -> mergeUF x y st
        ds <- newArray_ (1,n) :: ST s (STUArray s Int Int)
        forM_ [1..n] $ \i -> do
            k <- findUF i st
            when (i==k) $ writeArray ds i (diameter i)
        let go [] = return []
            go ([1,x]:qs) = (:) <$> (findUF x st >>= readArray ds) <*> go qs
            go ([2,x,y]:qs) = do
                px <- findUF x st
                py <- findUF y st
                when (px /= py) $ do
                    dx <- readArray ds px
                    dy <- readArray ds py
                    let rx = (dx + 1) `div` 2
                        ry = (dy + 1) `div` 2
                    mergeUF px py st
                    pz <- findUF x st
                    writeArray ds pz (maximum [dx,dy,rx+ry+1])
                go qs
        go qs
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) (es ++ map swap es)
    diameter i = d2 where
        (d1,v1) = go (-1) i
        (d2,v2) = go (-1) v1
        go pv v = maximum $ [(0,v)] ++ map (go v) (filter (/=pv) (g ! v))


This is an interactive problem.Jury initially had a sequence $$$a$$$ of length $$$n$$$, such that $$$a_i = i$$$.The jury chose three integers $$$i$$$, $$$j$$$, $$$k$$$, such that $$$1 \leq i < j < k \leq n$$$, $$$j - i > 1$$$. After that, Jury reversed subsegments $$$[i, j - 1]$$$ and $$$[j, k]$$$ of the sequence $$$a$$$.Reversing a subsegment $$$[l, r]$$$ of the sequence $$$a$$$ means reversing the order of elements $$$a_l, a_{l+1}, \ldots, a_r$$$ in the sequence, i. e. $$$a_l$$$ is swapped with $$$a_r$$$, $$$a_{l+1}$$$ is swapped with $$$a_{r-1}$$$, etc.You are given the number $$$n$$$ and you should find $$$i$$$, $$$j$$$, $$$k$$$ after asking some questions.In one question you can choose two integers $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq n$$$) and ask the number of inversions on the subsegment $$$[l, r]$$$ of the sequence $$$a$$$. You will be given the number of pairs $$$(i, j)$$$ such that $$$l \leq i < j \leq r$$$, and $$$a_i > a_j$$$.Find the chosen numbers $$$i$$$, $$$j$$$, $$$k$$$ after at most $$$40$$$ questions.The numbers $$$i$$$, $$$j$$$, and $$$k$$$ are fixed before the start of your program and do not depend on your queries.

Each test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. Description of the test cases follows. The single line of each test case contains a single integer $$$n$$$ ($$$4 \leq n \leq 10^9$$$). After reading it you should start an interaction process by asking questions for that test case. After giving an answer you should:   Terminate your program if that is the last test case.  Proceed to the next test case otherwise.

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[n] <- readv
  i <- binSearch 1 n
  di <- getLen i n
  let j=i+di+1
  dj <- getLen j n
  let k=j+dj
  putStr "! "
  printv [i,j,k]
  hFlush stdout

query :: Int -> Int -> IO Integer
query lo hi = do
  putStrLn $ "? " ++ show lo ++ " " ++ show hi
  hFlush stdout
  ~[ans] <- readv
  return ans

binSearch :: Int -> Int -> IO Int
binSearch lo hi
  | lo+1 == hi = return lo
  | otherwise = do
    let mid = lo + (hi - lo) `div` 2
    inv <- query lo mid
    if inv > 0 then binSearch lo mid else binSearch mid hi

getLen :: Int -> Int -> IO Int
getLen lo hi = do
  inv1 <- query lo hi
  inv2 <- query (lo+1) hi
  return $ fromIntegral $ inv1 - inv2

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  ~[n] <- readv
  CM.replicateM_ n solve

import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[n] <- readv
  i <- binSearch 1 n
  di <- getLen i n
  let j=i+di+1
  dj <- getLen j n
  let k=j+dj
  putStr "! "
  printv [i,j,k]

query :: Int -> Int -> IO Integer
query lo hi = do
  putStrLn $ "? " ++ show lo ++ " " ++ show hi
  ~[ans] <- readv
  return ans

binSearch :: Int -> Int -> IO Int
binSearch lo hi
  | lo+1 == hi = return lo
  | otherwise = do
    let mid = lo + (hi - lo) `div` 2
    inv <- query lo mid
    if inv > 0 then binSearch lo mid else binSearch mid hi

getLen :: Int -> Int -> IO Int
getLen lo hi = do
  inv1 <- query lo hi
  inv2 <- query (lo+1) hi
  return $ fromIntegral $ inv1 - inv2

printv :: Show a => [a] -> IO ()
printv xs =  putStrLn $ unwords $ fmap show xs

readv :: Read a => IO [a]
readv = fmap read . words <$> getLine

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  ~[n] <- readv
  CM.replicateM_ n solve


Sereja loves integer sequences very much. He especially likes stairs.Sequence a1, a2, ..., a|a| (|a| is the length of the sequence) is stairs if there is such index i (1 ≤ i ≤ |a|), that the following condition is met: a1 < a2 < ... < ai - 1 < ai > ai + 1 > ... > a|a| - 1 > a|a|.For example, sequences [1, 2, 3, 2] and [4, 2] are stairs and sequence [3, 1, 2] isn't.Sereja has m cards with numbers. He wants to put some cards on the table in a row to get a stair sequence. What maximum number of cards can he put on the table?

The first line contains integer m (1 ≤ m ≤ 105) — the number of Sereja's cards. The second line contains m integers bi (1 ≤ bi ≤ 5000) — the numbers on the Sereja's cards.

In the first line print the number of cards you can put on the table. In the second line print the resulting stairs.

import Data.List
main = getContents >>= putStrLn . f . map (take 2) . group . sort . map read . tail . words
f :: [[Int]] -> [Char]
f x = unlines [show (length y), unwords (map show y)]
  where y = map head x ++ (reverse . concatMap tail . init) x

import Data.List
main = do
	n <- read `fmap` getLine ::IO Int
	as <- map read `fmap` words `fmap` getLine::IO [Int]
	let (u,v) = solution as in do
		print $ length u + length v
		putStrLn $ (write $ reverse u) ++ " " ++ write v
	where
		write = unwords . map show
		solution as = case snd $ foldl' walk ((-1, False),([], [])) $ sort as of
			((u:us),(v:vs)) | u == v -> ((u:us),vs)
			t 						 -> t
		walk ((prev, rep), (us,vs)) a | prev /= a = ((a,False),(a:us,vs))
									| rep 		= ((a,True) ,(us,vs))
									| otherwise = ((a,True) ,(us,a:vs))

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

main = do
    getLine
    bs <- group . sort <$> readInts
    let as = makeStairs bs
    print $ length as
    putStrLn $ unwords $ map show as

makeStairs :: [[Int]] -> [Int]
makeStairs bs = go [] [] bs
    where
        go l1 l2 [(b:_)] = reverse l1 ++ b : l2
        go l1 l2 ([b]:bs) = go (b:l1) l2 bs
        go l1 l2 ((b:_):bs) = go (b:l1) (b:l2) bs

import Data.List
import Data.Array

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]

    let (part1, part2) = foldr (\cur (p1, p2) -> if p1 /= [] && head p1 == cur
        then if p2 /= [] && head p2 == cur
            then (p1, p2)
            else (p1, cur : p2)
        else (cur : p1, p2) ) ([], []) li

    let final = part1 ++ reverse (if part1 /= [] && part2 /= [] && last part1 == last part2 then init part2 else part2)

    print $ length final
    putStrLn $ concatMap (\x -> show x ++ " ") final

import Data.List (group, sort)
import Control.Arrow ((&&&))

main :: IO ()
main = getContents >>= printSolution . solve . map read . tail . words

solve :: [Int] -> [Int]
solve = map head . group . uncurry (++) . (map head &&& map head . filter (not . null) . map tail . reverse) . group . sort

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

import Data.List (group, sort)
import Control.Arrow ((&&&))

main :: IO ()
main = getContents >>= printSolution . solve . map read . tail . words

solve :: [Int] -> [Int]
solve = uncurry (++) . (map head &&& concatMap (tail . take 2) . tail . reverse) . group . sort

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

#!/usr/bin/env runghc
import Data.List
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c1:c2:cs) = (:solve cs)$ intercalate "\n" [show . length $ s,unwords . map show $ s]
  where
    a = map (read::String->Int) . words $ c2
    (l,r) = foldl f ([],[]) . group . sort $ a
    l' = if null l || head l /= head r then l else tail l
    s = reverse l'++r
f (l,r) (n:ns)
  | null ns   = (  l,n:r)
  | otherwise = (n:l,n:r)

import Data.List
import Control.Applicative
import Control.Monad

main = replicateM 2 getLine >>= answer . solve . parse

parse :: [String] -> (Int, [[Int]])
parse [i, nums] = (read i, group . sort . map read $ words nums)

solve :: (Int, [[Int]]) -> [Int]
solve (_, []) = []
solve (i, nums)
      | i == length nums = reverse . map head $ nums
      | otherwise = (s nums) ++ (s . filter (not . null) . map tail . tail $ reverse nums)
      where
        s :: [[Int]] -> [Int]
        s = map head

answer :: [Int] -> IO ()
answer result = (print $ length result)
             >> (putStrLn $ unwords $ map show result)

import Data.List
main = do
	n <- read `fmap` getLine ::IO Int
	as <- map read `fmap` words `fmap` getLine::IO [Int]
	let (u,v) = solution as in do
		print $ length u + length v
		putStrLn $ (write $ reverse u) ++ " " ++ write v
	where
		write = unwords . map show
		solution as = case snd $ foldl' walk ((-1, False),([], [])) as of
			((u:us),(v:vs)) | u == v -> ((u:us),vs)
			t 						 -> t
		walk ((prev, rep), (us,vs)) a | prev /= a = ((a,False),(a:us,vs))
									| rep 		= ((a,True) ,(us,vs))
									| otherwise = ((a,True) ,(us,a:vs))

import Data.List
import Data.Array

uni :: (Eq t) => [t] -> [t]
uni [] = []
uni (x:[]) = [x]
uni (x0:x1:xs)
    | x0 == x1 = uni $ x1 : xs
    | otherwise = x0 : (uni $ x1 : xs)

plainPrint :: (Show t) => [t] -> IO ()
plainPrint = putStrLn . tail . concatMap (\x -> ' ' : show x)

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]
    let uli = uni $ li
    let rest = reverse $ uni $ li \\ (uli ++ [last uli])
    print $ length uli + length rest
    plainPrint $ uli ++ rest

import Data.List
import Data.Array

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]

    let (part1, part2) = foldr (\cur (p1, p2) -> if p1 /= [] && head p1 == cur
        then if p2 /= [] && head p2 == cur
            then (p1, p2)
            else (p1, cur : p2)
        else (cur : p1, p2) ) ([], []) li

    putStrLn $ concatMap (\x -> show x ++ " ") (part1 ++ reverse (if part1 /= [] && part2 /= [] && last part1 == last part2 then init part2 else part2))

import Data.List
import Data.Array

uni :: (Eq t) => [t] -> [t]
uni [] = []
uni (x:[]) = [x]
uni (x0:x1:xs)
    | x0 == x1 = uni $ x1 : xs
    | otherwise = x0 : (uni $ x1 : xs)

plainPrint :: (Show t) => [t] -> IO ()
plainPrint = putStrLn . tail . concatMap (\x -> ' ' : show x)

main = do
    n <- fmap read getLine :: IO Int
    li <- fmap sort $ fmap (fmap read) (fmap words getLine) :: IO [Int]
    let uli = uni $ li
    let rest = reverse $ uni $ li \\ (uli ++ [last uli])
    plainPrint $ uli ++ rest

import Data.List (group)
import Control.Arrow ((&&&))

main :: IO ()
main = getContents >>= printSolution . solve . map read . tail . words

solve :: [Int] -> [Int]
solve = map head . group . uncurry (++) . (map head &&& map head . filter (not . null) . map tail . reverse) . group

printSolution :: Show a => [a] -> IO ()
printSolution xs = print (length xs) >> putStrLn (unwords (map show xs))

#!/usr/bin/env runghc
import Data.List
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c1:c2:cs) = (:solve cs)$ intercalate "\n" [show . length $ s,unwords . map show $ s]
  where
    a = map (read::String->Int) . words $ c2
    (l,r) = foldl f ([],[]) . group . sort $ a
    s = reverse l++r
f (l,r) (n:ns)
  | null ns   = (  l,n:r)
  | otherwise = (n:l,n:r)


There are $$$n$$$ slimes in a row. Each slime has an integer value (possibly negative or zero) associated with it.Any slime can eat its adjacent slime (the closest slime to its left or to its right, assuming that this slime exists). When a slime with a value $$$x$$$ eats a slime with a value $$$y$$$, the eaten slime disappears, and the value of the remaining slime changes to $$$x - y$$$.The slimes will eat each other until there is only one slime left. Find the maximum possible value of the last slime.

The first line of the input contains an integer $$$n$$$ ($$$1 \le n \le 500\,000$$$) denoting the number of slimes. The next line contains $$$n$$$ integers $$$a_i$$$ ($$$-10^9 \le a_i \le 10^9$$$), where $$$a_i$$$ is the value of $$$i$$$-th slime.

Print an only integer — the maximum possible value of the last slime.

NoteIn the first example, a possible way of getting the last slime with value $$$4$$$ is:  Second slime eats the third slime, the row now contains slimes $$$2, -1, 1$$$ Second slime eats the third slime, the row now contains slimes $$$2, -2$$$ First slime eats the second slime, the row now contains $$$4$$$ In the second example, the first slime can keep eating slimes to its right to end up with a value of $$$4$$$.

{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Int
import Control.Applicative
default (Int64)
main = B.interact exec
exec = B.pack . show . solve . tail . map (\x -> let Just (k, _) = B.readInt x in fromIntegral k) . B.words
solve [x] = x
solve xs = runFold ((\s p n m -> if p && n then s else s - 2 * m) <$> premap abs sumf <*> anyf (>= 0) <*> anyf (<= 0) <*> premap abs minf) xs
sumf = Fold (+) 0 id
anyf f = Fold (\a x -> a || f x) False id
minf = Fold min maxBound id

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin
premap f (Fold step begin done) = Fold step' begin done
  where
    step' x a = step x (f a)

{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Int
import Control.Applicative
default (Int64)
main = B.interact exec
exec = B.pack . show . solve . tail . map (\x -> let Just (k, _) = B.readInt x in fromIntegral k) . B.words
solve = runFold ((\s p n m -> if p && n then s else s - 2 * m) <$> premap abs sumf <*> anyf (>= 0) <*> anyf (<= 0) <*> premap abs minf)
sumf = Fold (+) 0 id
anyf f = Fold (\a x -> a || f x) False id
minf = Fold min maxBound id

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin
premap f (Fold step begin done) = Fold step' begin done
  where
    step' x a = step x (f a)