import Data.Graph
import Data.Array
import Control.Monad

solve n e
   | length kicked == 0 = 0
   | otherwise = solve n e' + 1
   where g      = buildG (1, n) e
         kicked = [ i | i <- [1..n], indegree g ! i == 1 ]
         e'     = (\(x, y) -> not (elem x kicked || elem y kicked)) `filter` e

main = do
   [n, m] <- fmap (map read . words) getLine
   e <- fmap concat . forM [1..m] $ \_ -> fmap ((\[x,y] -> [(x,y),(y,x)]) . map read . words) getLine
   print $ solve n e

-- vim: set expandtab:

import Data.List
import Debug.Trace (trace)

main2 = print $ solve [(1,2), (2,3), (3,4)]
--main = print $ groupBy (\(x,_) (y,_) -> x == y) [(1,2),(1,3),(3,4),(2,1),(3,2),(4,3)]
main =
	do
		[n, m] <- getNums
		lines <- getLines m
		putStrLn $ show $ solve $ (lines |> map (tuple . getNumbers))

solve l = iterate (\(r,n) -> getGroup r) (l,0) |> drop 1 |> takeWhile (\(_,n) -> n > 0) |> length

getGroup l = (r, (length l) - (length r))
	where
		l2 = (l ++ (map swap l)) |> sort
		ones = (groupBy (\(x,_) (y,_) -> x == y) l2) |> filter (\x -> length x == 1) |> map (fst . head)
		r = l |> filter (\(x,y) -> ones |> any (\z -> (z == x) || (z == y)) |> not)

swap (x,y) = (y,x)
tuple [x,y] = (x,y)
------------------utils-----------------------
tr x y = trace ((show x) ++ (show y)) y
tr1 x y = trace ((show x)) y
tr2 y = trace ((show y)) y

(|>) x f = f x

parseInt x = (read x) :: Int

getIndex = zip [0..]

getLines n = repeat getLine |> take n |> sequence

getNums ::  IO [Int]
getNums =
	do
		line <- getLine
		return $ getNumbers line

getNumbers ::  [Char] -> [Int]
getNumbers line =
	case index of
		Nothing -> [parseInt line]
		Just i ->
			let (l,r) = splitAt (i + 1) line in
				(parseInt l) : (getNumbers r)
	where
		index = elemIndex ' ' line

splitBy k =
	case index of
		Nothing -> [k]
		Just i ->
			let (l,r) = splitAt (i) k in
				l : splitBy (drop 1 r)
	where
		index = elemIndex ' ' k

import Debug.Trace

zipList :: [a] -> [(a, a)]
zipList [] = []
zipList (x:y:xs) = (x, y) : zipList xs
zipList _  = error "invalid list"

construct :: Int -> [(Int, Int)] -> [(Int, [Int])]
construct n lst = [(i, test i) | i <- [0..n-1]]
    where test i = let tmp = filter (check i) lst
                   in  map (get i) tmp
          check i (a, b) = a - 1 == i || b - 1 == i
          get i (a, b)   = a + b - i - 2

solve :: [(Int, [Int])] -> Int
solve g = let del = filter ((== 1) . length . snd) g
          in if null del
             then 0
             else 1 + (solve $ update g del)
    where update g del = let gg = filter ((/= 1) . length . snd) g
                             dd = map fst del
                         in update' gg dd
          update' gg dd = map (test dd) gg
          test dd (a, b) = (a, filter (flip notElem dd) b)

main :: IO()
main = do cs <- getContents
          let lst   = map read $ words cs :: [Int]
              n     = lst !! 0
              m     = lst !! 1
              rest  = drop 2 lst
              pairs = zipList rest
              graph = construct n pairs
          print $ solve graph

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

import Control.Applicative
import Control.Monad
import Data.Array.IO
import qualified Data.IntSet as IntSet

readInts :: IO [Int]
readInts = map read . words <$> getLine

solve :: (Int, Int) -> IOArray Int IntSet.IntSet -> IO Int
solve bounds buf = loop 0
 where
  loop n = do
    let f acc a = do
          set <- readArray buf a
          if IntSet.size set /= 1 then return acc else return $ a : acc
    as  <- foldM f [] (range bounds)
    notYet <- fmap or . forM as $ \a -> do
      set <- readArray buf a
      if IntSet.size set /= 1
        then return False
        else do
          let b = IntSet.findMax set
          set' <- readArray buf b
          writeArray buf b $ IntSet.delete a set'
          writeArray buf a $ IntSet.delete b set
          return True
    if not notYet
      then return n
      else loop (n + 1)

main :: IO ()
main = do
  [n, m]    <- readInts
  let bounds = (1, n)
  buf       <- newArray bounds IntSet.empty :: IO (IOArray Int IntSet.IntSet)
  replicateM_ m $ do
    [a, b]  <- readInts
    readArray buf a >>= writeArray buf a . (IntSet.insert b)
    readArray buf b >>= writeArray buf b . (IntSet.insert a)
  solve bounds buf >>= print

import Debug.Trace

zipList :: [a] -> [(a, a)]
zipList [] = []
zipList (x:y:xs) = (x, y) : zipList xs
zipList _  = error "invalid list"

construct :: Int -> [(Int, Int)] -> [(Int, [Int])]
construct n lst = [(i, test i) | i <- [0..n-1]]
    where test i = let tmp = filter (check i) lst
                   in  map (get i) tmp
          check i (a, b) = a - 1 == i || b - 1 == i
          get i (a, b)   = a + b - i - 1

solve :: [(Int, [Int])] -> Int
solve g = let del = filter ((== 1) . length . snd) g
          in if null del
             then 0
             else 1 + (solve $ update g del)
    where update g del = let gg = filter ((/= 1) . length . snd) g
                             dd = map fst del
                         in update' gg dd
          update' gg dd = map (test dd) gg
          test dd (a, b) = (a, filter (flip notElem dd) b)

main :: IO()
main = do cs <- getContents
          let lst   = map read $ words cs :: [Int]
              n     = lst !! 0
              m     = lst !! 1
              rest  = drop 2 lst
              pairs = zipList rest
              graph = construct n pairs
          print $ solve graph


import Control.Monad (forM_)

linefun line = (<) 1 . length . filter (== "1") $ words line

main = putStrLn . show . length . filter linefun . tail . lines =<< getContents

import Data.List
import Control.Applicative

solve :: [Int] -> Bool
solve = (>= 2) . length . filter ((==) 1)

main = do
  (_:cases) <- fmap (fmap read) . fmap words . lines <$> getContents
  let n = length $ filter id $ fmap solve cases
  print n

import Control.Monad

main = interact program

program :: String -> String
program input =
    let _:ts = lines input
        count1 = length . filter (== "1") . words
        pass = (>= 2) . count1
        results = length $ filter pass ts
    in show results

import           Control.Monad (replicateM)

main = do
   n <- readLn
   ls <- replicateM n getLine
   print $ length $ filter (\s -> length (filter (== '1') s) >= 2) ls

import Control.Monad

main = do
    n <- getLine
    inputs <- replicateM (read n) (getLine)
    print $ parseInputs inputs

parseInputs []   = 0
parseInputs (x:xs)
    | (sum (map read (words x))) > 1 = 1 + parseInputs xs
    | otherwise = parseInputs xs

module Main where

import Data.Maybe (fromJust)
import Control.Monad (foldM, sequence)
import qualified Data.ByteString.Char8 as BS

readNumber :: IO Int
readNumber =
  (fst
   . fromJust
   . BS.readInt) `fmap` BS.getLine

readNumbers :: IO [Int]
readNumbers =
 (fromJust
  . fmap (map fst)
  . sequence
  . map BS.readInt
  . BS.words) `fmap` BS.getLine

main :: IO ()
main = do
  nCases <- readNumber
  result <- foldM (\acc _ -> do
                    howManyKnow <- sum `fmap` readNumbers
                    return (if (howManyKnow >= 2)
                            then succ acc
                            else acc))
                  0
                  [1..nCases]
  print result

module Main where
import Data.List

solve :: Integer -> [Integer] -> Integer
solve acc xs = acc + (if s >= 2 then 1 else 0)
               where s = foldl1' (+) xs

