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

solve :: [Int] -> [Int]
solve [] = []
solve (p : q : r : vs)
  | q > p && q > r  = p : q : maximum (q : take 1 vs) : solve vs
solve (v : vs) = v : solve vs

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve a
      diffs = length $ filter id $ zipWith (/=) a ans
    pure $ putInts [diffs] <> putInts ans

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 inp
  P.putStr $ toLazyByteString outp

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

solve :: (Num b, Ord b) => [b] -> b -> ([b], b)
solve [] ops = ([], ops)
solve [a] ops = ([a], ops)
solve [a, b] ops = ([a, b], ops)
solve (a : b : c : cs) ops = (a : next, ops')
  where
    maxx = b > a && b > c
    maxxx = max b (if not (null cs) then head cs else 0)
    (next, ops') = solve (if maxx then b : maxxx : cs else b : c : cs) (if maxx then ops + 1 else ops)

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        _ <- getLine
        l <- getLine
        let arr = map read (words l) :: [Int]
        let (ans, ops) = solve arr 0
        print ops
        putStrLn $ unwords $ map show ans

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

solve :: [Int] -> [Maybe Int]
solve [] = []
solve (p : q : r : vs)
  | q > p && q > r  = Just p : Just q : Nothing : solve vs
solve (v : vs) = Just v : solve vs

solve2 :: [Maybe Int] -> [Int]
solve2 [Just x, Nothing] = [x, x]
solve2 (Just x : Nothing : t@(Just y : _)) = x : max x y : solve2 t
solve2 (Nothing : t@(Just y : _)) = y : solve2 t
solve2 (Just x : t) = x : solve2 t
solve2 [] = []
solve2 (Nothing : _) = error "solve2: yikes"

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve a
      diffs = length $ filter isNothing ans
    pure $ putInts [diffs] <> putInts (solve2 ans)

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 inp
  P.putStr $ toLazyByteString outp

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

solve :: (Ord t, Num a) => t -> t -> [t] -> a
solve _ _ [] = 0
solve ll l (c : []) = if (l > ll && l > c) then 1 else 0
solve ll l (c : cs)
  | l > ll && l > c = 1 + solve l (max l (cs !! 0)) cs
  | otherwise = solve l c cs

solve2 :: (Ord t, Num t) => t -> t -> [t] -> [t]
solve2 a b [] = [a,b]
solve2 ll l (c : []) = if (l > ll && l > c) then [ll,l, l] else [ll, l, c]
solve2 ll l (c : cs)
  | l > ll && l > c = (ll : solve2 l (max l (cs !! 0)) cs)
  | otherwise = (ll : (solve2 l c cs))

main :: IO ()
main = do
  t <- readLn :: IO Int
  forM_ [1 .. t] $ \i -> do
    n <- readLn :: IO Int
    l <- getLine
    let arr = map read (words l) :: [Int]
    let (a : b : cs) = arr
    let a1 = solve a b cs
    print a1
    let a2 = solve2 a b cs
    forM_ a2 $ \i -> do
      putStr $ show(i)
      putStr " "
    putStr "\n"

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

solve :: Int -> [Int] -> [Int]
solve _ [] = []
solve repv (p : q : r : vs)
  | q > p && q > r  = p : q : solve repv (repv : vs)
solve repv (v : vs) = v : solve repv vs

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    let
      ans = solve (foldl' max minBound a) a
      diffs = length $ filter id $ zipWith (/=) a ans
    pure $ putInts [diffs] <> putInts ans

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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 inp
  P.putStr $ toLazyByteString outp


import Data.List(sort)
getans m k (mx:smx:_) = mx*m - (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Integer) . words  <$> getLine
    n <- map (read :: String -> Integer) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ reverse $ sort $ map (read::String->Integer) $ words str2

import Data.List(sort)
getans m k (mx:smx:_) = mx*m + (m `div` (k+1)) * (mx - smx)
main = do
    str <- getLine
    let [n, m, k] = map (read::String->Integer) $ words str
    str2 <- getLine
    print $ getans m k $ sort $ map (read::String->Integer) $ words str2

module Main where
import Data.List

main = do
    [_, m, k] <- map (read :: String -> Int) . words  <$> getLine
    n <- map (read :: String -> Int) . words  <$> getLine
    let [a,b] = take 2 $ reverse $ sort n
        (c,d) = m `quotRem` (k+1)
    print $ a*k*c+b*c+a*d


{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

import Data.List
import Data.Maybe

main = do
  getLine
  [x, k, y] <- map read . words <$> getLine
  as <- (0 :) . (++ [-1]) . map read . words <$> getLine
  bs <- (0 :) . (++ [-1]) . map read . words <$> getLine
  print $ fromMaybe (- 1) $ solve x k y as bs

solve x k y (al : ars) (bl : bs@(br : _))
  | al /= bl || null as || null costs = Nothing
  | otherwise = (minimum costs +) <$> solve x k y as bs
  where
    (range, as) = span (/= br) ars
    len = genericLength range
    costs = [y * len | maximum (0 : range) < max bl br] ++ concat [[x + y * (len - k), x * (len `div` k) + y * (len `mod` k)] | len >= k]
solve _ _ _ _ _ = Just 0


module Main where

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

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

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

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    [h, w] <- getIntList
    let ans = getAnswer h w 1
    forM_ ans putStrLn
    putChar '\n'

getFirstAndLast :: Int -> String
getFirstAndLast w = take w $ cycle "10"

getAnswer :: Int -> Int -> Int -> [String]
getAnswer h w i
    | i == h         = [getFirstAndLast w]
    | i == 1         = getFirstAndLast w : getAnswer h w (i + 1)
    | i == h - 1     = emptyLine : getAnswer h w (i + 1)
    | i `mod` 2 == 0 = emptyLine : getAnswer h w (i + 1)
    | otherwise      = setLine : getAnswer h w (i + 1)
    where emptyLine = take w $ repeat '0'
          setLine   = "1" ++ (take (w - 2) $ repeat '0') ++ "1"

-- 101001
-- 000000
-- 100001
-- 000000
-- 100000
-- 001010

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

llines :: Int -> Int -> Int -> [String]
llines h w curr
  | curr == 0 = line : llines h w (curr+1)
  | curr == h - 1 = [line]
  | otherwise = (if odd curr || curr == h - 2 then replicate w '0' else "1" ++ replicate (w-2) '0' ++ "1") : llines h w (curr+1)
    where evenline = foldl (++) "" $ replicate (div w 2) "10"
          oddline = evenline ++ "1"
          line = if even w then evenline else oddline

solve :: IO ()
solve = do
  s <- getLine
  let [h, w] = map read $ words s :: [Int]
      rect = llines h w 0
    in putStrLn $ intercalate "\n" rect

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

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

main :: IO ()
-- main = C.interact $ runScanner (C.pack <$> testCase)
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = unlines . solve <$> pair int int

type Grid = [[Char]]

solve :: (Int, Int) -> Grid
solve (h, w) = [[if ok i j then '1' else '0' | j <- [1 .. w]] | i <- [1 .. h]]
  where
    ok i j
      | i == 1 = odd j
      | i == h = odd j && h >= 3
      | otherwise = odd i && i + 2 <= h && (j == 1 || j == w)

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


{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "14689") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

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.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) twoDigits of
                       y : _ -> show y
                       []    -> error "oops"
  where
    twoDigits = map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s

module Main where

import Data.List
import Data.Char (digitToInt)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf x l  = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

type InType  = String
type OutType = String

inpLines :: Int
inpLines = 2

prime :: Int -> Bool
prime x = [y | y <- [1 .. x] , x `mod` y == 0] == [1, x]

subLen2 :: [a] -> [(a,a)]
subLen2 []  = []
subLen2 (x:xs) = [(x, z) | z <- xs] ++ subLen2 xs

solve :: InType -> OutType
solve n = case "14689" `intersect` n of
            x : _ -> [x]
            []    -> case filter (not . prime) (map (\(x, y) -> 10 * digitToInt x + digitToInt y) (subLen2 n)) of
                       y : _ -> show y
                       []    -> error "oops"

receive :: [String] -> InType
receive [_, n] = n
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (showAns . solve . receive) . chunksOf inpLines . tail . lines
    where
      showAns s = show (length s) ++ "\n" ++ s
      -- showAns s = unlines [show (length s), s]

import Control.Monad
import Data.List
import Data.Maybe (fromJust)

isEvenChar '1' = True
isEvenChar '4' = True
isEvenChar '6' = True
isEvenChar '8' = True
isEvenChar '9' = True
isEvenChar _ = False

calc1 :: String -> Maybe String
calc1 x = do
  letter <- find isEvenChar x
  return $ [letter]

calc2 :: String -> Maybe String
calc2 (a:'2':xs) = Just (a:['2'])
calc2 (a:'5':xs) = Just (a:['5'])
calc2 (a:b:xs) | a == b = Just (a:[b])
calc2 (a:b:c:xs) | a == c = Just (a:[c])
calc2 ('2':'3':'7':xs) = Just ('2':['7'])
calc2 ('2':'7':xs) = Just ('2':['7'])
calc2 ('5':'3':'7':xs) = Just ('5':['7'])
calc2 ('5':'7':xs) = Just ('5':['7'])
calc2 (a:b:c:xs) = calc2 (b:c:xs)
calc2 _ | otherwise = Nothing

(<||>) :: (Monoid a, Eq a) => a -> a -> a
x <||> y
     | x == mempty = y
     | True = x

-- 77, 33
calc3 :: Char -> String -> Maybe String
calc3 ch x =
  let count = foldr (\a b -> if a == ch then (b+1) else b) 0 x in
    if count >= 2 then Just (ch:[ch])
    else Nothing

calc :: String -> Maybe String
calc a = (calc1 a) <||> (calc2 a ) <||> (calc3 '7' a) <||> (calc3 '3' a)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let k = read line :: Int
    line <- getLine
    let ans1 = calc line
    --print line
    let ans = fromJust ans1
    print $ length ans
    putStrLn ans

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (filterM, replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromJust)
import Data.Ord (comparing)
import Debug.Trace (trace)

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

type Input = String

type Output = (Int, String)

input :: Scanner Input
input = str *> str

output :: Output -> C.ByteString
output (d, s) = C.pack $ show d ++ "\n" ++ s

solve :: Input -> Output
solve s = case find (`elem` "1468") s of
  Just c -> (1, [c])
  Nothing ->
    case filter ((> 1) . length) . group . sort $ s of
      (ds : _) -> (2, take 2 ds)
      [] ->
        let ss =
              minimumBy (comparing length)
                . filter (not . isPrime . read)
                . filter (not . null)
                . filterM (const [True, False])
                $ s
         in (length ss, ss)

isPrime :: Int -> Bool
isPrime n = all ((/= 0) . (n `mod`)) [2 .. n -1]

-------------------------- Template ------------------------------------------
debug a = trace (show a) a

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 Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
    print $ if s >= n then s - n else 1

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

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            sm = sum a
            n = read ns :: Int
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    s <- sum <$> getInts
    if s < k then
      print 1
    else
      print $ s - k

import Control.Monad (replicateM_)

getInt = read <$> getLine
getInts = map read . words <$> getLine

main = do
  n <- getInt
  replicateM_ n $ do
    k <- getInt
    a <- getInts
    let s = sum a
    if s < k then
      print 1
    else
      print $ s - k

module Main where

(|>) = flip ($)

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

solve :: [Int] -> Int
solve a =
    if sum a >= length a
       then (sum a) - (length a)
       else 1

main :: IO ()
main = interact $
    unlines
    . map (show . solve)
    . map (map read . words)
    . map (head . tail)
    . chunksOf 2
    . tail
    . lines

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]
printS = do
    n <- readLn::IO Int
    aa <- readInts
    let s = sum aa
    print $ if s>=n then s-n else 1
main = do
    t <- readLn::IO Int
    replicateM_ t printS

import Control.Monad
import Data.Maybe
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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [k] <- getInts
    s <- sum <$> getInts
    let
      result = case compare s k of
        GT -> s - k
        LT -> 1
        EQ -> 0
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        a <- map parseInt . BS.words <$> BS.getLine
        let s = sum a
        if n == s then
            putStrLn "0"
        else if n > s then
            putStrLn "1"
        else
            print $ s - n

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Integer) (words s)
            n = read ns :: Integer
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Integer)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) (words s)
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

