Polycarp plans to conduct a load testing of its new project Fakebook. He already agreed with his friends that at certain points in time they will send requests to Fakebook. The load testing will last n minutes and in the i-th minute friends will send ai requests.Polycarp plans to test Fakebook under a special kind of load. In case the information about Fakebook gets into the mass media, Polycarp hopes for a monotone increase of the load, followed by a monotone decrease of the interest to the service. Polycarp wants to test this form of load.Your task is to determine how many requests Polycarp must add so that before some moment the load on the server strictly increases and after that moment strictly decreases. Both the increasing part and the decreasing part can be empty (i. e. absent). The decrease should immediately follow the increase. In particular, the load with two equal neigbouring values is unacceptable.For example, if the load is described with one of the arrays [1, 2, 8, 4, 3], [1, 3, 5] or [10], then such load satisfies Polycarp (in each of the cases there is an increasing part, immediately followed with a decreasing part). If the load is described with one of the arrays [1, 2, 2, 1], [2, 1, 2] or [10, 10], then such load does not satisfy Polycarp.Help Polycarp to make the minimum number of additional requests, so that the resulting load satisfies Polycarp. He can make any number of additional requests at any minute from 1 to n.

The first line contains a single integer n (1 ≤ n ≤ 100 000) — the duration of the load testing. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109), where ai is the number of requests from friends in the i-th minute of the load testing.

Print the minimum number of additional requests from Polycarp that would make the load strictly increasing in the beginning and then strictly decreasing afterwards.

NoteIn the first example Polycarp must make two additional requests in the third minute and four additional requests in the fourth minute. So the resulting load will look like: [1, 4, 5, 6, 5]. In total, Polycarp will make 6 additional requests.In the second example it is enough to make one additional request in the third minute, so the answer is 1.In the third example the load already satisfies all conditions described in the statement, so the answer is 0.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = minimum $ zipWith3 go (incCost xs) (reverse $ incCost $ reverse xs) xs
  where
  go (lm, lc) (rm, rc) x
    | lm < rm = lc + rc - fromIntegral (lm - x)
    | lm > rm = lc + rc - fromIntegral (rm - x)
    | otherwise = lc + rc - fromIntegral (max (lm - x) (rm - x))

incCost (x:xs) = scanl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = incCost $ reverse $ dropInc $ reverse xs

dropInc xs = map snd $ dropWhile (uncurry (<)) $ zip xs (tail xs)
incCost (x:xs) = snd $ foldl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = minimum $ zipWith3 go (incCost xs) (reverse $ incCost $ reverse xs) xs
  where
  go (lm, lc) (rm, rc) x = lc + rc - fromIntegral (max (lm - x) (rm - x))

incCost (x:xs) = scanl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = minimum $ zipWith go (incCost xs) (reverse $ incCost $ reverse xs)
  where
  go (lm, lc) (rm, rc)
    | lm > rm = lc
    | lm < rm = rc
    | otherwise = max lc rc

incCost (x:xs) = scanl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = incCost $ reverse $ dropInc $ reverse xs

