During the research on properties of the greatest common divisor (GCD) of a set of numbers, Ildar, a famous mathematician, introduced a brand new concept of the weakened common divisor (WCD) of a list of pairs of integers.For a given list of pairs of integers $$$(a_1, b_1)$$$, $$$(a_2, b_2)$$$, ..., $$$(a_n, b_n)$$$ their WCD is arbitrary integer greater than $$$1$$$, such that it divides at least one element in each pair. WCD may not exist for some lists.For example, if the list looks like $$$[(12, 15), (25, 18), (10, 24)]$$$, then their WCD can be equal to $$$2$$$, $$$3$$$, $$$5$$$ or $$$6$$$ (each of these numbers is strictly greater than $$$1$$$ and divides at least one number in each pair).You're currently pursuing your PhD degree under Ildar's mentorship, and that's why this problem was delegated to you. Your task is to calculate WCD efficiently.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 150\,000$$$) — the number of pairs. Each of the next $$$n$$$ lines contains two integer values $$$a_i$$$, $$$b_i$$$ ($$$2 \le a_i, b_i \le 2 \cdot 10^9$$$).

Print a single integer — the WCD of the set of pairs.  If there are multiple possible answers, output any; if there is no answer, print $$$-1$$$.

NoteIn the first example the answer is $$$6$$$ since it divides $$$18$$$ from the first pair, $$$24$$$ from the second and $$$12$$$ from the third ones. Note that other valid answers will also be accepted.In the second example there are no integers greater than $$$1$$$ satisfying the conditions.In the third example one of the possible answers is $$$5$$$. Note that, for example, $$$15$$$ is also allowed, but it's not necessary to maximize the output.

