{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -funbox-strict-fields -O3 #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if checkAns cs then cs else []
-- solveEven n as = if check b1s b2s && checkAns cs then cs else []
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

checkAns :: [Int] -> Bool
checkAns (a1:a2:a3:as) = (a1-a2)*(a3-a2) > 0 && checkAns (a2:a3:as)
checkAns _ = True

check :: [Int] -> [Int] -> Bool
check =  (and .) . zipWith (/=)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if checkAns cs then cs else []
-- solveEven n as = if check b1s b2s && checkAns cs then cs else []
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

checkAns :: [Int] -> Bool
checkAns (a1:a2:a3:as) = (a1-a2)*(a3-a2) > 0 && checkAns (a2:a3:as)
checkAns _ = True

check :: [Int] -> [Int] -> Bool
check =  (and .) . zipWith (/=)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

-- {-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if checkAns cs then cs else []
-- solveEven n as = if check b1s b2s && checkAns cs then cs else []
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

checkAns :: [Int] -> Bool
checkAns (a1:a2:a3:as) = (a1-a2)*(a3-a2) > 0 && checkAns (a2:a3:as)
checkAns _ = True

check :: [Int] -> [Int] -> Bool
check =  (and .) . zipWith (/=)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s && checkAns cs then cs else []
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

checkAns :: [Int] -> Bool
checkAns (a1:a2:a3:as) = (a1-a2)*(a3-a2) > 0 && checkAns (a2:a3:as)
checkAns _ = True

check :: [Int] -> [Int] -> Bool
check =  (and .) . zipWith (/=)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))
import Data.Int (Int32)

readInt :: B8.ByteString -> Int32
readInt =  fromIntegral . fst . fromJust . B8.readInt

readInts :: B8.ByteString -> [Int32]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int32
  as <- readInts <$> B8.getLine :: IO [Int32]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int32] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int32 -> [Int32] -> [Int32]
solveEven n as = if checkAns cs then cs else []
-- solveEven n as = if check b1s b2s && checkAns cs then cs else []
  where
    m = fromIntegral n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

checkAns :: [Int32] -> Bool
checkAns (a1:a2:a3:as) = (a1-a2)*(a3-a2) > 0 && checkAns (a2:a3:as)
checkAns _ = True

check :: [Int] -> [Int] -> Bool
check =  (and .) . zipWith (/=)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if True then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check as bs =  or $ zipWith (==) as bs

-- check :: [Int] -> [Int] -> Bool
-- check =  (or .) . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
-- output [] = noLit
output [] = B8.unwords $ yesLit : map (B8.pack . show) [1,2]
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check as bs =  or $ zipWith (==) as bs

-- check :: [Int] -> [Int] -> Bool
-- check =  (or .) . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = yesLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check as bs =  or $ zipWith (==) as bs

-- check :: [Int] -> [Int] -> Bool
-- check =  (or .) . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords $ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check as bs =  or $ zipWith (==) as bs

-- check :: [Int] -> [Int] -> Bool
-- check =  (or .) . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)
import System.IO (hSetBuffering, stdout, BufferMode (NoBuffering))

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  B8.putStrLn . output $ if even n then solveEven n as else []

noLit :: B8.ByteString
yesLit :: B8.ByteString
noLit  = B8.pack "NO"
yesLit = B8.pack "YES\n"

output :: [Int] -> B8.ByteString
output [] = noLit
output as = B8.unwords$ yesLit : map (B8.pack . show) as

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m bs
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check =  (.) or . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as

