{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  case res_lr of
    Just (x1,x2) -> do
      y1 <- findLine False n x1
      y2 <- findLine False n x2
      return ((x1,y1),(x2,y2))
    Nothing -> do
      Just (y1,y2) <- findLRUD True n
      x <- findLine True n y1
      return ((x,y1),(x,y2))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 1
  where
    tst x = (testOdd `on` swapWith xyflg) (x,1) (x,n)
    go1 x
      | x >= n = return Nothing
      | otherwise = do
          b <- tst x
          if not b then go1 (x+1) else Just . (x,) <$> go2 (x+1)
    go2 x
      | x >= n = return n
      | otherwise = do
          b <- tst x
          if not b then go2 (x+1) else return x

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  res_ud <- findLRUD True n
  case (res_lr,res_ud) of
    (Nothing,Nothing) -> exitFailure
    (Just (x1,x2),Nothing) -> do
      y <- findLine False n x1
      return ((x1,y),(x2,y))
    (Nothing, Just (y1,y2)) -> do
      x <- findLine True n y1
      return ((x,y1),(x,y2))
    (Just (x1,x2), Just (y1,y2)) -> do
      b <- testOdd (x1,y1) (x1,y1)
      return $ if b then ((x1,y1),(x2,y2)) else ((x1,y2),(x2,y1))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 1
  where
    tst x = (testOdd `on` swapWith xyflg) (x,1) (x,n)
    go1 x
      | x >= n = return Nothing
      | otherwise = do
          b <- tst x
          if not b then go1 (x+1) else Just . (x,) <$> go2 (x+1)
    go2 x
      | x >= n = return n
      | otherwise = do
          b <- tst x
          if not b then go2 (x+1) else return x

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

test :: (Int,Int) -> (Int,Int) -> IO Int
test (x1,y1) (x2,y2) = do
  putStrLn $ unwords $ ("?":) $ map show $ [x1,y1,x2,y2]
  hFlush stdout
  reply <- readInt <$> getLine
  when (reply < 0) $ exitFailure
  return reply

testOdd :: (Int, Int) -> (Int, Int) -> IO Bool
testOdd p1 p2 = odd <$> test p1 p2

swapWith False = id
swapWith True = swap

main :: IO ()
main = do
  n <- readInt <$> getLine
  ((x1,y1),(x2,y2)) <- query n
  putStrLn $ unwords $ ("!":) $ map show $ [x1,y1,x2,y2]

query :: Int -> IO ((Int,Int),(Int,Int))
query n = do
  res_lr <- findLRUD False n
  res_ud <- findLRUD True n
  case (res_lr,res_ud) of
    (Nothing,Nothing) -> exitFailure
    (Just (x1,x2),Nothing) -> do
      y <- findLine False n x1
      return ((x1,y),(x2,y))
    (Nothing, Just (y1,y2)) -> do
      x <- findLine True n y1
      return ((x,y1),(x,y2))
    (Just (x1,x2), Just (y1,y2)) -> do
      b <- testOdd (x1,y1) (x1,y1)
      return $ if b then ((x1,y1),(x2,y2)) else ((x1,y2),(x2,y1))

findLRUD :: Bool -> Int -> IO (Maybe (Int,Int))
findLRUD xyflg n = go1 2
  where
    tst x = (test `on` swapWith xyflg) (x,1) (x,n)
    go1 x = case compare x n of
      GT -> return Nothing
      EQ -> do
        b <- odd <$> tst n
        return $ if b then Just (n-1,n) else Nothing
      LT -> do
        b <- tst x
        if | testBit b 0 -> do
               b <- tst (x+1)
               if | testBit b 0 -> return $ Just (x,x+1)
                  | testBit b 1 -> Just . (x,) <$> go2 (x+3)
                  | otherwise   -> return $ Just (x-1,x)
           | testBit b 1 -> Just . (x-1,) <$> go2 (x+2)
           | otherwise   -> go1 (x+2)
    go2 x = case compare x (n+1) of
      GT -> return n
      EQ -> do
        b <- odd <$> tst n
        return $ if b then n else n-1
      LT -> do
        b <- tst x
        if | testBit b 0 -> return x
           | testBit b 1 -> go2 (x+2)
           | otherwise -> return (x-1)

findLine :: Bool -> Int -> Int -> IO Int
findLine flgSwap n x = go 0 n
  where
    swp = swapWith flgSwap
    go !lty !geqy
      | geqy - lty <= 1 = return geqy
      | otherwise = do
          b <- (testOdd `on` swp) (x,lty+1) (x,midy)
          if b then go lty midy else go midy geqy
      where
        midy = lty + shiftR (geqy - lty) 1

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


import Control.Monad
import Data.List
import qualified Data.Set as S

readInt :: String -> Int
readInt = read

getInts :: IO [Int]
getInts = map readInt . words <$> getLine

main :: IO ()
main = do
  t <- readLn :: IO Int
  putStr . unlines . map show =<<
    replicateM
      t
      (do [n, x] <- getInts
          solve 1 x . S.toAscList . S.fromList <$> getInts)

solve :: Int -> Int -> [Int] -> Int
solve v x [] = v + x - 1
solve v x (l:ls)
  | v == l = solve (v + 1) x ls
  | x > 0 = solve (v + 1) (x - 1) (l : ls)
  | otherwise = v - 1

import Control.Arrow
import Data.List (sort)

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

process :: [[Int]] -> [Int]
process [] = []
process ([_,x]:a:ps) = ((get x 1) . uniq . sort) a : process ps

get :: Int -> Int -> [Int] -> Int
get n _ [] = n
get n r (y:ys)
  | y == r = 1 + get n (r + 1) ys
  | n >= 1 = 1 + get (n - 1) (r + 1) (y:ys)
  | otherwise = 0

uniq :: (Eq a) => [a] -> [a]
uniq [] = []
uniq [x] = [x]
uniq (x:x':xs)
  | x == x' = ys
  | otherwise = x : ys
    where ys = uniq (x':xs)


import IO
import List
import Monad

solve :: Int -> Int -> [Int] -> (Int, [Int])
solve n k xs  =  (min, take k . map fst . filter ((min <=) . snd) . zip [1..] $ xs)
  where
    xs'  =  reverse (sort xs)
    min  =  xs' !! (k - 1)

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

    [n, k]  <-  liftM (map read . words) (hGetLine hInput)
    xs      <-  liftM (map read . words) (hGetLine hInput)
    let (min, (y:ys))  =  solve n k xs
    hPrint hOutput min
    hPutStr hOutput (show y) >> mapM_ (hPutStr hOutput . (" " ++) . show) ys

    hClose hInput
    hClose hOutput

import Data.List

solve :: Int -> [Int] -> (Int, [Int])
solve k xs = (minimum $ map fst answer,
              map snd answer)
  where reversedFst (x, _) (y, _) = compare y x
        answer = take k $ sortBy reversedFst $ zip xs [1 .. ]

main = do (k:xs) <- fmap (tail . map read . words) $ readFile "input.txt"
          let (mn, bs) = solve k xs
          writeFile "output.txt" $ unlines [show mn, unwords $ map show bs]

import Data.List
import Data.Ord

main = readFile"input.txt">>=writeFile"output.txt".solve.map read.words

solve (_:k:xs) = case take k.sortBy(flip (comparing snd))$zip[1..]xs of
                   ans -> shows (minimum $map snd ans) "\n" ++ unwords(map (show.fst) ans)

import Data.List
import Data.Ord

main = readFile"input.txt">>=writeFile"output.txt".unwords.map show.solve.map read.words

solve (_:k:xs) = map fst.take k.sortBy(flip (comparing snd))$zip[1..]xs


import Control.Applicative ((<$>))
import Control.Monad (forM_, when)
import Control.Monad.ST.Safe (ST)
import Data.Array.Unboxed (assocs)
import Data.Array.ST.Safe (STUArray, runSTUArray, newArray, readArray, writeArray)

sieve :: Int -> [Int]
sieve n = map fst . filter snd . assocs $ runSTUArray $ do
    arr <- newArray (2, n) True :: ST s (STUArray s Int Bool)
    forM_ [2..n] $ \i -> do
        b <- readArray arr i  -- if i is prime
        when b $ forM_ [i*i, i*i + i .. n] $ \i -> writeArray arr i False
    return arr

solve :: Int -> [Int]
solve n = concatMap run $ sieve n
    where run i = takeWhile (< n + 1) $ iterate (*i) i

main = do
    xs <- solve . read <$> getLine
    print $ length xs
    putStrLn . unwords $ map show xs

main = readLn >>= putStr . out . solve
out a = show (length a) ++ '\n' : (unwords $ map show a)

prime n = let nums = takeWhile (\x -> x * x <= n) [2..] in and $ map (\x -> n `rem` x /= 0) nums

solve n = concat $ map (\x -> takeWhile (<= n) $ iterate (x*) x) primes
  where primes = filter prime [2..n]

main = readLn >>= putStr . out . solve
out a = show (length a) ++ '\n' : (unwords $ map show a)

prime n = let nums = takeWhile ((<= n) . (^2)) [2..] in and $ map ((/=0) . (rem n)) nums

solve n = concat $ map (\x -> takeWhile (<= n) $ iterate (x*) x) primes
  where primes = filter prime [2..n]

import Text.Printf

sieve :: [Int]
sieve = sieve [2..]
    where
        sieve :: [Int] -> [Int]
        sieve (x:xs) = x:sieve [y | y <- xs, y `mod` x /= 0]

guesses :: Int -> [Int]
guesses n =
    let
        primes = takeWhile (<= n) sieve
    in
        concat [ primePowersUpToN x n x [] | x <- primes]
    where
        primePowersUpToN :: Int -> Int -> Int -> [Int] -> [Int]
        primePowersUpToN p n acc res
            | acc > n = res
            | otherwise = primePowersUpToN p n (acc * p) (acc:res)

main :: IO ()
main = do
    s <- getLine
    let n = read s :: Int
    let res = guesses n
    print $ length res
    mapM_ (printf "%d ") res

prime 2 = [2]
prime n | and (map (\x -> n `rem` x /= 0) pre) = pre++[n]
        | otherwise = pre
  where pre = prime (n-1)
isQ n (p:prime) f | n < p = True
                  | n `rem` p == 0 = if (f == 0 || f == p) then isQ (n `div` p) (p:prime) p else False
                  | f /= 0 = False
                  | otherwise = isQ n prime f
main = do
   w0 <- getLine
   let n = (read w0)::Int
   let p = prime 1000
   let kai = map show $ takeWhile (<=n) $ map fst $ filter (id.snd) $ zip [2..1000] (map(\n -> isQ n p 0) [2..1000])
   putStrLn $ show $ length kai
   putStrLn $ unwords kai

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc k x = if k>n then acc else f (k:acc) (x*k) x
              nums = map show . concat $ map (\x->f [] x x) ps

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc x  = if x>=n then acc else f (x:acc) (x*x)
              nums = map show . concat $ map (f []) ps

import Data.List
main=interact $ solve. read
solve::Int->String
solve n = (show $ length nums) ++ "\n" ++ intercalate " " nums
        where primes = 2 : filter isPrime [3..]
              isPrime x = all ((/=0) . (mod x)) $ takeWhile ((<=x).(^2)) primes
              ps=takeWhile (<=n) primes
              f acc x  = if x>n then acc else f (x:acc) (x*x)
              nums = map show . concat $ map (f []) ps

import Control.Applicative ((<$>))
import Control.Monad (forM_, when)
import Control.Monad.ST.Safe (ST)
import Data.Array.Unboxed (assocs)
import Data.Array.ST.Safe (STUArray, runSTUArray, newArray, readArray, writeArray)

sieve :: Int -> [Int]
sieve n = map fst . filter snd . assocs $ runSTUArray $ do
    arr <- newArray (2, n) True :: ST s (STUArray s Int Bool)
    forM_ [2..n] $ \i -> do
        b <- readArray arr i  -- if i is prime
        when b $ forM_ [i*i, i*i + i .. n] $ \i -> writeArray arr i False
    return arr

solve :: Int -> [Int]
solve n = concatMap run $ sieve n
    where run i = takeWhile (< n + 1) $ iterate (*i) i

main = getLine >>= putStrLn . unwords . map show . solve . read

prime 2 = [2]
prime n | and (map (\x -> n `rem` x /= 0) pre) = pre++[n]
        | otherwise = pre
  where pre = prime (n-1)
isQ n (p:prime) f | n < p = True
                  | n `rem` p == 0 = if (f == 0 || f == p) then isQ (n `div` p) (p:prime) p else False
                  | f /= 0 = False
                  | otherwise = isQ n prime f
main = do
   w0 <- getLine
   let n = (read w0)::Int
   let p = prime 1000
   putStrLn $ unwords $ map show $ takeWhile (<=n) $ map fst $ filter (id.snd) $ zip [2..1000] (map(\n -> isQ n p 0) [2..1000])


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

solve :: [Int] -> Int
solve (_:t:as) = go 0 0 0 as as
  where go a k s xxs@(x:xs) (y:ys) | s + y <= t = go (max a (k + 1)) (k + 1) (s + y) xxs ys
                                   | otherwise = go a k (s + y - x) xs ys
        go a _ _ _ _ = a
solve _ = undefined

import Control.Monad (liftM)
import Data.Array ((!), listArray)
import Data.Char (ord)
import Data.List (intercalate)

solve :: Int -> [Int] -> Int
solve t as  =  solve' (r-l) s (l, r)
  where
    array  =  listArray (1, n) as
    n  =  length as
    l  =  1
    r  =  (+1) $ length $ tail $ takeWhile (<= t) $ scanl (+) 0 as
    s  =  sum $ take (r-1) as
    -- inv: sum [al .. ar-1] <= t
    --  && sum [al..ar] > t
    solve' ans s (l, r)
      | r > n  =  ans
      | otherwise  =  solve' ans' s' (l', r')
      where
        l'  =  l + 1
        (r', s')  =  findR (s - array ! l) r
        ans'  =  max ans (r'-l')
        findR s r
          | r > n  =  (r, s)
          | s' > t  =  (r, s)
          | otherwise  =  findR s' (r+1)
          where
            s'  =  s + array ! r

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

  where

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

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go as as 0 0 where
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ b = [b]
  go _ [] _ _ = []
test = [
    solve [4,5,3,1,2,1] == 3
  ]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

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

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,t] <- map read.words <$> getLine :: IO [Int]
  xs <- map readInt.B.words <$> B.getLine
  print $ solve t xs

data Queue = Q !Int !Int [Int] [Int]

solve t xs = maximum.snd $ mapAccumL enq (Q 0 0 [] []) xs
   where
     enq que@(Q cnt acc fs rs) x
       | x+acc<=t = (Q (cnt+1) (acc+x) fs (x:rs), cnt+1)
       | cnt == 0 = (Q 0 0 [] [], 0)
       | otherwise = enq (deq que) x
     deq (Q cnt acc (f:fs) rs) = Q (cnt-1) (acc-f) fs rs
     deq (Q cnt acc [] rs) = deq $ Q cnt acc (reverse rs) []

import Data.Maybe (fromMaybe)
import Data.Sequence (Seq(..), ViewL(..), viewl, (|>), (<|) )

import Data.List (foldl')
import Control.Monad (replicateM)

main :: IO ()
main = do
  (_:t:_) <- map read . words <$> getLine
  bookMins <- map read . words <$> getLine
  print $ maximum $ analyzeNextBook (t, Empty, []) bookMins

  where
    analyzeNextBook :: (Int, Seq Int, [Int]) -> [Int] -> [Int]
    analyzeNextBook (_, _, readBookCount) [] = readBookCount
    analyzeNextBook (minsLeft, readMins, readBookCount) (nextBookMins: unprocessed) =
      let newLeft = minsLeft - nextBookMins
          currBookCount = fromMaybe 0 $ safeHead readBookCount
      in if newLeft >= 0
         -- can read next one
         then analyzeNextBook (newLeft, readMins |> nextBookMins, currBookCount + 1 : readBookCount) unprocessed
         -- no mins left for next one
         else case viewl readMins of
                -- but none read ... so this book can't be read, skip it
                EmptyL -> analyzeNextBook (minsLeft, readMins, currBookCount : readBookCount) unprocessed
                -- try skipping first read and get back the minutes
                (firstMins :< restMins) -> analyzeNextBook (firstMins + minsLeft, restMins, currBookCount - 1 : readBookCount) (nextBookMins : unprocessed)

    safeHead [] = Nothing
    safeHead (x:xs) = Just x

import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . show . solve . map readInt . B.words

solve (n:k:a) = maximum $ map fst $ solve' a a (0, 0)
  where
      solve' [] _ x = [(0, 0)]
      solve' (a : as) (b : bs) (0, 0)
        |     a > k = solve' as bs (0, 0)
      solve' (a : as) (b : bs) (c, s)
        | s + a > k = (c - 1, s - b) : solve' (a : as) bs (c - 1, s - b)
        | otherwise = (c + 1, s + a) : solve' as (b : bs) (c + 1, s + a)

import Data.Sequence as Q

readInts :: IO [Int]
readInts = do
    line <- getLine
    return $ map read $ words line

solve t books = go 0 0 [] books
    where
    go len sum buf [] = len
    go len sum buf rem@(b:bs) | sum+b <= t = go (len+1) (sum+b) (buf++[b]) bs
                              | len > 0 = max len $ go (len-1) (sum-(head buf)) (tail buf) rem
                              | otherwise = max len $ go len sum buf bs

solve2 t books = go 0 empty books
    where
    go sum buf [] = Q.length buf
    go sum buf rem@(b:bs) | sum+b <= t = go (sum+b) (b<|buf) bs
                          | otherwise = case viewr buf of
                                          EmptyR -> go sum buf bs
                                          s :> r -> max (Q.length buf) $ go (sum-r) s rem
main :: IO ()
main = do
    a <- readInts
    books <- readInts
    let (n, t) = (a!!0, a!!1)
    putStrLn $ show $ solve2 t books

import qualified Data.ByteString.Char8 as B

main = putStrLn .  show . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n : t : as) = maximum $ map fst $ f as as (0, 0)
  where
  f [] _ x = [(0, 0)]
  f (a : as) (b : bs) (0, 0)
    |     a > t = f as bs (0, 0)
  f (a : as) (b : bs) (c, s)
    | s + a > t = (c - 1, s - b) : f (a : as) bs (c - 1, s - b)
    | otherwise = (c + 1, s + a) : f as (b : bs) (c + 1, s + a)

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> Int -> Int
solve as t  =  length $ takeWhile (<= t) $ tail $ scanl (+) 0 $ reverse as

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

  where

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

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go cas cas 0 0 where
  cas = as ++ as
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go as as 0 0 where
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = b : go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

main = interact $ show . solve . map read . words
solve (m:t:as) = maximum $ 0 : go cas cas 0 0 where
  cas = as ++ as
  go ns@(n:ns') ps@(p:ps') r b | b > m = go ns' ps (r-p) (b-1)
                               | r + n > t = b : go ns ps' (r-p) (b-1)
                               | otherwise = go ns' ps (r+n) (b+1)
  go [] _ _ _ = []
  go _ [] _ _ = []

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  [n,t] <- map read.words <$> getLine :: IO [Int]
  xs <- map readInt.B.words <$> B.getLine
  print.length.dropWhile (t<) $ scanr1 (+) xs

import qualified Data.ByteString.Char8 as B
import Data.List

readInt bs = case B.readInt bs of Just (n,_) -> n
main = B.getContents >>= putStr . solve . map readInt . B.words

solve (n:k:a) = show . foldl max 0 $ zipWith delta z (inits z)
    where
        z = tail . scanl (+) 0 $ a
        delta cur prevs = binary (cur-k) prevs
        binary limit origin = length . dropWhile (<limit) $ origin


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

f :: Int -> Int -> Int -> Int -> UArray Int Int -> UArray Int Int
f k t0 t1 d1 farr = listArray (0, k) [ f' i | i <- [0..k] ] where
    donotignore n = max 0 ((farr ! n) - (t1 - t0)) + d1
    doignore n    = (farr ! (n-1)) - (t1 - t0)

    f' 0 = donotignore 0
    f' n = min (doignore n) (donotignore n)

f0 k = listArray (0, k) $ repeat 0

solve k farr t0 [] = max ((86401 - t0) - (farr ! k)) 0
solve k farr t0 ((t1, d1):xs) = max ((t1 - t0) - (farr ! k))
                                    (solve k (f k t0 t1 d1 farr) t1 xs)

readInt = (\(Just (x,_)) -> x) . BS.readInt

main = do
    [n, k] <- liftM (map readInt . BS.words) BS.getLine
    list <- replicateM n $ do
        [t, d] <- liftM (map readInt . BS.words) BS.getLine
        return (t, d)

    print $ solve k (f0 k) 1 list

{-
 -
 - Yannis Chatzimichos
 - A.M.: 03108610
 -
 - http://codeforces.com/problemset/problem/158/E
 -
 -}

import Debug.Trace
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

solve_cur_row :: Int -> Int -> [Int] -> (Int, [Int])
solve_cur_row t d [prev0]
  | t <= prev0  = (0, [prev0+d])
  | otherwise   = (t-prev0-1, [t+d-1])
solve_cur_row t d (prev0:prev1:prev_row)  =
  let
    cur0' = if t <= prev0 then prev0+d else t+d-1
    cur0 = min cur0' prev1
    (ans_rest, cur_rest) = solve_cur_row t d (prev1:prev_row)
    ans = if t <= prev0 then ans_rest else max ans_rest t-prev0-1
  in
    (ans, cur0:cur_rest)

solve :: [(Int, Int)] -> [Int] -> Int
{- solve x prev_row | trace("x: " ++ show x ++ "prev_row: " ++ show prev_row) False = undefined -}
solve [] prev_row = 86400 - minimum prev_row

solve (x:xs) prev_row =
  let
    (ans', cur_row) = solve_cur_row (fst x) (snd x) prev_row
  in
    max ans' (solve xs cur_row)

start n k list =
  print (solve list (take (k+1) [0,0..]))

main =
  do all <- BS.getContents
     let ((n, k), r1) = readPair all -- read the first two integers
     let list = readMany readPair r1 n
     start n k list
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readPair s = ((a, b), r2)
                where
                    Just (a, r1) = readInt s
                    Just (b, r2) = readInt r1
        readMany _ _  0 = []
        readMany readf s n = let
            (x, r) = readf s
          in
            x : readMany readf r (n-1)


z[a,b]=gcd a b+1
main=interact$show.z.map(pred.read).words

gao [a, b]
	| a > b		= gao [b, a]
	| a == 1	= a
	| a == b	= a
	| otherwise	= gao [a, b - (b - 2) `div` (a - 1) * (a - 1)]
main = do getLine >>= print . gao . map read . words

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative

solve :: Int -> Int -> Int
solve n m = gcd (n - 1) (m - 1) + 1

main = do
    [n, m] <- map read . words <$> getLine
    print $ solve n m

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative

solve :: Int -> Int -> Int
solve n m
    | n == m    = fromIntegral n
    | otherwise = simulate (0, 0) (1, 1) (n + m)
  where
    simulate (x, y) (dx, dy) answer
        | dx /= dx' && dy /= dy' = answer'
        | otherwise              = simulate (x', y') (dx', dy') answer'
      where
        xsteps = if dx < 0 then x else n - 1 - x
        ysteps = if dy < 0 then y else m - 1 - y
        steps = xsteps `min` ysteps
        x' = x + dx * steps
        y' = y + dy * steps
        dx' = if x' + dx >= n || x' + dx < 0 then -dx else dx
        dy' = if y' + dy >= m || y' + dy < 0 then -dy else dy
        answer' = answer `min` (x' + y')

main = do
    [n, m] <- map read . words <$> getLine
    print $ solve n m


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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STArray, newArray, STUArray)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

-- repeatM :: (a -> m a) -> Int -> a -> m a
-- repeatM f 0 a = a
-- repeatM f n a = do
--   a' <- f a

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find (a-1) (b-1)
            q <- find (c-1) (d-1)

            followd (p, q) >>= followr
            followr (p, q) >>= followd
          where
            followd = follow True h
            followr = follow False w

            follow b c (p, q) = f' c p q
              where
                f' 0 p q = return (p, q)
                f' c p q = do
                  let
                    -- f :: Int -> ST s Int
                    f p = if b then readArray ds p else readArray rs p

                  p' <- f p
                  q' <- f q

                  let
                    swap :: STUArray s Int Int -> ST s ()
                    swap a = readArray a p' >>= \t -> readArray a q' >>= writeArray a p' >> writeArray a q' t

                  if b then swap rs else swap ds

                  f' (c-1) p' q'

            find x y = downs x 0 >>= rights y
              where
                rights 0 p = return p
                rights n p = right p >>= rights (n-1)

                downs 0 p = return p
                downs n p = down p >>= downs (n-1)

        downs 0 p = return []
        downs n p = do
          p' <- down p
          (p':) <$> downs (n-1) p'

        rights 0 p = return []
        rights n p = do
          p' <- right p
          (p':) <$> rights (n-1) p'

      mapM_ update qs

      ds <- downs n 0
      mapM (rights m) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [x1, y1, x2, y2, h, w] = do
            p <- find x1 y1
            q <- find x2 y2

            (uncurry rights) =<< downs p q
            (uncurry downs) =<< rights p q
          where
            find x y = iterateNM' (y-1) right 0 >>= iterateNM' (x-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            downs p q = loop h p q
              where
                loop 0 p q = return (p, q)
                loop n p q = do
                  p' <- down p
                  q' <- down q
                  swap rs p' q'
                  loop (n-1) p' q'

            rights p q = loop w p q
              where
                loop 0 p q = return (p, q)
                loop n p q = do
                  p' <- right p
                  q' <- right q
                  swap ds p' q'
                  loop (n-1) p' q'

      forM_ qs update

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STArray, newArray, STArray)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (unfoldr)
import Data.Char (isSpace)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find (a-1) (b-1)
            q <- find (c-1) (d-1)

            followd (p, q) >>= followr
            followr (p, q) >>= followd
          where
            followd = follow True h
            followr = follow False w

            follow b c (p, q) = f' c p q
              where
                f' 0 p q = return (p, q)
                f' c p q = do
                  let f = if b then down else right

                  p' <- f p
                  q' <- f q

                  let
                    swap :: STArray s Int Int -> ST s ()
                    swap a = readArray a p' >>= \t -> readArray a q' >>= writeArray a p' >> writeArray a q' t

                  if b then swap rs else swap ds

                  f' (c-1) p' q'

            find x y = downs x 0 >>= rights y
              where
                rights 0 p = return p
                rights n p = right p >>= rights (n-1)

                downs 0 p = return p
                downs n p = down p >>= downs (n-1)

        downs 0 p = return []
        downs n p = do
          p' <- down p
          (p':) <$> downs (n-1) p'

        rights 0 p = return []
        rights n p = do
          p' <- right p
          (p':) <$> rights (n-1) p'

      mapM_ update qs

      ds <- downs n 0
      mapM (rights m) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [x1, y1, x2, y2, h, w] = do
            p <- find x1 y1
            q <- find x2 y2

            downs (p, q) >>= rights
            rights (p, q) >>= downs
          where
            find x y = iterateNM' (y-1) right 0 >>= iterateNM' (x-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            downs = iterateNM' h f
              where
                f (p, q) = do
                  p' <- down p
                  q' <- down q
                  swap rs p' q'
                  return (p', q')

            rights = iterateNM' w f
              where
                f (p, q) = do
                  p' <- right p
                  q' <- right q
                  swap ds p' q'
                  return (p', q')

      forM_ qs update

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM, forM_, mapM, liftM2)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.IArray (listArray, (!))
import Data.Array.Unboxed (UArray)
import Data.Array.ST.Safe (readArray, writeArray, newArray_, STUArray, newArray, STUArray)
import qualified Data.ByteString.Char8 as B
import Data.List (unfoldr)
import Data.Char (isSpace)

readInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

{-# INLINEABLE iterateNM' #-}
iterateNM' :: Monad m => Int -> (a -> m a) -> a -> m a
iterateNM' n f a = loop n a
  where
    loop 0 a = return a
    loop n a = f a >>= loop (n-1)

{-# INLINEABLE iterateNM #-}
iterateNM n f a = loop n a
  where
    loop 0 a = return []
    loop n a = f a >>= \a' -> fmap (a':) (loop (n-1) a')

main = do
  [n, m, q] <- readInts
  as <- replicateM n readInts
  qs <- replicateM q readInts

  let
    as' = listArray ((1, 1), (n, m)) $ concat as :: UArray (Int, Int) Int

    encode x y = x*(m+2) + y
    decode z = z `divMod` (m+2)

    xys = runST $ do
      ds <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray ds (encode x y) (encode (x+1) y)

      rs <- newArray_ (0, encode (n+1) (m+1)) :: ST s (STUArray s Int Int)
      forM_ [0..n] $ \x -> forM_ [0..m] $ \y -> writeArray rs (encode x y) (encode x (y+1))

      let
        {-# INLINE down #-}
        down z = readArray ds z
        {-# INLINE right #-}
        right z = readArray rs z

        update [a, b, c, d, h, w] = do
            p <- find a b
            q <- find c d

            iterateNM' h down' (p, q) >>= iterateNM' w right'
            iterateNM' w right' (p, q) >>= iterateNM' h down'
          where
            find x y = iterateNM' (x-1) right 0 >>= iterateNM' (y-1) down

            swap :: STUArray s Int Int -> Int -> Int -> ST s ()
            swap a p q = readArray a p >>= \t -> readArray a q >>= writeArray a p >> writeArray a q t

            down' (p, q) = do
              p' <- down p
              q' <- down q
              swap ds p' q'
              return (p', q')

            right' (p, q) = do
              p' <- right p
              q' <- right q
              swap rs p' q'
              return (p', q')

      ds <- iterateNM n down 0
      mapM (iterateNM m right) ds

  putStr $ unlines $ map (unwords . map (show . (as'!) . decode)) xys


import Control.Monad
main = do
  tcn <- readLn
  replicateM_ tcn $ do
    n <- readLn
    print $ max 0 (n-2)

main :: IO ()
main = do
  line <- getLine
  calc (read line :: Int)

calc :: Int -> IO ()
calc 0 = return ()
calc (n+1) = do
  x <- getLine
  putStr ((show (max 0 ((read x :: Int) - 2))) ++ "\n")
  calc n
calc _ = return ()

{-# OPTIONS_GHC -fglasgow-exts -O2 -optc-O3 #-}

import qualified Data.ByteString.Lazy.Char8 as BS (getContents, split, readInt, lines, ByteString)
import Control.Applicative

check :: Int -> Int
check 1 = 0
check n = n - 2

main = do
    (t:ns) <- BS.lines `fmap` BS.getContents
    mapM_ print $ map (check . readInt) $ ns

readInt :: BS.ByteString -> Int
readInt x =
    case BS.readInt x of
          Just (i, _) -> i
          Nothing     -> error "Unparsable Integer"

import Control.Monad
main = readLn >>= \t -> replicateM_ t $ readLn >>= \n -> print $ max 0 (n-2)

import Control.Monad
main = do
  tcn <- readLn
  replicateM_ tcn $ do
    n <- readLn
    print $ n`div`2


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

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

import Data.List

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [a, b] <- getInts 2
    let
      needed = abs (a - b) `div` 2
      tot = a + b
      maxv = tot - needed
      ans = [needed, needed + (if  even tot  then  2  else  1) .. maxv]
    putInts [length ans]
    putInts ans

type SP = StateT [P.ByteString]
type SIO = SP IO

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

{-# LANGUAGE LambdaCase #-}

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

main :: IO ()
main =
  C.interact $
    runScanner (numberOf testCase)
      >>> map (solve >>> showAns)
      >>> concat
      >>> C.unlines
  where
    showAns xs = [showB $ length xs, C.unwords $ map showB xs]

testCase :: Scanner (Int, Int)
testCase = pair int int

solve :: (Int, Int) -> [Int]
solve (a, b) = uniq . sort $ do
  sa <- [half, tot - half] -- A #serves
  let sb = a + b - sa -- B #serves
  ha <- [0..a] -- A #points by hold
  let ba = a - ha -- A #points by break
  let bb = sa - ha -- B #points by break
  let hb = b - bb -- B #points by hold
  guard $ ba >= 0
  guard $ bb >= 0
  guard $ hb >= 0
  return $ ba + bb
    where
      tot = a + b
      half = tot `div` 2
      uniq = map head . group

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

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

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

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

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


import Data.Char
import Data.List

tokenize :: String -> [String]
tokenize [] = []
tokenize (x:xs)
    | isSpace x = tokenize xs
    | isDigit x = (x:token):tokenize afterNumber
    | x == ',' = [x]:tokenize xs
    | x == '.' = "...":tokenize afterPoints
    where
        (_, afterPoints) = splitAt 2 xs
        (token, afterNumber) = span isDigit xs

fix :: [String] -> String
fix (x:xs) = x ++ fix' xs x
    where
        fix' :: [String] -> String -> String
        fix' [] _ = ""
        fix' (x:xs) p   | (isDigit.head $ x) && (head p == '.') = x ++ fix' xs x
                        | (head x == ',') && (head p == '.') = x ++ fix' xs x
                        | (head x == ',') && (isDigit.head $ p) = x ++ fix' xs x
                        | otherwise = " " ++ x ++ fix' xs x

main = interact $ fix.tokenize

import Data.Char

main = getLine >>= putStrLn . solve

solve = put . get

get :: String -> [String]
put :: [String] -> String

get "" = []
get (' ':xs) = get xs
get (',':xs) = "," : get xs
get ('.':'.':'.':xs) = "..." : get xs
get xs = let (as,bs) = break (not . isDigit) xs
         in as : get bs

put xs = let
  leftSp = map (=="...") xs
  rightSp = map (==",") xs
  num = map (isDigit . head) xs
  sp1 = zipWith (||) (tail leftSp) rightSp
  sp2 = zipWith (&&) num (tail num)
  in concat $ zipWith (\x flag -> if flag then " "++x else x) xs $
    False : zipWith (||) sp1 sp2

import Data.Char
data L = Spac | Dots | Comma | Num [Char] deriving Eq
instance Show L where
    show Spac = " "
    show Dots = "..."
    show Comma = ","
    show (Num s) = reverse s
sc (s:ss) (Num n:rs) | s `elem` ['0'..'9'] = sc ss (Num (s:n):rs)
sc (s:ss) rs | s `elem` ['0'..'9'] = sc ss (Num [s]:rs)
sc (' ':ss) rs = sc ss (Spac:rs)
sc (',':ss) rs = sc ss (Comma:rs)
sc ('.':'.':'.':ss) rs = sc ss (Dots:rs)
sc [] r = reverse $ filter (/= Spac) r
f n1@(Num _) n2@(Num _) = show n1 ++ " "
f a Dots = show a ++ " "
f Comma _ = show Comma ++ " "
f a _ = show a
poly (s1:s2:ss) = f s1 s2 ++ poly (s2:ss)
poly [s1] = show s1
poly [] = []
main = do
    l <- getLine
    putStrLn $ poly $ sc l []

import Data.Char
import Control.Applicative

data Token = IntToken Integer | Ellipsis | Comma deriving Show

digitToInteger = toInteger . digitToInt

tokenize [] = []
tokenize ('.':'.':'.':t) = Ellipsis : tokenize t
tokenize (',':t) = Comma:tokenize t
tokenize (' ':t) = tokenize t
tokenize (digit:t) = tokenize' t (digitToInteger digit)
    where
        tokenize' (dig:t) i | isDigit dig = tokenize' t (i*10 + digitToInteger dig)
        tokenize' list i = IntToken i : tokenize list

printToken (IntToken i) = show i
printToken Ellipsis = "..."
printToken Comma = ","

fancyPrint (Ellipsis : rest) = "..." ++ fancyPrint' rest
fancyPrint list = fancyPrint' list

fancyPrint' [] = ""
fancyPrint' [Comma] = ","
fancyPrint' (Comma:Ellipsis:rest) = ", ..." ++ fancyPrint' rest
fancyPrint' (Comma:rest@(_:_)) = ", " ++ fancyPrint' rest
fancyPrint' (IntToken i : rest@(IntToken _ : _)) = show i ++ " " ++ fancyPrint' rest
fancyPrint' (IntToken i : rest) = show i ++ fancyPrint' rest
fancyPrint' (Ellipsis : rest) = " ..." ++ fancyPrint' rest

solve = fancyPrint . tokenize

main = putStrLn =<< solve <$> getLine

import qualified Char as Char

data Gram = Comma | Dots | Num String

parse []                   = []
parse (' ':xs)             = parse xs
parse (',':xs)             = Comma:parse xs
parse ('.':'.':'.':xs)     = Dots:parse xs
parse xs                   = (Num number) : parse rest
    where (number, rest)   = span Char.isDigit xs

unparse []                 = ""
unparse (Comma:[])         = ","
unparse (Comma:Dots:xs)    = ", ..."   ++ unparse xs
unparse (Comma:xs)         = ", "      ++ unparse xs
unparse (Dots:xs)          = " ..."    ++ unparse xs
unparse (Num d1:Num d2:xs) = d1 ++ " " ++ unparse (Num d2:xs)
unparse (Num d:xs)         = d         ++ unparse xs

fix (' ':xs) = xs
fix xs = xs

main :: IO ()
main = do
    seq <- getLine
    putStr (fix (unparse (parse seq)))

import Data.Char
import Data.List

fix [] = []
fix (c:s) | isDigit c = c:fix s
fix (' ':cs)
		| rest /= [] && isDigit (head rest) = ' ':fix rest
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix (',':cs)
		| rest /= [] && head rest /= '.' = ',':' ':fix rest
		| otherwise = ',':fix rest
	where
		rest = dropWhile (== ' ') cs
fix ('.':'.':'.':cs) =
		' ':'.':'.':'.':(fix rest)
	where
		rest = dropWhile (== ' ') cs

solve = dropWhile (== ' ') . fix . dropWhileEnd (== '\n')

main = interact solve

import Char (isDigit)

--------------------------------------------------------------------------------
{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "#1" $ assertEq "1, 2, 3, ..., 10" $ solve "1,2 ,3,...,     10",
    Test "#2" $ assertEq "1, , , 4 ...5 ... ...6" $ solve "1,,,4...5......6",
    Test "#3" $ assertEq "..., 1, 2, 3, ..." $ solve "...,1,2,3,..."
  ]

testEmpty :: Test
testEmpty  =  TestList "TestEmpty"
  [
    Test "#1" $ assertEq "" $ solve "",
    Test "#2" $ assertEq "" $ solve " "
  ]

testTwoNumbers :: Test
testTwoNumbers  =  Test "TestTwoNumbers" $ assertEq "1 2" $ solve "1 2"

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    testEmpty,
    testTwoNumbers
  ]
-}
--------------------------------------------------------------------------------

data State  =  Start | Number | Comma | Dots | Space

isComma c  =  c == ','
isDot c    =  c == '.'
isSpace c  =  c == ' '

solve :: String -> String
solve s  =  solve' Start s
  where
    solve' _ []  =  []
    solve' Start (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Start cs
    solve' Number (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Space cs
    solve' Comma (c:cs)
      | isDigit c  =  ' ' : c : solve' Number cs
      | isComma c  =  ' ' : c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Comma cs
    solve' Dots (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Dots cs
    solve' Space (c:cs)
      | isDigit c  =  ' ' : c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Space cs

main :: IO ()
main  =  getLine >>= putStrLn . solve

import Data.Char
import Data.List

fix [] = []
fix (c:s) | isDigit c = c:(fix s)
fix (' ':cs)
		| rest /= [] && isDigit (head rest) = ' ':(fix rest)
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix (',':cs)
		| rest /= [] && head rest /= '.' = ',':' ':(fix rest)
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix ('.':'.':'.':cs) =
		' ':'.':'.':'.':(fix rest)
	where
		rest = dropWhile (== ' ') cs

solve = dropWhile (== ' ') . fix . dropWhileEnd (== '\n')

main = interact solve

import Data.Char

main = getLine >>= putStrLn . solve

solve = put . get

get :: String -> [String]
put :: [String] -> String

get "" = []
get (' ':xs) = get xs
get (',':xs) = "," : get xs
get ('.':'.':'.':xs) = "..." : get xs
get xs = let (as,bs) = break (not . isDigit) xs
         in as : get bs

put xs = let
  leftSp = map (=="...") xs
  rightSp = map (==",") xs
  sp = False : zipWith (||) (tail leftSp) rightSp
  in concat $ zipWith (\flag x -> if flag then " "++x else x) sp xs

import Data.Char
poly (r1:' ':r2:rs) s | not (isDigit r1 && isDigit r2) && not (r2 == ',') = poly (r1:r2:rs) s
poly (' ':' ':r':rs) ss | isDigit r' = poly (' ':r':rs) ss
poly r@(' ':r':rs) (s:ss) | isDigit r' = poly (s:r) ss
poly r@(' ':',':rs) (' ':ss) = poly r ss
poly r@(' ':',':rs) (s:ss) = poly (s:r) ss
poly (' ':rs) ss = poly rs ss
poly r@(',':rs) (s:ss) | s /= ' ' = poly (' ':r) (s:ss)
poly r@(',':rs) [] = r
poly r [] = r
poly r@(r':rs) ('.':'.':'.':ss) | r' /= ' ' = poly ('.':'.':'.':' ':r) ss
poly r@(r':rs) ('.':'.':'.':ss) | r' == ' ' = poly ('.':'.':'.':r) ss
poly r (s:ss) = poly (s:r) ss
main = do
    l <- getLine
    putStrLn $ reverse $ poly [] l


import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

data Frac = Frac Integer Integer
  deriving (Eq)
mkFrac :: Integer -> Integer -> Frac
mkFrac p q
  | p == 0 = Frac 0 1
  | q' < 0 = Frac (-p') (-q')
  | otherwise = Frac p' q'
  where (p', q', g) = (div p g, div q g, gcd p q)
instance Num Frac where
  (Frac p1 q1) + (Frac p2 q2) = mkFrac (p1 * q2 + p2 * q1) (q1 * q2)
  (Frac p1 q1) - (Frac p2 q2) = mkFrac (p1 * q2 - p2 * q1) (q1 * q2)
  (Frac p1 q1) * (Frac p2 q2) = mkFrac (p1 * p2) (q1 * q2)
  negate (Frac p q) = Frac (negate p) q
  abs (Frac p q) = Frac (abs p) q
  signum (Frac p _) = Frac (signum p) 1
  fromInteger n = Frac n 1
instance Ord Frac where
  compare (Frac p1 q1) (Frac p2 q2) = compare (p1 * q2) (p2 * q1)
instance Show Frac where
  show (Frac p q) = show p ++ "/" ++ show q

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- zip [1..n] <$> getInts
    let calc p q = mkFrac (toInteger p) (toInteger q)
        pairs = [(calc (x1 * y2 - x2 * y1) (x1 - x2), calc (y2 - y1) (x2 - x1)) | (x1, y1) <- as, (x2, y2) <- as, x1 < x2]
        num = maximum $ (0:) $ map length $ group $ sort pairs
        result = floor $ (1 + sqrt (8 * fromIntegral num + 1 :: Double)) / 2 + 0.5
    return $ intDec (n - result) `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    aLi <- getInts n
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi

      score i = let
        ratio x y = toRational x / toRational y
        slopes = [ratio (a ! j - a ! i) (j - i) | j <- [i + 1 .. n]]
        opts = map length $ group $ sort slopes
        in  n - 1 - foldl' max 0 opts
    pure $ putInts [foldl' min n $ map score [1 .. n]]

type SP = State [P.ByteString]

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

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

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


count::Eq a=>[a]->a->Int
count c d=length $ filter (==d) c

gao::Int->Int->Int
gao a b  | (b `mod` 2)==0 = 0
		 | (a `mod` 2)==0 = 1
		 | otherwise = -1

main::IO()
main = do
	n<-getLine
	aa<-getLine
	bb<-getLine
	let
		game=zip aa bb
		num = count game ('1','1')
		num1 = ( count game ('1','0') ) + ( count game ('0','1') )
		--奇数 + 奇数 -1  偶数+奇数 + 1
		ans = (count aa '1') + ( num `mod` 2 )*2 - (count bb '1') + (gao num num1)
	if ans>0
	then
		putStrLn "First"
	else if ans==0
	then
		putStrLn "Draw"
	else putStrLn "Second"

data Winner = First | Second

main = do
    _ <-  getLine
    ss <- getLine
    ts <- getLine
    let sts = zip ss ts
    putStrLn.answer $ foldl game (First,0,0) $ both1 sts ++ either1 sts

both1 = filter (\(a,b) -> a == b && a =='1')
either1 = filter (\(a,b) -> a /= b)

game (First,pf,ps) ('1','1') = (Second,pf+1,ps)
game (First,pf,ps) ('1','0') = (Second,pf+1,ps)
game (First,pf,ps) ('0','1') = (Second,pf,ps)
game (Second,pf,ps) ('1','1') = (First,pf,ps+1)
game (Second,pf,ps) ('1','0') = (First,pf,ps)
game (Second,pf,ps) ('0','1') = (First,pf,ps+1)

answer (_,a,b)
    | a == b = "Draw"
    | a > b = "First"
    | a < b = "Second"

count::Eq a=>[a]->a->Int
count c d=length $ filter (==d) c

gao::Int->Int->Int
gao a b  | (b `mod` 2)==0 = 0
		 | (a `mod` 2)==0 = 1
		 | otherwise = -1

main::IO()
main = do
	n<-getLine
	aa<-getLine
	bb<-getLine
	let
		game=zip aa bb
		num = count game ('1','1')
		num1 = ( count game ('1','0') ) + ( count game ('0','1') )
		ans = (count aa '1') + ( num `mod` 2 )*2 - (count bb '1') + (gao num num1)
	if ans>0
	then
		putStrLn "First"
	else if ans==0
	then
		putStrLn "Draw"
	else putStrLn "Second"


import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt ((length t + 1) `div` 2) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res

import Data.List (sortBy)
import Data.Array.Unboxed
import Control.Monad (guard)
import Control.Applicative ((<|>))
import qualified Data.IntMap as M
getEl m e = M.update (\x -> if x == 1 then Nothing else Just (x - 1)) e m
main = do
    [n, m] <- (map read . words) `fmap` getLine
    let f m a i | i < n = let
                f' | i == n - 1 = (`notElem` [a!0, a!(n-2)])
                   | otherwise = (/= a!(i-1)) in
                        foldl (\c k -> c <|> f (getEl m k)
                            (a // [(i, k)]) (i+1))
                            Nothing $ filter f' $ map fst $
                            sortBy (\(_, a) (_, b) -> compare b a) $ M.assocs m
                | otherwise = Just (elems a)
    t' <- (map read . words) `fmap` getLine
    let t = M.fromList $ zip [1..] t'
    let r = do
        let s = sum t'
            mt = maximum t'
        guard ((s - mt) >= n `div` 2)
        guard (s >= n)
        f (getEl t 1) (array (0, n-1) [(0,1)]:: UArray Int Int) 1
    putStrLn $ case r of
        Nothing -> "-1"
        Just l -> unwords $ map show $ l

import List
g 0 _=Just[]
g n[]=Nothing
g n(h:t)=fmap(m:)(g(n-m)t)where m=min h n
i([],t2)=t2
i(t1,[])=t1
i((a:x),(b:y))=a:b:i(x,y)
c t=i$splitAt((length t+1)`div`2)t
s[[n,_],t]=g n$map(min$n`div`2)t
main=interact$maybe"-1"(unwords.map show.c.(>>=uncurry replicate).sort.(`zip`[1..])).s.map(map read.words).lines

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt (length t `div` 2) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt (length t `div` 2 + 1) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res


import Data.Set as S
main = interact solve
solve input = output where
  inputs = lines input
  [k, n, m] = Prelude.map (read:: String -> Int) $ words $ head inputs
  s = fromList [(i,j,l)|i<-[0..k-1], j<-[0..n-1], l<-[0..m-1],
    (init $ drop 2 inputs)!!(i*(n+1)+j)!!l == '.']
  [x, y] = Prelude.map (read:: String -> Int) $ words $ last inputs
  output = show $ size s - (size $ f s [(0,x-1,y-1)])
  f :: Set (Int,Int,Int) -> [(Int,Int,Int)] -> Set (Int,Int,Int)
  f x [] = x
  f x ((i,j,l):xs) = if member (i,j,l) x
    then f (delete (i,j,l) x) (xs ++ [(i-1,j,l),(i+1,j,l),(i,j-1,l),(i,j+1,l),(i,j,l-1),(i,j,l+1)])
    else f x xs

module Main where

import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array.Unboxed
import Data.Array.ST

fillWater :: Int -> Int -> UArray (Int,Int,Int) Bool -> Int
fillWater x y plate = runST $ do
    let (_, (u,v,w)) = bounds plate
    visited <- newArray (bounds plate) False :: ST s (STUArray s (Int,Int,Int) Bool)

    let dfs x y z =
            if x < 1 || y < 1 || z < 1 || x > u || y > v || z > w || plate ! (x,y,z)
                then return 0
                else do
                    ptVisited <- readArray visited (x,y,z)
                    if ptVisited
                        then return 0
                        else do
                            writeArray visited (x,y,z) True
                            ( (1+) . sum ) `liftM` mapM (\(dx,dy,dz) -> dfs (x+dx) (y+dy) (z+dz))
                                [(1,0,0)
                                ,(-1,0,0)
                                ,(0,1,0)
                                ,(0,-1,0)
                                ,(0,0,1)
                                ,(0,0,-1)]

    dfs 1 x y

main = do
    [w,u,v] <- ( map read . words ) `liftM` getLine
    plateInput <- join `liftM` replicateM w ( do
        getLine
        join `liftM` replicateM u ( do
            row <- getLine
            return $ map (=='#') row
            )
        )
    let plate = listArray ((1,1,1),(w,u,v)) plateInput :: UArray (Int,Int,Int) Bool

    getLine
    [x,y] <- ( map read . words ) `liftM` getLine

    --putStrLn $ show plate
    putStrLn $ show $ fillWater x y plate

import Data.Array.IO
main = do
    [k, n, m] <- map read `fmap` (words `fmap` getLine)
    ar <- concat `fmap` (mapM (\_ -> do
        getLine
        concat `fmap` (mapM (\_ -> (take m) `fmap` getLine) [1..n])) [1..k])
    getLine
    [x,y] <- map read `fmap` (words `fmap` getLine)
    arr <- newListArray ((1,1,1), (k, n, m)) ar:: IO (IOUArray (Int, Int, Int) Char)
    let neibs (i1, i2, i3) = filter (\(i1, i2, i3) -> i1 > 0 && i1 <= k && i2 > 0 &&
            i2 <=n && i3 > 0 && i3 <= m) [(i1+1,i2, i3), (i1-1, i2, i3),
            (i1, i2 - 1, i3), (i1, i2 + 1, i3), (i1, i2, i3-1), (i1, i2, i3+1)]
        search counter [] = return counter
        search counter (s:ss) = readArray arr s >>= \c -> if c == '#'
                then search counter ss else (do
                writeArray arr s '#'
                ns <- (map fst . filter ((=='.').snd)) `fmap` (mapM (\s' -> readArray arr s' >>=
                    \c -> return (s', c)) (neibs s))
                search (counter + 1) (ss ++ ns))
    cnt <- search 0 [(1,x,y)]
    print cnt


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

main = do
		n<- getLine
		putStrLn $ n ++ reverse n

main = getLine >>= \s -> putStrLn $ s ++ (reverse s)

main = do
       e<-getLine
       putStrLn $ e ++ (reverse e)

main = do
    line <- getLine
    putStrLn ((line) ++ (reverse line))

import Control.Applicative
import Data.List

main :: IO ()
main = do
    a <- getLine
    putStrLn $ a ++ reverse a

main = getLine >>= putStrLn . (\s -> s ++ reverse s)

main = do
    s <- getLine
    putStrLn (s ++ reverse s)

module Main where

main = do
  l <- getLine
  putStr $ l ++ reverse l ++ ['\n']

process :: String -> String
process s = s ++ (reverse s)

main :: IO ()
main = do
    s <- getLine
    putStrLn $ process s

main = do
	line <- getLine
	putStr line
	putStr $ reverse line


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Sequence ((<|),(|>),(><),ViewL(..),ViewR(..),viewl,viewr)
import qualified Data.Sequence as Seq

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getLine
  print . solve . merge $ map (Up . Seq.singleton) xs

data SeqUpDown = Up (Seq.Seq Int)
               | Down (Seq.Seq Int)

solve :: [SeqUpDown] -> Int
solve xss = go 0 xss
   where
     go !res [Up _] = res
     go !res xss = go (res+1) $ merge $ kill xss

kill :: [SeqUpDown] -> [SeqUpDown]
kill (Down xs:xss)|(x:<_)<-viewl xs = Up (Seq.singleton x) : kill xss
kill (xs:xss) = xs : kill xss
kill [] = []

merge :: [SeqUpDown] -> [SeqUpDown]
merge (Up xs:Up ys:rest)
  | xr < yl = merge (Up (xs><ys):rest)
  | Seq.null nxs && Seq.null nys = merge (Down (xs><ys):rest)
  | Seq.null nxs = Down (xs|>yl) : merge (Up nys:rest)
  | Seq.null nys = Up nxs : merge (Down (xr<|ys):rest)
  | otherwise = Up nxs : Down (xr<|yl<|Seq.empty) : merge (Up nys:rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Up xs:Down ys:rest)
  | xr < yl = Up xs : merge (Down ys:rest)
  | Seq.null nxs = merge (Down (xr<|ys):rest)
  | otherwise = Up nxs : merge (Down (xr<|ys):rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Down xs:Up ys:rest)
  | xr < yl = Down xs : merge (Up ys:rest)
  | Seq.null nys = merge (Down (xs|>yl):rest)
  | otherwise = Down (xs|>yl) : merge (Up nys:rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Down xs:Down ys:rest)
  | xr < yl = Down xs : merge (Down ys:rest)
  | otherwise = merge (Down (xs><ys):rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys

merge xss = xss

module Main where

type Node = (Int, Int)

main :: IO()
main = do
          n <- getLine
          line <- getLine
          let ls = reverse $ map (read) $ words line
          putStrLn $ show $ solve ls []

solve :: [Int] -> [Node] -> Int
solve [] _ = 0
solve (x:xs) stack = max (ans) (solve xs ((x, ans):nstack))
                     where nstack = dropWhile (\y -> x > fst(y)) stack
                           ans = calc (map (snd) (takeWhile (\y -> x > fst(y)) stack)) 0

calc :: [Int] -> Int -> Int
calc [] mx = mx
calc (x:xs) mx = calc xs (max (mx + 1) x)

module Main where

main :: IO()
main = do
          n <- readLn
          line <- getLine
          let ls = reverse $ map (read) $ words line
          putStrLn $ show $ solve ls [] n

solve :: [Int] -> [Int] -> Int -> Int
solve [] _ _ = 0
solve (x:xs) stack n = max ((length stack) - (length nstack)) (solve xs (x:nstack) (n - 1))
                       where nstack = dropWhile (x>) stack


import Data.Char (digitToInt)

digits :: Integer -> [Integer]
digits = fmap (fromIntegral . digitToInt) . show

solve :: Integer -> Int
solve x = length . takeWhile (> 9) $ iterations
  where
    iterations = iterate (sum . digits) x

main :: IO ()
main = do
  x <- readLn
  print $ solve x

import Data.Char

main = interact $ (++"\n") . show . solve . head . lines

digitsum :: String -> Int
digitsum = sum . map ((subtract $ ord '0') . ord)

solve :: String -> Int
solve [x] = 0
solve xs = 1 + (solve . show . digitsum) xs

import Data.Char

main = do getLine >>= print . length . takeWhile ((>1) . length) . iterate (show . sum . map digitToInt)

{-
  sum of digits
-}
module Main where

import Data.List
import Data.Char

addDigits :: String -> String
addDigits digits = show $ foldl (\acc c -> acc + digitToInt c) 0 digits

stringTrim :: String -> String
stringTrim = filter (not . isSpace)

main :: IO ()
main = interact (show . iterate 0 . stringTrim )
       where iterate cnt digits = case length digits of
                                    0 -> cnt
                                    1 -> cnt
                                    _ -> iterate (cnt+1) $ addDigits digits

module Main where

import Char

main = do
    inputN <- getLine
    let n = read inputN
    putStrLn $ show $ process n

process :: Integer -> Int
process n =
    if n<10
        then 0
        else (+) 1 $ process $ foldl ( \a b -> a + fromIntegral ( ord b ) - 48 ) 0 $ show n

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

sumDigit :: C.ByteString -> Int
sumDigit x
	| x == C.empty = 0
	| otherwise = sumDigit (C.tail x) + (digitToInt (C.head x))

solve :: C.ByteString -> Int
solve x
	| C.length x == 1 = 0
	| otherwise = solve ((C.pack . show . sumDigit) x) + 1

main = getLine >>= putStrLn . show . solve . C.pack

import Data.Char
solve :: String -> Int
solve [x] = 0
solve xs
    | ds < 10 = 1
    | otherwise = 1 + solve (show ds)
    where ds = sum . map digitToInt $ xs
main = interact $ show . solve . head . lines

--import CPUTime
import Char

bigTest :: String
bigTest = replicate 100000 '9'

next :: Int -> Int
next 0 = 0
next n = mod n 10 + next (div n 10)

solve :: Int -> Int
solve 0 = 0
solve n = solve' n 1
  where
    solve' n m
      |  n  <  10  =  m
      | otherwise  =  solve' (next n) (m + 1)

readDigits :: IO Int
readDigits = readDigits' (0, 0)
  where
    readDigits' (m, n) = do
      c <- getChar
      if (isDigit c) then readDigits' (m + digitToInt c, n + 1) else if (n == 1) then return 0 else return m

main = do
--  n <- readLn
--  t0 <- getCPUTime
--  let n = read bigTest
  n <- readDigits
  print $ solve n
--  t1 <- getCPUTime
--  putStr "Time = "
--  print (fromIntegral (t1 - t0) * 1e-12)

g s = if length s == 1 then 0
      else (succ . g . show . sum . (map (\x -> read [x]::Int))) s
main = putStrLn =<< fmap (show . g) getLine

import Data.Char

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
	| n<=9 = 1
	| otherwise = 1 + ans (dsum n)

main = do
	s <- map (\x -> ord x - ord '0') `fmap` getLine
	putStrLn $ show $ if length s==1 then 0 else ans (sum s)

import Data.Char
import Data.List

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
	| n<=9 = 1
	| otherwise = 1 + ans (dsum n)

main = do
	s <- map (\x -> ord x - ord '0') `fmap` getLine
	let sm = sum s
	let n = length s
	putStrLn $ show $ if n==1 then 0 else ans sm

import Data.Char
main = print . flip solve 0 =<< getLine
solve [_] a = a
solve ns a = solve (show . sum $ map digitToInt ns) $! a + 1

import Data.Char as Char

g :: String -> Int
g [_] = 0
g str = 1 + (g $ show $ sum $ map Char.digitToInt str)

main :: IO()
main = do
  str <- getLine
  print $ g str

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Data.Char

spell :: Integer -> Integer
spell = sum . map (toInteger . digitToInt) . show

solve :: Integer -> Integer
solve = loop 0
 where
  loop !n !x = case (x `quotRem` 10) of
    (q, r) | q == 0     -> n
           | otherwise  -> loop (n + 1) (spell x)

main :: IO ()
main = readLn >>= print . solve

import Data.Char (ord)
import Data.List (foldl')
default (Int)
main = do
    n <- getLine
    if length n == 1 then print 0 else do
        let f s n | n < 10 = n + s
                  | otherwise = f (s + m) d where (d, m) = n `divMod` 10
            f1 k n | n < 10 = k
                   | otherwise = f1 (k + 1) $! f 0 n
        print $ (f1 1 . foldl' (\a b -> a + ord b - ord '0') 0) n

import Char
import List

putAnsLn :: (Show a) => a -> IO ()
putAnsLn ans = putStrLn (show ans)

digitsum [] s = s
digitsum (n:ns) s = digitsum ns (s + (ord n) - 48)

solve n ans = if (length n) == 1 then
                  ans
              else
                  solve (show (digitsum n 0)) (ans+1)

main = do n <- getLine
          putAnsLn (solve n 0)

import Data.Char

main = do getLine >>= print . length . takeWhile ((>1) .length) . iterate (show . sum . map digitToInt)

import Data.Char
solve = loop 0

loop acc [_] = acc
loop acc foo = loop (1 + acc) (show (sum [digitToInt x | x <- foo]))

main = interact (show . solve . filter isDigit)

module Main where

import Char

main = do
    inputN <- getLine
    let n = read inputN
    putStrLn $ show $ process n

process n =
    if n<10
        then 0
        else (+) 1 $ process $ foldl ( \a b -> a + ord b - 48 ) 0 $ show n

import Data.Char
import Data.List

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
    | n==0 = 0
    | n<=9 = 1
    | otherwise = 1 + ans (dsum n)

main = do
    s <- fmap (sum . map (\x -> ord x - ord '0')) getLine
    putStrLn $ show $ ans s


import List
import Control.Monad
import qualified Data.Map as M

maxOne [] = 0
maxOne ss = 1 + (maximum $ map fst ss)

maxTwo [] = 0
maxTwo (x:[]) = max (1 + fst x) (snd x)
maxTwo ss = max (o1 + o2 + 2) t1
  where o1:o2:_ = sortBy (flip compare) $ map fst ss
        t1 = maximum $ map snd ss

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
  where
    children p r = delete p $ M.findWithDefault [] r adj
    go p root = (maxOne sub, maxTwo sub)
      where sub = map (go root) $ children p root

adjList edges = map ((\(x,y) -> (head x, y)).unzip).groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y)).nub.sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges. M.fromList .adjList $ edges

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
        e' = accumArray (flip (:)) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
        gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a $ (b'!!0)+(b'!!1), b'!!0)) $
                foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
        v <- getLine
        e <- getContents
        putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import List
import Control.Monad

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
    where
        children p r = delete p . snd. head $ (filter ((r==).fst) adj)++[(r,[])]
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sortBy (flip compare) $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges.adjList $ edges

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read (v ++ v) in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
        e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
        gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
                foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
        v <- getLine
        e <- getContents
        putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum $ 0:[fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ take (n - 1) $ lines e

import List
import Control.Monad
import qualified Data.Map as M

solve adj = show $ maximum [snd (go x y) * snd (go y x)
                            | x <- M.keys adj, y <- children (-1) x]
    where
        children p r = delete p $ (M.findWithDefault) [] r adj
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sort $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve.(M.fromList).adjList $ edges

import List
import Control.Monad

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
    where
        children p r = delete p . snd. head $ (filter ((r==).fst) adj)++[(r,[])]
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sort $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges.adjList $ edges


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let v = k `div` 2
  print $
    if odd k
      then min (solve as (v + 1)) (solve (tail $ init as) v)
      else min (solve (init as) v) (solve (tail as) v)

solve as v = search (check as v) 0 (10 ^ 9 + 1)

check as v a = space (sort $ map snd $ filter ((<= a) . fst) $ zip as [0..]) >= v

space [] = 0
space [i] = 1
space (a : b : is)
  | a + 1 == b = space (a : is)
  | otherwise = 1 + space (b : is)

search f l r
  | l >= r - 1 = r
  | f m = search f l m
  | otherwise = search f m r
  where
    m = (l + r) `div` 2

main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve n k as

solve :: Int -> Int -> [Int] -> Int
solve _ k as = min minOdd minEven
  where
    bounds = (1,10^9)
    minOdd = binSearch (checkOdds as k) bounds
    minEven = binSearch (checkEvens as k) bounds

binSearch :: (Int -> Bool) -> (Int,Int) -> Int
binSearch predi (lo,hi)
  | lo == hi = lo
  | predi lmid = binSearch predi (lo,lmid)
  | otherwise = binSearch predi (hmid,hi)
  where
    lmid = div (lo+hi) 2
    hmid = lmid+1

checkOdds ::  [Int] -> Int -> Int -> Bool
checkOdds _ 0 _ = True
checkOdds [] _ _ = False
checkOdds (a:as) k x
  | a<=x = checkEvens as (k-1) x
  | otherwise = checkOdds as k x

checkEvens :: [Int] -> Int -> Int -> Bool
checkEvens _ 0 _ = True
checkEvens [] _ _ = False
checkEvens (_:as) k x = checkOdds as (k-1) x

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

doMagic :: [Bool] -> [Bool]
doMagic l = reverse $ dropWhile (==True) $ reverse $ dropWhile (==True) l

getMaxLength1 :: Int -> [Bool] -> Int
getMaxLength1 x = length . concat . map head1 . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = length l - length stripped + getMaxLength1 x stripped
    where
        stripped = doMagic (map (<=x) l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

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

import Control.Monad
import Data.List

head' :: [Bool] -> [Bool]
head' l = if head l then l else [False]

dedup :: [Bool] -> [Bool]
dedup = concat . map head' . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x = length . dedup . map (<=x)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

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

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

head2 :: [Bool] -> [Bool]
head2 l = if not $ head l then [False]
          else if (mod (length l) 2) == 1 then tail l
               else l

doMagic :: [Bool] -> [Bool]
doMagic l = reverse $ dropWhile (==True) $ reverse $ dropWhile (==True) l

getMaxLength1 :: Int -> [Bool] -> Int
getMaxLength1 x = length . concat . map head1 . group

getMaxLength2 :: Int -> [Bool] -> Int
getMaxLength2 x = length . concat . map head2 . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = length l - length stripped + max (getMaxLength1 x stripped) (getMaxLength2 x stripped)
    where
        stripped = doMagic (map (<=x) l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

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

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

head2 :: [Bool] -> [Bool]
head2 l = if not $ head l then [False]
          else if (mod (length l) 2) == 1 then tail l
               else l

getMaxLength1 :: Int -> [Int] -> Int
getMaxLength1 x = length . concat . map head1 . group . map (<=x)

getMaxLength2 :: Int -> [Int] -> Int
getMaxLength2 x = length . concat . map head2 . group . map (<=x)

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = max (getMaxLength1 x l) (getMaxLength2 x l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

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

import Data.List

head' :: [Bool] -> [Bool]
head' l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

dedup :: [Bool] -> [Bool]
dedup = concat . map head' . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x = length . dedup . map (<=x)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

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