import Data.List
import Data.Int
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents

    let mapped = map (map (read :: (String -> Int64)) . words) contents
        res = foldl (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd res <$> head mapped
        ans = max a b
    print $ if ans == 1 then -1 else ans

import Data.List
import Data.Int
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents

    let mapped = map (map (read :: (String -> Int64)) . words) contents
        res = foldl' (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd res <$> head mapped
        ans = max a b
    print $ if ans == 1 then -1 else ans

import Data.List
import Data.Int
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents

    let mapped = map (map (read :: (String -> Int64)) . words) contents
        res = foldr (\[a, b] y -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd res <$> head mapped
        ans = max a b
    print $ if ans == 1 then -1 else ans

import Data.List
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    let mapped =  map (map (read :: (String -> Int)) . words) contents
        res = foldl' (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd (factor res) <$> head mapped
        ans = max a b
    print (if ans == 1 then -1 else ans)

import Data.List
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    let mapped =  map (map (read :: (String -> Int)) . words) contents
        res = foldr (\[a, b] y -> gcd y (a * b)) 0 mapped
        g = factor res
        ([a, b]) = factor . gcd g <$> head mapped
        ans = max a b
    print (if ans == 1 then -1 else ans)

import Data.List
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    let mapped =  map (map (read :: (String -> Int)) . words) contents
        res = foldr (\[a, b] y -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd (factor res) <$> head mapped
        ans = max a b
    print (if ans == 1 then -1 else ans)

import Data.List
import Data.Int
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    -- hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    print "Here"
    let mapped = map (map (read :: (String -> Int64)) . words) contents
        res = foldl' (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd (factor res) <$> head mapped
        ans = max a b
    print (if ans == 1 then -1 else ans)

import Data.List
import Data.Int
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    -- hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    -- print "Here"
    let mapped = map (map (read :: (String -> Int64)) . words) contents
        res = foldl (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd res <$> head mapped
        ans = max a b
    print ans

import Data.List
import Data.Array
import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- drop 1 . lines <$> getContents
    let mapped =  map (map (read :: (String -> Int)) . words) contents
        res = foldl (\y [a, b] -> gcd y (a * b)) 0 mapped
        [a, b] = factor . gcd (factor res) <$> head mapped
        ans = max a b
    print (if ans == 1 then -1 else ans)


Oleg writes down the history of the days he lived. For each day he decides if it was good or bad. Oleg calls a non-empty sequence of days a zebra, if it starts with a bad day, ends with a bad day, and good and bad days are alternating in it. Let us denote bad days as 0 and good days as 1. Then, for example, sequences of days 0, 010, 01010 are zebras, while sequences 1, 0110, 0101 are not.Oleg tells you the story of days he lived in chronological order in form of string consisting of 0 and 1. Now you are interested if it is possible to divide Oleg's life history into several subsequences, each of which is a zebra, and the way it can be done. Each day must belong to exactly one of the subsequences. For each of the subsequences, days forming it must be ordered chronologically. Note that subsequence does not have to be a group of consecutive days.

In the only line of input data there is a non-empty string s consisting of characters 0 and 1, which describes the history of Oleg's life. Its length (denoted as |s|) does not exceed 200 000 characters.

If there is a way to divide history into zebra subsequences, in the first line of output you should print an integer k (1 ≤ k ≤ |s|), the resulting number of subsequences. In the i-th of following k lines first print the integer li (1 ≤ li ≤ |s|), which is the length of the i-th subsequence, and then li indices of days forming the subsequence. Indices must follow in ascending order. Days are numbered starting from 1. Each index from 1 to n must belong to exactly one subsequence. If there is no way to divide day history into zebra subsequences, print -1. Subsequences may be printed in any order. If there are several solutions, you may print any of them. You do not have to minimize nor maximize the value of k.

import Control.Monad
import Data.List

main = do
  inp <- getLine
  let (ans, bns) = genPairs inp
  if not (null bns)
  then print (-1)
  else do
    let l = length ans
    let sans = (map . map) show ans
    print l
    forM_ sans $ \s -> do
         putStr (show (length s) ++ " ")
         putStrLn . unwords . reverse $ s

-- completeted, not
genPairs :: String -> ([[Int]],[[Int]])
genPairs = maybe ([], [[1]]) id . foldl g (Just ([], [])) . zip [1..]
    where
      g :: Maybe ([[Int]], [[Int]]) -> (Int, Char) -> Maybe ([[Int]], [[Int]])
      g m x = m >>= flip f x
      f :: ([[Int]], [[Int]]) -> (Int, Char) -> Maybe ([[Int]], [[Int]])
      f (ha:a, b) (ix, '1') = Just (a, (ix:ha):b)
      f (a, hb:b) (ix, '0') = Just ((ix:hb):a, b)
      f ([], b)   (ix, '1') = Nothing
      f (a, [])   (ix, '0') = Just ([ix]:a, [])

import Control.Monad (foldM)

main :: IO ()
main = do
  n <- getLine

  case foldM f ([], []) (zip n [1..]) of
    Just (zs, []) -> do
      print (length zs)
      mapM_ (\xs -> putStrLn (unwords $ map show $ length xs : reverse xs)) zs
    _ -> print (-1)

f :: ([[Int]], [[Int]]) -> (Char, Int) -> Maybe ([[Int]], [[Int]])
f (zs, [])   ('0', i) = Just ([i] : zs, [])
f (zs, o:os) ('0', i) = Just ((i : o) : zs, os)
f (z:zs, os) ('1', i) = Just (zs, (i : z) : os)
f _ _ = Nothing

import Control.Monad
import Data.List

main = do
  inp <- getLine
  let (ans, bns) = genPairs inp
  if not (null bns)
  then print (-1)
  else do
    let l = length ans
    let sans = (map . map) show ans
    print l
    forM_ sans $ \s -> do
         putStr (show (length s) ++ " ")
         putStrLn . unwords . reverse $ s

-- completeted, not
genPairs :: String -> ([[Int]],[[Int]])
genPairs = foldl f ([], []) . zip [1..]
    where
      f :: ([[Int]], [[Int]]) -> (Int, Char) -> ([[Int]], [[Int]])
      f (ha:a, b) (ix, '1') = (a, (ix:ha):b)
      f (a, hb:b) (ix, '0') = ((ix:hb):a, b)
      f ([], b)   (ix, '1') = ([], [ix]:b)
      f (a, [])   (ix, '0') = ([ix]:a, [])

import Control.Monad
import Data.List

main = do
  inp <- getLine
  let (ans, bns) = genPairs inp
  print ans
  if not (null bns)
  then print (-1)
  else do
    let l = length ans
    let sans = (map . map) show ans
    print l
    forM_ sans $ \s -> do
         putStrLn . unwords . reverse $ s

-- completeted, not
genPairs :: String -> ([[Int]],[[Int]])
genPairs = foldl f ([], []) . zip [1..]
    where
      f :: ([[Int]], [[Int]]) -> (Int, Char) -> ([[Int]], [[Int]])
      f (ha:a, b) (ix, '1') = (a, (ix:ha):b)
      f (a, hb:b) (ix, '0') = ((ix:hb):a, b)
      f ([], b)   (ix, '1') = ([], [ix]:b)
      f (a, [])   (ix, '0') = ([ix]:a, [])

import Control.Monad
import Data.List

main = do
  inp <- getLine
  let (ans, bns) = genPairs inp
  if not (null bns)
  then print (-1)
  else do
    let l = length ans
    let sans = (map . map) show ans
    print l
    forM_ sans $ \s -> do
         putStrLn . unwords . reverse $ s

-- completeted, not
genPairs :: String -> ([[Int]],[[Int]])
genPairs = foldl f ([], []) . zip [1..]
    where
      f :: ([[Int]], [[Int]]) -> (Int, Char) -> ([[Int]], [[Int]])
      f (ha:a, b) (ix, '1') = (a, (ix:ha):b)
      f (a, hb:b) (ix, '0') = ((ix:hb):a, b)
      f ([], b)   (ix, '1') = ([], [ix]:b)
      f (a, [])   (ix, '0') = ([ix]:a, [])


Vivek has encountered a problem. He has a maze that can be represented as an $$$n \times m$$$ grid. Each of the grid cells may represent the following:  Empty — '.'  Wall — '#'  Good person  — 'G'  Bad person — 'B' The only escape from the maze is at cell $$$(n, m)$$$.A person can move to a cell only if it shares a side with their current cell and does not contain a wall. Vivek wants to block some of the empty cells by replacing them with walls in such a way, that all the good people are able to escape, while none of the bad people are able to. A cell that initially contains 'G' or 'B' cannot be blocked and can be travelled through.Help him determine if there exists a way to replace some (zero or more) empty cells with walls to satisfy the above conditions.It is guaranteed that the cell $$$(n,m)$$$ is empty. Vivek can also block this cell.

The first line contains one integer $$$t$$$ $$$(1 \le t \le 100)$$$ — the number of test cases. The description of the test cases follows. The first line of each test case contains two integers $$$n$$$, $$$m$$$ $$$(1 \le n, m \le 50)$$$ — the number of rows and columns in the maze. Each of the next $$$n$$$ lines contain $$$m$$$ characters. They describe the layout of the maze. If a character on a line equals '.', the corresponding cell is empty. If it equals '#', the cell has a wall. 'G' corresponds to a good person and 'B' corresponds to a bad person.

For each test case, print "Yes" if there exists a way to replace some empty cells with walls to satisfy the given conditions. Otherwise print "No" You may print every letter in any case (upper or lower).

NoteFor the first and second test cases, all conditions are already satisfied.For the third test case, there is only one empty cell $$$(2,2)$$$, and if it is replaced with a wall then the good person at $$$(1,2)$$$ will not be able to escape.For the fourth test case, the good person at $$$(1,1)$$$ cannot escape.For the fifth test case, Vivek can block the cells $$$(2,3)$$$ and $$$(2,2)$$$.For the last test case, Vivek can block the destination cell $$$(2, 2)$$$.

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

import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
import Data.Set as S hiding (elems, filter)

type Lab = UArray (Int, Int) Char

type Walk = ReaderT Lab (State (Set (Int, Int)))

neighbors, neighbors' :: (Int, Int) -> [(Int, Int)]
neighbors (x, y) = [(x + 1, y), (x, y + 1), (x - 1, y), (x, y - 1)]
neighbors' p = p : neighbors p

go :: (Int, Int) -> Walk Int
go p = do
  lab <- ask
  seen <- get
  let good = lab ! p == 'G'
      stop = not (bounds lab `inRange` p) || member p seen || lab ! p == '#'
  if stop
    then return 0
    else do
      modify' $ insert p
      res <- mapM go $ neighbors p
      return $ sum res + fromEnum good

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    [n, m] <- getInts
    lines <- replicateM n BS.getLine
    let lab = listArray @UArray ((1, 1), (n, m)) $ lines >>= filter (`elem` "#.GB"). BS.unpack
        blacklist = fmap (,'#') . filter (inRange $ bounds lab) . (neighbors' =<<) . fmap fst . filter ((==) 'B' . snd) $ assocs lab
        lab' = lab // blacklist
        goods = length $ filter ((==) 'G') $ elems lab
        found =  go (n, m) `runReaderT` lab' `evalState` empty
        ok = goods == 0 || found == goods
    putStrLn $ if ok then "Yes" else "No"

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

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

import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
import Data.Set as S hiding (elems, filter)

type Lab = UArray (Int, Int) Char

type Walk = ReaderT Lab (State (Set (Int, Int)))

neighbors, neighbors' :: (Int, Int) -> [(Int, Int)]
neighbors (x, y) = [(x + 1, y), (x, y + 1), (x - 1, y), (x, y - 1)]
neighbors' p = p : neighbors p

go :: (Int, Int) -> Walk Int
go p = do
  lab <- ask
  seen <- get
  let good = lab ! p == 'G'
      stop = not (bounds lab `inRange` p) || member p seen || lab ! p == '#'
  if stop
    then return 0
    else do
      modify' $ insert p
      res <- mapM go $ neighbors p
      return $ sum res + fromEnum good

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    [n, m] <- getInts
    lines <- replicateM n BS.getLine
    let lab = listArray @UArray ((1, 1), (n, m)) $ lines >>= BS.unpack
        blacklist = fmap (,'#') . filter (inRange $ bounds lab) . (neighbors' =<<) . fmap fst . filter ((==) 'B' . snd) $ assocs lab
        lab' = lab // blacklist
        goods = length $ filter ((==) 'G') $ elems lab
        found = evalState (runReaderT (go (n, m)) lab') empty
        ok = goods == 0 || found == goods
    putStrLn $ if ok then "Yes" else "No"

getInts :: IO [Int]
getInts = go <$> BS.getLine

  where
    go s = case BS.readInt s of
      Nothing -> []
      Just (x, s') -> x : go (BS.drop 1 s')

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

import Control.Monad
import Control.Monad.Reader
import Control.Monad.State
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as BS
import Data.Set as S hiding (elems, filter)

type Lab = UArray (Int, Int) Char

type Walk = ReaderT Lab (State (Set (Int, Int)))

neighbors, neighbors' :: (Int, Int) -> [(Int, Int)]
neighbors (x, y) = [(x + 1, y), (x, y + 1), (x - 1, y), (x, y - 1)]
neighbors' p = p : neighbors p

go :: (Int, Int) -> Walk Int
go p = do
  lab <- ask
  seen <- get
  let good = lab ! p == 'G'
      stop = not (bounds lab `inRange` p) || member p seen || lab ! p == '#'
  if stop
    then return 0
    else do
      modify' $ insert p
      res <- mapM go $ neighbors p
      return $ sum res + fromEnum good

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t do
    [n, m] <- getInts
    lines <- replicateM n BS.getLine
    let lab = listArray @UArray ((1, 1), (n, m)) $ lines >>= BS.unpack
        blacklist = fmap (,'#') . filter (inRange $ bounds lab) . (neighbors' =<<) . fmap fst . filter ((==) 'B' . snd) $ assocs lab
        lab' = lab // blacklist
        goods = length $ filter ((==) 'G') $ elems lab
        found =  go (n, m) `runReaderT` lab' `evalState` empty
        ok = goods == 0 || found == goods
    putStrLn $ if ok then "Yes" else "No"

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


You are given an array $$$a$$$ consisting of $$$n$$$ positive integers.You are allowed to perform this operation any number of times (possibly, zero):   choose an index $$$i$$$ ($$$2 \le i \le n$$$), and change $$$a_i$$$ to $$$a_i - a_{i-1}$$$. Is it possible to make $$$a_i=0$$$ for all $$$2\le i\le n$$$?

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 100$$$)  — the number of test cases. The description of the test cases follows. The first line contains one integer $$$n$$$ ($$$2 \le n \le 100$$$) — the length of array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$1 \le a_i \le 10^9$$$).

For each test case, print "YES" (without quotes), if it is possible to change $$$a_i$$$ to $$$0$$$ for all $$$2 \le i \le n$$$, and "NO" (without quotes) otherwise. You can print letters in any case (upper or lower).

NoteIn the first test case, the initial array is $$$[5,10]$$$. You can perform $$$2$$$ operations to reach the goal:  Choose $$$i=2$$$, and the array becomes $$$[5,5]$$$.  Choose $$$i=2$$$, and the array becomes $$$[5,0]$$$. In the second test case, the initial array is $$$[1,2,3]$$$. You can perform $$$4$$$ operations to reach the goal:   Choose $$$i=3$$$, and the array becomes $$$[1,2,1]$$$.  Choose $$$i=2$$$, and the array becomes $$$[1,1,1]$$$.  Choose $$$i=3$$$, and the array becomes $$$[1,1,0]$$$.  Choose $$$i=2$$$, and the array becomes $$$[1,0,0]$$$. In the third test case, you can choose indices in the order $$$4$$$, $$$3$$$, $$$2$$$.

import Debug.Trace

test (x:xs) = x : map ( `mod` x ) xs

rec a = if (test a)== a then a else test a

is_zero (x:xs) = sum xs == 0

exec 0 = pure ()
exec t = do
	n <- read <$> getLine :: IO Int
	a <- (map read . words) <$> getLine :: IO [Integer]

	putStr $ if is_zero (rec  a) then "YES" else "NO"
	putStr "\n"

	exec (t-1)

main = do
	t <- read <$> getLine :: IO Int
	exec t

solve :: IO ()
solve =         readInt <$> getLine >>= \ n     ->
    map readInt . words <$> getLine >>= \(x:xs) ->
        putStrLn $ if all (\i -> i `mod` x == 0) xs then "YES" else "NO"

main :: IO ()
main =
    let f 0 = return ()
        f t = solve >> f (t - 1)
    in readInt <$> getLine >>= f

readInt :: String -> Int
readInt = read

solve :: IO ()
solve =         readInt <$> getLine >>= \ n     ->
    map readInt . words <$> getLine >>= \(x:xs) ->
        putStrLn . (\v -> if v then "YES" else "NO") $
            all (\i -> i `mod` x == 0) xs

main :: IO ()
main =
    let f 0 = return ()
        f t = solve >> f (t - 1)
    in readInt <$> getLine >>= f

readInt :: String -> Int
readInt = read

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

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

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

solve xs = all isConvertible . tail $ xs
  where
    p = head xs
    isConvertible x = (x >= p && x `mod` p == 0)

import Debug.Trace
diff n e a = [a!!i | i<-[0..e-1] ] ++ [ if a!!e - a!!(e-1) >= 0 then  a!!e - a!!(e-1) else a!!e] ++ [a!!i | i<-[e+1..n-1] ]

-- test _ _ a | trace ("\t" ++ show a ) False = undefined
test _ 0 a = a
test n e a = test  n (e-1) $ diff n e a

rec n a = if (t n a)== a then a else test n (n-1) $ t n a
	where
		t n a = test n (n-1) a

is_zero (x:xs) = sum xs == 0

exec 0 = pure ()
exec t = do
	n <- read <$> getLine :: IO Int
	a <- (map read . words) <$> getLine :: IO [Integer]

	putStr $ if is_zero (rec n  a) then "YES" else "NO"
	putStr "\n"

	exec (t-1)

main = do
	t <- read <$> getLine :: IO Int
	exec t

import Debug.Trace
diff n e a = [a!!i | i<-[0..e-1] ] ++ [ if a!!e - a!!(e-1) >= 0 then  a!!e - a!!(e-1) else a!!e] ++ [a!!i | i<-[e+1..n-1] ]

-- test _ _ a | trace ("\t" ++ show a ) False = undefined
test _ 0 a = a
test n e a = test  n (e-1) $ diff n e a

rec n a = if (t n a)== a then a else test n (n-1) $ t n a
	where
		t n a = test n (n-1) a

is_zero (x:xs) = sum xs == 0

exec 0 = pure ()
exec t = do
	n <- read <$> getLine :: IO Int
	a <- (map read . words) <$> getLine :: IO [Int]

	putStr $ if is_zero (rec n  a) then "YES" else "NO"
	putStr "\n"

	exec (t-1)

main = do
	t <- read <$> getLine :: IO Int
	exec t


Let's call a permutation $$$p$$$ of length $$$n$$$ anti-Fibonacci if the condition $$$p_{i-2} + p_{i-1} \ne p_i$$$ holds for all $$$i$$$ ($$$3 \le i \le n$$$). Recall that the permutation is the array of length $$$n$$$ which contains each integer from $$$1$$$ to $$$n$$$ exactly once.Your task is for a given number $$$n$$$ print $$$n$$$ distinct anti-Fibonacci permutations of length $$$n$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 48$$$) — the number of test cases.  The single line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 50$$$).

For each test case, print $$$n$$$ lines. Each line should contain an anti-Fibonacci permutation of length $$$n$$$. In each test case, you cannot print any permutation more than once. If there are multiple answers, print any of them. It can be shown that it is always possible to find $$$n$$$ different anti-Fibonacci permutations of size $$$n$$$ under the constraints of the problem.

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

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

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

type InType  = Int
type OutType = [[Int]]

solve :: InType -> OutType
solve n = [go i n | i <- [0 .. n - 1]]
  where go i n = concat [[n - z + 1 | z <- [1 .. i]],
                         [1],
                         [n - z + 1 | z <- [i + 1 .. n - 1]]
                        ]

receive :: [String] -> InType
receive [x] = read x :: Int
receive _   = error "input error"

main :: IO ()
main = interact $ unlines . map (unlines . map showArr . solve . receive) . chunksOf 1 . tail . lines

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    mapM_ (putStrLn . unwords . map show)
        [p ++ [1] ++ s | let r = [n,n-1..2], (p, s) <- zip (inits r) (tails r)]

main :: IO ()
main = flip replicateM_ solve =<< readLn

-- problem: https://codeforces.com/contest/1644/problem/B
-- origin: https://codeforces.com/contest/1644/submission/147286507

import Control.Monad.State (State, evalState, replicateM, state)
import Data.Bifunctor (Bifunctor (first))
import Data.Char (isDigit, isSpace)
import Data.List (permutations)

isOk :: [Int] -> Bool
isOk li@(a : b : c) = and $ zipWith3 (\x y z -> x + y /= z) li (b : c) c
isOk _ = error "Wrong"

getInt :: State [Char] Int
getInt = state (first (\x -> read x :: Int) . span isDigit . dropWhile isSpace)

putInts :: [Int] -> [Char]
putInts [] = "\n"
putInts (x : xs) = show x ++ concatMap (\y -> ' ' : show y) xs ++ "\n"

mainFunc :: State [Char] [[Char]]
mainFunc = do
  t <- getInt
  replicateM t $ do
    n <- getInt
    let ans = filter isOk $ permutations [1 .. n]
        ans' = take n ans -- accelerate calculating
    pure $ concatMap putInts ans'

main :: IO ()
main = do
  inp <- getContents
  putStr $ concat $ evalState mainFunc inp

import Control.Monad (forM_)
import Data.List (permutations)

antifib :: [Int] -> Bool
antifib [] = True
antifib [_] = True
antifib [a, b] = True
antifib (a : b : c : cs) = (a + b) /= c && antifib (b : c : cs)

solve :: Int -> [[Int]]
solve n = take n $ filter antifib $ permutations [1 .. n]

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        putStr $ unlines $ map (unwords . map show) (solve n)

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

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

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    let
      isOK li = and
        $ zipWith3 (\x y z -> x + y /= z) li (tail li) (tail $ tail li)
      ans = take n $ filter isOK $ permutations [1..n]
    pure $ foldMap putInts ans

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

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

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

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

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

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

type InType  = Int
type OutType = [[Int]]

solve :: InType -> OutType
solve n = [n .. 1] : [go i n | i <- [0 .. n - 2]]
  where go i n = concat [[n - z | z <- [0 .. i]],
                         [1],
                         [n - z | z <- [i + 1 .. n - 2]]
                        ]

receive :: [String] -> InType
receive [x] = read x :: Int
receive _   = error "input error"

main :: IO ()
main = interact $ unlines . map (showAnswer . solve . receive) . chunksOf 1 . tail . lines
  where showAnswer :: OutType -> String
        showAnswer [] = ""
        showAnswer (v : vs) = concat [concatMap (\x -> show x ++ " ") v, "\n", showAnswer vs]

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    mapM_ (putStrLn . unwords . map show) $ case n of
        1 -> [[1]]
        2 -> [[1, 2], [2, 1]]
        _ -> [[n,n-1..1], [n,n-1..3] ++ [1,2]] ++
             [[1, 3] ++ p ++ [2] ++ s | let r = [4..n], (p, s) <- zip (inits r) (tails r)]

main :: IO ()
main = flip replicateM_ solve =<< readLn


Bob is a farmer. He has a large pasture with many sheep. Recently, he has lost some of them due to wolf attacks. He thus decided to place some shepherd dogs in such a way that all his sheep are protected.The pasture is a rectangle consisting of R × C cells. Each cell is either empty, contains a sheep, a wolf or a dog. Sheep and dogs always stay in place, but wolves can roam freely around the pasture, by repeatedly moving to the left, right, up or down to a neighboring cell. When a wolf enters a cell with a sheep, it consumes it. However, no wolf can enter a cell with a dog.Initially there are no dogs. Place dogs onto the pasture in such a way that no wolf can reach any sheep, or determine that it is impossible. Note that since you have many dogs, you do not need to minimize their number.

First line contains two integers R (1 ≤ R ≤ 500) and C (1 ≤ C ≤ 500), denoting the number of rows and the numbers of columns respectively. Each of the following R lines is a string consisting of exactly C characters, representing one row of the pasture. Here, 'S' means a sheep, 'W' a wolf and '.' an empty cell.

If it is impossible to protect all sheep, output a single line with the word "No". Otherwise, output a line with the word "Yes". Then print R lines, representing the pasture after placing dogs. Again, 'S' means a sheep, 'W' a wolf, 'D' is a dog and '.' an empty space. You are not allowed to move, remove or add a sheep or a wolf. If there are multiple solutions, you may print any of them. You don't have to minimize the number of dogs.

NoteIn the first example, we can split the pasture into two halves, one containing wolves and one containing sheep. Note that the sheep at (2,1) is safe, as wolves cannot move diagonally.In the second example, there are no empty spots to put dogs that would guard the lone sheep.In the third example, there are no wolves, so the task is very easy. We put a dog in the center to observe the peacefulness of the meadow, but the solution would be correct even without him.

import Data.List

main = getContents >>= putStr . solve . preProcess

preProcess = tail . lines . map (\x -> if x == '.' then 'D' else x)

solve a
    | exam a && exam (transpose a) = unlines $ "Yes" : a
    | otherwise = "No\n"
    where exam = all isSafe
          isSafe [] = True
          isSafe ('W':'S':xs) = False
          isSafe ('S':'W':xs) = False
          isSafe (x:xs) = isSafe xs

import Data.List

main = getContents >>= putStr . solve . preProcess

preProcess = tail . lines . map (\x -> if x == '.' then 'D' else x)
solve a
    | exam a && exam (transpose a) = unlines $ "Yes" : a
    | otherwise = "No\n"
    where exam = all (\xs -> not (isInfixOf "WS" xs || isInfixOf "SW" xs))

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

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

main = interact solve

solve input
    | not possible = "No\n"
    | otherwise = "Yes\n" ++ (printTable r c solutionTable) ++ "\n"
    where
        asWords = words input
        rs:cs:tableWords = asWords
        c = read cs :: Int
        r = read rs :: Int
        table = parseTable r c tableWords
        solutionTable = makeSolutionTable table
        possible = M.getAll . mconcat $ map idxCan (A.indices table)
        idxCan :: (Int, Int) -> M.All
        idxCan idx = M.All $ (not isWolf) || (not hasSheepNeighbour)
            where
                curChar = table A.! idx
                isWolf = curChar == 'W'
                nextidx :: [(Int,Int)]
                nextidx = [(1,0),(-1,0),(0,1),(0,-1)]
                (cR,cC) = idx
                hasSheepNeighbour = M.getAny . mconcat $ anyB
                    where
                        okIdx :: [(Int,Int)]
                        okIdx = filter (A.inRange $ A.bounds table) . map (\(r,c) -> (r+cR, c+cC)) $ nextidx
                        anyB :: [M.Any]
                        anyB = map (\cidx -> M.Any $ ((table A.! cidx) == 'S')) okIdx

printTable :: Int -> Int -> A.Array (Int,Int) Char -> String
printTable r c table = intercalate "\n" . map printRow $ [0..(r-1)]
    where
        printRow :: Int -> String
        printRow rowNum = map (\cc -> table A.! (rowNum, cc)) [0..(c-1)]

parseTable :: Int -> Int -> [String] -> A.Array (Int,Int) Char
parseTable r c tableWords = A.array ((0,0), (r-1,c-1)) indexList
    where
        indexList = convertWordsToIndexList 0 tableWords

convertWordsToIndexList :: Int -> [String] -> [((Int, Int), Char)]
convertWordsToIndexList _ [] = []
convertWordsToIndexList curRow wordsList = (drop 1 $ convertRow row) ++ (convertWordsToIndexList (curRow + 1) next)
    where
        row:next = wordsList
        convertRow = scanl scanner ((curRow, -1), ' ') :: String -> [((Int, Int), Char)]
        scanner :: ((Int, Int), Char) -> Char -> ((Int, Int), Char)
        scanner cidx curChar = ((curRow,curCol+1), curChar)
            where
                ((_,curCol),_) = cidx :: ((Int, Int), Char)

makeSolutionTable :: A.Array (Int,Int) Char -> A.Array (Int,Int) Char
makeSolutionTable sourceTable = A.array (A.bounds sourceTable) mappedList
    where
        indices = A.indices sourceTable
        mappedList = map mapNewIdx indices
        mapNewIdx idx
            | isDot && hasNeighbourWolf = (idx, 'D')
            | otherwise = (idx, curChar)
            where
                curChar = sourceTable A.! idx
                isDot = curChar == '.'
                (cR, cC) = idx
                hasNeighbourWolf = M.getAny . mconcat $ anyB
                    where
                        nextidx = [(1,0),(-1,0),(0,1),(0,-1)]
                        okIdx = filter (A.inRange $ A.bounds sourceTable) . map (\(r,c) -> (r+cR, c+cC)) $ nextidx
                        anyB = map (\cidx -> M.Any $ ((sourceTable A.! cidx) == 'W')) okIdx

{-# LANGUAGE LambdaCase #-}
import Data.List
main = interact exec
exec = (\(_:_:m) -> if all ok m && all ok (transpose m) then "Yes\n" ++ unlines (map (map (\case { '.' -> 'D'; x -> x })) m) else "No") . words
ok xs = not $ any (\case {('W', 'S') -> True; ('S', 'W') -> True; _ -> False; }) $ zip xs (tail xs)


The only difference between the easy and the hard version is the limit to the number of queries.This is an interactive problem.There is an array $$$a$$$ of $$$n$$$ different numbers. In one query you can ask the position of the second maximum element in a subsegment $$$a[l..r]$$$. Find the position of the maximum element in the array in no more than 40 queries.A subsegment $$$a[l..r]$$$ is all the elements $$$a_l, a_{l + 1}, ..., a_r$$$. After asking this subsegment you will be given the position of the second maximum from this subsegment in the whole array.

The first line contains a single integer $$$n$$$ $$$(2 \leq n \leq 10^5)$$$ — the number of elements in the array.

NoteIn the sample suppose $$$a$$$ is $$$[5, 1, 4, 2, 3]$$$. So after asking the $$$[1..5]$$$ subsegment $$$4$$$ is second to max value, and it's position is $$$3$$$. After asking the $$$[4..5]$$$ subsegment $$$2$$$ is second to max value and it's position in the whole array is $$$4$$$.Note that there are other arrays $$$a$$$ that would produce the same interaction, and the answer for them might be different. Example output is given in purpose of understanding the interaction.

{-# LANGUAGE BlockArguments, MultiWayIf #-}

import System.IO

solve iask n = iask 1 n >>= go 1 n
  where
    go l r lrmax
      | l == r     = pure l
      | l == r - 1 = pure if lrmax == l then r else l
      | otherwise  = do
          let
            m = (l + r) `div` 2
          lmmax <- iask l m
          mrmax <- iask m r
          if
            | lrmax == lmmax -> go l m lmmax
            | lrmax == mrmax -> go m r mrmax
            | lrmax > m -> go l m lmmax
            | lrmax < m -> go m r mrmax
            | otherwise -> undefined

main = do
  n <- readLn
  let
    iask l r = putStrLn ("? " <> show l <> " " <> show r) >> hFlush stdout >> readLn
  solve iask n >>= putStrLn . ("! " <>) . show

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

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

------

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

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

------

getInt = fst . fromJust . B.readInt . dropCR <$> B.getLine

ask l r = do
  B.putStrLn $ B.unwords ["?", bshow (l + 1), bshow r]
  hFlush stdout
  (subtract 1) <$> getInt

answer i = do
  B.putStrLn $ B.unwords ["!", bshow (i + 1)]
  hFlush stdout

main = do
  n <- getInt
  p <- ask 0 n
  let r = sortOn (\(i, j) -> i - j) $
          filter (\(i, j) -> i /= j) [(0, p), (p + 1, n)]
  case r of
    [(i, j)] -> go p i j
    [(i, j), (k, l)]
      | i < p -> do q <- ask i (p + 1)
                    if p == q
                      then go p i j
                      else go p k l
      | otherwise -> do q <- ask p j
                        if p == q
                          then go p i j
                          else go p k l

go p i j | i < p = lgo i j p
         | otherwise = rgo p i j

lgo i j p | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask k (p + 1)
                             if p == q
                               then lgo k j p
                               else lgo i k p

rgo p i j | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask p k
                             if p == q
                               then rgo p i k
                               else rgo p k j

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

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

boolInt :: Bool -> Int
boolInt p = if  p  then  1  else  0

query :: Int -> Int -> SIO Int
query li ri = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (B.char7 '?' : map B.intDec [li, ri])
  in  do
  lift $ B.hPutBuilder stdout outBuilder >> hFlush stdout
  [response] <- readInts
  pure response

go :: Int -> Int -> Int -> SIO Int
go v li ri = let
  mi = div (li + ri) 2
  in  if  li + boolInt (elem v [li, ri]) == ri
  then  pure $ if  v == li
    then  ri
    else  li
  else  if  v < li
  then  do
    resp <- query v mi
    if  resp == v
      then  go v li mi
      else  go v (mi+1) ri
  else  if  ri < v
  then  do
    resp <- query (mi+1) v
    if  resp == v
      then  go v (mi+1) ri
      else  go v li mi
  else  do
  let
    innermi = mi + boolInt (v <= mi) - boolInt (even $ ri - li)
    lower = v <= innermi
  resp <- if  lower  then  query li innermi  else  query (innermi+1) ri
  if  (resp == v) == lower
    then  go v li innermi
    else  go v (innermi+1) ri

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  sndMin <- query 1 n
  ans <- go sndMin 1 n
  lift $ B.hPutBuilder stdout
    $ B.char7 '!' <> B.char7 ' ' <> B.intDec ans <> B.char7 '\n'

type SIO = StateT P.ByteString IO

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

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

{-# LANGUAGE BlockArguments, TypeApplications, MultiWayIf #-}

{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad
import Data.Foldable
import System.IO

main :: IO ()
main = do
  n <- line1 @Int
  let
    go l r lrmax
      | l == r     = ianswer [l]
      | l == r - 1 = ianswer [if lrmax == l then r else l]
      | otherwise  = do
          let
            m = (l + r) `div` 2
          lmmax <- iask1 [l, m]
          mrmax <- iask1 [m, r]
          if
            | lrmax == lmmax -> go l m lmmax
            | lrmax == mrmax -> go m r mrmax
            | lrmax > m -> go l m lrmax
            | lrmax < m -> go m r mrmax
  i <- iask1 [1, n]
  go 1 n i

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

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

line1 :: Read a => IO a
line1 = readLn

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

iask :: (Read b, Show a) => [a] -> IO [b]
iask l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line

iask1 :: (Read b, Show a) => [a] -> IO b
iask1 l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line1

ianswer :: Show a => [a] -> IO ()
ianswer l = putStrLn ("! " <> unwords (fmap show l)) <> hFlush stdout

{-# LANGUAGE BlockArguments, TypeApplications, MultiWayIf #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad
import Data.Foldable
import System.IO

main :: IO ()
main = do
  n <- line1
  let
    go l r lrmax
      | l == r     = ianswer [l]
      | l == r - 1 = ianswer [if lrmax == l then r else l]
      | otherwise  = do
          let
            m = (l + r) `div` 2
            m' = if l == r - 2 then m else m + 1
          lmmax <- iask1 [l, m]
          mrmax <- iask1 [m', r]
          if
            | lrmax == lmmax -> go l m lmmax
            | lrmax == mrmax -> go m' r mrmax
            | lrmax > m -> go l m lrmax
            | otherwise -> go m' r mrmax
  i <- iask1 [1, n]
  go 1 n i

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

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

line1 :: Read a => IO a
line1 = readLn

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

iask :: (Read b, Show a) => [a] -> IO [b]
iask l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line

iask1 :: (Read b, Show a) => [a] -> IO b
iask1 l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line1

ianswer :: Show a => [a] -> IO ()
ianswer l = putStrLn ("! " <> unwords (fmap show l)) <> hFlush stdout

{-# LANGUAGE BlockArguments, TypeApplications, MultiWayIf #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad
import Data.Foldable
import System.IO

main :: IO ()
main = do
  n <- line1 @Int
  let
    go l r lrmax
      | l == r     = ianswer [l]
      | l == r - 1 = ianswer [if lrmax == l then r else l]
      | otherwise  = do
          let
            m = (l + r) `div` 2
          lmmax <- iask1 [l, m]
          mrmax <- iask1 [m, r]
          if
            | lrmax == lmmax -> go l m lmmax
            | lrmax == mrmax -> go m r mrmax
            | lrmax > m -> go l m lrmax
            | otherwise -> go m r mrmax
  i <- iask1 @Int [1, n]
  go 1 n i

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

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

line1 :: Read a => IO a
line1 = readLn

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

iask :: (Read b, Show a) => [a] -> IO [b]
iask l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line

iask1 :: (Read b, Show a) => [a] -> IO b
iask1 l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line1

ianswer :: Show a => [a] -> IO ()
ianswer l = putStrLn ("! " <> unwords (fmap show l)) <> hFlush stdout

{-# LANGUAGE BlockArguments, TypeApplications, MultiWayIf #-}
{-# OPTIONS_GHC -O2 #-}

module Main ( main ) where

import Control.Monad
import Data.Foldable
import System.IO

main :: IO ()
main = do
  n <- line1 @Int
  let
    go l r lrmax
      | l == r     = ianswer [l]
      | l == r - 1 = ianswer [if lrmax == l then r else l]
      | otherwise  = do
          let
            m = (l + r) `div` 2
          lmmax <- iask1 [l, m]
          mrmax <- iask1 [m, r]
          if
            | lrmax == lmmax -> go l m lmmax
            | lrmax == mrmax -> go m r mrmax
            | lrmax >= m -> go l m lrmax
            | otherwise  -> go m r mrmax
  i <- iask1 @Int [1, n]
  go 1 n i

-- lib

nCases :: IO a -> IO ()
nCases m = do
  n <- readLn
  replicateM_ n m

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

line1 :: Read a => IO a
line1 = readLn

putBool :: Bool -> IO ()
putBool b = putStr if b then "Yes" else "No"

putBoolLn :: Bool -> IO ()
putBoolLn b = putStrLn if b then "Yes" else "No"

iask :: (Read b, Show a) => [a] -> IO [b]
iask l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line

iask1 :: (Read b, Show a) => [a] -> IO b
iask1 l = putStrLn ("? " <> unwords (fmap show l)) >> hFlush stdout >> line1

ianswer :: Show a => [a] -> IO ()
ianswer l = putStrLn ("! " <> unwords (fmap show l)) <> hFlush stdout

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

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

------

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

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

------

getInt = fst . fromJust . B.readInt . dropCR <$> B.getLine

ask l r = do
  B.putStrLn $ B.unwords ["?", bshow (l + 1), bshow r]
  hFlush stdout
  (subtract 1) <$> getInt

answer i = do
  B.putStrLn $ B.unwords ["!", bshow (i + 1)]
  hFlush stdout

main = do
  n <- getInt
  p <- ask 0 n
  let r = sortOn (\(i, j) -> i - j) $
          filter (\(i, j) -> i /= j) [(0, p), (p + 1, n)]
  case r of
    [(i, j)] -> go p i j
    [(i, j), (k, l)]
      | i < p -> do q <- ask i (p + 1)
                    if p == q
                      then go p i j
                      else go p k l
      | otherwise -> do q <- ask p l
                        if p == q
                          then go p k l
                          else go p i j

go p i j | i < p = lgo i j p
         | otherwise = rgo p i j

lgo i j p | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask k (p + 1)
                             if p == q
                               then lgo k j p
                               else lgo i k p

rgo p i j | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask p k
                             if p == q
                               then rgo p i k
                               else rgo p k j


User ainta loves to play with cards. He has a cards containing letter "o" and b cards containing letter "x". He arranges the cards in a row, and calculates the score of the deck by the formula below.  At first, the score is 0.  For each block of contiguous "o"s with length x the score increases by x2.  For each block of contiguous "x"s with length y the score decreases by y2.   For example, if a = 6, b = 3 and ainta have arranged the cards in the order, that is described by string "ooxoooxxo", the score of the deck equals 22 - 12 + 32 - 22 + 12 = 9. That is because the deck has 5 blocks in total: "oo", "x", "ooo", "xx", "o".User ainta likes big numbers, so he wants to maximize the score with the given cards. Help ainta make the score as big as possible. Note, that he has to arrange all his cards.

The first line contains two space-separated integers a and b (0 ≤ a, b ≤ 105; a + b ≥ 1) — the number of "o" cards and the number of "x" cards.

In the first line print a single integer v — the maximum score that ainta can obtain. In the second line print a + b characters describing the deck. If the k-th card of the deck contains "o", the k-th character must be "o". If the k-th card of the deck contains "x", the k-th character must be "x". The number of "o" characters must be equal to a, and the number of "x " characters must be equal to b. If there are many ways to maximize v, print any. Please, do not write the %lld specifier to read or write 64-bit integers in С++. It is preferred to use the cin, cout streams or the %I64d specifier.

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (intersperse,maximumBy)
import Data.Ord (comparing)
import Data.Int
import Debug.Trace (trace)

sq x = x'*x'
  where x' = fromIntegral x

-- return the score for a value of k when a >= b
kscore :: Int -> Int -> Int -> Int64
kscore a b k =
  let (q,r) = b `divMod` (k+2)
      n1    = fromIntegral (k+2-r)
      n2    = fromIntegral r
  in sq (a-k) + (fromIntegral k) - n1 * (sq q) - n2 * (sq (q+1))

-- determine the best k when a >= b >= 2
bestk :: Int -> Int -> Int
bestk a b = go 0 (minimum [a-1,b-2])
  where
    -- go lo hi | trace msg False = undefined
    --  where msg = "=== go " ++ show lo ++ " " ++ show hi
    go lo hi | lo+5 >= hi = maximumBy (comparing (kscore a b)) [lo..hi]
    go lo hi =
      let m = (lo+hi) `div` 2
          s0 = kscore a b m
          s1 = kscore a b (m+1)
      in if s0 < s1 then go m hi else go lo m

data Solution = Seq Int Int Int | Split Int Int Int
  deriving (Show)

solve :: Int -> Int -> Solution
solve 0 b = Seq b 0 0
solve a 0 = Seq 0 a 0
solve a 1 = Seq 1 a 0
solve a b =
  let sol1 = Split a b (bestk a b)
      sol2 = split2 a b
  in if score sol2 > score sol1 then sol2 else sol1

split2 a b = Seq q a (q+r)
  where (q,r) = b `divMod` 2

score :: Solution -> Int64
score (Seq b1 a b2) = sq a - sq b1 - sq b2
score (Split a b k) = s
  where
    (q,r)  = b `divMod` (k+2)
    n1     = k+2-r
    n2     = r
    s      = sq (a-k) + (fromIntegral k) - (fromIntegral n1) * (sq q) - (fromIntegral n2) * (sq (q+1))

repox n m = (BS.replicate n 'o') `BS.append` (BS.replicate m 'x')

repxox b1 a b2 = (BS.replicate b1 'x') `BS.append` repox a b2

rep :: [(Int,Int)] -> ByteString
rep pairs = BS.concat $ map (uncurry repox) pairs

xostr :: Solution -> ByteString
xostr (Seq b1 a b2) = repxox b1 a b2
xostr (Split a b k) =
  let (q,r) = b `divMod` (k+2)
      n1 = k+2-r
      n2 = r
      bsizes = replicate n1 q ++ replicate n2 (q+1)
      asizes = [0] ++ [a-k] ++ replicate k 1
  in rep (zip asizes bsizes)

(-->) = flip fmap

main = do
  (a:b:_) <- getLine --> words --> map read
  let sol = solve a b
  let scr = score sol
  let xos = xostr sol
  putStrLn $ show scr
  BS.putStrLn xos

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (intersperse,maximumBy)
import Data.Ord (comparing)
import Data.Int
import Debug.Trace (trace)

sq x = x'*x'
  where x' = fromIntegral x

-- return the score for a value of k when a >= b
kscore :: Int -> Int -> Int -> Int64
kscore a b k =
  let (q,r) = b `divMod` (k+2)
      n1    = fromIntegral (k+2-r)
      n2    = fromIntegral r
  in sq (a-k) + sq k - n1 * (sq q) - n2 * (sq (q+1))

-- determine the best k when a >= b >= 2
bestk :: Int -> Int -> Int
bestk a b = go 0 (minimum [a-1,b-2,hi])
  where
    hi = floor $ fromIntegral b / sqrt ((fromIntegral (2*a)) :: Double)
    go lo hi | lo+5 >= hi = maximumBy (comparing (kscore a b)) [lo..hi]
    go lo hi =
      let m = (lo+hi) `div` 2
          s0 = kscore a b m
          s1 = kscore a b (m+1)
      in if s0 < s1 then go m hi else go lo m

data Solution = Seq Int Int Int | Split Int Int Int
  deriving (Show)

solve :: Int -> Int -> Solution
solve 0 b = Seq b 0 0
solve a 0 = Seq 0 a 0
solve a 1 = Seq 1 a 0
solve a b =
  let sol1 = Split a b (bestk a b)
      sol2 = split2 a b
  in if score sol2 > score sol1 then sol2 else sol1

split2 a b = Seq q a (q+r)
  where (q,r) = b `divMod` 2

score :: Solution -> Int64
score (Seq b1 a b2) = sq a - sq b1 - sq b2
score (Split a b k) = s
  where
    (q,r)  = b `divMod` (k+2)
    n1     = k+2-r
    n2     = r
    s      = sq (a-k) + sq k - (fromIntegral n1) * (sq q) - (fromIntegral n2) * (sq (q+1))

repox n m = (BS.replicate n 'o') `BS.append` (BS.replicate m 'x')

repxox b1 a b2 = (BS.replicate b1 'x') `BS.append` repox a b2

rep :: [(Int,Int)] -> ByteString
rep pairs = BS.concat $ map (uncurry repox) pairs

xostr :: Solution -> ByteString
xostr (Seq b1 a b2) = repxox b1 a b2
xostr (Split a b k) =
  let (q,r) = b `divMod` (k+2)
      n1 = k+2-r
      n2 = r
      bsizes = replicate n1 q ++ replicate n2 (q+1)
      asizes = [0] ++ [a-k] ++ replicate k 1
  in rep (zip asizes bsizes)

(-->) = flip fmap

main = do
  (a:b:_) <- getLine --> words --> map read
  let sol = solve a b
  let scr = score sol
  let xos = xostr sol
  putStrLn $ show scr
  BS.putStrLn xos

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)

square x = x*x

solve :: Int -> Int -> (ByteString,Int)
solve a b
  | a >= b    = let str = (BS.replicate a 'o') `BS.append` (BS.replicate b 'x')
                    score = a*a - b*b
                in (str,score)
  | otherwise =
      let (q,r) = b `divMod` (a+1)
          sizes = replicate (a+1-r) q ++ replicate r (q+1)
          xs    = map (\n -> BS.replicate n 'x') sizes
          score = a - sum (map square sizes)
          str   = BS.intercalate (BS.pack ['o']) xs
      in (str,score)

(-->) = flip fmap

main = do
  (a:b:_) <- getLine --> words --> map read
  let (str,score) = solve a b
  putStrLn $ show score
  BS.putStrLn str

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (intersperse,maximumBy)
import Data.Ord (comparing)
import Data.Int
import Debug.Trace (trace)

sq x = x'*x'
  where x' = fromIntegral x

-- return the score for a value of k when a >= b
kscore :: Int -> Int -> Int -> Int64
kscore a b k =
  let (q,r) = b `divMod` (k+2)
      n1    = fromIntegral (k+2-r)
      n2    = fromIntegral r
  in sq (a-k) + (fromIntegral k) - n1 * (sq q) - n2 * (sq (q+1))

-- determine the best k when a >= b >= 2
bestk :: Int -> Int -> Int
bestk a b = go 0 (minimum [a-1,b-2,hi])
  where
    hi = floor $ fromIntegral b / sqrt ((fromIntegral (2*a)) :: Double)
    go lo hi | lo+5 >= hi = maximumBy (comparing (kscore a b)) [lo..hi]
    go lo hi =
      let m = (lo+hi) `div` 2
          s0 = kscore a b m
          s1 = kscore a b (m+1)
      in if s0 < s1 then go m hi else go lo m

data Solution = Seq Int Int Int | Split Int Int Int
  deriving (Show)

solve :: Int -> Int -> Solution
solve 0 b = Seq b 0 0
solve a 0 = Seq 0 a 0
solve a 1 = Seq 1 a 0
solve a b =
  let sol1 = Split a b (bestk a b)
      sol2 = split2 a b
  in if score sol2 > score sol1 then sol2 else sol1

split2 a b = Seq q a (q+r)
  where (q,r) = b `divMod` 2

score :: Solution -> Int64
score (Seq b1 a b2) = sq a - sq b1 - sq b2
score (Split a b k) = s
  where
    (q,r)  = b `divMod` (k+2)
    n1     = k+2-r
    n2     = r
    s      = sq (a-k) + (fromIntegral k) - (fromIntegral n1) * (sq q) - (fromIntegral n2) * (sq (q+1))

repox n m = (BS.replicate n 'o') `BS.append` (BS.replicate m 'x')

repxox b1 a b2 = (BS.replicate b1 'x') `BS.append` repox a b2

rep :: [(Int,Int)] -> ByteString
rep pairs = BS.concat $ map (uncurry repox) pairs

xostr :: Solution -> ByteString
xostr (Seq b1 a b2) = repxox b1 a b2
xostr (Split a b k) =
  let (q,r) = b `divMod` (k+2)
      n1 = k+2-r
      n2 = r
      bsizes = replicate n1 q ++ replicate n2 (q+1)
      asizes = [0] ++ [a-k] ++ replicate k 1
  in rep (zip asizes bsizes)

(-->) = flip fmap

main = do
  (a:b:_) <- getLine --> words --> map read
  let sol = solve a b
  let scr = score sol
  let xos = xostr sol
  putStrLn $ show scr
  BS.putStrLn xos

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (intersperse)
import Debug.Trace (trace)

square x = x*x

solve2 :: Int -> Int -> [Int]
solve2 a b
  | b == 0    = [a,0]
  | b == 1    = [a,1]
  | a >= b    = let (q,r) = b `divMod` 2
                in [0,q,a,q+r]
  | otherwise = let (q,r) = b `divMod` (a+1)
                    bs = replicate (a+1-r) q ++ replicate r (q+1)
                    sizes = intersperse 1 bs
                in [0] ++ sizes

solve' :: Int -> Int -> (ByteString,Int)
solve' a b = go 0 (BS.empty) (debug (solve2 a b))
  where
    debug result = result -- trace msg result
      where msg = "solve2: " ++ show a ++ " " ++ show b ++ " = " ++ show result
    go !score str []         = (str,score)
    go !score str (n:m:rest) = go score' str' rest
      where score' = score + n*n - m*m
            str'   = str `BS.append` (BS.replicate n 'o') `BS.append` (BS.replicate m 'x')

solve :: Int -> Int -> (ByteString,Int)
solve a b
  | b == 0    = (BS.replicate a 'o', a*a)
  | b == 1    = let str = BS.replicate a 'o' `BS.append` (BS.pack ['x'])
                in (str, a*a - 1)
  | a >= b    = let (q,r) = b `divMod` 2
                    sizes = [ q, q+r ]
                    strs  = map (\n -> BS.replicate n 'x') sizes
                    str   = (strs !! 0) `BS.append` (BS.replicate a 'o')
                                        `BS.append` (strs !! 1)
                    score = square a - sum (map square sizes)
                in (str,score)
  | otherwise =
      let (q,r) = b `divMod` (a+1)
          sizes = replicate (a+1-r) q ++ replicate r (q+1)
          xs    = map (\n -> BS.replicate n 'x') sizes
          score = a - sum (map square sizes)
          str   = BS.intercalate (BS.pack ['o']) xs
      in (str,score)

(-->) = flip fmap

main = do
  (a:b:_) <- getLine --> words --> map read
  let (str,score) = solve' a b
  putStrLn $ show score
  BS.putStrLn str


Given an integer $$$n$$$, find the maximum value of integer $$$k$$$ such that the following condition holds:  $$$n$$$ & ($$$n-1$$$) & ($$$n-2$$$) & ($$$n-3$$$) & ... ($$$k$$$) = $$$0$$$  where & denotes the bitwise AND operation.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 3 \cdot 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^9$$$).

For each test case, output a single integer — the required integer $$$k$$$.

NoteIn the first testcase, the maximum value for which the continuous & operation gives 0 value, is 1.In the second testcase, the maximum value for which the continuous & operation gives 0 value, is 3. No value greater then 3, say for example 4, will give the & sum 0.   $$$5 \, \& \, 4 \neq 0$$$,  $$$5 \, \& \, 4 \, \& \, 3 = 0$$$. Hence, 3 is the answer.

main = interact $ unlines . map (show . (\x -> 2^x - 1) . floor . logBase 2 . fromIntegral . read) . tail . lines

import Data.Bits
main = interact (unlines . map (\x -> show ((\y->2^y-1)(fn x 0))). tail . map g. lines) where g x = read x ::Int
  -- text <- readFile "inputt.txt"

fn :: Int -> Int -> Int
fn n acc = if ((==) n 1) then acc else fn (div n 2) ((+) acc 1)

module Main where
    f :: Int -> Int -> Int
    f 0 res = res
    f n res = f (n `div` 2) (res + 1)

    solve :: IO ()
    solve = do
        n <- getLine
        print $ 2 ^ ((f (read n :: Int) 0) - 1) - 1

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import Control.Monad

main = do
    t <- read <$> getLine
    replicateM_ t (getLine >>= print . pred . maxBit . read)

maxBit :: Int -> Int
maxBit 1 = 1
maxBit n = 2 * maxBit (quot n 2)

import Control.Arrow ((>>>))

main = interact $ words >>> drop 1 >>> map (read >>> solve >>> show) >>> unlines

solve :: Int -> Int
solve n = subtract 1 $ last $ takeWhile (<= n) $ iterate (* 2) 1

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

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

getInt :: IO Int
getInt = fmap parseInt C.getLine

main :: IO ()
main = do
  t <- getInt
  result <- fmap mconcat $ replicateM t $ do
    n <- getInt
    return $ intDec (bit (finiteBitSize n - 1 - countLeadingZeros n) - 1) `mappend` charUtf8 '\n'
  hPutBuilder stdout result


The Berland capital is shaken with three bold crimes committed by the Pihsters, a notorious criminal gang.The Berland capital's map is represented by an n × m rectangular table. Each cell of the table on the map represents some districts of the capital. The capital's main detective Polycarpus took a map and marked there the districts where the first three robberies had been committed as asterisks. Deduction tells Polycarpus that the fourth robbery will be committed in such district, that all four robbed districts will form the vertices of some rectangle, parallel to the sides of the map. Polycarpus is good at deduction but he's hopeless at math. So he asked you to find the district where the fourth robbery will be committed.

The first line contains two space-separated integers n and m (2 ≤ n, m ≤ 100) — the number of rows and columns in the table, correspondingly. Each of the next n lines contains m characters — the description of the capital's map. Each character can either be a "." (dot), or an "*" (asterisk). A character equals "*" if the corresponding district has been robbed. Otherwise, it equals ".". It is guaranteed that the map has exactly three characters "*" and we can always find the fourth district that meets the problem requirements.

Print two integers — the number of the row and the number of the column of the city district that is the fourth one to be robbed. The rows are numbered starting from one from top to bottom and the columns are numbered starting from one from left to right.

import Data.List
main=interact$f.drop 2.words
f s=g s++" "++g(transpose s)
g=show.(+1).head.findIndices((=="*").filter(=='*'))

import Data.List

main = putStrLn . solve . drop 2 . words =<< getContents
solve s = f s ++ " " ++ f (transpose s)
f = show . (+1) . head . elemIndices 1 . map (length . filter(=='*'))

import Control.Monad
import Data.Bits

main = do
    [r, c] <- fmap (map read . words) getLine
    a <- replicateM r getLine
    let b = [(i, j) | i <- [1 .. r], j <- [1 .. c], a!!(i-1)!!(j-1) == '*']
        f g = show $ foldl1 xor $ map g b
        in putStrLn $ unwords $ [f fst, f snd]

solve :: Int -> Int -> [String] -> (Int, Int)
solve n m lines  =  (notEq x1 x2 x3, notEq y1 y2 y3)
  where
    [(x1,y1),(x2,y2),(x3,y3)]  =  solve' 1 1 lines
    solve' _ _ []  =  []
    solve' n _ ("" : xs)  =  solve' (n+1) 1 xs
    solve' n m (('*' : s) : xs)  =  (n,m) : solve' n (m+1) (s:xs)
    solve' n m ((_:s) : xs)  =  solve' n (m+1) (s:xs)
    notEq a b c
      | a == b  =  c
      | a == c  =  b
      | b == c  =  a
      | otherwise  =  error ":'("

main :: IO ()
main  =  do
    [n, m]  <-  getLine >>= return . map read . words
    lines  <-  mapM (const getLine) [1..n]
    let (a, b)  =  solve n m lines
    putStrLn $ concat [show a, " ", show b]

import Data.List

f::Int->[String]->[(Int,Int)]
f _ []=[]
f y (str:strs)
    |'*' `elem` str=let xs=elemIndices '*' str
                    in (zip xs (repeat y))++(f (y+1) strs)
    |otherwise=f (y+1) strs

main = do
       e<-getLine
       es<-getContents
       let ds=lines es
           xs=f 1 ds
           ans=nub [(show (y1))++" "++(show (x1+1))|(x1,_)<-xs,(_,y1)<-xs,(x1,y1) `notElem` xs]
       putStrLn $ head ans

getClues rows =
  [(x, y) |
   (x, row) <- zip [1..] rows,
   (y, a)   <- zip [1..] row,
   a == '*']

updateBounds ([minX, maxX], [minY, maxY]) (x, y) =
  ([min minX x, max maxX x],
   [min minY y, max maxY y])

getBounds clues = foldl updateBounds ([101, 0], [101, 0]) clues

solve board =
  let clues = getClues board
      (xs, ys) = getBounds clues
  in head [[x, y] |
           x <- xs,
           y <- ys,
           not $ elem (x, y) clues]

main = interact $ unwords . map show . solve . tail . lines

import Data.List

main::IO ()
main =
    do cs <- getContents
       (putStr.showSolve.solve.tail.lines) cs

showSolve ::(Int,Int)->String
showSolve (a,b) = show a ++ " " ++ show b

findAster::String->Bool
findAster s = findAster1 s 0

findAster1 :: String->Int->Bool
findAster1 [] i = (i == 1)
findAster1 (x:xs) i =
  if (x == '*' )
  then findAster1 xs (i+1)
  else findAster1 xs i

getP ::[(Bool,Int)]->(Bool,Int)
getP [] = (False,0)
getP (x@(b,_):xs) = if b
              then x
              else getP xs

solve::[String]->(Int,Int)
solve s = (x,y)
    where
      (_,x) = getP $ zip (map findAster s) [1..]
      (_,y) = getP $ zip (map findAster $ transpose s) [1..]

process :: [[Char]] -> (Int,Int)
process s
    | ax /= bx && ay /= by = (ax+bx-cx,ay+by-cy)
    | bx /= cx && by /= cy = (bx+cx-ax,by+cy-ay)
    | otherwise = (cx+ax-bx,cy+ay-by)
    where
        [(ax,ay),(bx,by),(cx,cy)] = concat $ zipWith f [1..] s
        f i xs = [(i,j) | j <- (g xs)]
        g = map fst . filter ((=='*').snd) . zip [1..]

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,m] <- fmap (map readInt.words) getLine
    s <- fmap lines getContents
    let (r,c) = process s
    putStrLn $ show r ++ " " ++ show c


One of Timofey's birthday presents is a colourbook in a shape of an infinite plane. On the plane n rectangles with sides parallel to coordinate axes are situated. All sides of the rectangles have odd length. Rectangles cannot intersect, but they can touch each other.Help Timofey to color his rectangles in 4 different colors in such a way that every two rectangles touching each other by side would have different color, or determine that it is impossible.Two rectangles intersect if their intersection has positive area. Two rectangles touch by sides if there is a pair of sides such that their intersection has non-zero length    The picture corresponds to the first example

The first line contains single integer n (1 ≤ n ≤ 5·105) — the number of rectangles. n lines follow. The i-th of these lines contains four integers x1, y1, x2 and y2 ( - 109 ≤ x1 < x2 ≤ 109,  - 109 ≤ y1 < y2 ≤ 109), that means that points (x1, y1) and (x2, y2) are the coordinates of two opposite corners of the i-th rectangle. It is guaranteed, that all sides of the rectangles have odd lengths and rectangles don't intersect each other.

Print "NO" in the only line if it is impossible to color the rectangles in 4 different colors in such a way that every two rectangles touching each other by side would have different color. Otherwise, print "YES" in the first line. Then print n lines, in the i-th of them print single integer ci (1 ≤ ci ≤ 4) — the color of i-th rectangle.

main = interact $ unlines . ("YES":) . map (show . (\(a:b:_) -> a `mod` 2 + b `mod` 2 * 2 + 1) . map read) . filter ((==4) . length) . map words . lines

import Control.Monad
import Data.Int (Int64)
import Data.Sequence (Seq)
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

f t | even t = 0
    | otherwise = 1

gao :: (Int, Int) -> Int
gao (x1, y1) = f x1 + f y1 * 2 + 1

main = do
  (n : _) <- fmap (map readInt . C.words) C.getLine
  putStrLn "YES"
  r <- replicateM n $ do
    (x1 : y1 : x2 : y2 : _) <- fmap (map readInt . C.words) C.getLine
    return (x1, y1)
  mapM putStrLn $ map show $ map gao r
  where
  readInt s = let Just (i, _) = C.readInt s in i

main = interact $ unlines . map (show . (\(a:b:_) -> a `mod` 2 + b `mod` 2 * 2 + 1) . map read) . filter ((==4) . length) . map words . lines


Anna and Maria are in charge of the math club for junior students. When the club gathers together, the students behave badly. They've brought lots of shoe laces to the club and got tied with each other. Specifically, each string ties together two students. Besides, if two students are tied, then the lace connects the first student with the second one as well as the second student with the first one.To restore order, Anna and Maria do the following. First, for each student Anna finds out what other students he is tied to. If a student is tied to exactly one other student, Anna reprimands him. Then Maria gathers in a single group all the students who have been just reprimanded. She kicks them out from the club. This group of students immediately leaves the club. These students takes with them the laces that used to tie them. Then again for every student Anna finds out how many other students he is tied to and so on. And they do so until Anna can reprimand at least one student.Determine how many groups of students will be kicked out of the club.

The first line contains two integers n and m — the initial number of students and laces (). The students are numbered from 1 to n, and the laces are numbered from 1 to m. Next m lines each contain two integers a and b — the numbers of students tied by the i-th lace (1 ≤ a, b ≤ n, a ≠ b). It is guaranteed that no two students are tied with more than one lace. No lace ties a student to himself.

Print the single number — the number of groups of students that will be kicked out from the club.

NoteIn the first sample Anna and Maria won't kick out any group of students — in the initial position every student is tied to two other students and Anna won't be able to reprimand anyone.In the second sample four students are tied in a chain and two more are running by themselves. First Anna and Maria kick out the two students from both ends of the chain (1 and 4), then — two other students from the chain (2 and 3). At that the students who are running by themselves will stay in the club.In the third sample Anna and Maria will momentarily kick out all students except for the fourth one and the process stops at that point. The correct answer is one.

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

solve n e
   | length kicked == 0 = 0
   | otherwise = solve n e' + 1
   where g      = buildG (1, n) e
         kicked = [ i | i <- [1..n], indegree g ! i == 1 ]
         e'     = (\(x, y) -> not (elem x kicked || elem y kicked)) `filter` e

main = do
   [n, m] <- fmap (map read . words) getLine
   e <- fmap concat . forM [1..m] $ \_ -> fmap ((\[x,y] -> [(x,y),(y,x)]) . map read . words) getLine
   print $ solve n e

-- vim: set expandtab:

import Debug.Trace

zipList :: [a] -> [(a, a)]
zipList [] = []
zipList (x:y:xs) = (x, y) : zipList xs
zipList _  = error "invalid list"

construct :: Int -> [(Int, Int)] -> [(Int, [Int])]
construct n lst = [(i, test i) | i <- [0..n-1]]
    where test i = let tmp = filter (check i) lst
                   in  map (get i) tmp
          check i (a, b) = a - 1 == i || b - 1 == i
          get i (a, b)   = a + b - i - 2

solve :: [(Int, [Int])] -> Int
solve g = let del = filter ((== 1) . length . snd) g
          in if null del
             then 0
             else 1 + (solve $ update g del)
    where update g del = let gg = filter ((/= 1) . length . snd) g
                             dd = map fst del
                         in update' gg dd
          update' gg dd = map (test dd) gg
          test dd (a, b) = (a, filter (flip notElem dd) b)

main :: IO()
main = do cs <- getContents
          let lst   = map read $ words cs :: [Int]
              n     = lst !! 0
              m     = lst !! 1
              rest  = drop 2 lst
              pairs = zipList rest
              graph = construct n pairs
          print $ solve graph

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

import Control.Applicative
import Control.Monad
import Data.Array.IO
import qualified Data.IntSet as IntSet

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

solve :: (Int, Int) -> IOArray Int IntSet.IntSet -> IO Int
solve bounds buf = loop 0
 where
  loop n = do
    let f acc a = do
          set <- readArray buf a
          if IntSet.size set /= 1 then return acc else return $ a : acc
    as  <- foldM f [] (range bounds)
    notYet <- fmap or . forM as $ \a -> do
      set <- readArray buf a
      if IntSet.size set /= 1
        then return False
        else do
          let b = IntSet.findMax set
          set' <- readArray buf b
          writeArray buf b $ IntSet.delete a set'
          writeArray buf a $ IntSet.delete b set
          return True
    if not notYet
      then return n
      else loop (n + 1)

main :: IO ()
main = do
  [n, m]    <- readInts
  let bounds = (1, n)
  buf       <- newArray bounds IntSet.empty :: IO (IOArray Int IntSet.IntSet)
  replicateM_ m $ do
    [a, b]  <- readInts
    readArray buf a >>= writeArray buf a . (IntSet.insert b)
    readArray buf b >>= writeArray buf b . (IntSet.insert a)
  solve bounds buf >>= print

import Data.List
import Debug.Trace (trace)

main2 = print $ solve [(1,2), (2,3), (3,4)]
--main = print $ groupBy (\(x,_) (y,_) -> x == y) [(1,2),(1,3),(3,4),(2,1),(3,2),(4,3)]
main =
	do
		[n, m] <- getNums
		lines <- getLines m
		putStrLn $ show $ solve $ (lines |> map (tuple . getNumbers))

solve l = iterate (\(r,n) -> getGroup r) (l,0) |> drop 1 |> takeWhile (\(_,n) -> n > 0) |> length

getGroup l = (r, (length l) - (length r))
	where
		l2 = (l ++ (map swap l)) |> sort
		ones = (groupBy (\(x,_) (y,_) -> x == y) l2) |> filter (\x -> length x == 1) |> map (fst . head)
		r = l |> filter (\(x,y) -> ones |> any (\z -> (z == x) || (z == y)) |> not)

swap (x,y) = (y,x)
tuple [x,y] = (x,y)
------------------utils-----------------------
tr x y = trace ((show x) ++ (show y)) y
tr1 x y = trace ((show x)) y
tr2 y = trace ((show y)) y

(|>) x f = f x

parseInt x = (read x) :: Int

getIndex = zip [0..]

getLines n = repeat getLine |> take n |> sequence

getNums ::  IO [Int]
getNums =
	do
		line <- getLine
		return $ getNumbers line

getNumbers ::  [Char] -> [Int]
getNumbers line =
	case index of
		Nothing -> [parseInt line]
		Just i ->
			let (l,r) = splitAt (i + 1) line in
				(parseInt l) : (getNumbers r)
	where
		index = elemIndex ' ' line

splitBy k =
	case index of
		Nothing -> [k]
		Just i ->
			let (l,r) = splitAt (i) k in
				l : splitBy (drop 1 r)
	where
		index = elemIndex ' ' k

import Debug.Trace

zipList :: [a] -> [(a, a)]
zipList [] = []
zipList (x:y:xs) = (x, y) : zipList xs
zipList _  = error "invalid list"

construct :: Int -> [(Int, Int)] -> [(Int, [Int])]
construct n lst = [(i, test i) | i <- [0..n-1]]
    where test i = let tmp = filter (check i) lst
                   in  map (get i) tmp
          check i (a, b) = a - 1 == i || b - 1 == i
          get i (a, b)   = a + b - i - 1

solve :: [(Int, [Int])] -> Int
solve g = let del = filter ((== 1) . length . snd) g
          in if null del
             then 0
             else 1 + (solve $ update g del)
    where update g del = let gg = filter ((/= 1) . length . snd) g
                             dd = map fst del
                         in update' gg dd
          update' gg dd = map (test dd) gg
          test dd (a, b) = (a, filter (flip notElem dd) b)

main :: IO()
main = do cs <- getContents
          let lst   = map read $ words cs :: [Int]
              n     = lst !! 0
              m     = lst !! 1
              rest  = drop 2 lst
              pairs = zipList rest
              graph = construct n pairs
          print $ solve graph


Given a string $$$s$$$ of length $$$n$$$ and integer $$$k$$$ ($$$1 \le k \le n$$$). The string $$$s$$$ has a level $$$x$$$, if $$$x$$$ is largest non-negative integer, such that it's possible to find in $$$s$$$:  $$$x$$$ non-intersecting (non-overlapping) substrings of length $$$k$$$,  all characters of these $$$x$$$ substrings are the same (i.e. each substring contains only one distinct character and this character is the same for all the substrings). A substring is a sequence of consecutive (adjacent) characters, it is defined by two integers $$$i$$$ and $$$j$$$ ($$$1 \le i \le j \le n$$$), denoted as $$$s[i \dots j]$$$ = "$$$s_{i}s_{i+1} \dots s_{j}$$$".For example, if $$$k = 2$$$, then:  the string "aabb" has level $$$1$$$ (you can select substring "aa"),  the strings "zzzz" and "zzbzz" has level $$$2$$$ (you can select two non-intersecting substrings "zz" in each of them),  the strings "abed" and "aca" have level $$$0$$$ (you can't find at least one substring of the length $$$k=2$$$ containing the only distinct character). Zuhair gave you the integer $$$k$$$ and the string $$$s$$$ of length $$$n$$$. You need to find $$$x$$$, the level of the string $$$s$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2 \cdot 10^5$$$) — the length of the string and the value of $$$k$$$. The second line contains the string $$$s$$$ of length $$$n$$$ consisting only of lowercase Latin letters.

Print a single integer $$$x$$$ — the level of the string.

NoteIn the first example, we can select $$$2$$$ non-intersecting substrings consisting of letter 'a': "(aa)ac(aa)bb", so the level is $$$2$$$.In the second example, we can select either substring "a" or "b" to get the answer $$$1$$$.

-- Codeforces Round #533 Div.2 (B), Contest 1105, Problem set ?.
-- UNDONE

{-# 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
  [n,k] <- map read . words <$> getLine :: IO [Int]
  bs <- BS.takeWhile (\x -> 'a' <= x && x <= 'z') <$> BS.getLine
  as <- A.newArray ('a','z') 0 :: IO (IOUArray Char Int)
  prevChar <- newIORef ' '
  prevCnt <- newIORef (0::Int)
  forM_ [0..n-1] $ \i -> do
    let c = bs `BS.index` i
    pch <- readIORef prevChar
    pcnt <- readIORef prevCnt
    if c == pch then
      writeIORef prevCnt (pcnt+1)
    else do
      writeIORef prevChar c
      writeIORef prevCnt 1
    cnt <- readIORef prevCnt
    when (cnt >= k) $ do
      A.writeArray as c . (+1) =<< A.readArray as c
      writeIORef prevCnt 0
  ans <- maximum <$> A.getElems as
  print ans