A progress bar is an element of graphical interface that displays the progress of a process for this very moment before it is completed. Let's take a look at the following form of such a bar.A bar is represented as n squares, located in line. To add clarity, let's number them with positive integers from 1 to n from the left to the right. Each square has saturation (ai for the i-th square), which is measured by an integer from 0 to k. When the bar for some i (1 ≤ i ≤ n) is displayed, squares 1, 2, ... , i - 1 has the saturation k, squares i + 1, i + 2, ... , n has the saturation 0, and the saturation of the square i can have any value from 0 to k.So some first squares of the progress bar always have the saturation k. Some last squares always have the saturation 0. And there is no more than one square that has the saturation different from 0 and k.The degree of the process's completion is measured in percents. Let the process be t% completed. Then the following inequation is fulfilled: An example of such a bar can be seen on the picture.  For the given n, k, t determine the measures of saturation for all the squares ai of the progress bar.

We are given 3 space-separated integers n, k, t (1 ≤ n, k ≤ 100, 0 ≤ t ≤ 100).

Print n numbers. The i-th of them should be equal to ai.

module Main where

import Control.Monad

main = do
    [n, k, t] <- ( map read . words ) `liftM` getLine

    let a = n * t `div` 100
        m = ( n * t - 100 * a ) * k `div` 100
        out = unwords $ map show $ if a == n
            then replicate a k
            else replicate a k ++ [m] ++ replicate (n-a-1) 0

    putStrLn out

solve :: Int -> Int -> Int -> [Int]
solve n k t
	| t <= k = t:(take (n-1) (repeat 0))
	| otherwise = k:(solve (n-1) k (t-k))

main = do
	[n,k,t] <- getLine >>= return . map read . words
	putStrLn . unwords . map show $ solve n k ((n*k)*t`div`100)

printAns :: Int -> Int -> Int -> Int -> IO ()
printAns n k m m2 =
  putStrLn (foldl (\x y -> x ++ show k ++ " ") "" [1..m]
            ++ if m == n then "" else (show m2)
            ++ foldl (\x y -> x ++ " 0") "" [1..(n - m - 1)])

main = do
  line <- getLine
  let [n, k, t] = map (read::String->Int) (words line)
  let j = div (t * n * k) 100
  let m = div (t * n) 100
  let m2 = div (t * n * k - 100 * m * k) 100
  printAns n k m m2

-- Codeforces 71B

import Control.Applicative
import Data.List

main :: IO ()
main = do
    [n, k, t] <- (map read . words) <$> getLine :: IO [Int]
    let (u, v) = (t * (n * k) `div` 100) `divMod` k
        r = if u == n
               then replicate u k
               else replicate u k ++ [v] ++ replicate (n - u - 1) 0
    putStrLn $ intercalate " " (map show r)

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

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

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = map read . words <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

calc :: Double -> Double -> Double -> (Int, Int)
calc n k t =
  let
    i = floor (n*t/100) + 1
    ai = floor (n*k*t/100 - (fi i - 1) * k)
  in (i, ai)

makeBar :: Double -> Double -> Int -> Int -> String
makeBar n k i ai =
  unwords . map show $ values
  where
    values :: [Int]
    values
      | n >= fi i = replicate (i - 1) (round k) ++ [ai] ++ replicate (round n - i) 0
      | otherwise = replicate (round n) (round k)

main = do
  [n, k, t] <- doubles
  let (i, ai) = calc n k t
  putStrLn $ makeBar n k i ai

