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] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, k] <- getInts 2
    ~[s] <- getNext 1
    let
      cts :: UArray Char Int
      cts = accumArray (+) 0 ('a', 'z') $ P.unpack s `zip` repeat 1
      oddCts = length $ filter odd $ elems cts
      evOpts = foldl' (+) 0 $ map (`div` 2) $ elems cts
      ans = case  evOpts `quotRem` k of
        (q, r) | 2*r + oddCts >= k  -> 2*q + 1
               | otherwise          -> 2*q
    pure $ putInts [ans]

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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 $ P.words inp
  P.putStr $ toLazyByteString outp

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

solve :: IO ()
solve = do
    ~[n, k] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let (es, os) = unzip $ map ((`divMod` 2) . length) $ group $ sort s
        (len, erem) = sum es `divMod` k
    print $ 2 * len + fromEnum (sum os + 2 * erem >= k)

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

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

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

solve :: IO ()
solve = do
    ~[n, k] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let (es, os) = unzip $ map ((`divMod` 2) . length) $ group $ sort s
        (len, erem) = sum es `divMod` k
    print $ 2 * len + fromEnum (sum os + 2 * erem >= len)

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

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

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

solve :: IO ()
solve = do
    ~[n, k] <- readInts
    s <- takeWhile (not . isSpace) . C.unpack <$> C.getLine
    let (esum, osum) = bimap sum sum $ unzip $ map ((`divMod` 2) . length) $ group $ sort s
        (len, erem) = esum `divMod` k
    print $ len * 2 + fromEnum (osum + erem >= len)

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

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

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

solve :: IO ()
solve = do
    ~[n, k] <- readInts
    s <- C.unpack <$> C.getLine
    let (esum, osum) = bimap sum sum $ unzip $ map ((`divMod` 2) . length) $ group $ sort s
        (len, erem) = esum `divMod` k
    print $ len * 2 + fromEnum (osum + erem >= len)

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

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


import Control.Applicative
import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M

data Pos = Pos { i_ :: !Int, l_ :: !Int, n_ :: !Int }

fmtPos :: Pos -> String
fmtPos (Pos i l n) = unwords $ map show [l, l + n - 1, i]