module Main where

    solve :: IO ()
    solve = do
        ns <- getLine
        s <- getLine
        let a = map (\x -> read x :: Int) $ words s
            n = read ns :: Int
            sm = sum a
        print $
            if sm < n then
                1
            else
                sm - n

    iter :: Int -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        q <- getLine
        iter (read q :: Int)

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else 1

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

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let s = sum a
        l = length a
    print $ if s > 0 then s - l else l + 1

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

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

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    print $ abs (sum a) - length a

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


luckyDigits :: String -> Int
luckyDigits xs = length $ filter (\x -> x == '4' || x == '7') xs

solve :: Int -> [String] -> Int
solve k xs = length $ filter (\x -> luckyDigits x <= k) xs

parseInput :: String -> (Int, [String])
parseInput input = (k, xs) where
    ls = lines input
    k = read $ last $ words $ head ls
    xs = words $ last ls

main = do
    input <- getContents
    let (k, xs) = parseInput input
    print $ solve k xs

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- words <$> getLine
	let
		res = length $ filter ( ok k ) as
	print res

ok :: Int -> String -> Bool
ok k a = count47 a <= k
	where
		count47 :: String -> Int
		count47 = length . filter ( \c -> c == '4' || c == '7' )

main = interact $ show . solve . words

solve (n : kk : a) = length . filter ((<=k) . length . filter (`elem` "47")) $ a
                    where k = read kk

import Data.List

lucky x = x == '4' || x == '7'

findLucky k [] = 0
findLucky k (a:ais) =
    let l = length $ (findIndices lucky a)
    in if l > k then findLucky k ais else 1 + findLucky k ais

main :: IO ()
main = do
    nm <- getLine
    let [_, k] = map read $ words nm
    ais <- getLine
    let a = words ais
    print $ findLucky k a

import Control.Monad (liftM)
import Prelude hiding (reads)

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

solve :: Int -> [String] -> Int
solve k  =  length . filter happyDigitsLessK
  where
    happyDigitsLessK  =  (<= k) . length . filter isHappyDigit
    isHappyDigit c  =  c == '4' || c == '7'

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

import Prelude

main = do
	str <- getContents
	print $ solve str