main = do
	[n, k, t] <- (map read . words) `fmap` getLine
        let t' = toRational (t * n) / 100
            (чёрные, серость) = properFraction t'
            as = replicate чёрные k ++
                    replicate (ceiling серость) (floor (toRational k * серость)) ++
                    replicate (n - ceiling t') 0
	putStrLn $ unwords $ map show as

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

gen k t
	| t >= k = Just (show k,t-k)
	| t > 0 = Just (show t,0)
	| otherwise = Just (show 0,0)

main = do
	(sn:sk:st:_) <- words <$> getLine
	let n = read sn :: Int
	let k = read sk :: Int
	let t = read st :: Int
	putStr $ unwords $ take n $ unfoldr (gen k) $ truncate $ realToFrac (t*k*n)/100

module Main where

--import Debug.Trace

import Control.Monad
import Control.DeepSeq
import Data.Function
import Data.List
import Data.Char

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = fmap head . sequence . map print
printStrs = fmap head . sequence . map putStrLn

process :: Int -> Int -> Int -> [Int]
process n k t = take n infBar where
    b = floor (fromIntegral (n * k * t) / 100)
    (q, r) = b `divMod` k
    infBar = replicate q k ++ [r] ++ repeat 0

main = do
    (n:k:[t]) <- getInts
    putStrLn . unwords . map show $ process n k t

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

g:: Int -> Int -> Int -> (Int,Int)
g n k t = (s,m)
    where n'  = (n*k*t `div` 100)
          s   = n' `div` k
          m   = n' `mod` k

floor' :: (Integral a) => a -> a
floor' = floor . fromIntegral

f n m s k = take n (l ++ [m] ++ r)
    where l = ((take (fromIntegral s)) . repeat $ k)
          m' = (if (length (l++r))>=n then [] else [m])
          r = repeat 0

main :: IO ()
main = do { n:k:t:_ <- map read . split . head . lines <$> getContents
          ; let (s,m) = g n k t in
            mapM_ (printf "%d ") $ f n m s k
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

g:: Int -> Int -> Int -> (Int,Int)
g n k t = (s,m)
    where n'  = (n*k*t `div` 100)
          s   = n' `div` k
          m   = n' `mod` k

floor' :: (Integral a) => a -> a
floor' = floor . fromIntegral

f n m s k = l ++ m' ++ r
    where l = ((take (fromIntegral s)) . repeat $ k)
          m' = (if (length (l++r))>=n then [] else [m])
          r = (take (n-(fromIntegral s) - 1) . repeat $ 0)

main :: IO ()
main = do { n:k:t:_ <- map read . split . head . lines <$> getContents
          ; let (s,m) = g n k t in
            mapM_ (printf "%d ") $ f n m s k
          }

main=getLine>>=putStrLn.unwords.slv.map read.words
slv :: [Int] -> [String]
slv (n:k:100:_) = map show $ replicate n k
slv (n:k:t:_) =
    map show $ replicate nFull k ++ [v] ++ replicate (n - nFull - 1) 0
    where
        nFull = p `div` k
        v = p `mod` k
        p = floor $ (fromIntegral k)*(fromIntegral n)*(fromIntegral t) / 100

-- Codeforces 71B

import Control.Applicative
import Data.List

main :: IO ()
main = do
    [n, k, t] <- (map read . words) <$> getLine :: IO [Int]
    let (u, v) = (t * (n * k) `div` 100) `divMod` k
        r = if u == n
               then replicate u k
               else replicate u k ++ [v] ++ replicate (n - u - 1) 0
    print (u, v)
    putStrLn $ intercalate " " (map show r)

-- Codeforces 71B

import Control.Applicative
import Data.List

main :: IO ()
main = do
    [n, k, t] <- (map read . words) <$> getLine :: IO [Int]
    let (u, v) = (t * (n * k) `div` 100) `divMod` k
        r = replicate u k ++ [v] ++ replicate (n - u - 1) 0
    putStrLn $ intercalate " " (map show r)

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

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

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = map read . words <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

calc :: Double -> Double -> Double -> (Int, Int)
calc n k t =
  let i = floor (n*t/100) + 1
      ai = floor (n*k*t/100 - (fi i - 1) * k)
  in (i, ai)

makeBar :: Double -> Double -> Int -> Int -> String
makeBar n k i ai =
  unwords . map show $ values
  where
    values :: [Int]
    values = replicate (i - 1) (round k) ++ [ai] ++ replicate (round n - i) 0

main = do
  [n, k, t] <- doubles
  let (i, ai) = calc n k t
  putStrLn $ makeBar n k i ai

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

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

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = read <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

progressbar :: Int -> Int -> Int -> [Int]
progressbar n k t =
  let t' = fi t
      n' = fi n
      k' = fi k
      sigai = n' * k' * t' / 100
      (nSats, rem) = floor sigai `divMod` k
  in  replicate nSats k ++ [rem] ++ replicate (n - nSats - 1) 0

main = do
  [n, k, t] <- ints
  let res = progressbar n k t
  putStrLn (unwords (map show res))

main = do
	[n, k, t] <- (map read . words) `fmap` getLine
	let tnk = t * n * k
	    f s | (s + k) * 100 < tnk = k
		| s * 100 <= tnk && (s + k) * 100 > tnk = (tnk - s * 100) `div` 100
		| otherwise = 0
	let as = reverse $ snd $ foldl (\(s, as) _ -> (s + f s, f s:as)) (0, []) [1..n]
	putStrLn $ unwords $ map show as

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

g:: Int -> Int -> Int -> (Int,Int)
g n k t = (s,m)
    where n'  = (n*k*t `div` 100)
          s   = n' `div` k
          m   = n' `mod` k

floor' :: (Integral a) => a -> a
floor' = floor . fromIntegral

f n m s k = ((take (fromIntegral s)) . repeat $ k) ++ [m] ++ (take (n-(fromIntegral s) - 1) . repeat $ 0)

main :: IO ()
main = do { n:k:t:_ <- map read . split . head . lines <$> getContents
          ; let (s,m) = g n k t in
            mapM_ (printf "%d ") $ f n m s k
          }

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Main where
import Control.Applicative
import Data.List
import Text.Printf

splitBy :: (a -> Bool) -> [a] -> [[a]]
splitBy p [] = []
splitBy p xs = a : (splitBy p $ dropWhile p $ b)
   where
     (a, b) = break p xs

split :: String -> [String]
split = splitBy (==' ')

g:: Int -> Int -> Int -> (Int,Int)
g n k t = (s,m)
    where n'  = (n*k*t `div` 100)
          s   = n' `div` k
          m   = n' `mod` k

floor' :: (Integral a) => a -> a
floor' = floor . fromIntegral

f n m s k = take n (l ++ [m] ++ [0..])
    where l = ((take (fromIntegral s)) . repeat $ k)
          m' = (if (length (l++r))>=n then [] else [m])
          r = repeat 0

main :: IO ()
main = do { n:k:t:_ <- map read . split . head . lines <$> getContents
          ; let (s,m) = g n k t in
            mapM_ (printf "%d ") $ f n m s k
          }

main=getLine>>=putStrLn.unwords.slv.map read.words
slv :: [Int] -> [String]
slv (n:k:t:_) =
    map show $ replicate nFull k ++ [v] ++ replicate (n - nFull - 1) 0
    where
        nFull = p `div` k
        v = p `mod` k
        p = floor $ (fromIntegral k)*(fromIntegral n)*(fromIntegral t) / 100


Jeff has become friends with Furik. Now these two are going to play one quite amusing game.At the beginning of the game Jeff takes a piece of paper and writes down a permutation consisting of n numbers: p1, p2, ..., pn. Then the guys take turns to make moves, Jeff moves first. During his move, Jeff chooses two adjacent permutation elements and then the boy swaps them. During his move, Furic tosses a coin and if the coin shows "heads" he chooses a random pair of adjacent elements with indexes i and i + 1, for which an inequality pi > pi + 1 holds, and swaps them. But if the coin shows "tails", Furik chooses a random pair of adjacent elements with indexes i and i + 1, for which the inequality pi < pi + 1 holds, and swaps them. If the coin shows "heads" or "tails" and Furik has multiple ways of adjacent pairs to take, then he uniformly takes one of the pairs. If Furik doesn't have any pair to take, he tosses a coin one more time. The game ends when the permutation is sorted in the increasing order.Jeff wants the game to finish as quickly as possible (that is, he wants both players to make as few moves as possible). Help Jeff find the minimum mathematical expectation of the number of moves in the game if he moves optimally well.You can consider that the coin shows the heads (or tails) with the probability of 50 percent.

The first line contains integer n (1 ≤ n ≤ 3000). The next line contains n distinct integers p1, p2, ..., pn (1 ≤ pi ≤ n) — the permutation p. The numbers are separated by spaces.

In a single line print a single real value — the answer to the problem. The answer will be considered correct if the absolute or relative error doesn't exceed 10 - 6.

NoteIn the first test the sequence is already sorted, so the answer is 0.

import Data.List
main=do
 (_:a)<-fmap (map read . words) getContents::IO [Int]
 let m=length [(x,y)|(x:ys)<-tails a,y<-ys,x>y]
 print $ (div m 2)*3+(m-(div m 2))

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLn
    ps <- readsLine
    print $ solve n ps

reverseNumber ps = length $ do
    (i,pi) <- zip [1..] ps
    pj     <- drop i ps
    guard $ pi > pj
    return ()

solve :: Int -> [Int] -> Int
solve n ps | even k     = 2*k
           | otherwise = 2*(k-1) + 1
    where
    k = reverseNumber ps

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

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

main = do
    n <- readLn
    ps <- readsLine
    print $ solve n ps

reverseNumber ps = length $ do
    (i,pi) <- zip [1..] ps
    pj     <- drop i ps
    guard $ pi > pj
    return ()

solve :: Int -> [Int] -> Int
solve n ps | k == 0    = 0
           | otherwise = 2*(k-1) + 1
    where
    k = reverseNumber ps


A camera you have accidentally left in a desert has taken an interesting photo. The photo has a resolution of n pixels width, and each column of this photo is all white or all black. Thus, we can represent the photo as a sequence of n zeros and ones, where 0 means that the corresponding column is all white, and 1 means that the corresponding column is black.You think that this photo can contain a zebra. In this case the whole photo should consist of several (possibly, only one) alternating black and white stripes of equal width. For example, the photo [0, 0, 0, 1, 1, 1, 0, 0, 0] can be a photo of zebra, while the photo [0, 0, 0, 1, 1, 1, 1] can not, because the width of the black stripe is 3, while the width of the white stripe is 4. Can the given photo be a photo of zebra or not?

The first line contains a single integer n (1 ≤ n ≤ 100 000) — the width of the photo. The second line contains a sequence of integers a1, a2, ..., an (0 ≤ ai ≤ 1) — the description of the photo. If ai is zero, the i-th column is all black. If ai is one, then the i-th column is all white.

If the photo can be a photo of zebra, print "YES" (without quotes). Otherwise, print "NO". You can print each letter in any case (upper or lower).

NoteThe first two examples are described in the statements.In the third example all pixels are white, so the photo can be a photo of zebra.In the fourth example the width of the first stripe is equal to three (white color), the width of the second stripe is equal to three (black), and the width of the third stripe is equal to two (white). Thus, not all stripes have equal length, so this photo is not a photo of zebra.

main = do
  (n:as) <- fmap (map read . words) getContents
  let counted = count as
  putStrLn $ if ((all (== head counted)) counted) then "YES" else "NO"
  return ()

count :: [Int] -> [Int]
count (a:as) = count' a as where
    count' a [] = [1]
    count' a (b:bs) = if a == b
        then
            let d:ds = count' b bs in (d+1):ds
        else
            1 : count' b bs

wordsWhen :: (Char -> Bool) -> String -> [String]
wordsWhen p s = case dropWhile p s of
    [] -> []
    s' -> w : wordsWhen p s''
        where (w, s'') = break p s'

ce :: (String -> Bool) -> [String] -> (Integer, [String])
ce _ [] = (0, [])
ce p (x:xs) = case p x of
    True -> (1 + fst r, snd r)
        where r = ce p xs
    False -> (0, x:xs)

change :: [String] -> [Integer]
change [] = []
change (x:xs) = fst r : change (snd r)
    where r = ce (== x) (x:xs)

isPossible :: [Integer] -> Bool
isPossible [] = True
isPossible (x:[]) = True
isPossible (x:x':xs) = (x == x') && (isPossible (x':xs))

makeString :: Bool -> String
makeString True = "YES"
makeString False = "NO"

solve :: String -> String
solve str = makeString $ isPossible $ change $ words sec
    where (_:sec:_) = lines str

main = interact solve

-- |inputs: (x:xs) is the photo
-- width is the width of the first stripe, or 0 if yet unknown
-- val is the colour of the current stripe
-- acc is the width of the current stripe
solve_rec :: [Int] -> Int -> Int -> Int -> String
solve_rec [] width _ acc
    | width == 0   = "YES"
    | width == acc = "YES"
    | otherwise    = "NO"
solve_rec (x:xs) width val acc
    | width == 0 =
        if val == x then solve_rec xs width x (acc + 1)
        else             solve_rec xs acc   x 1
    | width > acc =
        if val == x then solve_rec xs width x (acc + 1)
        else             "NO"
    | otherwise =
        if val == x then "NO"
        else             solve_rec xs width x 1

-- wrapper function to call recursive helper
solve :: [Int] -> String
solve (x:xs) = solve_rec (x:xs) 0 x 0

-- ignore first line and read second line as [Int]
main = do
    _ <- getLine
    s <- getLine
    -- must use putStrLn because print outputs quotation marks
    putStrLn $ solve $ map read $ words s

read_array :: String -> [Int]
read_array = map read . words

get_width :: [Int] -> Int -> Int -> Int
get_width [] _ acc = acc
get_width (x:xs) val acc
    | x == val   = get_width xs val (acc + 1)
    | otherwise  = acc

solve_rec :: [Int] -> Int -> Int -> Int -> String
solve_rec [] width _ acc
    | acc == width = "YES"
    | otherwise    = "NO"
solve_rec (x:xs) width val acc
    | x == val && acc < width  = solve_rec xs width val (acc + 1)
    | x == val && acc >= width = "NO"
    | x /= val && acc < width  = "NO"
    | 1 == val && acc >= width = solve_rec xs width 0 1
    | 0 == val && acc >= width = solve_rec xs width 1 1

solve :: [Int] -> String
solve [] = "YES"
solve (x:xs) = solve_rec (x:xs) (get_width (x:xs) x 0) x 0

solves :: [Int] -> Int
solves (x:xs) = get_width (x:xs) x 0

main = do
    n <- read `fmap` getLine :: IO Int
    s <- getLine :: IO String
    putStrLn (solve (read_array s))

getInts = fmap (map read . words) getLine :: IO [Int]

conv ans cnt last [] = cnt:ans
conv ans cnt last (x:xs) =
    if last == x
       then conv ans (cnt + 1) last xs
       else conv (cnt:ans) 1 x xs

allTheSame xs = and $ map (== head xs) (tail xs)

solve (x:xs) =
    if allTheSame (conv [] 1 x xs)
       then "YES"
       else "NO"

main = do
    n <- getLine
    a <- getInts
    putStrLn $ solve a

readInts :: IO [Int]
readInts = fmap (map read.words) getLine

process0 :: Int -> [Int] -> (Int,[Int])
process0 x [] = (0,[])
process0 x (y:as) = if x==y then (1 + (fst d),(snd d)) else (0,(y:as))
    where d = process0 x as

process :: [Int] -> [Int]
process [] = []
process (x:as) = ((fst d):(process (snd d)))
    where d = (process0 x (x:as))

main :: IO()
main = do
    s <- getLine
    let x = (read s :: Int)
    a <- readInts
    let b = process a
    let t = and $ map (== head b) (tail b)
    let ans = if t then "YES" else "NO"
    putStrLn ans

main = f

f = do
 n <- getLine
 --let x = read n :: Int
 img <- getLine
 let pixels = words img
 let first = head pixels
 putStrLn $ if check (words img) first then "YES" else "NO"

check l curr = check_rec l curr 0

check_rec [] _ _ = True

check_rec l curr 0 =
    let len = length $ takeWhile (\x -> x == curr) l in
     check_rec (drop len l) (changeSymbol curr) len

check_rec l curr n =
 let len = length $ takeWhile (\x -> x == curr) l in
  if len /= n then False else check_rec (drop len l) (changeSymbol curr) n

changeSymbol "1" = "0"
changeSymbol "0" = "1"

read_array :: String -> [Int]
read_array = map read . words

get_width :: [Int] -> Int -> Int -> Int
get_width [] _ acc = acc
get_width (x:xs) val acc
    | x == val   = get_width xs val (acc + 1)
    | otherwise  = acc

solve_rec :: [Int] -> Int -> Int -> Int -> String
solve_rec [] _ _ _ = "YES"
solve_rec (x:xs) width val acc
    | x == val && acc < width  = solve_rec xs width val (acc + 1)
    | x == val && acc >= width = "NO"
    | x /= val && acc < width  = "NO"
    | 1 == val && acc >= width = solve_rec xs width 0 1
    | 0 == val && acc >= width = solve_rec xs width 1 1

solve :: [Int] -> String
solve [] = "YES"
solve (x:xs) = solve_rec (x:xs) (get_width (x:xs) x 0) x 0

solves :: [Int] -> Int
solves (x:xs) = get_width (x:xs) x 0

main = do
    n <- read `fmap` getLine :: IO Int
    s <- getLine :: IO String
    print (solve (read_array s))

read_array :: String -> [Int]
read_array = map read . words

get_width :: [Int] -> Int -> Int -> Int
get_width [] _ acc = acc
get_width (x:xs) val acc
    | x == val   = get_width xs val (acc + 1)
    | otherwise  = acc

solve_rec :: [Int] -> Int -> Int -> Int -> String
solve_rec [] _ _ _ = "YES"
solve_rec (x:xs) width val acc
    | x == val && acc < width  = solve_rec xs width val (acc + 1)
    | x == val && acc >= width = "NO"
    | x /= val && acc < width  = "NO"
    | 1 == val && acc >= width = solve_rec xs width 0 1
    | 0 == val && acc >= width = solve_rec xs width 1 1

solve :: [Int] -> String
solve [] = "YES"
solve (x:xs) = solve_rec (x:xs) (get_width (x:xs) x 0) x 0

solves :: [Int] -> Int
solves (x:xs) = get_width (x:xs) x 0

main = do
    n <- read `fmap` getLine :: IO Int
    s <- getLine :: IO String
    putStrLn (solve (read_array s))

read_array :: String -> [Int]
read_array = map read . words

get_width :: [Int] -> Int -> Int -> Int
get_width [] _ acc = acc
get_width (x:xs) val acc
    | x == val   = get_width xs val (acc + 1)
    | otherwise  = acc

solve_rec :: [Int] -> Int -> Int -> Int -> String
solve_rec [] _ val acc
    | val == acc = "YES"
    | otherwise  = "NO"
solve_rec (x:xs) width val acc
    | x == val && acc < width  = solve_rec xs width val (acc + 1)
    | x == val && acc >= width = "NO"
    | x /= val && acc < width  = "NO"
    | 1 == val && acc >= width = solve_rec xs width 0 1
    | 0 == val && acc >= width = solve_rec xs width 1 1

solve :: [Int] -> String
solve [] = "YES"
solve (x:xs) = solve_rec (x:xs) (get_width (x:xs) x 0) x 0

solves :: [Int] -> Int
solves (x:xs) = get_width (x:xs) x 0

main = do
    n <- read `fmap` getLine :: IO Int
    s <- getLine :: IO String
    putStrLn (solve (read_array s))


Iahub got lost in a very big desert. The desert can be represented as a n × n square matrix, where each cell is a zone of the desert. The cell (i, j) represents the cell at row i and column j (1 ≤ i, j ≤ n). Iahub can go from one cell (i, j) only down or right, that is to cells (i + 1, j) or (i, j + 1). Also, there are m cells that are occupied by volcanoes, which Iahub cannot enter. Iahub is initially at cell (1, 1) and he needs to travel to cell (n, n). Knowing that Iahub needs 1 second to travel from one cell to another, find the minimum time in which he can arrive in cell (n, n).

The first line contains two integers n (1 ≤ n ≤ 109) and m (1 ≤ m ≤ 105). Each of the next m lines contains a pair of integers, x and y (1 ≤ x, y ≤ n), representing the coordinates of the volcanoes. Consider matrix rows are numbered from 1 to n from top to bottom, and matrix columns are numbered from 1 to n from left to right. There is no volcano in cell (1, 1). No two volcanoes occupy the same location.

Print one integer, the minimum time in which Iahub can arrive at cell (n, n). If no solution exists (there is no path to the final cell), print -1.

NoteConsider the first sample. A possible road is: (1, 1)  →  (1, 2)  →  (2, 2)  →  (2, 3)  →  (3, 3)  →  (3, 4)  →  (4, 4).

import Data.List
import Control.Monad
import Debug.Trace

type X = Int
type Y = Int
type Depth = Int
type Ys = [Int]
type Column = (X, Ys)
type Point = (X, Y)
type ColState = [(Y, Depth)]

debug = False

evalOp =
  if debug
  then ($!)
  else ($)
traceOp =
  if debug
  then trace
  else flip const
trace' a b = evalOp (traceOp a) b

fillEmptyColumn :: ColState -> ColState
fillEmptyColumn input =
  let n1 = fst (head input)
      depth = process (tail input)
  in (n1, 0) : ((0, depth) : []) where
    process :: ColState -> Depth
    process [] = 0
    process ((y,depth):rest) =
      if depth > 0
      then y + depth
      else process rest

runThroughColumns :: [Maybe Ys] -> X -> ColState
runThroughColumns colList n = trace' ("baseState == " ++ show baseState) (evalOp (foldr (step1 n) baseState) colList) where
  baseState :: [(Y, Depth)]
  baseState = (n+1, 0) : ((n - 1, 1) : ((0, 0) : []))
  step1 :: X -> Maybe Ys -> ColState -> ColState
  step1 n x y =
    let aa = step n x y
    in evalOp (trace' (show x ++ "        " ++ show y ++ "     -------> " ++ show aa)) aa

generateColumnsWithHoles :: [Column] -> [Maybe Ys]
generateColumnsWithHoles [] = []
generateColumnsWithHoles ((_,ys):[]) = [Just ys]
generateColumnsWithHoles l@(f:(s:_)) =
  let
    rest = tail l
    (x1, y1) = f
    (x2, y2) = s
    r' = generateColumnsWithHoles rest
  in
   if (x1 + 1) == x2
   then ((Just y1): r')
   else ((Just y1) : (Nothing : r'))

solve :: [Point] -> X -> Bool
solve points n =
  let
    c = (generateColumns points)
    c' = (0, [0, 2]) : c
    withHoles' = generateColumnsWithHoles c'
    withHoles =
      if (null c) || n == (fst (last c))
      then withHoles'
      else withHoles' ++ [Nothing]
    finalState = runThroughColumns withHoles n
    (_, depth) = last finalState
  in
   trace' ("Points = " ++ show points) `evalOp`
   trace' ("Columns = " ++ show c') `evalOp`
   trace' ("With Holes = " ++ show withHoles) `evalOp`
   trace' ("Final State = " ++ show finalState) `evalOp`
   depth > 0

generateColumns :: [Point] -> [Column]
generateColumns points =
  let
    sorted = sort points
    grouped = groupBy (\p1 p2 -> (fst p1) == (fst p2)) sorted
  in
   map (\pointList -> (fst (head pointList), 0: (map snd pointList))) grouped

parsePoint :: String -> Point
parsePoint line =
  let (x:(y:[])) = map read (words line)
  in (x, y)

readPoint :: IO Point
readPoint = fmap parsePoint getLine

readInput :: IO ([Point], X)
readInput = do
  (first:rest) <- fmap lines getContents
  let (n, _) = parsePoint first
  let points = map parsePoint rest
  return (points, n)

runTest :: IO ()
runTest = do
  (points, n) <- readInput
  let numSteps =
        if (solve points n)
        then 2 * (n - 1)
        else -1
  print numSteps
  return ()

main = runTest

step :: Y -> Maybe Ys -> ColState -> ColState
step _ Nothing c = fillEmptyColumn c
step n (Just ys) state = ($!) reverse ((fst (($!) foldr step' ([(n + 1, 0 :: Depth)], state) ys)))
  where
    (0, d0) = last state
    y0 = last ys
    step' :: Y -> (ColState, ColState) -> (ColState, ColState)
    step' y xx@(sofar, inpList@(s:(t:ss)))
      | y2 < y3 - 1 && d2 > 0 = ((y, y2 + d2 - y):sofar, inpList)
      | y < (fst t) = step' y (sofar, (t:ss))
      | otherwise = traceOp (show y ++ "    " ++ show xx ++ "  and answer = " ++ show answer ++ " a1=" ++ show a1 ++ " a2=" ++ show a2) ((y, answer):sofar, inpList)
      where
        y3 = fst (head sofar)
        (y2, d2) = s
        (y1, d1) = t
        a2 =
          if d2 > 0 && y3 > (y2 + 1)
          then ((min (d2 + y2) (y3 - 1)) - y)
          else 0
        a1 = y1 + d1 - y
        answer = min (max a2 a1) (y3 - y - 1)

import Data.List
import Control.Monad
import Debug.Trace

type X = Int
type Y = Int
type Depth = Int
type Ys = [Int]
type Column = (X, Ys)
type Point = (X, Y)
type ColState = [(Y, Depth)]

trace' a b = b

fillEmptyColumn :: ColState -> ColState
fillEmptyColumn input =
  let n1 = fst (head input)
      depth = process (tail input)
  in (n1, 0) : ((0, depth) : []) where
    process :: ColState -> Depth
    process [] = 0
    process ((y,depth):rest) =
      if depth > 0
      then y + depth
      else process rest

runThroughColumns :: [Maybe Ys] -> X -> ColState
runThroughColumns colList n = foldr (step1 n) baseState colList where
  baseState :: [(Y, Depth)]
  baseState = (n+1, 0) : ((n - 1, 1) : ((0, 0) : []))
  step1 :: X -> Maybe Ys -> ColState -> ColState
  step1 n x y = trace' (show x ++ "        " ++ show y) $ step n x y

generateColumnsWithHoles :: [Column] -> [Maybe Ys]
generateColumnsWithHoles [] = []
generateColumnsWithHoles ((_,ys):[]) = [Just ys]
generateColumnsWithHoles l@(f:(s:_)) =
  let
    rest = tail l
    (x1, y1) = f
    (x2, y2) = s
    r' = generateColumnsWithHoles rest
  in
   if x1 == (x2 + 1)
   then ((Just y1): r')
   else ((Just y1) : (Nothing : r'))

solve :: [Point] -> X -> Bool
solve points n =
  let
    c = (generateColumns points)
    c' = c ++ [(0, [2])]
    withHoles' = generateColumnsWithHoles c'
    withHoles =
      if (null c) || n == (fst (head c))
      then withHoles'
      else Nothing : withHoles'
    finalState = runThroughColumns withHoles n
    (_, depth) = last finalState
  in
   trace' ("Columns = " ++ show c') $
   trace' ("With Holes = " ++ show withHoles) $
   trace' ("Final State = " ++ show finalState) $
   depth > 0

generateColumns :: [Point] -> [Column]
generateColumns points =
  let
    sorted = reverse (sort points)
    grouped = groupBy (\p1 p2 -> (fst p1) == (fst p2)) sorted
  in
   map (\pointList -> (fst (head pointList), map snd pointList)) grouped

readPoint :: IO Point
readPoint = do
  line <- getLine
  let (x:(y:[])) = map read (words line)
  return (x, y)

main = do
  (n, numPoints) <- readPoint
  points <- replicateM numPoints readPoint
  let numSteps =
        if (solve points n)
        then 2 * (n - 1)
        else -1
  print numSteps
  return ()

step :: Y -> Maybe Ys -> ColState -> ColState
step _ Nothing c = fillEmptyColumn c
step n (Just ys) state = reverse (attachHead : (fst (foldr step' ([(n + 1, 0 :: Depth)], state) ys)))
  where
    (0, d0) = last state
    y0 = last ys
    attachHead = (0, min d0 (y0 - 1))
    step' y (sofar, inpList@(s:(t:ss)))
      | y < (fst t) = step' y (sofar, (t:ss))
      | otherwise = ((y, answer):sofar, inpList)
      where
        (y2, d2) = s
        (y1, d1) = t
        a2 =
          if d2 > 0
          then (d2 + y2 - y)
          else 0
        a1 = y1 + d1 - y
        answer = max a2 a1

import Data.List
import Control.Monad
import Debug.Trace

type X = Int
type Y = Int
type Depth = Int
type Ys = [Int]
type Column = (X, Ys)
type Point = (X, Y)
type ColState = [(Y, Depth)]

evalOp = ($)
traceOp = flip const
trace' a b = evalOp (traceOp a) b

fillEmptyColumn :: ColState -> ColState
fillEmptyColumn input =
  let n1 = fst (head input)
      depth = process (tail input)
  in (n1, 0) : ((0, depth) : []) where
    process :: ColState -> Depth
    process [] = 0
    process ((y,depth):rest) =
      if depth > 0
      then y + depth
      else process rest

runThroughColumns :: [Maybe Ys] -> X -> ColState
runThroughColumns colList n = trace' ("baseState == " ++ show baseState) (evalOp (foldr (step1 n) baseState) colList) where
  baseState :: [(Y, Depth)]
  baseState = (n+1, 0) : ((n - 1, 1) : ((0, 0) : []))
  step1 :: X -> Maybe Ys -> ColState -> ColState
  step1 n x y =
    let aa = step n x y
    in evalOp (trace' (show x ++ "        " ++ show y ++ "     -------> " ++ show aa)) aa

generateColumnsWithHoles :: [Column] -> [Maybe Ys]
generateColumnsWithHoles [] = []
generateColumnsWithHoles ((_,ys):[]) = [Just ys]
generateColumnsWithHoles l@(f:(s:_)) =
  let
    rest = tail l
    (x1, y1) = f
    (x2, y2) = s
    r' = generateColumnsWithHoles rest
  in
   if (x1 + 1) == x2
   then ((Just y1): r')
   else ((Just y1) : (Nothing : r'))

solve :: [Point] -> X -> Bool
solve points n =
  let
    c = (generateColumns points)
    c' = (0, [2]) : c
    withHoles' = generateColumnsWithHoles c'
    withHoles =
      if (null c) || n == (fst (last c))
      then withHoles'
      else withHoles' ++ [Nothing]
    finalState = runThroughColumns withHoles n
    (_, depth) = last finalState
  in
   trace' ("Points = " ++ show points) `evalOp`
   trace' ("Columns = " ++ show c') `evalOp`
   trace' ("With Holes = " ++ show withHoles) `evalOp`
   trace' ("Final State = " ++ show finalState) `evalOp`
   depth > 0

generateColumns :: [Point] -> [Column]
generateColumns points =
  let
    sorted = sort points
    grouped = groupBy (\p1 p2 -> (fst p1) == (fst p2)) sorted
  in
   map (\pointList -> (fst (head pointList), map snd pointList)) grouped

readPoint :: IO Point
readPoint = do
  line <- getLine
  let (x:(y:[])) = map read (words line)
  return `evalOp` (x, y)

main = do
  (n, numPoints) <- readPoint
  points <- replicateM numPoints readPoint
  let numSteps =
        if (solve points n)
        then 2 * (n - 1)
        else -1
  print numSteps
  return ()

step :: Y -> Maybe Ys -> ColState -> ColState
step _ Nothing c = fillEmptyColumn c
step n (Just ys) state = reverse (attachHead : (fst (foldr step' ([(n + 1, 0 :: Depth)], state) ys)))
  where
    (0, d0) = last state
    y0 = last ys
    attachHead = (0, min d0 (y0 - 1))
    step' y (sofar, inpList@(s:(t:ss)))
      | y < (fst t) = step' y (sofar, (t:ss))
      | otherwise = ((y, answer):sofar, inpList)
      where
        y3 = fst (head sofar)
        (y2, d2) = s
        (y1, d1) = t
        a2 =
          if d2 > 0
          then (d2 + y2 - y)
          else 0
        a1 = y1 + d1 - y
        answer = min (max a2 a1) (y3 - y - 1)

import Data.List
import Control.Monad
import Debug.Trace

type X = Int
type Y = Int
type Depth = Int
type Ys = [Int]
type Column = (X, Ys)
type Point = (X, Y)
type ColState = [(Y, Depth)]

debug = False

evalOp =
  if debug
  then ($!)
  else ($)
traceOp =
  if debug
  then trace
  else flip const
trace' a b = evalOp (traceOp a) b

fillEmptyColumn :: ColState -> ColState
fillEmptyColumn input =
  let n1 = fst (head input)
      depth = process (tail input)
  in (n1, 0) : ((0, depth) : []) where
    process :: ColState -> Depth
    process [] = 0
    process ((y,depth):rest) =
      if depth > 0
      then y + depth
      else process rest

runThroughColumns :: [Maybe Ys] -> X -> ColState
runThroughColumns colList n = trace' ("baseState == " ++ show baseState) (evalOp (foldr (step1 n) baseState) colList) where
  baseState :: [(Y, Depth)]
  baseState = (n+1, 0) : ((n - 1, 1) : ((0, 0) : []))
  step1 :: X -> Maybe Ys -> ColState -> ColState
  step1 n x y =
    let aa = step n x y
    in evalOp (trace' (show x ++ "        " ++ show y ++ "     -------> " ++ show aa)) aa

generateColumnsWithHoles :: [Column] -> [Maybe Ys]
generateColumnsWithHoles [] = []
generateColumnsWithHoles ((_,ys):[]) = [Just ys]
generateColumnsWithHoles l@(f:(s:_)) =
  let
    rest = tail l
    (x1, y1) = f
    (x2, y2) = s
    r' = generateColumnsWithHoles rest
  in
   if (x1 + 1) == x2
   then ((Just y1): r')
   else ((Just y1) : (Nothing : r'))

solve :: [Point] -> X -> Bool
solve points n =
  let
    c = (generateColumns points)
    c' = (0, [0, 2]) : c
    withHoles' = generateColumnsWithHoles c'
    withHoles =
      if (null c) || n == (fst (last c))
      then withHoles'
      else withHoles' ++ [Nothing]
    finalState = runThroughColumns withHoles n
    (_, depth) = last finalState
  in
   trace' ("Points = " ++ show points) `evalOp`
   trace' ("Columns = " ++ show c') `evalOp`
   trace' ("With Holes = " ++ show withHoles) `evalOp`
   trace' ("Final State = " ++ show finalState) `evalOp`
   depth > 0

generateColumns :: [Point] -> [Column]
generateColumns points =
  let
    sorted = sort points
    grouped = groupBy (\p1 p2 -> (fst p1) == (fst p2)) sorted
  in
   map (\pointList -> (fst (head pointList), 0: (map snd pointList))) grouped

parsePoint :: String -> Point
parsePoint line =
  let (x:(y:[])) = map read (words line)
  in (x, y)

readPoint :: IO Point
readPoint = fmap parsePoint getLine

runTest = do
  (n, numPoints) <- getHeader
  points <- replicateM numPoints readPoint
  let numSteps =
        if (solve points n)
        then 2 * (n - 1)
        else -1
  print numSteps
  return ()
  where
    getHeader :: IO Point
    getHeader = do
      l <- getLine
      if null l
        then getHeader
        else return (parsePoint l)

main = runTest

step :: Y -> Maybe Ys -> ColState -> ColState
step _ Nothing c = fillEmptyColumn c
step n (Just ys) state = reverse ((fst (foldr step' ([(n + 1, 0 :: Depth)], state) ys)))
  where
    (0, d0) = last state
    y0 = last ys
    step' y xx@(sofar, inpList@(s:(t:ss)))
      | y < (fst t) = step' y (sofar, (t:ss))
      | otherwise = traceOp (show y ++ "    " ++ show xx ++ "  and answer = " ++ show answer ++ " a1=" ++ show a1 ++ " a2=" ++ show a2) ((y, answer):sofar, inpList)
      where
        y3 = fst (head sofar)
        (y2, d2) = s
        (y1, d1) = t
        a2 =
          if d2 > 0 && y3 > (y2 + 1)
          then ((min (d2 + y2) (y3 - 1)) - y)
          else 0
        a1 = y1 + d1 - y
        answer = min (max a2 a1) (y3 - y - 1)

import Data.List
import Control.Monad
import Debug.Trace

type X = Int
type Y = Int
type Depth = Int
type Ys = [Int]
type Column = (X, Ys)
type Point = (X, Y)
type ColState = [(Y, Depth)]

evalOp = ($)
trace' a b = b

fillEmptyColumn :: ColState -> ColState
fillEmptyColumn input =
  let n1 = fst (head input)
      depth = process (tail input)
  in (n1, 0) : ((0, depth) : []) where
    process :: ColState -> Depth
    process [] = 0
    process ((y,depth):rest) =
      if depth > 0
      then y + depth
      else process rest

runThroughColumns :: [Maybe Ys] -> X -> ColState
runThroughColumns colList n = trace' ("baseState == " ++ show baseState) (evalOp (foldr (step1 n) baseState) colList) where
  baseState :: [(Y, Depth)]
  baseState = (n+1, 0) : ((n - 1, 1) : ((0, 0) : []))
  step1 :: X -> Maybe Ys -> ColState -> ColState
  step1 n x y =
    let aa = step n x y
    in evalOp (trace' (show x ++ "        " ++ show y ++ "     -------> " ++ show aa)) aa

generateColumnsWithHoles :: [Column] -> [Maybe Ys]
generateColumnsWithHoles [] = []
generateColumnsWithHoles ((_,ys):[]) = [Just ys]
generateColumnsWithHoles l@(f:(s:_)) =
  let
    rest = tail l
    (x1, y1) = f
    (x2, y2) = s
    r' = generateColumnsWithHoles rest
  in
   if (x1 + 1) == x2
   then ((Just y1): r')
   else ((Just y1) : (Nothing : r'))

solve :: [Point] -> X -> Bool
solve points n =
  let
    c = (generateColumns points)
    c' = (0, [2]) : c
    withHoles' = generateColumnsWithHoles c'
    withHoles =
      if (null c) || n == (fst (last c))
      then withHoles'
      else Nothing : withHoles'
    finalState = runThroughColumns withHoles n
    (_, depth) = last finalState
  in
   trace' ("Points = " ++ show points) `evalOp`
   trace' ("Columns = " ++ show c') `evalOp`
   trace' ("With Holes = " ++ show withHoles) `evalOp`
   trace' ("Final State = " ++ show finalState) `evalOp`
   depth > 0

generateColumns :: [Point] -> [Column]
generateColumns points =
  let
    sorted = sort points
    grouped = groupBy (\p1 p2 -> (fst p1) == (fst p2)) sorted
  in
   map (\pointList -> (fst (head pointList), map snd pointList)) grouped

readPoint :: IO Point
readPoint = do
  line <- getLine
  let (x:(y:[])) = map read (words line)
  return `evalOp` (x, y)

main = do
  (n, numPoints) <- readPoint
  points <- replicateM numPoints readPoint
  let numSteps =
        if (solve points n)
        then 2 * (n - 1)
        else -1
  print numSteps
  return ()

step :: Y -> Maybe Ys -> ColState -> ColState
step _ Nothing c = fillEmptyColumn c
step n (Just ys) state = reverse (attachHead : (fst (foldr step' ([(n + 1, 0 :: Depth)], state) ys)))
  where
    (0, d0) = last state
    y0 = last ys
    attachHead = (0, min d0 (y0 - 1))
    step' y (sofar, inpList@(s:(t:ss)))
      | y < (fst t) = step' y (sofar, (t:ss))
      | otherwise = ((y, answer):sofar, inpList)
      where
        y3 = fst (head sofar)
        (y2, d2) = s
        (y1, d1) = t
        a2 =
          if d2 > 0
          then (d2 + y2 - y)
          else 0
        a1 = y1 + d1 - y
        answer = min (max a2 a1) (y3 - y - 1)


You've got another problem dealing with arrays. Let's consider an arbitrary sequence containing n (not necessarily different) integers a1, a2, ..., an. We are interested in all possible pairs of numbers (ai, aj), (1 ≤ i, j ≤ n). In other words, let's consider all n2 pairs of numbers, picked from the given array.For example, in sequence a = {3, 1, 5} are 9 pairs of numbers: (3, 3), (3, 1), (3, 5), (1, 3), (1, 1), (1, 5), (5, 3), (5, 1), (5, 5).Let's sort all resulting pairs lexicographically by non-decreasing. Let us remind you that pair (p1, q1) is lexicographically less than pair (p2, q2) only if either p1 < p2, or p1 = p2 and q1 < q2.Then the sequence, mentioned above, will be sorted like that: (1, 1), (1, 3), (1, 5), (3, 1), (3, 3), (3, 5), (5, 1), (5, 3), (5, 5)Let's number all the pair in the sorted list from 1 to n2. Your task is formulated like this: you should find the k-th pair in the ordered list of all possible pairs of the array you've been given.

The first line contains two integers n and k (1 ≤ n ≤ 105, 1 ≤ k ≤ n2). The second line contains the array containing n integers a1, a2, ..., an ( - 109 ≤ ai ≤ 109). The numbers in the array can coincide. All numbers are separated with spaces. Please do not use the %lld specificator to read or write 64-bit integers in С++. It is preferred to use cin, cout, streams or the %I64d specificator instead.

In the single line print two numbers — the sought k-th pair.

NoteIn the first sample the sorted sequence for the given array looks as: (1, 1), (1, 2), (2, 1), (2, 2). The 4-th of them is pair (2, 2).The sorted sequence for the array from the second sample is given in the statement. The 2-nd pair there is (1, 3).

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as BS

solve :: [Int] -> Integer -> Integer -> (Int, Int)
solve a k n = solve' a k
    where
      solve' (x:xs) k = let cnt = fromIntegral $ length $ takeWhile (== x) (x:xs) :: Integer
                            all = cnt * n
                        in if all > k
                           then (x, a !! (fromIntegral (k `div` cnt)))
                           else solve' (dropWhile (== x) xs) (k - all)

main = do
  [n, k] <- (map (toNumber . BS.readInteger) <$> (BS.words <$> BS.getLine)) :: IO [Integer]
  a      <- (sort <$> map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
  let (f, s) = solve a (k - 1) n
  putStrLn $ (show f) ++ " " ++ (show s)

toNumber :: Num a => Maybe (a, BS.ByteString) -> a
toNumber (Just (x, _)) = x
toNumber Nothing       = 0

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (sort)
import Prelude hiding (reads)

reads :: IO [Integer]
reads  =  liftM (map read . words) getLine
  where
    read ('-' : s)  =  (-1) * read s
    read s  =  read' 0 s
    read' a ""  =  a
    read' a (c:s)  =  read' a' s
      where
        a'  =  10*a + fromIntegral (ord c - ord '0')

solve :: Integer -> Integer -> [Integer] -> (Integer, Integer)
solve n k as  =  (a, b)
  where
    indexA  =  fromIntegral ((k-1) `div` n) + 1
    countA  =  fromIntegral $ length $ filter (== a) as
    countLessA  =  length $ filter (< a) as
    indexInGroup  =  k - n * fromIntegral countLessA
    indexB  =  fromIntegral ((indexInGroup - 1) `div` countA) + 1
    a  =  sort as !! (indexA - 1)
    b  =  sort as !! (indexB - 1)

test :: [Integer] -> IO ()
test as  =  do
    let n  =  fromIntegral $ length as
    let ans1  =  sort [(a, b) | a <- as, b <- as]
    let ans2  =  map (\k -> solve n k as) [1..n*n]
    if ans1 == ans2 then
        print "Ok"
    else
        print "Fail: " >> print as

main :: IO ()
main  =  do
    [n, k]  <-  reads
    as  <-  reads
    let (a, b)  =  solve n k as
    putStrLn $ concat [show a, " ", show b]

import Control.Applicative
import Data.List

main = do
  [n, k] <- (map read <$> (words <$> getLine)) :: IO [Integer]
  a      <- (sort <$> map read <$> (words <$> getLine)) :: IO [Int]
  putStrLn $ (show $ a !! (fromIntegral ((k - 1) `div` n))) ++ " " ++ (show $ a !! (fromIntegral ((k - 1) `mod` n)))

import Control.Applicative
import Data.List

main = do
  [n, k] <- (map read <$> (words <$> getLine)) :: IO [Integer]
  a      <- (sort <$> map read <$> (words <$> getLine)) :: IO [Integer]
  putStrLn $ (show $ a !! (fromIntegral ((k - 1) `div` n))) ++ " " ++ (show $ a !! (fromIntegral ((k - 1) `mod` n)))

import Data.List

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

solve :: (Int, Int) -> [Int] -> (Int, Int)
solve (n, k) xs  =  (x', sortXs !! (y `div` z))
  where
    sortXs  =  sort xs
    (x, y)  =  (k-1) `divMod` n
    x'  =  sortXs !! x
    z  =  length $ filter (== x') sortXs

main :: IO ()
main  =  do
    [n, k] <- Main.reads
    xs <- Main.reads
    let (x, y)  =  solve (n, k) xs
    putStrLn $ concat [show x, " ", show y]

import List

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

solve :: (Int, Int) -> [Int] -> (Int, Int)
solve (n, k) xs  =  (sortXs !! x, sortXs !! y)
  where
    sortXs  =  sort xs
    (x, y)  =  (k-1) `divMod` n

main :: IO ()
main  =  do
    [n, k] <- Main.reads
    xs <- Main.reads
    let (x, y)  =  solve (n, k) xs
    putStrLn $ concat [show x, " ", show y]

import Control.Monad (liftM)
import Data.List (sort)
import Prelude hiding (print, reads)

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

solve :: Integer -> Integer -> [Int] -> (Int, Int)
solve n k xs  =  (xs' !! a, xs' !! b)
  where
    a    =  fromIntegral $ div (k-1) n
    b    =  fromIntegral $ mod (k-1) n
    xs'  =  sort xs

print :: (Int, Int) -> IO ()
print (a, b)  =  putStrLn $ concat [show a, " ", show b]

main :: IO ()
main  =  do
    [n, k]  <-  reads
    xs      <-  reads
    print $ solve n k xs

import Data.List

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

solve :: (Integer, Integer) -> [Int] -> (Int, Int)
solve (n, k) xs  =  (x', sortXs !! ((fromIntegral y) `div` z))
  where
    sortXs  =  sort xs
    (x, y)  =  (k-1) `divMod` n
    x'  =  sortXs !! (fromIntegral x)
    z  =  length $ filter (== x') sortXs

main :: IO ()
main  =  do
    [n, k] <- Main.reads
    xs <- Main.reads
    let (x, y)  =  solve (n, k) xs
    putStrLn $ concat [show x, " ", show y]

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (sort)
import Prelude hiding (reads)

reads :: IO [Integer]
reads  =  liftM (map read . words) getLine
  where
    read ('-' : s)  =  (-1) * read s
    read s  =  read' 0 s
    read' a ""  =  fromIntegral a
    read' a (c:s)  =  read' (10*a + ord c - ord '0') s

solve :: Integer -> Integer -> [Integer] -> (Integer, Integer)
solve n k as  =  (a, b)
  where
    indexA  =  fromIntegral ((k-1) `div` n) + 1
    countA  =  fromIntegral $ length $ filter (== a) as
    countLessA  =  length $ filter (< a) as
    indexInGroup  =  k - n * fromIntegral countLessA
    indexB  =  fromIntegral ((indexInGroup - 1) `div` countA) + 1
    a  =  sort as !! (indexA - 1)
    b  =  sort as !! (indexB - 1)

test :: [Integer] -> IO ()
test as  =  do
    let n  =  fromIntegral $ length as
    let ans1  =  sort [(a, b) | a <- as, b <- as]
    let ans2  =  map (\k -> solve n k as) [1..n*n]
    if ans1 == ans2 then
        print "Ok"
    else
        print "Fail: " >> print as

main :: IO ()
main  =  do
    [n, k]  <-  reads
    as  <-  reads
    let (a, b)  =  solve n k as
    putStrLn $ concat [show a, " ", show b]


After all the events in Orlando we all know, Sasha and Roma decided to find out who is still the team's biggest loser. Thankfully, Masha found somewhere a revolver with a rotating cylinder of n bullet slots able to contain exactly k bullets, now the boys have a chance to resolve the problem once and for all. Sasha selects any k out of n slots he wishes and puts bullets there. Roma spins the cylinder so that every of n possible cylinder's shifts is equiprobable. Then the game starts, the players take turns, Sasha starts: he puts the gun to his head and shoots. If there was no bullet in front of the trigger, the cylinder shifts by one position and the weapon is given to Roma for make the same move. The game continues until someone is shot, the survivor is the winner. Sasha does not want to lose, so he must choose slots for bullets in such a way as to minimize the probability of its own loss. Of all the possible variant he wants to select the lexicographically minimal one, where an empty slot is lexicographically less than a charged one. More formally, the cylinder of n bullet slots able to contain k bullets can be represented as a string of n characters. Exactly k of them are "X" (charged slots) and the others are "." (uncharged slots). Let us describe the process of a shot. Suppose that the trigger is in front of the first character of the string (the first slot). If a shot doesn't kill anyone and the cylinder shifts, then the string shifts left. So the first character becomes the last one, the second character becomes the first one, and so on. But the trigger doesn't move. It will be in front of the first character of the resulting string.Among all the strings that give the minimal probability of loss, Sasha choose the lexicographically minimal one. According to this very string, he charges the gun. You have to help Sasha to charge the gun. For that, each xi query must be answered: is there a bullet in the positions xi?

The first line contains three integers n, k and p (1 ≤ n ≤ 1018, 0 ≤ k ≤ n, 1 ≤ p ≤ 1000) — the number of slots in the cylinder, the number of bullets and the number of queries. Then follow p lines; they are the queries. Each line contains one integer xi (1 ≤ xi ≤ n) the number of slot to describe. Please do not use the %lld specificator to read or write 64-bit numbers in С++. It is preferred to use cin, cout streams or the %I64d specificator.

For each query print "." if the slot should be empty and "X" if the slot should be charged.

NoteThe lexicographical comparison of is performed by the < operator in modern programming languages. The a string is lexicographically less that the b string, if there exists such i (1 ≤ i ≤ n), that ai < bi, and for any j (1 ≤ j < i) aj = bj.

readInteger :: String -> Integer
readInteger token = read token :: Integer

unchargedSlot = "."
chargedSlot = "X"

toList :: a -> [a]
toList item = [item]

processQuery :: Integer -> Integer -> Integer -> Integer -> String
processQuery u v n x = if 0 <= x && x < n - t then
                         unchargedSlot
                       else if n - t <= x && x < n - v then
                              if even (x - n + t) then
                                unchargedSlot
                                else
                                chargedSlot
                            else
                              chargedSlot
  where t = 2 * u + v

solve :: [Integer] -> [String]
solve (n:k:p:queries) | odd (n - 2 * u - v) = map (processQuery (u - 1) (v + 1) n) q
                      | otherwise = map (processQuery u v n) q
  where u = min k (n - k)
        v = k - u
        q = map pred queries

main :: IO ()
main = interact (unlines . toList . foldl (++) "" . solve . map readInteger . words)

module Main where

import Control.Monad

main = do
    [n, k, p] <- ( map read . words ) `liftM` getLine :: IO [Integer]

    q <- replicateM (fromIntegral p) $ read `liftM` getLine
    let hn = ( n + 1 ) `div` 2

    putStrLn $ map (\q -> let hq = q `div` 2 in if q `mod` 2 == 0
        then if hq + k > hn then 'X' else '.'
        else if k > 0 && q == n || hq + k >= n then 'X' else '.'
        ) q

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

import Debug.Trace

parseInput = do
    n <- readInteger
    k <- readInteger
    p <- readInt
    query <- replicateM p readInteger
    return (n, k, query)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, k, query) = map solvePosition query
  where
    solvePosition x
        | k == 0    = '.'
        | k == n    = 'X'
        | k == 1    = if x == n then 'X' else '.'
        | partLeft  = if x == left then 'X' else '.'
        | partA     = if (x - left) `mod` 2 == 0 then 'X' else '.'
        | otherwise = 'X'
      where
        partLeft = x <= left
        partA = (x - left) <= 2 * a

    minB = n `mod` 2

    -- 2 * a + b <= n - 2
    -- a + b + 1 == k

    a = ((n - 2) - (k - 1)) `min` (k - 1 - minB)
    b = k - 1 - a

    left = n - 2 * a - b

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

module Main where

import Control.Monad

main = do
    [n, k, p] <- ( map read . words ) `liftM` getLine

    q <- replicateM p $ read `liftM` getLine
    let hn = ( n + 1 ) `div` 2

    putStrLn $ map (\q -> let hq = q `div` 2 in if q `mod` 2 == 0
        then if hq + k > hn then 'X' else '.'
        else if q == n || hq + k >= n then 'X' else '.'
        ) q

module Main where

import Control.Monad

main = do
    [n, k, p] <- ( map read . words ) `liftM` getLine

    q <- replicateM n $ read `liftM` getLine
    let hn = ( n + 1 ) `div` 2

    putStrLn $ map (\q -> let hq = q `div` 2 in if q `mod` 2 == 0
        then if hq + k > hn then 'X' else '.'
        else if q == n || hq + k >= n then 'X' else '.'
        ) q

module Main where

import Control.Monad

main = do
    [n, k, p] <- ( map read . words ) `liftM` getLine :: IO [Integer]

    q <- replicateM (fromIntegral p) $ read `liftM` getLine
    let hn = ( n + 1 ) `div` 2

    putStrLn $ map (\q -> let hq = q `div` 2 in if q `mod` 2 == 0
        then if hq + k > hn then 'X' else '.'
        else if q == n || hq + k >= n then 'X' else '.'
        ) q

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

import Debug.Trace

parseInput = do
    n <- readInteger
    k <- readInteger
    p <- readInt
    query <- replicateM p readInteger
    return (n, k, query)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStr =<< solve . evalState parseInput <$> BS.getContents

solve (n, k, query) = map solvePosition query
  where
    solvePosition x
        | k == 0    = '.'
        | k == n    = 'X'
        | partLeft  = if x == left then 'X' else '.'
        | partA     = if (x - left) `mod` 2 == 0 then 'X' else '.'
        | otherwise = 'X'
      where
        partLeft = x <= left
        partA = (x - left) <= 2 * a

    minB = n `mod` 2

    -- 2 * a + b <= n - 2
    -- a + b + 1 == k

    a = ((n - 2) - (k - 1)) `min` (k - 1 - minB)
    b = k - 1 - a

    left = n - 2 * a - b

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


There is a bookshelf which can fit $$$n$$$ books. The $$$i$$$-th position of bookshelf is $$$a_i = 1$$$ if there is a book on this position and $$$a_i = 0$$$ otherwise. It is guaranteed that there is at least one book on the bookshelf.In one move, you can choose some contiguous segment $$$[l; r]$$$ consisting of books (i.e. for each $$$i$$$ from $$$l$$$ to $$$r$$$ the condition $$$a_i = 1$$$ holds) and:  Shift it to the right by $$$1$$$: move the book at index $$$i$$$ to $$$i + 1$$$ for all $$$l \le i \le r$$$. This move can be done only if $$$r+1 \le n$$$ and there is no book at the position $$$r+1$$$.  Shift it to the left by $$$1$$$: move the book at index $$$i$$$ to $$$i-1$$$ for all $$$l \le i \le r$$$. This move can be done only if $$$l-1 \ge 1$$$ and there is no book at the position $$$l-1$$$. Your task is to find the minimum number of moves required to collect all the books on the shelf as a contiguous (consecutive) segment (i.e. the segment without any gaps).For example, for $$$a = [0, 0, 1, 0, 1]$$$ there is a gap between books ($$$a_4 = 0$$$ when $$$a_3 = 1$$$ and $$$a_5 = 1$$$), for $$$a = [1, 1, 0]$$$ there are no gaps between books and for $$$a = [0, 0,0]$$$ there are also no gaps between books.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 200$$$) — 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 50$$$) — the number of places on a bookshelf. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 1$$$), where $$$a_i$$$ is $$$1$$$ if there is a book at this position and $$$0$$$ otherwise. It is guaranteed that there is at least one book on the bookshelf.

For each test case, print one integer: the minimum number of moves required to collect all the books on the shelf as a contiguous (consecutive) segment (i.e. the segment without gaps).

NoteIn the first test case of the example, you can shift the segment $$$[3; 3]$$$ to the right and the segment $$$[4; 5]$$$ to the right. After all moves, the books form the contiguous segment $$$[5; 7]$$$. So the answer is $$$2$$$.In the second test case of the example, you have nothing to do, all the books on the bookshelf form the contiguous segment already.In the third test case of the example, you can shift the segment $$$[5; 5]$$$ to the left and then the segment $$$[4; 4]$$$ to the left again. After all moves, the books form the contiguous segment $$$[1; 3]$$$. So the answer is $$$2$$$.In the fourth test case of the example, you can shift the segment $$$[1; 1]$$$ to the right, the segment $$$[2; 2]$$$ to the right, the segment $$$[6; 6]$$$ to the left and then the segment $$$[5; 5]$$$ to the left. After all moves, the books form the contiguous segment $$$[3; 4]$$$. So the answer is $$$4$$$.In the fifth test case of the example, you can shift the segment $$$[1; 2]$$$ to the right. After all moves, the books form the contiguous segment $$$[2; 5]$$$. So the answer is $$$1$$$.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.List (dropWhileEnd)

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

process :: [String] -> [Int]
process [] = []
process (_ : x : xs) = solve x : process xs

solve :: [Char] -> Int
solve = length . filter (== '0') . dropWhileEnd (/= '1') . dropWhile (/= '1')

module Main where

import Data.List
import Control.Exception

scanPairs :: [a] -> [(a, a)]
scanPairs xs = zip xs $ tail xs

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

solveCase :: String -> String
solveCase =
  show .
  sum .
  map (\(x, y) -> assert (x <= y) $ y - x - 1) .
  scanPairs .
  map fst .
  filter ((==) "1" . snd) .
  zip [0..] .
  words

main :: IO ()
main = interact $ unlines . map solveCase . concatMap tail . chunks 2 . tail . lines

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- getInts
    as <- getInts
    putStrLn $ show $ length $ filter (==0) $ dropWhile (==0) $ reverse $ dropWhile (==0) as

import           Data.List (dropWhileEnd)

everyOther :: [a] -> [a]
everyOther []       = []
everyOther (x:y:xs) = y : everyOther xs

countMoves :: String -> String
countMoves s = show $ foldr countZeros 0 (stripZeros (words s))
  where
    stripZeros = dropWhileEnd (== "0") . dropWhile (== "0")
    countZeros x acc = if x == "0" then acc + 1 else acc

main :: IO ()
main = do
    _ <- getLine
    interact $ unlines . map countMoves . everyOther . lines

import Control.Monad

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    a <- readInts
    let
      a1 = dropWhile (== 0) a
      a2 = dropWhile (== 0) $ reverse a1
    print $ length [() | x <- a2, x == 0]

import Control.Monad

readInt :: IO Int
readInt = read <$> getLine

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

main :: IO ()
main = do
    t <- readInt
    replicateM_ t $ do
        n <- readInt
        let m = n + 1
        a <- readInts
        let a' = trimZeroes a in putStrLn $ show $ (length a') - (sum a')

trimZeroes::[Int] -> [Int]
trimZeroes = f . f
            where f = reverse . dropWhile (== 0)


You are given an array $$$a$$$ consisting of $$$n$$$ integers.Your task is to say the number of such positive integers $$$x$$$ such that $$$x$$$ divides each number from the array. In other words, you have to find the number of common divisors of all elements in the array.For example, if the array $$$a$$$ will be $$$[2, 4, 6, 2, 10]$$$, then $$$1$$$ and $$$2$$$ divide each number from the array (so the answer for this test is $$$2$$$).

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 4 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^{12}$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

Print one integer — the number of such positive integers $$$x$$$ such that $$$x$$$ divides each number from the given array (in other words, the answer is the number of common divisors of all elements in the array).

import Control.Monad
import Data.List

readInt :: IO(Int)
readInt = fmap read getLine

readlist :: IO([Integer])
readlist = fmap (map read . words) getLine

loop :: Int -> IO() -> IO()
loop 0 f = do
    f; loop 0 f
loop 1 f = f
loop x f = do
    f; loop (x - 1) f

main = do
	sz <- readInt
	v <- readlist
	print $ solve v

solve v = foldl (*) 1 . fact $ x where x = (foldl1 gcd v)

countDup v = (head v, length v)
fact :: Integer -> [Integer]
fact x = map ((+1) . toInteger . length) .
	group .
	filter (>1)
	$ (fact' x x 2)

fact' :: Integer -> Integer -> Integer -> [Integer]
fact' x y a
    | a * a <= y =
        if x `mod` a == 0 then
            (a: (fact' (div x a) y a))
        else
            fact' x y (a + 1)
    | otherwise = [x]

import Control.Monad
import Data.List

readInt :: IO(Int)
readInt = fmap read getLine

readlist :: IO([Integer])
readlist = fmap (map read . words) getLine

loop :: Int -> IO() -> IO()
loop 0 f = do
    f; loop 0 f
loop 1 f = f
loop x f = do
    f; loop (x - 1) f

main = do
	sz <- readInt
	v <- readlist
	print $ solve v

solve v = x - euler x where x = (foldl1 gcd v)

countDup v = (head v, length v)

euler x = if x > 1 then euler' (map countDup . group . fact $ x) else 0

euler' [] = 1
euler' (x:xs) = euler' xs * (fst x - 1) * (fst x ^ (snd x - 1))

fact :: Integer -> [Integer]
fact x = filter (>1) (fact' x x 2)

fact' :: Integer -> Integer -> Integer -> [Integer]
fact' x y a
    | a * a <= y =
        if x `mod` a == 0 then
            (a: (fact' (div x a) y a))
        else
            fact' x y (a + 1)
    | otherwise = [x]

import Control.Monad
import Data.List

readInt :: IO(Int)
readInt = fmap read getLine

readlist :: IO([Int])
readlist = fmap (map read . words) getLine

loop :: Int -> IO() -> IO()
loop 0 f = do
    f; loop 0 f
loop 1 f = f
loop x f = do
    f; loop (x - 1) f

main = do
	sz <- readInt
	v <- readlist
	print $ solve v

solve v = x - euler x where x = (foldl1 gcd v)

countDup v = (head v, length v)

euler x = if x > 1 then euler' (map countDup . group . fact $ x) else 0

euler' [] = 1
euler' (x:xs) = euler' xs * (fst x - 1) * (fst x ^ (snd x - 1))

fact :: Int -> [Int]
fact x = filter (>1) (fact' x x 2)

fact' :: Int -> Int -> Int -> [Int]
fact' x y a
    | a * a <= y =
        if x `mod` a == 0 then
            (a: (fact' (div x a) y a))
        else
            fact' x y (a + 1)
    | otherwise = [x]


One day n friends met at a party, they hadn't seen each other for a long time and so they decided to make a group photo together. Simply speaking, the process of taking photos can be described as follows. On the photo, each photographed friend occupies a rectangle of pixels: the i-th of them occupies the rectangle of width wi pixels and height hi pixels. On the group photo everybody stands in a line, thus the minimum pixel size of the photo including all the photographed friends, is W × H, where W is the total sum of all widths and H is the maximum height of all the photographed friends.As is usually the case, the friends made n photos — the j-th (1 ≤ j ≤ n) photo had everybody except for the j-th friend as he was the photographer.Print the minimum size of each made photo in pixels.

The first line contains integer n (2 ≤ n ≤ 200 000) — the number of friends.  Then n lines follow: the i-th line contains information about the i-th friend. The line contains a pair of integers wi, hi (1 ≤ wi ≤ 10, 1 ≤ hi ≤ 1000) — the width and height in pixels of the corresponding rectangle.

Print n space-separated numbers b1, b2, ..., bn, where bi — the total number of pixels on the minimum photo containing all friends expect for the i-th one.

{-# LANGUAGE MultiWayIf #-}
import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
  n <- readInt <$> C.getLine
  a <- replicateM n $ do
    [w, h] <- map readInt . C.words <$> C.getLine
    return (w, h)
  let (h1, h2) = flip foldl1' ((0, 0): a) $ \k@(i, j) (_, h) -> if
        | h > i -> (h, i)
        | h > j -> (i, h)
        | otherwise -> k
      sw = sum $ map fst a
      ans = [(sw - w) * (if h /= h1 then h1 else h2) | (w, h) <- a]
  putStrLn $ unwords $ map show ans
  where
  readInt = fst . fromJust . C.readInt

import Data.List

ans :: [(Int,Int)] -> [Int]
ans ls = map (\(x,y) -> (sumFstLs - x)*(if y == maxi then maxi2 else maxi)) ls where
	sumFstLs	= sum (map fst ls)
	sortedSndLs	= reverse $ sort (map snd ls)
	maxi 		= sortedSndLs !! 0
	maxi2		= sortedSndLs !! 1

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

main :: IO()
main = do
	n <- getLine
	content <- fmap (map read . words) getContents
	putStrLn $ intercalate " " $ map show $ ans $ getPairs content

import Control.Applicative ((<$>))
import Data.List ((\\))

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map read . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			solve w h =
					(s - w) * (if h == h1 then h2 else h1)
				where
					(ws, hs) = unzip sizes
					s = sum ws
					h1 = maximum hs
					h2 = maximum $ hs \\ [h1]

	putStrLn . unwords $ map show solution

{-# OPTIONS_GHC -O3 #-}

import Control.Applicative ((<$>))
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, lines, words)
import Data.List ((\\))
import Data.Maybe (fromJust)
import Data.Tuple (fst, uncurry)

import Prelude hiding (getContents, getLine, lines, words)

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map (fst . fromJust . readInt) . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			solve w h =
					(s - w) * (if h == h1 then h2 else h1)
				where
					(ws, hs) = unzip sizes
					s = sum ws
					h1 = maximum hs
					h2 = maximum $ hs \\ [h1]

	putStrLn . unwords $ map show solution

import Control.Applicative ((<$>))
import Data.List ((\\))
import Data.Maybe (fromJust)
import Data.Tuple (fst, uncurry)

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map read . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			(ws, hs) = unzip sizes
			totalWeight = sum ws
			h1 = maximum hs
			h2 = maximum $ hs \\ [h1]

			solve w h = (totalWeight - w) * (if h == h1 then h2 else h1)

	putStrLn . unwords $ map show solution

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, lines, words)
import Data.List ((\\))
import Data.Maybe (fromJust)
import Data.Tuple (fst, uncurry)

import Prelude hiding (getContents, getLine, lines, words)

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map (fst . fromJust . readInt) . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			solve w h =
					(s - w) * (if h == h1 then h2 else h1)
				where
					(ws, hs) = unzip sizes
					s = sum ws
					h1 = maximum hs
					h2 = maximum $ hs \\ [h1]

	putStrLn . unwords $ map show solution

import Control.Applicative ((<$>))
import Data.List ((\\))
import Data.Maybe (fromJust)
import Data.Tuple (fst, uncurry)

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map read . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			(ws, hs) = unzip sizes
			-- totalWeight = sum ws
			h1 = maximum hs
			h2 = maximum $ hs \\ [h1]

			solve w h = (s - w) * (if h == h1 then h2 else h1)
				where
					s = sum ws

	putStrLn . unwords $ map show solution

import Control.Applicative ((<$>))
import Data.ByteString (getContents, getLine)
import Data.ByteString.Char8 (readInt, lines, words)
import Data.List ((\\))
import Data.Maybe (fromJust)
import Data.Tuple (fst, uncurry)

import Prelude hiding (getContents, getLine, lines, words)

main = do
	getLine
	sizes <- map ((\[w, h] -> (w, h)) . map (fst . fromJust . readInt) . words) . lines <$> getContents

	let solution =
			map (uncurry solve) sizes
		where
			(ws, hs) = unzip sizes
			totalWeight = sum ws
			h1 = maximum hs
			h2 = maximum $ hs \\ [h1]

			solve w h = (totalWeight - w) * (if h == h1 then h2 else h1)

	putStrLn . unwords $ map show solution

readInput = do
    contents <- getContents
    let [n] : _sizes = map (map (read :: String -> Int) . words) $ lines contents
    let sizes = map (\[w, h] -> (w, h)) _sizes
    return (n, sizes)

printResult result = putStr $ unwords $ map show result

addMax (a, b) x
    | x > a     = (x, a)
    | x > b     = (a, x)
    | otherwise = (a, b)

remMax (a, b) x
    | x == a    = b
    | otherwise = a

getMax2 arr = foldl addMax (minVal, minVal) arr
    where minVal = -1

solve sizes = map f sizes
    where sumv     = sum $ map fst sizes
          max2     = getMax2 $ map snd sizes
          f (w, h) = (sumv - w) * (remMax max2 h)

main = do
    (n, sizes) <- readInput
    printResult $ solve sizes

import Control.Monad
secondMaximum l = if length lAlt == n - 1 then maximum lAlt else mx
    where
      mx = maximum l
      lAlt = filter (/= mx) l
      n = length l
solve l =
    map (\(w, h)-> (totalWidth - w) * (alternative h firstH secondH)) l
    where
      totalWidth = sum $ map fst l :: Integer
      firstH = maximum $ map snd l
      secondH = secondMaximum $ map snd l
      alternative x y z = if x == y then z else y :: Integer

main = do
  n <- liftM read getLine
  l <- forM [1..n] (\ i -> liftM (listToPair . map read . words) getLine)
  putStrLn $ unwords $ map show $ solve l
  where
    listToPair [a, b] = (a, b)

import Data.List

ans :: [(Int,Int)] -> [Int]
ans ls = map (\(x,y) -> (sumFstLs - x)*(if y == maxi then maxi2 else maxi)) ls where
	sumFstLs	= sum (map fst ls)
	sortedSndLs	= reverse $ sort (map snd ls)
	maxi 		= sortedSndLs !! 0
	maxi2		= sortedSndLs !! 1

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

main :: IO()
main = do
	n <- getLine
	content <- fmap (map read . words) getContents
	putStrLn $ intercalate " " $ map show $ ans $ getPairs content


The only difference between easy and hard versions is on constraints. In this version constraints are higher. You can make hacks only if all versions of the problem are solved.Koa the Koala is at the beach!The beach consists (from left to right) of a shore, $$$n+1$$$ meters of sea and an island at $$$n+1$$$ meters from the shore.She measured the depth of the sea at $$$1, 2, \dots, n$$$ meters from the shore and saved them in array $$$d$$$. $$$d_i$$$ denotes the depth of the sea at $$$i$$$ meters from the shore for $$$1 \le i \le n$$$.Like any beach this one has tide, the intensity of the tide is measured by parameter $$$k$$$ and affects all depths from the beginning at time $$$t=0$$$ in the following way:  For a total of $$$k$$$ seconds, each second, tide increases all depths by $$$1$$$.  Then, for a total of $$$k$$$ seconds, each second, tide decreases all depths by $$$1$$$.  This process repeats again and again (ie. depths increase for $$$k$$$ seconds then decrease for $$$k$$$ seconds and so on ...).Formally, let's define $$$0$$$-indexed array $$$p = [0, 1, 2, \ldots, k - 2, k - 1, k, k - 1, k - 2, \ldots, 2, 1]$$$ of length $$$2k$$$. At time $$$t$$$ ($$$0 \le t$$$) depth at $$$i$$$ meters from the shore equals $$$d_i + p[t \bmod 2k]$$$ ($$$t \bmod 2k$$$ denotes the remainder of the division of $$$t$$$ by $$$2k$$$). Note that the changes occur instantaneously after each second, see the notes for better understanding. At time $$$t=0$$$ Koa is standing at the shore and wants to get to the island. Suppose that at some time $$$t$$$ ($$$0 \le t$$$) she is at $$$x$$$ ($$$0 \le x \le n$$$) meters from the shore:  In one second Koa can swim $$$1$$$ meter further from the shore ($$$x$$$ changes to $$$x+1$$$) or not swim at all ($$$x$$$ stays the same), in both cases $$$t$$$ changes to $$$t+1$$$.  As Koa is a bad swimmer, the depth of the sea at the point where she is can't exceed $$$l$$$ at integer points of time (or she will drown). More formally, if Koa is at $$$x$$$ ($$$1 \le x \le n$$$) meters from the shore at the moment $$$t$$$ (for some integer $$$t\ge 0$$$), the depth of the sea at this point  — $$$d_x + p[t \bmod 2k]$$$  — can't exceed $$$l$$$. In other words, $$$d_x + p[t \bmod 2k] \le l$$$ must hold always.  Once Koa reaches the island at $$$n+1$$$ meters from the shore, she stops and can rest.Note that while Koa swims tide doesn't have effect on her (ie. she can't drown while swimming). Note that Koa can choose to stay on the shore for as long as she needs and neither the shore or the island are affected by the tide (they are solid ground and she won't drown there). Koa wants to know whether she can go from the shore to the island. Help her!

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$)  — the number of test cases. Description of the test cases follows. The first line of each test case contains three integers $$$n$$$, $$$k$$$ and $$$l$$$ ($$$1 \le n \le 3 \cdot 10^5; 1 \le k \le 10^9; 1 \le l \le 10^9$$$) — the number of meters of sea Koa measured and parameters $$$k$$$ and $$$l$$$. The second line of each test case contains $$$n$$$ integers $$$d_1, d_2, \ldots, d_n$$$ ($$$0 \le d_i \le 10^9$$$)  — the depths of each meter of sea Koa measured. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case: Print Yes if Koa can get from the shore to the island, and No otherwise. You may print each letter in any case (upper or lower).

NoteIn the following $$$s$$$ denotes the shore, $$$i$$$ denotes the island, $$$x$$$ denotes distance from Koa to the shore, the underline denotes the position of Koa, and values in the array below denote current depths, affected by tide, at $$$1, 2, \dots, n$$$ meters from the shore.In test case $$$1$$$ we have $$$n = 2, k = 1, l = 1, p = [ 0, 1 ]$$$.Koa wants to go from shore (at $$$x = 0$$$) to the island (at $$$x = 3$$$). Let's describe a possible solution:  Initially at $$$t = 0$$$ the beach looks like this: $$$[\underline{s}, 1, 0, i]$$$.  At $$$t = 0$$$ if Koa would decide to swim to $$$x = 1$$$, beach would look like: $$$[s, \underline{2}, 1, i]$$$ at $$$t = 1$$$, since $$$2 > 1$$$ she would drown. So Koa waits $$$1$$$ second instead and beach looks like $$$[\underline{s}, 2, 1, i]$$$ at $$$t = 1$$$.  At $$$t = 1$$$ Koa swims to $$$x = 1$$$, beach looks like $$$[s, \underline{1}, 0, i]$$$ at $$$t = 2$$$. Koa doesn't drown because $$$1 \le 1$$$.  At $$$t = 2$$$ Koa swims to $$$x = 2$$$, beach looks like $$$[s, 2, \underline{1}, i]$$$ at $$$t = 3$$$. Koa doesn't drown because $$$1 \le 1$$$.  At $$$t = 3$$$ Koa swims to $$$x = 3$$$, beach looks like $$$[s, 1, 0, \underline{i}]$$$ at $$$t = 4$$$.  At $$$t = 4$$$ Koa is at $$$x = 3$$$ and she made it! We can show that in test case $$$2$$$ Koa can't get to the island.

import Control.Monad

data Phase = Up | Down

solve :: Int -> Int -> [Int] -> Bool
solve k l d = go d k Down
  where go [] _ _ = True
        go (di:ds) tide phase
          | di + k <= l                 = go ds k Down
          | water < 0 || di + water > l = False
          | water == 0                  = go ds 0 Up
          | otherwise                   = go ds water phase
            where water = case phase of
                    Up -> tide + 1
                    Down -> if di + tide - 1 > l then l - di else tide - 1

main :: IO ()
main = do
  let readInts = getLine >>= pure . map read . words :: IO [Int]
  t <- readLn :: IO Int
  replicateM_ t $ do
    _ : k : l : _ <- readInts
    d <- readInts
    putStrLn $ if solve k l d then "yes" else "no"


You are given three positive (i.e. strictly greater than zero) integers $$$x$$$, $$$y$$$ and $$$z$$$.Your task is to find positive integers $$$a$$$, $$$b$$$ and $$$c$$$ such that $$$x = \max(a, b)$$$, $$$y = \max(a, c)$$$ and $$$z = \max(b, c)$$$, or determine that it is impossible to find such $$$a$$$, $$$b$$$ and $$$c$$$.You have to answer $$$t$$$ independent test cases. Print required $$$a$$$, $$$b$$$ and $$$c$$$ in any (arbitrary) order.

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 only line of the test case contains three integers $$$x$$$, $$$y$$$, and $$$z$$$ ($$$1 \le x, y, z \le 10^9$$$).

For each test case, print the answer:   "NO" in the only line of the output if a solution doesn't exist;  or "YES" in the first line and any valid triple of positive integers $$$a$$$, $$$b$$$ and $$$c$$$ ($$$1 \le a, b, c \le 10^9$$$) in the second line. You can print $$$a$$$, $$$b$$$ and $$$c$$$ in any order.

import Data.List

main = do
    contents <- getContents
    let notnull = filter (not . null) $ lines contents
    mapM solve $ drop 1 $ map (sort . map (read :: String -> Int) . words) notnull

solve (a:b:c:[])
    | b == c = putStrLn ("YES " ++ show b ++ " " ++ show a ++ " 1")
    | otherwise = putStrLn "NO"

module Main where
import Data.List
main :: IO ()
main = interact $ unlines . map solve . tail . lines

solve :: String -> String
solve str=
  let
      (x:y:z:[]) = sort $ map read $ words str :: [Integer]
      b = x
      c = y
      a = if (c > b) then b - 1 else c - 1
  in
   if (z /= max b c)
   then "NO\n"
   else if (a == 0)
   then "YES\n" ++ show (a+1) ++ " " ++ show b ++ " " ++ show c
   else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- solve :: String -> String
-- solve str=
--   let
--       (x:y:z:[]) = map read $ words str :: [Integer]
--       l = [1 .. 1000]
--       ll = [(a, b, c) | a <- l, b <- l, c <-l, x == max a b, y == max a c, z == max b c]
--       (a, b, c) = if null ll then (0, 0, 0) else head ll
--   in
--    if (a == 0 || b == 0 || c == 0)
--    then "NO\n"
--    else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- max1 :: Integer -> Integer -> Maybe Integer
-- max1 a b = if a == b then Nothing else Just $ max a b

main = interact $ unlines . concat . map (solve . map show . sort . map read) . map words . tail . lines

solve :: [String] -> [String]
solve (x:y:z:_)
  | x == y && y == z = ["YES", unwords [x, x, x]]
  | x == y = ["YES", unwords [x, z, z]]
  | otherwise = ["NO"]

sort :: [Integer] -> [Integer]
sort (x:y:z:[])
  | x >= y && y >= z = [x, y, z]
  | x >= z && z >= y = [x, z, y]
  | y >= x && x >= z = [y, x, z]
  | y >= z && z >= x = [y, z, x]
  | z >= y && y >= x = [z, y, x]
  | z >= x && x >= y = [z, x, y]

import Data.List ( sort )
import Control.Monad ( replicateM_ )

solve :: [Integer] -> String
solve [x, y, z]
  | y == z    = "YES\n" ++ unwords (map show [x, x, z])
  | otherwise = "NO"

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n $ solve . sort . map read . words <$> getLine >>= putStrLn

import Data.List ( sort )

solve :: [Integer] -> String
solve [x, y, z]
  | y == z    = "YES\n" ++ unwords (map show [x, x, z])
  | otherwise = "NO"

main :: IO ()
main = interact $ unlines . map (solve . sort . map read . words) . tail . lines

module Main where

import Data.List
import Control.Monad (replicateM_)

go :: IO ()
go = do
  [x, y, z] <- reverse . sort . map read . words <$> getLine :: IO [Integer]
  if x == y && y == z
    then putStrLn "YES" >> putStrLn (unwords $ show <$> [x, y, z])
    else if x == y && y > z
      then putStrLn "YES" >> putStrLn (unwords $ show <$> [x, z, z])
      else putStrLn "NO"

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

import Control.Monad
import Data.List

solve :: [Int] -> [Int]
solve xs @ [x, y, z]
  | yes && x == y && y == z = [m, m, m]
  | yes = [m, z, z]
  | otherwise = []

  where
    yes = length (xs \\ [m, m]) == 1
    m = maximum xs
    z = minimum xs

print' :: [Int] -> IO ()
print' xs
  | null xs = putStrLn "NO"
  | otherwise = putStrLn "YES" >> putStrLn (unwords . map show $ xs)

test :: Int -> IO ()
test n = do
  tests <- replicateM n (map read . words <$> getLine)
  mapM_ (print' . solve) tests

main :: IO ()
main = do
  n <- getLine
  let n' = (read n :: Int)
  test n'

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

process x y z | x==y && y==z = [x,x,x]
	      | x==y = []
              | y==z = [x,x,y]
	      | otherwise = []

onecase = do
		[x,y,n]<- sort <$> map read <$> words <$> getLine ::IO [Int]
		let k = process x y n
		putStrLn $ if k==[] then "NO" else "YES"
		if k/=[] then putStrLn ( intercalate " " ( map show k)) else putStr ""

main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

import Data.List

main = do
    contents <- getContents
    mapM solve (drop 1 (map (sort . words) (lines contents)))

solve (a:b:c:[])
    | b == c = putStrLn ("YES " ++ b ++ " " ++ a ++ " 1")
    | otherwise = putStrLn "NO"

module Main where

main :: IO ()
main = interact $ unlines . map solve . tail . lines

solve :: String -> String
solve str=
  let
      (x:y:z:[]) = map read $ words str :: [Integer]
      b = x
      c = y
      a = if (c > b) then b - 1 else c - 1
  in
   if (z /= max b c)
   then "NO\n"
   else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- solve :: String -> String
-- solve str=
--   let
--       (x:y:z:[]) = map read $ words str :: [Integer]
--       l = [1 .. 1000]
--       ll = [(a, b, c) | a <- l, b <- l, c <-l, x == max a b, y == max a c, z == max b c]
--       (a, b, c) = if null ll then (0, 0, 0) else head ll
--   in
--    if (a == 0 || b == 0 || c == 0)
--    then "NO\n"
--    else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- max1 :: Integer -> Integer -> Maybe Integer
-- max1 a b = if a == b then Nothing else Just $ max a b

module Main where

main :: IO ()
main = interact $ unlines . map solve . tail . lines

solve :: String -> String
solve str=
  let
      (x:y:z:[]) = map read $ words str :: [Integer]
      b = x
      c = y
      a = if (c > b) then b - 1 else c - 1
  in
   if (z /= max b c)
   then "NO\n"
   else if (a == 0)
   then "YES\n" ++ show (a+1) ++ " " ++ show b ++ " " ++ show c
   else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- solve :: String -> String
-- solve str=
--   let
--       (x:y:z:[]) = map read $ words str :: [Integer]
--       l = [1 .. 1000]
--       ll = [(a, b, c) | a <- l, b <- l, c <-l, x == max a b, y == max a c, z == max b c]
--       (a, b, c) = if null ll then (0, 0, 0) else head ll
--   in
--    if (a == 0 || b == 0 || c == 0)
--    then "NO\n"
--    else "YES\n" ++ show a ++ " " ++ show b ++ " " ++ show c

-- max1 :: Integer -> Integer -> Maybe Integer
-- max1 a b = if a == b then Nothing else Just $ max a b

import Control.Monad
import Data.List

solve :: [Int] -> [Int]
solve xs @ [x, y, z]
  | yes && x == y && y == z = [m, m, m]
  | yes = xs
  | otherwise = []

  where
    yes = length (xs \\ [m, m]) == 1
    m = maximum xs

print' :: [Int] -> IO ()
print' xs
  | null xs = putStrLn "NO"
  | otherwise = putStrLn "YES" >> putStrLn (unwords . map show $ xs)

test :: Int -> IO ()
test n = do
  tests <- replicateM n (map read . words <$> getLine)
  mapM_ (print' . solve) tests

main :: IO ()
main = do
  n <- getLine
  let n' = (read n :: Int)
  test n'