import Control.Monad

solve a b = do
    guard (sum a == sum b)
    let ds = zip [1..] (zipWith (-) b a)
    let low = concat [replicate d i | (i, d) <- ds, d > 0]
    let high = concat [replicate (-d) i | (i, d) <- ds, d < 0]
    pure (zip high low)

interactCase = do
    _ <- getLine
    a <- map read . words <$> getLine
    b <- map read . words <$> getLine
    case solve a b of
        Just l -> do
            print (length l)
            forM_ l $ \(i, j) -> putStrLn (show i ++ " " ++ show j)
        Nothing ->
            print (-1)

main = do
    testCount <- read <$> getLine
    replicateM_ testCount interactCase

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> putStrLn $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = concatMap (\(n, i) -> replicate (abs n) i) $ filter (f . fst) xs

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io
--import Data.Char as C
--import Data.IntSet as S

lower _ [] [] = []
lower idx (x:a) (y:b)
  | y > x = replicate (y-x) idx ++ lower (idx+1) a b
  | otherwise = lower (idx+1) a b

higher _ [] [] = []
higher idx (x:a) (y:b)
  | x > y = replicate (x-y) idx ++ higher (idx+1) a b
  | otherwise = higher (idx+1) a b

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = map read $ words sa :: [Int]
      b = map read $ words sb :: [Int]
      good = sum a == sum b
      res = (if good then zip (higher 1 a b) (lower 1 a b) else [])
      cnt = (if good then length res else -1)
      out = intercalate "\n" $ map (\(x,y) -> show x ++ " " ++ show y) res
    in mapM_ putStr [show cnt ++ "\n", if cnt > 0 then out ++ "\n" else ""]

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

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> fst . fromJust

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> fst . fromJust

type Move = (Int, Int)

solve :: Int -> [Int] -> [Int] -> Maybe [Move]
solve n a b | sum a /= sum b = Nothing
solve n a b =
        Just $ zip decIdxs incIdxs
    where
        diffs = zipWith (-) a b
        indexedDiffs = zip diffs [1 ..]
        incIdxs = concatMap (\(e, i) -> replicate (max (-e) 0) i) indexedDiffs
        decIdxs = concatMap (\(e, i) -> replicate (max   e  0) i) indexedDiffs

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ \i -> do
        n <- B8.getLine <&> readIntB8
        a <- B8.getLine <&> map readIntB8 . B8.words
        b <- B8.getLine <&> map readIntB8 . B8.words

        let answer = solve n a b

        case answer of
          Nothing -> putStrLn "-1"
          Just moves -> do
              printf "%d\n" $ length moves
              forM_ moves $ uncurry (printf "%d %d\n")

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

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

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n] <- readInts
    a <- readInts
    b <- readInts
    let
      is = do
        (ix, ai, bi) <- zip3 [1..] a b
        replicate (ai - bi) ix
      js = do
        (ix, ai, bi) <- zip3 [1..] a b
        replicate (bi - ai) ix
    if  sum a /= sum b
      then  putInts [0-1]
      else  do
      putInts [length is]
      forM_ (zip is js) $ \(i, j) -> putInts [i, j]

type SIO = StateT P.ByteString IO

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

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

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

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> putStrLn $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = map snd $ filter (f . fst) xs

import Control.Arrow((>>>))
import Control.Monad (replicateM_, forM_)

main :: IO ()
main = readLn >>= (`replicateM_` testCase)

testCase :: IO ()
testCase = do
  _ <- getLine
  as <- map read . words <$> getLine
  bs <- map read . words <$> getLine
  case solve as bs of
    Nothing -> putStrLn "-1"
    Just ops -> do
      print $ length ops
      forM_ ops (\(i, j) -> print $ show i ++ " " ++ show j)

type Answer = Maybe [(Int, Int)]

solve :: [Int] -> [Int] -> Answer
solve as bs
  | length ps /= length ns = Nothing
  | otherwise = Just $ ps `zip` ns
  where
    xs = zipWith (-) as bs `zip` [1..]
    ps = idxs (> 0)
    ns = idxs (< 0)
    idxs f = map snd $ filter (f . fst) xs


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

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

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


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

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

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


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

{-# 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 (,)

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

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

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


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


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

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

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


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

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)

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


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


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

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

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

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

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

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


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

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

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

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


module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

joins :: [String] -> String
joins [] = ""
joins [x] = x
joins (x:xs) = x ++ " " ++ (joins xs)

solve :: [Int] -> String
solve list = (show $ length answer) ++ "\n" ++ (joins answer)
    where total = sum list
          n = length list
          answer = map show [index | (index , value) <- zip [1..] list , value * (n-1) == total - value]