solve :: String -> Int
solve str = length $ filter (<=k) $ ln
	where
		(ns:ks:a) = words str
		n = read ns
		k =  read ks
		aa = take n a
		ln = map toLucky aa
		toLucky number = length $ filter (\chr -> (chr == '7') || (chr == '4')) $ number

g s c = length $ filter (==c) s
f s = sum $ map (g s) "47"
t (k:s) = length $ filter (<=read k) $ map f s
main = interact $ show . t . tail . words

main :: IO ()
main = do
  nkLine <- getLine
  intLine <- getLine
  let
    k = read $ last $ words nkLine
    intVals = words intLine
    lengths = map length $ map (filter (\x -> x == '4' || x == '7')) intVals
    numLuckies = length $ filter (<= k) lengths
    in
   print numLuckies

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

solve :: [Int] -> Int
solve (k:as) = length [ () | a <- as, length (filter (`elem`"47") (show a)) <= k ]
solve _ = undefined

main = interact $ show . solve . tail . words
solve (k:as) = length $ filter ((<= read k) . length . filter (`elem` "47")) as

main=interact$show.f.words
f(_:k:x)=l[y|y<-x,l(filter(`elem`"47")y)<=read k]
l=length

#!/usr/bin/env runghc
main = do
  c <- getContents
  putStrLn . solve . lines $ c

solve (m:a:cs) = show . length . filter (<=k) . map f $ words a
  where
    f = length . filter (\x -> x=='4' || x=='7')
    k = read . head . tail . words $ m

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let [_, k] = map read $ words nkStr
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if checkHappyDigits num k then a+1 else a) 0 nums

module Main where
import Data.Char
import Data.List.Split

strToInt :: String -> Int
strToInt = helper 0
	where
		helper acc [] = acc
		helper acc (x:xs) = helper (acc * 10 - 48 + ord x) xs

fits :: Int -> String -> Int
fits k s = helper s 0
	where
		helper [] acc | acc > k = 0
			      | otherwise = 1
		helper (x:xs) acc | x == '4' || x == '7' = helper xs (acc + 1)
				  | otherwise = helper xs acc

toInts :: String -> [Int]
toInts = map strToInt . filter (/="") . splitOn " "

process :: String -> String -> String
process par = show . sum . map (fits k) . splitOn " "
	where
		(n:k:xs) = toInts par

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

module Main where

checkHappyDigits :: String -> Int -> Bool
checkHappyDigits "" n
                 | n >= 0 = True
                 | otherwise = False
checkHappyDigits _ n | n < 0 = False
checkHappyDigits ('4':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits ('7':ls) n = checkHappyDigits ls (n-1)
checkHappyDigits (_:ls) n = checkHappyDigits ls n

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         n = nk!!0
         k = nk!!1
     numsStr <- getLine
     let nums = words numsStr
     print $ foldl (\ a num -> if (checkHappyDigits num k) then (a+1) else a) 0 nums

import Control.Applicative
import Data.List

main= do
	[n,k]<- map read . words<$> getLine ::IO [Int]
	s<- words <$> getLine
	print $ length $ filter (<=k) $ map (length. filter (\z-> elem z "47") ) s

process :: Int -> [String] -> Int
process k = length . filter f
    where f = (<=k) . length . filter (\x -> x `elem` "47")

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,k] <- fmap (map readInt.words) getLine
    xs <- fmap words getLine
    print $ process k xs

main = do
    [n, k] <- fmap (map read . words) getLine :: IO [Int]
    a <- fmap words getLine :: IO [String]
    print $ length $ filter (<= k) $ map f a where
        f [] = 0
        f (x:xs)
            | x == '4' || x == '7' = 1 + f xs
            | otherwise            = f xs

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.IntMap as IntMap
import Data.List

solve k num =
  (lucky num) > k
  where lucky n = length $ filter (\d -> (d == 4) || (d == 7)) $ map (`mod` 10)
                   $ takeWhile (> 0) $ iterate (`div`10) n
main :: IO ()
main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let Just (k, r2) = readInt r1
     let Just (numbers, r3) = readIntList n r2
     let tSeq = length $ filter (\x -> x == False) $ map (solve k) numbers
     putStr $ show tSeq ++ "\n"
  where readInt s = BSC.readInt (BSC.dropWhile isSpace s)
        readIntList 0 s = do return ([], s)
        readIntList n s = do (number, r) <- readInt s
                             (l, t) <- readIntList (n-1) r
                             return ((number : l, t))

import Control.Applicative
main = do
    [n,k] <- map read . words <$> getLine
    ns <- take n . words <$> getContents
    let
        ans = length $ filter (<=k) $ map toNumberOfLucky $ ns
        toNumberOfLucky word = length $ filter (\c -> c=='4'||c=='7') $ word
    print ans