dropInc xs = map snd $ dropWhile (uncurry (<)) $ zip xs (tail xs)
incCost (x:xs) = snd $ foldl (\(p, c) n -> if n <= p then (p + 1, c - n + p + 1) else (n, c)) (x, 0) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = c + fromIntegral (max 0 $ m - m')
  where
  (m, r) = dropInc $ reverse xs
  (m', c) = incCost $ reverse r

dropInc xs = (\zs@((_, z):_) -> (z, map snd zs)) $ dropWhile (uncurry (<)) $ zip xs (tail xs)
incCost (x:xs) = foldl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = minimum $ zipWith3 go (incCost xs) (reverse $ incCost $ reverse xs) xs
  where
  go (lm, lc) (rm, rc) x
    | lm < rm = lc + rc - fromIntegral (lm - x) + fromIntegral (rm - x)
    | lm > rm = lc + rc - fromIntegral (rm - x) + fromIntegral (lm - x)
    | otherwise = lc + rc - fromIntegral (max (lm - x) (rm - x))

incCost (x:xs) = scanl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n poi
  return $ show $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve [_] = 0
solve xs = incCost $ reverse $ dropInc $ reverse xs

dropInc xs = (\zs -> fst (head zs):map snd zs) $ dropWhile (uncurry (<)) $ zip xs (tail xs)
incCost (x:xs) = snd $ foldl (\(p, c) n -> if n <= p then (p + 1, c - (fromIntegral n) + (fromIntegral p) + 1) else (n, c)) (x, 0 :: Int64) xs


...Mike the TV greets you again! Tired of the monotonous furniture? Sick of gray routine? Dreaming about dizzying changes in your humble abode? We have something to offer you! This domino carpet for only $99.99 will change your life! You can lay it on the floor, hang it on the wall or even on the ceiling! Among other things ... Having watched the commercial, virus Hexadecimal also wanted to get a Domino Carpet and wanted badly to be photographed in front of it. But of course, a virus will never consent to buying a licensed Carpet! So she ordered a truck of dominoes and decided to make such a Carpet herself. The original Domino Carpet is a field of squares n × m in size. Each square is half of a domino, and can be rotated either vertically or horizontally, independently from its neighbors. Vertically rotated domino halves look like this:    And horizontally rotated halves look like this:   Notice, that some halves looks the same in both rotations, but other halves differ.Dominoes bought by Hexadecimal are represented by uncuttable chips 1 × 2 in size, which can be laid either vertically or horizontally. If the chip is laid vertically, then both of it's halves should be laid vertically orientated; if the chip is laid horizontally, then both of it's halves should be laid horizontally.The samples of valid and invalid dominoes laid vertically and horizontally are:    Virus Hexadecimal assembles her own Domino Carpet so that the following conditions are satisfied:  each carpet square is covered by a domino chip, i.e. there are no empty squares;  all domino chips lie entirely within the carpet and don't overlap with each other;  if there is a horizontal domino chip with its left half in column j then there are no horizontal domino chips with their left halves in columns j - 1 or j + 1. Before starting to assemble her own Domino Carpet, the virus wants to know the number of ways to achieve the intended purpose modulo 109 + 7.You can assume that the virus has an infinitely large number of dominoes of each type.

The first line contains two integers n and m, separated by a space — the size of the Domino Carpet (1 ≤ n, m ≤ 250). Next 4n + 1 lines contain 4m + 1 symbols.  Each square of the Domino Carpet, which is a domino half, is described by a 3 × 3 square. Symbol 'O' in this square indicates the presence of a point, symbol '.' — its absence.  Each 3 × 3 square is delineated from adjacent squares by symbols '#' as shown in the examples.  It is guaranteed that every box describes the correct half of a domino.  In all pretests the Domino Carpets have the size of 2 × 2 and 4 × 4.

Print a single number, the number of ways to assemble the Domino Carpet modulo 109 + 7, using only standard dominoes of size 1 × 2.

NoteA note to the first example: all correct ways to make Domino Carpet are represented below:  And this way is incorrect:

import Control.Monad
import Control.Applicative
import Data.Array
import Data.Int

type Block = [Bool]

checkRotate :: Block -> (Bool, Bool)
checkRotate block
    | sz == 2 || sz == 3 = if head block then (False, True) else (True, False)
    | sz == 6            = if block !! 1 then (False, True) else (True, False)
    | otherwise          = (True, True)
  where
    sz = length $ filter id block

buildBlocks :: Int -> Int -> [[Char]] -> Array (Int,Int) Block
buildBlocks rows cols str = array bnds [((x,y), getBlock x y) | x <- [0..rows-1] , y <- [0..cols-1]]
  where
    bndsC = ((0, 0), (rows * 4, cols * 4))
    arr = array bndsC [((x,y),ch) | (x, line) <- zip [0..] str, (y, ch) <- zip [0..] line]
    bnds = ((0,0), (rows-1,cols-1))
    getBlock x y = [ch == 'O' | i <- [0..2], j <- [0..2], let ch = arr ! (bx + i, by + j)]
      where
        bx = x * 4 + 1
        by = y * 4 + 1

solve :: Int -> Int -> Array (Int, Int) (Bool, Bool) -> Int
solve rows cols rotates = solveCols (map solveOneCol [0..cols-1]) (map solveTwoCol [0..cols-1])
  where
    modulo = 10^9+7
    myPlus :: Int -> Int -> Int
    myPlus a b = if sum >= modulo then sum - modulo else sum
      where
        sum = a + b
    myMul :: Int -> Int -> Int
    myMul a b = fromIntegral (mul `mod` fromIntegral modulo)
      where
        mul = (fromIntegral a) * (fromIntegral b) :: Int64
    solveOneCol col
        | odd rows = 0
        | otherwise = if and [fst $ rotates ! (x, col) | x <- [0..rows-1]] then 1 else 0
    solveTwoCol col = if col + 1 < cols then solveCol $ listArray (0, rows-1) thisCol else undefined--0
      where
        thisCol = [ (a && c, b && d)
                  | x <- [0..rows-1]
                  , let (a,b) = rotates ! (x,col)
                  , let (c,d) = rotates ! (x,col+1)
                  ]
    solveCol col = foldl myPlus 0 [go (x+1) | x <- takeWhile canTwo' $ filter even [0..rows-1], canOne x]
      where
        bnds = (0, rows)
        memo = array bnds [(x, go x) | x <- range bnds]
        go r
            | r == rows = 1
            | otherwise = sum1 `myPlus` sum2
          where
            go' r = memo ! r
            sum1 = if canOne r then go' (r + 1) else 0
            sum2 = if canTwo r then go' (r + 2) else 0
        canOne r = r < rows && snd (col ! r)
        canTwo r = r + 1 < rows && fst (col ! r) && fst (col ! (r + 1))
        canTwo' r = r == 0 || canTwo (r - 2)
    solveCols col1 col2 = go 0
      where
        bnds = (0, cols)
        arr1 = listArray bnds col1
        arr2 = listArray bnds col2
        memo = array bnds [(x, go x) | x <- range bnds]
        go c
            | c == cols = 1
            | otherwise = sum1 `myPlus` sum2
          where
            go' c = memo ! c
            sum1 = (arr1 ! c) `myMul` go' (c + 1)
            sum2 = if c + 1 < cols then (arr2 ! c) `myMul` go' (c + 2) else 0

main = do
    [rows,cols] <- map read . words <$> getLine :: IO [Int]
    blocks <- buildBlocks rows cols <$> replicateM (rows * 4 + 1) getLine
    print $ solve rows cols (checkRotate <$> blocks)


This is an easy version of the problem. In this version, all numbers in the given array are distinct and the constraints on $$$n$$$ are less than in the hard version of the problem.You are given an array $$$a$$$ of $$$n$$$ integers (there are no equals elements in the array). You can perform the following operations on array elements:  choose any index $$$i$$$ ($$$1 \le i \le n$$$) and move the element $$$a[i]$$$ to the begin of the array;  choose any index $$$i$$$ ($$$1 \le i \le n$$$) and move the element $$$a[i]$$$ to the end of the array. For example, if $$$n = 5$$$, $$$a = [4, 7, 2, 3, 9]$$$, then the following sequence of operations can be performed:   after performing the operation of the first type to the second element, the array $$$a$$$ will become $$$[7, 4, 2, 3, 9]$$$;  after performing the operation of the second type to the second element, the array $$$a$$$ will become $$$[7, 2, 3, 9, 4]$$$. You can perform operations of any type any number of times in any order.Find the minimum total number of operations of the first and second type that will make the $$$a$$$ array sorted in non-decreasing order. In other words, what is the minimum number of operations that must be performed so the array satisfies the inequalities $$$a[1] \le a[2] \le \ldots \le a[n]$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the test. Then $$$t$$$ test cases follow. Each test case starts with a line containing an integer $$$n$$$ ($$$1 \le n \le 3000$$$) — length of the array $$$a$$$. Then follow $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — an array that needs to be sorted by the given operations. All numbers in the given array are distinct. The sum of $$$n$$$ for all test cases in one test does not exceed $$$3000$$$.

For each test case output one integer — the minimum total number of operations of the first and second type, which will make the array sorted in non-decreasing order.

NoteIn the first test case, you first need to move 3, and then 2 to the beginning of the array. Therefore, the desired sequence of operations: $$$[4, 7, 2, 3, 9] \rightarrow [3, 4, 7, 2, 9] \rightarrow [2, 3, 4, 7, 9]$$$.In the second test case, you need to move the 1 to the beginning of the array, and the 8 — to the end. Therefore, the desired sequence of operations: $$$[3, 5, 8, 1, 7] \rightarrow [1, 3, 5, 8, 7] \rightarrow [1, 3, 5, 7, 8]$$$.In the third test case, the array is already sorted.

import Control.Monad
import qualified Data.IntMap as IM
import Data.Array
--import Data.Maybe

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

routine :: IO ()
routine = do
  n <- readLn
  xs <- (map read.words) <$> getLine
  print $ solve n xs

solve :: Int -> [Int] -> Int
solve n xs = n - maximum dp
  where
    z =map (\(v,i) -> IM.insertWith (\x y -> head x:y) v [i]) $ zip xs [1..]
    myMap = apply z IM.empty
    dp = array (1,n) [ (i,f v i) | (v,i) <- zip xs [1..]]
    f :: Int -> Int -> Int
    f v i =1 + maximum (0:[dp!ii|ii <- indx])
      where
        indx =let a = filter (<i) $ (IM.!) myMap v in if null a
          then maybe [] ((\x -> if null x then [] else [head x]).filter (<i).snd) (IM.lookupLT v myMap)
          else [head a]
        --is = filter (<i) $ (IM.!) myMap v ++ maybe [] ((\x -> if null x then [] else [head x]).filter (<i).snd) (IM.lookupLT v myMap)

apply :: [a -> a] -> a -> a
apply xs a = foldl (\ y x -> x y) a xs


You are given a positive integer $$$n$$$.The weight of a permutation $$$p_1, p_2, \ldots, p_n$$$ is the number of indices $$$1\le i\le n$$$ such that $$$i$$$ divides $$$p_i$$$. Find a permutation $$$p_1,p_2,\dots, p_n$$$ with the minimum possible weight (among all permutations of length $$$n$$$).A permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 10^4$$$). The description of the test cases follows. The only line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the length of permutation. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, print a line containing $$$n$$$ integers $$$p_1, p_2,\dots, p_n$$$ so that the permutation $$$p$$$ has the minimum possible weight. If there are several possible answers, you can print any of them.

NoteIn the first test case, the only valid permutation is $$$p=[1]$$$. Its weight is $$$1$$$.In the second test case, one possible answer is the permutation $$$p=[2,1,4,3]$$$. One can check that $$$1$$$ divides $$$p_1$$$ and $$$i$$$ does not divide $$$p_i$$$ for $$$i=2,3,4$$$, so the weight of this permutation is $$$1$$$. It is impossible to find a permutation of length $$$4$$$ with a strictly smaller weight.

{-# OPTIONS_GHC -O2 #-}

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:xs) = (readInt x, xs)

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - 48)

solve n = n:[1..n-1]

format = unwords . map show

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (readInt l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:xs) = (read x, xs)

readInt = foldl1 (\x y -> x*10 + y) . map (\x -> fromEnum x - fromEnum '0')

solve n = n:[1..n-1]

format = unwords . map show

main = interact $ unlines . map (format . solve) . parse . lines

parse (l:ls) = take (read l) $ go ls
  where go ys = x:go ys'
          where (x,ys') = parse1 ys

parse1 (x:xs) = (read x, xs)

solve n = n:[1..n-1]

format = unwords . map show

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n] <- ri
        return n
    mapM_ (putStrLn.showL.solve) tcs

showL = unwords . map show

solve n = take n . drop (n-1) . cycle $ [1..n]


Burenka and Tonya are playing an old Buryat game with a chip on a board of $$$n \times m$$$ cells.At the beginning of the game, the chip is located in the lower left corner of the board. In one move, the player can move the chip to the right or up by any odd number of cells (but you cannot move the chip both to the right and up in one move). The one who cannot make a move loses.Burenka makes the first move, the players take turns. Burenka really wants to win the game, but she is too lazy to come up with a strategy, so you are invited to solve the difficult task of finding it. Name the winner of the game (it is believed that Burenka and Tonya are masters of playing with chips, so they always move in the optimal way).    Chip's starting cell is green, the only cell from which chip can't move is red. if the chip is in the yellow cell, then blue cells are all options to move the chip in one move.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The following is a description of the input data sets. The only line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 10^9$$$) — the dimensions of the game board.

For each test case print a single line — the name of the winner of the game ("Burenka" or "Tonya").

Tonya
Burenka
Burenka
Tonya
Burenka
Burenka

NoteIn the first case, Burenka has no move, so Tonya wins.In the second case, Burenka can move $$$3$$$ cells to the right, after which Tony will not be able to make a move, which means that Burenka wins.In the third case, Burenka can move $$$5$$$ squares to the right. Then we can say that we have a game on a board of $$$1 \times 5$$$ cells, and Tonya is the first player. In such game the second player wins, so in the original one Burenka will win.

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

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

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

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n,m] <- ri
        return (n,m)
    mapM_ (putStrLn.showB.solve) tcs

showB False = "Tonya"
showB True  = "Burenka"

solve (n,m) = isFirstWins
  where
    isFirstWins = odd $ (n-1) + (m-1)

