Valera is a little boy. Yesterday he got a huge Math hometask at school, so Valera didn't have enough time to properly learn the English alphabet for his English lesson. Unfortunately, the English teacher decided to have a test on alphabet today. At the test Valera got a square piece of squared paper. The length of the side equals n squares (n is an odd number) and each unit square contains some small letter of the English alphabet.Valera needs to know if the letters written on the square piece of paper form letter "X". Valera's teacher thinks that the letters on the piece of paper form an "X", if:  on both diagonals of the square paper all letters are the same;  all other squares of the paper (they are not on the diagonals) contain the same letter that is different from the letters on the diagonals. Help Valera, write the program that completes the described task for him.

The first line contains integer n (3 ≤ n < 300; n is odd). Each of the next n lines contains n small English letters — the description of Valera's paper.

Print string "YES", if the letters on the paper form letter "X". Otherwise, print string "NO". Print the strings without quotes.

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

main = do
    n <- read <$> getLine
    sequence [ getLine | _ <- [1..n]] >>= putStrLn . solve n

solve :: Int -> [[Char]] -> String
solve len xss = if check len xss
                then "YES"
                else "NO"

check :: Int -> [[Char]] -> Bool
check len xss
    | len == 1  = True
    | otherwise = let ((x:y:_):_) = xss
                  in  if x /= y
                        then recursion x y len (1, 1) xss
                        else False

-- haskell
recursion :: Char -> Char -> Int -> (Int, Int) -> [[Char]] -> Bool
recursion _ _ _ (_, _) [] = True
recursion d n len (x, y) ([]:xss) = recursion d n len (1, y + 1) xss
recursion d n len (x, y) ((c:xs):xss)
    | x == y || (len - x + 1) == y = c == d && (recursion d n len (x + 1, y) (xs:xss))
    | otherwise                    = c == n && (recursion d n len (x + 1, y) (xs:xss))

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

main = do
    n <- read <$> getLine
    sequence [ getLine | _ <- [1..n]] >>= putStrLn . solve n

solve :: Int -> [[Char]] -> String
solve len xss = if check len xss
                then "YES"
                else "NO"

check :: Int -> [[Char]] -> Bool
check _ [[_]] = True
check len xss@((x:y:_):_)
    | x == y    = False
    | otherwise = recursion x y len (1, 1) xss

-- haskell
recursion :: Char -> Char -> Int -> (Int, Int) -> [[Char]] -> Bool
recursion _ _ _ (_, _) [] = True
recursion d n len (x, y) ([]:xss) = recursion d n len (1, y + 1) xss
recursion d n len (x, y) ((c:xs):xss)
    | x == y || (len - x + 1) == y = c == d && (recursion d n len (x + 1, y) (xs:xss))
    | otherwise                    = c == n && (recursion d n len (x + 1, y) (xs:xss))

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  a <- replicateM n getLine

  let
    x = a!!0!!0
    y = a!!0!!1

    b = and $ zipWith check (concat a) $ [(i, j) | i <- [1..n], j <- [1..n]]

    check c (i, j) = c == (if i == j || i == n-j+1 then x else y)

  putStrLn $ if x /= y && b then "YES" else "NO"