main = interact $ show . (foldl' solve 0) .  (map (map read)) . (map words) . (drop 1) . lines

import Control.Applicative
main= do
	getLine
	s<- length .filter (\z-> elem z ["1 1 1","1 1 0", "1 0 1", "0 1 1"]). lines <$> getContents
	print s

module Main where

--71A
--replicateM n x = sequence (replicate n x)

--processWord :: String -> String
--processWord word | length word > 10 = (head word) : (show (length word - 2)) ++ ((last word):[])--(word !! ((length word) - 1))
--                 | otherwise = word

--main = sequence [putStrLn $ show i | i <- [1..5]]
--main = getLine >>= \line -> replicateM (read line) (getLine) >>= \list -> sequence [putStrLn (processWord (list!!i)) | i <- [0..(length list) - 1]]

--118A
--import Data.Char
--isSylable :: Char -> Bool
--isSylable char = elem char "AOYEUIaoyeui"
--
--deleteSylabls::[Char] -> [Char]
--deleteSylabls [] = []
--deleteSylabls (x:xs) | isSylable x = deleteSylabls xs
--                     | otherwise = x:(deleteSylabls xs)
--
--addDots :: [Char] -> [Char]
--addDots [] = []
--addDots (x:xs) = '.' : x : (addDots xs)
--
--processWord :: String -> String
--processWord = addDots . deleteSylabls . (map toLower)
--
--main = getLine >>= putStrLn . processWord

--50A

--split :: Char -> String -> [String]
--split _ [] = [""]
--split c (x:xs) | x == c = "" : rest
--               | otherwise = (x : head rest): tail rest
--                where rest = split c xs
--
--calc :: Int -> Int -> Int
--calc  m n = m*n `div` 2
--
--main = getLine >>= \a -> let inp = (map read (split  ' ' a)) in putStrLn $ show $ calc (inp !! 0) (inp !! 1)

--231A

split :: Char -> String -> [String]
split _ [] = [""]
split c (x:xs) | x == c = "" : rest
               | otherwise = (x : head rest): tail rest
                where rest = split c xs

isGood :: [Int] -> Int
isGood (a:b:c:[]) = if (a+b+c >= 2) then 1 else 0

toIntList :: [[String]] -> [[Int]]
toIntList strs = map (map read) strs

main = getLine >>= \line -> sequence (replicate (read line) getLine) >>= \list -> putStrLn $ show $ sum $ map isGood (toIntList (map (split ' ') list))

main = do
  d <- getContents
  let (n:ls) = lines d
  let xs = map (map read . words) ls
  print $ length $ filter (\t -> sum t >= 2) xs

-- cf 231 a

main :: IO ()
main = getContents >>= (print . f 0 . map (map read . words) . tail . lines)

f :: Int -> [[Integer]]-> Int
f acc [] = acc
f acc (x : rem)
  | sum x > 1 = f (acc+1) rem
  | otherwise = f acc rem

import Control.Monad

main :: IO ()
main = do
    n:_ <- getList
    matrix <- getLists n
    print $ solve matrix

getList :: (Read a) => IO [a]
getList = fmap (fmap read . words) getLine

getLists :: (Read a) => Int -> IO [[a]]
getLists nRows = replicateM nRows getList

solve :: [[Int]] -> Int
solve matrix = length [row | row <- matrix, sum row >= 2]

main = do
    getLine
    interact (solve.(map (map read)).(map words).lines)
solve = show.(result 0)
result acc x
    |x==[]              = acc
    |sum(head x)>=2     = result (acc+1) (tail x)
    |otherwise          = result acc (tail x)

module Main where

(|>) = flip (.)

main = interact $
    lines
    |> drop 1
    |> map (words |> map read)
    |> map sum
    |> filter (>= 2)
    |> length
    |> show

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.State
import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  r <-
    replicateM n $ do
      q <- C.getLine
      let qs = fmap trim . (C.split ' ') $ q
      if (foldl score 0 qs) >= 2
        then return 1
        else return 0
  putStrLn . show . sum $ r

score :: Int -> C.ByteString -> Int
score s "1" = s + 1
score s _ = s

trim :: C.ByteString -> C.ByteString
trim s = C.filter (\c -> (||) (c == '1') (c == '0')) s

main = do
	dat <- getContents
	let allLines = tail $ lines dat
	putStrLn $ show $ answer allLines

answer :: [String] -> Int
answer = length . filter (\x -> x == "1 1 1" || x == "1 1 0" || x == "1 0 1" || x == "0 1 1")

main = do
	n<-getLine
	a<-getContents
	let k =map words $ lines a
	putStrLn $ show $ sum $ map (solve.map read) k

solve k = if length ( filter (==1) k) >=2 then 1
	      else 0

f xs | (sum xs) > 1 = 1 | 1>0 = 0
main = interact $ show.sum.map f.map (map read.words).tail.lines

import Data.Char
import System.IO

getWords :: String -> [String]
getWords str = words str

lineProc :: String -> [Integer]
lineProc str = map readInt (getWords(str))
	where readInt = read :: String -> Integer

sumAll :: [Integer] -> Integer
sumAll lst = sum lst

invoke :: Integer -> IO Integer
invoke n = if n == 0 then return $ 0 else do
	new_line <- getLine
	to_add <- invoke(n - 1)
	return $ (if (sumAll $ lineProc $ new_line) >= 2 then 1 else 0) + to_add

main = do
	n <- getLine
	result <- invoke (read n :: Integer)
	print $ result

solve x = show . sum . map (check . map read . words) $ (drop 1 $ lines x)
          where check x = if sum x > 1 then 1 else 0

main = interact solve

f x=show$length[ y | y<-[sum$map read (words n) | n<-(tail$lines x)],y>=2]
main=interact$f

main = interact $ show . length . filter ((> 1) . length) . map (filter (== '1')) . tail . lines

import Control.Monad

-- Snippet: readInts
readInts = do
    line <- getLine
    return $ map read $ words line

main = do
    n <- readLn
    answer <- replicateM n $ do
        s <- readInts
        return $ if sum s < 2 then 0 else 1
    putStrLn $ show $ sum answer

isGood s
    | (sum l) > 1 = 1
    | otherwise = 0
    where l = map (read :: String -> Int).words $ s

main = interact $ show.sum.map isGood.tail.lines

cYcle 0 m=do
	putStr $ show m
cYcle n m=do
    input<-getLine
    let t = words input
    let a = read (head t)
    let b = read (head (tail t))
    let c = read (head (tail (tail t)))
    let p = if a+b+c>1 then m+1 else m
    cYcle (n-1) p
main=do
    input<-getLine
    cYcle (read.head.words$input) 0

import Control.Monad
solve :: [[Int]] -> Int
solve [] = 0
solve (x : xs) = (if sum x > 1 then 1 else 0) + solve xs
main = do
    n <- readLn
    l <- replicateM n getLine
    print . solve $ map (map read . words) l

import Data.List
import Data.List.Split
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Char as C

(|>) = flip ($)

main = interact process

process contents = let
  problems = contents |> lines |> tail |> map words |> map (map read) :: [[Int]]
  in solve problems |> show

solve problems = problems
  |> map sum
  |> filter (>= 2)
  |> length

solve = length.filter (>1) . map sum

main = do
	v <- getContents
	print . solve . map (map read) . map words . tail . lines $ v

import Control.Applicative

main = interact $ show . length . filter (>1) . map (length . filter (=='1')) . tail . lines

main =
  print .
  length .
  filter (>1) .
  map (sum . map read . words) .
  tail .
  lines =<< getContents

main = readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \x-> interact $ show.foldr (\a b-> case () of
                                                                    _|a> 1 ->  1+b
                                                                     |otherwise -> b ) 0. map (foldr (\a b-> read a+b) 0. words). take (read x) . lines

main = interact $ show . length . filter (> 1) . map (sum . map read . words) . tail . lines

solve :: String -> Integer
solve all =
    let
      conv = map (map (read::String->Integer)) $ map words .tail $ lines all
    in foldl (\acc x -> if x > 1 then acc + 1 else acc) 0 $ map sum conv
main = do
    all <- getContents
    print $ solve all

{-#LANGUAGE OverloadedStrings#-}
module Main where

import Data.Text (splitOn, pack, unpack)

main :: IO ()
main = do
    [n] <- getInts
    solve n
    >>= pure . length . filter (>=2)
    >>= putStrLn . show

-- solve :: Int -> String
-- solve = undefined

solve ::  Int -> IO [Int]
solve n = sequence [getLine >>= oz | _ <- [1..n]]

-- ones should be greater than equal to 2
oz :: String -> IO Int
oz  = pure . length . filter (=='1')

getInts :: IO [Int]
getInts = fmap ( map ( read . unpack )
            . splitOn " " . pack ) getLine

-- Codeforces 231A

import Control.Monad

main :: IO ()
main = do
    n <- fmap read getLine
    replicateM n getLine >>= putStrLn . show . solve . map words where
        solve = length . filter (>= 2) . map (sum . map read)

import Control.Applicative
import Control.Monad

main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine :: IO [[Int]]
  let nt = sum $ map (`cntOnes` 0) ls
  print nt

cntOnes [] c = 0
cntOnes (x:xs) c
  | c+x > 1     = 1
  | otherwise = cntOnes xs (c+x)

f::[String]->Int
f []=0
f (x:xs)=let ys=map read (words x)::[Int]
             y=sum ys
         in if y>1 then 1+f xs else f xs

main =do
      e<-getLine
      es<-getContents
      let xs=lines es
      print $ f xs

answer :: [[Int]] -> Int
answer = length . filter (>=2) . map sum

main = do interact $ show . answer . map (map read) . map words . tail . lines

-- import Data.Char
-- import Data.Int
-- import Data.List
import Control.Monad
getList :: Read a => IO [a]
getList = fmap (map read . words) getLine

solve :: [[Int]] -> Int
solve = length . filter ((>= 2) . sum)

main :: IO ()
main = do
        n <- readLn
        a <- replicateM n getList
        putStrLn . show $ solve a

main = do
  _ <- getLine
  inputStr <- getContents
  let s = (map (sum . map read . words) . lines) inputStr :: [Int]
  print $ (length . filter (>=2)) s

import Prelude hiding (catch)
import Control.Applicative
import Control.Exception

readLines :: Int -> IO [String]
readLines 0 = return [""]
readLines n = do
        s <- getLine
        rest <- readLines (n - 1)
        return $ s:rest

calc :: String -> Int
calc s = if (sum $ map read $ words s) >= 2 then 1 else 0

main = do
    n <- read <$> getLine
    ss <- readLines n
    print $ sum $ map calc ss

solve :: String -> Int
solve xs
    | s > 1 = 1
    | otherwise = 0
    where s = sum (map read (words xs))

main = interact $ show . sum . map solve . tail . lines

solve = length . filter (>=2) . map sum
main = interact $ show . solve . map (map read) . map words . tail . lines

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2016
-- http://mivael.in.ua

main = do
  interact $ show . s . map read . words
    where
      s (n:triples) = csum n triples
      s _ = error "N expected."

      csum 0 [] = 0
      csum n (a:b:c:rest) =
        (count (a+b+c >= 2)) + (csum (n-1) rest)
      csum _ _ = error "N triples expected."

      count True = 1
      count False = 0

import Control.Applicative

main::IO ()
main=do
    getLine
    a<-(map (map read.words)) .lines <$> getContents
    print $ length $ filter (>1) $ map sum a

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

solve :: [[Int]] -> Int
solve = length . filter ((>1) . sum)

module Main where

import Control.Applicative

getL n = sequence (replicate n getLine)

main = do
  n <- getLine
  l <- map (length . filter (=='1')) <$> lines <$> getContents
  putStrLn $ show . length . filter (>=2) $ l

import Control.Monad
main = do
    taskCount <- getLine
    res <- forM [1..read taskCount] (\_ -> do
        strTask <- getLine
        let [a,b,c] = map read . words $ strTask
        return $ if a+b+c >= 2 then 1 else 0)
    print $ sum res

module Main where

import Control.Monad (replicateM)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  inp <- replicateM n getLine
  let willSolve = fmap (length . filter (== '1')) inp
      output = length . filter (> 1) $ willSolve
  print output

main :: IO ()
main = do
       arg <- getLine
       let num = read arg
       let spisok = sequence $ replicate num getLine
       sp <- spisok
       let spt = map read $ concat $ map words sp
       print $ solve spt

printSolver :: Int -> IO ()
printSolver 1 = solver
printSolver n = do solver
                   printSolver (n-1)

solver :: IO ()
solver = do
         line <- getLine
         let str = map read $ words line
         print $ solve str

solve :: [Int] -> Int
solve [] = 0
solve (x:y:z:xs) = if x+y+z >= 2 then 1 + solve xs else 0 + solve xs

solve :: Int -> Int -> IO ()
solve 0 ans = putStrLn $ show ans
solve n ans = do
  a <- (map read . words) `fmap` getLine
  if (sum a) > 1
    then solve (n - 1) (ans + 1)
    else solve (n - 1) ans

main = do
  n <- read `fmap` getLine;
  solve n 0

-- Vicfred
-- https://codeforces.com/problemset/problem/231/A

import Control.Monad

main = do
    n <- readLn
    a <- replicateM n getList
    putStrLn . show $ solve a

solve :: [[Int]] -> Int
solve = length . filter ((>= 2) . sum)

getList :: Read a => IO [a]
getList = fmap (map read . words) getLine

module Main where
import Control.Applicative
import Control.Monad
main = do
  problems <- ((read :: String -> Int) <$> getLine) >>= \c -> mapM (\_ -> getLine) [1..c]
  print $ length $ filter (\p -> (length $ filter (=='1') p) >1 ) problems

main = interact $ show . length . filter (>= 2) .  map (length . filter (== "1") . words) . tail . lines

module Main where

infixl 0 |>
(|>) :: a -> (a -> b) -> b
x |> f = f x

getInt :: IO Int
getInt = readLn

process :: (Eq t, Num t) => t -> IO [Int]
process range = process' range []
 where
  process' 0     sums = return sums
  process' range sums = do
    line <- getLine
    let currentSum = line |> words |> map (read :: String -> Int) |> sum
    process' (range - 1) (currentSum : sums)

main :: IO ()
main = do
  range         <- getInt
  processedSums <- process range
  processedSums |> filter (>= 2) |> length |> print

module Main where

infixl 0 |>
x |> f = f x

getInt :: IO Int
getInt = readLn

process :: (Eq t, Num t) => t -> [Int] -> IO [Int]
process 0     sums = return sums
process range sums = do
  line <- getLine
  let currentSum = line |> words |> map (read :: String -> Int) |> sum
  process (range - 1) (currentSum : sums)

main :: IO ()
main = do
  range         <- getInt
  processedSums <- process range []
  processedSums |> filter (>= 2) |> length |> print

solve [] = 0
solve ((a, b, c):xs) = if a + b + c > 1 then y + 1 else y where y = solve xs

main :: IO()
main = do
    n <- getLine
    contents <- getContents
    let input = map ((\(a:b:c:_) -> (a, b, c)) . map (read :: String -> Int) . words) $ lines contents
    print(solve input)

import Data.List
import Control.Applicative

solve :: [Int] -> Bool
solve = (>= 2) . length . filter ((==) 1)

main = do
  (_:cases) <- fmap (fmap read) . fmap words . lines <$> getContents
  let n = length $ filter solve cases
  print n

main = interact $ show . length . filter (>1) . map (sum . (map read . words)) . lines

main = do
    getLine
    cs <- fmap (map (map read . words) . lines) getContents
    print $ map (\l -> sum l >= 2) cs

solve = length.filter (>1) . map sum

main = do
	v <- getContents
	print . solve . map (map read) . map words . lines $ tail v

solve dtms = length $ filter (>=2) $ map sum dtms
main = interact $ show . solve . map (map read . words) . lines

sumInts :: [String] -> Integer
sumInts = sum . map read

consensus :: String -> String
consensus views
  | tot > 1 = "YES"
  | otherwise = "NO"
  where tot = sumInts . words $ views

main = do
  n <- getLine
  interact (unlines . map consensus . lines)

main = interact $ show . length . filter willImplement . tail . lines

willImplement :: String -> Bool
willImplement s = case s of
    "0 1 1" -> True
    "1 1 0" -> True
    "1 1 1" -> True
    otherwise -> False

{-# LANGUAGE OverloadedStrings #-}

import Control.Monad.State
import Control.Monad.Writer.Strict (liftM, replicateM_)
import qualified Data.ByteString.Char8 as C

main = do
  n <- read `fmap` getLine :: IO Int
  r <-
    replicateM n $ do
      q <- C.getLine
      let qs = C.split ' ' q
      if (foldl score 0 qs) >= 2
        then return 1
        else return 0
  putStrLn . show . sum $ r

score :: Int -> C.ByteString -> Int
score s "1" = s + 1
score s _ = s


import Control.Applicative
import Control.Monad
import Data.Function
import Data.Array

solve :: Array Int Int -> Int
solve arr = if z > 1 then -1 else s
  where
    func (a, b) c
        | c == maxBound = (a, b+1)
        | otherwise     = (a+c, b)
    (s, z) = foldl func (0, 0) $ map snd $ assocs arr

main = do
    n <- read <$> getLine :: IO Int
    q <- map read . words <$> getLine :: IO [Int]
    let parseLine [a,b,c] = (read b, read c)
    lists <- read <$> getLine >>= flip replicateM (parseLine . words<$> getLine)
    let arr = accumArray min maxBound (1,n) lists
    print $ solve arr

import Control.Monad
import Data.Array
import qualified Data.IntMap as M
import Data.List

solve :: Int -> [Int] -> Int -> [(Int, Int, Int)] -> Int
solve n qs m apps =
    foldr rec 0 $ tail $ reverse ms
    where
      rec i res
          | res == -1 = -1
          | otherwise =
              let es = map snd $ filter (\(j, _) -> is ! i < is ! j) $
                       M.findWithDefault [] i edges
              in  if null es then -1 else res + minimum es
      ms = map snd $ sort $ zip qs [1..]
      is = listArray (1, n) $ map snd $ sort $ zip ms [1..]
      edges = M.fromListWith (++) $ map (\(a, b, c) -> (b, [(a, c)])) apps

main = do
  n <- readLn
  qs <- fmap (map read . words) getLine
  m <- readLn
  apps <- replicateM m $ do
            [a, b, c] <- fmap (map read . words) getLine
            return (a, b, c)
  print $ solve n qs m apps

import List

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

num max_q (a:s) n | max_q == a = n
                  | True       = num max_q s (n+1)

main = do
    s <- getLine
    s2<- getLine
    s3<- getLine
    let n:_ = un s
        qs = un s2
        m:_ = un s3
        max_q = maximum $ qs
        max_n = num max_q qs 0
    zajav <- getLines m
    let m_zajavlenij = map un zajav
        apps = map (\(a:b:c:s) -> (b,c)) m_zajavlenij
        appsByNum = [ [ (b,c) | (b,c) <- apps, b == emp] | emp <- [1..n]]
        bestApps = map f appsByNum
            where f [] = 0 :: Int
                  f ((b,c):as) = getBest as c :: Int
                  getBest [] c = c :: Int
                  getBest ((_,t):as) c = getBest as (min c t) :: Int
        best_sum = sum bestApps
        notEmp = filter null appsByNum
        notEmpN = length notEmp

    if notEmpN > 1 then
        putStrLn "-1"
        else
            putStrLn $ show best_sum

    --putStrLn $ show apps
    --putStrLn $ show appsByNum
    --putStrLn $ show bestApps
    --putStrLn $ show bestApps
    --putStrLn $ show notEmpN

import List

un = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

uniq [] = []
uniq [a] = [a]
uniq (a:b:s) | a == b = uniq (b:s)
             | True   = a:(uniq (b:s))

uniqBy [] = []
uniqBy [(a,b)] = [b]
uniqBy ((a,b):(c,d):s) | a == c = (min b d):(uniqBy s)
             | True   = b:d:(uniqBy s)

main = do
    s <- getLine
    s2<- getLine
    s3<- getLine
    let n:_ = un s
        qs = un s2
        m:_ = un s3
    zajav <- getLines m
    let m_zajavlenij = map un zajav :: [[Int]]
        list_of_emploers = uniq $ sort $ map (\(a:b:c:s) -> b) m_zajavlenij
    if length list_of_emploers < (n-1) then
            putStrLn "-1"
        else do
        --putStrLn $ show list_of_emploers
        let emp_costs = sort $ map (\(a:b:c:s) -> (b,c)) m_zajavlenij :: [(Int, Int)]
            emp_best = uniqBy  emp_costs
            summa = sum emp_best
        --putStrLn $ show emp_costs
        --putStrLn $ show emp_best
        putStrLn $ show summa


import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Maybe (fromJust)
import Prelude hiding ((.))
(.) a b = b a

main = do
    s1 <- getLine
    s2 <- getLine
    let [n, s, t] = s1 . words . map (read :: String -> Int)
        ps = s2 . words . map (read :: String -> Int)
        ms = Map.fromList (zip [1 .. n] ps)
        visit l c v
            | c == t = l
            | c `Set.member` v = -1
            | otherwise = visit (l + 1) (fromJust $ Map.lookup c ms) (Set.insert c v)
    print (visit 0 s Set.empty)

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

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

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

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

solve n s t xs = go 0 . take n $ iterate (unsafeAt arr) s
   where
     !arr = listArray (0,n) $ 0:xs :: UArray Int Int
     go cnt (y:ys)
       | cnt > n = -1
       | y == t = cnt
       | otherwise = go (cnt+1) ys
     go _ _ = -1

import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Data.Maybe (fromJust)
import Prelude hiding ((.))
(.) a b = b a

main = do
    s1 <- getLine
    s2 <- getLine
    let [n, s, t] = s1 . words . map (read :: String -> Int)
        ps = s2 . words . map (read :: String -> Int)
        ms = Map.fromList (zip [1 .. n] ps)
        visit l c v
            | c == t = l
            | c `Set.member` v = -1
            | otherwise = visit (l + 1) (fromJust $ Map.lookup c ms) (Set.insert c v)
    print (visit 0 s Set.empty)

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

solve :: [Int] -> (Int, Int) -> Int
solve ps (a, b)  =  solve' 0 a
  where
    ps'  =  listArray (1, length ps) ps
    solve' m c
      | c == b  =  m
      | c == a && m > 0  =  -1
      | otherwise  =  solve' (m+1) (ps' ! c)

main :: IO ()
main  =  do
    [n, a, b]  <-  reads
    ps  <-  reads
    print $ solve ps (a, b)

  where

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


import Control.Monad (replicateM, replicateM_)
import Data.Char

readInt :: IO Int
readInt = read <$> getLine

readLine :: IO [Int]
readLine = map digitToInt <$> getLine

readTable :: IO [[Int]]
readTable =
    read <$> getLine >>= \n ->
    replicateM n readLine

checkMatrix :: [[Int]] -> Bool
checkMatrix m = not $ any (any invalid) (zipWith3 zip3 m ts t) where
    ts = map tail m
    t = tail m
    invalid (x, right, down) = x == 1 && right == 0 && down == 0

main =
    readInt >>= \t ->
    replicateM_ t (
        readTable >>= \m ->
        putStrLn (
            if checkMatrix m then "YES"
            else "NO"
        )
    )

import           Control.Monad
import           Data.Array
import           Data.Maybe
import           Control.Arrow

valid (v, w) = v /= '1' || w == '1'

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n   <- read <$> getLine
        mat <-
            array ((1, 1), (n, n))
            .   zip [ (i, j) | i <- [1 .. n], j <- [1 .. n] ]
            .   concat
            <$> replicateM n getLine
        putStrLn
            $ if and
                      [ (\(i, j) ->
                            ((j + 1) > n || valid
                                    (mat ! (i, j), mat ! (i, j + 1))
                                )
                                || ((i + 1) > n || valid
                                       (mat ! (i, j), mat ! (i + 1, j))
                                   )
                        )
                            (i, j)
                      | i <- [1 .. n]
                      , j <- [1 .. n]
                      ]
                  then "YES"
                  else "NO"

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

main = getLine >>= flip replicateM_ test . read

test = do
    n <- read <$> getLine
    polygon <- replicateM n (map (== '1') <$> getLine)
    let down = tail polygon
        right = tail <$> polygon
        valid = zipWith (zipWith (||)) down right
    putStrLn $ bool "NO" "YES" $ all and $ zipWith (zipWith (||)) ((not <$>) <$> polygon) valid

import Control.Monad (replicateM, replicateM_)
import Data.Array
import Data.Char

readInt :: IO Int
readInt = read <$> getLine

readLine :: IO [Int]
readLine = map digitToInt <$> getLine

getDimensions :: Array (Int, Int) Int -> (Int, Int)
getDimensions = (snd . bounds)

readTable :: IO [[Int]]
readTable =
    read <$> getLine >>= \n ->
    replicateM n readLine

addIndices :: [[Int]] -> [((Int, Int), Int)]
addIndices xss = [((i, j), x) | (i, xs) <- zip [0..] xss,
                                (j, x)  <- zip [0..] xs]

matrixFromList :: [[Int]] -> Array (Int, Int) Int
matrixFromList xss =
    array ((0, 0), (n, m)) (addIndices xss)
    where
        (n, m) = (length xss - 1, (length . head) xss - 1)

isCellValid :: (Int, Int) -> Array (Int, Int) Int -> Bool
isCellValid (i, j) matrix =
    matrix ! (i, j) == 0 ||
    i == n  || j == m ||
    matrix ! (i, j + 1) == 1 ||
    matrix ! (i + 1, j) == 1
    where
        (n, m) = getDimensions matrix

checkMatrix :: Array (Int, Int) Int -> String
checkMatrix matrix = if valid then "YES" else "NO" where
    valid = all (\ idx -> isCellValid idx matrix) (indices matrix)

main =
    readInt >>= \t ->
    replicateM_ t (
        readTable >>= \table ->
        putStrLn $ (checkMatrix . matrixFromList) table
    )

import Control.Monad ( replicateM_ )

readInput = do
    n <- read <$> getLine
    sequenceA $ replicate n (map (=='1') <$> getLine)

buyingShovels :: [[Bool]] -> String
buyingShovels m =
    let a = map tail m
        b = tail m
        zipped = zipWith3 zip3 m a b
    in
        if any (any invalid) zipped
            then "NO"
            else "YES"
    where invalid (t, u, v) = t && not u && not v

main = do
    t <- read <$> getLine
    replicateM_ t (buyingShovels <$> readInput >>= putStrLn)

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/E

import Control.Monad ( replicateM_ )

polygon :: [[Bool]] -> String
polygon grid =
    let right = map tail grid
        bottom = tail grid
        invalid = zipWith3_2d isValid grid right bottom
    in
        if any or invalid
            then "NO"
            else "YES"
    where
        zipWith3_2d = zipWith3 . zipWith3
        isValid t u v = t && not u && not v

readInput :: IO [[Bool]]
readInput = do
    n <- read <$> getLine
    sequence $ replicate n (map (=='1') <$> getLine)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (polygon <$> readInput >>= putStrLn)

import Data.List (transpose)
import Data.Traversable (for, for)

solve :: [[Char]] -> Bool
solve arr = and $ map and ok  where
  supr :: [[Char]] -> [[Bool]]
  supr = map $ \li -> zipWith (<=) li (tail li)
  ok = zipWith (zipWith (||)) (supr arr) (transpose . supr $ transpose arr)

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  _ <- for [1..t] $ \_ -> do
    n <- read <$> getLine :: IO Int
    arr <- for [1..n] $ const getLine
    putStrLn $ if  solve arr  then  "YES"  else  "NO"
  return ()


import Control.Applicative
import Control.DeepSeq
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.State
import Data.Either
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.IntSet as IS

-- Implementing this gave me a headache
data PQNode = PQLeaf !Int
            | PNode [PQNode]
            | QNode [PQNode]
            deriving Show

data RNode = Em { unRNode :: PQNode }
           | Fu { unRNode :: PQNode }
           | Pa [PQNode] [PQNode] -- empty and full, end first
           deriving Show

mkPNode, mkQNode :: [PQNode] -> PQNode
mkPNode []     = error "empty PNode"
mkPNode [n]    = n
mkPNode ns     = PNode ns
mkQNode []     = error "empty QNode"
mkQNode [n]    = n
mkQNode [n, m] = PNode [n, m]
mkQNode ns     = QNode ns

mkRNode :: [PQNode] -> [PQNode] -> RNode
mkRNode [] _  = error "empty RNode es"
mkRNode _ []  = error "empty RNode fs"
mkRNode es fs = Pa es fs

isFu, isEm, isPa :: RNode -> Bool
isFu (Fu _)   = True
isFu _        = False
isEm (Em _)   = True
isEm _        = False
isPa (Pa _ _) = True
isPa _        = False

splitForP :: [RNode] -> ([PQNode], [RNode], [PQNode])
splitForP us = go us [] [] [] where
    go []     e p f = (e, p, f)
    go (x:xs) e p f = case x of
        Em n   -> go xs (n:e) p     f
        Pa _ _ -> go xs e     (x:p) f
        Fu n   -> go xs e     p     (n:f)

span1 :: (a -> Bool) -> [a] -> ([a], [a])
span1 _ [] = ([], [])
span1 f xs@(x:xs')
    | f x       = ([x], xs')
    | otherwise = ([],  xs)

splitForQ :: [RNode] -> Maybe ([PQNode], [RNode], [PQNode])
splitForQ xs = go xs <|> go (reverse xs) where
    go = evalStateT $ do
        ~[es, ps, fs] <- mapM state [span isEm, span1 isPa, span isFu]
        lift . ((map unRNode es, ps, map unRNode fs) <$) . guard =<< gets null

splitForQRoot :: [RNode] -> Maybe ([PQNode], [RNode], [PQNode], [RNode], [PQNode])
splitForQRoot = evalStateT $ do
    ~[e1, p1, fs, p2, e2] <- mapM state [span isEm, span1 isPa, span isFu, span1 isPa, span isEm]
    lift . ((map unRNode e1, p1, map unRNode fs, p2, map unRNode e2) <$) . guard =<< gets null

buildPQ :: [Int] -> PQNode
buildPQ = mkPNode . map PQLeaf

reducePQ :: [Int] -> PQNode -> Maybe PQNode
reducePQ [] = Just
reducePQ xs0 = fromRight (error "outside initial set") . visit where
    xs = IS.fromList xs0

    visit :: PQNode -> Either Int (Maybe PQNode)
    visit n@(PNode cs) = visitPQ n PNode cs
    visit n@(QNode cs) = visitPQ n QNode cs
    visit n@(PQLeaf x)
        | x `IS.notMember` xs = Left 0
        | IS.size xs > 1      = Left 1
        | otherwise           = Right $ reduceRoot n
    visitPQ n f cs
        | cnt == IS.size xs = Right $ reduceRoot n
        | null rts          = Left cnt
        | ~[r] <- rts       = Right $ f cs' <$ r
      where
        ys = map visit cs
        cnt = sum $ lefts ys
        rts = rights ys
        cs' = zipWith (\c e -> either (const c) fromJust e) cs ys

    reduceRoot :: PQNode -> Maybe PQNode
    reduceRoot = go where
        go n@(PNode cs) = do
            (es, ps, fs) <- splitForP <$> mapM reduceInternal cs
            let noPartial
                    | null es || null fs = n
                    | otherwise          = mkPNode $ mkPNode fs : es
                withPartial pe1 pf1 pe2 pf2 = mkPNode $ qn : es where
                    qn = mkQNode $
                        pe1 ++ reverse pf1 ++ [mkPNode fs | not (null fs)] ++ pf2 ++ reverse pe2
            case ps of
                []                       -> Just noPartial
                [Pa pe1 pf1]             -> Just $ withPartial pe1 pf1 [] []
                [Pa pe1 pf1, Pa pe2 pf2] -> Just $ withPartial pe1 pf1 pe2 pf2
                _                        -> Nothing

        go n@(QNode cs) = do
            (e1, p1, fs, p2, e2) <- splitForQRoot =<< mapM reduceInternal cs
            let withPartial pe1 pf1 pe2 pf2 =
                    mkQNode $ e1 ++ pe1 ++ reverse pf1 ++ fs ++ pf2 ++ reverse pe2 ++ e2
            case (p1, p2) of
                ([],           [])           -> Just n
                ([Pa pe1 pf1], [])           -> Just $ withPartial pe1 pf1 []  []
                ([],           [Pa pe2 pf2]) -> Just $ withPartial []  []  pe2 pf2
                ([Pa pe1 pf1], [Pa pe2 pf2]) -> Just $ withPartial pe1 pf1 pe2 pf2
                _                            -> Nothing

        go n@(PQLeaf _) = Just n

    reduceInternal :: PQNode -> Maybe RNode
    reduceInternal = go where
        go n@(PNode cs) = do
            (es, ps, fs) <- splitForP <$> mapM go cs
            let noPartial
                    | null es   = Fu n
                    | null fs   = Em n
                    | otherwise = mkRNode [mkPNode es] [mkPNode fs]
                withPartial pe pf =
                    mkRNode ([mkPNode es | not (null es)] ++ pe) ([mkPNode fs | not (null fs)] ++ pf)
            case ps of
                []         -> Just noPartial
                [Pa pe pf] -> Just $ withPartial pe pf
                _          -> Nothing

        go n@(QNode cs) = do
            (es, ps, fs) <- splitForQ =<< mapM go cs
            let noPartial
                    | null es = Fu n
                    | null fs = Em n
                    | otherwise = mkRNode es (reverse fs)
                withPartial pe pf = mkRNode (es ++ pe) (reverse fs ++ pf)
            case ps of
                []         -> Just noPartial
                [Pa pe pf] -> Just $ withPartial pe pf
                _          -> Nothing

        go n@(PQLeaf x) = Just $ if x `IS.member` xs then Fu n else Em n

reduceAllPQ :: [[Int]] -> PQNode -> Maybe PQNode
reduceAllPQ xss t = foldM (flip reducePQ) t xss

m :: Int64
m = 998244353

mulmod :: Int64 -> Int64 -> Int64
mulmod a b = a * b `mod` m

count :: PQNode -> Int64
count (PQLeaf _) = 1
count (PNode cs) = foldl1' mulmod $ zipWith mulmod [1..] $ map count cs
count (QNode cs) = mulmod 2 $ foldl1' mulmod $ map count cs

solve :: IO ()
solve = do
    [n, m] <- readMany
    xss <- map tail <$> replicateM m readMany
    print $ maybe 0 count $ reduceAllPQ xss $ buildPQ [1..n]

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

main :: IO ()
main = solve

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Either
import Data.List
import Data.Maybe
import qualified Data.IntSet as IS

m :: Int
m = 998244353

mulmod :: Int -> Int -> Int
mulmod a b = a * b `mod` m

count :: PQNode -> Int
count (PQLeaf _) = 1
count (PNode cs) = foldl1' mulmod $ zipWith mulmod [1..] $ map count cs
count (QNode cs) = mulmod 2 $ foldl1' mulmod $ map count cs

solve :: IO ()
solve = do
    [n, m] <- readMany
    xss <- map tail <$> replicateM m readMany
    print $ maybe 0 count $ reduceAllPQ xss $ buildPQ [1..n]

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

main :: IO ()
main = solve

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

data PQNode = PQLeaf !Int
            | PNode  [PQNode]
            | QNode  [PQNode]
            deriving Show

type Parts = ([PQNode], [PQNode]) -- empty and full, end first
data RNode = Empty PQNode
           | Full  PQNode
           | Part  Parts
           deriving Show

mkPNode, mkQNode :: [PQNode] -> PQNode
mkPNode []     = error "empty PNode"
mkPNode [n]    = n
mkPNode ns     = PNode ns
mkQNode []     = error "empty QNode"
mkQNode [n]    = n
mkQNode [n, m] = PNode [n, m]
mkQNode ns     = QNode ns

mkPartial :: [PQNode] -> [PQNode] -> RNode
mkPartial [] _  = error "empty RNode es"
mkPartial _  [] = error "empty RNode fs"
mkPartial es fs = Part (es, fs)

emptyMany, fullMany :: State [RNode] [PQNode]
emptyMany = state $ go [] where
    go ys (Empty n : xs) = go (n:ys) xs
    go ys xs             = (reverse ys, xs)
fullMany = state $ go [] where
    go ys (Full n : xs) = go (n:ys) xs
    go ys xs            = (reverse ys, xs)

partialMaybe :: State [RNode] (Maybe Parts)
partialMaybe = state go where
    go (Part p : xs) = (Just p,  xs)
    go xs            = (Nothing, xs)

splitForP :: [RNode] -> ([PQNode], [Parts], [PQNode])
splitForP us = go us [] [] [] where
    go []     es ps fs = (es, ps, fs)
    go (x:xs) es ps fs = case x of
        Empty n -> go xs (n:es) ps     fs
        Part p  -> go xs es     (p:ps) fs
        Full n  -> go xs es     ps     (n:fs)

splitForQ :: [RNode] -> Maybe ([PQNode], Maybe Parts, [PQNode])
splitForQ xs = go xs <|> go (reverse xs) where
    go = evalState $ go' <$> emptyMany <*> partialMaybe <*> fullMany <*> gets null
    go' es ps fs end = (es, ps, fs) <$ guard end

splitForQRoot :: [RNode] -> Maybe ([PQNode], Maybe Parts, [PQNode], Maybe Parts, [PQNode])
splitForQRoot = evalState $
    go <$> emptyMany <*> partialMaybe <*> fullMany <*> partialMaybe <*> emptyMany <*> gets null
  where
    go es1 ps1 fs ps2 es2 end = (es1, ps1, fs, ps2, es2) <$ guard end

buildPQ :: [Int] -> PQNode
buildPQ = mkPNode . map PQLeaf

reducePQ :: [Int] -> PQNode -> Maybe PQNode
reducePQ []  = Just
reducePQ xs0 = fromRight (error "outside initial set") . visit where
    xs = IS.fromList xs0
    xsz = IS.size xs

    visit :: PQNode -> Either Int (Maybe PQNode)
    visit n@(PNode cs) = visitPQ n PNode cs
    visit n@(QNode cs) = visitPQ n QNode cs
    visit n@(PQLeaf x)
        | x `IS.notMember` xs = Left 0
        | xsz > 1             = Left 1
        | otherwise           = Right $ reduceRoot n
    visitPQ n f cs
        | cnt == xsz  = Right $ reduceRoot n
        | null rts    = Left cnt
        | ~[r] <- rts = Right $ f . getcs' <$> r
      where
        ys = map visit cs
        cnt = sum $ lefts ys
        rts = rights ys
        getcs' c' = zipWith (\c -> either (const c) (const c')) cs ys

    reduceRoot :: PQNode -> Maybe PQNode
    reduceRoot n@(PNode cs) = go . splitForP =<< mapM reduceInternal cs where
        go (es, ps, fs) = case ps of
            []       -> Just noPartial
            [p1]     -> Just $ withPartial p1 ([], [])
            [p1, p2] -> Just $ withPartial p1 p2
            _        -> Nothing
          where
            noPartial
                | null es || null fs = n
                | otherwise          = mkPNode $ mkPNode fs : es
            withPartial (pe1, pf1) (pe2, pf2) = mkPNode $ qn : es where
                qn = mkQNode $
                    pe1 ++ reverse pf1 ++ [mkPNode fs | not (null fs)] ++ pf2 ++ reverse pe2

    reduceRoot n@(QNode cs) = fmap go . splitForQRoot =<< mapM reduceInternal cs where
        go (es1, ps1, fs, ps2, es2) = case (ps1, ps2) of
            (Nothing, Nothing) -> n
            _                  -> withPartial (fromMaybe ([], []) ps1) (fromMaybe ([], []) ps2)
          where
            withPartial (pe1, pf1) (pe2, pf2) =
                mkQNode $ es1 ++ pe1 ++ reverse pf1 ++ fs ++ pf2 ++ reverse pe2 ++ es2

    reduceRoot n@(PQLeaf _) = Just n

    reduceInternal :: PQNode -> Maybe RNode
    reduceInternal n@(PNode cs) = go . splitForP =<< mapM reduceInternal cs where
        go (es, ps, fs) = case ps of
            []   -> Just noPartial
            [p1] -> Just $ withPartial p1
            _    -> Nothing
          where
            noPartial
                | null es   = Full n
                | null fs   = Empty n
                | otherwise = mkPartial [mkPNode es] [mkPNode fs]
            withPartial (pe, pf) = mkPartial
                ([mkPNode es | not (null es)] ++ pe) ([mkPNode fs | not (null fs)] ++ pf)

    reduceInternal n@(QNode cs) = fmap go . splitForQ =<< mapM reduceInternal cs where
        go (es, ps, fs) = maybe noPartial withPartial ps where
            noPartial
                | null es   = Full n
                | null fs   = Empty n
                | otherwise = mkPartial es (reverse fs)
            withPartial (pe, pf) = mkPartial (es ++ pe) (reverse fs ++ pf)

    reduceInternal n@(PQLeaf x) = Just $ if x `IS.member` xs then Full n else Empty n

reduceAllPQ :: [[Int]] -> PQNode -> Maybe PQNode
reduceAllPQ xss t = foldM (flip reducePQ) t xss


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

main = do
	ct <- C.getContents
	let
		(n:t) = map (fst.fromJust.C.readInt) $ C.words ct
	putStrLn $ adjust $ solve (reverse t)

adjust (s,x)
	| x < 0 = map (\x -> if x == '+' then '-' else '+') s | otherwise = s

solve :: [Int] -> (String,Int)
solve (h:t) = foldl cal ("+",h) t
	where
		cal (s,x) y
			| x + y <= y = ('+':s, x+y)
			| otherwise = ('-':s, x-y)

--solve (x:[]) v = if x < v then ("-",0) else ("+",1)
--solve (x:xs) v = if x < v then
--					let
--						(seq,flag) = solve xs (v-x)
--					in
--						if flag==1 then (seq++"+",1) else (seq++"-",0)
--				else
--					let
--						(seq,flag) = solve xs (x-v)
--					in
--						if flag==1 then (seq++"-",0) else (seq++"+",1)

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

main :: IO ()
main = do
  (h:t) <- fmap (reverse . map (fst . fromJust . C.readInt) . tail . C.words) C.getContents
  let (x, y) = foldl gao (h, "+") t
  putStrLn $ if x >= 0 then y else map (\i -> if i == '+' then '-' else '+') y
  where
    gao (x, s) y
      | x + y <= y  = (x + y, '+': s)
      | otherwise   = (x - y, '-': s)

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

-- main = do (_:as) <- (map (fst . fromJust . BS.readInt) . BS.words) `fmap` BS.getContents
--           putStrLn $ solve'' (reverse as)

main = do (_:as) <- (map read . words) `fmap` getContents
          putStrLn $ solve'' (reverse as)

solve' as     = fst $ foldl (\(ops, s) a ->
                              if a <= s
                              then ('-':ops, s-a)
                              else ('+':(map rev ops), a-s)
                            ) ("+", head as) (tail as)
rev '+' = '-'
rev '-' = '+'

solve'' as = (\(ops, s) ->
               if s <= 0
               then map rev ops
               else ops
             )
             $ foldl (\(ops, s) a ->
                       if s <= 0
                       then ('+':ops, s+a)
                       else ('-':ops, s-a)
                     ) ("+", head as) (tail as)

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

main = do (_:as) <- (map (fst . fromJust . BS.readInt) . BS.words) `fmap` BS.getContents
          putStrLn $ solve'' (reverse as)

-- main = do (_:as) <- (map read . words) `fmap` getContents
--           putStrLn . fst $ solve' (reverse as)

solve' as     = fst $ foldl (\(ops, s) a ->
                              if a <= s
                              then ('-':ops, s-a)
                              else ('+':(map rev ops), a-s)
                            ) ("+", head as) (tail as)
rev '+' = '-'
rev '-' = '+'

solve'' as = (\(ops, s) ->
               if s <= 0
               then map rev ops
               else ops
             )
             $ foldl (\(ops, s) a ->
                       if s <= 0
                       then ('+':ops, s+a)
                       else ('-':ops, s-a)
                     ) ("+", head as) (tail as)

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

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

solve :: [Int] -> String
solve (_ : as) = g False $ snd $ foldr f (0, "") as
  where
  f a (s, x)
    | a > s = (a - s, '+' : x)
    | otherwise = (s - a, '-' : x)
  g False ('+' : x) = '+' : g True  x
  g False ('-' : x) = '-' : g False x
  g True  ('+' : x) = '-' : g False x
  g True  ('-' : x) = '+' : g True  x
  g _ _ = []

next :: (Integer, String) -> Integer -> (Integer, String)
next (s, r) a
  | s < 0  = (s + a, "+" ++ r)
  | s >= 0 = (s - a, "-" ++ r)

inv :: Char -> Char
inv '-' = '+'
inv '+' = '-'

main :: IO ()
main = do
  _ <- getLine
  ais <- fmap (map read . reverse . words) getLine
  let (si, res) = foldl next (0, "") ais
  if si < 0 then
      putStrLn $ map inv res
    else
      putStrLn res

next :: (Integer, String) -> Integer -> (Integer, String)
next (s, r) a
  | s < 0  = (s + a, r ++ "+")
  | s >= 0 = (s - a, r ++ "-")

inv :: Char -> Char
inv '-' = '+'
inv '+' = '-'

main :: IO ()
main = do
  _ <- getLine
  ais <- fmap (map read . reverse . words) getLine
  let (si, res) = foldl next (0, "") ais
  if si < 0 then
      putStrLn $ map inv res
    else
      putStrLn res


{-# 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 <- readInt
	let
		res = solve n
	print $ length res
	putStrLn $ unwords $ map show res

solve 2 = [ 2 ]
solve 3 = [ 3 ]
solve n = 2 : solve ( n - 2 )

import Control.Monad
import Data.List

getInt = read `fmap` getLine :: IO Int

main = do
    n <- getInt
    let ps = fact n
    print $ length ps
    forM_ ps $ \p -> do
        putStr (show p)
        putChar ' '

fact n
    | even n = m
    | otherwise = 3 : tail m
    where m = replicate (n `div` 2) 2

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  if n < 4
    then do
      putStrLn "1"
      putStrLn (show n)
    else do
      let r = (n `div` 2)
      print r
      mapM_ (\_ -> do
                putStr "2 "
                ) [1..(r-2)]
      putStr "2 "
      if (n `mod` 2) == 1 then putStrLn "3" else putStrLn "2"

sol :: Int -> IO ()
sol n = do
  mapM_ putStr ["2 " | _ <- [1..((n `div` 2) - 1)]]
  if (n `mod` 2 == 0)
    then putStrLn "2"
    else putStrLn "3"

main :: IO ()
main = do
  n <- getLine
  let ni = read n :: Int
  print (ni `div` 2)
  sol ni

import Data.List

sol :: Int -> IO ()
sol n = do
  mapM_ putStr (replicate ((n `div` 2) - 1) "2 ")
  if (n `mod` 2 == 0)
    then putStrLn "2"
    else putStrLn "3"

main :: IO ()
main = do
  n <- getLine
  let ni = read n :: Int
  print (ni `div` 2)
  sol ni

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInt).C.words<$>C.getLine))
solve [x] = let f=x `mod` 2; d=x `div` 2 in if  f== 0 then print d>>putStr (unwords $ map show $ take d (repeat 2)) else print (d)>>putStr (unwords $ map show $ (++) [3] $ take (d-1) (repeat 2))

main = getLine >>= putStrLn . calc . read

calc :: Int -> String
calc n = unlines ans
  where ans = [show k, unwords $ map show (calc' $ n - 2)]
        k = n `div` 2
        calc' 1 = [3]
        calc' 0 = [2]
        calc' n = 2:(calc' $ n - 2)

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')

readInt :: String -> Int
readInt = Prelude.read

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

solve :: Int -> [Int]
solve 2 = [2]
solve 3 = [3]
solve x = 2 : solve (x - 2)

main :: IO ()
main = do
    n <- readInt <$> getLine
    let answer = solve n
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "
    printf "\n"

import Control.Applicative
import Data.List
import Data.Char

main=do
    a<-read <$> getLine::IO Int
    let b = (div a 2)
    print b
    putStrLn $ intercalate " " $ map show $ (replicate (b-1) 2) ++ [(if mod a 2==1 then 3 else 2)]

import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as B

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

format (a, b) = show a ++ "\n" ++ (unwords $ map show b)

solve :: Int -> (Int, [Int])
solve x
    | even x    = (n, replicate n 2)
    | otherwise = (n, 3 : replicate (n - 1) 2)
        where n = div x 2

main :: IO ()
main = do
    x <- readInt
    putStrLn $ format $ solve x

main = do
  n <- readLn
  let d = n `div` 2
  if even n
    then do
      print d
      putStrLn $ unwords $ replicate d "2"
    else do
      print d
      putStrLn $ unwords $ "3" : replicate (d-1) "2"

import Control.Monad( replicateM_)
main = do
    k_ <- readLn
    let solve k = let (d,m) = k `divMod` 2 in if m==0
		    then do
			print d
			replicateM_ d (putStr "2 ")
		    else do
			print d
			replicateM_ (d-1) (putStr "2 ")
			print 3
    solve k_

module Main where
    solve :: Integer -> [Integer]
    solve x = if x <= 3 then [x] else [2] ++ solve (x - 2)

    main :: IO ()
    main = do
        l <- getLine
        let n = read l :: Integer
            ans = solve n
            res = concat $ map (\x -> show x ++ " ") $ ans
        print $ length ans
        putStrLn res

module Main where

import Control.Applicative
import Data.List

solve :: Int -> [Int]
solve 0 = []
solve n | odd n     = 3 : solve (n - 3)
        | otherwise = 2 : solve (n - 2)

main = do
    n <- read <$> getLine
    let a = solve n
    print $ length a
    putStrLn $ intercalate " " (map show a)

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

main= do
	n<-  read <$> getLine ::IO Int
	let c=  div n 2
	let d= concat $ replicate (c-1) "2 "
	let e = if (mod n 2 ==0 ) then "2 " else "3 "
	print  c
	putStrLn $ e++d

--ghc 7.10

bachgold :: Int -> [Int]
bachgold 2 = [2]
bachgold 3 = [3]
bachgold n = 2:bachgold (n-2)

main = do
    nStr <- getLine
    let n = read nStr :: Int
    let a = bachgold n
    print . length $ a
    putStrLn . unwords . map show $ a

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

solve :: Int -> [[Int]]
solve n = [[length d], d]
    where d = decompose  n

decompose :: Int -> [Int]
decompose 2 = [2]
decompose 3 = [3]
decompose x = 2 : decompose (x - 2)

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

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

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

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. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

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

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

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

solve n | n > 3     = 2 : solve (n-2)
        | otherwise = [n]

printList [x] = print x
printList (x : xs) = do
  putStr $ show x
  putStr " "
  printList xs

main = do
  s <- getContents
  let n = read s
  let l = solve n
  print $ length l
  printList l

import Data.List

sol :: Int -> [Int]
sol n = if n == 3
  then [3]
  else 2:(sol (n-2))

main :: IO ()
main = do
  n <- getLine
  putStrLn (intercalate " " (map show (sol (read n :: Int))))

{-# 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 = readInt >>= putStrLn . unwords . map show . solve

solve 2 = [ 2 ]
solve 3 = [ 3 ]
solve n = 2 : solve ( n - 2 )

import Control.Applicative
import Data.List
import Data.Char

main=do
    a<-read <$> getLine::IO Int
    print $ (div a 2) +(mod a 2)

main = do
  n <- readLn
  let d = n `div` 2
  if even n
    then do
      print d
      putStrLn $ unwords $ replicate d "2"
    else do
      print (d+1)
      putStrLn $ unwords $ "3" : replicate d "2"


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

main :: IO ()
main = interact $ lines >>> drop 1 >>> map solve >>> unlines

solve :: String -> String
solve s
  | null fs = s
  | not (null fs1) = let o = fst (head fs1) in o : filter (/= o) (suf $ (a, fa) : fs)
  | fa <= 2 = repl fa a ++ suf fs
  | fa - 2 <= n - fa = a : interleave (repl (fa - 1) a) (suf fs)
  | length fs == 1 = a : suf fs ++ repl (fa - 1) a
  | otherwise = case fs of
    (b, fb) : (c, fc) : fs' ->
      a : b : suf ((a, fa - 1) : (c, 1) : (b, fb - 1) : (c, fc - 1) : fs')
  where
    n = length s
    (a, fa) : fs = [(c, f) | c <- ['a' .. 'z'], let f = count c s, f > 0]
    fs1 = filter ((== 1) . snd) $ (a, fa) : fs
    suf = concatMap (uncurry (flip repl))

interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x : xs) ys = x : interleave ys xs

count :: Eq a => a -> [a] -> Int
count a = length . filter (== a)

repl = replicate

{-# LANGUAGE BangPatterns #-}

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

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

import Data.Array.Unboxed
import Data.Array.ST.Safe

type UAC = UArray Char Int

isOK :: UAC -> Char -> Char -> Char -> Bool
isOK cts c1 c2 prev = if  c1 == c2
  then  let
  n = foldl' (+) 0 $ elems cts
  needed = if  c1 == prev  then  2 * cts ! c1  else  2 * cts ! c1 - 1
  in  n >= needed
  else  c1 /= prev || cts ! c2 == 0
  || or [ct > 0 | (c, ct) <- assocs cts, c /= c1 && c /= c2]

nextC :: UAC -> Char -> Char -> Char -> Char
nextC cts c1 c2 prev = head $ do
  (curr, ct) <- assocs cts
  guard $ ct > 0 -- can use char
  guard $ prev /= c1 || curr /= c2 -- no immediate issue
  guard $ isOK (cts // [(curr, ct - 1)]) c1 c2 curr -- no later issue
  pure curr

step :: Char -> Char -> (UAC, Int, Char) -> Maybe (Char, (UAC, Int, Char))
step _ _ (_, 0, _) = Nothing
step c1 c2 (!cts, !n, !prev) = let
  curr = nextC cts c1 c2 prev
  in  Just (curr, (cts // [(curr, cts ! curr - 1)], n - 1, curr))

concatArr :: UAC -> String
concatArr arr = do
  (c, ct) <- assocs arr
  replicate ct c

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    s <- readLine
    let
      cts :: UAC
      cts = runSTUArray $ do
        arr <- newArray ('a', 'z') 0
        (\fun -> arr <$ P.foldr fun (pure ()) s) $ \c act -> do
          v <- readArray arr c
          writeArray arr c (v + 1)
          act
      n = foldl' (+) 0 $ elems cts
      uniqs = [c | (c, 1) <- assocs cts]
      ans = case  uniqs  of
        c : _ -> c : concatArr (cts // [(c, 0)])
        [] -> let
          present = [c | (c, ct) <- assocs cts, ct > 0]
          in  case  present  of
          [] -> error "empty input?"
          [c] -> replicate n c
          c1 : _ -> let
            rcts = cts // [(c1, cts ! c1 - 1)]
            c2 = head [c | (c, ct) <- assocs rcts, ct > 0,
                       isOK (rcts // [(c, ct - 1)]) c1 c c]
            nrcts = rcts // [(c2, rcts ! c2 - 1)]
            in  c1 : c2 : unfoldr (step c1 c2) (nrcts, n - 2, c2)
    lift $ B.hPutBuilder stdout $ B.string7 ans <> B.char7 '\n'

type SIO = StateT P.ByteString IO

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

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

{-# LANGUAGE LambdaCase #-}

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.List (sort)
import Data.Maybe (fromJust)

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

type Str = C.ByteString

testCase :: Scanner Str
testCase = C.pack . solve <$> bstr

solve :: Str -> String
solve s
  | null fs = C.unpack s
  | not (null fs1) = let o = fst (head fs1) in o : filter (/= o) (suf $ (a, fa):fs)
  | fa <= 2 = repl fa a ++ suf fs
  | fa - 2 <= n - fa = a : interleave (repl (fa - 1) a) (suf fs)
  | length fs == 1 = a : suf fs ++ repl (fa - 1) a
  | otherwise = case fs of
    (b, fb) : (c, fc) : fs' ->
      a : b : suf ((a, fa - 1) : (c, 1) : (b, fb - 1) : (c, fc - 1) : fs')
  where
    n = fi $ C.length s
    (a, fa) : fs = [(c, fi f) | c <- ['a' .. 'z'], let f = C.count c s, f > 0]
    fs1 = filter ((== 1) . snd) $ (a, fa) : fs
    suf = concatMap (uncurry (flip repl))

interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x : xs) ys = x : interleave ys xs

fi = fromIntegral
repl = replicate

-------------------------- 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.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)

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

type Str = C.ByteString

testCase :: Scanner Str
testCase = C.pack . solve <$> bstr

solve :: Str -> String
solve s
  | null fs = C.unpack s
  | fa <= 2 = repl fa a ++ suf fs
  | fa - 2 <= n - fa = a : interleave (repl (fa - 1) a) (suf fs)
  | length fs == 1 = a : suf fs ++ repl (fa - 1) a
  | otherwise = case fs of
    (b, fb) : (c, fc) : fs' ->
      a : b : suf ((a, fa - 1) : (c, 1) : (b, fb - 1) : (c, fc - 1) : fs')
  where
    n = fi $ C.length s
    (a, fa) : fs = sort [(c, fi f) | c <- ['a' .. 'z'], let f = C.count c s, f > 0]
    suf = concatMap (\(c, f) -> repl f c)

interleave :: [a] -> [a] -> [a]
interleave [] ys = ys
interleave (x : xs) ys = x : interleave ys xs

fi = fromIntegral
repl = replicate

-------------------------- 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 #-}
{-# 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.List (sort)
import Data.Maybe (fromJust)

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

type Str = C.ByteString

testCase :: Scanner Str
testCase = solve <$> bstr

solve :: Str -> Str
solve s
  | null fs = s
  | fa <= 2 = C.pack $ repl fa a ++ suf
  | fa - 2 > n - fa = C.pack $ interleave (repl fa a) suf
  | otherwise = C.pack $ 'a' : interleave (repl (fa - 1) a) suf
  where
    n = fi $ C.length s
    (a, fa) : fs = sort [(c, fi $ C.count c s) | c <- ['a' .. 'z']]
    suf = concatMap (\(c, f) -> repl f c) fs
    interleave [] ys = ys
    interleave (x : xs) ys = x : interleave ys xs

fi = fromIntegral
repl = replicate

-------------------------- 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 #-}
{-# 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.List (sort)
import Data.Maybe (fromJust)

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

type Str = C.ByteString

testCase :: Scanner Str
testCase = solve <$> bstr

solve :: Str -> Str
solve s
  | null fs = s
  | fa <= 2 = C.pack $ repl fa a ++ suf
  | otherwise = C.pack $ 'a' : interleave (repl (fa - 1) a) suf
  where
    (a, fa) : fs = sort [(c, C.count c s) | c <- ['a' .. 'z']]
    suf = concatMap (\(c, f) -> repl f c) fs
    repl n x = replicate (fromIntegral n) x
    interleave [] ys = ys
    interleave (x : xs) ys = x : interleave ys xs

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

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

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

import Data.Array.Unboxed
import Data.Array.ST.Safe

bucketSort :: (Char, Char) -> P.ByteString -> (Int, String, UArray Char Int)
bucketSort bnds s = let
  counts :: UArray Char Int
  counts = runSTUArray $ do
    arr <- newArray bnds 0
    (\fun -> arr <$ P.foldr fun (pure ()) s) $ \c act -> do
      v <- readArray arr c
      writeArray arr c (v + 1)
      act
  n = foldl' (+) 0 $ elems counts
  ss = do
    (c, ct) <- assocs $ counts
    replicate ct c
  in  (n, ss, counts)

go :: String -> String -> String -> String
go [] xs ys = xs ++ ys
go as xs [] = xs ++ as
go (a:as) xs (y:ys) = a : y : go as xs ys

solve :: String -> String -> String -> String
solve as [] [] = as
solve (a:as) (x:xs) ys = a : x : go as xs ys
solve _ _ _ = error "yikes"

go2 :: String -> String -> String
go2 [] xs = xs
go2 [a] [] = [a]
go2 (a : as) (x : xs) = a : x : go2 as xs
go2 _ _ = error "yikes2:go"

solve2 :: String -> String -> String
solve2 [] [] = []
solve2 (a : as) xs = a : go2 as xs
solve2 _ _ = error "yikes2"

solve1 :: UArray Char Int -> Maybe String
solve1 arr = case  [c | (c, 1) <- assocs arr]  of
  [] -> Nothing
  c : _ -> Just $ c : do
    (cc, ct) <- assocs arr
    guard $ cc /= c
    replicate ct cc

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    s <- readLine
    let
      (n, w, cts) = bucketSort ('a', 'z') s
      tarc = head w
      key : unsa : sau = group w ++ replicate 3 []
      sa = concat sau
      ans = case  solve1 cts  of
        Just v -> v
        Nothing -> if  2 * (cts ! tarc - 1) > n
          then  solve  key unsa sa
          else  solve2 key (unsa ++ sa)
    lift $ B.hPutBuilder stdout $ B.string7 ans <> B.char7 '\n'

type SIO = StateT P.ByteString IO

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

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

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

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

import Data.Array.Unboxed
import Data.Array.ST.Safe

bucketSort :: (Char, Char) -> P.ByteString -> (Int, String, UArray Char Int)
bucketSort bnds s = let
  counts :: UArray Char Int
  counts = runSTUArray $ do
    arr <- newArray bnds 0
    (\fun -> arr <$ P.foldr fun (pure ()) s) $ \c act -> do
      v <- readArray arr c
      writeArray arr c (v + 1)
      act
  n = foldl' (+) 0 $ elems counts
  ss = do
    (c, ct) <- assocs $ counts
    replicate ct c
  in  (n, ss, counts)

go :: String -> String -> String -> String
go [] xs ys = xs ++ ys
go as xs [] = xs ++ as
go (a:as) xs (y:ys) = a : y : go as xs ys

solve :: String -> String -> String -> String
solve as [] [] = as
solve (a:as) (x:xs) ys = a : x : go as xs ys
solve _ _ _ = error "yikes"

go2 :: String -> String -> String
go2 [] xs = xs
go2 [a] [] = [a]
go2 (a : as) (x : xs) = a : x : go2 as xs
go2 _ _ = error "yikes2:go"

solve2 :: String -> String -> String
solve2 [] [] = []
solve2 (a : as) xs = a : go2 as xs
solve2 _ _ = error "yikes2"

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    s <- readLine
    let
      (n, w, cts) = bucketSort ('a', 'z') s
      tarc = head w
      key : unsa : sau = group w ++ replicate 3 []
      sa = concat sau
      ans = if  2 * (cts ! tarc - 1) > n
        then  solve  key unsa sa
        else  solve2 key (unsa ++ sa)
    lift $ B.hPutBuilder stdout $ B.string7 ans <> B.char7 '\n'

type SIO = StateT P.ByteString IO

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

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


import Data.List
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS

getToken :: IO String
getToken = do
    c <- getChar
    if c == '\n' || c == ' '
        then
            return []
        else do
            cs <- getToken
            return (c:cs)

nextInt :: IO Int
nextInt = do
    token <- getToken
    return (read token :: Int)

nextIntList :: IO [Int]
nextIntList = do
    list <- fmap words getLine
    return $ fmap read list

nextDouble :: IO Double
nextDouble = do
    token <- getToken
    return (read token :: Double)

nextDoubleList :: IO [Double]
nextDoubleList = do
    list <- fmap words getLine
    return $ fmap read list

main = do
    getLine
    v2 <- (map BS.readInt . BS.words) <$> BS.getLine
    let v = [x | (Just (x, _)) <- v2]
--    v <- nextIntList
    m <- nextInt
    let
        v1 = scanl (+) 0 (fmap fromIntegral v) :: [Integer]
        v2 = scanl (+) 0 (fmap fromIntegral (sort v)) :: [Integer]
    let map1 = Map.fromList $ zip [0 ..] v1
    let map2 = Map.fromList $ zip [0 ..] v2
    loop m map1 map2
    where
    loop 0 _ _ = return ()
    loop m map1 map2 = do
        t <- nextInt
        l <- nextInt
        r <- nextInt
        if t == 1
        then
            print $ (map1 Map.! r) - (map1 Map.! (l-1))
        else
            print $ (map2 Map.! r) - (map2 Map.! (l-1))
        loop (m-1) map1 map2

margeSort :: (Ord a) => [a] -> [a]
margeSort [] = []
margeSort list = help xs ys
    where
    (xs,ys) = splitAt ((length list) `div` 2) list
    help xs [] = xs
    help [] ys = ys
    help xs ys = marge (margeSort xs) (margeSort ys)

supersum :: [Int] -> Integer
supersum [] = error "empty"
supersum list = sum $ (fmap fromIntegral list)

marge :: (Ord a) => [a] -> [a] -> [a]
marge xs [] = xs
marge [] ys = ys
marge (x:xs) (y:ys)
    | x < y = x:(marge xs (y:ys))
    | otherwise = y:(marge (x:xs) ys)

{-# LANGUAGE ScopedTypeVariables #-}

import Data.Array.IArray as I
import Data.List
import Control.Applicative
import Control.Monad

getSub :: Array Int Integer -> Int -> Int -> Integer
getSub arr l r = (arr I.! r) - (arr I.! (l - 1))

main = do
  n <- read <$> getLine
  stones::[Integer] <- map read . words <$> getLine
  m <- read <$> getLine
  let
    a1 = I.listArray (0, n) $ (scanl (+) 0 stones)
    a2 = I.listArray (0, n) $ (scanl (+) 0 (sort stones))
  forM_ [1..m] $ \_ -> do
    [t, l, r] <- map read . words <$> getLine
    let a = if t == 1 then a1 else a2
    print $ getSub a l r

import Data.List
import qualified Data.Map as Map

getToken :: IO String
getToken = do
	c <- getChar
	if c == '\n' || c == ' '
		then
			return []
		else do
			cs <- getToken
			return (c:cs)

nextInt :: IO Int
nextInt = do
	token <- getToken
	return (read token :: Int)

nextIntList :: IO [Int]
nextIntList = do
	list <- fmap words getLine
	return $ fmap read list

nextDouble :: IO Double
nextDouble = do
	token <- getToken
	return (read token :: Double)

nextDoubleList :: IO [Double]
nextDoubleList = do
	list <- fmap words getLine
	return $ fmap read list

main = do
	n <- nextInt
	v <- nextIntList
	m <- nextInt
	let
		v1 = scanl (+) 0 (fmap fromIntegral v) :: [Integer]
		v2 = scanl (+) 0 (fmap fromIntegral (sort v)) :: [Integer]
	let map1 = Map.fromList $ zip [0 ..] v1
	let map2 = Map.fromList $ zip [0 ..] v2
	sequence_ [ nextInt >>= \t -> nextInt >>= \l -> nextInt >>= \r ->
		if t == 1
		then
			print $ (map1 Map.! r) - (map1 Map.! (l-1))
		else
			print $ (map2 Map.! r) - (map2 Map.! (l-1)) | _ <- [1..m]]

	where
	loop 0 _ _ = return ()
	loop m map1 map2 = do
		t <- nextInt
		l <- nextInt
		r <- nextInt
		loop (m-1) map1 map2

margeSort :: (Ord a) => [a] -> [a]
margeSort [] = []
margeSort list = help xs ys
	where
	(xs,ys) = splitAt ((length list) `div` 2) list
	help xs [] = xs
	help [] ys = ys
	help xs ys = marge (margeSort xs) (margeSort ys)

supersum :: [Int] -> Integer
supersum [] = error "empty"
supersum list = sum $ (fmap fromIntegral list)

marge :: (Ord a) => [a] -> [a] -> [a]
marge xs [] = xs
marge [] ys = ys
marge (x:xs) (y:ys)
	| x < y = x:(marge xs (y:ys))
	| otherwise = y:(marge (x:xs) ys)

import Data.List
import qualified Data.Map as Map

getToken :: IO String
getToken = do
	c <- getChar
	if c == '\n' || c == ' '
		then
			return []
		else do
			cs <- getToken
			return (c:cs)

nextInt :: IO Int
nextInt = do
	token <- getToken
	return (read token :: Int)

nextIntList :: IO [Int]
nextIntList = do
	list <- fmap words getLine
	return $ fmap read list

nextDouble :: IO Double
nextDouble = do
	token <- getToken
	return (read token :: Double)

nextDoubleList :: IO [Double]
nextDoubleList = do
	list <- fmap words getLine
	return $ fmap read list

main = do
	n <- nextInt
	v <- nextIntList
	m <- nextInt
	let
		v1 = scanl (+) 0 (fmap fromIntegral v) :: [Integer]
		v2 = scanl (+) 0 (fmap fromIntegral (sort v)) :: [Integer]
	let map1 = Map.fromList $ zip [0 ..] v1
	let map2 = Map.fromList $ zip [0 ..] v2
	loop m map1 map2
	where
	loop 0 _ _ = return ()
	loop m map1 map2 = do
		t <- nextInt
		l <- nextInt
		r <- nextInt
		if t == 1
		then
			print $ (map1 Map.! r) - (map1 Map.! (l-1))
		else
			print $ (map2 Map.! r) - (map2 Map.! (l-1))
		loop (m-1) map1 map2

margeSort :: (Ord a) => [a] -> [a]
margeSort [] = []
margeSort list = help xs ys
	where
	(xs,ys) = splitAt ((length list) `div` 2) list
	help xs [] = xs
	help [] ys = ys
	help xs ys = marge (margeSort xs) (margeSort ys)

supersum :: [Int] -> Integer
supersum [] = error "empty"
supersum list = sum $ (fmap fromIntegral list)

marge :: (Ord a) => [a] -> [a] -> [a]
marge xs [] = xs
marge [] ys = ys
marge (x:xs) (y:ys)
	| x < y = x:(marge xs (y:ys))
	| otherwise = y:(marge (x:xs) ys)

import Data.List
import Data.Int
import Control.Applicative
import qualified Data.Map as Map
import qualified Data.ByteString.Char8 as BS

getToken :: IO String
getToken = do
    c <- getChar
    if c == '\n' || c == ' '
        then
            return []
        else do
            cs <- getToken
            return (c:cs)

nextInt :: IO Int
nextInt = do
    token <- getToken
    return (read token :: Int)

nextIntList :: IO [Int]
nextIntList = do
    list <- fmap words getLine
    return $ fmap read list

nextDouble :: IO Double
nextDouble = do
    token <- getToken
    return (read token :: Double)

nextDoubleList :: IO [Double]
nextDoubleList = do
    list <- fmap words getLine
    return $ fmap read list

main = do
    getLine
    v2 <- (map BS.readInt . BS.words) <$> BS.getLine
    let v = [x | (Just (x, _)) <- v2]
    m <- nextInt
    let
        v1 = scanl (+) 0 (fmap fromIntegral v) :: [Int64]
        v2 = scanl (+) 0 (fmap fromIntegral (sort v)) :: [Int64]
    let map1 = Map.fromList $ zip [0 ..] v1
    let map2 = Map.fromList $ zip [0 ..] v2
    loop m map1 map2
    where
    loop 0 _ _ = return ()
    loop m map1 map2 = do
        t <- nextInt
        l <- nextInt
        r <- nextInt
        if t == 1
        then
            print $ (map1 Map.! r) - (map1 Map.! (l-1))
        else
            print $ (map2 Map.! r) - (map2 Map.! (l-1))
        loop (m-1) map1 map2

margeSort :: (Ord a) => [a] -> [a]
margeSort [] = []
margeSort list = help xs ys
    where
    (xs,ys) = splitAt ((length list) `div` 2) list
    help xs [] = xs
    help [] ys = ys
    help xs ys = marge (margeSort xs) (margeSort ys)

supersum :: [Int] -> Integer
supersum [] = error "empty"
supersum list = sum $ (fmap fromIntegral list)

marge :: (Ord a) => [a] -> [a] -> [a]
marge xs [] = xs
marge [] ys = ys
marge (x:xs) (y:ys)
    | x < y = x:(marge xs (y:ys))
    | otherwise = y:(marge (x:xs) ys)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn
  vs <- map fromIntegral <$> getInts :: IO [Int64]
  m <- readLn
  qs <- replicateM m getInts

  let
    a = listArray (0, n) $ scanl (+) 0 vs
    b = listArray (0, n) $ scanl (+) 0 $ sort vs

    query [1, l, r] = a!r - a!(l-1)
    query [2, l, r] = b!r - b!(l-1)

  putStrLn $ unlines $ map show $ map query qs

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn
  vs <- map fromIntegral <$> getInts :: IO [Int64]
  m <- readLn
  qs <- replicateM m getInts

  let
    a = listArray (0, n) $ scanl (+) 0 vs :: UArray Int Int64
    b = listArray (0, n) $ scanl (+) 0 $ sort vs :: UArray Int Int64

    query [1, l, r] = a!r - a!(l-1)
    query [2, l, r] = b!r - b!(l-1)

  putStrLn $ unlines $ map show $ map query qs

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn
  vs <- map fromIntegral <$> getInts :: IO [Int64]
  m <- readLn
  qs <- replicateM m getInts

  let
    a = listArray (0, n) $ scanl (+) 0 vs :: UArray Int Int64
    b = listArray (0, n) $ scanl (+) 0 $ sort vs :: UArray Int Int64

    query [1, l, r] = a!r - a!(l-1)
    query [2, l, r] = b!r - b!(l-1)

  putStrLn $ unlines $ map show $ map query qs

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Int

import Data.Array.IO
import Data.Bits ( (.|.), (.&.) )

update arr at by = do
  (_,hi) <- getBounds arr
  let loop i | i > hi = return ()
      loop i = do v <- readArray arr i
                  writeArray arr i (v+by)
                  loop (i .|. (i+1))
  loop at

query0 arr at = do
  (lo,_) <- getBounds arr
  let loop !s i | i < lo = return s
      loop !s i = do v <- readArray arr i
                     loop (s+v) ((i .&. (i+1)) -1)
  loop 0 at

query arr i0 i1 = do
  s0 <- query0 arr (i0-1)
  s1 <- query0 arr i1
  return (s1-s0)

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStr $ label ++ ":"
  (lo,hi) <- getBounds arr
  forM_ [lo..hi] $ \i -> do
    v <- readArray arr i
    putStr $ " " ++ show v
  putStrLn ""

main = do
  n <- fmap read getLine
  nums <- fmap (parseInts n) BS.getLine
  a1 <- newArray (0,n) 0 :: IO (IOUArray Int Int64)
  a2 <- newArray (0,n) 0 :: IO (IOUArray Int Int64)
  forM_ (zip [1..] nums) $ \(i,v) -> update a1 i (fromIntegral v)
  forM_ (zip [1..] (sort nums)) $ \(i,v) -> update a2 i (fromIntegral v)

  -- showArray "a1" a1
  -- showArray "a2" a2

  k <- fmap read getLine
  replicateM_ k $ do
    (q:a:b:_) <- fmap (parseInts 3) BS.getLine
    if q == 1
      then query a1 a b >>= print
      else query a2 a b >>= print

import Data.List
import Data.Array
import Control.Monad
main = do
  n <- readLn
  vs <- map read . words <$> getLine
  let s = listArray (0,n) $ scanl (+) 0 vs
      c = listArray (0,n) $ scanl (+) 0 (sort vs)
  m <- readLn
  replicateM_ m $ do
    [t,l,r] <- map read . words <$> getLine
    let a = [c,s] !! fromEnum (t == 1)
    print $ a!r - a!(l-1)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn
  vs <- getInts
  m <- readLn
  qs <- replicateM m getInts

  let
    a = listArray (0, n) $ scanl (+) 0 vs
    b = listArray (0, n) $ scanl (+) 0 $ sort vs

    query [1, l, r] = a!r - a!(l-1)
    query [2, l, r] = b!r - b!(l-1)

  putStrLn $ unlines $ map show $ map query qs

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

import Data.Array.IO
import Data.Bits ( (.|.), (.&.) )

update arr at by = do
  (_,hi) <- getBounds arr
  let loop i | i > hi = return ()
      loop i = do v <- readArray arr i
                  writeArray arr i (v+by)
                  loop (i .|. (i+1))
  loop at

query0 arr at = do
  (lo,_) <- getBounds arr
  let loop !s i | i < lo = return s
      loop !s i = do v <- readArray arr i
                     loop (s+v) ((i .&. (i+1)) -1)
  loop 0 at

query arr i0 i1 = do
  s0 <- query0 arr (i0-1)
  s1 <- query0 arr i1
  return (s1-s0)

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStr $ label ++ ":"
  (lo,hi) <- getBounds arr
  forM_ [lo..hi] $ \i -> do
    v <- readArray arr i
    putStr $ " " ++ show v
  putStrLn ""

main = do
  n <- fmap read getLine
  nums <- fmap (parseInts n) BS.getLine
  a1 <- newArray (0,n) 0 :: IO (IOUArray Int Int)
  a2 <- newArray (0,n) 0 :: IO (IOUArray Int Int)
  forM_ (zip [1..] nums) $ \(i,v) -> update a1 i v
  forM_ (zip [1..] (sort nums)) $ \(i,v) -> update a2 i v

  -- showArray "a1" a1
  -- showArray "a2" a2

  k <- fmap read getLine
  replicateM_ k $ do
    (q:a:b:_) <- fmap (parseInts 3) BS.getLine
    if q == 1
      then query a1 a b >>= print
      else query a2 a b >>= print

import Data.List
import Control.Monad
main = do
  getLine -- n
  vs <- map read . words <$> getLine
  let s = scanl (+) 0 vs
      c = scanl (+) 0 (sort vs)
  m <- readLn
  replicateM_ m $ do
    [t,l,r] <- map read . words <$> getLine
    let a = [c,s] !! fromEnum (t == 1)
    print $ a!!l - a!!r


parse :: String -> [[Integer]]
parse = map (map read . words) . go . tail . lines
  where
    go [] = []
    go (_:y:ys) = y : go ys

solve :: [Integer] -> Bool
solve = any (not . square)
  where
    square x = (==x) . (^ 2) . floor . sqrt $ fromIntegral x

format :: [Bool] -> String
format = unlines . map go
  where
    go True = "YES"
    go False = "NO"

main = interact $ format . map solve . parse

parse :: String -> [[Integer]]
parse = map (map read . words) . go . tail . lines
  where
    go [] = []
    go (_:y:ys) = y : go ys

solve :: [Integer] -> Bool
solve = any (not . square)
  where
    square n = r * r == n
      where r = floor . sqrt $ fromIntegral n

format :: [Bool] -> String
format = unlines . map go
  where
    go x = if x then "YES" else "NO"

main = interact $ format . map solve . parse

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

readInts = fmap (map read.words) getLine :: IO [Integer]
printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

isntPerfectSquare::Integer->Bool
isntPerfectSquare x = (floor (sqrt (fromIntegral x)) )*(floor (sqrt (fromIntegral x))) /= x

solve = do
    n<-readLn :: IO Int
    a<-readInts
    putStrLn $ if any isntPerfectSquare a then "YES" else "NO"

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

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

import qualified Data.Array as A

import Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor)

import Data.Array((!))
import Control.Monad(replicateM)
import Numeric.Natural
import Data.Maybe

intNat :: Natural -> Int
intNat = fromInteger . toInteger

isPerfectSquare :: Natural -> Bool
isPerfectSquare n = aux1 $ aux2 2 (n, True) where
	aux1 (n, b) = if n > 1 then False else b

	aux2 i (n, b) | i * i > n = (n, b)
	aux2 i (n, b) = aux2 (i+1) $ n' n b where
		n' n b
			| mod n i /= 0 = (n, b)
			| mod n (i*i) == 0 = n' (div n (i*i)) b
			| otherwise = (div n i, False)

solve list = foldr (||) False $ fmap (not . isPerfectSquare) list

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

main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n] <- getLine >>= return . (fmap read) . words :: IO [Natural]
		a <- getLine >>= return . (fmap read) . words :: IO [Natural]
		putStrLn $ showR $ solve a