decide :: Int -> IO()
decide t | t <= 0 = return ()
         | otherwise = do
            vars <- getLine >>= (return . words)
            let intoInt = return . ((\a -> a `mod` 2 + 1) . (read :: String -> Int))

            n <- intoInt $ head vars
            m <- intoInt $ head $ tail vars

            --Sup
            --putStrLn ("n = " ++ (show n))
            --putStrLn ("m = " ++ (show m))

            if (n + m) `mod` 2 == 1
            then putStrLn "Burenka"
            else putStrLn "Tonya"
            decide $ t-1

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


Even if it's a really easy question, she won't be able to answer it— Perfect Memento in Strict SenseCirno's perfect bitmasks classroom has just started!Cirno gave her students a positive integer $$$x$$$. As an assignment, her students need to find the minimum positive integer $$$y$$$, which satisfies the following two conditions:$$$$$$x\ \texttt{and}\ y > 0$$$$$$ $$$$$$x\ \texttt{xor}\ y > 0$$$$$$Where $$$\texttt{and}$$$ is the bitwise AND operation, and $$$\texttt{xor}$$$ is the bitwise XOR operation.Among the students was Mystia, who was truly baffled by all these new operators. Please help her!

The first line of input contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^3$$$) — the number of input test cases. For each test case, the only line of input contains one integer $$$x$$$ ($$$1 \leq x \leq 2^{30}$$$).

For each test case, print a single integer — the minimum number of $$$y$$$.

import Control.Arrow ((>>>))
import Data.Bits ((.&.))

-- https://codeforces.com/problemset/problem/1688/A
solve :: Int -> Int
solve x =
    let y = x .&. (- x)
     in incWhile
            (\z -> z == x || z .&. x == 0)
            y

incWhile :: (Int -> Bool) -> Int -> Int
incWhile p x = if p x then incWhile p (x + 1) else x

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

module Main where

getMinNumber :: Int -> Int
getMinNumber 1 = 3
getMinNumber n = one n + isPower2 n
  where
    isPower2 m
      | even m = isPower2 (m `div` 2)
      | m == 1 = 1
      | otherwise = 0
    one m
      | even m = 2 * one (m `div` 2)
      | otherwise = 1

solution :: [Int] -> [Int]
solution (_: xs) = map getMinNumber xs
solution _ = undefined

main :: IO ()
main = interact $ unlines . map show . solution . map read . words