solve x  =
     let [n',a',b'] = map ($ head x) $ [show .length,  (:[]) . (!!0), (:[]) . (!!1)]
         (n,a,b) = (read n' :: Int, head a', head b')
     in if a == b
            then "NO"
            else
                let  d' =  map (take n) $ zipWith (flip (++)) (replicate n (replicate n False)) $ take n $ iterate (False:) [True]
                     d =  map (map (\x -> if x then (==a) else (==b) )) $ zipWith (zipWith (||)) d' $ reverse d'
                     r =  all (==True)  $ map (all (==True)) $ zipWith (zipWith (\f a -> f a)) d x -- show d  --- show (n,a,b)
            in if r then "YES" else "NO"

main = interact $ solve . tail . lines

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . tail . lines

solve :: [String] -> Bool
solve css@((x:y:_):_) = x /= y && and [ and [ c == f i j | (j, c) <- zip [0..] cs ] | (i, cs) <- zip [0..] css ]
  where f i j = if i == j || i + j + 1 == length css then x else y
solve _ = undefined

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

main :: IO ()
main = getContents >>= putStrLn . yesno . solve . tail . lines

solve :: [String] -> Bool
solve css = x /= y && and [ and [ c == f i j | (j, c) <- zip [0..] cs ] | (i, cs) <- zip [0..] css ]
  where x = head (head css); y = head css !! 1; n = length css
        f i j = if i == j || i + j + 1 == n then x else y

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Data.List
import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let (c,nc) = partition diag (indices g)
      diag (i,j) = i == j || i == n+1-j
  putStrLn $ if all ((== g!(1,1)) . (g!)) c &&
                all ((== g!(1,2)) . (g!)) nc &&
                g!(1,1) /= g!(1,2)
                then "YES" else "NO"

import Debug.Trace

debug x = trace (show x) x

main = interact $ solve . lines

solve (snum : lines) =
    let n     = read snum :: Int
        x:o:_ = head lines
        check x o i line = and $ zipWith f line [0..]
            where
                f ch j
                    | i == j         = (ch == x)
                    | i + j + 1 == n = (ch == x)
                    | otherwise      = (ch == o)
        ans = and $ zipWith (check x o) [0..] lines
    in if x /= o && ans
       then "YES\n" else "NO\n"

import Control.Applicative
import Data.Array.Base

main = do
  n <- readLn
  cs <- concat.words <$> getContents
  putStrLn $ solve n $listArray (0,n*n-1) cs

solve :: Int -> UArray Int Char -> String
solve n arr
  | x == o = "NO"
  | all (x==) diags && all (o==) others = "YES"
  | otherwise = "NO"
   where
     diags = do i<- [0..n-1];map (unsafeAt arr)[(i*n+i), (i*n+n-i-1)]
     others = [unsafeAt arr (i*n+j) |i<-[0..n-1],j<-[0..n-1],j/=i,j/=(n-i-1)]
     x = unsafeAt arr 0
     o = unsafeAt arr 1

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

check n a = diayes && othyes
	where diag = concat [[a!(i,i),a!(i,n-i+1)]| i<-[1..n]]
 	      diagh = head diag
	      diayes = all (==diagh) diag
	      oth = [a!(i,j)| i<-[1..n],j<-[1..n],i/=j,i/=n-j+1]
	      othh = head oth
              othyes = othh /= diagh && (all (==othh) oth)

main= do
	n<-read <$> getLine::IO Int
	s<- concat.lines <$> getContents ::IO String
	let a = listArray ((1,1),(n,n)) s
	putStrLn $ if check n a then "YES" else "NO"

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Data.Array
import Data.Array.IO
import Control.Monad
import Control.Applicative
import Control.Arrow
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

readInt2 :: B.ByteString -> (Int, Int)
readInt2 = l2t . map readInt . B.words
readInt3 :: B.ByteString -> (Int, Int, Int)
readInt3 = l3t . map readInt . B.words

l2t [x,y] = (x,y)
l3t [x,y,z] = (x,y,z)

(|>) x f = f x; infixl 1 |>
car = head
cdr = tail
caar = car . car
cadr = car . cdr
cddr = cdr . cdr
cdar = cdr . car
caddr = car . cddr
cadar = car . cdar

debug x = trace (show x) x

main :: IO ()
main = do
    n  <- read <$> getLine :: IO Int
    ls <- take n <$> lines <$> getContents
    let x = caar ls
        o = cadar ls
        ans = and $ map (check (n, x, o)) (zip ls [0 .. ])
    putStrLn $ if x /= o && ans then "YES" else "NO"

  where
    check (n, x, o) (l, i) =
      and $ map cheki (zip l [0 .. ])
      where
        cheki (c, j)
          | i == j = c == x
          | i + j + 1 == n = c == x
          | True = c == o

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

main = do
    n <- read <$> getLine
    sequence [ getLine | _ <- [1..n]] >>= putStrLn . solve n

solve :: Int -> [[Char]] -> String
solve len xss = if check len xss
                then "YES"
                else "NO"

check :: Int -> [[Char]] -> Bool
check len xss
    | len == 1  = True
    | otherwise = let ((x:y:_):_) = xss
                  in  recursion x y len (1, 1) xss

-- haskell
recursion :: Char -> Char -> Int -> (Int, Int) -> [[Char]] -> Bool
recursion _ _ _ (_, _) [] = True
recursion d n len (x, y) ([]:xss) = recursion d n len (1, y + 1) xss
recursion d n len (x, y) ((c:xs):xss)
    | x == y || (len - x + 1) == y = c == d && (recursion d n len (x + 1, y) (xs:xss))
    | otherwise                    = c == n && (recursion d n len (x + 1, y) (xs:xss))

import Control.Arrow
import Data.List
solve x  =
  (\x -> if x == (True,True) then "YES" else "NO") $
  (((<=2).length) *** ((==1).length)) $
  ( nub *** nub ) $
  (\((a,b),(c,d))-> (a++c,b++d)) $
  (foldr (\(xs',d) (xs,ds)->(xs++xs', (d:ds))) ([],[]) *** foldr (\(xs',d) (xs,ds)->(xs++xs', (d:ds))) ([],[])) $
  ( map (\(a,b)-> (init a ++ b , last a)) *** map (\(a,b)-> (init a ++ b , last a)))  $
  ( zipWith (\x y -> splitAt x y) [1..] *** zipWith (\x y -> splitAt x y) [1..] ) $
  second (map reverse) $
  (x,x)

main = interact $ solve . tail . lines

solve x  =
     let [n',a',b'] = map ($ head x) $ [show .length,  (:[]) . (!!0), (:[]) . (!!1)]
         (n,a,b) = (read n' :: Int, head a', head b')
         d' =  map (take n) $ zipWith (flip (++)) (replicate n (replicate n False)) $ take n $ iterate (False:) [True]
         d =  map (map (\x -> if x then (==a) else (==b) )) $ zipWith (zipWith (||)) d' $ reverse d'
         r =  all (==True)  $ map (all (==True)) $ zipWith (zipWith (\f a -> f a)) d x -- show d  --- show (n,a,b)
     in if r then "YES" else "NO"

main = interact $ solve . tail . lines

import Control.Arrow
import Data.List
solve x  =
  (\x -> if x == (True,True) then "YES" else "NO") $
  (((==2).length) *** ((==1).length)) $
  ( nub *** nub ) $
  (\((a,b),(c,d))-> (a++c,b++d)) $
  (foldr (\(xs',d) (xs,ds)->(xs++xs', (d:ds))) ([],[]) *** foldr (\(xs',d) (xs,ds)->(xs++xs', (d:ds))) ([],[])) $
  ( map (\(a,b)-> (init a ++ b , last a)) *** map (\(a,b)-> (init a ++ b , last a)))  $
  ( zipWith (\x y -> splitAt x y) [1..] *** zipWith (\x y -> splitAt x y) [1..] ) $
  second (map reverse) $
  (x,x)

main = interact $ solve . tail . lines

import Data.List
import Data.Array
main = do
  n <- readLn
  g <- listArray ((1,1),(n,n)) . concat . lines <$> getContents
  let (c,nc) = partition diag (indices g)
      diag (i,j) = i == j || i == n+1-j
  putStrLn $ if all ((== g!(1,1)) . (g!)) c && all ((== g!(1,2)) . (g!)) nc
                then "YES" else "NO"

import Debug.Trace

debug x = trace (show x) x

main = interact $ solve . lines

solve (snum : lines) =
    let n     = read snum :: Int
        x:o:_ = head lines
        check x o i line = and $ zipWith f line [0..]
            where
                f ch j
                    | i == j         = (ch == x)
                    | i + j + 1 == n = (ch == x)
                    | otherwise      = (ch == o)
    in if and $ zipWith (check x o) [0..] lines
       then "YES\n" else "NO\n"

import Control.Applicative
import Data.Array.Base

main = do
  n <- readLn
  cs <- concat.words <$> getContents
  putStrLn $ solve n $listArray (0,n*n-1) cs

solve :: Int -> UArray Int Char -> String
solve n arr
  | all (x==) diags && all (o==) others = "YES"
  | otherwise = "NO"
   where
     diags = do i<- [0..n-1];map (unsafeAt arr)[(i*n+i), (i*n+n-i-1)]
     others = [unsafeAt arr (i*n+j) |i<-[0..n-1],j<-[0..n-1],j/=i,j/=(n-i-1)]
     x = unsafeAt arr 0
     o = unsafeAt arr 1

import Data.List
import Data.Char
import Data.Maybe
import Data.Tuple
import Debug.Trace
import Data.Array
import Data.Array.IO
import Control.Monad
import Control.Applicative
import Control.Arrow
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as M
import Text.Printf

readInt :: B.ByteString -> Int
readInt = fst . fromJust . B.readInt

readInt2 :: B.ByteString -> (Int, Int)
readInt2 = l2t . map readInt . B.words
readInt3 :: B.ByteString -> (Int, Int, Int)
readInt3 = l3t . map readInt . B.words

l2t [x,y] = (x,y)
l3t [x,y,z] = (x,y,z)

(|>) x f = f x; infixl 1 |>
car = head
cdr = tail
caar = car . car
cadr = car . cdr
cddr = cdr . cdr
cdar = cdr . car
caddr = car . cddr
cadar = car . cdar

debug x = trace (show x) x

main :: IO ()
main = do
    n  <- read <$> getLine :: IO Int
    ls <- take n <$> lines <$> getContents
    let x = caar ls
        o = cadar ls
        ans = and $ map (check (n, x, o)) (zip ls [0 .. ])
    putStrLn $ if ans then "YES" else "NO"

  where
    check (n, x, o) (l, i) =
      and $ map cheki (zip l [0 .. ])
      where
        cheki (c, j)
          | i == j = c == x
          | i + j + 1 == n = c == x
          | True = c == o


Sakuzyo - ImprintingA.R.C. Markland-N is a tall building with $$$n$$$ floors numbered from $$$1$$$ to $$$n$$$. Between each two adjacent floors in the building, there is a staircase connecting them.It's lunchtime for our sensei Colin "ConneR" Neumann Jr, and he's planning for a location to enjoy his meal.ConneR's office is at floor $$$s$$$ of the building. On each floor (including floor $$$s$$$, of course), there is a restaurant offering meals. However, due to renovations being in progress, $$$k$$$ of the restaurants are currently closed, and as a result, ConneR can't enjoy his lunch there.CooneR wants to reach a restaurant as quickly as possible to save time. What is the minimum number of staircases he needs to walk to reach a closest currently open restaurant.Please answer him quickly, and you might earn his praise and even enjoy the lunch with him in the elegant Neumanns' way!

The first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the test. Then the descriptions of $$$t$$$ test cases follow. The first line of a test case contains three integers $$$n$$$, $$$s$$$ and $$$k$$$ ($$$2 \le n \le 10^9$$$, $$$1 \le s \le n$$$, $$$1 \le k \le \min(n-1, 1000)$$$) — respectively the number of floors of A.R.C. Markland-N, the floor where ConneR is in, and the number of closed restaurants. The second line of a test case contains $$$k$$$ distinct integers $$$a_1, a_2, \ldots, a_k$$$ ($$$1 \le a_i \le n$$$) — the floor numbers of the currently closed restaurants. It is guaranteed that the sum of $$$k$$$ over all test cases does not exceed $$$1000$$$.

For each test case print a single integer — the minimum number of staircases required for ConneR to walk from the floor $$$s$$$ to a floor with an open restaurant.

NoteIn the first example test case, the nearest floor with an open restaurant would be the floor $$$4$$$.In the second example test case, the floor with ConneR's office still has an open restaurant, so Sensei won't have to go anywhere.In the third example test case, the closest open restaurant is on the $$$6$$$-th floor.

import qualified Data.Map as Map
import qualified Data.Map.Strict as Map.Strict

buildCount :: [Int] -> Map.Map Int Int
buildCount [] = Map.empty
buildCount (x:xs) = Map.Strict.insertWith (+) x 1 (buildCount xs)

minDist :: Int -> Int -> [Int] -> Int
minDist limit start closed = pickDist 0
    where pickDist d = if (actual d) /= (expected d)
                           then d
                           else pickDist (d + 1)
          actual d = Map.findWithDefault 0 d count
          expected 0 = 1
          expected d = (if start > d then 1 else 0) +
                       (if start + d <= limit then 1 else 0)
          count = buildCount dists
          dists = map (abs . (start - )) closed

solveTest :: String -> String -> String
solveTest header closedList =
    let tokens = words header
        limit = read (tokens !! 0) :: Int
        start = read (tokens !! 1) :: Int
        closed = map read $ words closedList :: [Int]
    in show $ minDist limit start closed

solveAll :: [String] -> [String]
solveAll (testsStr:other) =
    let tests = read testsStr :: Int
    in map testResult [1..tests]
    where testResult i = solveTest (firstLine i) (secondLine i)
          firstLine i = (other !! (2 * i - 2))
          secondLine i = (other !! (2 * i - 1))

main = interact (unlines . solveAll . lines)

import Control.Monad
import Data.List
import Data.Maybe

solve :: Int -> Int -> [Int] -> Int -> Int
solve n s cls i
  | (a >= 1) && isNothing fa = i
  | (b <= n) && isNothing fb = i
  | otherwise = solve n s cls (i+1)
  where
    a = s - i
    b = s + i
    fa = elemIndex a cls
    fb = elemIndex b cls

main = do
  t <- readLn :: IO Int
  replicateM_ t $ do
    [n,s,k] <- map read . words <$> getLine :: IO [Int]
    cls <- map read . words <$> getLine :: IO [Int]
    print $ solve n s cls 0

import Data.Set as S
import Data.List as L

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (L.take n arr):(groupByNLines n (L.drop n arr))

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 2 . tail . lines)

parse :: [String] -> String
parse [fstLine, sndLine] = show $ solve n s ks
  where [n, s, _] = L.map (\x -> read x :: Int) $ words fstLine
        ks = L.map (\x -> read x :: Int) $ words sndLine

withinRanges :: Int -> Int -> Bool
withinRanges n x = x >= 1 && x <= n

isOk :: S.Set Int -> Int -> Int -> Bool
isOk forbidden n x = (withinRanges n x) && (not $ S.member x forbidden)

solve :: Int -> Int -> [Int] -> Int
solve n s ks = head $ L.filter (\k -> (isOk' (s-k)) || (isOk' (s+k))) [0..restaurantsClosed]
  where restaurantsClosed = length ks
        forbidden = S.fromList ks
        isOk' = isOk forbidden n

import Data.Set as S
import Data.List as L

removeFloor :: S.Set Int -> Int -> S.Set Int
removeFloor available s = S.delete s available

availableFloors :: Int -> [Int] -> S.Set Int
availableFloors s ks = L.foldl (\available k -> removeFloor available k) initial ks
  where initial = S.fromList [(max 1 (s-klength))..(s+klength)]
        klength = length ks

nearestFloor :: S.Set Int -> Int -> Int
nearestFloor floors s = S.foldl (\curr k -> if (abs (k-s)) < curr then abs (k-s) else curr) 10000 floors

solve :: Int -> Int -> [Int] -> Int
solve _ s ks = ans
  where floors = availableFloors s ks
        ans = nearestFloor floors s

parse :: [String] -> String
parse [fstLine, sndLine] = show $ solve n s ks
  where [n, s, _] = L.map (\x -> read x :: Int) $ words fstLine
        ks = L.map (\x -> read x :: Int) $ words sndLine

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (L.take n arr):(groupByNLines n (L.drop n arr))

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 2 . tail . lines)


You are an experienced Codeforces user. Today you found out that during your activity on Codeforces you have made y submissions, out of which x have been successful. Thus, your current success rate on Codeforces is equal to x / y.Your favorite rational number in the [0;1] range is p / q. Now you wonder: what is the smallest number of submissions you have to make if you want your success rate to be p / q?

The first line contains a single integer t (1 ≤ t ≤ 1000) — the number of test cases. Each of the next t lines contains four integers x, y, p and q (0 ≤ x ≤ y ≤ 109; 0 ≤ p ≤ q ≤ 109; y > 0; q > 0). It is guaranteed that p / q is an irreducible fraction. Hacks. For hacks, an additional constraint of t ≤ 5 must be met.

For each test case, output a single integer equal to the smallest number of submissions you have to make if you want your success rate to be equal to your favorite rational number, or -1 if this is impossible to achieve.

NoteIn the first example, you have to make 4 successful submissions. Your success rate will be equal to 7 / 14, or 1 / 2.In the second example, you have to make 2 successful and 8 unsuccessful submissions. Your success rate will be equal to 9 / 24, or 3 / 8.In the third example, there is no need to make any new submissions. Your success rate is already equal to 20 / 70, or 2 / 7.In the fourth example, the only unsuccessful submission breaks your hopes of having the success rate equal to 1.

import qualified Data.ByteString.Char8 as B
import           Data.Functor
import           Data.List
import           Data.Maybe
import qualified Data.Set              as S

getInts :: IO [Int]
getInts = map (fst . fromJust . B.readInt) <$> B.words <$> B.getContents
getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . B.readInteger) <$> B.words <$> B.getContents
pair []       = []
pair (x:y:rs) = (x, y) : pair rs
clamp u v w = max u $ min v $ w

main = do
    (_:xs) <- getIntegers
    putStrLn $ solveAll xs

solveAll []           = ""
solveAll (x:y:p:q:rs) = show (solve x y p q) ++ "\n" ++ solveAll rs

solve x y p q
    | p == 0 = if x == 0 then 0 else -1
    | p == q = if x == y then 0 else -1
    | otherwise = if m == 0 then ans else -1
  where
    (g, u0, v0) = gcdex q p
    (d, m) = divMod (y * p - x * q) g
    (u1, v1) = (u0 * d, -v0 * d)
    t = min (div u1 p) (div (v1-u1) (q-p))
    ans = v1 - q * t

gcdex a 0 = (a, 1, 0)
gcdex a b = let (g, u, v) = gcdex b (mod a b) in (g, v, u - (div a b) * v)

module Main where

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

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

getInt::IO Int
getInt = do
  line <- BS.getLine
  let Just (x, _ ) = BS.readInt line
  return x

search::Integer->Integer->Integer->Integer->Maybe Integer
search x y p q = go 0 (y + 1) where
  go u v | u + 1 >= v   = fmap result $ mfilter ok $ Just v
         | ok (mid u v) = go u (mid u v)
         | otherwise    = go (mid u v) v
  ok t = p * t >= x && (q - p) * t >= (y - x)
  mid u v = quot (u + v) 2
  result t = q * t - y

main :: IO ()
main = do
  t <- getInt
  replicateM_ t $ do
    [x,y,p,q] <- getInts
    print $ fromMaybe (-1) $ search x y p q

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Applicative
import Control.Monad

solve :: Integer -> Integer -> Integer -> Integer -> Integer
solve x y p q | x' == p && y' == q = 0
              | p == 0 = (-1)
              | p == q = (-1)
              | otherwise = r * q - y
    where d = gcd x y
          x' = x `div` d
          y' = y `div` d

          r = max ((y - x + q - p - 1) `div` (q - p)) ((x + p - 1) `div` p)

main :: IO ()
main = do
  numTests <- read <$> getLine :: IO Int
  replicateM_ numTests $ do
         [x, y, p, q] <- map read . words <$> getLine :: IO [Integer]
         print $ solve x y p q

{-# OPTIONS_GHC -O2 -optc-O2 -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

ee a b = go a b 1 0 0 1
  where
    go r0 r1 s0 s1 t0 t1
      | r == 0 = (s1, t1)
      | otherwise = go r1 r s1 (s0 - q * s1) t1 (t0 - q * t1)
      where (q, r) = r0 `quotRem` r1

solve x y p q
  | p == 0 = if x == 0 then 0 else -1
  | p == q = max (x - y) (-1)
  | otherwise = s' - u' - t * q :: Integer
  where (a, b) = ee (q - p) p
        c = p*y - q*x
        (s', u') = (a * c, b * c)
        t = min (s' `div` p) (u' `div` (p - q))

main = do
  t <- fmap readInt B.getLine
  rs <- replicateM t (fmap ((\[x, y, p, q] -> solve x y p q) . map fromIntegral . readInts) B.getLine)
  B.putStr $ B.unlines $ map (B.pack . show) rs

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

import Control.Monad (forM_)
import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInteger, words, unpack, reverse, dropWhile)
import qualified Data.Maybe as M (fromJust)
import Data.Char as C (isSpace)

readInt = fst . M.fromJust . C.readInteger
rstrip = C.reverse . C.dropWhile C.isSpace . C.reverse

exgcd a 0 = (a, 1, 0)
exgcd a b = (ret, y, x - a `quot` b * y) where
    (ret, x, y) = exgcd b (a `mod` b)

run x y 0 q | x == 0 = 0 | otherwise = -1
run x y p q | p == q && y == x = 0 | p == q = -1
run x y p q | v `mod` d /= 0 = -1
            | p > q && k2 < k1 = -1
            | p > q = k1 * (q `quot` d) + vx * xx
            | otherwise = max k1 k2 * (q `quot` d) + vx * xx where
    v = q * x - p * y
    vx = v `quot` d
    (d, xx, yy) = exgcd p q
    k1 | vx * yy == 0 = 0
       | vx * yy >  0 = (vx * yy - 1) `quot` (p `quot` d) + 1
       | otherwise    = (vx * yy) `quot` (p `quot` d)
    k2 | vx * (xx + yy) == 0 = 0
       | p > q && vx * (xx + yy) > 0
            = vx * (xx + yy) `quot` ((p - q) `quot` d)
       | p > q && vx * (xx + yy) < 0
            = (vx * (xx + yy) + 1) `quot` ((p - q) `quot` d) - 1
       | p < q && -vx * (xx + yy) > 0
            = (-vx * (xx + yy) - 1) `quot` ((q - p) `quot` d) + 1
       | p < q && -vx * (xx + yy) < 0
            = -vx * (xx + yy) `quot` ((q - p) `quot` d)

main = do
    (readInt -> t) <- B.getLine
    forM_ [1..t] $ \_ -> do
        (map readInt . C.words -> [x, y, p, q]) <- B.getLine
        putStrLn $ show $ run x y p q

import Control.Monad
import Control.Applicative

solve :: Integer -> Integer -> Integer -> Integer -> Integer
solve x y p q
 | p == q = if (x == y) then 0 else -1
 | p == 0 = if (x == 0) then 0 else -1
 | otherwise = k*q-y
    where k1 = (y - x + q - p - 1) `div` (q - p)
          k2 = (x + p - 1) `div` p
          k3 = (y + q - 1) `div` q
          k = maximum [k1,k2,k3]

main :: IO ()
main = do
        t <- readLn :: IO Int
        replicateM_ t $ do
            x:y:p:q:_ <- map read . words <$> getLine :: IO [Integer]
            print $ solve x y p q

{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Applicative
import Control.Monad

solve :: Int -> Int -> Int -> Int -> Int
solve x y p q | x' == p && y' == q = 0
              | p == 0 = (-1)
              | p == q = (-1)
              | otherwise = r * q - y
    where d = gcd x y
          x' = x `div` d
          y' = y `div` d

          r = max ((y - x + q - p - 1) `div` (q - p)) ((x + p - 1) `div` p)

main :: IO ()
main = do
  numTests <- read <$> getLine :: IO Int
  replicateM_ numTests $ do
         [x, y, p, q] <- map read . words <$> getLine
         print $ solve x y p q

{-# OPTIONS_GHC -O2 -optc-O2 -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.Int

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

ee a b = go a b 1 0 0 1
  where
    go r0 r1 s0 s1 t0 t1
      | r == 0 = (s1, t1)
      | otherwise = go r1 r s1 (s0 - q * s1) t1 (t0 - q * t1)
      where (q, r) = r0 `quotRem` r1

solve x y p q
  | p == 0 = if x == 0 then 0 else -1
  | p == q = max (x - y) (-1)
  | otherwise = s' - u' - t * q :: Int64
  where (a, b) = ee (q - p) p
        c = p*y - q*x
        (s', u') = (a * c, b * c)
        t = min (s' `div` p) (u' `div` (p - q))

main = do
  t <- fmap readInt B.getLine
  rs <- replicateM t (fmap ((\[x, y, p, q] -> solve x y p q) . map fromIntegral . readInts) B.getLine)
  B.putStr $ B.unlines $ map (B.pack . show) rs


You and your friend are playing the game Mortal Kombat XI. You are trying to pass a challenge tower. There are $$$n$$$ bosses in this tower, numbered from $$$1$$$ to $$$n$$$. The type of the $$$i$$$-th boss is $$$a_i$$$. If the $$$i$$$-th boss is easy then its type is $$$a_i = 0$$$, otherwise this boss is hard and its type is $$$a_i = 1$$$.During one session, either you or your friend can kill one or two bosses (neither you nor your friend can skip the session, so the minimum number of bosses killed during one session is at least one). After your friend session, your session begins, then again your friend session begins, your session begins, and so on. The first session is your friend's session.Your friend needs to get good because he can't actually kill hard bosses. To kill them, he uses skip points. One skip point can be used to kill one hard boss.Your task is to find the minimum number of skip points your friend needs to use so you and your friend kill all $$$n$$$ bosses in the given order.For example: suppose $$$n = 8$$$, $$$a = [1, 0, 1, 1, 0, 1, 1, 1]$$$. Then the best course of action is the following:  your friend kills two first bosses, using one skip point for the first boss;  you kill the third and the fourth bosses;  your friend kills the fifth boss;  you kill the sixth and the seventh bosses;  your friend kills the last boss, using one skip point, so the tower is completed using two skip points. You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of bosses. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 1$$$), where $$$a_i$$$ is the type of the $$$i$$$-th boss. It is guaranteed that the sum of $$$n$$$ does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$).

For each test case, print the answer: the minimum number of skip points your friend needs to use so you and your friend kill all $$$n$$$ bosses in the given order.

module Main where
import Data.List

solve [] = []
solve (_:x:xs) = (if head x == '1' then 1 else 0 ) + ( sum . map ((`div` 3) . length) . filter ((=="1").head) . group . words . tail $ x) : solve xs

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

import Control.Monad
import Data.List

solve :: [Int] -> Int
solve li = sum [div (length s) 3 | s <- group li, head s == 1]

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    print $ solve (1:1:a)


There is a chessboard of size $$$n$$$ by $$$n$$$. The square in the $$$i$$$-th row from top and $$$j$$$-th column from the left is labelled $$$(i,j)$$$.Currently, Gregor has some pawns in the $$$n$$$-th row. There are also enemy pawns in the $$$1$$$-st row. On one turn, Gregor moves one of his pawns. A pawn can move one square up (from $$$(i,j)$$$ to $$$(i-1,j)$$$) if there is no pawn in the destination square. Additionally, a pawn can move one square diagonally up (from $$$(i,j)$$$ to either $$$(i-1,j-1)$$$ or $$$(i-1,j+1)$$$) if and only if there is an enemy pawn in that square. The enemy pawn is also removed.Gregor wants to know what is the maximum number of his pawns that can reach row $$$1$$$?Note that only Gregor takes turns in this game, and the enemy pawns never move. Also, when Gregor's pawn reaches row $$$1$$$, it is stuck and cannot make any further moves.

The first line of the input contains one integer $$$t$$$ ($$$1\le t\le 2\cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of three lines. The first line contains a single integer $$$n$$$ ($$$2\le n\le 2\cdot{10}^{5}$$$) — the size of the chessboard. The second line consists of a string of binary digits of length $$$n$$$, where a $$$1$$$ in the $$$i$$$-th position corresponds to an enemy pawn in the $$$i$$$-th cell from the left, and $$$0$$$ corresponds to an empty cell. The third line consists of a string of binary digits of length $$$n$$$, where a $$$1$$$ in the $$$i$$$-th position corresponds to a Gregor's pawn in the $$$i$$$-th cell from the left, and $$$0$$$ corresponds to an empty cell. It is guaranteed that the sum of $$$n$$$ across all test cases is less than $$$2\cdot{10}^{5}$$$.

For each test case, print one integer: the maximum number of Gregor's pawns which can reach the $$$1$$$-st row.

NoteIn the first example, Gregor can simply advance all $$$3$$$ of his pawns forward. Thus, the answer is $$$3$$$.In the second example, Gregor can guarantee that all $$$4$$$ of his pawns reach the enemy row, by following the colored paths as demonstrated in the diagram below. Remember, only Gregor takes turns in this "game"!  In the third example, Gregor's only pawn is stuck behind the enemy pawn, and cannot reach the end.In the fourth example, Gregor has no pawns, so the answer is clearly $$$0$$$.

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Data.Array as Array
import Control.Monad

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

subMain = do
    n <- readLn :: IO Int
    a <- getLine
    b <- getLine
    putStrLn . show $ memDp (BSC.pack a) (BSC.pack b) n

memDp aStr bStr ind = dp ind
    where
        dp 0 = 0

        dp 1
            | BSC.head aStr == '0' && BSC.head bStr == '1' = 1
            | otherwise = 0

        dp ind
            | b == '1' && prevB == '1' && a == '1' && prevA == '1' = max dp1A (dp2 + 2)
            | b == '1' && prevA == '1' = max dp1A (dp2 + 1)
            | prevB == '1' && a == '1' = max dp1A (dp2 + 1)
            | otherwise = dp1A
            where
                a = aStr `BSC.index` (ind - 1)
                prevA = aStr `BSC.index` (ind - 2)
                b = bStr `BSC.index` (ind - 1)
                prevB = bStr `BSC.index` (ind - 2)

                dp1 = arr ! (ind - 1)
                dp2 = arr ! (ind - 2)
                dp1A
                    | b == '1' && a == '0' = dp1 + 1
                    | otherwise = dp1

        arr = Array.listArray(0, BS.length aStr) [dp x | x <- [0 .. BS.length aStr]]

main :: IO ()
main = interact $ unlines . inp . tail . words

inp :: [String] -> [String]
inp []             = []
inp (n:s1:s2:rest) = show (solve ('0':s1++['0']) s2) : inp rest

solve :: String -> String -> Int
solve _ [] = 0
solve (x:xs) ('0':us) = solve xs us
solve (x:next@(y:more@(z:rest))) ('1':us)
    | x == '1'  = 1 + solve next us
    | y == '0'  = 1 + solve ('-':more) us
    | z == '1'  = 1 + solve (y:'-':rest) us
    | otherwise = solve next us

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

main :: IO ()
main = interact $ unlines . inp . tail . words

inp :: [String] -> [String]
inp []             = []
inp (n:s1:s2:rest) = show (solve ('2':s1++['2']) s2) : inp rest

solve :: String -> String -> Int
solve _ [] = 0
solve (x:xs) ('0':us) = solve xs us
solve (x:next@(y:more@(z:rest))) ('1':us)
    | x == '1'  = 1 + solve next us
    | y == '0'  = 1 + solve ('2':more) us
    | z == '1'  = 1 + solve (y:'2':rest) us
    | otherwise = solve next us

import Control.Arrow ((>>>))
import Debug.Trace (trace)

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

solve :: [String] -> Int
solve [es, ps] = rec ps ("0" ++ es ++ "0")

rec :: String -> String -> Int
rec [] _ = 0
rec (p : ps) (el : e : er : es) = cur + rec ps (e' : er' : es)
  where
    (cur, e', er')
      | p == '0' = (0, e, er)
      | e == '0' = (1, '-', er)
      | el == '1' = (1, e, er)
      | er == '1' = (1, e, '-')
      | otherwise = (0, e, er)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import Control.Monad

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

subMain = do
    n <- readLn :: IO Int
    a <- BS.getLine
    b <- BS.getLine
    putStrLn . show $ memDp n a b

memDp = (map dp [0 ..] !!)

dp 0 _ _ = 0

dp 1 aStr bStr
    | BSC.head aStr == '0' && BSC.head bStr == '1' = 1
    | otherwise = 0

dp ind aStr bStr
    | b == '1' && prevB == '1' && a == '1' && prevA == '1' = max dp1A (dp2 + 2)
    | b == '1' && prevA == '1' = max dp1A (dp2 + 1)
    | prevB == '1' && a == '1' = max dp1A (dp2 + 1)
    | otherwise = dp1A
    where
        a = aStr `BSC.index` (ind - 1)
        prevA = aStr `BSC.index` (ind - 2)
        b = bStr `BSC.index` (ind - 1)
        prevB = bStr `BSC.index` (ind - 2)

        dp1 = memDp (ind - 1) aStr bStr
        dp2 = memDp (ind - 2) aStr bStr
        dp1A
            | b == '1' && a == '0' = dp1 + 1
            | otherwise = dp1

import Control.Monad

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

subMain = do
    n <- readLn :: IO Int
    a <- getLine
    b <- getLine
    putStrLn . show $ dp (reverse a) (reverse b)

dp (a : prevA : otherA) (b : prevB : otherB)
    | b == '1' && prevB == '1' && a == '1' && prevA == '1' = max dp1 (dp2 + 2)
    | b == '1' && prevA == '1' = max dp1 (dp2 + 1)
    | prevB == '1' && a == '1' = max dp1 (dp2 + 1)
    | b == '1' && a == '0' = dp1 + 1
    | otherwise = dp1
    where
        dp1 = dp (prevA : otherA) (prevB : otherB)
        dp2 = dp otherA otherB

dp (a : otherA) (b : otherB)
    | a == '0' && b == '1' = 1
    | otherwise = 0

dp [] [] = 0

import Control.Monad

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

subMain = do
    n <- readLn :: IO Int
    a <- getLine
    b <- getLine
    putStrLn . show $ dp (reverse a) (reverse b)

dp :: String -> String -> Int
dp (a : prevA : otherA) (b : prevB : otherB)
    | b == '1' && prevB == '0' && prevA == '1' = max dp1 (dp2 + 1)
    | b == '1' && prevB == '1' && a == '1' && prevA == '1' = max dp1 (dp2 + 2)
    | prevB == '1' && a == '1' = max dp1 (dp2 + 1)
    | b == '1' && a == '0' = dp1 + 1
    | otherwise = dp1
    where
        dp1 = dp (prevA : otherA) (prevB : otherB)
        dp2 = dp otherA otherB

dp (a : otherA) (b : otherB)
    | a == '0' && b == '1' = 1
    | otherwise = 0

dp [] [] = 0


Phoenix has collected $$$n$$$ pieces of gold, and he wants to weigh them together so he can feel rich. The $$$i$$$-th piece of gold has weight $$$w_i$$$. All weights are distinct. He will put his $$$n$$$ pieces of gold on a weight scale, one piece at a time. The scale has an unusual defect: if the total weight on it is exactly $$$x$$$, it will explode. Can he put all $$$n$$$ gold pieces onto the scale in some order, without the scale exploding during the process? If so, help him find some possible order. Formally, rearrange the array $$$w$$$ so that for each $$$i$$$ $$$(1 \le i \le n)$$$, $$$\sum\limits_{j = 1}^{i}w_j \ne x$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 100$$$; $$$1 \le x \le 10^4$$$) — the number of gold pieces that Phoenix has and the weight to avoid, respectively.  The second line of each test case contains $$$n$$$ space-separated integers $$$(1 \le w_i \le 100)$$$ — the weights of the gold pieces. It is guaranteed that the weights are pairwise distinct.

For each test case, if Phoenix cannot place all $$$n$$$ pieces without the scale exploding, print NO. Otherwise, print YES followed by the rearranged array $$$w$$$. If there are multiple solutions, print any.

NoteIn the first test case, Phoenix puts the gold piece with weight $$$3$$$ on the scale first, then the piece with weight $$$2$$$, and finally the piece with weight $$$1$$$. The total weight on the scale is $$$3$$$, then $$$5$$$, then $$$6$$$. The scale does not explode because the total weight on the scale is never $$$2$$$.In the second test case, the total weight on the scale is $$$8$$$, $$$9$$$, $$$11$$$, $$$14$$$, then $$$18$$$. It is never $$$3$$$.In the third test case, Phoenix must put the gold piece with weight $$$5$$$ on the scale, and the scale will always explode.

calculate :: [Int] -> Int -> Int -> [Int]
calculate [] acc value = []
calculate (x:xs) acc value
    | acc + x /= value = [x] ++ calculate xs (acc + x) value
    | otherwise = calculate (xs ++ [x]) acc value

getAns :: Int -> [Int] -> [String]
getAns value nums
    | sum nums == value = ["NO"]
    | otherwise = ["YES", unwords $ map show $ calculate nums 0 value]

solve :: [String] -> [String]
solve [] = []
solve (x:xs) =
  (getAns value $ toInt $ head xs) ++ (solve $ tail xs)
  where
      toInt str = map read $ words str
      [_, value] = toInt x

main =
  interact $ unlines . helper . lines
  where
      helper (x:xs) = solve xs

calculate :: [Int] -> Int -> Int -> [Int]
calculate [] acc value = []
calculate (x:xs) acc value
    | acc + x /= value = [x] ++ calculate xs (acc + x) value
    | otherwise = calculate ((head xs):x:(tail xs)) acc value

getAns :: Int -> [Int] -> [String]
getAns value nums
    | sum nums == value = ["NO"]
    | otherwise = ["YES", unwords $ map show $ calculate nums 0 value]

solve :: [String] -> [String]
solve [] = []
solve (x:xs) =
  (getAns value $ toInt $ head xs) ++ (solve $ tail xs)
  where
      toInt str = map read $ words str
      [_, value] = toInt x

main =
  interact $ unlines . helper . lines
  where
      helper (x:xs) = solve xs

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

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

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

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

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

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n,x] <- map parseInt . BS.words <$> BS.getLine
        a <- map parseInt . BS.words <$> BS.getLine
        let s = scanl1 (+) a
            win r = putStrLn "YES" >> (putStrLn . unwords . map show $ r)
            lose = putStrLn "NO"
        case elemIndex x s of
            Just i ->
                if i == n-1 then
                    lose
                else
                    win $ take i a ++ [a !! (i+1), a !! i] ++ drop (i+2) a
            Nothing ->
                win a

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, x] <- readInts
    w <- readInts
    case  [i | (i, wps) <- zip [0..] $ scanl (+) 0 w, wps == x]  of
      [] -> lift (putStrLn "YES") >> putInts w
      [ix] | ix == n -> lift $ putStrLn "NO"
           | otherwise -> let
               (p1, p2:p3:p4) = splitAt (ix - 1) w
             in  lift (putStrLn "YES") >> putInts (p1 ++ p3:p2:p4)