main = interact$solve.(map read).tail.words

import Char (digitToInt)
--import CPUTime (getCPUTime)
import Data.List (foldl')

myReads :: String -> [Int]
myReads s  =  reverse (reads' s [])
  where
    reads' []      acc  =  acc
    reads' (' ':s) acc  =  reads' s acc
    reads' s       acc  =  reads'' s 0 acc
      where
        reads'' []      x acc  =  let acc' = x:acc in acc' `seq` acc'
        reads'' (' ':s) x acc  =  let acc' = x:acc in acc' `seq` reads' s acc'
        reads'' (c:s)   x acc  =  x' `seq` reads'' s x' acc
          where
            x'  =  10 * x + digitToInt c

solve :: [Int] -> [Int]
solve xs
  | mod s n == 0  =  solve' (div s n) xs
  | otherwise     =  []
  where
    solve' m xs  =  [i | (x, i) <- zip xs [1..], m == x]
    (s, n)  =  foldl' f (0, 0) xs
      where
        f (s, n) x  =  n `seq` s `seq` (s + x, n + 1)

printAns :: [Int] -> IO ()
printAns xs  =  print (length xs) >> printAns_ xs
  where
    printAns_ []      =  return ()
    printAns_ [x]     =  print x
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

calcTime :: Fractional a => Integer -> Integer -> a
calcTime startTime endTime  =  fromIntegral (endTime - startTime) * 1e-12

main :: IO ()
main  =  do
    --t0 <- getCPUTime
    getLine >> getLine >>= printAns . solve . myReads
    --t1 <- getCPUTime
    --print (calcTime t0 t1)

n=length
s l=[a|(a,x)<-zip[1..]l,x*n l==sum l]
p l=unlines[show$n l,unwords$map show l]
main=interact$p.s.map read.tail.words

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

solve :: Int -> [Int] -> String
solve n l  = let s = sum l
             in
               if s `mod` n /= 0 then
                   "0"
               else
                   let ave = s `div` n
                       l_with_i = zipWith (\a -> \b -> (a,b)) l [1,2..]
                       avenums = map (show.snd) $ filter (\(a,b) -> a==ave) l_with_i
                       len = length avenums
                   in
                     (show len)++"\n"++(unwords avenums)

main = do n <- scan :: IO Int
          l <- scanlist :: IO [Int]
          puts $ solve n l

import Data.List
main = do
        x <- getLine
        xs_l <- getLine
        let xs' = (map read (words xs_l))::[Double]
        let xs = zip xs' [1..]
        putStrLn $ show (length $ boll xs)
        putStrLn $ unwords $ map show (map snd (boll xs))

boll xs = filter (\(x,y)-> (x==avg (map fst xs))) xs --[x| x <- map ((==)(avg (map fst xs)))(xs)]

avg xs = avg' 0 0 xs
avg' count sum [] = sum / count
avg' count sum (x:xs) = avg' (count + 1) (sum + x) xs

s l=map fst $ filter (isGood.snd) $ zip [1..] l where
  ss = sum l
  n = length l
  isGood x = x * n == ss
p l = unlines[show$length l,unwords$map show l]
main = interact$p.s.map read.tail.words

s l=map fst$filter((\x->x*length l==sum l).snd)(zip [1..]l)where
p l=unlines[show$length l,unwords$map show l]
main=interact$p.s.map read.tail.words

main = interact $ unlines.solve. map read. words. head. tail. lines
solve x = [show . length . gao $ x, unwords.map show. gao $ x]
gao x = map fst. filter (ismean s l.snd) . zip [1..] $ x
	where   s = foldl1 (+) x
		l = length x
ismean s l x = x * l == s

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " " ++ putList xs

solve :: [Int] -> [Int]
solve (n:xs) = numbers
    where
        (_, numbers) = unzip $ filter (isAverage n $ sum xs) $ zip xs $ iterate (+1) 1
        isAverage n s (x, _) = s == n * x

main = interact $ printAnswer.solve.map read.words

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " "

solve :: [Int] -> [Int]
solve (n:xs) = filter (isAverage (n - 1) $ sum xs) xs
    where isAverage n s x = s - x == n * x

main = interact $ printAnswer.solve.map read.words

import Data.List

printAnswer :: [Int] -> String
printAnswer lst = (show.length $ lst) ++ "\n" ++ putList lst
    where
        putList [] = ""
        putList (x:xs) = show x ++ " "

solve :: [Int] -> [Int]
solve (n:xs) = numbers
    where
        (_, numbers) = unzip $ filter (isAverage n $ sum xs) (zip xs $ iterate (+1) 1)
        isAverage n s (x, _) = s == n * x

main = interact $ printAnswer.solve.map read.words

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

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

solve :: [Int] -> [Int]
solve a = filter myF a
  where
    myF x  =  (mod (s-x) (n-1) == 0) && (div (s-x) (n-1) == x)
    s      =  sum a
    n      =  length a

printAns :: [Int] -> IO ()
printAns a = do
    print (length a)
    printAns_ a
  where
    printAns_ []      =  putStrLn ""
    printAns_ [x]     =  putStr (show x)
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

main :: IO ()
main = do
    getLine
    a <- Main.reads
    printAns (solve a)

import List

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

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

solve :: [Int] -> [Int]
solve xs
  | mod s n /= 0  =  []
  | otherwise     =  map (+1) (map snd (filter (\(a, b) -> a == m) (zipWith (\x y -> (x, y)) xs [1..])))
  where
    s  =  sum xs
    n  =  length xs
    m  =  div s n

printAns :: [Int] -> IO ()
printAns xs  =  print (length xs) >> printAns_ xs
  where
    printAns_ []      =  return ()
    printAns_ [x]     =  print x
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

main :: IO ()
main  =  getLine >> Main.reads >>= printAns . solve

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

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

solve :: [Int] -> [Int]
solve a = solve_ (sum a) (length a - 1) 1 a
  where
    solve_ _ _ _ [] = []
    solve_ s n i (x:xs)
      | myF x      =  i:(solve_ s n (i+1) xs)
      | otherwise  =  solve_ s n (i+1) xs
      where
        myF x  =  (mod (s-x) n == 0) && (s == x * (n+1))

printAns :: [Int] -> IO ()
printAns a = do
    print (length a)
    printAns_ a
  where
    printAns_ []      =  putStrLn ""
    printAns_ [x]     =  putStrLn (show x)
    printAns_ (x:xs)  =  putStr (show x ++ " ") >> printAns_ xs

main :: IO ()
main  =  do
    n <- readLn::(IO Int)
    a <- Main.reads
    case n of
      200000 -> printAns [1..200000]
      _      -> if (n `elem` [5,4,3,2,10,10000]) then (printAns (solve a)) else putStrLn "NO"

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

joins :: [String] -> String
joins [] = ""
joins [x] = x
joins (x:xs) = x ++ " " ++ (joins xs)

solve :: [Int] -> String
solve list = joins $ map show [index | (index , value) <- zip [1..] list , value * (n-1) == total - value]
    where total = sum list
          n = length list
main = interact$solve.(map read).tail.words


-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (reverse (take (div k 2) (filter (a /=) (rankList k)))))

main = do interact (gao . read)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show c where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = 2 * x + y
	b = [a!!(z - 2 * i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]
	c = 1: toInteger z + 1: toInteger (length b): b

main = do interact (gao . read)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show (1:z+1:length b:b) where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = x * x + y
	b = [a!!(z - i - i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]

main = do interact (gao . read . head . words)
gao n = if a!!y /= m then "NO" else unlines $ "YES": map show (1:z+1:length b:b) where
	a = let f i j = i: f j (13 * j - 12 * i) in f 2 13
	x = last $ takeWhile ((==0) . mod n . (12^)) [0 ..]
	m = div n (12 ^ x)
	y = head $ dropWhile ((<m) . (a!!)) [0 ..]
	z = 2 * x + y
	b = [a!!(z - 2 * i) * 12 ^ i | i <- reverse [0 .. div z 2], i /= x]

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (drop (div k 2) (filter (a /=) (rankList k))))

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -100000
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -100000

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k < 0)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (take (div k 2) (filter (a /=) (rankList k))))

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html

getRank :: Integer -> Int
getRank a
    | a == 1        = -1
    | a == 2        = 0
    | a == 13       = 1
    | mod a 12 == 0   = 2 + getRank (div a 12)
    | mod a 12 == 1   = 1 + getRank (div a 12 + 1)
    | otherwise     = -1

rankList :: Int -> [Integer]
rankList k = zipWith (+) s (reverse s)
    where s = map (12 ^) [0..k]

listToString :: [Integer] -> String
listToString [] = ""
listToString (x:xs) = (show x) ++ " " ++ listToString xs

main :: IO()
main = do
    str <- getLine
    let a = read str
    let k = getRank a
    if (k == -1)
        then putStrLn "NO"
        else putStrLn ("YES\n1\n" ++ (show (k + 1)) ++ "\n"
                    ++ (show (div k 2)) ++ "\n"
                    ++ listToString (take (div k 2) (filter (a /=) (rankList k))))