{-# 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 :: Int -> [String] -> Int
solve k = length . filter (ok k)

ok :: Int -> String -> Bool
ok k = (<= k). length . filter (`elem` "47")

-- Shit
main :: IO ()
main = do
        [[_,k], as]  <- readShit
        printShit $ solve (read k) as

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

main=interact$show.f.map read.words
f(n:k:x)=l[y|y<-x,l(show y)<=k]
l=length


main :: IO ()
main = interact $ unlines . map unwords . solve . words

solve :: [String] -> [[String]]
solve (_ : ds) = [[show $ length ans], ans]
  where
  ans
    | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
    | otherwise = d0 ++ d1 ++ d2 ++ d3
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (\x->0<x&&x<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

takeFirst :: [String] -> [String]
takeFirst [] = []
takeFirst (x : xs) = [x]

transTo01 :: String -> String
transTo01 [] = []
transTo01 (x : xs) = (if x == '0' then '0' else '1') : (transTo01 xs)

handle :: [String] -> [[String]]
handle (_ : xs) = [[show $ length res], res]
    where
    res
        | null $ x1 ++ x10 = x0 ++ x11 ++ x100
        | otherwise        = x0 ++ x1 ++ x10 ++ x100
    x0   = take 1 [x | x <- xs, transTo01 x == "0"  ]
    x1   = take 1 [x | x <- xs, transTo01 x == "1"  ]
    x10  = take 1 [x | x <- xs, transTo01 x == "10" ]
    x11  = take 1 [x | x <- xs, transTo01 x == "11" ]
    x100 = take 1 [x | x <- xs, transTo01 x == "100"]

main :: IO ()
main = interact $ unlines . map unwords . handle . words

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

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

solve :: [Int] -> [Int]
solve as
    | null maybe1_9 && null maybe10_90  =  concat [maybe0, maybe1_99, maybe100]
    | otherwise  =  concat [maybe0, maybe1_9, maybe10_90, maybe100]
  where
    maybe0  =  take 1 $ filter (==0) as
    maybe100  =  take 1 $ filter (== 100) as
    maybe1_9  =  take 1 $ filter (\x -> 1 <= x && x <= 9) as
    maybe10_90  =  take 1 $ filter ((== 0) . flip mod 10) $ filter (\x -> 1 <= x && x <= 99) as
    maybe1_99  =  take 1 $ filter (/= 0) $ filter (/= 100) as

prints :: Show a => [a] -> IO ()
prints as  =  do
    print $ length as
    putStrLn $ intercalate " " $ map show as

main :: IO ()
main  =  getLine >> reads >>= prints . solve

main :: IO ()
main = interact $ unwords . solve . words

solve :: [String] -> [String]
solve (_ : ds)
  | null $ d1 ++ d2 = d0 ++ take 1 d12 ++ d3
  | otherwise = d0 ++ d1 ++ d2 ++ d3
  where
  d0 = take 1 ["0" | "0" <- ds]
  d1 = take 1 [d | d <- ds, length d == 1, d /= "0"]
  d12 = [d | d <- ds, length d == 2]
  d2 = take 1 [d | d <- d12, d !! 1 == '0']
  d3 = take 1 ["100" | "100" <- ds]

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null z && null zero && null y' = [[1],take 1(x++y)]
  | otherwise = [[length res],res]
   where
     res = zero ++ z ++ take 1 (x++y'') ++ take (fromEnum.not$null x&&(not$null y'')) y'
     zero = filter (0==)xs
     x = filter (<10)xs
     y = filter (\x->9<x&&x<100)xs
     y' = filter ((0==).(`mod`10)) y
     y'' = filter ((0<).(`mod`10)) y
     z = filter (100==)xs

main=interact$unlines.(map(unwords.map show)).f.map read.words
f(_:xs)
  | null zs = [[length ys],ys]
  | otherwise = [[1+length ys],(zs!!0):ys]
   where
     ys = filter(elem '0'.show) xs
     zs = filter(notElem '0'.show) xs


import Control.Applicative ((<$>))

isPal a = and $ zipWith (==) a a'
    where a' = reverse a

chunk _ ""  = []
chunk k str = (take k str):chunk k rest
    where rest = drop k str

pred' line k | length line `mod` k /= 0 = False
pred' line k = all isPal $ chunk (length line `div` k) line

main = do
    line <- getLine
    k <- read <$> getLine
    putStrLn $ if pred' line k then "Yes" else "No"

main :: IO()
main = getContents >>= putStrLn . solve . lines

solve :: [String] -> String
solve [s, sk] =
    let len = length s
        k   = read sk
        m   = div len k
    in if (mod len k) == 0 && (solve' s m m "") then "YES" else "NO"
        where
            solve' :: String -> Int -> Int -> String -> Bool
            solve' "" m 0 sub = palin sub
            solve' (x:xs) m 0 sub = (palin sub) && (solve' xs m (m-1) [x])
            solve' (x:xs) m i sub = solve' xs m (i-1) (x:sub)

            palin :: String -> Bool
            palin s = s == (reverse s)

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = if (length s) `mod` k == 0 then (length s) `quot` k else 0
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes _ [] = True
checkPalindromes len str
	|
		length substr == len &&
		substr == reverse substr = checkPalindromes len newstr
	|
		otherwise = False
	where
		substr = take len str
		newstr = drop len str

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- 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 qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  s <- getLine
  k <- readLn

  let
    l = length s `div` k
    ss = unfoldr (\s -> if null s then Nothing else Just $ splitAt l s) s
    check s = s == reverse s

  putStrLn $ if length s `mod` k == 0 && all check ss then "YES" else "NO"

answer::String -> Int -> String
answer s k | ((length s) `rem` k) == 0 = handan s ((length s) `div` k)
           | otherwise = "NO"
handan::String -> Int -> String
handan [] k = "YES"
handan s k | isp (take k s) = handan (drop k s) k
           | otherwise = "NO"
isp::String ->  Bool
isp s0 = s0 == reverse s0
main = do
  w <- getLine
  w0 <- getLine
  let k = read w0::Int
  putStrLn $ answer w k

import Data.List

is_pal :: String -> Bool
is_pal "" = True
is_pal (x:"") = True
is_pal cs = head cs == last cs && is_pal (init. tail $ cs)

foo :: String -> Int -> [String]
foo "" _ = []
foo cs n = (take n cs) : (foo (drop n cs) n)

main :: IO ()
main = do
  s <- getLine
  n <- return . (read::String->Int) =<< getLine
  putStrLn $ if mod (length s) n == 0 && all is_pal (foo s (length s `div` n)) then "YES" else "NO"

import Control.Applicative ((<$>), (<*>))
import Data.List (unfoldr)

main :: IO ()
main = putStrLn <$> yesno =<< solve <$> getLine <*> readLn

solve :: String -> Int -> Bool
solve s k = all palindrome (splitN (length s `div` k) s) && length s >= k && length s `mod` k == 0

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

main = do
    s <- getLine
    k <- getLine >>= return.read
    putStrLn $ if (solve s k) then "YES" else "NO"

solve :: String -> Int -> Bool
solve s k
    | (length s) `mod` k /= 0   = False
    | otherwise = sol s ((length s) `div` k)

sol [] _ = True
sol s k
    | pre == reverse pre = sol (drop k s) k
    | otherwise = False
    where pre = (take k s)

main = do
    s <- getLine
    k <- fmap read getLine
    putStrLn $ if correct s k then "YES" else "NO"

correct s k | l `mod` k /= 0 = False
            | otherwise = f s (l `div` k)
    where l = length s
          f [] _ = True
          f s' k' = let (a,b) = splitAt k' s'
                    in isPalindrome a && f b k'

isPalindrome s = s == reverse s

import Data.Bits (shift, (.&.), Bits)
import Data.List (group, sort, transpose)
import Data.Char (ord)
import Control.Applicative ((<$>))
import Control.Monad (replicateM, liftM, join, mapM_)

isPal a = foldr (&&) True $ zipWith (==) a $ reverse a

chunk _ ""  = []
chunk k str = (take k str):chunk k rest
    where rest = drop k str

pred' line k | length line `mod` k /= 0 = False
pred' line k = all isPal $ chunk (length line `div` k) line

main = do
    line <- getLine
    k <- read <$> getLine
    putStrLn $ if pred' line k then "Yes" else "No"

import Control.Applicative
import Data.List

palindrome x = x== reverse x

chunks n [] = []
chunks n s = (take n s ): (chunks n (drop n s))

main= do
	s<-  getLine
	n<- read <$> getLine ::IO Int
	let les = length s
	let k = div les n
	putStrLn $ if (k*n == les) && (all palindrome ( chunks k s)) then "YES" else "NO"

import Data.List

isPalindrome "" = False
isPalindrome s = s == reverse s

kPals 0 "" = True
kPals 0 _  = False
kPals n s  = any (\(h,t) -> isPalindrome h && (length h * (n-1)) == length t && kPals (n-1) t) (splits s)
  where splits s = zip (inits s) (tails s)

main = do
    s <- getLine
    n <- fmap read getLine
    putStr $ if kPals n s then "YES" else "NO"

import Control.Applicative
import Data.List

palindrome x = x== reverse x

chunks n [] = []
chunks n s = (take n s ): (chunks n (drop n s))

main= do
	s<-  getLine
	n<- read <$> getLine ::IO Int
	let k = div (length s ) n
	putStrLn $ if all palindrome $ chunks k s then "YES" else "NO"

-- http://codeforces.com/problemset/problem/547/A

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

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

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		strs = slice sublen s
		palin_strs = map reverse strs

	case strs == palin_strs of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

	return ()

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

-- http://codeforces.com/problemset/problem/547/A

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

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

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

allEqualLen :: [[a]] -> Bool
allEqualLen [] = False
allEqualLen (x:xs) = allEqualLen' (length x) xs
	where
		allEqualLen' :: Int -> [[a]] -> Bool
		allEqualLen' _ [] = True
		allEqualLen' len (x:xs)
			| length x == len = allEqualLen' len xs
			| otherwise = False

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		strs = slice sublen s
		palin_strs = map reverse strs

	case allEqualLen strs && strs == palin_strs of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

	return ()

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

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes len str = checkPalindromes' Set.empty len str
	where
		checkPalindromes' :: Set.Set String -> Int -> String -> Bool
		checkPalindromes' _ _ [] = True
		checkPalindromes' set len str
			|
				substr `Set.notMember` set &&
				length substr == len &&
				substr == reverse substr = checkPalindromes' (Set.insert substr set) len newstr
			|
				otherwise = False
			where
				substr = take len str
				newstr = drop len str

-- http://codeforces.com/problemset/problem/547/A

import qualified Data.Set as Set

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

main = do

	s <- getLine
	k <- fmap read $ getLine :: IO Int

	let
		sublen = (length s) `quot` k
		result = checkPalindromes sublen s

	case result of
		True -> putStrLn "YES"
		False -> putStrLn "NO"

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

checkPalindromes :: Int -> String -> Bool
checkPalindromes 0 _ = False
checkPalindromes _ [] = True
checkPalindromes len str
	|
		length substr == len &&
		substr == reverse substr = checkPalindromes len newstr
	|
		otherwise = False
	where
		substr = take len str
		newstr = drop len str

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- 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 qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  s <- getLine
  k <- readLn

  let
    l = length s `div` k
    ss = unfoldr (\s -> if null s then Nothing else Just $ splitAt l s) s
    check s = s == reverse s

  putStrLn $ if all check ss then "YES" else "NO"

import Control.Applicative ((<$>), (<*>))
import Data.List (unfoldr)

main :: IO ()
main = putStrLn <$> yesno =<< solve <$> getLine <*> readLn

solve :: String -> Int -> Bool
solve s k = all palindrome $ splitN (length s `div` k) s

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Control.Applicative ((<$>), (<*>))
import Control.Arrow ((&&&))
import Data.List (unfoldr)

main :: IO ()
main = putStrLn <$> yesno =<< solve <$> getLine <*> readLn

solve :: String -> Int -> Bool
solve s k = all (uncurry (&&) . ((==length s `div` k) . length &&& palindrome)) $ splitN (length s `div` k) s

palindrome :: Eq a => [a] -> Bool
palindrome xs = xs == reverse xs

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Data.List

isPalindrome "" = False
isPalindrome s = s == reverse s

kPals 0 _ = True
kPals n s = any (\(h,t) -> isPalindrome h && kPals (n-1) t) (splits s)
  where splits s = zip (inits s) (tails s)

main = do
    s <- getLine
    n <- fmap read getLine
    putStr $ if kPals n s then "YES" else "NO"


import Data.Either

primes = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31]

main = getLine >>= test . read

test 0 = return ()
test t = do
    getLine
    as <- map read . words <$> getLine
    let sol = rights $ f 1 (Left <$> as) primes
    print $ maximum sol
    putStrLn $ unwords $ show <$> sol
    test $ pred t

f _ as [] = as
f c as (p:ps)
    | any ((== 0).(`mod` p)) $ lefts as = f (succ c) (recolor c p <$> as) ps
    | otherwise = f c as ps

recolor c p = either (\a -> if a `mod` p == 0 then Right c else Left a) Right

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

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

routine :: IO ()
routine = do
    _ <- getLine
    xs <- (map read.words) <$> getLine
    putStrLn $ tidy $ solve xs

primes :: [(Int,Int)]
primes =zip [2,3,5,7,11,13,17,19,23,29,31] [1..]

solve :: [Int] -> [Int]
solve xs = map f xs
  where
    f x = snd $ head $ filter (\(p,_) -> x `mod` p == 0) primes

tidy :: [Int] -> String
tidy cs = (show m) ++ "\n" ++ (unwords.map show) newcs
  where
    nubbed = zip (nub cs) [(1::Int)..]
    f = fromJust . ((flip lookup) nubbed)
    newcs = map f cs
    m = length nubbed


-- import Debug.Trace

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-b, -a)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numMinus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