type SIO = StateT P.ByteString IO

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

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

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


Martian scientists explore Ganymede, one of Jupiter's numerous moons. Recently, they have found ruins of an ancient civilization. The scientists brought to Mars some tablets with writings in a language unknown to science.They found out that the inhabitants of Ganymede used an alphabet consisting of two letters, and each word was exactly $$$\ell$$$ letters long. So, the scientists decided to write each word of this language as an integer from $$$0$$$ to $$$2^{\ell} - 1$$$ inclusively. The first letter of the alphabet corresponds to zero bit in this integer, and the second letter corresponds to one bit.The same word may have various forms in this language. Then, you need to restore the initial form. The process of doing it is described below.Denote the distance between two words as the amount of positions, in which these words differ. For example, the distance between $$$1001_2$$$ and $$$1100_2$$$ (in binary) is equal to two, as these words have different letters in the second and the fourth positions, counting from left to right. Further, denote the distance between words $$$x$$$ and $$$y$$$ as $$$d(x, y)$$$.Let the word have $$$n$$$ forms, the $$$i$$$-th of which is described with an integer $$$x_i$$$. All the $$$x_i$$$ are not necessarily different, as two various forms of the word can be written the same. Consider some word $$$y$$$. Then, closeness of the word $$$y$$$ is equal to the sum of distances to each of the word forms, i. e. the sum $$$d(x_i, y)$$$ over all $$$1 \le i \le n$$$.The initial form is the word $$$y$$$ with minimal possible nearness.You need to help the scientists and write the program which finds the initial form of the word given all its known forms. Note that the initial form is not necessarily equal to any of the $$$n$$$ given forms.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The following are descriptions of the test cases. The first line contains two integers $$$n$$$ and $$$\ell$$$ ($$$1 \le n \le 100$$$, $$$1 \le \ell \le 30$$$) — the amount of word forms, and the number of letters in one word. The second line contains $$$n$$$ integers $$$x_i$$$ ($$$0 \le x_i \le 2^\ell - 1$$$) — word forms. The integers are not necessarily different.