-- boilerplate {{{1
-- vim: foldmethod=marker
-- pragmas {{{2
{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE TupleSections       #-}
{-# LANGUAGE TypeApplications    #-}

module Main where -- {{{2

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Foldable hiding ( sum, product )
import Data.Function
import Data.Functor
import Data.List hiding ( sum, product )
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Semigroup ( Min(..), Max(..) )
import Data.Traversable
import Data.Tuple
import Debug.Trace
import Prelude hiding ( sum, product )
import System.IO
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet           as IS
import qualified Data.Map              as LM
import qualified Data.Map.Strict       as M
import qualified Data.Set              as S

-- recursion schemes {{{2
data Tree a b = Tree a (Forest a b) deriving (Eq,Ord,Show,Functor)
type Forest a b = [b]
deriving instance Foldable (Tree a)
deriving instance Traversable (Tree a)

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

newtype Term f = In { out :: f (Term f) }
type Algebra f a = f a -> a
type Coalgebra f a = a -> f a

cata :: Functor f => Algebra f a -> Term f -> a
cata f = c where c = f . fmap c . out

ana :: Functor f => Coalgebra f a -> a -> Term f
ana g = a where a = In . fmap a . g

treeCoalgebra :: -- {{{2
    Int -> [[Int]] -> (Int -> a) ->
    Coalgebra (Tree a) (Int,Int)
treeCoalgebra n uvs f = coalg
  where
    coalg (curr,prev) = Tree (f curr) $ map (,curr) $ lookup curr prev
    lookup curr prev = IS.elems $ IS.delete prev $ uvary ! curr
    uvary = runSTArray $ do
        ary <- newArray (1,n) IS.empty
        let insert u 1 = pure ()
            insert u v = readArray ary u >>= writeArray ary u . IS.insert v
        for_ uvs $ \[u,v] -> insert u v >> insert v u
        pure ary

data V2 a = V2 !a !a -- {{{2
    deriving ( Eq, Ord, Show )
instance Num a => Num (V2 a) where
    (+) = liftA2 (+)
    (-) = liftA2 (-)
    (*) = liftA2 (*)
    abs = fmap abs
    negate = fmap negate
    signum = fmap signum
    fromInteger = pure . fromInteger
instance Functor V2 where
    fmap f (V2 a b) = V2 (f a) (f b)
    a <$ _ = V2 a a
instance Applicative V2 where
    pure a = V2 a a
    V2 a b <*> V2 d e = V2 (a d) (b e)
instance Monad V2 where
    V2 a b >>= f = V2 a' b' where
        V2 a' _ = f a
        V2 _ b' = f b
instance Foldable V2 where
    foldMap f (V2 a b) = f a `mappend` f b
    null _ = False
    length _ = 2
instance Traversable V2 where
    traverse f (V2 a b) = V2 <$> f a <*> f b

data V3 a = V3 !a !a !a -- {{{2
    deriving ( Eq, Ord, Show )
instance Num a => Num (V3 a) where
    (+) = liftA2 (+)
    (-) = liftA2 (-)
    (*) = liftA2 (*)
    abs = fmap abs
    negate = fmap negate
    signum = fmap signum
    fromInteger = pure . fromInteger
instance Functor V3 where
    fmap f (V3 a b c) = V3 (f a) (f b) (f c)
    a <$ _ = V3 a a a
instance Applicative V3 where
    pure a = V3 a a a
    V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)
instance Monad V3 where
    V3 a b c >>= f = V3 a' b' c' where
        V3 a' _ _ = f a
        V3 _ b' _ = f b
        V3 _ _ c' = f c
instance Foldable V3 where
    foldMap  f (V3 a b c) = f a `mappend` f b `mappend` f c
    null _ = False
    length _ = 3
instance Traversable V3 where
    traverse f (V3 a b c) = V3 <$> f a <*> f b <*> f c

-- utilites {{{2
readInt s = let Just (i,_) = C.readInt s in i :: Int
getInt = readInt <$> C.getLine
getInts = map readInt . C.words <$> C.getLine
ynq = putStrLn . bool "No" "Yes"
ynQ = putStrLn . bool "NO" "YES"
modulus = 10^9 + 7 :: Int
mod' x = rem x modulus
mprint :: Show a => String -> Maybe a -> IO ()
mprint s = maybe (putStrLn s) print
tri n = quot (n * n + n) 2
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM b t e = b >>= bool e t
whenM :: Monad m => m Bool -> m () -> m ()
whenM b t = ifM b t (pure ())
gcount g@(x:_) = (x, length g)
sum t     = foldl' (+) 0 t
product t = foldl' (*) 1 t

-- }}}1

main = getInt >>= flip replicateM_ docase
-- main = docase

docase = do
    [x] <- getInts
    print $ solve x

solve x
    | ay /= x = ay
    | otherwise = min by ny
  where
    (y:_,n:_) = partition (testBit x) [0..]
    ay = setBit 0 y
    by = setBit ay (y+1)
    ny = setBit ay n

import Control.Monad (replicateM_)
import Data.Bits ((.&.))
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . minNum

s2P :: Int -> Int
s2P x = x .&. (-x)

minNum :: Int -> Int
minNum x | s2P x == x = if x == 1 then 3 else x+1
         | otherwise = s2P x

import Data.Bits

powersOfTwo :: [Int]
powersOfTwo = [2^i | i <- [0..30]]

solve :: Int -> Int
solve x = let powerIntersecingX = filter (\power -> (x .&. power) > 0) powersOfTwo in
          if length powerIntersecingX > 1
          then head powerIntersecingX
          else if head powerIntersecingX /= 1
               then head powerIntersecingX + 1
               else head powerIntersecingX + 2

mainLoop :: Int -> IO ()
mainLoop t | t <= 0 = return ()
           | otherwise = do number <- (readLn :: IO Int)
                            print (solve number)
                            mainLoop (t - 1)

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


It is winter now, and Max decided it's about time he watered the garden.The garden can be represented as n consecutive garden beds, numbered from 1 to n. k beds contain water taps (i-th tap is located in the bed xi), which, if turned on, start delivering water to neighbouring beds. If the tap on the bed xi is turned on, then after one second has passed, the bed xi will be watered; after two seconds have passed, the beds from the segment [xi - 1, xi + 1] will be watered (if they exist); after j seconds have passed (j is an integer number), the beds from the segment [xi - (j - 1), xi + (j - 1)] will be watered (if they exist). Nothing changes during the seconds, so, for example, we can't say that the segment [xi - 2.5, xi + 2.5] will be watered after 2.5 seconds have passed; only the segment [xi - 2, xi + 2] will be watered at that moment.  The garden from test 1. White colour denotes a garden bed without a tap, red colour — a garden bed with a tap.   The garden from test 1 after 2 seconds have passed after turning on the tap. White colour denotes an unwatered garden bed, blue colour — a watered bed. Max wants to turn on all the water taps at the same moment, and now he wonders, what is the minimum number of seconds that have to pass after he turns on some taps until the whole garden is watered. Help him to find the answer!

The first line contains one integer t — the number of test cases to solve (1 ≤ t ≤ 200). Then t test cases follow. The first line of each test case contains two integers n and k (1 ≤ n ≤ 200, 1 ≤ k ≤ n) — the number of garden beds and water taps, respectively. Next line contains k integers xi (1 ≤ xi ≤ n) — the location of i-th water tap. It is guaranteed that for each  condition xi - 1 < xi holds. It is guaranteed that the sum of n over all test cases doesn't exceed 200. Note that in hacks you have to set t = 1.

For each test case print one integer — the minimum number of seconds that have to pass after Max turns on some of the water taps, until the whole garden is watered.

NoteThe first example consists of 3 tests:  There are 5 garden beds, and a water tap in the bed 3. If we turn it on, then after 1 second passes, only bed 3 will be watered; after 2 seconds pass, beds [1, 3] will be watered, and after 3 seconds pass, everything will be watered.  There are 3 garden beds, and there is a water tap in each one. If we turn all of them on, then everything will be watered after 1 second passes.  There are 4 garden beds, and only one tap in the bed 1. It will take 4 seconds to water, for example, bed 4.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Strict

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  t <- poi
  fmap (unlines . map show) $ replicateM t $ do
    n <- poi
    k <- poi
    xs <- replicateM k poi
    return $ solve n xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n xs = (+1) $ maximum $ foldr (\i g tts@((p, c):ts) -> case (abs (i - p), abs (i - c)) of { (a, b) | a > b -> b:g ts; (a, _) -> a:g tts }) (const []) [1..n] $ let ys = (-1000):xs ++ [1000] in zip ys (tail ys)


You are given an array $$$a$$$ consisting of $$$n$$$ integers (it is guaranteed that $$$n$$$ is even, i.e. divisible by $$$2$$$). All $$$a_i$$$ does not exceed some integer $$$k$$$.Your task is to replace the minimum number of elements (replacement is the following operation: choose some index $$$i$$$ from $$$1$$$ to $$$n$$$ and replace $$$a_i$$$ with some integer in range $$$[1; k]$$$) to satisfy the following conditions:  after all replacements, all $$$a_i$$$ are positive integers not greater than $$$k$$$;  for all $$$i$$$ from $$$1$$$ to $$$\frac{n}{2}$$$ the following equation is true: $$$a_i + a_{n - i + 1} = x$$$, where $$$x$$$ should be the same for all $$$\frac{n}{2}$$$ pairs of elements. You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le n \le 2 \cdot 10^5, 1 \le k \le 2 \cdot 10^5$$$) — the length of $$$a$$$ and the maximum possible value of some $$$a_i$$$ correspondingly. It is guratanteed that $$$n$$$ is even (i.e. divisible by $$$2$$$). The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le k$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ (as well as the sum of $$$k$$$) over all test cases does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$, $$$\sum k \le 2 \cdot 10^5$$$).

For each test case, print the answer — the minimum number of elements you have to replace in $$$a$$$ to satisfy the conditions from the problem statement.

import Control.Monad
import Data.List

main = readLn >>= flip replicateM_ test

test = do
    (n:k:_) <- map read . words <$> getLine
    as <- map read . words <$> getLine
    print $ solve k as

f --> ps = sort $ uncurry f <$> ps

solve k as = f (2 * k) 0 mins 0 maxs sums
  where
    n = length as
    ps = take (n `div` 2) $ zip as (reverse as)
    mins = reverse $ min --> ps
    maxs = reverse $ max --> ps
    sums = reverse $ (+) --> ps
    f (-1) _ _ _ _ _ = n
    f i a mins b maxs sums = min (n - length eqs + a' - b') (f (i - 1) a' mins' b' maxs' sums')
      where
        (lesss, mins') = span (>= i) mins
        (mores, maxs') = span (>= i - k) maxs
        (eqs, sums') = span (== i) sums
        a' = a + length lesss
        b' = b + length mores


There are $$$n$$$ segments $$$[l_i, r_i]$$$ for $$$1 \le i \le n$$$. You should divide all segments into two non-empty groups in such way that there is no pair of segments from different groups which have at least one common point, or say that it's impossible to do it. Each segment should belong to exactly one group.To optimize testing process you will be given multitest.

The first line contains one integer $$$T$$$ ($$$1 \le T \le 50000$$$) — the number of queries. Each query contains description of the set of segments. Queries are independent. First line of each query contains single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — number of segments. It is guaranteed that $$$\sum{n}$$$ over all queries does not exceed $$$10^5$$$. The next $$$n$$$ lines contains two integers $$$l_i$$$, $$$r_i$$$ per line ($$$1 \le l_i \le r_i \le 2 \cdot 10^5$$$) — the $$$i$$$-th segment.

For each query print $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$ ($$$t_i \in \{1, 2\}$$$) — for each segment (in the same order as in the input) $$$t_i$$$ equals $$$1$$$ if the $$$i$$$-th segment will belongs to the first group and $$$2$$$ otherwise. If there are multiple answers, you can print any of them. If there is no answer, print $$$-1$$$.

NoteIn the first query the first and the second segments should be in different groups, but exact numbers don't matter.In the second query the third segment intersects with the first and the second segments, so they should be in the same group, but then the other group becomes empty, so answer is $$$-1$$$.In the third query we can distribute segments in any way that makes groups non-empty, so any answer of $$$6$$$ possible is correct.

-- Educational Codeforces Round #58 (C), Contest 1101, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    lrs <- replicateM n
      $ (\[l,r] -> (l,r)) . map read . words <$> getLine
    putStrLn $ fromMaybe "-1" $ unwords . map show <$> query lrs

query :: [(Int,Int)] -> Maybe [Int]
query lrs = fmap (\cp -> map (\(l,r) -> if r <= cp then 1 else 2) lrs) cutpt
  where
    cutpt = fmap fst $ find ((== 0) . snd)
      $ init $ merge $ sort (lrs >>= \(l,r) -> [(l,1),(r,-1)])
    merge [] = []
    merge ((i,x):xs) = go i x xs
      where
        go !i !acc [] = [(i,acc)]
        go !i !acc ((j,x):xs) | i == j    = go i (acc+x) xs
                              | otherwise = (i,acc) : go j (acc+x) xs

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe ([Int], [Int], Int)

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), i) answer = do
    (a1, a2, ll) <- answer
    if r < ll then
        return (i : a2, a1, l)
    else
        return (i : a1, a2, min l ll)

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sortBy (compare `on` (\((x, y), z) -> ((y, x), z))) $ zip segments [1..]
    (a1, a2, ll) <- foldr' foldAnswer (Just ([], [], 400000)) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

{- We can start out by picking one segment, and arbitrarily put it in a group. Then every other
 - segment that intersect with it have to be put in the same group, etc. If there are at least one
 - element in the rest, we're good. Now that might be very naive, and it uses nothing about segment
 - intersection other than its equivalence relation nature. The running time is definitely in big
 - theta of n squared: it will not fit. Let's nonetheless write this naive solution to get a better
 - view of the problem.
 -
 - The upper bound on li and ri suggests that they could be used to index an array.
 -
 - Update: as expected, the naive solution takes far too much time. There has to be a much better
 - way, using the fact that we are specifically dealing with intervals.
 - Reupdate: apparently the naive solution is fast enough for some inputs of maximum size. There
 - might be another factor that differentiates possible inputs. -}

import Data.List (intersperse, sortBy)
import Data.Ord (comparing)

sortOn :: Ord b => (a -> b) -> [a] -> [a]
sortOn f =
  map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))

main = interact (format . solve . parse)

parse :: String -> [[IndexedInterval]]
parse = reverse . parseQueries . words

parseQueries :: [String] -> [[IndexedInterval]]
parseQueries (ns:s) = let
    f 0 _ ret = ret
    f n xs ret = let (s0, q) = parseQuery xs in f (n - 1) s0 (q:ret)
    in
    f (read ns :: Integer) s []

parseQuery :: [String] -> ([String], [IndexedInterval])
parseQuery (ns:s) = let
    f 0 _ xs ret = (xs, ret)
    f rn i (x0:x1:xs) ret = f (rn - 1) (i + 1) xs (IndexedInterval {
        index = i,
        interval = Interval { begin=(read x0), end=(read x1) }
    }:ret)
    f _ _ _ _ = ([], [])
    in
    f (read ns :: Integer) 0 s []
parseQuery [] = ([], [])

{- Introducing these types does not make sense in a Codeforces context, but it might help with
 - Haskell the first few times. -}
data Interval = Interval { begin :: Integer, end :: Integer } deriving (Show)
data IndexedInterval = IndexedInterval { index :: Integer, interval :: Interval } deriving (Show)

solve = map solveQuery

solveQuery :: [IndexedInterval] -> Maybe [Bool]
solveQuery a = let (b, c) = (partitionIntervals . orderIntervals) a in reorderPartition b c

orderIntervals :: [IndexedInterval] -> [IndexedInterval]
orderIntervals a = sortOn (begin . interval) a

{- Note: the intervals passed as argument MUST be sorted with respect to their left boundary. -}
partitionIntervals :: [IndexedInterval] -> ([IndexedInterval], [IndexedInterval])
partitionIntervals [] = ([], [])
partitionIntervals (x:a) = let
    f u b [] = (b, [])
    f u b (i:c) = if end u < (begin . interval) i then (b, (i:c))
        else f (union u (interval i)) (i:b) c
    in f (interval x) [x] a

reorderPartition :: [IndexedInterval] -> [IndexedInterval] -> Maybe [Bool]
reorderPartition _ [] = Nothing
reorderPartition a b = Just $ map snd $ sortOn fst $ (map (\i -> (index i, False)) a) ++ (map (\i -> (index i, True)) b)

{- Only makes sense when passed intersecting intervals. -}
union :: Interval -> Interval -> Interval
union (Interval l0 r0) (Interval l1 r1) = Interval (min l0 l1) (max r0 r1)

{- Returns a query result in the requested output form -}
formatQuery :: Maybe [Bool] -> String
formatQuery Nothing = "-1"
formatQuery (Just a) = intersperse ' ' $ map (\x -> if x then '2' else '1') a

format :: [Maybe [Bool]] -> String
format = unlines . (map formatQuery)

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

check (([_,sr],_):range) = go range sr 2
    where go [] _ _ = -1
          go (([l,r], _):s) x i
            | l > x = i
            | otherwise = go s (max x r) (i+1)

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` (head . fst)) (zip range [1..])
    let k = check sorted
    let v = zip (map snd sorted) (map (\x -> if x < k then 1 else 2) [1..q])
    if k == -1 then print k else (printInts $ map snd $ sort v)

main = do
    [t] <- getInts
    mapM_ solve [1..t]

import Data.List
import Data.Function

solve :: [(Int, Int)] -> [Int]
solve xs =
  let
    d = groupDivider $ sort xs
    g = groups d xs
  in validate g

groupDivider :: [(Int, Int)] -> Int
groupDivider ((l, r) : xs) = go r xs
  where
    go r [] = r
    go r ((x, y) : ys)
      | x > r = r
      | otherwise = go (max r y) ys

groups :: Int -> [(Int, Int)] -> [Int]
groups d = map (f . (<= d). snd)
  where f True = 1
        f False = 2

validate :: [Int] -> [Int]
validate xs = if 2 `elem` xs then xs else [-1]

list2tuple :: [Int] -> (Int, Int)
list2tuple [x, y] = (x, y)

parseInput :: String -> [[Int]]
parseInput = map (map read . words) . lines

splitTestCases :: [[Int]] -> [[(Int, Int)]]
splitTestCases = map (map list2tuple) .
                 filter ((==2) . length . head) .
                 groupBy ((==) `on` length)

formatOutput :: [[Int]] -> String
formatOutput = unlines . map (unwords . map show)

main = interact $ formatOutput . map solve . splitTestCases . parseInput

import Data.List
import Data.Function

solve :: [(Int, Int)] -> String
solve xs =
  let
    d = groupDivider $ sort xs
    g = groups d xs
    v = validate g
  in unwords $ map show v

groupDivider :: [(Int, Int)] -> Int
groupDivider ((l, r) : xs) = go r xs
  where
    go r [] = r
    go r ((x, y) : ys)
      | x > r = r
      | otherwise = go (max r y) ys

groups :: Int -> [(Int, Int)] -> [Int]
groups d = map (f . (<= d). snd)
  where f True = 1
        f False = 2

validate :: [Int] -> [Int]
validate xs = if 2 `elem` xs then xs else [-1]

list2tuple :: [Int] -> (Int, Int)
list2tuple [x, y] = (x, y)

parseInput :: String -> [[Int]]
parseInput = map (map read . words) . lines

splitTestCases :: [[Int]] -> [[(Int, Int)]]
splitTestCases = map (map list2tuple) .
                 filter ((==2) . length . head) .
                 groupBy ((==) `on` length)

main = interact $ unlines . map solve . splitTestCases . parseInput

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe (([Int], Int), ([Int], Int))

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), id) answer = do
    ((a1, l1), (a2, l2)) <- answer
    if r < l2 then
        if l < l1 then
            return ((id : a2, l), (a1, l1))
        else
            return ((a1, l1), (id : a2, l))
    else
        Nothing

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sortBy (compare `on` snd) $ zip segments [1..]
    ((a1, l1), (a2, l2)) <- foldr' foldAnswer (Just (([], 300000), ([], 300000))) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe (([Int], Int), ([Int], Int))

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), id) answer = do
    ((a1, l1), (a2, l2)) <- answer
    if r < l2 then
        if l < l1 then
            return ((id : a2, l), (a1, l1))
        else
            return ((a1, l1), (id : a2, l))
    else
        Nothing

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sortBy (compare `on` (\((x, y), z) -> ((y, x), z))) $ zip segments [1..]
    ((a1, l1), (a2, l2)) <- foldr' foldAnswer (Just (([], 300000), ([], 300000))) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe (([Int], Int), ([Int], Int))

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), id) answer = do
    ((a1, l1), (a2, l2)) <- answer
    if (r < l1) && not (null a2 && r < l2) then
        return ((id : a1, l), (a2, l2))
    else
        if r < l2 then
            Just ((a1, l1), (id : a2, l))
        else
            Nothing

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sort $ zip segments [1..]
    ((a1, l1), (a2, l2)) <- foldr' foldAnswer (Just (([], 300000), ([], 300000))) sortedSegments
    return . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe (([Int], Int), ([Int], Int))

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), id) answer = do
    ((a1, l1), (a2, l2)) <- answer
    if (r < l1) && not (null a2 && r < l2) then
        return ((id : a1, l), (a2, l2))
    else
        if r < l2 then
            Just ((a1, l1), (id : a2, l))
        else
            Nothing

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sort $ zip segments [1..]
    ((a1, l1), (a2, l2)) <- foldr' foldAnswer (Just (([], 300000), ([], 300000))) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe (([Int], Int), ([Int], Int))

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), id) answer = do
    ((a1, l1), (a2, l2)) <- answer
    if r < l2 then
        if l < l1 then
            return ((id : a2, l), (a1, l1))
        else
            return ((a1, l1), (id : a2, l))
    else
        Nothing

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sort $ zip segments [1..]
    ((a1, l1), (a2, l2)) <- foldr' foldAnswer (Just (([], 300000), ([], 300000))) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

type Answer = Maybe ([Int], [Int], Int)

foldAnswer :: ((Int, Int), Int) -> Answer -> Answer
foldAnswer ((l, r), i) answer = do
    (a1, a2, ll) <- answer
    if r < ll then
        return (i : a2, a1, l)
    else
        return (i : a1, a2, l)

solve :: [(Int, Int)] -> Maybe [Int]
solve segments = do
    let sortedSegments = sortBy (compare `on` (\((x, y), z) -> ((y, x), z))) $ zip segments [1..]
    (a1, a2, ll) <- foldr' foldAnswer (Just ([], [], 400000)) sortedSegments
    if null a1 || null a2 then
        Nothing
    else
        Just . map snd . sort $ (zip a1 (repeat 1) ++ zip a2 (repeat 2))

main :: IO ()
main = do
    testCount <- readInt <$> getLine
    replicateM_ testCount $ do
        n <- readInt <$> getLine
        segments <- replicateM n $ ((\[l, r] -> (l, r)) . map readInt . words) <$> getLine
        let answer = fromMaybe [-1] $ solve segments
        forM_ answer $ printf "%d "
        printf "\n"

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

check range = go range 0 -- l
    where go [] _ = -1
          go (([l, r], k):[]) x = if x < l then k else -1
          go (([l,r], k):([nl,nr], k2):s) x
            | l > x && r < nl = k
            | otherwise = go (([nl,nr],k2):s) (max x r)

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` (head . fst)) (zip range [1..])
    let k = check sorted
    if k == -1 then print k else printInts $ map (\x -> if x == k then 2 else 1) [1..q]

main = do
    [t] <- getInts
    mapM_ solve [1..t]

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

make range = go range 0 0 -- l, r 각각 오른쪽 끝 유지
    where go [] _ _ = []
          go ([l, r]:ls) x y
            | l > max x y = if x > y then 1:go ls r y else 2:go ls x r
            | l > x = 1: go ls r y
            | l > y = 2: go ls x r
            | otherwise = []

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` head) range
    let groups = make sorted
    let groups' = if all (\x -> x == 2) groups then 1:tail groups else groups
    if length groups' < q then print (-1) else printInts groups'

main = do
    [t] <- getInts
    mapM_ solve [1..t]

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

make range = go range 0 0 -- l, r 각각 오른쪽 끝 유지
    where go [] _ _ = []
          go (([l, r], k):ls) x y
            | l > max x y = if x > y then (k, 1):go ls r y else (k, 2):go ls x r
            | l > x = (k, 1): go ls r y
            | l > y = (k, 2): go ls x r
            | otherwise = []

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` (head . fst)) (zip range [1..])
    let groups = make sorted
    let groups' = if all (\(a, b) -> b == 2) groups then (fst $ head groups, 1):tail groups else groups
    let sorted' = sortBy (compare `on` fst) groups'
    if length groups' < q then print (-1) else printInts (map snd sorted')

main = do
    [t] <- getInts
    mapM_ solve [1..t]

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

make range = go range 0 0 -- l, r 각각 오른쪽 끝 유지
    where go [] _ _ = []
          go ([l, r]:ls) x y
            | l > x = 1:go ls r y
            | l > y = 2: go ls x r
            | otherwise = []

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` head) range
    let groups = make sorted
    let groups' = if all (\x -> x == 1) groups then 2:tail groups else groups
    if length groups' < q then print (-1) else printInts groups'

main = do
    [t] <- getInts
    mapM_ solve [1..t]

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix, on)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

make range = go range 0 0 -- l, r 각각 오른쪽 끝 유지
    where go [] _ _ = []
          go ([l, r]:ls) x y
            | l > max x y = if x > y then 1:go ls r y else 2:go ls x r
            | l > x = 1: go ls r y
            | l > y = 2: go ls x r
            | otherwise = []

solve _ = do
    [q] <- getInts
    range <- forM [1..q] (\_ -> getInts)
    let sorted = sortBy (compare `on` head) range
    let groups = make sorted
    let groups' = if all (\x -> x == 1) groups then 2:tail groups else groups
    if length groups' < q then print (-1) else printInts groups'

main = do
    [t] <- getInts
    mapM_ solve [1..t]


This is an hard version of the problem. The only difference between an easy and a hard version is the constraints on $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$.You are given $$$4$$$ positive integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$ with $$$a < c$$$ and $$$b < d$$$. Find any pair of numbers $$$x$$$ and $$$y$$$ that satisfies the following conditions: $$$a < x \leq c$$$, $$$b < y \leq d$$$, $$$x \cdot y$$$ is divisible by $$$a \cdot b$$$.Note that required $$$x$$$ and $$$y$$$ may not exist.

The first line of the input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10$$$), the number of test cases. The descriptions of the test cases follow. The only line of each test case contains four integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$ ($$$1 \leq a < c \leq 10^9$$$, $$$1 \leq b < d \leq 10^9$$$).

For each test case print a pair of numbers $$$a < x \leq c$$$ and $$$b < y \leq d$$$ such that $$$x \cdot y$$$ is divisible by $$$a \cdot b$$$. If there are multiple answers, print any of them. If there is no such pair of numbers, then print -1 -1.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

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

{- solution -}

compositeFactors :: Int64 -> [Int64]
compositeFactors n = L.map L.head . L.group . L.sort $ compositeFactors'
    where
        compositeFactors' = L.concat $ do
            d <- [1 .. ceiling . sqrt $ fromIntegral n]
            M.guard $ n `mod` d == 0
            return $ [d, n `div` d]

solve :: (Int64, Int64) -> (Int64, Int64) -> Maybe (Int64, Int64)
solve (a, c) (b, d) = listToMaybe $ do
    let aFactors = compositeFactors a
    let bFactors = compositeFactors b
    aFactor <- aFactors
    bFactor <- bFactors
    let factor = aFactor * bFactor
    -- tracingM "factor" factor
    let xDiv = factor
        yDiv = a * b `div` xDiv
    let x = (a `div` xDiv + 1) * xDiv
        y = (b `div` yDiv + 1) * yDiv
    M.guard $ a < x && x <= c
    M.guard $ b < y && y <= d
    M.guard $ (x * y) `mod` (a * b) == 0
    return $ (x, y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [a, b, c, d] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let (x, y) = fromMaybe (-1, -1) $ solve (a, c) (b, d)
        printf "%lld %lld\n" x y

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

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

{- solution -}

primeFactors :: Int64 -> [Int64]
primeFactors n = L.concat . flip MS.evalStateT n $ do
    d :: Int64 <- MT.lift [2 .. ceiling . sqrt $ fromIntegral n]
    n <- MS.get
    let dPowers = L.iterate (* d) d
        ndPower = takeWhile (\dPower -> n `mod` dPower == 0) dPowers
        nPower = L.length ndPower

    M.guard $ nPower > 0
    let dPower = L.last ndPower
    MS.modify $ (`div` dPower)
    return $ L.replicate nPower d

compositeFactors :: [Int64] -> [Int64]
compositeFactors ps = compositeFactors' pGroups
    where
        pGroups = L.map (\group -> (L.head group, L.length group)) . L.group . L.filter (/= 1) $ L.sort ps

        compositeFactors' [] = [1]
        compositeFactors' pGroups@(pGroup:otherPGroups) = do
            factor <- compositeFactors' otherPGroups
            let (p, cnt) = pGroup
            pPower <- L.take (cnt + 1) (L.iterate (*p) 1)
            return $ factor * pPower

solve :: (Int64, Int64) -> (Int64, Int64) -> Maybe (Int64, Int64)
solve (a, c) (b, d) = listToMaybe $ do
    let aPrimeFactors = primeFactors a
    let bPrimeFactors = primeFactors b
    factor <- compositeFactors (aPrimeFactors ++ bPrimeFactors)
    let xDiv = factor
        yDiv = a * b `div` xDiv
    let x = (a `div` xDiv + 1) * xDiv
        y = (b `div` yDiv + 1) * yDiv
    M.guard $ a < x && x <= c
    M.guard $ b < y && y <= d
    M.guard $ (x * y) `mod` (a * b) == 0
    return $ (x, y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [a, b, c, d] <- B8.getLine <&> readIntegerB8s <&> map fromIntegral
        let (x, y) = fromMaybe (-1, -1) $ solve (a, c) (b, d)
        printf "%lld %lld\n" x y


There is a grid with $$$n$$$ rows and $$$m$$$ columns. Some cells are colored black, and the rest of the cells are colored white.In one operation, you can select some black cell and do exactly one of the following:   color all cells in its row black, or  color all cells in its column black. You are given two integers $$$r$$$ and $$$c$$$. Find the minimum number of operations required to make the cell in row $$$r$$$ and column $$$c$$$ black, or determine that it is impossible.

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 four integers $$$n$$$, $$$m$$$, $$$r$$$, and $$$c$$$ ($$$1 \leq n, m \leq 50$$$; $$$1 \leq r \leq n$$$; $$$1 \leq c \leq m$$$) — the number of rows and the number of columns in the grid, and the row and column of the cell you need to turn black, respectively. Then $$$n$$$ lines follow, each containing $$$m$$$ characters. Each of these characters is either 'B' or 'W' — a black and a white cell, respectively.

For each test case, if it is impossible to make the cell in row $$$r$$$ and column $$$c$$$ black, output $$$-1$$$.  Otherwise, output a single integer — the minimum number of operations required to make the cell in row $$$r$$$ and column $$$c$$$ black.

9

3 5 1 4

WBWWW

BBBWB

WWBBB

4 3 2 1

BWW

BBW

WBB

WWB

2 3 2 2

WWW

WWW

2 2 1 1

WW

WB

5 9 5 9

WWWWWWWWW

WBWBWBBBW

WBBBWWBWW

WBWBWBBBW

WWWWWWWWW

1 1 1 1

B

1 1 1 1

W

1 2 1 1

WB

2 1 1 1

W

B

NoteThe first test case is pictured below.  We can take the black cell in row $$$1$$$ and column $$$2$$$, and make all cells in its row black. Therefore, the cell in row $$$1$$$ and column $$$4$$$ will become black.  In the second test case, the cell in row $$$2$$$ and column $$$1$$$ is already black.In the third test case, it is impossible to make the cell in row $$$2$$$ and column $$$2$$$ black.The fourth test case is pictured below.  We can take the black cell in row $$$2$$$ and column $$$2$$$ and make its column black.   Then, we can take the black cell in row $$$1$$$ and column $$$2$$$ and make its row black.   Therefore, the cell in row $$$1$$$ and column $$$1$$$ will become black.

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  diff -sdu -- <(cat -- input.txt | ./a.out) output.txt  &&  cat -- bw.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

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

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

    t <- readLn
    tcs <- replicateM t readTC

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

readTC = do
    [n,_m, r,c] <- map read . words <$> getLine
    rows <- replicateM n getLine
    return (rows, r-1, c-1)

solve (rows, r, c) = x
  where
    row =           rows !! r
    col = transpose rows !! c

    rowChars  = toBlacks row
    colChars  = toBlacks col
    matrChars = toBlacks (concat rows)

    x = case (row!!c, rowChars, colChars, matrChars) of
        ('B',  _ ,  _ ,  _ ) ->  0
        ('W', "B",  _ ,  _ ) ->  1
        ('W',  _ , "B",  _ ) ->  1
        ('W',  _ ,  _ , "B") ->  2
        ('W',  _ ,  _ , "" ) -> -1
        _                    -> error "logic error"

toBlacks = nub . sort . filter (== 'B')

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  diff -sdu -- <(cat -- input.txt | ./a.out) output.txt)

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  diff -sdu -- <(cat -- input.txt | ./a.out) output.txt)

-- cat -- bw.hs | xclip -selection clipboard

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

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

    t <- readLn
    tcs <- replicateM t readTC

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

readTC = do
    [n,_m, r,c] <- map read . words <$> getLine
    rows <- replicateM n getLine
    return (rows, r-1, c-1)

solve (rows, r, c) = x
  where
    row =           rows !! r
    col = transpose rows !! c

    rowChars  = toBlacks row
    colChars  = toBlacks col
    matrChars = toBlacks (concat rows)

    x = case (row!!c, rowChars, colChars, matrChars) of
        ('B',  _ ,  _ ,  _ ) ->  0
        ('W', "B",  _ ,  _ ) ->  1
        ('W',  _ , "B",  _ ) ->  1
        ('W',  _ ,  _ , "B") ->  2
        ('W',  _ ,  _ , "" ) -> -1
        _                    -> error "logic error"

toBlacks = nub . sort . filter (== 'B')

{-# LANGUAGE TupleSections #-}
import Data.Array
import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

readInput :: IO (Int, Int, Int, Int, Array (Int, Int) Bool)
readInput = map read . words <$> getLine >>=
            \a -> case a of
                    [n, m, r, c] -> (n,m,r,c,) . toA n m . map (=='W') .
                                    concat <$> replicateM n getLine
                    _ -> error $ "Could not read an array: " ++ show (a)
  where
    toA n m = listArray ((1, 1), (n, m))

singleCase :: IO ()
singleCase = readInput >>= print . f
  where
    f (n,m,r,c,a)  | (not $ a!(r,c))    = 0
                   | (blackView a r c)  = 1
                   | (blackCount a > 0) = 2
                   | otherwise          = -1

blackView :: Array (Int, Int) Bool -> Int -> Int -> Bool
blackView a r c = any (\i -> not (a!i))
                  $ zip (repeat r) [1..m] ++ zip [1..n] (repeat c)
  where ((1, 1), (n, m)) = bounds a

blackCount :: Array (Int, Int) Bool -> Int
blackCount = foldl (\acc b -> if b then acc else acc+1) 0

{-# LANGUAGE MultiWayIf #-}

import Control.Monad

test :: IO ()
test = do
  [n, _, r', c'] <- (<$>) read . words <$> getLine
  let (r, c) = (pred r', pred c')
  grid <- replicateM n getLine
  print
    ( if
          | (all . all) (== 'W') grid -> -1
          | grid !! r !! c == 'B' -> 0
          | any (== 'B') (grid !! r) || any (== 'B') ((!! c) <$> grid) -> 1
          | otherwise -> 2
    )
  return ()

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


A boy Petya loves chess very much. He even came up with a chess piece of his own, a semiknight. The semiknight can move in any of these four directions: 2 squares forward and 2 squares to the right, 2 squares forward and 2 squares to the left, 2 squares backward and 2 to the right and 2 squares backward and 2 to the left. Naturally, the semiknight cannot move beyond the limits of the chessboard.Petya put two semiknights on a standard chessboard. Petya simultaneously moves with both semiknights. The squares are rather large, so after some move the semiknights can meet, that is, they can end up in the same square. After the meeting the semiknights can move on, so it is possible that they meet again. Petya wonders if there is such sequence of moves when the semiknights meet. Petya considers some squares bad. That is, they do not suit for the meeting. The semiknights can move through these squares but their meetings in these squares don't count.Petya prepared multiple chess boards. Help Petya find out whether the semiknights can meet on some good square for each board.Please see the test case analysis.

The first line contains number t (1 ≤ t ≤ 50) — the number of boards. Each board is described by a matrix of characters, consisting of 8 rows and 8 columns. The matrix consists of characters ".", "#", "K", representing an empty good square, a bad square and the semiknight's position, correspondingly. It is guaranteed that matrix contains exactly 2 semiknights. The semiknight's squares are considered good for the meeting. The tests are separated by empty line.

For each test, print on a single line the answer to the problem: "YES", if the semiknights can meet and "NO" otherwise.

NoteConsider the first board from the sample. We will assume the rows and columns of the matrix to be numbered 1 through 8 from top to bottom and from left to right, correspondingly. The knights can meet, for example, in square (2, 7). The semiknight from square (4, 1) goes to square (2, 3) and the semiknight goes from square (8, 1) to square (6, 3). Then both semiknights go to (4, 5) but this square is bad, so they move together to square (2, 7).On the second board the semiknights will never meet.

{-# 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 = B.readInt >>> fmap fst >>> fromMaybe 0
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 . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    n <- readLn
    forM_ [1..n] $ \i -> do
        l <- replicateM 8 getLine
        putStrLn $ if solve l then "YES" else "NO"
        when ( i < n ) (void getLine)

solve :: [String] -> Bool
solve l = any (check bads) $ zip l1 l2
    where
    as = zip (range ((1,1),(8,8))) (concat l)
    [k1,k2] = [ p | (p,'K') <- as ]
    bads = S.fromList [ p | (p,'#') <- as ]
    l1 = calcFP step (S.empty,S.singleton k1)
    l2 = calcFP step (S.empty,S.singleton k2)

type Pos = (Int,Int)
check :: S.Set Pos -> ((S.Set Pos,S.Set Pos),(S.Set Pos,S.Set Pos))-> Bool
check bads ((a,b),(c,d)) = sub a b || sub b d
    where
    sub x y = not $ S.null (S.intersection x y S.\\ bads)

next (i,j) = (\dx dy -> (i+dx,j+dy)) <$> [-2,2] <*> [-2,2]

step (s1,s2) = (s3,s4)
    where
    f s = S.fromList $ do
        p <- S.elems s >>= next
        guard (inRange ((1,1),(8,8)) p)
        return p
    s3 = f s2
    s4 = f s3

calcFP f p = p:go p
    where
    go p = let p' = f p in if p' == p then [] else p':go p'

import Control.Monad (liftM)
import Data.Array ((!), indices, listArray)

n :: Num a => a
n  =  8

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

solve :: [[String]] -> [Bool]
solve  =  map (solve' . toArray)
  where
    toArray  =  listArray ((1, 1), (n, n)) . concat
    solve' array
        =  abs (x1 - x2) `mod` 4 == 0
        && abs (y1 - y2) `mod` 4 == 0
      where
        [(x1, y1), (x2, y2)]  =
            [ij | ij <- indices array, array ! ij == 'K']

intoGroups :: Int -> [a] -> [[a]]
intoGroups _ []  =  []
intoGroups n xs  =  take n xs : intoGroups n (drop n xs)

main :: IO ()
main  =  liftM (intoGroups n . tail . words) getContents
    >>= return . solve
    >>= mapM_ (putStrLn . ("YES" <?> "NO"))


Everybody knows that the $$$m$$$-coder Tournament will happen soon. $$$m$$$ schools participate in the tournament, and only one student from each school participates.There are a total of $$$n$$$ students in those schools. Before the tournament, all students put their names and the names of their schools into the Technogoblet of Fire. After that, Technogoblet selects the strongest student from each school to participate. Arkady is a hacker who wants to have $$$k$$$ Chosen Ones selected by the Technogoblet. Unfortunately, not all of them are the strongest in their schools, but Arkady can make up some new school names and replace some names from Technogoblet with those. You can't use each made-up name more than once. In that case, Technogoblet would select the strongest student in those made-up schools too.You know the power of each student and schools they study in. Calculate the minimal number of schools Arkady has to make up so that $$$k$$$ Chosen Ones would be selected by the Technogoblet.

The first line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$1 \le n \le 100$$$, $$$1 \le m, k \le n$$$) — the total number of students, the number of schools and the number of the Chosen Ones. The second line contains $$$n$$$ different integers $$$p_1, p_2, \ldots, p_n$$$ ($$$1 \le p_i \le n$$$), where $$$p_i$$$ denotes the power of $$$i$$$-th student. The bigger the power, the stronger the student. The third line contains $$$n$$$ integers $$$s_1, s_2, \ldots, s_n$$$ ($$$1 \le s_i \le m$$$), where $$$s_i$$$ denotes the school the $$$i$$$-th student goes to. At least one student studies in each of the schools.  The fourth line contains $$$k$$$ different integers $$$c_1, c_2, \ldots, c_k$$$ ($$$1 \le c_i \le n$$$)  — the id's of the Chosen Ones.

Output a single integer  — the minimal number of schools to be made up by Arkady so that $$$k$$$ Chosen Ones would be selected by the Technogoblet.

NoteIn the first example there's just a single Chosen One with id $$$3$$$. His power is equal to $$$3$$$, but in the same school $$$1$$$, there's a student with id $$$5$$$ and power $$$6$$$, and that means inaction would not lead to the latter being chosen. If we, however, make up a new school (let its id be $$$4$$$) for the Chosen One, Technogoblet would select students with ids $$$2$$$ (strongest in $$$3$$$), $$$5$$$ (strongest in $$$1$$$), $$$6$$$ (strongest in $$$2$$$) and $$$3$$$ (strongest in $$$4$$$).In the second example, you can change the school of student $$$3$$$ to the made-up $$$5$$$ and the school of student $$$4$$$ to the made-up $$$6$$$. It will cause the Technogoblet to choose students $$$8$$$, $$$7$$$, $$$6$$$, $$$5$$$, $$$3$$$ and $$$4$$$.

{-
Problem statement in Japanese:

トーナメントが開催される.
m校の学校が参加し各校から1人参加できる.

全ての学校合わせて学生はn人である.
トーナメント前に全ての学生は氏名と学校名をTechnoに提出する.
続いてTechnoは各校から最も強い学生を参加者として選ぶ.

Arkadyは特定のk人が選ばれるようにしたい.
残念ながら, その学生達は自身の学校で最も強いとは限らない.
しかし, Arkadyは学校名を追加し, 学生の学校名を追加したものに書き換えることができる.
なお, 追加した学校名を使い回すことはできない.

あなたは各学生の強さと学校名を知っている.
特定のk人が選ばれるために必要となる, 学校名を追加する最小回数を求めよ.
-}

main = do
  [_, _, _] <- map read . words <$> getLine :: IO [Int]
  as <- map read . words <$> getLine :: IO [Int]
  ps <- map read . words <$> getLine :: IO [Int]
  qs <- map read . words <$> getLine :: IO [Int]
  let xs = zip as ps
  print $ sum $ map (f xs) qs

f xs q = if a < m then 1 else 0
  where
    m = maximum $ map fst $ filter ((== p) . snd) xs
    (a, p) = xs !! (q - 1)

{-# 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
import Data.Char

main :: IO ()
main = do
  [n,m,k] <- map readInt . words <$> getLine
  powers <- A.listArray (1,n) . map readInt . words <$> getLine
             :: IO (UArray Int Int)
  school <- A.listArray (1,n) . map readInt . words <$> getLine
             :: IO (UArray Int Int)
  chosen <- map readInt . words <$> getLine
  print
    $ length
    $ [ i
      | i <- chosen,
        (> powers A.! i) $ maximum
        $ map (powers A.!) $ map fst
        $ filter ((== school A.! i) . snd) $ A.assocs school]

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


The main road in Bytecity is a straight line from south to north. Conveniently, there are coordinates measured in meters from the southernmost building in north direction.At some points on the road there are n friends, and i-th of them is standing at the point xi meters and can move with any speed no greater than vi meters per second in any of the two directions along the road: south or north.You are to compute the minimum time needed to gather all the n friends at some point on the road. Note that the point they meet at doesn't need to have integer coordinate.

The first line contains single integer n (2 ≤ n ≤ 60 000) — the number of friends. The second line contains n integers x1, x2, ..., xn (1 ≤ xi ≤ 109) — the current coordinates of the friends, in meters. The third line contains n integers v1, v2, ..., vn (1 ≤ vi ≤ 109) — the maximum speeds of the friends, in meters per second.

Print the minimum time (in seconds) needed for all the n friends to meet at some point on the road.  Your answer will be considered correct, if its absolute or relative error isn't greater than 10 - 6. Formally, let your answer be a, while jury's answer be b. Your answer will be considered correct if  holds.

NoteIn the first sample, all friends can gather at the point 5 within 2 seconds. In order to achieve this, the first friend should go south all the time at his maximum speed, while the second and the third friends should go north at their maximum speeds.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

test x v t = maximum la <= minimum lb where
    (la, lb) = unzip $ zipWith (\a b -> (a - t * b, a + t * b)) x v

bin x v a b | b - a < 1E-6           = b
            | test x v ((a + b) / 2) = bin x v a ((a + b) / 2)
            | otherwise              = bin x v ((a + b) / 2) b

main = do
    (read -> n) <- getLine
    (take n . map (read :: String -> Double) . words -> x) <- getLine
    (take n . map (read :: String -> Double) . words -> v) <- getLine
    let tm = (maximum x - minimum x) * maximum v
    putStrLn $ show $ bin x v 0.0 tm

-- Codeforces Round #403 (Div. 2)
-- B. The Meeting Place Cannot Be Changed
-- http://codeforces.com/contest/782/problem/B

import Control.Monad
import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

main = do
    n <- getInt
    coords <- (map fromIntegral) `fmap` getInts :: IO [Double]
    speeds <- (map fromIntegral) `fmap` getInts :: IO [Double]
    let (lb, ub) = recurse coords speeds (0.0, 1e9) 100
    let answer = (lb + ub) / 2.0
    print answer

recurse _ _ result 0 = result
recurse coords speeds (lb, ub) cnt
    | canMeet coords speeds mid = recurse coords speeds (lb, mid) (cnt-1)
    | otherwise = recurse coords speeds (mid, ub) (cnt-1)
    where mid = (lb + ub) / 2.0

canMeet :: [Double] -> [Double] -> Double -> Bool
canMeet coords speeds t = isJust $ foldl getOverlap (Just (0.0, 1e9)) ranges where
    ranges = zipWith (\coord speed -> (coord - speed * t, coord + speed * t)) coords speeds

getOverlap Nothing _ = Nothing
getOverlap (Just (l1, r1)) (l2, r2)
    | l > r = Nothing
    | otherwise = Just (l, r)
    where
        l = max l1 l2
        r = min r1 r2

{-# LANGUAGE BangPatterns #-}

import Data.List

main :: IO ()
main = do
  readLine
  xs <- readLine
  vs <- readLine
  print $ search 0 1e9 $ sortBy (\(a, _) (b, _) -> a `compare` b) (zip xs vs)
    where
      search :: Double -> Double -> [(Double, Double)] -> Double
      search t1 t2 xvs
        | abs (t1-t2) <= 1e-6 = t2
        | otherwise = if valid mid then search t1 mid xvs else search mid t2 xvs
        where
          mid = (t1+t2)/2

          valid :: Double -> Bool
          valid t = loop xvs (x0+v0*t)
            where
              (x0, v0) = head xvs

              loop [] _ = True
              loop ((curX, curV):rem) rightMost =
                if (curX - t*curV) <= rightMost then loop rem (min (curX + t*curV) rightMost)
                                                else False

readLine :: IO [Double]
readLine = getLine >>= return . words >>= return . (map read)

{-# LANGUAGE BangPatterns #-}

import Data.List

main :: IO ()
main = do
  readLine
  xs <- readLine
  vs <- readLine
  print $ search 0 1e9 $ sortBy (\(a, _) (b, _) -> a `compare` b) (zip xs vs)
    where
      search :: Double -> Double -> [(Double, Double)] -> Double
      search t1 t2 xvs
        | abs (t1-t2) <= 1e-6 = t2
        | otherwise = if valid mid then search t1 mid xvs else search mid t2 xvs
        where
          mid = (t1+t2)/2

          valid :: Double -> Bool
          valid t = loop (tail xvs) (x0+v0*t)
            where
              (x0, v0) = head xvs

              loop [] _ = True
              loop ((curX, curV):rem) rightMost =
                if (curX - t*curV) <= rightMost then loop rem (min (curX + t*curV) rightMost)
                                                else False

readLine :: IO [Double]
readLine = getLine >>= return . words >>= return . (map read)