{-# LANGUAGE Strict  #-}

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString.Char8 as B8
import Data.Maybe (fromJust)

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

readInts :: B8.ByteString -> [Int]
readInts = map readInt . B8.words

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t run

run :: IO ()
run = do
  n <- readInt <$> B8.getLine :: IO Int
  as <- readInts <$> B8.getLine :: IO [Int]
  -- n <- readLn :: IO Int
  -- as <- map read . words <$> getLine :: IO [Int]
  putStrLn . output $ if even n then solveEven n as else []

output :: [Int] -> String
output [] = "NO"
output as = "YES\n" ++ unwords (map show as)

solveEven :: Int -> [Int] -> [Int]
solveEven n as = if check b1s b2s then [] else cs
  where
    m = n `div` 2
    bs = sort as
    (b1s, b2s) = splitAt m as
    cs = interleave b1s b2s

check :: [Int] -> [Int] -> Bool
check =  (.) or . zipWith (==)

interleave :: [a] -> [a] -> [a]
interleave (a:as) (b:bs) = a : b : interleave as bs
interleave [] bs = bs
interleave as [] = as


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

solve :: [Int] -> String
solve a = let
  asor = sort a
  q = head asor
  fun x y = x == y || rem x q == 0
  in  if  and $ zipWith fun a asor  then  "YES"  else  "NO"

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

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> String
solve xs = if error == 0 then "YES" else "NO"
    where
        sorted = sort xs
        error = length $ filter (\(x, y) -> x /= y && mod x min_element /= 0) (zip xs sorted)
        min_element = minimum xs

deal :: IO()
deal = do
    getLine
    a <- map read . words <$> getLine
    putStrLn $ solve a

main :: IO()
main = getLine >>= flip replicateM_ deal . read

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

testCase :: IO a -> IO ()
testCase f = do
  t <- read <$> getLine
  replicateM_ t f

main = testCase $ do
  _ <- getLine
  v <- map read . words <$> getLine
  let m = minimum v
  let t = sort v
  if t == v || (foldl (\flag (a, b) -> flag && (a == b || b `mod` m == 0)) True $ zip t v)
    then putStrLn "Yes"
    else putStrLn "No"

module Main where

import Control.Monad
import Data.List

readWords :: Read a => IO [a]
readWords =
  fmap read . words <$> getLine

isSorted :: Ord a => [a] -> Bool
isSorted xs =
  GT `notElem` zipWith compare xs (tail xs)

taskSort :: [Int] -> [Int]
taskSort xs =
  let m = minimum xs
      indexed = zip [0..] xs
      isDivisable (_, x) = x `mod` m == 0
      (divisable, notDivisable) = partition isDivisable indexed
      (divIndices, divValues) = unzip divisable
      sortedDivisable = zip (sort divIndices) (sort divValues)
      -- sortedDivisable = uncurry zip . fmap sort . unzip $ divisable
      sortedAll = sort $ notDivisable ++ sortedDivisable
      (_, result) = unzip sortedAll
   in result

solve :: [Int] -> String
solve = asYesNo . isSorted . taskSort

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

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    xs <- readWords
    putStrLn $ solve xs

import Control.Monad -- for replicateM_
import Data.List -- for sort

solve :: [Int] -> String
solve xs = if error == 0 then "YES" else "NO"
    where
        sorted = sort xs
        error = length $ filter (\(x, y) -> x /= y && gcd x min_element == 1) (zip xs sorted)
        min_element = minimum xs

deal :: IO()
deal = do
    getLine
    a <- map read . words <$> getLine
    putStrLn $ solve a

main :: IO()
main = getLine >>= flip replicateM_ deal . read

module Main where

import Control.Monad
import Data.List

readWords :: Read a => IO [a]
readWords =
  fmap read . words <$> getLine

isSorted :: Ord a => [a] -> Bool
isSorted xs =
  GT `notElem` zipWith compare xs (tail xs)

taskSort :: [Int] -> [Int]
taskSort xs =
  let m = minimum xs
      indexed = zip [0..] xs
      isDivisable (_, x) = x `mod` m == 0
      (divisable, notDivisable) = partition isDivisable indexed
      (divIndices, divValues) = unzip divisable
      sortedDivisable = zip (sort divIndices) (sort divValues)
      -- sortedDivisable = uncurry zip . fmap sort . unzip $ divisable
      sortedAll = sort $ notDivisable ++ sortedDivisable
      (_, result) = unzip sortedAll
   in result

solve :: [Int] -> String
solve = asYesNo . isSorted . taskSort

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

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    getLine
    xs <- readWords
    print $ solve xs


import Data.Functor

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

solve :: Int -> [Int] -> String
solve n r
  | n == 1 && s == 1 = "YES"
  | n > 1 && n == s + 1 = "YES"
  | otherwise = "NO"
  where s = sum r

main = interact $ solve . map read . words
solve (n:r)
 | n == 1 && s == 1 = "YES"
 | n > 1 && n == s + 1 = "YES"
 | otherwise = "NO"
 where s = sum . take n $ r

check jacket = if length jacket == 1 then jacket !! 0 == 1 else sum [1 | x <- jacket, x == 0] == 1

output jacket = putStrLn ( if check jacket then "YES" else "NO" )

main = do
	n <- getLine
	raw_jacket <- getLine
	let jacket = [ read x :: Int | x <- ( words raw_jacket ) ]
	output jacket

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

main = do
    n <- getInt
    xs <- getInts
    if n == 1
    then if xs == [1] then putStrLn "YES" else putStrLn "NO"
    else if (filter (==0) xs) == [0] then putStrLn "YES" else putStrLn "NO"

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

msg = putStrLn . which "YES" "NO"

main = do
	getLine
	a <- getList
	if length a == 1
		then msg $ head a == 1
		else msg $ ( == length a - 1 ) $ length $ filter ( == 1 ) a

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    putStrLn (if sum m == n - fromEnum (n > 1) then "YES" else "NO")

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    putStrLn (
      if (n == 1 && head m == 1) || (n /= 1 && sum m == n - 1)
        then "YES" else "NO"
      )

main :: IO ()
main = do
    _ <- getLine
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    putStrLn (if sum m == length m - fromEnum (length m > 1) then "YES" else "NO")

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  xs <- getInts

  let f = if n == 1 then xs == [1] else length (filter (== 0) xs) == 1

  putStrLn $ if f then "YES" else "NO"

main = interact $ f . map read . words
f (a:b) = if max 1 (a - 1) == sum b then "YES\n" else "NO\n"

main = getContents >>= putStrLn . solve . map read . tail . words

solve [0] = "NO"
solve [1] = "YES"
solve ls = if sum ls == length ls - 1 then "YES" else "NO"

module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

  readInt :: String -> Int
  readInt s = read s :: Int

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  -- converting list to Set
  -- let mySet = S.fromList myList
  solve :: [Int] -> String
  solve [1] = "YES"
  solve [0] = "NO"
  solve xs =
    case (==1) $ length $ filter (==0) xs of
      True -> "YES"
      False -> "NO"

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . (map readInt) . words
    putStrLn $ solve xs

main = getContents >>= putStrLn . (\(n:l) -> if (n - 1) == (sum $ take n l) && n > 1 || n == 1 && head l == 1 then "YES" else "NO") . map read . words

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = getLine >> getList >>= putStrLn . which "YES" "NO" . ( == 1 ) . length . filter ( == 0 )

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	a <- getList
	putStrLn $ which "YES" "NO" $ ( == length a - 1 ) $ length $ filter ( == 1 ) a

a :: Int ->[Int] -> Bool
a r [] = r == 1
a r (x:xs) = a (r + 1 - x) xs

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    if n == 1 then
      if head m == 0 then
        print "NO"
        else
          print "YES"
      else
        if a 0 m then
          print "YES"
          else
            print "NO"

a :: Int -> [Int] -> Bool
a r [] = r == 1
a r (x:xs) = a (r + 1 - x) xs

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    let s = sum m
    if n == 1 then
      if head m == 0 then
        print "NO"
        else
          print "YES"
      else
        if sum m == n - 1 then
            putStrLn "YES"
        else
            putStrLn "NO"

a :: Int -> [Int] -> Bool
a r [] = r == 1
a r (x:xs) = a (r + 1 - x) xs

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    if n == 1 then
      if head m == 0 then
        print "NO"
        else
          print "YES"
      else
        if a 0 m then
          print "YES"
          else
            print "NO"

a :: Int -> [Int] -> Bool
a r [] = r == 1
a r (x:xs) = a (r + 1 - x) xs

main :: IO ()
main = do
    n_str <- getLine
    let n = read n_str :: Int
    m_str <- getLine
    let m = map read $ words m_str :: [Int]
    let s = sum m
    if n == 1 then
      if head m == 0 then
        print "NO"
        else
          print "YES"
      else
        if sum m == n - 1 then
            print "YES"
        else
            print "NO"

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  xs <- getInts

  let f = n == 1 && xs == [1] || length (filter (== 0) xs) == 1

  putStrLn $ if f then "YES" else "NO"

main = getContents >>= putStrLn . show . (\(n:l) -> if (n - 1) == (sum $ take n l) then "YES" else "NO") . map read . words

main = getContents >>= putStrLn . (\(n:l) -> if 1 == n || (n - 1) == (sum $ take n l) then "YES" else "NO") . map read . words

main = getContents >>= putStrLn . (\(n:l) -> if (n - 1) == (sum $ take n l) then "YES" else "NO") . map read . words


{-
instructions go here...
-}

module Main where

solve :: Int -> Int -> [[Int]]
solve n k = take n $ solve' [1 ..] [n*n, n*n-1 ..]
  where solve' :: [Int] -> [Int] -> [[Int]]
        solve' lower upper = row : solve' lower' upper'
          where lower' = drop (k - 1) lower
                upper' = drop (n - k + 1) upper
                row = take (k - 1) lower ++ (reverse $ take (n - k + 1) upper)
{-
solve :: Int -> Int -> [[Int]]
solve n k = take n $ solve' 1 (n*n)
  where solve' :: Int -> Int -> [[Int]]
        solve' lower upper = row : solve' lower' upper'
          where lower' = lower + (k - 1)
                upper' = upper - (n - k - 1)
                row = [lower .. (lower' - 1)] ++ [(upper' + 1) .. upper]
-}

kTableSum :: [[Int]] -> Int -> Int
kTableSum kTable k = sum $ map (!! (k - 1)) kTable

kTableToStr :: [[Int]] -> String
kTableToStr rows = unlines $ map (unwords . numsToStrings) rows
  where numsToStrings = map show :: [Int] -> [String]

main :: IO ()
main = do
  line <- getLine
  let [n, k] = map read (words line) :: [Int]
      ktable = solve n k
  putStrLn $ show $ kTableSum ktable k
  putStrLn $ kTableToStr ktable

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

getInts = fmap (map read . words) getLine
-- getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, k] <- getInts

  let
    (ls, rs) = splitAt (n*(k-1)) [1..n*n]
    ls' = if k == 1 then replicate n [] else ch (k-1) ls
    rs' = ch (n-k+1) rs
    r = zipWith (++) ls' rs'

    ch k = unfoldr (\s -> if null s then Nothing else Just $ splitAt k s)

  print $ sum $ transpose r !! (k-1)
  putStr $ unlines $ map (unwords . map show) r

