Ever since Kalevitch, a famous Berland abstractionist, heard of fractals, he made them the main topic of his canvases. Every morning the artist takes a piece of graph paper and starts with making a model of his future canvas. He takes a square as big as n × n squares and paints some of them black. Then he takes a clean square piece of paper and paints the fractal using the following algorithm: Step 1. The paper is divided into n2 identical squares and some of them are painted black according to the model.Step 2. Every square that remains white is divided into n2 smaller squares and some of them are painted black according to the model.Every following step repeats step 2.  Unfortunately, this tiresome work demands too much time from the painting genius. Kalevitch has been dreaming of making the process automatic to move to making 3D or even 4D fractals.

The first line contains integers n and k (2 ≤ n ≤ 3, 1 ≤ k ≤ 5), where k is the amount of steps of the algorithm. Each of the following n lines contains n symbols that determine the model. Symbol «.» stands for a white square, whereas «*» stands for a black one. It is guaranteed that the model has at least one white square.

Output a matrix nk × nk which is what a picture should look like after k steps of the algorithm.

import Array
import Control.Monad (liftM)
import IO

type Paint  =  Array (Int, Int) Char

parsePaint :: Int -> [String] -> Paint
parsePaint n xs  =  array ((1,1), (n,n))
    [((i,j), xs !! (i-1) !! (j-1)) | i <- [1..n], j <- [1..n]]

step :: Int -> Paint -> Paint
step m a  =  array ((1,1), (m*n, m*n))
    [((i,j), f i j) | i <- [1..m*n], j <- [1..m*n]]
  where
    n  =  snd $ snd $ bounds a
    f i j
      | a ! (1 + div (i-1) m, 1 + div (j-1) m) == '*'  =  '*'
      | otherwise  =  a ! (i2, j2)
      where
        i2  =  1 + mod (i-1) n
        j2  =  1 + mod (j-1) n

solve :: Int -> Int -> Paint -> Paint
solve n 1 a  =  a
solve n k a  =  solve n (k-1) (step n a)

printPaint :: Handle -> Paint -> IO ()
printPaint hOutput paint  =
    mapM_ (\i -> hPutStrLn hOutput $ [paint ! (i,j) | j <- [1..n]]) [1..n]
  where
    n  =  snd $ snd $ bounds paint

main :: IO ()
main  =  do
    hInput   <-  openFile "input.txt" ReadMode
    hOutput  <-  openFile "output.txt" WriteMode

    [n, k]  <-  liftM (map read . words) (hGetLine hInput)
    lineses  <-  liftM lines (hGetContents hInput)
    let paint  =  parsePaint n lineses
    printPaint hOutput $ solve n k paint

    hClose hInput
    hClose hOutput

import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.words

func::[String]->String
func (a:b:xs) = solve (toInt a) (toInt b) 0 xs
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read
toString::Int->String
toString=show