import Data.List
import Data.Maybe

data Equation = Equation {
    expression :: [Term]
  , equationResult :: Int
}

instance Show Equation where
  show (Equation exp n) = unwords $ (tail . concatMap showTerm $ exp) ++ ["=", show n]
    where
      showTerm (Term sign (Just value)) = [[sign], show value]
      showTerm (Term sign _) = [[sign], "?"]

type Sign = Char

data Term = Term {
    termSign :: Sign
  , termValue :: Maybe Int
}

countSign :: Sign -> [Term] -> Int
countSign sign = length . filter ((==sign) . termSign)

solve :: String -> Maybe String
solve s = let
    eq@(Equation exp n) = equationFromString s
    c1 = countSign '+' exp
    c2 = countSign '-' exp
    inRange = c1 - n * c2 <= n && n <= n * c1 - c2
    sum2 = max (c1 - n) c2
    sum1 = n + sum2
    exp' = fillExpression n sum1 sum2 c1 c2 exp
  in if inRange then Just (show (Equation exp' n)) else Nothing

fillExpression :: Int -> Int -> Int -> Int -> Int -> [Term] -> [Term]
fillExpression n sum1 sum2 c1 c2 exp = case exp of
  [] -> []
  ((Term '+' _):ts) -> Term '+' (Just x1) : fillExpression n (sum1 - x1) sum2 (c1 - 1) c2 ts
  ((Term '-' _):ts) -> Term '-' (Just x2) : fillExpression n sum1 (sum2 - x2) c1 (c2 - 1) ts
  where
    x1 = min n (sum1 - (c1 - 1))
    x2 = min n (sum2 - (c2 - 1))

equationFromString :: String -> Equation
equationFromString s = let
  (sL, (_:sR)) = splitAt (fromJust $ elemIndex '=' s) s
  signs = ('+':) . catMaybes . map f $ sL
  exp = map (flip Term Nothing) signs
  n = read sR :: Int
  f c = case c of
    '+' -> Just '+'
    '-' -> Just '-'
    _ -> Nothing
  in Equation exp n

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

import Data.List
main = do
    s <- getLine
    let signs = filter (\c -> c == '+' || c == '-') s
        n = read . drop 1 . dropWhile (/= '=') $ s
        npos = 1 + length (elemIndices '+' signs)
        nneg = length (elemIndices '-' signs)

        cand = if nneg == 0
               then [[solve npos n, []]]
               else [[replicate npos 1, solve nneg (npos-n)],
                     [solve npos (n+nneg), replicate nneg 1]]

        res = filter (all (all (\x -> x >= 1 && x <= n))) cand
        [(p:pos), neg] = head res

        pairs = merge signs pos neg

        rest = concatMap (\(c, m) -> " " ++ [c] ++ " " ++ show m) pairs

    if null res
    then putStrLn "Impossible"
    else do
        putStrLn "Possible"
        putStrLn $ show p ++ rest ++ " = " ++ show n

merge :: String -> [Int] -> [Int] -> [(Char, Int)]
merge [] _ _ = []
merge ('+':srest) (p:prest) neg = ('+',p) : merge srest prest neg
merge ('-':srest) pos (n:nrest) = ('-',n) : merge srest pos nrest
merge _ _ _ = error "Unexpected data in merge"

solve :: Int -> Int -> [Int]
solve n sum = map (+1) $ replicate (n - s `mod` n) (s `div` n) ++ replicate (s `mod` n) ((s + n-1) `div` n)
    where s = sum - n

-- import Debug.Trace

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-b, -a)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numPlus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq

data Rebus = Rebus {
    expression :: [Char]
  , rebusN :: Int
}

countPlus :: [Char] -> Int
countPlus e  = 1 + countChar '+' e

countMinus :: [Char] -> Int
countMinus e = countChar '-' e

countChar :: Char -> [Char] -> Int
countChar c = length . filter (==c)

makeRange :: Int -> Int -> (Int, Int)
-- Range of the sum of m integers in [1, n]
makeRange m n = (m, m * n)

negateRange (a, b) = (-a, -b)
plusRange (a1, b1) (a2, b2) = (a1 + a2, b1 + b2)

inRange n (a, b) = a <= n && n <= b

constructNums [] n sumPlus sumMinus nPlus nMinus = []
constructNums (x:xs) n sumPlus sumMinus nPlus nMinus = let
    numPlus = min n (sumPlus - (nPlus - 1))
    numMinus = min n (sumMinus - (nMinus - 1))
  in if x == '+'
     then numPlus : constructNums xs n (sumPlus - numPlus) sumMinus (nPlus - 1) nMinus
     else numMinus : constructNums xs n sumPlus (sumMinus - numPlus) nPlus (nMinus - 1)

rebusFromString :: String -> Rebus
rebusFromString s = let
    s' = filter (/=' ') s
    (exp, n) = splitAt (length . takeWhile (/='=') $ s') s'
    n' = read $ tail n :: Int
  in Rebus exp n'

fillExpression :: [Char] -> [Int] -> String
fillExpression exp nums = unwords $ combine exp nums where
  combine (x:xs) (y:ys)
    | x == '?' = show y : combine xs ys
    | otherwise = [x] : combine xs (y:ys)
  combine xs _ = map (:[]) xs

showRebus (Rebus exp n) nums = fillExpression exp nums ++ " = " ++ show n

solve :: String -> Maybe String
solve s = let
    rebus@(Rebus exp n) = rebusFromString s
    c1 = countPlus exp
    c2 = countMinus exp
    rangePlus@(a1, b1) = makeRange c1 n
    rangeMinus@(a2, b2) = makeRange c2 n
    range = plusRange rangePlus (negateRange rangeMinus)
    sumMinus = max (a1 - n) a2
    sumPlus = sumMinus + n
    nums = constructNums ('+':filter (/='?') exp) n sumPlus sumMinus c1 c2
    result = showRebus rebus nums
  in if inRange n range then Just result else Nothing

main = do
  s <- getLine
  putStrLn $ case solve s of
    Nothing -> "Impossible"
    Just eq -> "Possible\n" ++ eq


import Data.Array.Unboxed
import Control.Monad( replicateM)
main = do
    let readLine = return . map read . words =<< getLine
    [_n,_m] <- readLine
    _as <- readLine
    let readPair = do
	    [l,r] <- return . map (read::String->Int) . words =<< getLine
	    return (l,r)
    bounds <- replicateM _m readPair
    let _arr = listArray (1,_n) _as::UArray Int Int
	happineses = map f bounds
	    where f (l,r) = let v = sum $ map (_arr!) [l..r]
			    in if v>0 then v else 0
    print $ sum happineses

{-# 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
	[ n, m ] <- readInts
	as <- readInts
	segments <- replicateM m $ do
		lr <- readInts
		return $ mp lr
	let
		sublists = map ( $ as ) $ map sublist segments
	print $ sum $ filter ( >= 0 ) $ map sum sublists

sublist ( l, r ) = take ( r - l + 1 ) . drop ( l - 1 )

module Main (main) where

import Control.Monad
import Data.List

getm :: [Int] -> Int -> Int -> IO Int
getm nl acc _ = do
  lr <- getLine
  let l:r:_ = map read $ words lr :: [Int]
  let t = sum (drop (l-1) $ take r nl)
  return $ if t < 0
    then acc
    else acc + t

main :: IO ()
main = do
  dum <- getLine
  let n:m:_ = map read $ words dum :: [Int]
  nl <- getLine
  let an = map read $ words nl :: [Int]
  g <- foldM (getm an) 0 [1..m]
  print g

import Data.Array
main = interact $ show . solve . map (map read . words) . lines

solve ([n,_]:(f:ns):qs) = sum $ map (max 0 . query) qs
  where sa = array (1, n) $ (1,f) : [(i, v + (sa ! (i - 1))) | (i,v) <- [2..] `zip` ns]
        query [l, r] = (sa ! r) - sum [sa ! (l-1) | l > 1]


{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.List as L (sortBy, intercalate)

readInt = fst . M.fromJust . C.readInt

cmp (a, b, i) (c, d, j) = compare c a
tk (_, _, i) = i

run ((_, b, i):(_, d, j):cs) ans | b >= d = run cs (i:ans) | otherwise = run cs (j:ans)
run [] ans = ans

main = do
    (readInt -> n) <- B.getLine
    (map readInt . C.words -> as) <- B.getLine
    (map readInt . C.words -> bs) <- B.getLine
    let cs = L.sortBy cmp (zip3 as bs [1..])
        ans | even n = tk (head cs):tk (cs !! 1):run (drop 2 cs) []
            |  odd n = tk (head cs):run (tail cs) []
    putStrLn $ show $ length ans
    putStrLn $ L.intercalate " " (map show ans)

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List             (sortBy)
import           Data.Ord

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

solution::(Ord a, Ord b)=>[a]->[b]->[Int]
solution as bs = let ((_, x):xs) = sortBy cmpA $ as `zip` bs `zip` [1..]
                     cmpA = comparing $ Down .fst .fst
                     res = x: go xs
                     go (((_, b1), i1): ((_, b2), i2): rest )
                        | b1 > b2   = i1 : go rest
                        | otherwise = i2 : go rest
                     go [(_, i)] = [i]
                     go []       = []
                 in res

main = do
  void getLine
  sol <- solution <$> getInts <*> getInts
  print $ length sol
  putStrLn $ unwords $ show <$> sol

import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as BS
import           Data.List             (sortBy)
import           Data.Ord

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

solution::(Ord a, Ord b)=>[a]->[b]->[Int]
solution as bs = let ((_, x):xs) = sortBy cmpA $ as `zip` bs `zip` [1..]
                     cmpA = comparing $ Down .fst .fst
                     res = x: go xs
                     go (((_, b1), i1): ((_, b2), i2): rest )
                        | b1 > b2   = i1 : go rest
                        | otherwise = i2 : go rest
                     go _ = []
                 in res

main = do
  void getLine
  sol <- solution <$> getInts <*> getInts
  print $ length sol
  putStrLn $ unwords $ show <$> sol


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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  -- mirrorOf 'i' 'i' = True --questionable
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  -- mirrorOf 'n' 'n' = True -- questionable
  -- mirrorOf 'm' 'm' = True -- questionable
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  -- mirrorOf 'u' 'u' = True -- questionable
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

-- ID:  691B (s-palindrome)
-- URL: http://codeforces.com/problemset/problem/691/B

import Data.List

pairs = [
    ('A','A'), ('b','d'), ('d','b'), ('H','H'), ('I','I'),
    ('M','M'),
    ('O','O'), ('o','o'), ('p','q'), ('q','p'), ('T','T'),
    ('U','U'), ('V','V'), ('v','v'), ('W','W'),
    ('w','w'), ('X','X'), ('x','x'), ('Y','Y')
    ]

mirror [] = []
mirror (x:xs) = case lookup x pairs of
    Nothing -> '?' : mirror xs
    Just y -> y : mirror xs

palindrome str = mirror left == reverse right where
    n = length str
    m = n `div` 2
    left = if odd n then take (m+1) str else take m str
    right = drop m str

main = do
    str <- getLine
    if palindrome str
    then putStrLn "TAK"
    else putStrLn "NIE"

{-# 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
	s <- getLine
	putStrLn $ which "TAK" "NIE" $ and $ zipWith f s $ reverse s

f a b
	| a == b = a `elem` "AHIMOoTUVvWwXxY"
	| otherwise = syn a b
		where
			syn 'b' 'd' = True
			syn 'd' 'b' = True
			syn 'p' 'q' = True
			syn 'q' 'p' = True
			syn _ _ = False

main = interact $ solve . head . words
solve s
 | s == (reverse $ map ch s) = "TAK"
 | otherwise = "NIE"

ch 'p' = 'q'
ch 'q' = 'p'
ch 'b' = 'd'
ch 'd' = 'b'
ch 'o' = 'o'
ch 'A' = 'A'
ch 'H' = 'H'
ch 'I' = 'I'
ch 'M' = 'M'
ch 'O' = 'O'
ch 'T' = 'T'
ch 'U' = 'U'
ch 'V' = 'V'
ch 'W' = 'W'
ch 'X' = 'X'
ch 'Y' = 'Y'
ch 'v' = 'v'
ch 'w' = 'w'
ch 'x' = 'x'
ch l = toEnum $ (fromEnum l) + 40

-- ID:  691B (s-palindrome)
-- URL: http://codeforces.com/problemset/problem/691/B

import Data.List

pairs = [
    ('A','A'), ('b','d'), ('d','b'), ('H','H'), ('I','I'),
    ('M','M'), ('m','m'), ('n','n'),
    ('O','O'), ('o','o'), ('p','q'), ('q','p'), ('T','T'),
    ('U','U'), ('u','u'), ('V','V'), ('v','v'), ('W','W'),
    ('w','w'), ('X','X'), ('x','x'), ('Y','Y'), ('Z','Z'),
    ('z','z')]

mirror [] = []
mirror (x:xs) = case lookup x pairs of
    Nothing -> '?' : mirror xs
    Just y -> y : mirror xs

palindrome str = mirror left == reverse right where
    n = length str
    m = n `div` 2
    left = if odd n then take (m+1) str else take m str
    right = drop m str

main = do
    str <- getLine
    if palindrome str
    then putStrLn "TAK"
    else putStrLn "NIE"

-- ID:  691B (s-palindrome)
-- URL: http://codeforces.com/problemset/problem/691/B

import Data.List

pairs = [
    ('A','A'), ('b','d'), ('d','b'), ('H','H'), ('I','I'),
    ('i','i'), ('l','l'), ('M','M'), ('m','m'), ('n','n'),
    ('O','O'), ('o','o'), ('p','q'), ('q','p'), ('T','T'),
    ('U','U'), ('u','u'), ('V','V'), ('v','v'), ('W','W'),
    ('w','w'), ('X','X'), ('x','x'), ('Y','Y'), ('Z','Z'),
    ('z','z')]

mirror [] = []
mirror (x:xs) = case lookup x pairs of
    Nothing -> '?' : mirror xs
    Just y -> y : mirror xs

palindrome str = mirror left == right where
    n = length str
    m = n `div` 2
    left = take m str
    right = if odd n then drop (m+1) str else drop m str

main = do
    str <- getLine
    if palindrome str
    then putStrLn "TAK"
    else putStrLn "NIE"

-- ID:  691B (s-palindrome)
-- URL: http://codeforces.com/problemset/problem/691/B

import Data.List

pairs = [
    ('A','A'), ('b','d'), ('d','b'), ('H','H'), ('I','I'),
    ('i','i'), ('l','l'), ('M','M'), ('m','m'), ('n','n'),
    ('O','O'), ('o','o'), ('p','q'), ('q','p'), ('T','T'),
    ('U','U'), ('u','u'), ('V','V'), ('v','v'), ('W','W'),
    ('w','w'), ('X','X'), ('x','x'), ('Y','Y'), ('Z','Z'),
    ('z','z')]

mirror [] = []
mirror (x:xs) = case lookup x pairs of
    Nothing -> '?' : mirror xs
    Just y -> y : mirror xs

palindrome [x] = mirror [x] == [x]
palindrome str = mirror left == right where
    n = length str
    m = n `div` 2
    left = take m str
    right = if odd n then drop (m+1) str else drop m str

main = do
    str <- getLine
    if palindrome str
    then putStrLn "TAK"
    else putStrLn "NIE"

-- ID:  691B (s-palindrome)
-- URL: http://codeforces.com/problemset/problem/691/B

import Data.List

pairs = [
    ('A','A'), ('b','d'), ('d','b'), ('H','H'), ('I','I'),
    ('i','i'), ('l','l'), ('M','M'), ('m','m'), ('n','n'),
    ('O','O'), ('o','o'), ('p','q'), ('q','p'), ('T','T'),
    ('U','U'), ('u','u'), ('V','V'), ('v','v'), ('W','W'),
    ('w','w'), ('X','X'), ('x','x'), ('Y','Y'), ('Z','Z'),
    ('z','z')]

mirror [] = []
mirror (x:xs) = case lookup x pairs of
    Nothing -> '?' : mirror xs
    Just y -> y : mirror xs

palindrome str = mirror left == reverse right where
    n = length str
    m = n `div` 2
    left = if odd n then take (m+1) str else take m str
    right = drop m str

main = do
    str <- getLine
    if palindrome str
    then putStrLn "TAK"
    else putStrLn "NIE"

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  mirrorOf 'J' 'L' = True -- questionable
  mirrorOf 'L' 'J' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  -- mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'L' 'J' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'L' 'J' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  -- mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  mirrorOf 'J' 'L' = True -- questionable
  mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'n' 'n' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True -- questionable
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  mirrorOf 'J' 'L' = True -- questionable
  mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'd' 'b' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  -- mirrorOf 'i' 'i' = True --questionable
  -- mirrorOf 'J' 'L' = True -- questionable
  -- mirrorOf 'l' 'l' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'n' 'n' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'p' 'q' = True
  mirrorOf 'q' 'p' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  -- mirrorOf 'u' 'u' = True -- questionable
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

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

  mirrorOf :: Char -> Char -> Bool
  mirrorOf 'A' 'A' = True
  mirrorOf 'b' 'd' = True
  mirrorOf 'H' 'H' = True
  mirrorOf 'I' 'I' = True
  mirrorOf 'i' 'i' = True
  mirrorOf 'J' 'L' = True -- questionable
  mirrorOf 'M' 'M' = True
  mirrorOf 'm' 'm' = True
  mirrorOf 'O' 'O' = True
  mirrorOf 'o' 'o' = True
  mirrorOf 'T' 'T' = True
  mirrorOf 'U' 'U' = True
  mirrorOf 'u' 'u' = True
  mirrorOf 'V' 'V' = True
  mirrorOf 'v' 'v' = True
  mirrorOf 'W' 'W' = True
  mirrorOf 'w' 'w' = True
  mirrorOf 'X' 'X' = True
  mirrorOf 'x' 'x' = True
  mirrorOf 'Y' 'Y' = True
  mirrorOf _ _ = False

  -- converting list to Set
  -- let mySet = S.fromList myList

  solve :: String -> Bool
  solve xs =
    let ys = reverse xs
        xys = zip xs ys
        mof = (\(x,y) -> x `mirrorOf` y)
        in all mof xys

  main :: IO()
  main = do
    xs <- getLine >>= return . filter (/='\n')
    let result = case solve xs of
                   True -> "TAK"
                   False -> "NIE"
    putStrLn result

main = interact solve
solve s
 | s == (reverse $ map ch s) = "TAK"
 | otherwise = "NIE"

ch 'p' = 'q'
ch 'q' = 'p'
ch 'b' = 'd'
ch 'd' = 'b'
ch 'o' = 'o'
ch 'A' = 'A'
ch 'O' = 'O'
ch 'H' = 'H'
ch 'M' = 'M'
ch 'I' = 'I'
ch 'T' = 'T'
ch 'U' = 'U'
ch 'V' = 'V'
ch 'W' = 'W'
ch 'X' = 'X'
ch 'Y' = 'Y'
ch 'v' = 'v'
ch 'w' = 'w'
ch l = toEnum $ (fromEnum l) + 40


import Data.List
import Data.Char

mode::String->String
mode a = show ( read a :: Int )

cannot::String->Bool
cannot a = (mode a /= a) || ( read a>255 )

gao::String->(Int,Int,Int,Int)->[String]
gao a (x1,x2,x3,x4) = if(x1+x2+x3+x4/=length a) then []
					  else if(cannot a1 || cannot a2 || cannot a3 || cannot a4)then []
					  else [a1 ++ "." ++ a2 ++ "." ++ a3 ++ "." ++ a4]
	where (a1,tmp1)=splitAt x1 a
	      (a2,tmp2)=splitAt x2 tmp1
	      (a3,a4)=splitAt x3 tmp2

check1::String->[String]
check1 a=foldl (\ans p -> gao a p ++ ans) [] [(x1,x2,x3,x4) | x1<-p,x2<-p,x3<-p,x4<-p]
	where p=[1,2,3]

check::String->String->[String]
check d a= if(ok==length d)
		       then ( check1 $ a ++ ( reverse a ) ) ++ ( check1 $ a ++ ( tail (reverse a) ) )
		   else []
	where ok=sum [ ( if (x `elem` a) then  1 else 0 ) | x<-d ]

dfs::[Char]->String->Int->[String]
dfs _ _ 0 = []
dfs d a n = foldl (\t di -> check d (di:a) ++ ( dfs d (di:a) (n-1) ) ++ t) [] d

main :: IO()
main = do
	input <- getContents
	let
		(n:a) = map read ( words input )::[Int]
		ans=if n>6 then []
		    else  dfs ( map  ((!!0).show) a ) [] 6
	print $ length ans
	mapM_ putStrLn ans

import Data.List

main::IO()
main =
 do
 input <- getContents
 let
  (n:an) = map read (words input)::[Int]
 if n>6
  then print (0::Int)
  else
   let
    string = [filter (\t->((length $ group $ sort t)==n)) [[x,y,z,u,v,w],[x,y,z,u,v],[x,y,z,u],[x,y,z],[x,y]] |x<-an,y<-an,z<-an,u<-an,v<-an,w<-an]

    getAns::[[[Int]]]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns [] ans = ans
    getAns (x:xs) ans =
     getAns xs (getAns' x ans)

    getAns'::[[Int]]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns' [] ans = ans
    getAns' (x:xs) ans =
     getAns' xs (getAns'' (x++(reverse x)) (getAns'' (x++(tail $ reverse x)) ans))

    getAns''::[Int]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns'' x ans =
     [get i j k|i<-[1..l-1],j<-[i+1..l-1],k<-[j+1..l-1],0+1==i||(x!!0)/=0,i+1==j||(x!!i)/=0,j+1==k||(x!!j)/=0,k+1==l||(x!!k)/=0,check i j k]++ans
     where
      l=length x
      get i j k =
       (a,b,c,d)
       where
        a = func (take i x) 0
        b = func (drop i (take j x)) 0
        c = func (drop j (take k x)) 0
        d = func (drop k x) 0
        func [] t = t
        func (y:ys) t = func ys (t*10+y)
      check i j k =
       a<256&&b<256&&c<256&&d<256
       where
        a = func (take i x) 0
        b = func (drop i (take j x)) 0
        c = func (drop j (take k x)) 0
        d = func (drop k x) 0
        func [] t = t
        func (y:ys) t = func ys (t*10+y)
    _ans = map head (group $ sort $ getAns string [])
    printAll::[(Int,Int,Int,Int)]->IO()
    printAll [] = return ()
    printAll ((a,b,c,d):xs) =
     do
      putStr $ show a
      putStr "."
      putStr $ show b
      putStr "."
      putStr $ show c
      putStr "."
      putStr $ show d
      putStr "\n"
      printAll xs
   in
    do
     print $ length _ans
     printAll _ans

import Data.List

main::IO()
main =
 do
 input <- getContents
 let
  (n:an) = map read (words input)::[Int]
 if n>6
  then print (0::Int)
  else
   let
    string = [filter (\t->((length $ group $ sort t)==n)) [[x,y,z,u,v,w],[x,y,z,u,v],[x,y,z,u],[x,y,z],[x,y]] |x<-an,y<-an,z<-an,u<-an,v<-an,w<-an]

    getAns::[[[Int]]]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns [] ans = ans
    getAns (x:xs) ans =
     getAns xs (getAns' x ans)

    getAns'::[[Int]]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns' [] ans = ans
    getAns' (x:xs) ans =
     getAns' xs (getAns'' (x++(reverse x)) (getAns'' (x++(tail $ reverse x)) ans))

    getAns''::[Int]->[(Int,Int,Int,Int)]->[(Int,Int,Int,Int)]
    getAns'' x ans =
     [get i j k|i<-[1..l-1],j<-[i+1..l-1],k<-[j+1..l-1],0+1==i||(x!!0)/=0,i+1==j||(x!!i)/=0,j+1==k||(x!!j)/=0,k+1==l||(x!!k)/=0,check i j k]++ans
     where
      l=length x
      get i j k =
       (a,b,c,d)
       where
        a = func (take i x) 0
        b = func (drop i (take j x)) 0
        c = func (drop j (take k x)) 0
        d = func (drop k x) 0
        func [] t = t
        func (y:ys) t = func ys (t*10+y)
      check i j k =
       a<256&&b<256&&c<256&&d<256
       where
        a = func (take i x) 0
        b = func (drop i (take j x)) 0
        c = func (drop j (take k x)) 0
        d = func (drop k x) 0
        func [] t = t
        func (y:ys) t = func ys (t*10+y)
    _ans = getAns string []
    printAll::[(Int,Int,Int,Int)]->IO()
    printAll [] = return ()
    printAll ((a,b,c,d):xs) =
     do
      putStr $ show a
      putStr "."
      putStr $ show b
      putStr "."
      putStr $ show c
      putStr "."
      putStr $ show d
      putStr "\n"
      printAll xs
   in
    do
     print $ length _ans
     printAll _ans