{-# LANGUAGE TupleSections, MultiParamTypeClasses, ExistentialQuantification,
             RankNTypes, FlexibleContexts, DeriveFunctor #-}

import Control.Monad
import Control.Applicative
--import Control.Lens
--import Control.Zipper
import Control.Arrow
import qualified Data.Map as M
--import qualified Data.Vector as V
import qualified Data.Set as S
import Data.List
--import Debug.Trace
--import Control.Comonad
import Data.Monoid
--import Data.Functor.Foldable
--import Test.QuickCheck
import Data.Tree
--import Data.Machine
--import Data.Traversable
--import Data.Distributive
--import Linear
import Control.Monad.Cont

main = do
  [n, k] <- fmap (map read . words) getLine
  pprint $ solve n (k-1)

pprint :: ([[Int]], Int) -> IO ()
pprint (l, x) = print x >> mapM_ putStrLn rest
    where
      rest = map g l
      g x = x >>= \a -> show a ++ " "

solve :: Int -> Int -> ([[Int]], Int)
solve n k = (take n $ zipWith (++) pref suff, sumKs)
    where
      sumKs = sum $ map head (take n suff)
      pref = chunks k l
      suff = chunks (n-k) l'
      (l, l') = splitAt (k*n) [1..n*n]

chunks _ [] = (repeat [])
chunks x l = b : chunks x a
    where
      (b, a) = splitAt x l


import Control.Monad

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

routine :: IO ()
routine = do
  [a1,b1,q] <- (map read.words) <$> getLine
  queries <- replicateM q $ (map read.words) <$> getLine
  let (a,b) = (fromIntegral $ min a1 b1, fromIntegral $ max a1 b1)
    in putStrLn.unwords.map show $ map (solveQuery (a,b)) queries

upToN :: (Integer,Integer) -> Integer -> Integer
upToN (a,b) n = d*b + min m b
    where
      period = lcm a b
      (d,m) = divMod (n+1) period

solveQuery :: (Integer,Integer) -> [Integer] -> Integer
solveQuery (a,b) [l,r] = (r - f r) - ((l-1) - f (l-1))
  where
    f = upToN (a,b)

import qualified Data.List as L
import qualified Data.Array as A

f a b x = (x `mod` a) `mod` b

solve_one cycle acc xx = q*(acc A.! (cycle)) + (acc A.! r)
  where x = xx+0
        q = x `div` cycle
        r = x `mod` cycle

solve_query :: Integer -> A.Array Integer Integer -> [Integer] -> Integer
solve_query cycle acc [ll,rr] = (solve_one cycle acc (rr+1)) - (solve_one cycle acc ll)

solve :: (Integer,Integer,Integer,[[Integer]]) -> [Integer]
solve (a,b,q,queries) = map (solve_query cycle (A.listArray (0,cycle) acc)) queries
   where cycle = a*b
         numbers = init [0..cycle]
         mods_a = map (f a b) numbers
         mods_b = map (f b a) numbers
         is_diff = zipWith (\q w -> if q == w then 0 else 1) mods_a mods_b
         acc = scanl (+) 0 is_diff

parse_other :: [[Integer]] -> [(Integer,Integer,Integer,[[Integer]])]
parse_other ([a,b,q]:ss) = (a,b,q,take (fromInteger q) ss):(parse_other $ drop (fromInteger q) ss)
parse_other [] = []
parse_input ([t]:other) = parse_other other

main = interact $ unlines . map (unwords . map show) . map solve . parse_input . map (map read) . map words . lines

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

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

getIntegers :: IO [Integer]
getIntegers = map (fst . fromJust . C.readInteger) . C.words <$> C.getLine

main :: IO ()
main = do
  tt <- parseInt <$> C.getLine
  replicateM_ tt $ do
    [a, b, q] <- getIntegers
    let c = a * b `div` gcd a b
        d = max a b
        f n = (n `div` c) * (c - d) + max 0 (n `mod` c - d + 1)
    as <- replicateM (fromIntegral q) $ do
      [l, r] <- getIntegers
      return $ f r - f (l - 1)
    putStrLn $ unwords $ map show as

import qualified Data.List as L
import qualified Data.Array as V

f a b x = (x `mod` a) `mod` b

solve_query :: Integer -> Integer -> Integer -> V.Array Integer Integer -> [Integer] -> Integer
solve_query a b cycle acc [l,rr] = (q_r-q_l) * (acc V.! (cycle-1)) + (acc V.! (fromInteger (r `mod` cycle))) - (acc V.! (fromInteger (l`mod` cycle)))
  where r = rr+1
        q_l = l `div` cycle
        q_r = r `div` cycle

solve :: (Integer,Integer,Integer,[[Integer]]) -> [Integer]
solve (a,b,q,queries) = map (solve_query a b cycle (V.listArray (0,cycle-1) acc)) queries
   where cycle = a*b
         numbers = init [0..cycle]
         mods_a = map (f a b) numbers
         mods_b = map (f b a) numbers
         is_diff = zipWith (\q w -> if q == w then 0 else 1) mods_a mods_b
         acc = scanl (+) 0 is_diff

parse_other :: [[Integer]] -> [(Integer,Integer,Integer,[[Integer]])]
parse_other ([a,b,q]:ss) = (a,b,q,take (fromInteger q) ss):(parse_other $ drop (fromInteger q) ss)
parse_other [] = []
parse_input ([t]:other) = parse_other other

main = interact $ unlines . map (unwords . map show) . map solve . parse_input . map (map read) . map words . lines

import qualified Data.List as L
import qualified Data.Array as A

f a b x = (x `mod` a) `mod` b

solve_one cycle acc xx = q*(acc A.! (cycle)) + (acc A.! r)
  where x = xx+1
        q = x `div` cycle
        r = x `mod` cycle

solve_query :: Integer -> A.Array Integer Integer -> [Integer] -> Integer
solve_query cycle acc [ll,rr] = (solve_one cycle acc (rr+1)) - (solve_one cycle acc ll)

solve :: (Integer,Integer,Integer,[[Integer]]) -> [Integer]
solve (a,b,q,queries) = map (solve_query cycle (A.listArray (0,cycle) acc)) queries
   where cycle = a*b
         numbers = init [0..cycle]
         mods_a = map (f a b) numbers
         mods_b = map (f b a) numbers
         is_diff = zipWith (\q w -> if q == w then 0 else 1) mods_a mods_b
         acc = scanl (+) 0 is_diff

parse_other :: [[Integer]] -> [(Integer,Integer,Integer,[[Integer]])]
parse_other ([a,b,q]:ss) = (a,b,q,take (fromInteger q) ss):(parse_other $ drop (fromInteger q) ss)
parse_other [] = []
parse_input ([t]:other) = parse_other other

main = interact $ unlines . map (unwords . map show) . map solve . parse_input . map (map read) . map words . lines


import Data.List (elemIndex)
import Data.Maybe (fromJust)

main :: IO ()
main = getContents >>= printSolution . solve 0 . map read . tail . words
  where printSolution xs = print (length xs) >> mapM_ (putStrLn . unwords . map show) xs

solve :: Int -> [Int] -> [[Int]]
solve _ [] = []
solve i aas@(a:as) = (if j > 0 then ([i, i + j]:) else id) (solve (i + 1) [ if j == k then a else b | (k, b) <- zip [1..] as ])
  where j = fromJust $ elemIndex (minimum aas) aas

import qualified Data.List as List

argMin :: [Int] -> (Int, Int)
argMin [v] = (v, 0)
argMin (x : xs) = (v', p')
    where (v, p) = argMin xs
          p' = if v < x then p + 1 else 0
          v' = min x v

replace :: [Int] -> Int -> Int -> [Int]
replace (x : xs) 0 v = v : xs
replace (x : xs) p v = x : replace xs (p - 1) v

solve :: [Int] -> [Int]
solve [] = []
solve all@(x : xs) = let (_, p) = argMin all
                         rs = if (p == 0) then xs else replace xs (p - 1) x
                      in p : solve rs

main = do
    getLine
    input <- getLine
    let swap = solve $ map read $ words input
        n = length swap
    print n
    mapM putStrLn $ map unwords $ zipWith (\x y -> [show x, show (x + y)]) [0 .. ] swap

import Data.List (elemIndex)
import Data.Maybe (fromJust)

main :: IO ()
main = getContents >>= printSolution . solve 0 . map read . tail . words
  where printSolution xs = print (length xs) >> mapM_ (putStrLn . unwords . map show) xs

solve :: Int -> [Int] -> [[Int]]
solve _ [] = []
solve i as = (if j > Just 0 then ([i, i + fromJust j]:) else id) (solve (i + 1) [ if j == Just k then head as else a | (k, a) <- zip [1..] (tail as) ])
  where j = elemIndex (minimum as) as

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I

process [x] = putStrLn "0 0"
process t = do
		let z = fromJust(elemIndex (maximum t) t)
		let lt = length t - 1
		putStrLn $ show z ++ " "++ show lt
		let nt = init (take z t ++ [t!!lt] ++ (drop (z+1) t))
		process nt

main=do
	s<- getLine
	t<- map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	print $ length t
	process t

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I

process [x] = putStrLn "0 0"
process t = do
		let z = fromJust(elemIndex (maximum t) t)
		let lt = length t - 1
		putStrLn $ show z ++ " "++ show lt
		let nt = init (take (z-1) t ++ [t!!lt] ++ (drop (z+1) t))
		process nt

main=do
	s<- getLine
	t<- map (fst.fromJust.C.readInt). C.words <$> C.getLine ::IO [Int]
	print $ length t
	process t


import Control.Monad ( replicateM, replicateM_ )
import Data.Array ( (!) )
import Data.Bits ( Bits(testBit, (.&.), xor) )
import Data.Graph ( buildG )
import Data.List ( sort )
import Data.Tuple ( swap )
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

data Queue a = Queue [a] [a] deriving Show

empty :: Queue a -> Bool
empty (Queue [] []) = True
empty _             = False

push :: a -> Queue a -> Queue a
push x (Queue a b) = Queue (x:a) b

pop :: Queue a -> (a, Queue a)
pop (Queue [] [])    = error "empty"
pop (Queue a (x:xs)) = (x, Queue a xs)
pop (Queue a [])     = pop $ Queue [] (reverse a)

solve :: IO ()
solve = do
    n <- readInt
    e <- replicateM (n * 2^(n - 1)) $ do
        [u, v] <- readInts
        return (u, v)
    let g = buildG (0, 2^n - 1) (e ++ map swap e)
        go :: S.IntSet -> Int -> Int -> [Int]
        go un u v | S.size un == 2 = [u, v]
        go un u v =
            let (r0, u0, v0, r1, u1, v1) = bfs un (Queue [] [u]) (S.singleton u) (Queue [] [v]) (S.singleton v)
                r0' = go r0 u0 v0
                r1' = match un r0' r1
            in r0' ++ r1'
        bfs :: S.IntSet -> Queue Int -> S.IntSet -> Queue Int -> S.IntSet -> (S.IntSet, Int, Int, S.IntSet, Int, Int)
        bfs un q0 a0 q1 a1
            | empty q0 = (a0, -1, -1, a1, -1, -1)
            | otherwise =
                let (u, q0') = pop q0
                    ok v = v `S.notMember` a0 && v `S.notMember` a1 && v `S.member` un
                    nbs = filter ok (g!u)
                    a0' = foldr S.insert a0 nbs
                    q0'' = foldr push q0' nbs
                    (r1, u1, v1, r0, _, _) = bfs un q1 a1 q0'' a0'
                in (r0, u, head nbs, r1, u1, v1)
        match :: S.IntSet -> [Int] -> S.IntSet -> [Int]
        match un r0 r1 =
            let ok v = v `S.member` r1 && v `S.member` un
            in map (head . filter ok . (g!)) r0
        canColor = n .&. (n - 1) == 0
        color u = foldr xor 0 [i | i <- [0..n - 1], u `testBit` i]
    let (u, v) = head e
        p = go (S.fromList [0..2^n - 1]) u v
        invP = map snd $ sort $ zip p [0..]
        pStr = unwords $ map show p
        cStr = unwords $ map show $ [color (i :: Int) | i <- invP]
    putStrLn pStr
    putStrLn $ if canColor then cStr else "-1"

parseInt = getInt . C.readInt where getInt (Just (i, _)) = i
readInt = parseInt <$> C.getLine
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
    t <- readInt
    replicateM_ t solve

import Control.Monad ( replicateM, replicateM_ )
import Data.Array ( (!) )
import Data.Bits ( Bits(testBit, (.&.), xor) )
import Data.Graph ( buildG )
import Data.List ( sort )
import Data.Tuple ( swap )
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as S

data Queue a = Queue [a] [a] deriving Show

empty :: Queue a -> Bool
empty (Queue [] []) = True
empty _             = False

push :: a -> Queue a -> Queue a
push x (Queue a b) = Queue (x:a) b

pop :: Queue a -> (a, Queue a)
pop (Queue [] [])    = error "empty"
pop (Queue a (x:xs)) = (x, Queue a xs)
pop (Queue a [])     = pop $ Queue [] (reverse a)

solve :: IO ()
solve = do
    n <- readInt
    e <- replicateM (n * 2^(n - 1)) $ do
        [u, v] <- readInts
        return (u, v)
    let g = buildG (0, 2^n - 1) (e ++ map swap e)
        go :: S.IntSet -> Int -> Int -> [Int]
        go un u v | S.size un == 2 = [u, v]
        go un u v =
            let (r0, u0, v0, r1, u1, v1) = bfs un (Queue [] [u]) (S.singleton u) (Queue [] [v]) (S.singleton v)
                r0' = go r0 u0 v0
                r1' = match un r0' r1
            in r0' ++ r1'
        bfs :: S.IntSet -> Queue Int -> S.IntSet -> Queue Int -> S.IntSet -> (S.IntSet, Int, Int, S.IntSet, Int, Int)
        bfs un q0 a0 q1 a1
            | empty q0 = (a0, -1, -1, a1, -1, -1)
            | otherwise =
                let (u, q0') = pop q0
                    ok v = v `S.notMember` a0 && v `S.notMember` a1 && v `S.member` un
                    nbs = filter ok (g!u)
                    a0' = foldr S.insert a0 nbs
                    q0'' = foldr push q0' nbs
                    (r1, u1, v1, r0, _, _) = bfs un q1 a1 q0'' a0'
                in (r0, u, head nbs, r1, u1, v1)
        match :: S.IntSet -> [Int] -> S.IntSet -> [Int]
        match un r0 r1 =
            let ok v = v `S.member` r1 && v `S.member` un
            in map (head . filter ok . (g!)) r0
        canColor = n .&. (n - 1) == 0
        color :: Int -> Int
        color u = foldr xor 0 $ filter (testBit u) [0..n - 1]
    let (u, v) = head e
        p = go (S.fromList [0..2^n - 1]) u v
        invP = map snd $ sort $ zip p [0..]
        pStr = unwords $ map show p
        cStr = unwords $ map (show . color) invP
    putStrLn pStr
    putStrLn $ if canColor then cStr else "-1"

parseInt = getInt . C.readInt where getInt (Just (i, _)) = i
readInt = parseInt <$> C.getLine
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = do
    t <- readInt
    replicateM_ t solve

import Control.Monad ( replicateM, replicateM_ )
import Data.Array ( (!) )
import Data.Bits ( Bits(testBit, (.&.), xor) )
import Data.Graph ( buildG )
import Data.List ( sort )
import Data.Tuple ( swap )
import qualified Data.IntSet as S

data Queue a = Queue [a] [a] deriving Show

empty :: Queue a -> Bool
empty (Queue [] []) = True
empty _             = False

push :: a -> Queue a -> Queue a
push x (Queue a b) = Queue (x:a) b

pop :: Queue a -> (a, Queue a)
pop (Queue [] [])    = error "empty"
pop (Queue a (x:xs)) = (x, Queue a xs)
pop (Queue a [])     = pop $ Queue [] (reverse a)

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    e <- replicateM (n * 2^(n - 1)) $ do
        [u, v] <- readMany :: IO [Int]
        return (u, v)
    let g = buildG (0, 2^n - 1) (e ++ map swap e)
        go :: S.IntSet -> Int -> Int -> [Int]
        go un u v | S.size un == 2 = [u, v]
        go un u v =
            let (r0, u0, v0, r1, u1, v1) = bfs un (Queue [] [u]) (S.singleton u) (Queue [] [v]) (S.singleton v)
            in go r0 u0 v0 ++ go r1 u1 v1
        bfs :: S.IntSet -> Queue Int -> S.IntSet -> Queue Int -> S.IntSet -> (S.IntSet, Int, Int, S.IntSet, Int, Int)
        bfs un q0 a0 q1 a1
            | empty q0 = (a0, -1, -1, a1, -1, -1)
            | otherwise =
                let (u, q0') = pop q0
                    ok v = v `S.notMember` a0 && v `S.notMember` a1 && v `S.member` un
                    nxt = filter ok (g!u)
                    a0' = foldr S.insert a0 nxt
                    q0'' = foldr push q0' nxt
                    (r1, u1, v1, r0, u0, v0) = bfs un q1 a1 q0'' a0'
                    (u0', v0') = if null nxt then (u0, v0) else (u, head nxt)
                in (r0, u0', v0', r1, u1, v1)
        canColor = n .&. (n - 1) == 0
        color u = foldr xor 0 [i | i <- [0..n - 1], u `testBit` i]
    let (u, v) = head e
        p = go (S.fromList [0..2^n - 1]) u v
        invP = map snd $ sort $ zip p [0..]
        pStr = unwords $ map show p
        cStr = unwords $ map show $ [color (i :: Int) | i <- invP]
    putStrLn pStr
    putStrLn $ if canColor then cStr else "-1"

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

import Control.Monad ( replicateM, replicateM_ )
import Data.Array ( (!) )
import Data.Bits ( Bits(testBit, (.&.), xor) )
import Data.Graph ( buildG )
import Data.List ( sort )
import Data.Tuple ( swap )
import qualified Data.IntSet as S

data Queue a = Queue [a] [a] deriving Show

empty :: Queue a -> Bool
empty (Queue [] []) = True
empty _             = False

push :: a -> Queue a -> Queue a
push x (Queue a b) = Queue (x:a) b

pop :: Queue a -> (a, Queue a)
pop (Queue [] [])    = error "empty"
pop (Queue a (x:xs)) = (x, Queue a xs)
pop (Queue a [])     = pop $ Queue [] (reverse a)

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    e <- replicateM (n * 2^(n - 1)) $ do
        [u, v] <- readMany :: IO [Int]
        return (u, v)
    let g = buildG (0, 2^n - 1) (e ++ map swap e)
        go :: S.IntSet -> Int -> Int -> [Int]
        go un u v =
            let (r0, u0, v0, r1, u1, v1) = bfs un (Queue [] [u]) (S.singleton u) (Queue [] [v]) (S.singleton v)
            in if u0 == -1 then [S.findMin r0, S.findMin r1] else go r0 u0 v0 ++ go r1 u1 v1
        bfs :: S.IntSet -> Queue Int -> S.IntSet -> Queue Int -> S.IntSet -> (S.IntSet, Int, Int, S.IntSet, Int, Int)
        bfs un q0 a0 q1 a1
            | empty q0 = (a0, -1, -1, a1, -1, -1)
            | otherwise =
                let (u, q0') = pop q0
                    ok v = v `S.notMember` a0 && v `S.notMember` a1 && v `S.member` un
                    nxt = filter ok (g!u)
                    a0' = foldr S.insert a0 nxt
                    q0'' = foldr push q0' nxt
                    (r1, u1, v1, r0, u0, v0) = bfs un q1 a1 q0'' a0'
                    (u0', v0') = if null nxt then (u0, v0) else (u, head nxt)
                in (r0, u0', v0', r1, u1, v1)
        canColor = n .&. (n - 1) == 0
        color u = foldr xor 0 [i | i <- [0..n - 1], u `testBit` i]
    let (u, v) = head e
        p = go (S.fromList [0..2^n - 1]) u v
        pStr = unwords $ map show p
        invP = map snd $ sort $ zip p [0..]
        cStr = unwords $ map show $ [color (i :: Int) | i <- invP]
    putStrLn pStr
    putStrLn $ if canColor then cStr else "-1"

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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


main = do line <- getLine
          let [n, t, c] = (map read $ words line) :: [Int]
          line <- getLine
          let xs = (map read $ words line) :: [Int]
          putStrLn $ show $ countCrime xs t c

countCrime :: [Int] -> Int -> Int -> Int
countCrime xs t c = count badGuys 0 0
    where badGuys = map (\ x -> x > t) xs
          count [] acc cur = acc + (max (cur - c + 1) 0)
          count (True : xs) acc cur  = count xs newAcc 0
              where newAcc = acc + (max (cur - c + 1) 0)
          count (False : xs) acc cur = count xs acc (cur + 1)

split as [] l t c = if l >= c then (l-c+1:as) else as
split as (b:bs) l t c =
  if b > t
    then split (if l >= c then (l-c+1:as) else as) bs 0 t c
    else split as bs (l+1) t c

main = do
  let getInts = getLine >>= return . map (\x -> read x :: Int) . words
  [n,t,c] <- getInts
  is <- getInts
  print $ sum $ split [] is 0 t c

f t xs = let (l,ys) = span (<=t) xs in if ys == [] then if l==[] then [] else l:[]  else if l == [] then (f t $ tail ys) else l:(f t $ tail ys)

count c t = (\x -> if x<c then 0 else x-c+1) . length

codeforces t c = sum . (map $ count c t) . f t

main = do
	[_,t,c] <- getLine >>= return . map (read :: String -> Int) . words
	res <- getLine >>= return . codeforces t c . map (read :: String -> Int) . words
	print res

import Data.List (group)

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

solve :: [Int] -> Int
solve (_:t:c:xs) = sum $ filter (>0) $ map (subtract (c - 1) . length) $ filter head $ group $ map (<=t) xs
solve _ = undefined

import Data.List
main=interact$show.f.map read.words
f (_:t:c:xs)=sum$filter(>0)$map((+(1-c)).length)$filter head$group$map(<=t)xs

import Data.List
strToList = (fmap (read :: (String -> Int))).words
f [] _ _ = 0
f xs t c = let (a, b) = break (>t) (dropWhile (>t) xs) in max 0 (length a - c + 1) + f b t c
main = do
    [n, t, c] <- fmap strToList getLine
    s <- fmap strToList getLine
    putStrLn $ show (f s t c)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

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

solve :: Int -> Int -> [Int] -> Int
solve t c xs = go 0 xs
   where
     go !res [] = res
     go !res xs = go (res + max 0 (len - c + 1)) zs
      where
        (ys, zs) = dropWhile (t<) <$> span (<=t) xs
        !len = length ys

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

main :: IO ()
main = do
	[_,t,c] <- inputInts
	print =<< sum . filter (>0) . map (subtract (c - 1) . length) . filter head . group . map (<= t) <$> inputInts

main = do
    s1<-getLine
    s2<-getLine
    putStr $ res((map read.words)s1)((map read.words)s2)

res [n,t,c] x = solve n t c x 0
solve _ _ _ [] acc = show acc
solve n t c x acc
    |length(takeWhile (<=t) x)>=c   = solve n t c (dropWhile(<=t)x) (acc+1-c+length(takeWhile (<=t) x))
    |dropWhile(<=t)x==[]        = show acc
    |otherwise          = solve n t c (tail(dropWhile(<=t)x)) acc

import Data.List
import Control.Applicative

main :: IO ()
main = do
	inp <- (map read . words) <$> getLine
	xs <- (map read . words) <$> getLine
	print $ solve inp 0 xs

solve :: [Int] -> Int -> [Int] -> Int
solve _  _          []  = 0
solve [n, t, c] cnt (x : xs)
	| newCount >= c  = 1 + solve [n, t, c] newCount xs
	| otherwise =  solve [n, t, c] newCount xs
	where
		newCount = if x <= t then cnt + 1 else 0

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  C.getLine >>= \ns -> putStrLn.solve.(\as->[tail $ map (fst.fromJust.C.readInt) $ C.words ns]++[as]) =<< (C.getLine>>= \js -> return $ map (fst.fromJust.C.readInt) $ C.words js)
solve [[x1,x2],xs] = show $ slv2 slv1
  where
  slv1 = foldr f [0] xs
  f a (b:bs) = if a>x1 then (0:b:bs) else (b+1):bs
  slv2 ys = foldr (\ a b -> if a<x2 then b else a-x2+1+b) 0 ys

split as [] l t c = if l > 0 then (l-c+1:as) else as
split as (b:bs) l t c =
  if b > t
    then split (if l >= c then (l-c+1:as) else as) bs 0 t c
    else split as bs (l+1) t c

main = do
  let getInts = getLine >>= return . map (\x -> read x :: Int) . words
  [n,t,c] <- getInts
  is <- getInts
  print $ sum $ split [] is 0 t c

f t xs = let (l,ys) = span (<=t) xs in if ys == [] then if l==[] then [] else l:[]  else if l == [] then (f t $ tail ys) else l:(f t $ tail ys)

count c t = (\x -> if x<c then 0 else x-c+1) . length

codeforces t c = sum . (map $ count c t) . f t

main = do
	[_,t,c] <- getLine >>= return . map (read :: String -> Int) . words
	getLine >>= return . codeforces t c . map (read :: String -> Int) . words


{- ok -}
import Control.Applicative ((<$>))
import Data.Array (Array, (!))
import qualified Data.Array as Array
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Data.Tuple (swap)

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

readInt' = fst . fromJust . readInt

type Graph = Array Int [Int]

main = do
	[n, m] <- map readInt' . words <$> getLine
	edges <- map ((\[a, b] -> (a, b)) . map readInt' . words) . lines <$> getContents

	let
		search set
     			| Set.null set = []
      			| otherwise = cycle:(search set')
       			where
		  		(cycle, set') = dfs set (Set.findMin set) 0

				dfs set u w = dfs' (u `Set.delete` set) $ filter (/= w) $ g ! u
    					where
		 				dfs' set [] = (False, set)
		 				dfs' set (v:vs)
							| v `Set.notMember` set = (True, set)
						        | otherwise = (cycle1 || cycle2, set'')
		    					where
							   (cycle1, set') = dfs set v u
							   (cycle2, set'') = dfs' set' vs

				-- dfs set u w = foldl dfs' (False, vs') . filter (/= w) $ g ! u
				--	where
	     			--		vs' = u `Set.delete` vs

				--		dfs' (f, vs) v
				--			| v `Set.notMember` vs = (True, vs)
				--		        | otherwise = (f || f', vs')
       				--			where
				--			      (f', vs') = dfs vs v u

	 	comps = search $ Set.fromList [1..n]
		g = Array.accumArray (flip (:)) [] (1, n) $ edges ++ map swap edges

 	print . length . filter not $ comps

{- ok -}
import Control.Applicative ((<$>))
import Data.Array (Array, (!))
import qualified Data.Array as Array
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Data.Tuple (swap)

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

readInt' = fst . fromJust . readInt

type Graph = Array Int [Int]

main = do
	[n, m] <- map readInt' . words <$> getLine
	edges <- map ((\[a, b] -> (a, b)) . map readInt' . words) . lines <$> getContents

	let
		search set
     			| Set.null set = []
      			| otherwise = cycle:(search set')
       			where
		  		(cycle, set') = dfs set (Set.findMin set) 0

				dfs set u w = dfs' (u `Set.delete` set) $ filter (/= w) $ g ! u
    					where
		 				dfs' set [] = (False, set)
		 				dfs' set (v:vs)
							| v `Set.notMember` set = (True, set)
						        | otherwise = (cycle1 || cycle2, set'')
		    					where
							   (cycle1, set') = dfs set v u
							   (cycle2, set'') = dfs' set' vs

                                -- above is prettier ?
				-- dfs set u w = foldl dfs' (False, vs') . filter (/= w) $ g ! u
				--	where
	     			--		vs' = u `Set.delete` vs

				--		dfs' (f, vs) v
				--			| v `Set.notMember` vs = (True, vs)
				--		        | otherwise = (f || f', vs')
       				--			where
				--			      (f', vs') = dfs vs v u

	 	comps = search $ Set.fromList [1..n]
		g = Array.accumArray (flip (:)) [] (1, n) $ edges ++ map swap edges

 	print . length . filter not $ comps

import Control.Applicative ((<$>))
import Data.Array (Array, (!))
import qualified Data.Array as Array
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Data.Tuple (swap)

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

readInt' = fst . fromJust . readInt

type Graph = Array Int [Int]

main = do
	[n, m] <- map readInt' . words <$> getLine
	edges <- map ((\[a, b] -> (a, b)) . map readInt' . words) . lines <$> getContents

	let
		search vs
     			| Set.null vs = []
      			| otherwise = f : (search vs')
       			where
		  		(f, vs') = dfs vs (Set.findMin vs) (-1)
      					where
		  				u = Set.findMin vs

				dfs vs u w
					| u `Set.notMember` vs = (True, vs')
			   	        | otherwise = foldl next (False, vs') $ filter (/= w) $ g ! u
		    			where
		 				vs' = u `Set.delete` vs

       						next (f, vs) v = (f || f', vs')
		     					where
		    						(f', vs') = dfs vs v u

	 	comps = search $ Set.fromList [1..n]
		g = Array.accumArray (flip (:)) [] (1, n) $ edges ++ map swap edges

 	print . length . filter not $ comps

{- ok -}
import Control.Applicative ((<$>))
import Data.Array (Array, (!))
import qualified Data.Array as Array
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Data.Tuple (swap)

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

readInt' = fst . fromJust . readInt

type Graph = Array Int [Int]

main = do
	[n, m] <- map readInt' . words <$> getLine
	edges <- map ((\[a, b] -> (a, b)) . map readInt' . words) . lines <$> getContents

	let
		search vs
     			| Set.null vs = []
      			| otherwise = f : (search vs')
       			where
		  		(f, vs') = dfs vs (Set.findMin vs) 0

				dfs vs u w = foldl dfs' (False, vs') . filter (/= w) $ g ! u
					where
	     					vs' = u `Set.delete` vs

						dfs' (f, vs) v
							| v `Set.notMember` vs = (True, vs)
						        | otherwise = (f || f', vs')
       							where
							      (f', vs') = dfs vs v u

	 	comps = search $ Set.fromList [1..n]
		g = Array.accumArray (flip (:)) [] (1, n) $ edges ++ map swap edges

 	print . length . filter not $ comps

{- ok -}
import Control.Applicative ((<$>))
import Data.Array (Array, (!))
import qualified Data.Array as Array
import Data.Set (Set)
import qualified Data.Set as Set
import Data.ByteString (getLine, getContents)
import Data.ByteString.Char8 (readInt, lines, words, unpack)
import Data.Maybe (fromJust)
import Data.Tuple (swap)

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

readInt' = fst . fromJust . readInt

type Graph = Array Int [Int]

main = do
	[n, m] <- map readInt' . words <$> getLine
	edges <- map ((\[a, b] -> (a, b)) . map readInt' . words) . lines <$> getContents

	let
		search vs
     			| Set.null vs = []
      			| otherwise = f : (search vs')
       			where
		  		(f, vs') = dfs vs (Set.findMin vs) 0

				dfs vs u w = foldl dfs' (False, vs') . filter (/= w) $ g ! u
					where
	     					vs' = u `Set.delete` vs

						dfs' (f, vs) v
							| u `Set.notMember` vs = (True, vs)
						        | otherwise = (f || f', vs')
       							where
							      (f', vs') = dfs vs v u

	 	comps = search $ Set.fromList [1..n]
		g = Array.accumArray (flip (:)) [] (1, n) $ edges ++ map swap edges

 	print . length . filter not $ comps


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

main= do
	s<-  C.tail. C.take 3 . C.reverse .C.filter (/=' ') <$> C.getLine
	let s1 = read (reverse (C.unpack s)) ::Int
	print $ if mod s1 4 ==0 then 4 else 0

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

solve :: Integer -> Integer
solve n | n `mod` 4 == 0 = 4 | otherwise = 0

main = putStrLn . solve =<< getLine
solve s | n `mod` 4 == 0 = "4" | otherwise = "0" where
  n = read $ reverse $ take 2 $ reverse s

module Main where

main = do
	line <- getLine
	let n = read line `mod` 4
	let ans = (1^n + 2^n + 3^n + 4^n) `mod` 5
	putStrLn $ show ans

main = do
    n <- fmap (read . reverse . take 2 . reverse) getLine :: IO Int
    print $ f n where
        f n
            | mod n 2 == 1 = 0
            | otherwise = let m = mod n 4 in mod (1 + 2^m + 3^m + 4^m) 5

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: BS.ByteString -> Int
solve s = if divisibleBy4 s then 4 else 0

divisibleBy4 :: BS.ByteString -> Bool
divisibleBy4 s =  toInt str `mod` 4 == 0
    where len = BS.length s
          str = if len < 2 then s else BS.drop (len - 2) s
          toInt = fst .fromJust . BS.readInt

-- Shit
main :: IO ()
main = do
        [[s]]  <- readShit
        printShit [solve s]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: x -> x -> Bool-> x
iif a b c = if c then a else b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit String where
    printShit = putStrLn
    printShitV = putStrLn
    readShit = getLine

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

solve n = if n `mod` 4 == 0 then 4 else 0
main = getLine >>= print . solve . read

compute :: Int -> Int
compute n = (1 +  2 ^ n + 3 ^ n + 4 ^ n) `mod` 5

lastN :: Int -> [a] -> [a]
lastN n xs = foldl (const . drop 1) xs (drop n xs)

main :: IO ()
main = do
  line <- getLine
  let n = read $ lastN 3 line
  print $ compute (n `mod` 4)

import Data.List
import Data.Function
import Data.Char

main = interact $ show . getAns . read

getAns :: Integer -> Int
getAns x = let m2 = fromInteger $ x `mod` 2; m4 = fromInteger $ x `mod` 4
			in (1 + ([1, 2, 4, 3] !! m4) + ([1, 3, 4, 2] !! m4) + ([1, 4] !! m2)) `mod` 5

{-
1 -> [1]
2 -> [2, 4, 3, 1]
3 -> [3, 4, 2, 1]
4 -> [4, 1]-}

import Data.List
import Data.Function
import Data.Char

main = interact $ show . getAns . read

getAns :: Integer -> Int
getAns x = let m = fromInteger $ x `mod` 4
			in (1 + 2 ^ m + 3 ^ m + 4 ^ m) `mod` 5

module Main where

import Data.Bits

main = do
    n <- getLine
    let l = length n
    print  $  (\x -> if x `mod`4 == 0 then 4 else 0) $ (read :: String -> Int) $ drop (if l > 1 then l-2 else 0) n

solve :: String -> Int
solve s
  | read ends `mod` 4 == 0  =  4
  | otherwise  =  0
  where
    ends  =  drop (length s - 2) s

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

main = do
    input <- getLine
    let len = length input
    let short = (read :: String -> Int) $ drop (len - 2) input
    putStrLn $ show $ f short

f :: Int -> Int
f x =
    let x1 = cycle [1,1,1,1]
        x2 = cycle [6,2,4,8]
        x3 = cycle [1,3,9,7]
        x4 = cycle [6,4,6,4]
        m = mod4 x
    in mod5 (x1 !! m + x2 !! m + x3 !! m + x4 !! m)

mod4 x = mod x 4
mod5 x = mod x 5

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

solve :: String -> Int
solve [] = 0
solve (_:s@(_:_:_)) = solve s
solve s = if (read s :: Int) `mod` 4 == 0 then 4 else 0

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

main :: IO ()
main = B.getLine >>= print . solve

solve :: B.ByteString -> Int
solve s = if fst (fromJust $ B.readInt (B.drop (B.length s - 3) s)) `mod` 4 == 0 then 4 else 0

import Data.Char

compute :: Int -> Int
compute n = (1 +  2 ^ n + 3 ^ n + 4 ^ n) `mod` 5

main :: IO ()
main = do
  line <- getLine
  let n = digitToInt $ last line
  print $ compute (n `mod` 4)

main = do
    input <- getLine
    let len = length input
    let short = (read :: String -> Int) $ drop (len - 2) input
    putStrLn $ show $ f short

f :: Int -> Int
f 0 = 4
f x =
    let x1 = cycle [1,1,1,1]
        x2 = cycle [2,4,8,6]
        x3 = cycle [3,9,7,1]
        x4 = cycle [4,6,4,6]
        m = mod4 x
    in mod5 (x1 !! m + x2 !! m + x3 !! m + x4 !! m)

mod4 x = mod x 4
mod5 x = mod x 5

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

main :: IO ()
main = B.getLine >>= print . solve

solve :: B.ByteString -> Int
solve s = if fst (fromJust $ B.readInt (B.drop (B.length s - 2) s)) `mod` 4 == 0 then 4 else 0

main = interact $ show . solve
solve s | n `mod` 4 == 0 = "4" | otherwise = "0" where
  n = read $ reverse $ take 2 $ reverse s

main = interact $ show . solve
solve s = (1^n + 2^n + 3^n + 4^n) `mod` 5 :: Integer where
  n = read $ reverse $ take 2 $ reverse s

main = interact solve
solve s | n `mod` 4 == 0 = "4" | otherwise = "0" where
  n = read $ reverse $ take 2 $ reverse s

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

main= do
	s<-  C.take 2 . C.reverse <$> C.getLine
	let s1 = read (reverse (C.unpack s)) ::Int
	print $ if mod s1 4 ==0 then 4 else 0

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: BS.ByteString -> Int
solve s = if divisibleBy4 s then 4 else 0

divisibleBy4 :: BS.ByteString -> Bool
divisibleBy4 s =  toInt str `mod` 4 == 0
    where len = BS.length s
          str = if len < 2 then s else BS.drop (len - 2) s
          toInt = fst .fromJust . BS.readInt

-- Shit
main :: IO ()
main = do
        [s]  <- readShit
        printShit [solve s]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: x -> x -> Bool-> x
iif a b c = if c then a else b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit String where
    printShit = putStrLn
    printShitV = putStrLn
    readShit = getLine

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: BS.ByteString -> Int
solve s = if divisibleBy4 s then 4 else 0

divisibleBy4 :: BS.ByteString -> Bool
divisibleBy4 s = (suffInt  `mod` 4) == 0
    where len = BS.length s
          suffix = BS.drop (len - 2) s :: BS.ByteString
          suffInt = fst . fromJust . BS.readInt $ suffix :: Int
-- Shit
main :: IO ()
main = do
        [s]  <- readShit
        printShit [solve s]

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: x -> x -> Bool-> x
iif a b c = if c then a else b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit String where
    printShit = putStrLn
    printShitV = putStrLn
    readShit = getLine

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents


module Main where

import Data.List ( group, nub )

isUnsospicious :: String -> String
isUnsospicious tasks
  | taskList == nub taskList = "YES"
  | otherwise                = "NO"
  where
    taskList = map head $ group tasks

solve :: IO String
solve = do
  stringLength <- getLine
  tasks        <- getLine
  return $ isUnsospicious tasks

solution :: Int -> IO [String]
solution 0    = return []
solution test = do
  answer <- solve
  rest   <- solution (test - 1)
  return $ answer : rest

main :: IO ()
main = do
  tests   <- getLine
  results <- solution (read tests)
  mapM_ putStrLn results

import Control.Monad
import Data.List

printResult = do
    n <- readLn :: IO Int
    s <- getLine
    let a = map head $ group s
        r = any (\x->length x > 1) $ group $ sort a
    putStrLn $ if r then "NO" else "YES"

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

import Data.List
import System.IO
import Control.Monad

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

countConsequence c [] meet = 0
countConsequence c (x:xs) meet
    | c /= x  && meet == False = countConsequence c xs meet
    | c /= x && meet == True = 0
    | otherwise = 1  + (countConsequence c xs True)

forString [] ys = putStrLn"YES"
forString (x:xs) ys = if sum[1|y<-ys,y==x] /= (countConsequence x ys False)
    then putStrLn "NO"
    else forString xs ys

printS = do
    n<-readLn::IO Int
    s<-getLine
    let ys = ['A'..'Z']
    forString ys s

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

import Control.Monad
import Data.Containers.ListUtils (nubInt)
import Data.List (group)

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        _ <- getLine
        a <- map fromEnum <$> getLine
        let b = map head $ group a
        putStrLn $
            if b == nubInt b
                then "YES"
                else "NO"

import Control.Arrow
import Data.List
import Data.Bool

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = let (s, xs') = splitAt n xs in s : chunksOf n xs'

main = interact $
         lines >>> drop 1 >>> chunksOf 2
         >>> map ((!! 1) >>> solve >>> bool "NO" "YES")
         >>> unlines

solve = all ((== 1) . length) . group . sort . map head . group

module Main where

import Control.Monad
import qualified Data.Set as Set

solveString :: String -> String
solveString str = if helper Set.empty str '1' then "Yes" else "No" where
  helper :: Set.Set Char -> String -> Char -> Bool
  helper _ [] _ = True
  helper set (ch : chs) lastChar | Set.member ch set && ch /= lastChar = False
                                 | otherwise = helper (Set.insert ch set) chs ch

solve :: Integer -> IO ()
solve t
  | t == 0 = putStr ""
  | otherwise = do
      n <- getLine
      string <- getLine
      putStrLn $ solveString string
      solve (t - 1)

main :: IO ()
main = do
  t <- getLine
  solve (read t)

import qualified Data.Set as S
import qualified Data.List as L

solve l = let
    chunks = L.group l
    chunksFirst = map head chunks
    chunksFirstUniq = S.fromList chunksFirst
    in
    if length chunksFirst == length chunksFirstUniq then "YES" else "NO"

solveAll [] = []
solveAll (l1:l2:lrest) = (solve l2):(solveAll lrest)

main = do
    stdin <- getContents
    let _lines = lines stdin
    let l1:lrest = _lines
    let n = (read :: String -> Int) l1
    let answers = solveAll lrest
    sequence [putStrLn a | a <- answers]

import Data.List
import Data.Function

solve [] = [""]
solve (x:xs) = [answer $ head xs] ++ (solve $ tail xs)
  where
    answer x = if isNice x
               then "YES"
               else "NO"

    isNice x = all (== True) $
          map (\x -> all (== True) $ map snd x) $
          map isGood $ map (\x -> map snd x) $
          groupBy ((==) `on` fst) $
          sort $
          zip x [0..]
    isGood (x:xs) = scanl (\x y -> if (fst x) + 1 == y
                                   then (y, (snd x) && True)
                                   else (y, False)) (x, True) xs

main = interact $ unlines . helper . lines
  where
    helper (x:xs) = solve xs

module Main where

import Data.List ( group, nub )

isSuspicious :: String -> String
isSuspicious tasks
  | taskList == nub taskList = "YES"
  | otherwise                = "NO"
  where
    taskList = group tasks

solve :: IO String
solve = do
  stringLength <- getLine
  tasks        <- getLine
  return $ isSuspicious tasks

solution :: Int -> IO [String]
solution 0    = return []
solution test = do
  answer <- solve
  rest   <- solution (test - 1)
  return $ answer : rest

main :: IO ()
main = do
  tests   <- getLine
  results <- solution (read tests)
  mapM_ putStrLn results


import Data.Set

main = do
  getLine
  interact $ unlines.solve empty.reverse.lines

solve _ [] = []
solve s (x:xs)
  |not(x`member`s) = x:solve(x`insert`s) xs
  |otherwise = solve s xs

import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S
main = C.interact $ C.unlines . reverse . fst . foldr f ([],S.empty) . tail . C.lines . C.filter (/='\r')
f n (l,s) | S.member n s = (l,s)
          | True = (n:l,S.insert n s)


import Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t $ do
        _ <- getLine
        l1 <- getLine
        let a = (map read . words) l1 :: [Int]
        _ <- getLine
        l2 <- getLine
        let b = (map read . words) l2 :: [Int]
        let ma = maximum a
            mb = maximum b
        putStrLn $
            if ma == mb
                then "Alice\nBob"
                else if ma > mb then "Alice\nAlice" else "Bob\nBob"

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

main :: IO ()
main = do
	n <- getLine
	let number = read n :: Int
	solve number number

solve number 0 = return ()
solve number current = do
	n <- getLine
	alice <- getLine
	let aliceCards = (map read $ words alice) :: [Int]
	m <- getLine
	bob <- getLine
	let bobCards = (map read $ words bob) :: [Int]
	if (maximum aliceCards) > (maximum bobCards) then do
		putStrLn "Alice"
		putStrLn "Alice"
	else if (maximum aliceCards == maximum bobCards) then do
		putStrLn "Alice"
		putStrLn "Bob"
		else do
			putStrLn "Bob"
			putStrLn "Bob"
	solve number (current - 1)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
import Data.Word (Word32)
import System.Environment (getArgs)
import GHC.Conc (par, pseq)
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)
import Control.Monad.State (State, evalState, gets, MonadState (get, put), replicateM)
import Control.Applicative (Applicative(liftA2))
import Control.Arrow ((>>>))

data TC = TC { a::[Int], b::[Int] }

aliceBob x = if x then "Alice" else "Bob"

solve TC{..} = (aliceBob $ ma >= mb, aliceBob $ ma > mb)
  where
    ma = maximum a
    mb = maximum b

main = C.interact $ runScanner scan >>> map solve >>> map (\(x, y) -> [x, y]) >>> concat >>> map C.pack >>> C.unlines

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

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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