test _ (-1) _ _ _                        = True
test a b y x d | ((d!!y')!!x') == '*' = False
               | otherwise            = True &&
                                        (test a (b-1)
                                                  y --(y `mod` (a^b))
                                                  x --(x `mod` (a^b))
                                                  d)
                                        where
                                          y' = (y `div` (a^b))`mod`a
                                          x' = (x `div` (a^b))`mod`a

solve::Int->Int->Int->[[Char]]->String
solve a b c d | c < a^b = (foldl solve' [] [0..a^b-1]) ++
                           "\n" ++ (solve a b (c+1) d)
              | otherwise= []
                where
                  solve' acc a' | test a (b-1) c a' d = acc++['.']
                                | otherwise           = acc++['*']

import Control.Applicative
import Control.Monad
import Data.List
import Text.Printf

main :: IO ()
main = do
  let writeText = appendFile "output.txt" . printf "%s\n"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = map read . words $ s
      pat = take n ss
      generate pss = do
        let expand qss = [concat [replicate n q | q <- qs] | qs <- qss]
            pss'  = expand pss
            pss'' = transpose . expand . transpose $ pss'
        pss''
      boards = do
        (i, xss) <- zip [1 .. k] $ iterate generate pat
        let duplicate = map (concat . replicate (n ^ (k - i)))
            xss'  = duplicate xss
            xss'' = transpose . duplicate . transpose $ xss'
        return $ xss''
      combine '*' _   = '*'
      combine _   '*' = '*'
      combine _   _   = '.'
      ans = foldl1 (zipWith (zipWith combine)) boards
  mapM_ writeText ans

import Control.Applicative
import Control.Monad
import Data.List
import Text.Printf

main :: IO ()
main = do
  let writeText = appendFile "output.txt" . printf "%s\n"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = map read . words $ s
      g = n ^ k
      pat = take n ss
      generate pss = do
        let expand qss = [concat [replicate n q | q <- qs] | qs <- qss]
            pss'  = expand pss
            pss'' = transpose . expand . transpose $ pss'
        pss''
      boards = do
        (i, xss) <- zip [1 .. k] $ iterate generate pat
        let w = n ^ (k - i)
            duplicate = map (concat . replicate w)
            xss'  = duplicate xss
            xss'' = transpose . duplicate . transpose $ xss'
        return $ xss''
      combine '*' _   = '*'
      combine _   '*' = '*'
      combine _   _   = '.'
      ans = foldr1 (zipWith (zipWith combine)) boards
  mapM_ writeText ans

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Char
import Data.Ord
-- import Data.Function
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.IO
import Data.Array.Unboxed

for_ :: (Monad m, Integral a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let conv :: String -> [Int]
      conv = map read . words
      writeText = appendFile "output.txt"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = conv s
      g = n ^ k
      a = listArray ((1, 1), (n, n)) . concat $ take n ss :: UArray (Int, Int) Char
  table <- newArray ((1, 1), (g, g)) '.' :: IO (IOUArray (Int, Int) Char)
  let fill !baseL !baseC !w = do
        for_ 1 w $ \l -> do
          for_ 1 w $ \c -> do
            let !idx  = (baseL + l, baseC + c)
                !idx' = ((l - 1) `quot` (w `quot` n) + 1, (c - 1) `quot` (w `quot` n) + 1)
            x <- readArray table idx
            when (x == '.' && a ! idx' == '*') $ do
                writeArray table idx '*'
      loop w = do
        when (w >= n) $ do
          forM_ [0, w .. g - 1] $ \baseL -> do
            forM_ [0, w .. g - 1] $ \baseC -> do
              fill baseL baseC  w
          loop (w `quot` n)
  loop g
  let split [] = []
      split xs = as : split bs where
        (as, bs) = splitAt g xs
  getElems table >>= writeText . unlines . split

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Text.Printf

main :: IO ()
main = do
  let writeText = appendFile "output.txt" . printf "%s\n"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = map read . words $ s
      g = n ^ k
      pat = take n ss
      generate pss = do
        let expand qss = [concat [replicate n q | q <- qs] | qs <- qss]
            pss'  = expand pss
        transpose . expand . transpose $ pss'
      boards = do
        (i, xss) <- zip [1 .. k] $ iterate generate pat
        let w = n ^ (k - i)
            duplicate = map (concat . replicate w)
            xss'  = duplicate xss
            xss'' = transpose . duplicate . transpose $ xss'
        return $ xss''
      combine '*' _   = '*'
      combine _   '*' = '*'
      combine _   _   = '.'
      ans = foldr1 (zipWith (zipWith combine)) boards
  mapM_ writeText ans

main = do
  x <- readFile "input.txt"
  writeFile "output.txt" (f x)
f x = unlines $ answer k where
  l0:model = lines x
  [n,k] = map (read::String->Int) $ words l0
  g [] = []
  g (y:ys) = (g0 y):(g ys)
  g0 [] = []
  g0 (y:ys) = (g1 y):(g0 ys)
  g1 y
    | y=='.'    = model
    | otherwise = replicate n $ replicate n '*'
  h [] = []
  h (y:ys) = (h0 y) ++ (h ys)
  h0 ys
    | null $ head ys = []
    | otherwise      = (concat $ map head ys):(h0 $ map tail ys)
  answer 1 = model
  answer y = h $ g $ answer (y-1)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Char
import Data.Ord
-- import Data.Function
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.IO
import Data.Array.Unboxed

for_ :: (Monad m, Integral a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let conv :: String -> [Int]
      conv = map read . words
      writeText = appendFile "output.txt"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = conv s
      g = n ^ k
      a = listArray ((1, 1), (n, n)) . concat $ take n ss :: UArray (Int, Int) Char
  table <- newArray ((1, 1), (g, g)) '.' :: IO (IOUArray (Int, Int) Char)
  let fill !baseL !baseC !w = do
        for_ 1 w $ \l -> do
          for_ 1 w $ \c -> do
            let !idx  = (baseL + l, baseC + c)
                !idx' = ((l - 1) `quot` (w `quot` n) + 1, (c - 1) `quot` (w `quot` n) + 1)
            x <- readArray table idx
            when (x == '.' && a ! idx' == '*') $ do
                writeArray table idx '*'
      loop w = do
        when (w > n) $ do
          let !w' = w `quot` n
          forM_ [0, w' .. g - 1] $ \baseL' -> do
            forM_ [0, w' .. g - 1] $ \baseC' -> do
              fill baseC' baseL' w'
          loop w'
  loop g
  let split [] = []
      split xs = as : split bs where
        (as, bs) = splitAt g xs
  getElems table >>= writeText . unlines . split

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Char
import Data.Ord
-- import Data.Function
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.IO
import Data.Array.Unboxed

for_ :: (Monad m, Integral a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let conv :: String -> [Int]
      conv = map read . words
      writeText = appendFile "output.txt"
  s : ss <- lines <$> readFile "input.txt"
  let n : k : _ = conv s
      a = listArray ((1, 1), (n , n)) . concat $ take n ss :: UArray (Int, Int) Char
  table <- newArray ((1, 1), (n ^ k, n ^ k)) '.' :: IO (IOArray (Int, Int) Char)
  let fill (baseL, baseC) w = do
        forM_ [1 .. w] $ \l -> do
          forM_ [1 .. w] $ \c -> do
            let idx  = (baseL + l, baseC + c)
                idx' = ((l - 1) `quot` (w `quot` n) + 1, (c - 1) `quot` (w `quot` n) + 1)
            x <- readArray table idx
            when (x == '.') $ do
              when (a ! idx' == '*') $ do
                writeArray table idx '*'
        when (False && w > n) $ do
          let w' = w `quot` n
          forM_ [0, w' .. n ^ k - 1] $ \baseL' -> do
            forM_ [0, w' .. n ^ k - 1] $ \baseC' -> do
              fill (baseC', baseL') w'
  fill (0, 0) (n ^ k)
  let split [] = []
      split xs = as : split bs where
        (as, bs) = splitAt (n ^ k) xs
  getElems table >>= writeText . unlines . split


Hiking club "Up the hill" just returned from a walk. Now they are trying to remember which hills they've just walked through.It is known that there were N stops, all on different integer heights between 1 and N kilometers (inclusive) above the sea level. On the first day they've traveled from the first stop to the second stop, on the second day they've traveled from the second to the third and so on, and on the last day they've traveled from the stop N - 1 to the stop N and successfully finished their expedition.They are trying to find out which heights were their stops located at. They have an entry in a travel journal specifying how many days did they travel up the hill, and how many days did they walk down the hill.Help them by suggesting some possible stop heights satisfying numbers from the travel journal.

In the first line there is an integer non-negative number A denoting the number of days of climbing up the hill. Second line contains an integer non-negative number B — the number of days of walking down the hill (A + B + 1 = N, 1 ≤ N ≤ 100 000).

Output N space-separated distinct integers from 1 to N inclusive, denoting possible heights of the stops in order of visiting.

nums :: Int -> Int -> [String]
nums a b
    | a>b       = []
    | a==b      = [show b]
    | otherwise = (show a) : (nums (a+1) b)

f :: Int -> Int -> Int -> [String]
f u d n = (nums 1 u) ++ (reverse (nums (u+1) (n+1)))

main = do
    a <- getLine
    b <- getLine
    putStrLn (unwords(f (read a) (read b) ((read a)+(read b))))

{-# LANGUAGE ScopedTypeVariables #-}

module Main where

import Control.Monad (forM_)

interchange :: [t] -> [t] -> [t]
interchange [] []         = []
interchange (x:xs) (y:ys) = x:y:(interchange xs ys)
interchange _ _           = error "must be of the same length"

getRoute :: (Ord a, Num a, Enum a) => a -> a -> [a]
getRoute u d
  = if u == d then
      interchange [1..u] [n,n-1..u+2] ++ [u+1]
    else if u > d then
      [1..(u-d)] ++ interchange [(u-d)+1..u] [n,n-1..u+2] ++ [u+1]
    else
      [n,n-1..2*u+2] ++ interchange [2*u+1,2*u..u+2] [1..u] ++ [u+1]
  where
    n  = u + d + 1

main :: IO ()
main = do
  (a :: Int) <- readLn
  (b :: Int) <- readLn
  forM_ (getRoute a b) (putStr . (++" ") . show)

{-# LANGUAGE ScopedTypeVariables #-}

-- | Main entry point to the application.
module Main where

-- | The main entry point.
main :: IO ()
main = do
    (a :: Int) <- readLn
    (b :: Int) <- readLn
    let n = a + b + 1
    if (a > b) then do
        mapM_ (putStr . (++" ") . show) [1..a+1]
        mapM_ (putStr . (++" ") . show) [a..a+1-b]
    else do
        mapM_ (putStr . (++" ") . show) [n,n-1..n-b]
        mapM_ (putStr . (++" ") . show) [n-b+1,n-b..n-b+a]

{-# LANGUAGE ScopedTypeVariables #-}

-- | Main entry point to the application.
module Main where

-- | The main entry point.
main :: IO ()
main = do
    (a :: Int) <- readLn
    (b :: Int) <- readLn
    let n = a + b + 1
    if (a > b) then do
        mapM_ (putStr . (++" ") . show) [1..a+1]
        mapM_ (putStr . (++" ") . show) [a,a-1..a+1-b]
    else do
        mapM_ (putStr . (++" ") . show) [n,n-1..n-b]
        mapM_ (putStr . (++" ") . show) [n-b+1..n-b+a]


Luis has a sequence of $$$n+1$$$ integers $$$a_1, a_2, \ldots, a_{n+1}$$$. For each $$$i = 1, 2, \ldots, n+1$$$ it is guaranteed that $$$0\leq a_i < n$$$, or $$$a_i=n^2$$$. He has calculated the sum of all the elements of the sequence, and called this value $$$s$$$. Luis has lost his sequence, but he remembers the values of $$$n$$$ and $$$s$$$. Can you find the number of elements in the sequence that are equal to $$$n^2$$$?We can show that the answer is unique under the given constraints.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 2\cdot 10^4$$$). Description of the test cases follows. The only line of each test case contains two integers $$$n$$$ and $$$s$$$ ($$$1\le n< 10^6$$$, $$$0\le s \le 10^{18}$$$). It is guaranteed that the value of $$$s$$$ is a valid sum for some sequence satisfying the above constraints.

For each test case, print one integer — the number of elements in the sequence which are equal to $$$n^2$$$.

NoteIn the first test case, we have $$$s=0$$$ so all numbers are equal to $$$0$$$ and there isn't any number equal to $$$49$$$.In the second test case, we have $$$s=1$$$. There are two possible sequences: $$$[0, 1]$$$ or $$$[1, 0]$$$. In both cases, the number $$$1$$$ appears just once. In the third test case, we have $$$s=12$$$, which is the maximum possible value of $$$s$$$ for this case. Thus, the number $$$4$$$ appears $$$3$$$ times in the sequence.

import Control.Monad
main = read <$> getLine >>= flip replicateM_ (map read . words <$> getLine >>= \ [n, s] -> print $ s `div` (n*n))

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

solve :: IO ()
solve = map readInt . words <$> getLine >>= \ [n, s] -> print $ s `div` (n*n)

readInt :: String -> Int
readInt = read

module Main where

import Control.Monad

main :: IO ()
main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    [n, s] <- (map read . words) <$> getLine :: IO [Int]
    print $ div s (n^2)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Main (main) where

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Control.Monad.State (State, evalState, gets, MonadState (get), put)
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Control.Applicative (liftA2)

data TC = TC { n :: Integer, s :: Integer }

solve TC{..} = s `div` (n * n)

main :: IO ()
main = C.interact $ runScanner scan >>> map solve >>> map (C.pack . show) >>> C.unlines

scan = numberOf $ TC <$> integer <*> integer

type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

str :: Scanner C.ByteString
str = get >>= \case { s:ss -> put ss >> return s }

int :: Scanner Int
int = fst . fromJust . C.readInt <$> str

integer :: Scanner Integer
integer = read . C.unpack <$> str

double :: Scanner Double
double = read . C.unpack <$> str

decimal :: Int -> Scanner Int
decimal p = round . ((10^p)*) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case { [] -> return []; _ -> (:) <$> s <*> many s }

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t then return [] else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2..4]

pair :: Scanner a -> Scanner b -> Scanner (a,b)
pair = liftA2 (,)

solve :: [String] -> [String]
solve = map (func . (map read . words))
func :: [Int] -> String
func [a,b] = show $ b `div` (a*a)
main :: IO()
main = interact $ unlines.solve.tail.lines


You are standing on the $$$\mathit{OX}$$$-axis at point $$$0$$$ and you want to move to an integer point $$$x > 0$$$.You can make several jumps. Suppose you're currently at point $$$y$$$ ($$$y$$$ may be negative) and jump for the $$$k$$$-th time. You can:   either jump to the point $$$y + k$$$  or jump to the point $$$y - 1$$$. What is the minimum number of jumps you need to reach the point $$$x$$$?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first and only line of each test case contains the single integer $$$x$$$ ($$$1 \le x \le 10^6$$$) — the destination point.

For each test case, print the single integer — the minimum number of jumps to reach $$$x$$$. It can be proved that we can reach any integer point $$$x$$$.

NoteIn the first test case $$$x = 1$$$, so you need only one jump: the $$$1$$$-st jump from $$$0$$$ to $$$0 + 1 = 1$$$.In the second test case $$$x = 2$$$. You need at least three jumps:   the $$$1$$$-st jump from $$$0$$$ to $$$0 + 1 = 1$$$;  the $$$2$$$-nd jump from $$$1$$$ to $$$1 + 2 = 3$$$;  the $$$3$$$-rd jump from $$$3$$$ to $$$3 - 1 = 2$$$; Two jumps are not enough because these are the only possible variants:   the $$$1$$$-st jump as $$$-1$$$ and the $$$2$$$-nd one as $$$-1$$$ — you'll reach $$$0 -1 -1 =-2$$$;  the $$$1$$$-st jump as $$$-1$$$ and the $$$2$$$-nd one as $$$+2$$$ — you'll reach $$$0 -1 +2 = 1$$$;  the $$$1$$$-st jump as $$$+1$$$ and the $$$2$$$-nd one as $$$-1$$$ — you'll reach $$$0 +1 -1 = 0$$$;  the $$$1$$$-st jump as $$$+1$$$ and the $$$2$$$-nd one as $$$+2$$$ — you'll reach $$$0 +1 +2 = 3$$$; In the third test case, you need two jumps: the $$$1$$$-st one as $$$+1$$$ and the $$$2$$$-nd one as $$$+2$$$, so $$$0 + 1 + 2 = 3$$$.In the fourth test case, you need three jumps: the $$$1$$$-st one as $$$-1$$$, the $$$2$$$-nd one as $$$+2$$$ and the $$$3$$$-rd one as $$$+3$$$, so $$$0 - 1 + 2 + 3 = 4$$$.

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

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

solve :: Int -> Int
solve x
  | x == tri-1 = n+1
  | otherwise = n
  where
    n = ceiling ((-1 + sqrt (1 + 8*fromIntegral x))/2)
    tri = n*(n+1)`div`2

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = (itoline . solve . linetoi) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Int -> Int
solve x
  | a == x+1 = b+1
  | otherwise = b where
  (a,b) = head $ dropWhile ((<x).fst)  $ [(n*(n+1) `div` 2, n) | n <- [(floor.sqrt.fromIntegral) x ..]]


Mark is cleaning a row of $$$n$$$ rooms. The $$$i$$$-th room has a nonnegative dust level $$$a_i$$$. He has a magical cleaning machine that can do the following three-step operation.   Select two indices $$$i<j$$$ such that the dust levels $$$a_i$$$, $$$a_{i+1}$$$, $$$\dots$$$, $$$a_{j-1}$$$ are all strictly greater than $$$0$$$.  Set $$$a_i$$$ to $$$a_i-1$$$.  Set $$$a_j$$$ to $$$a_j+1$$$.  Mark's goal is to make $$$a_1 = a_2 = \ldots = a_{n-1} = 0$$$ so that he can nicely sweep the $$$n$$$-th room. Determine the minimum number of operations needed to reach his goal.

The first line contains a single integer $$$t$$$ ($$$1\leq t\leq 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2\leq n\leq 2\cdot 10^5$$$) — the number of rooms. The second line of each test case contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$0\leq a_i\leq 10^9$$$) — the dust level of each room. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print a line containing a single integer — the minimum number of operations. It can be proven that there is a sequence of operations that meets the goal.

NoteIn the first case, one possible sequence of operations is as follows.   Choose $$$i=1$$$ and $$$j=2$$$, yielding the array $$$[1,1,0]$$$.  Choose $$$i=1$$$ and $$$j=3$$$, yielding the array $$$[0,1,1]$$$.  Choose $$$i=2$$$ and $$$j=3$$$, yielding the array $$$[0,0,2]$$$.  At this point, $$$a_1=a_2=0$$$, completing the process.In the second case, one possible sequence of operations is as follows.   Choose $$$i=4$$$ and $$$j=5$$$, yielding the array $$$[0,2,0,1,1]$$$.  Choose $$$i=2$$$ and $$$j=3$$$, yielding the array $$$[0,1,1,1,1]$$$.  Choose $$$i=2$$$ and $$$j=5$$$, yielding the array $$$[0,0,1,1,2]$$$.  Choose $$$i=3$$$ and $$$j=5$$$, yielding the array $$$[0,0,0,1,3]$$$.  Choose $$$i=4$$$ and $$$j=5$$$, yielding the array $$$[0,0,0,0,4]$$$. In the last case, the array already satisfies the condition.

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

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

solve as = (sum.tail $ rs) + (length . filter (==0) . dropWhile (==0) . reverse . tail $ rs)
  where
    rs = reverse as

{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns,
  FlexibleContexts,
  TypeApplications,
  MultiWayIf #-}

import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe
import Control.Monad
import Data.Array.Unboxed
import Data.Array.IO

main = do
  [!t] <- readInts
  replicateM_ t $ do
    [!n] <- readInts
    a <- dropWhile (== 0) . take (n-1) <$> readInts
    let ans = sum a + length (filter (== 0) a)
    print ans

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

modifyArray :: (MArray a e m , Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr i f = readArray arr i >>= writeArray arr i . f


A club plans to hold a party and will invite some of its $$$n$$$ members. The $$$n$$$ members are identified by the numbers $$$1, 2, \dots, n$$$. If member $$$i$$$ is not invited, the party will gain an unhappiness value of $$$a_i$$$.There are $$$m$$$ pairs of friends among the $$$n$$$ members. As per tradition, if both people from a friend pair are invited, they will share a cake at the party. The total number of cakes eaten will be equal to the number of pairs of friends such that both members have been invited.However, the club's oven can only cook two cakes at a time. So, the club demands that the total number of cakes eaten is an even number.What is the minimum possible total unhappiness value of the party, respecting the constraint that the total number of cakes eaten is even?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \leq t \leq 10^4$$$). The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n \leq 10^5$$$, $$$0 \leq m \leq \min(10^5,\frac{n(n-1)}{2})$$$) — the number of club members and pairs of friends. The second line of each test case contains $$$n$$$ integers $$$a_1,a_2, \dots,a_n$$$ ($$$0 \leq a_i \leq 10^4$$$) — the unhappiness value array. Each of the next $$$m$$$ lines contains two integers $$$x$$$ and $$$y$$$ ($$$1 \leq x,y \leq n$$$, $$$x \neq y$$$) indicating that $$$x$$$ and $$$y$$$ are friends. Each unordered pair $$$(x,y)$$$ appears at most once in each test case. It is guaranteed that both the sum of $$$n$$$ and the sum of $$$m$$$ over all test cases do not exceed $$$10^5$$$.

For each test case, print a line containing a single integer – the minimum possible unhappiness value of a valid party.

NoteIn the first test case, all members can be invited. So the unhappiness value is $$$0$$$.In the second test case, the following options are possible:   invite $$$1$$$ and $$$2$$$ ($$$0$$$ cakes eaten, unhappiness value equal to $$$3$$$);  invite $$$2$$$ and $$$3$$$ ($$$0$$$ cakes eaten, unhappiness value equal to $$$2$$$);  invite only $$$1$$$ ($$$0$$$ cakes eaten, unhappiness value equal to $$$4$$$);  invite only $$$2$$$ ($$$0$$$ cakes eaten, unhappiness value equal to $$$5$$$);  invite only $$$3$$$ ($$$0$$$ cakes eaten, unhappiness value equal to $$$3$$$);  invite nobody ($$$0$$$ cakes eaten, unhappiness value equal to $$$6$$$).  The minimum unhappiness value is achieved by inviting $$$2$$$ and $$$3$$$.In the third test case, inviting members $$$3,4,5$$$ generates a valid party with the minimum possible unhappiness value.

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,m] <-              ri
        as     <-              ri
        pairs  <- replicateM m ri
        return (as, m, pairs)
    mapM_ (putStrLn.show.solve) tcs

solve (as, m, pairs) = ans
  where
    i2u = Map.fromList . (`zip` as) $ inds

    ans | (m `mod` 2 == 0)  = 0
        | otherwise         = unh

    i2n = Map.fromList . map fromGroup . groupOn head . L.sort $ pairs ++ map reverse pairs
      where
        fromGroup ps = (head.head $ ps, length . map last $ ps)

    oddInds = map fst . filter (odd.snd) . Map.assocs $ i2n

    (!) = (Map.!)
    evenPs = filter (all$even.(i2n!)) $ pairs

    cands = evenPs ++ map (:[]) oddInds

    unh = minimum . map (sum . map (i2u!)) $ cands

inds = [1..] :: [Int]

groupOn f = L.groupBy g  where  g = (==) `on` f


Polycarp wants to cook a soup. To do it, he needs to buy exactly $$$n$$$ liters of water.There are only two types of water bottles in the nearby shop — $$$1$$$-liter bottles and $$$2$$$-liter bottles. There are infinitely many bottles of these two types in the shop.The bottle of the first type costs $$$a$$$ burles and the bottle of the second type costs $$$b$$$ burles correspondingly.Polycarp wants to spend as few money as possible. Your task is to find the minimum amount of money (in burles) Polycarp needs to buy exactly $$$n$$$ liters of water in the nearby shop if the bottle of the first type costs $$$a$$$ burles and the bottle of the second type costs $$$b$$$ burles. You also have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 500$$$) — the number of queries. The next $$$q$$$ lines contain queries. The $$$i$$$-th query is given as three space-separated integers $$$n_i$$$, $$$a_i$$$ and $$$b_i$$$ ($$$1 \le n_i \le 10^{12}, 1 \le a_i, b_i \le 1000$$$) — how many liters Polycarp needs in the $$$i$$$-th query, the cost (in burles) of the bottle of the first type in the $$$i$$$-th query and the cost (in burles) of the bottle of the second type in the $$$i$$$-th query, respectively.

Print $$$q$$$ integers. The $$$i$$$-th integer should be equal to the minimum amount of money (in burles) Polycarp needs to buy exactly $$$n_i$$$ liters of water in the nearby shop if the bottle of the first type costs $$$a_i$$$ burles and the bottle of the second type costs $$$b_i$$$ burles.

module Main where
import Control.Monad

solve (a:b:c:_)= if b*2 < c then a*b else (a`div`2)*c + (a`mod`2)*b
main = do
    n <- readLn :: IO Int
    r <- replicateM n $ solve . map (read :: String -> Integer ). words <$> getLine
    mapM_ print r

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

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

main = interact solve

solve input =
    let x:xs = map fastRead . words $ input
        grouped = tripleGroup xs
        answers = map doSolve grouped :: [Int64]
    in unlines . map show $ answers

tripleGroup :: [Int64] -> [(Int64, Int64, Int64)]

tripleGroup [a,b,c] = [(a, b, c)]
tripleGroup (a:b:c:xs) = (a, b, c):tripleGroup xs

doSolve :: (Int64, Int64, Int64) -> Int64
doSolve (n, a, b)
    | a*2 < b = n*a
    | otherwise =
        let (d,md) = divMod n 2
        in d * b + md * a

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,a,b] <- map read . words <$> getLine
    if 2*a < b then print (n*a) else print (n `mod` 2 * a + n `div` 2 * b)

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

onecase = do
		[c,a,b]<-map read <$> words <$> getLine ::IO [Integer]
		print $ min (c*a) ((div c 2)*b + (mod c 2) *a)

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

main = interact $ unlines . map show . map (process . map read . words) . tail . lines
process :: [Integer] -> Integer
process [n, a, b] = if b < 2*a then b*(div n 2) + a*(mod n 2) else n * a

process :: Integer -> Integer -> Integer -> Integer
process n a b
    | 2*a > b = a*(n `mod` 2) + b*(n `div` 2)
    | otherwise = a*n

readInt :: String -> Integer
readInt = read

main :: IO ()
main = do
    q <- fmap readInt getLine
    qs <- fmap (map (map readInt.words).lines) getContents
    mapM_ print $ map (\[n,a,b] -> process n a b) qs

import Data.List
import Control.Monad

solve = do
  [n, a, b] <- map read.words <$> getLine
  print $ ((n `div` 2) * b + (n `mod` 2) * a) `min` (n * a)

main=do
 n <- readLn::IO Int
 replicateM_ n solve

module Main where
import Control.Monad

solve (a:b:c:_)= if b*2 < c then a*b else (a`div`2)*c + (a`mod`2)*b
main = do
    n <- readLn :: IO Int
    r <- replicateM n $ solve . map (read :: String -> Int ). words <$> getLine
    mapM_ print r


An array of integers $$$p_1, p_2, \dots, p_n$$$ is called a permutation if it contains each number from $$$1$$$ to $$$n$$$ exactly once. For example, the following arrays are permutations: $$$[3, 1, 2]$$$, $$$[1]$$$, $$$[1, 2, 3, 4, 5]$$$ and $$$[4, 3, 1, 2]$$$. The following arrays are not permutations: $$$[2]$$$, $$$[1, 1]$$$, $$$[2, 3, 4]$$$.Polycarp invented a really cool permutation $$$p_1, p_2, \dots, p_n$$$ of length $$$n$$$. It is very disappointing, but he forgot this permutation. He only remembers the array $$$q_1, q_2, \dots, q_{n-1}$$$ of length $$$n-1$$$, where $$$q_i=p_{i+1}-p_i$$$.Given $$$n$$$ and $$$q=q_1, q_2, \dots, q_{n-1}$$$, help Polycarp restore the invented permutation.

The first line contains the integer $$$n$$$ ($$$2 \le n \le 2\cdot10^5$$$) — the length of the permutation to restore. The second line contains $$$n-1$$$ integers $$$q_1, q_2, \dots, q_{n-1}$$$ ($$$-n < q_i < n$$$).

Print the integer -1 if there is no such permutation of length $$$n$$$ which corresponds to the given array $$$q$$$. Otherwise, if it exists, print $$$p_1, p_2, \dots, p_n$$$. Print any such permutation if there are many of them.

import Data.List(sort, foldl')
import Control.Monad.Writer.Strict

belongInt :: Char -> Bool
belongInt t = or [t == '-', and ['0' <= t, t <= '9']]

replace :: Char -> Char
replace ' ' = ','
replace x = x

getArray:: String -> [Int]
getArray x = (read $ ("["++) $ (++"]") $ map replace x) :: [Int]

calcPreSum :: [Int] -> [Int]
calcPreSum = scanl (+) 0

mainCalc :: [Int] -> [Int]
mainCalc array = tail $ calcPreSum (1-t:array)
    where t = minimum $ calcPreSum (0:array)

checkValid :: Int -> [Int] -> Bool
checkValid n array = (sort array) == [1..n]

getResult :: Int -> [Int] -> String
getResult n array
    | checkValid n array = concat $ map ((++" ").show) array
    | otherwise = "-1"

main = do{
    n <- getLine;
    line <- getLine;
    putStrLn $ getResult ((read n)::Int) $ mainCalc $ getArray line;
}

module Main where
import Data.List
import qualified Data.ByteString.Char8 as C

test b _ [] = b
test b a (x:xs) = if x /= a+1 then False else test b x xs

main = do
    C.getLine
    qs <- map ((read :: String -> Int) . C.unpack) . C.words <$> C.getLine
    let r = scanr (flip (-)) 1 qs
        m = minimum r
        t = map ((if m < 1 then (1-m) else 0)+) r
        p = test True 0 $ sort t -- \\ [1..length t]
    mapM_ (\x -> putStr $ show x ++ " ") $ if p then t else [(-1)]
    putStrLn ""

import Data.Maybe
import Data.List
-- import Debug.Trace

import qualified Data.ByteString.Char8 as B

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

prefixSums :: Num a => [a] -> [a]
prefixSums q = scanl1 (+) q

firstPermElem :: (Num a, Ord a) => [a] -> a
firstPermElem q = 1 - minimum (0:(prefixSums q))

getPermutation :: Num a => [a] -> [a] -> [a]
getPermutation perm [] = perm
getPermutation perm q = getPermutation (perm ++ [last perm + head q]) (tail q)

permutation q = prefixSums ((firstPermElem q):q)

isProperPermutation :: [Int] -> Bool
isProperPermutation perm = (sort perm) == (sort [1..length(perm)])

solve :: [Int] -> [Int]
solve q = if isProperPermutation (permutation q) then permutation q
        else [-1]

listToStr :: Show a => [a] -> String
listToStr l = unwords $ map (show) (l)

main = getLine >> B.getLine >>= putStrLn . listToStr . solve . getInts

import Data.List

main :: IO ()
main = interact $ intercalate " " . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:difs) = if (hasDup . sort $ res) || hasGreater n res then [-1] else res
    where res = map ((+) (1 + abs (minimum cbp))) cbp
          cbp = basePerm difs

hasGreater :: Int -> [Int] -> Bool
hasGreater _ []     = False
hasGreater n (x:xs) = n < x || hasGreater n xs

hasDup :: Eq a => [a] -> Bool
hasDup (x:y:xs) = x == y || hasDup (y:xs)
hasDup _        = False

arithSum :: Int -> Int
arithSum n = (n * (n+1)) `div` 2

basePerm :: [Int] -> [Int]
basePerm (x:[]) = [0 - x] ++ [0]
basePerm (x:xs) = [head restPerm - x] ++ restPerm
    where restPerm = basePerm xs

{-# LANGUAGE Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Control.Monad.ST
import Control.Monad
import Data.Array.ST.Safe
import Data.List
import Data.Int

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

enc :: Int -> Builder
enc = intDec
out :: [Int64] -> Builder
out = mconcat . (intersperse (char7 ' ')) . map int64Dec

solve :: [Int] -> Builder
solve (n:a)
  | check b1 = out b1
  | check bn = out bn
  | check b0 = out b0
  | otherwise = intDec (-1)
  where
    q :: [Int64]
    q = map fromIntegral $ take (n - 1) a
    b1 = scanl (+) 1 q
    bn = scanl (+) (fromIntegral n) q
    b0 = map (succ . subtract u) b1
    u = minimum b1
    check l = u == 1 && v == (fromIntegral n) && check' (map fromIntegral l)
      where
        u = minimum l
        v = maximum l
    check' :: [Int] -> Bool
    check' l = runST $ do
      d <- newArray (1, n) False :: ST s (STUArray s Int Bool)
      x <- forM l $ \i -> do
        if i < 1 || i > n then return True
        else do
          w <- readArray d i
          if w then return True
          else do
            writeArray d i True
            return False
      return $! not (or x)

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

import Data.List

turnListIntoString :: [Int] -> String
turnListIntoString qs = unwords . map show $ qs

trialUni :: [Int] -> Int -> Bool
trialUni qs n = w && t where
  t = all (\x -> x >= 1 && x <=n) qs
  w = all (\x -> x == 1) . map length . group . sort $ qs

foldOnQ :: [Int] -> [Int]
foldOnQ qs = ret where
  t = scanl (\b a ->  b + a) 1 qs
  m = minimum t
  ret = if m < 0 then map (-m + 1 + ) t
        else if m == 0 then map ( + 1) t
        else t

solve :: [[Int]] -> String
solve [[n], qs] = w where
  t = foldOnQ qs
  w = if trialUni t n then turnListIntoString t
      else "-1"

rInt :: String -> Int
rInt = read

main :: IO ()
main = interact $ solve . (map . map) rInt .  map words . lines

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Bits
import Data.Char
import Data.Int
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int64] -> IO ()

---- Answer Code Section ----

process :: [Int64] -> [Int64]
process qs = if valid then ps else [-1] where
    accum = scanl (+) 0 qs
    offset = 1 - (minimum accum)
    ps = map (+ offset) accum
    valid = unique ps && maximum ps == fromIntegral (length ps)

unique l = Set.size set == length l where
    set = foldl (flip Set.insert) Set.empty l

main = do
    n <- getInt
    qs <- map fromIntegral <$> getInts
    printList $ process qs

import qualified Data.Set as Set

restore diff = map ((1 - minVal)+) g
  where g = scanl (+) 0 diff
        minVal = minimum g

solve n diff = if correct then res else [-1]
  where check [] set = n == Set.size set
        check (h : t) set
          | h < 1 || h > n = False
          | otherwise      = check t $ Set.insert h set
        res = restore diff
        correct = check res Set.empty

main = do
  n <- read <$> getLine
  diff <- (map read . words) <$> getLine
  putStrLn . unwords . map show $ solve n diff

module Main where
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

main = do
    C.getLine
    qs <- map ((read :: String -> Int) . C.unpack) . C.words <$> C.getLine
    let r = scanr (flip (-)) 1 qs
        m = minimum r
        t = map ((if m < 1 then (1-m) else 0)+) r
        p = let q = S.fromList t in if length q == length t then True else False
    mapM_ (\x -> putStr $ show x ++ " ") $ if p then t else [(-1)]
    putStrLn ""

module Main where
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

main = do
    C.getLine
    qs <- map ((read :: String -> Int) . C.unpack) . C.words <$> C.getLine
    let r = scanr (flip (-)) 1 qs
        m = minimum r
        t = map ((if m < 1 then (1-m) else 0)+) r
        p = not $ any (>length t) t
    mapM_ (\x -> putStr $ show x ++ " ") $ if p then t else [(-1)]
    putStrLn ""

{-# LANGUAGE Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Control.Monad.ST
import Control.Monad
import Data.Array.ST.Safe
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

enc :: Int -> Builder
enc = intDec
out :: [Int] -> Builder
out = mconcat . (intersperse (char7 ' ')) . map intDec

solve :: [Int] -> Builder
solve (n:a)
  | check b1 = out b1
  | check bn = out bn
  | check b0 = out b0
  | otherwise = intDec (-1)
  where
    q = take (n - 1) a
    b1 = scanl (+) 1 q
    bn = scanl (+) n q
    b0 = map (succ . subtract u) b1
    u = minimum b1
    check l = runST $ do
      d <- newArray (1, n) False :: ST s (STUArray s Int Bool)
      x <- forM l $ \i -> do
        if i < 1 || i > n then return True
        else do
          w <- readArray d i
          if w then do
            writeArray d i True
            return True
          else return False
      return $! not (or x)

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents

import Data.List

turnListIntoString :: [Int] -> String
turnListIntoString qs = unwords . map show $ qs

trialUni :: [Int] -> Int -> Bool
trialUni qs n = w && t where
  t = all (\x -> x >= 1 && x <=n) qs
  w = all (\x -> x == 1) . map length . group $ qs

foldOnQ :: [Int] -> [Int]
foldOnQ qs = ret where
  t = scanl (\b a ->  b + a) 1 qs
  m = minimum t
  ret = if m < 0 then map (-m + 1 + ) t
        else if m == 0 then map ( + 1) t
        else t

solve :: [[Int]] -> String
solve [[n], qs] = w where
  t = foldOnQ qs
  w = if trialUni t n then turnListIntoString t
      else "-1"

rInt :: String -> Int
rInt = read

main :: IO ()
main = interact $ solve . (map . map) rInt .  map words . lines

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

process :: [Int] -> [Int]
process qs = if valid then ps else [-1] where
    accum = scanl (+) 0 qs
    offset = 1 - (minimum accum)
    ps = map (+ offset) accum
    valid = unique ps && maximum ps == length ps

unique l = Set.size set == length l where
    set = foldl (flip Set.insert) Set.empty l

main = do
    n <- getInt
    qs <- getInts
    printList $ process qs

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()
printList = putStrLn . intercalate " " . map show :: [Int] -> IO ()

---- Answer Code Section ----

process :: [Int] -> [Int]
process qs = if valid then ps else [-1] where
    accum = scanl (+) 0 qs
    offset = 1 - (minimum accum)
    ps = map (+ offset) accum
    valid = maximum ps == length ps

main = do
    n <- getInt
    qs <- getInts
    printList $ process qs


There is a house with $$$n$$$ flats situated on the main street of Berlatov. Vova is watching this house every night. The house can be represented as an array of $$$n$$$ integer numbers $$$a_1, a_2, \dots, a_n$$$, where $$$a_i = 1$$$ if in the $$$i$$$-th flat the light is on and $$$a_i = 0$$$ otherwise.Vova thinks that people in the $$$i$$$-th flats are disturbed and cannot sleep if and only if $$$1 < i < n$$$ and $$$a_{i - 1} = a_{i + 1} = 1$$$ and $$$a_i = 0$$$.Vova is concerned by the following question: what is the minimum number $$$k$$$ such that if people from exactly $$$k$$$ pairwise distinct flats will turn off the lights then nobody will be disturbed? Your task is to find this number $$$k$$$.

The first line of the input contains one integer $$$n$$$ ($$$3 \le n \le 100$$$) — the number of flats in the house. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$a_i \in \{0, 1\}$$$), where $$$a_i$$$ is the state of light in the $$$i$$$-th flat.

Print only one integer — the minimum number $$$k$$$ such that if people from exactly $$$k$$$ pairwise distinct flats will turn off the light then nobody will be disturbed.

NoteIn the first example people from flats $$$2$$$ and $$$7$$$ or $$$4$$$ and $$$7$$$ can turn off the light and nobody will be disturbed. It can be shown that there is no better answer in this example.There are no disturbed people in second and third examples.

solve :: [Int] -> Int
solve [] = 0
solve (a:[]) = 0
solve (a:b:[]) = 0
solve (1:0:1:tail) = 1+ solve(0:0:tail)
solve (a:b) = solve b

main :: IO()
main = do
  n <- getLine
  s <- getLine
  (putStrLn . show . solve . (map (read::String->Int)) . words) s

readInt :: String -> Int
readInt = read

parseInt :: String -> [Int]
parseInt file
    = [ readInt word | word <- words $ last $ lines file ]

solve :: [Int] -> Int
solve [] = 0
solve [_] = 0
solve [_, _] = 0
solve (1 : 0 : 1 : xs) = 1 + solve (0 : xs)
solve (x : xs) = solve xs

main = do interact $ (\t -> show t ++ "\n") . solve . parseInt

import Data.Maybe
import Data.List

readInt :: String -> Int
readInt = read

parseInput :: String -> [Int]
parseInput file
    = [ readInt word | word <- words $ last $ lines file ]

processInput :: [Int] -> Int
processInput = adjust . disturbed 0

showOutput :: Int -> String
showOutput x = show x ++ "\n"

main = interact $ showOutput . processInput . parseInput

disturbed :: Int -> [Int] -> [Int]
disturbed _ [] = []
disturbed _ [_] = []
disturbed _ [_, _] = []
disturbed m (x:y:z:zs)
     = if x == 1 && y == 0 && z == 1
       then (m + 1) : disturbed (m + 2) (z:zs)
       else disturbed (m + 1) (y:z:zs)

adjust :: [Int] -> Int
adjust [] = 0
adjust [_] = 1
adjust (i:j:js)
    = if j == i + 2
      then 1 + adjust js
      else 1 + adjust (j : js)

f::[Int]->Int
f (_:_:[])=0
f (1:0:1:xs)=1+f (0:0:xs)
f (x:xs)=f xs

main = do
       e<-getLine
       e2<-getLine
       let xs=map read (words e2)::[Int]
       print $ f xs

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

solve :: [Int] -> Int
solve [_, _] = 0
solve (a:b:c:d)
    | a == 1 && b == 0 && c == 1 = 1 + solve (0:0:d)
    | otherwise                  = solve (b:c:d)

main :: IO ()
main = do
    _ <- readInt
    xs <- readInts
    print $ solve xs

main = interact $ show . solve . map read . tail . words
solve (1:0:1:fs) = 1 + solve fs
solve (_:fs) = solve fs
solve [] = 0

import Data.Maybe
import Data.List

readInt :: String -> Int
readInt = read

parseInput :: String -> [Int]
parseInput file
    = [ readInt word | word <- words $ last $ lines file ]

processInput :: [Int] -> Int
processInput xs = (adjust . disturbed . zeros) xs
    where zeros = findIndices ( == 0)
          disturbed :: [Int] -> [Int]
          disturbed [] = []
          disturbed [x] = if x == (length xs) - 1  || x == 0 then [] else [x]
          disturbed (x:y:ys)
            = if y == x + 1
              then disturbed ys
              else if x == 0 then disturbed (y:ys) else x : disturbed (y:ys)

showOutput :: Int -> String
showOutput x = show x ++ "\n"

adjust :: [Int] -> Int
adjust [] = 0
adjust [_] = 1
adjust (i:j:js)
    = if j == i + 2
      then 1 + adjust js
      else 1 + adjust (j : js)

main = interact $ showOutput . processInput . parseInput

import Data.Maybe
import Data.List

readInt :: String -> Int
readInt = read

parseInput :: String -> [Int]
parseInput file
    = [ readInt word | word <- words $ last $ lines file ]

processInput :: [Int] -> Int
processInput xs = (adjust . disturbed . zeros) xs
    where zeros = findIndices ( == 0)
          disturbed :: [Int] -> [Int]
          disturbed [] = []
          disturbed [x] = if x == (length xs) - 1 then [] else [x]
          disturbed (x:y:ys)
            = if y == x + 1
              then disturbed ys
              else if x == 0 then disturbed (y:ys) else x : disturbed (y:ys)

showOutput :: Int -> String
showOutput x = show x ++ "\n"

adjust :: [Int] -> Int
adjust [] = 0
adjust [_] = 1
adjust (i:j:js)
    = if j == i + 2
      then 1 + adjust js
      else 1 + adjust (j : js)

main = interact $ showOutput . processInput . parseInput


Vasya has two arrays $$$A$$$ and $$$B$$$ of lengths $$$n$$$ and $$$m$$$, respectively.He can perform the following operation arbitrary number of times (possibly zero): he takes some consecutive subsegment of the array and replaces it with a single element, equal to the sum of all elements on this subsegment. For example, from the array $$$[1, 10, 100, 1000, 10000]$$$ Vasya can obtain array $$$[1, 1110, 10000]$$$, and from array $$$[1, 2, 3]$$$ Vasya can obtain array $$$[6]$$$.Two arrays $$$A$$$ and $$$B$$$ are considered equal if and only if they have the same length and for each valid $$$i$$$ $$$A_i = B_i$$$.Vasya wants to perform some of these operations on array $$$A$$$, some on array $$$B$$$, in such a way that arrays $$$A$$$ and $$$B$$$ become equal. Moreover, the lengths of the resulting arrays should be maximal possible.Help Vasya to determine the maximum length of the arrays that he can achieve or output that it is impossible to make arrays $$$A$$$ and $$$B$$$ equal.

The first line contains a single integer $$$n~(1 \le n \le 3 \cdot 10^5)$$$ — the length of the first array. The second line contains $$$n$$$ integers $$$a_1, a_2, \cdots, a_n~(1 \le a_i \le 10^9)$$$ — elements of the array $$$A$$$. The third line contains a single integer $$$m~(1 \le m \le 3 \cdot 10^5)$$$ — the length of the second array. The fourth line contains $$$m$$$ integers $$$b_1, b_2, \cdots, b_m~(1 \le b_i \le 10^9)$$$ - elements of the array $$$B$$$.

Print a single integer — the maximum length of the resulting arrays after some operations were performed on arrays $$$A$$$ and $$$B$$$ in such a way that they became equal. If there is no way to make array equal, print "-1".

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

rInt = fst . fromJust . C.readInteger
rList = fmap (map rInt . C.words)

solve (x:xs) (y:ys) =
  if x + y == 0 then 0
  else if x == y then 1 + solve xs ys
  else if x > y then solve (y:ys) (x:xs)
  else if (head xs) == 0 then inf
  else solve ((x+(head xs)):(tail xs)) (y:ys)

inf=10000000000000

func x = if x >= inf then -1 else x

main = do
        C.getLine
        as <- rList C.getLine
        C.getLine
        bs <- rList C.getLine
        print $ func (solve (as++[0,0..]) (bs++[0,0..]))

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

rInt = fst . fromJust . C.readInteger
rList = fmap (map rInt . C.words)

solve as bs sa sb c | ae && be = if sa /= sb then -1 else c+1
                    | ae || be = solve [] [] (sa+(sum as)) (sb+(sum bs)) c
                    | sa == sb = solve ta tb (sa+a) (sb+b) (c+1)
                    | sa < sb = solve ta bs (sa+a) sb c
                    | sa > sb = solve as tb sa (sb+b) c
                where ae = as == []; be = bs == []
                      a  = head as ; b =  head bs
                      ta = tail as ; tb = tail bs

main = do
        C.getLine
        as <- rList C.getLine
        C.getLine
        bs <- rList C.getLine
        print $ solve (tail as) (tail bs) (head as) (head bs) 0

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

rInt = fst . fromJust . C.readInteger
rList = fmap (map rInt . C.words)

solve as bs sa sb c | ae || be = if (sa+(sum as)) /= (sb+(sum bs)) then -1 else c+1
                    | sa == sb = solve ta tb (sa+a) (sb+b) (c+1)
                    | sa < sb = solve ta bs (sa+a) sb c
                    | sa > sb = solve as tb sa (sb+b) c
                where ae = as == []; be = bs == []
                      a  = head as ; b =  head bs
                      ta = tail as ; tb = tail bs

main = do
        C.getLine
        as <- rList C.getLine
        C.getLine
        bs <- rList C.getLine
        print $ solve (tail as) (tail bs) (head as) (head bs) 0

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

rInt = fst . fromJust . C.readInt
rList = fmap (map rInt . C.words)

solve as bs sa sb c | ae && be = if sa /= sb then -1 else c+1
                    | ae || be = solve [] [] (sa+(sum as)) (sb+(sum bs)) c
                    | sa == sb = solve ta tb (sa+a) (sb+b) (c+1)
                    | sa < sb = solve ta bs (sa+a) sb c
                    | sa > sb = solve as tb sa (sb+b) c
                where ae = as == []; be = bs == []
                      a  = head as ; b =  head bs
                      ta = tail as ; tb = tail bs

main = do
        C.getLine
        as <- rList C.getLine
        C.getLine
        bs <- rList C.getLine
        print $ solve (tail as) (tail bs) (head as) (head bs) 0

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

rInt = fst . fromJust . C.readInt
rList = fmap (map rInt . C.words)

solve (a:as) (b:bs) sa sb c | as == [] || bs == [] =
                                solve [] [] (sa+a+(sum as)) (sb+b+(sum bs)) c
                            | sa == sb = solve as bs (sa+a) (sb+b) (c+1)
                            | sa < sb = solve as (b:bs) (sa+a) sb c
                            | sa > sb = solve (a:as) bs sa (sb+b) c

solve [] [] sa sb c = if sa /= sb then -1 else c+1

main = do
        C.getLine
        as <- rList C.getLine
        C.getLine
        bs <- rList C.getLine
        print $ solve as bs (head as) (head bs) 0


One day Vasya painted a Cartesian coordinate system on a piece of paper and marked some set of points (x1, y1), (x2, y2), ..., (xn, yn). Let's define neighbors for some fixed point from the given set (x, y):   point (x', y') is (x, y)'s right neighbor, if x' > x and y' = y  point (x', y') is (x, y)'s left neighbor, if x' < x and y' = y  point (x', y') is (x, y)'s lower neighbor, if x' = x and y' < y  point (x', y') is (x, y)'s upper neighbor, if x' = x and y' > y We'll consider point (x, y) from the given set supercentral, if it has at least one upper, at least one lower, at least one left and at least one right neighbor among this set's points.Vasya marked quite many points on the paper. Analyzing the picture manually is rather a challenge, so Vasya asked you to help him. Your task is to find the number of supercentral points in the given set.

The first input line contains the only integer n (1 ≤ n ≤ 200) — the number of points in the given set. Next n lines contain the coordinates of the points written as "x y" (without the quotes) (|x|, |y| ≤ 1000), all coordinates are integers. The numbers in the line are separated by exactly one space. It is guaranteed that all points are different.

Print the only number — the number of supercentral points of the given set.

NoteIn the first sample the supercentral points are only points (1, 1) and (1, 2).In the second sample there is one supercental point — point (0, 0).

import System.IO
import Data.Array

parse h = do
   n <- fmap read (hGetLine h)
   ps <- mapM f [1..n]
   return (n, ps)
   where
      f _ = fmap (g . map read . words) (hGetLine h)
      g [x,y] = (x,y)

solve (n, ps) = length $ filter f ps
   where
      f (x,y) =  left ! y /= x
              && right ! y /= x
              && bottom ! x /= y
              && top ! x /= y
      left    = accumArray min inf b ps'
      right   = accumArray max (-inf) b ps'
      bottom  = accumArray min inf b ps
      top     = accumArray max (-inf) b ps
      ps'     = map (\(x, y) -> (y, x)) ps
      b       = (-1000, 1000)
      inf     = 10^4

main = print . solve =<< parse stdin

-- vim: set expandtab:

import Control.Monad
import Data.List
main = do
  n <- (liftM read) getLine
  p <- replicateM n $ (liftM $ (\[x,y] -> (read x, read y) :: (Int, Int)) . words) getLine
  let left = filter (\(x,y) -> any (\(x',y') -> x' < x && y == y') p) p
      right = filter (\(x,y) -> any (\(x',y') -> x' > x && y == y') p) p
      up = filter (\(x,y) -> any (\(x',y') -> y' > y && x == x') p) p
      down = filter (\(x,y) -> any (\(x',y') -> y' < y && x == x') p) p
      super = filter (\u -> all (\l -> elem u l) [left, right, up, down]) p
  putStrLn . show $ length super

import Control.Applicative

below (x, y) (x', y') = x < x' && y == y'
rotate (x, y) = (-y, x)

solve ps =
		length $ filter supercentral ps
	where
		supercentral p = and [any (below p') ps' | (p', ps') <- take 4 $ zip (iterate rotate p) (iterate (map rotate) ps)]

main = do
	_ <- getLine
	ps <- map ((\[a,b] -> (a,b)) . map read . words) . lines <$> getContents
	print $ solve ps

import Array

type Point = (Int, Int)

n :: Int
n = 1000

maxInt, minInt :: Int
maxInt  =  maxBound
minInt  =  minBound

solve :: [Point] -> Int
solve ps  =  length $ filter f ps
  where
    f :: Point -> Bool
    f (x, y)
      | x >= lefts  ! y  =  False
      | x <= rights ! y  =  False
      | y >= uppers ! x  =  False
      | y <= downs  ! x  =  False
      | otherwise  =  True
    uppers  =  accumArray max minInt (-n, n) [(x, y) | (x, y) <- ps]
    downs   =  accumArray min maxInt (-n, n) [(x, y) | (x, y) <- ps]
    lefts   =  accumArray max minInt (-n, n) [(x, y) | (y, x) <- ps]
    rights  =  accumArray min maxInt (-n, n) [(x, y) | (y, x) <- ps]

parsePoint :: String -> Point
parsePoint s  =  (x, y)
  where
    [x, y]  =  map read (words s)

main :: IO ()
main  =  do
    n <- readLn
    lines <- mapM (const getLine) [1..n]
    let points = map parsePoint lines
    print $ solve points

import Data.Bits

t :: [Int] -> [Int] -> Int
t [a, c] [b, d]
  | a == b && c < d = 1
  | a == b && c > d = 2
  | a < b && c == d = 4
  | a > b && c == d = 8
  | True            = 0

s q = length $ filter (\p -> foldl (.|.) 0 (map (t p) q) == 15) q
main = interact $ show . s . map (map read . words) . tail . lines

import Data.Bits

t :: [Int] -> [Int] -> Int
t [x1, y1] [x2, y2]
  | x1 == x2 && y1 < y2 = 1
  | x1 == x2 && y1 > y2 = 2
  | x1 < x2 && y1 == y2 = 4
  | x1 > x2 && y1 == y2 = 8
  | True                = 0

s q = length $ filter (\p -> foldl (.|.) 0 (map (t p) q) == 15) q
main = interact $ show . s . map (map read . words) . tail . lines

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

parseInput = do
    n <- readInt
    replicateM n ((,) <$> readInt <*> readInt)
  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 = print =<< solve . evalState parseInput <$> BS.getContents

check1 (x1, y1) (x2, y2) = x1 == x2 && y1 > y2
check2 (x1, y1) (x2, y2) = x1 == x2 && y1 < y2
check3 (x1, y1) (x2, y2) = y1 == y2 && x1 > x2
check4 (x1, y1) (x2, y2) = y1 == y2 && x1 < x2

solve pts = length [ a
                   | a <- pts
                   , and [ any (check a) pts
                         | check <- [check1, check2, check3, check4]
                         ]
                   ]

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

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

main :: IO ()
main = getContents >>= print . solve . map (toTuple . map read . words) . tail . lines

solve :: [(Int, Int)] -> Int
solve xys = length [ (x, y) | (x, y) <- xys, all (flip any xys . ($ (x, y))) [ left, right, lower, upper ] ]
  where left (x, y) (x', y') = x' > x && y' == y
        right (x, y) (x', y') = x' < x && y' == y
        lower (x, y) (x', y') = x' == x && y' < y
        upper (x, y) (x', y') = x' == x && y' > y

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

main = print . solve . pairs . map read . tail . words =<< getContents
pairs (x:y:zs) = (x,y) : pairs zs
pairs _ = []
solve :: [(Int,Int)] -> Int
solve ps = length (filter (superCentral ps) ps)
superCentral ps p = hasNeighbor right ps p &&
                    hasNeighbor left ps p &&
                    hasNeighbor lower ps p &&
                    hasNeighbor upper ps p
hasNeighbor dir ps p = not $ null $ filter (dir p) ps
right (x,y) (x',y') = x' > x && y' == y
left (x,y) (x',y') = x' < x && y' == y
upper (x,y) (x',y') = x' == x && y' < y
lower (x,y) (x',y') = x' == x && y' > y

main = interact $ show.solve.map ((\[x,y]->(x,y)).map read.words).tail.lines

solve :: [(Int,Int)] -> Int
solve xys = length $ filter (flip p xys) xys

p (x,y) xys = (or $ map h xys)&&(or $ map j xys)&&(or $ map k xys)&&(or $ map l xys)
   where h (z,w)= z<x && y==w
         j (z,w)= z==x && y<w
         k (z,w)= z==x && y>w
         l (z,w)= z>x && y==w

h (x,y) (z,w) = z<x && y==w
j (x,y) (z,w) = z==x && y<w
k (x,y) (z,w) = z==x && y>w
l (x,y) (z,w) = z>x && y==w

import Control.Applicative

below (x, y) (x', y') = x < x' && y == y'
rotate (x, y) = (-y, x)

solve ps =
		length [p | p <- ps, supercentral p]
	where
		supercentral p = and [any (below p') ps' | (p', ps') <- take 4 $ zip (iterate rotate p) (iterate (map rotate) ps)]

main = do
	n <- readLn :: IO Int
	ps <- map ((\[a,b] -> (a,b)) . map (read :: String -> Int) . words) . lines <$> getContents
	print $ solve ps

readPoint = do
    line <- getLine
    let ints = map (read::String->Int) (words line)
    return (ints !! 0, ints !! 1)

top (x1,y1) (x2,y2) = x1 == x2 && y1 < y2
left (x1,y1) (x2,y2) = x1 < x2 && y1 == y2
right (x1,y1) (x2,y2) = x1 > x2 && y1 == y2
bottom (x1,y1) (x2,y2) = x1 == x2 && y1 > y2

supercentral xs p = any (top p) xs && any (bottom p) xs && any (right p) xs && any (left p) xs

count xs = foldl (\acc b -> if b then acc + 1 else acc) 0 xs

main = do
    n <- readLn :: IO Int
    pts <- mapM (\_ -> readPoint) [1..n]
    let supers = count (map (supercentral pts) pts)
    print supers

import Control.Monad
import Data.Char

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    input <- replicateM n getLine
    let coords = [getAsInt item | item <- input]
    print $ length $ filter (isCentral coords) coords

isCentral :: [(Int, Int)] -> (Int, Int) -> Bool
isCentral coords (x, y)
    | getNeightbour (x, y) coords "top" && getNeightbour (x, y) coords "left" && getNeightbour (x, y) coords "right" && getNeightbour (x, y) coords "bottom" = True
    | otherwise = False

getNeightbour :: (Int, Int) -> [(Int, Int)] -> String -> Bool
getNeightbour item [(x, y)] part = isTrue item (x, y) part
getNeightbour item ((x, y):xs) part
    | isTrue item (x, y) part = True
    | otherwise = getNeightbour item xs part

getAsInt :: String -> (Int, Int)
getAsInt w = (head r, last r)
    where
        r =  map read $ words w

isTrue :: (Int, Int) -> (Int, Int) -> String -> Bool
isTrue (x', y') (x, y) part
    | part == "left" = x' > x && y' == y
    | part == "right" = x' < x && y' == y
    | part == "top" = x' == x && y' > y
    | part == "bottom" = x' == x && y' < y

import Control.Monad
import Data.List
main = getLine >>= return . read
               >>= flip replicateM getLine
               >>= return . map (map read . words)
               >>= putStrLn . show . solve

solve ar = length . filter (==5) $ map (flip sl ar) ar

sl a = length . filter (elem 0) . nub . map mw
  where mw = map signum . zipWith (-) a

import Data.Function
import Data.List
import Control.Monad

t1 (a, _, _) = a
t2 (_, a, _) = a
t3 (_, _, a) = a

-- subsolve :: [[(Int, Int, Int)]] -> [[(Int, Int, Int)]]
subsolve points f = map subsub points
    where
      subsub l = (let
                     sorted = sortBy (compare `on` f) l
                in
                  (head sorted) : (subsub' $ tail sorted))
      subsub' [] = []
      subsub' [foo] = [foo]
      subsub' ((x, y, cnt):l) = (x, y, cnt + 2) : (subsub' l)

-- solve :: [(Int, Int, Int)] -> Int
solve points =
    let p1 = concat $ subsolve (groupBy ((==) `on` t1) (sortBy (compare `on` t1) points)) t2
        p2 = concat $ subsolve (groupBy ((==) `on` t2) (sortBy (compare `on` t2) p1)) t1
    in
      length (filter (\x -> (t3 x) == 4) p2)

tuplify [x, y] = (x, y, 0)

main = do
  n <- getLine >>= return . (read::String->Int)
  points <-  forM [1..n] (\_ -> getLine >>= (return . tuplify . map (read::String->Int) . words))
  -- print points
  print $ solve points

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Data.List
import Debug.Trace
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi s | B.head s == '-' = - (atoi' $ B.tail s)
       | otherwise = atoi' s

atoi' :: B.ByteString -> Int
atoi' = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

type P = (Int, Int)

rot :: P -> P
rot (x, y) = (y, -x)

solve :: [P] -> Int
solve ps = length $ filter (supercentral ps) ps

supercentral :: [P] -> P -> Bool
supercentral ps = all (uncurry anybelow) . flip zip rss . iterate rot
  where rss = take 4 $  iterate (map rot) ps

anybelow :: P -> [P] -> Bool
anybelow p = any (isbelow p)

isbelow :: P -> P -> Bool
isbelow (x, y) (x', y') = (x == x') && (y < y')

main = do
    n <- head . map atoi . B.words <$> B.getLine
    ps <- replicateM n $ do
        [x, y] <- map atoi . B.words <$> B.getLine
        return (x, y)
    printf "%d\n" $ solve ps

module Main where

import Data.Maybe
import Data.Array
import Data.List
import Data.Char

import Data.Time.Calendar

main = interact (show . solve . map (\[a, b] -> (a, b)) . map (map read . words) . tail . lines)

solve :: [(Int, Int)] -> Int
solve points = length central where
    central = filter (\p -> haveRight p &&
                            haveLeft p &&
                            haveTop p &&
                            haveBottom p) points

    haveRight (x, y)   = any (\(x', y') -> y == y' && x < x') points
    haveLeft (x, y)    = any (\(x', y') -> y == y' && x' < x) points
    haveTop (x, y)     = any (\(x', y') -> y < y'  && x' == x) points
    haveBottom (x, y)  = any (\(x', y') -> y' < y  && x' == x) points

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

parseInput = do
    n <- readInt
    replicateM n ((,) <$> readInt <*> readInt)
  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 = print =<< solve . evalState parseInput <$> BS.getContents

check1 (x1, y1) (x2, y2) = x1 == x2 && y1 > y2
check2 (x1, y1) (x2, y2) = x1 == x2 && y1 < y2
check3 (x1, y1) (x2, y2) = y1 == y2 && x1 > x2
check4 (x1, y1) (x2, y2) = y1 == y2 && x1 > x2

solve pts = length [ a
                   | a <- pts
                   , and [ any (check a) pts
                         | check <- [check1, check2, check3, check4]
                         ]
                   ]

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

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

main = interact $ show.solve.map ((\[x,y]->(x,y)).map read.words).tail.lines

solve :: [(Int,Int)] -> Int
solve xys = let minx = minimum.map fst $ xys
                miny = minimum.map snd $ xys
                maxx = maximum.map fst $ xys
                maxy = maximum.map snd $ xys
                p (x,y) = x==minx || y==miny || x==maxx || y==maxy
                zs = filter p xys
                q (x,y) = (x,y)`notElem`zs && any (`elem`zs) [(x,y+1),(x,y-1),(x+1,y),(x-1,y)]
            in length $ filter q xys

import Data.Function
import Data.List
import Control.Monad

t1 (a, _, _) = a
t2 (_, a, _) = a
t3 (_, _, a) = a

-- subsolve :: [[(Int, Int, Int)]] -> [[(Int, Int, Int)]]
subsolve points f = map subsub points
    where
      subsub l = (head l) : (subsub' . tail $ sortBy (compare `on` f) l)
      subsub' [] = []
      subsub' [foo] = [foo]
      subsub' ((x, y, cnt):l) = (x, y, cnt + 2) : (subsub' l)

-- solve :: [(Int, Int, Int)] -> Int
solve points =
    let p1 = concat $ subsolve (groupBy ((==) `on` t1) (sortBy (compare `on` t1) points)) t2
        p2 = concat $ subsolve (groupBy ((==) `on` t2) (sortBy (compare `on` t2) p1)) t1
    in
      length (filter (\x -> (t3 x) == 4) p2)

tuplify [x, y] = (x, y, 0)

main = do
  n <- getLine >>= return . (read::String->Int)
  points <-  forM [1..n] (\_ -> getLine >>= (return . tuplify . map (read::String->Int) . words))
  -- print points
  print $ solve points

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Data.List
import Debug.Trace
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

type P = (Int, Int)

rot :: P -> P
rot (x, y) = (y, -x)

solve :: [P] -> Int
solve ps = length $ filter (supercentral ps) ps

supercentral :: [P] -> P -> Bool
supercentral ps = all (uncurry anybelow) . flip zip rss . iterate rot
  where rss = take 4 $  iterate (map rot) ps

anybelow :: P -> [P] -> Bool
anybelow p = any (isbelow p)

isbelow :: P -> P -> Bool
isbelow (x, y) (x', y') = (x == x') && (y < y')

main = do
    n <- head . map atoi . B.words <$> B.getLine
    ps <- replicateM n $ do
        [x, y] <- map atoi . B.words <$> B.getLine
        return (x, y)
    printf "%d\n" $ solve ps

{-# OPTIONS_GHC -O3 -fno-spec-constr-count #-}
import Control.Monad
import Control.Applicative
import Text.Printf
import Data.List
import Debug.Trace
import qualified Data.ByteString.Char8 as B
import qualified Data.Char as C

atoi :: B.ByteString -> Int
atoi = B.foldl' (\a c -> a*10 + C.ord c - C.ord '0') 0

type P = (Int, Int)

rot :: P -> P
rot (x, y) = (y, -x)

solve :: [P] -> Int
solve ps = length $ filter (supercentral ps) ps

supercentral :: [P] -> P -> Bool
supercentral ps = all (uncurry anybelow) . flip zip rss . iterate rot
  where rss = take 4 $  iterate (map rot) ps

anybelow :: P -> [P] -> Bool
anybelow p = any (isbelow p)

isbelow :: P -> P -> Bool
isbelow (x, y) (x', y') = (x == x') && (y < y')

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

main = do
    (_:xs) <- map atoi . B.words <$> B.getContents
    printf "%d\n" . solve $ topairs xs


So the Beautiful Regional Contest (BeRC) has come to an end! $$$n$$$ students took part in the contest. The final standings are already known: the participant in the $$$i$$$-th place solved $$$p_i$$$ problems. Since the participants are primarily sorted by the number of solved problems, then $$$p_1 \ge p_2 \ge \dots \ge p_n$$$.Help the jury distribute the gold, silver and bronze medals. Let their numbers be $$$g$$$, $$$s$$$ and $$$b$$$, respectively. Here is a list of requirements from the rules, which all must be satisfied:  for each of the three types of medals, at least one medal must be awarded (that is, $$$g>0$$$, $$$s>0$$$ and $$$b>0$$$);  the number of gold medals must be strictly less than the number of silver and the number of bronze (that is, $$$g<s$$$ and $$$g<b$$$, but there are no requirements between $$$s$$$ and $$$b$$$);  each gold medalist must solve strictly more problems than any awarded with a silver medal;  each silver medalist must solve strictly more problems than any awarded a bronze medal;  each bronze medalist must solve strictly more problems than any participant not awarded a medal;  the total number of medalists $$$g+s+b$$$ should not exceed half of all participants (for example, if $$$n=21$$$, then you can award a maximum of $$$10$$$ participants, and if $$$n=26$$$, then you can award a maximum of $$$13$$$ participants). The jury wants to reward with medals the total maximal number participants (i.e. to maximize $$$g+s+b$$$) so that all of the items listed above are fulfilled. Help the jury find such a way to award medals.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10000$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. The first line of a test case contains an integer $$$n$$$ ($$$1 \le n \le 4\cdot10^5$$$) — the number of BeRC participants. The second line of a test case contains integers $$$p_1, p_2, \dots, p_n$$$ ($$$0 \le p_i \le 10^6$$$), where $$$p_i$$$ is equal to the number of problems solved by the $$$i$$$-th participant from the final standings. The values $$$p_i$$$ are sorted in non-increasing order, i.e. $$$p_1 \ge p_2 \ge \dots \ge p_n$$$. The sum of $$$n$$$ over all test cases in the input does not exceed $$$4\cdot10^5$$$.

Print $$$t$$$ lines, the $$$j$$$-th line should contain the answer to the $$$j$$$-th test case. The answer consists of three non-negative integers $$$g, s, b$$$.   Print $$$g=s=b=0$$$ if there is no way to reward participants with medals so that all requirements from the statement are satisfied at the same time.  Otherwise, print three positive numbers $$$g, s, b$$$ — the possible number of gold, silver and bronze medals, respectively. The sum of $$$g+s+b$$$ should be the maximum possible. If there are several answers, print any of them.

NoteIn the first test case, it is possible to reward $$$1$$$ gold, $$$2$$$ silver and $$$3$$$ bronze medals. In this case, the participant solved $$$5$$$ tasks will be rewarded with the gold medal, participants solved $$$4$$$ tasks will be rewarded with silver medals, participants solved $$$2$$$ or $$$3$$$ tasks will be rewarded with bronze medals. Participants solved exactly $$$1$$$ task won't be rewarded. It's easy to see, that in this case, all conditions are satisfied and it is possible to reward participants in this way. It is impossible to give more than $$$6$$$ medals because the number of medals should not exceed half of the number of participants. The answer $$$1$$$, $$$3$$$, $$$2$$$ is also correct in this test case.In the second and third test cases, it is impossible to reward medals, because at least one medal of each type should be given, but the number of medals should not exceed half of the number of participants.

import Data.List

main = getLine >>= test.read
test 0 = return ()
test i = do
    n <- read <$> getLine
    ps <- words <$> getLine
    let vs = scanl1 (+) $ map length $ group ps
        g = safeHead vs
        s = do
            g <- g
            safeHead $ dropWhile (<= g) $ subtract g <$> vs
        b = do
            g <- g
            s <- s
            safeHead $ reverse $ dropWhile (<= g) $ map (subtract $ g + s) $ takeWhile (<= div n 2) vs
    case [g, s, b] of
        [Just g, Just s, Just b] -> putStrLn $ unwords $ map show [g, s, b]
        _ -> putStrLn "0 0 0"
    test $ pred i

safeHead [] = Nothing
safeHead (h:_) = Just h

import Data.List

main = getLine >>= test.read
test 0 = return ()
test i = do
    n <- read <$> getLine
    ps <- words <$> getLine
    let vs = scanl1 (+) $ map length $ group ps
        g = safeHead vs
        s = do
            g <- g
            safeHead $ dropWhile (< g) $ subtract g <$> vs
        b = do
            g <- g
            s <- s
            safeHead $ reverse $ dropWhile (< g) $ map (subtract $ g + s) $ takeWhile (<= div n 2) vs
    case [g, s, b] of
        [Just g, Just s, Just b] -> putStrLn $ unwords $ map show [g, s, b]
        _ -> putStrLn "0 0 0"
    test $ pred i

safeHead [] = Nothing
safeHead (h:_) = Just h


You are given an integer $$$n$$$. In $$$1$$$ move, you can do one of the following actions:  erase any digit of the number (it's acceptable that the number before the operation has exactly one digit and after the operation, it is "empty");  add one digit to the right. The actions may be performed in any order any number of times.Note that if, after deleting some digit from a number, it will contain leading zeroes, they will not be deleted. E.g. if you delete from the number $$$301$$$ the digit $$$3$$$, the result is the number $$$01$$$ (not $$$1$$$).You need to perform the minimum number of actions to make the number any power of $$$2$$$ (i.e. there's an integer $$$k$$$ ($$$k \ge 0$$$) such that the resulting number is equal to $$$2^k$$$). The resulting number must not have leading zeroes.E.g. consider $$$n=1052$$$. The answer is equal to $$$2$$$. First, let's add to the right one digit $$$4$$$ (the result will be $$$10524$$$). Then let's erase the digit $$$5$$$, so the result will be $$$1024$$$ which is a power of $$$2$$$.E.g. consider $$$n=8888$$$. The answer is equal to $$$3$$$. Let's erase any of the digits $$$8$$$ three times. The result will be $$$8$$$ which is a power of $$$2$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing one integer $$$n$$$ ($$$1 \le n \le 10^9$$$).

For each test case, output in a separate line one integer $$$m$$$ — the minimum number of moves to transform the number into any power of $$$2$$$.

NoteThe answer for the first test case was considered above.The answer for the second test case was considered above.In the third test case, it's enough to add to the right the digit $$$4$$$ — the number $$$6$$$ will turn into $$$64$$$.In the fourth test case, let's add to the right the digit $$$8$$$ and then erase $$$7$$$ and $$$5$$$ — the taken number will turn into $$$8$$$.The numbers of the fifth and the sixth test cases are already powers of two so there's no need to make any move.In the seventh test case, you can delete first of all the digit $$$3$$$ (the result is $$$01$$$) and then the digit $$$0$$$ (the result is $$$1$$$).

import Data.Int (Int64)

main = do
    t <- read <$> getLine :: IO Int
    mapM_ (solve (map split [2 ^ (i :: Int64) | i <- [0..60]])) [1..t]

solve :: [[Int]] -> Int -> IO ()
solve powerOf2 _ = do
    n <- read <$> getLine :: IO Int
    print $ foldr1 min (map (dist $ split n) powerOf2)

splitHelper :: Integral a => a -> [Int]
splitHelper n
    | n == 0     = []
    | otherwise  = let (x, y) = n `quotRem` 10 in fromIntegral y : splitHelper x

split :: Integral a => a -> [Int]
split = reverse . splitHelper

dist :: [Int] -> [Int] -> Int
dist  (x:xs) ay@(y:ys)  = if x == y then dist xs ys else 1 + dist xs ay
dist  xs     []         = length xs
dist  []     ys         = length ys

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = tail (lines input)
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        n = read input
        result = findDistanceToPowerOfTwo n
        output = show result

findDistanceToPowerOfTwo :: Integer -> Int
findDistanceToPowerOfTwo starting_number = min_distance
    where
        starting_string = show starting_number
        powers_of_two = map (2^) [0..]
        potential_targets = map show powers_of_two
        max_distance = findTransformationCost starting_string (head potential_targets)
        max_length_allowed = length starting_string + max_distance
        interesting_targets = takeWhile
            ((<= max_length_allowed) . length)
            potential_targets
        distances_variants = map (findTransformationCost starting_string) interesting_targets
        min_distance = minimum distances_variants

findTransformationCost :: String -> String -> Int
findTransformationCost start target
    | null start = length target
    | can_reuse_first_char = findTransformationCost (drop 1 start) (drop 1 target)
    | otherwise = 1 + findTransformationCost (drop 1 start) target
    where
        can_reuse_first_char = take 1 start == take 1 target

import Data.List (genericLength)

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = tail (lines input)
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        n = read input
        result = findDistanceToPowerOfTwo n
        output = show result

findDistanceToPowerOfTwo :: Integer -> Integer
findDistanceToPowerOfTwo starting_number = min_distance
    where
        starting_string = show starting_number
        powers_of_two = map (2^) [0..]
        potential_targets = map show powers_of_two
        max_distance = findTransformationCost starting_string (head potential_targets)
        max_length_allowed = genericLength starting_string + max_distance
        interesting_targets = takeWhile
            ((<= max_length_allowed) . genericLength)
            potential_targets
        distances_variants = map (findTransformationCost starting_string) interesting_targets
        min_distance = minimum distances_variants

findTransformationCost :: String -> String -> Integer
findTransformationCost start target
    | null start = genericLength target
    | can_reuse_first_char = findTransformationCost (drop 1 start) (drop 1 target)
    | otherwise = 1 + findTransformationCost (drop 1 start) target
    where
        can_reuse_first_char = take 1 start == take 1 target

import Control.Monad
import Data.List
import Data.Int

countSteps :: String -> String -> Int
countSteps [] s2 = length s2
countSteps s1 [] = length s1
countSteps (x:xs) (s:ss) | x == s = countSteps xs ss
countSteps (x:xs) s = 1+(countSteps xs s)

calc :: String -> Int
calc str =
  let one = 1 :: Int64
      powers = take 61 $ map show $ iterate (*2) one
  in
    minimum $ map (countSteps str) powers

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    print $ calc line

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn :: IO [Integer]

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

maxP2Len = (9+1)*2
p2pwrs   = takeWhile ((maxP2Len>=).length) . map show . iterate (*2) $ (1::Integer)

solve :: String -> Int
solve = minimum . ($ p2pwrs) . map . solvePwr

solvePwr :: String -> String -> Int
solvePwr s p2 = length s + length p2 - (2 * longestPref s p2)

longestPref ""     _                  = 0
longestPref _      ""                 = 0
longestPref (c:cs) (p:ps) | (c == p)  = 1 + longestPref cs ps
                          | otherwise = 0 + longestPref cs (p:ps)

import Data.Int (Int64)

main = do
    t <- read <$> getLine :: IO Int
    mapM_ (solve (map factor [2 ^ (i :: Int64) | i <- [0..60]])) [1..t]

solve :: [[Int]] -> Int -> IO ()
solve powerOf2 _ = do
    n <- read <$> getLine :: IO Int
    print $ foldr1 min (map (dist $ factor n) powerOf2)

factorHelper :: Integral a => a -> [Int]
factorHelper n = if n == 0
                     then []
                     else let (x, y) = n `quotRem` 10 in fromIntegral y : factor (x `quot` 10)

factor :: Integral a => a -> [Int]
factor = reverse . factorHelper

dist :: [Int] -> [Int] -> Int
dist  (x:xs) ay@(y:ys)  = if x == y then dist xs ys else 1 + dist xs ay
dist  xs     []         = length xs
dist  []     ys         = length ys