For each test, print a single integer, the initial form of the word, i. e. such $$$y$$$ ($$$0 \le y \le 2^\ell - 1$$$) that the sum $$$d(x_i, y)$$$ over all $$$1 \le i \le n$$$ is minimal possible. Note that $$$y$$$ can differ from all the integers $$$x_i$$$. If there are multiple ways to restore the initial form, print any.

NoteIn the first test case, the words can be written as $$$x_1 = 10010_2$$$, $$$x_2 = 01001_2$$$ and $$$x_3 = 10101_2$$$ in binary. Let $$$y = 10001_2$$$. Then, $$$d(x_1, y) = 2$$$ (the difference is in the fourth and the fifth positions), $$$d(x_2, y) = 2$$$ (the difference is in the first and the second positions), $$$d(x_3, y) = 1$$$ (the difference is in the third position). So, the closeness is $$$2 + 2 + 1 = 5$$$. It can be shown that you cannot achieve smaller closeness.In the second test case, all the forms are equal to $$$18$$$ ($$$10010_2$$$ in binary), so the initial form is also $$$18$$$. It's easy to see that closeness is equal to zero in this case.

import Control.Monad (replicateM_)
import Data.Maybe (fromJust)
import Data.List
import Data.Bits
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

toBinList x len = [x.&.(2^i) /= 0 | i <- [0..(len-1)]]
toAnswerBinList xss =
    (\xs -> length (filter (==True) xs) > length (filter (==False) xs)) <$> xss
binListToInt xs = sum $ zipWith (\binItem value -> if binItem then value else 0) xs ((2^) <$> [0..])

main = getLine >>= flip replicateM_ run . read
run = do
    [n, len] <- (read <$>) . words <$> getLine
    xs <- (fst.fromJust.B.readInt <$>) . B.words <$> B.getLine
    B.putStrLn.B.pack.show. binListToInt.toAnswerBinList.transpose $ (`toBinList` len) <$> xs