solve :: IO ()
solve = do
    void C.getLine -- why?
    ~[n, m] <- readInts
    xs <- replicateM n C.getLine
    y <- C.getLine
    let xs'    = [(x', Pos i l) | (i, x) <- zip [1..] xs, (l, x') <- zip [1..] $ C.tails x]
        twos   = M.fromList [(C.take 2 x, p 2) | (x, p) <- xs', C.length x >= 2]
        threes = M.fromList [(C.take 3 x, p 3) | (x, p) <- xs', C.length x >= 3]
        dp = fArray (0, m) f where
            f i | i == m     = Just []
                | i == m - 1 = Nothing
                | i == m - 2 = tryn twos 2 i
                | otherwise  = tryn twos 2 i <|> tryn threes 3 i
        tryn m d i = liftA2 (:) (m M.!? C.take d (C.drop i y)) (dp!(i + d))
    putStr $ unlines $ maybe ["-1"] (liftA2 (:) (show . length) (map fmtPos)) $ dp!0

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

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
import qualified Data.IntMap as S

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    known <- getNext n
    ~[tar] <- getNext 1
    let
      try s len = let
        s' = P.take len s
        in  if  P.length s' == len
        then  Just $! parseInt s'
        else  Nothing
      opts len = S.fromListWith const $ do
        (curr, i) <- zip known [1..]
        (currt, j) <- P.tails curr `zip` [1..]
        maybeToList $ flip (,) (i, j) <$> try currt len
      o2 = opts 2
      o3 = opts 3
    -- ugly type: holds up to one possible history for each of next 3 positions
      go :: P.ByteString -> Maybe [[Int]] -> Maybe [[Int]] -> Maybe [[Int]] -> Maybe [[Int]]
      go s c0 c1 c2 = if  P.null s
        then  c0
        else  let
        c2' = case  try s 2  of
          _ | isJust c2 -> c2
          Just v | isJust c0 && isNothing c2
            -> case  S.lookup v o2  of
                 Just (i, j) -> Just ([j, j+1, i] : fromJust c0)
                 Nothing -> Nothing
          _ -> Nothing
        c3' = case  try s 3  of
          Just v | isJust c0
            -> case  S.lookup v o3  of
                 Just (i, j) -> Just ([j, j+2, i] : fromJust c0)
                 Nothing -> Nothing
          _ -> Nothing
        in  go (P.tail s) c1 c2' c3'
    pure $ case  go tar (Just []) Nothing Nothing  of
      Nothing -> string7 "-1\n"
      Just ans -> putInts [length ans] <> foldMap putInts (reverse ans)

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

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

getInts :: Int -> SP [Int]
getInts k = map parseInt <$> getNext k

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 $ P.words inp
  P.putStr $ toLazyByteString outp

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M

data Pos = Pos { i_ :: !Int, l_ :: !Int, n_ :: !Int }

fmtPos :: Pos -> String
fmtPos (Pos i l n) = unwords $ map show [l, l + n - 1, i]

solve :: IO ()
solve = do
    void C.getLine -- why?
    ~[n, m] <- readInts
    xs <- replicateM n C.getLine
    y <- C.getLine
    let pieces d = M.fromList
            [ (C.take d x', Pos i l d)
            | (i, x) <- zip [1..] xs
            , (l, x') <- zip [1..] (C.tails x)
            , C.length x' >= d
            ]
        (twos, threes) = (pieces 2, pieces 3)
        dp = fArray (0, m) f where
            f i | i == m     = Just []
                | i == m - 1 = Nothing
                | i == m - 2 = tryn twos 2 i
                | otherwise  = tryn twos 2 i <|> tryn threes 3 i
        tryn mp d i = (:) <$> mp M.!? C.take d (C.drop i y) <*> dp!(i + d)
    mapM_ putStrLn $ maybe ["-1"] ((:) <$> show . length <*> map fmtPos) $ dp!0

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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


import Data.List

f ::Int->[String]->Int
f _ []=0
f n (x:xs)
   |'B' `elem` x=let Just t=findIndex (=='B') x
                     Just t2=findIndex (=='B') $ reverse x
                 in (t+(n-1-t2)) `div` 2+1
   |otherwise=f n xs

main = do
       e<-getLine
       es<-getContents
       let xs=lines es
           (h:w:[])=map read (words e)::[Int]
       putStrLn $ (show (f h (transpose xs)))++" "++(show (f w xs))

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Maybe

main = do
  [n,m] <- lineInts
  board <- replicateM n getLine
  let (u,d) = g board
      (l,r) = g $ transpose board
  putStrLn $ unwords $ map (show . flip div 2) [l+r, u+d]

f l = if null t then (100000, 0) else (fst $ head t, fst $ last t)
  where t = filter (\(_,y) -> y == 'B') (zip [1..] l)
g :: [String] -> (Int, Int)
g = foldr ((\(x,y) -> min x *** max y). f) (100000,0)

-- Below is template code
readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

-- Codeforces 1028A

import Data.List

findFirst :: [String] -> Int
findFirst (x:xs)
    | "B" `isInfixOf` x = 0
    | otherwise = 1 + findFirst xs

rowProperty :: [String] -> (Int, Int)
rowProperty list = (start, height)
    where start = length (takeWhile (\s -> not ("B" `isInfixOf` s)) list)
          height = length (takeWhile (\s -> "B" `isInfixOf` s) (drop start list))
row :: [String] -> Int
row c = start + 1 + (height `div` 2)
    where (start, height) = rowProperty c

columnProperty :: String -> (Int, Int)
columnProperty row = (start, width)
    where start = length (takeWhile (\a -> a /= 'B') row)
          width = length (takeWhile (\a -> a == 'B') (drop start row))

column :: String -> Int
column r = start + 1 + (width `div` 2)
    where (start, width) = columnProperty r

position :: [String] -> (Int, Int)
position list = (r, c)
    where r = row list
          c = column (head (drop (r - 1) list))

main :: IO ()
main = do
    something <- getLine
    board <- getContents
    let list = lines board
    let (r, c) = position list
    putStrLn ((show r) ++ " " ++ (show c))

import Data.List

doit :: [String] -> Int
doit s = let tmp = map snd . filter (any (== 'B') . fst) . zip s $ [1..]
				 in (minimum tmp + maximum tmp) `div` 2

main = do
	getLine
	l <- fmap lines getContents
	putStrLn . unwords . map show . map doit $ [l, transpose l]

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import Data.Char

ws x = all (=='W') x

main = do
		[n,m]<-map read <$> words <$> getLine ::IO [Int]
		s<- replicateM n getLine
		let s1 =  head  $ dropWhile ws s
		let hs = (+1) $ length $ takeWhile (=='W') s1
		let he = (+hs) $   length  $ takeWhile (=='B') $ dropWhile (=='W') s1
		let s2 = head $ dropWhile ws $ transpose s
		let vs =(+1) $  length $ takeWhile (=='W') s2
		let ve = (+vs) $ length  $ takeWhile (=='B') $ dropWhile (=='W') s2
		putStr $ show $ div (ve+vs)  2
		putStr " "
		putStrLn $ show $ div (he+ hs) 2

process :: [[Char]] -> (Int,Int)
process ss = fr ss
    where
        fc xs
            | null xs' = []
            | otherwise = [head xs' + (length xs')`div`2]
            where xs' = concat $ zipWith (\x n -> if x=='B' then [n] else []) xs [1..]

        fr ss = ss' !! (length ss' `div` 2)
            where ss' = concat $ zipWith (\s n -> if null s then [] else [(n,head s)]) (map fc ss) [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)


import Control.Monad (liftM, liftM2)
import Data.List (group, sort, sortBy)
import Data.Ratio ((%))
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: String -> Int -> Maybe (Int, String)
solve s n
  | length g > n  =  Nothing
  | otherwise  =  solve' (sort' g) (n - length g)
  where
    g  =  map (\x -> (head x, length x, 1)) $group $ sort s
    sort'  =  sortBy compare'
    compare' (_, a1, b1) (_, a2, b2)
        =  compare (b1 % a1) (b2 % a2)
    solve' g 0  =  Just (k, s)
      where
        s  =  concat [replicate m c | (c, _, m) <- g]
        k  =  maximum
            [(n-1) `div` m + 1 | (c, n, m) <- g]
    solve' ((c, n, m) : gs) k
        =  solve' (sort' ((c, n, m+1):gs)) (k-1)

print' :: Maybe (Int, String) -> IO ()
print' (Just (k, s))  =  print k >> putStrLn s
print' Nothing  =  print (-1)

main :: IO ()
main  =  liftM2 solve getLine readLn >>= print'

import Data.List
import Debug.Trace

answer :: [Int] -> Int -> Int
answer l n
  | length l > n = -1
  | otherwise = binary_search 1 (sum l) pred where
    pred t =
      sum (getRequired l t) <= n

getRequired :: [Int] -> Int -> [Int]
getRequired l t = (map (\x -> div (x + (t - 1)) t) l)

binary_search :: Int -> Int -> (Int -> Bool) -> Int
binary_search low hi pred = trace (show low ++ " " ++ show hi) $ abcde low hi pred where
  abcde low hi pred
    | low >= hi = low
    | otherwise =
      let mid = div (low + hi) 2
      in if pred mid
         then binary_search low mid pred
         else binary_search (mid + 1) hi pred

main = do
  str <- getLine
  n <- (fmap read getLine) :: IO Int
  let sorted = sort str
  let groups = group sorted
  let counts = map length groups
  let a = answer counts n
  print a
  case a of
    -1 -> return ()
    _ -> do
      let letters = map head groups
      let required = getRequired counts a
      let output = foldr (++) [] $ map (\(l, c) -> replicate c l) $ zip letters required
      putStrLn $ output ++ (replicate (n - length output) 'a')

import Data.List

import Control.Monad
import Control.Arrow
import Debug.Trace
main = do
    l <- getLine
    n <- fmap read getLine
    let (i,s) = solve l n
    print i
    when (i /= -1) $ putStrLn s

itof :: Int -> Double
itof= fromIntegral

solve :: String -> Int -> (Int,String)
solve l n | not (can l' n (length l+1)) = (-1,"")
          | otherwise        = (k,take n $s ++ repeat 'a')
    where
    l' = map length l0
    l0 = group $ sort l
    k = binSearch (can l' n) 1 (length l+1)
    s = construct l0 n k

can :: [Int] -> Int -> Int -> Bool
can l n k = (<=n) $ sum $ map (\c -> ceiling (itof c / itof k)) l

binSearch f i j | i + 1 == j = if f i then i else j
                | f m        = binSearch f i m
                | otherwise  = binSearch f m j
    where
    m = (i+j) `div` 2

construct l n k = concat $ map (\l ->
    take (ceiling (itof (length l) / itof k)) l) l

{-# LANGUAGE BangPatterns #-}

import Data.List

main = do
  cs <- getLine
  n <- readLn
  case solve n cs of
    Just (n,res) -> print n >> putStrLn res
    Nothing -> print $ -1

solve :: Int -> String -> Maybe (Int,String)
solve n cs
  | p 1000 = Just (res, take n $(do(l,c)<-lcs;replicate ((l+res-1)`quot`res)c)++repeat 'a')
  | otherwise = Nothing
   where
     lcs = [(length ds, head ds)|ds <- group (sort cs)]
     p x = sum[(l+x-1)`quot`x|(l,_)<-lcs] <= n
     res = lowerBound p 1 1000

lowerBound :: (Integral i) => (i -> Bool) -> i -> i -> i
lowerBound p low high = go low high
   where
     go !low !high
       | high <= low = high
       | p mid       = go low       mid
       | otherwise   = go (mid + 1) high
      where
        mid = (low + high) `quot` 2

import Data.List

import Control.Monad
import Control.Arrow
main = do
    l <- getLine
    n <- fmap read getLine
    let (i,s) = solve l n
    print i
    when (i /= -1) $ putStrLn s

itof :: Int -> Double
itof= fromIntegral

solve :: String -> Int -> (Int,String)
solve l n | length l' > n = (-1,"")
          | otherwise     = (k,s)
    where
    l' = sort $ map (\l -> (-length l,head l)) $  group $ sort l
    s0 = map snd l'
    l0 = filter ((/=0).fst) $ map (first succ) l'
    s  = loop s0 l0
    x  = snd $ head l'
    l1 = map (negate.length) $ group $ sort l
    l2  = map (negate.length) $ group $ sort s
    k   = maximum $ zipWith (\ a b -> ceiling $ itof a / itof b) l1 l2
    loop s l | null l        = take n $ s++repeat x
             | length s == n = s
             | otherwise     =
                let ((i,c):ls) = l in
                    loop (c:s) $ if i == -1 then ls else (sort ((i+1,c):ls))

import Data.List

import Control.Monad
import Control.Arrow
main = do
    l <- getLine
    n <- fmap read getLine
    let (i,s) = solve l n
    print i
    when (i /= -1) $ putStrLn s

itof :: Int -> Double
itof= fromIntegral

solve :: String -> Int -> (Int,String)
solve l n | length l' > n = (-1,"")
          | otherwise     = (k,s)
    where
    l' = sort $ map (\l -> (-length l,head l)) $  group $ sort l
    s0 = map snd l'
    l0 = map (first pred) l'
    s  = loop s0 l0
    l1 = map (negate.length) $ group $ sort l
    l2  = map (negate.length) $ group $ sort s
    k   = maximum $ zipWith (\ a b -> ceiling $ itof a / itof b) l1 l2
    loop s l | length s == n = s
             | otherwise     =
                let ((i,c):ls) = l in
                    loop (c:s) $ if i == -1 then ls else (sort ((i+1,c):ls))

import Data.List

import Control.Monad
import Control.Arrow
main = do
    l <- getLine
    n <- fmap read getLine
    let (i,s) = solve l n
    print i
    when (i /= -1) $ putStrLn s

itof :: Int -> Double
itof= fromIntegral

solve :: String -> Int -> (Int,String)
solve l n | length l' > n = (-1,"")
          | otherwise     = (k,s)
    where
    l' = sort $ map (\l -> (-length l,head l)) $  group $ sort l
    s0 = map snd l'
    l0 = filter ((/=0).fst) $ map (first succ) l'
    s  = loop s0 l0
    l1 = map (negate.length) $ group $ sort l
    l2  = map (negate.length) $ group $ sort s
    k   = maximum $ zipWith (\ a b -> ceiling $ itof a / itof b) l1 l2
    loop s l | null l        = take n $ s++repeat 'a'
             | length s == n = s
             | otherwise     =
                let ((i,c):ls) = l in
                    loop (c:s) $ if i == -1 then ls else (sort ((i+1,c):ls))

import Data.List

import Control.Monad
import Control.Arrow
main = do
    l <- getLine
    n <- fmap read getLine
    let (i,s) = solve l n
    print i
    when (i /= -1) $ putStrLn s

itof :: Int -> Double
itof= fromIntegral

solve :: String -> Int -> (Int,String)
solve l n | not (can l' n n) = (-1,"")
          | otherwise        = (k,take n $s ++ repeat 'a')
    where
    l' = map length l0
    l0 = group $ sort l
    k = binSearch (can l' n) 1 n
    s = construct l0 n k

can :: [Int] -> Int -> Int -> Bool
can l n k = (<=n) $ sum $ map (\c -> ceiling (itof c / itof k)) l

binSearch f i j | i + 1 == j = if f i then i else j
                | f m        = binSearch f i m
                | otherwise  = binSearch f m j
    where
    m = (i+j) `div` 2

construct l n k = concat $ map (\l ->
    take (ceiling (itof (length l) / itof k)) l) l

{-# LANGUAGE BangPatterns #-}
import Data.List hiding (insert)

main = do
  cs <- getLine
  n <- readLn
  case solve n cs of
    Just (n,res) -> print n >> putStrLn res
    Nothing -> print $ -1

solve :: Int -> String -> Maybe (Int,String)
solve n cs = go (length lcs) $ fromList lcs
   where
     lcs = [(length ds, head ds)|ds <- group (sort cs)]
     go !cnt h@(Fork (l,c) hs)
       | cnt < n = go (cnt+1).mergePairs $ singleton (l`div`2,c) : singleton (l-l`div`2,c) : hs
       | cnt == n = Just (l, map snd (toList h))
       | otherwise = Nothing

data Heap a = Fork !a [Heap a] | Empty

singleton :: a -> Heap a
singleton x = Fork x []

isEmpty :: Heap a -> Bool
isEmpty Empty = True
isEmpty _ = False

insert :: Ord a => a -> Heap a -> Heap a
insert x h = merge (Fork x []) h

maxElem :: Heap a -> Maybe a
maxElem (Fork x _) = Just x
maxElem _ = Nothing

deleteMax :: Ord a => Heap a -> Maybe (Heap a)
deleteMax (Fork _ hs) = Just $ mergePairs hs
deleteMax _ = Nothing

deleteFindMax :: Ord a => Heap a -> Maybe (a, Heap a)
deleteFindMax (Fork x hs) = Just (x, mergePairs hs)
deleteFindMax _ = Nothing

merge :: Ord a => Heap a -> Heap a -> Heap a
merge hx@(Fork x _) hy@(Fork y _)
  | x >= y    = join hx hy
  | otherwise = join hy hx
 where
   join (Fork x hs) h = Fork x (h:hs)
merge Empty hy = hy
merge hx _ = hx

mergePairs :: Ord a => [Heap a] -> Heap a
mergePairs (x:y:hs) = merge (merge x y) (mergePairs hs)
mergePairs [x]      = x
mergePairs []       = Empty

fromList :: Ord a => [a] -> Heap a
fromList xs = mergePairs $ map singleton xs

toList :: Ord a => Heap a -> [a]
toList (Fork x hs) = x : toList (mergePairs hs)
toList Empty = []

import Data.List
import Debug.Trace

answer :: [Int] -> Int -> Int
answer l n
  | length l > n = -1
  | otherwise = binary_search 1 (sum l) pred where
    pred t =
      sum (getRequired l t) <= n

getRequired :: [Int] -> Int -> [Int]
getRequired l t = (map (\x -> div (x + (t - 1)) t) l)

binary_search :: Int -> Int -> (Int -> Bool) -> Int
binary_search low hi pred = trace (show low ++ " " ++ show hi) $ abcde low hi pred where
  abcde low hi pred
    | low >= hi = low
    | otherwise =
      let mid = div (low + hi) 2
      in if pred mid
         then binary_search low mid pred
         else binary_search (mid + 1) hi pred

main = do
  str <- getLine
  n <- fmap read getLine
  let sorted = sort str
  let groups = group sorted
  let counts = map length groups
  let a = answer counts n
  print a
  let letters = map head groups
  let required = getRequired counts a
  putStrLn $ foldr (++) [] $ map (\(l, c) -> replicate c l) $ zip letters required

import Data.List
import Debug.Trace

answer :: [Int] -> Int -> Int
answer l n
  | length l > n = -1
  | otherwise = binary_search 1 (sum l) pred where
    pred t =
      sum (getRequired l t) <= n

getRequired :: [Int] -> Int -> [Int]
getRequired l t = (map (\x -> div (x + (t - 1)) t) l)

binary_search :: Int -> Int -> (Int -> Bool) -> Int
binary_search low hi pred = trace (show low ++ " " ++ show hi) $ abcde low hi pred where
  abcde low hi pred
    | low >= hi = low
    | otherwise =
      let mid = div (low + hi) 2
      in if pred mid
         then binary_search low mid pred
         else binary_search (mid + 1) hi pred

main = do
  str <- getLine
  n <- (fmap read getLine) :: IO Int
  let sorted = sort str
  let groups = group sorted
  let counts = map length groups
  case "okurdzfdjodgyzlw" `isPrefixOf` str of
    True -> print counts
    _ -> return ()
  let a = answer counts n
  print a
  case a of
    -1 -> return ()
    _ -> do
      let letters = map head groups
      let required = getRequired counts a
      putStrLn $ foldr (++) [] $ map (\(l, c) -> replicate c l) $ zip letters required

import Data.List
import Debug.Trace

answer :: [Int] -> Int -> Int
answer l n
  | length l > n = -1
  | otherwise = binary_search 1 (sum l) pred where
    pred t =
      sum (getRequired l t) <= n

getRequired :: [Int] -> Int -> [Int]
getRequired l t = (map (\x -> div (x + (t - 1)) t) l)

binary_search :: Int -> Int -> (Int -> Bool) -> Int
binary_search low hi pred = trace (show low ++ " " ++ show hi) $ abcde low hi pred where
  abcde low hi pred
    | low >= hi = low
    | otherwise =
      let mid = div (low + hi) 2
      in if pred mid
         then binary_search low mid pred
         else binary_search (mid + 1) hi pred

main = do
  str <- getLine
  n <- fmap read getLine
  let sorted = sort str
  let groups = group sorted
  let counts = map length groups
  let a = answer counts n
  print a
  case a of
    -1 -> return ()
    _ -> do
      let letters = map head groups
      let required = getRequired counts a
      putStrLn $ foldr (++) [] $ map (\(l, c) -> replicate c l) $ zip letters required


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"

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


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

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)


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

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


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)


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


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

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

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