import Data.List (group)
solve :: [String] -> Integer
solve = sum . map (f . length) . group
    where f x = let x' = fromIntegral x in quot (x' * (x' + 1)) 2
main = getLine >> getLine >>= putStrLn . show . solve . words

module Main where

import List

parseInt :: String -> Int
parseInt token = read token :: Int

subArrays :: Int -> Integer
subArrays x = n * (n + 1) `div` 2
              where n = toInteger x

solve :: [Int] -> Integer
solve = sum . map (subArrays . length) . group

main = interact (show . solve . map parseInt . tail . words)

module Main where

import Data.Char;

main = do
  s <- getLine
  interact in2out

in2out input
  = output
  where
    nums :: [Integer]
    nums = map read $ words input
    output = show $ count nums (10^9+1) 0 0
    count [] _ cx ans
      = cx + ans
    count (x:xs) px cx ans
      = count xs x cx' $! cx+ans
      where
        cx'
          | x == px
          = cx + 1
          | otherwise
          = 1

import List (group)
import Monad (liftM)

solve :: [Int] -> Integer
solve  =  sum . map (f . fromIntegral . length) . group
  where
    f :: Integer -> Integer
    f n  =  div (n * (n + 1)) 2

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

import Data.List
main = getLine >> (group . words) `fmap` getLine >>=
       print . foldl' (\x n -> x + n*(n+1) `div` 2) 0 . map (fromIntegral . length)

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

f :: Integer -> Integer -> Integer
f x n = seq y (x + y)
    where y = n * (n+1) `div` 2

main = do
    getLine
    xs <- map read . words <$> getLine :: IO [Integer]
    print $ foldl' f 0 $ map (fromIntegral . length) $ group xs

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    replicateM n readInt
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = do
    a <- evalState parseInput <$> BS.getContents
    print $ solve a

solve :: [Int] -> Int64
solve a = sum .  map (\x -> (fromIntegral x * (fromIntegral x + 1) `div` 2) ) . map length $ group a

--{{{ Start of a minimal State Monad
class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State
--}}} end of a minimal State Monad

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE ViewPatterns #-}

module Main where

import Data.List
import Data.Ord
import Data.Map(Map)
import qualified Data.Map as Map
import Data.Set(Set)
import qualified Data.Set as Set
import Control.Applicative
import Control.Monad
import Data.Bits

main = do
    [n::Integer] <- map read . words <$> getLine
    (numbers::[Integer]) <- map read . words <$> getLine
    let sizes = map genericLength (group numbers) :: [Integer]
    let solve size = (size+1) * size `div` 2
    putStrLn $ show $ sum $ map solve sizes

import List
import Control.Monad

main =
	do
		n <- getLine
		l <- liftM (\x -> map read $ words x) getLine
		putStrLn $ show $ foldl (\x y -> x + y * (y+1) `div` 2) 0 (map fromIntegral (map length $ group (l::[Int])))

import Data.List (genericLength, group)
solve :: [String] -> Integer
solve = sum . map ((\x -> x * (x+1) `quot` 2) . genericLength) . group
main = getLine >> getLine >>= putStrLn . show . solve . words

import Data.List
import Data.Int
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int32]
    putStr $ show $ sum $ map (\x -> let k = (fromIntegral (length x) :: Integer) in
			k * (k + 1) `div` 2) $ group l

readd line = map (\x-> (read x)::Int) $ parsespace line

parsespace' res cur [] = cur:res
parsespace' res cur (a:xs) =
  if a == ' ' then
   parsespace' (cur:res) [] xs
  else
   parsespace' res (cur++[a]) xs

parsespace line = filter (\x->length x > 0) $ parsespace' [] [] line

magicparts' res cur last [] = cur:res
magicparts' res cur last (a:xs) =
 if a==last then
   magicparts' res (cur+1) last (xs)
 else
   magicparts' (cur:res) 1 a (xs)

magicparts arr = magicparts' [] 1 (head arr) (tail arr)

res line = foldr (+) 0 $ map (\x->x*(x+1) `div` 2) (magicparts (readd line))

main = do
  line1 <- getLine
  line <- getLine
  putStrLn (show (res line))

{-# OPTIONS_GHC -O2 #-}
import Data.List (genericLength, group)
import qualified Data.ByteString.Char8 as B
solve :: [B.ByteString] -> Integer
solve = sum . map ((\x -> x * (x+1) `quot` 2) . genericLength) . group
main = B.getLine >> B.getLine >>= putStrLn . show . solve . B.words

import Data.List (genericLength, group)
solve xs = sum $ map (\x -> (x + 1) * x `div` 2) $ map genericLength $ group xs
main = interact $ show . solve . tail . words

import Data.List (genericLength)

decompose [] = []
decompose (x:xs) =
  case span (== x) (x:xs) of
    (a, b) -> a:(decompose b)

solve :: [Integer] -> Integer
solve xs = sum $ map (\x -> x * (x + 1) `div` 2) $ map genericLength (decompose xs)

main = do _ <- getLine
          line <- getLine
          putStrLn $ show $ solve $ map (read :: String -> Integer) (words line)

import List (group)
import Monad (liftM)

solve :: [Int] -> Int
solve  =  sum . map f . map length . group
  where
    f n  =  div (n * (n + 1)) 2

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

decompose [] = []
decompose (x:xs) =
  case span (== x) (x:xs) of
    (a, b) -> a:(decompose b)

solve xs = sum $ map (\x -> x * (x + 1) `div` 2) $ map length (decompose xs)

main = do _ <- getLine
          line <- getLine
          putStrLn $ show $ solve $ map (read :: String -> Integer) (words line)

import List
import Control.Monad

main =
	do
		n <- getLine
		l <- liftM (\x -> map read $ words x) getLine
		putStrLn $ show $ foldl (\x y -> x + y * (y+1) `div` 2) 0 (map length $ group (l::[Int]))

import Data.List
import Data.Int
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int32]
    putStr $ show $ sum $ map (\x -> let k = length x in k * (k + 1) `div` 2) $ group l

import Data.List
main = do
    n <- read `fmap` getLine :: IO Int
    l <- (map read . words) `fmap` getLine :: IO [Int]
    putStr $ show $ sum $ map (\x -> let k = length x in k * (k + 1) `div` 2) $ group l


{-# OPTIONS_GHC -O2 -optc-O2 #-}
module Main where

import Control.Monad (liftM)
import qualified Data.ByteString.Lazy.Char8 as BS

readInteger :: BS.ByteString -> Integer
readInteger s = case BS.readInteger s of
  Just (x, _) -> x
  Nothing     -> error "Can't parse Integer"

solve :: Integer -> Integer -> [Integer] -> [Integer]
solve n k a = solve' n 1 0 (zip a [1 ..])
  where solve' n i _ _ | i > n = []
        solve' n i s ((a, x):as) = if rating < k
                                   then x : solve' (n - 1) i s as
                                   else solve' n (i + 1) s' as
          where rating = s - (i - 1) * (n - i) * a
                s'     = s + a * (i - 1)

main = do
  (n:k:a) <- liftM (map readInteger . BS.words) BS.getContents
  let result = solve n k a
  BS.putStr . BS.unlines $ map (BS.pack . show) result

import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int
import Data.Maybe

import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
main = do
    n:k:l <- map readInt . B.words <$> B.getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop :: Int -> Int64 -> Int -> [Int] -> [Int]
        loop c b m (a1:a2:as)
            | d < itol k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + itol a1*itol (c-2)
                d  = b' - itol (c-1)*itol (m-c)*itol a2
        loop c b n _ = []

itol = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Int

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop :: Int -> Int64 -> Int -> [Int] -> [Int]
        loop c b m (a1:a2:as)
            | d < itol k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + itol a1*itol (c-2)
                d  = b' - itol (c-1)*itol (m-c)*itol a2
        loop c b n _ = []

itol = fromIntegral

import Control.Monad
import Control.Applicative
import Control.Arrow

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop c b m (a1:a2:as)
            | d < k = (c+n-m):loop c b (m-1) (a2:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + a1*(c-2)
                d  = b' - (c-1)*(m-c)*a2
        loop c b n _ = []

import Control.Monad
import Control.Applicative
import Control.Arrow

main = do
    n:k:l <- map read . words <$> getContents
    putStr $ unlines $ map show $ solve n k l

solve :: Int -> Int -> [Int] -> [Int]
solve n k l = loop 2 0 n l
    where
        loop c b m (a1:a2:as)
            | d < k = (c+n-m):loop c b (m-1) (a1:as)
            | otherwise = loop (c+1) b' m (a2:as)
            where
                b' = b  + a1*(c-2)
                d  = b' - (c-1)*(m-c)*a2
        loop c b n _ = []


import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as SP
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.Array.Unboxed

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    orig <- replicateM n (P.toStrict <$> readLine)
    scr <- replicateM (n-1) (P.toStrict <$> readLine)
    let
      outStr = (++ "\n") $ do
        i <- [0 .. fromIntegral (m - 1)]
        let
          [oi, si] = map (map (`SP.index` i)) [orig, scr]
          cts :: UArray Char Int
          cts = accumArray (+) 0 ('a', 'z')
            $ zip oi (repeat 1) ++ zip si (repeat (0-1))
        [c | c <- ['a' .. 'z'], cts ! c /= 0]
    lift $ B.hPutBuilder stdout $ B.string7 outStr

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]

{-# OPTIONS_GHC -O2 #-}

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

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

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  _ <- let a = B.transpose $ _s2
           b = B.transpose $ _s3
           sol = if n == 1 then head _s2 else B.pack $ zipWith subtr a b
       in sequence [B.putStr sol,  putStrLn "", hFlush stdout]
  return ()

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

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

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

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

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

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

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

solve :: Int -> Int -> [String] -> [String] -> String
solve n m initA resultA = result
    where
        initAB8 :: [B8.ByteString]
        initAB8 = map B8.pack initA

        resultAB8 :: [B8.ByteString]
        resultAB8 = map B8.pack resultA

        result :: String
        result = flip map [0 .. m - 1] $ \i ->
                let
                    emptyMap :: M.Map Char Int
                    emptyMap = M.empty

                    inclusiveMap :: M.Map Char Int
                    inclusiveMap = foldr (\s m -> M.insertWith (+) (s `B8.index` i) 1 m) emptyMap initAB8

                    resultMap :: M.Map Char Int
                    resultMap = foldr (\s m -> M.insertWith (+) (s `B8.index` i) (-1) m) inclusiveMap resultAB8

                in fst . head . filter (\(k, v) -> v > 0) . M.toList $ resultMap

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, m] <- B8.getLine <&> map readIntB8 . B8.words
        initA <- replicateM n $ B8.getLine <&> B8.unpack
        resultA <- replicateM (n - 1) $ B8.getLine <&> B8.unpack

        let answer = solve n m initA resultA

        putStrLn answer
        hFlush stdout

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (forM_, replicateM_)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List (transpose, group, sort)

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

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

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

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

(><) = times

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

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

testCase :: Scanner String
testCase = do
  (n, _) <- pair int int
  ss <- (2 * n - 1) >< str
  return $ map findOdd (transpose ss)

findOdd :: [Char] -> Char
findOdd = head . head . filter (odd . length) . group . sort

{-# OPTIONS_GHC -O2 #-}

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

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

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  _ <- let a = B.transpose $ _s2
           b = B.transpose $ _s3
           sol = if n == 1 then [B.head $ head a] else zipWith subtr a b
       in sequence [B.putStr $ B.pack sol, putStrLn "", hFlush stdout]
  return ()

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

{-# OPTIONS_GHC -O2 #-}

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

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

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n (B.getLine :: IO B.ByteString)
  _s3 <- sequence $ replicate (n-1) (B.getLine :: IO B.ByteString)
  let a = B.transpose $ _s2
      b = B.transpose $ _s3
      sol = zipWith subtr a b
    in sequence [B.putStr $ B.pack sol, putStrLn ""]
  return ()

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

{-# OPTIONS_GHC -O2 #-}

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

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

--import Data.Char as C
--import Data.IntSet as S

-- fuck haskell and its slow io

findchar (x:_) [] = B.head x
findchar (x:xs) (y:ys)
  | B.length x == B.length y && B.head x == B.head y = findchar xs ys
  | otherwise = B.head x

subtr :: B.ByteString -> B.ByteString -> Word8
subtr a b = findchar as bs
  where as = B.group $ B.sort a
        bs = B.group $ B.sort b

solve :: IO ()
solve = do
  _s1 <- getLine
  let [n, m] = map read $ words _s1 :: [Int]
  _s2 <- sequence $ replicate n B.getLine :: IO [B.ByteString]
  _s3 <- sequence $ replicate (n-1) B.getLine :: IO [B.ByteString]
  let a = B.transpose $ _s2
      b = B.transpose $ _s3
      sol = zipWith subtr a b
    in sequence [B.putStr $ B.pack sol, putStrLn "", hFlush stdout]
  return ()

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


{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List

main = do
  [_, v] <- map read.words <$> getLine
  xys <- parse.map read.words <$> getContents
  print $ solve v xys

parse (x:y:xys) = (x, y) : parse xys
parse _ = []

solve :: Int -> [(Int, Int)] -> Int
solve v xys = go 0 1 v $ sort xys
   where
     go !res !day !num ((a,b):rest)
       | day < a = go res (day+1) v $ (a,b):rest
       | a + 1 < day = go res day num rest
       | num <= b = go (res+num) (day+1) v $ (a,b-num) : rest
       | otherwise = go (res+b) day (num-b) rest
     go res _ _ _ = res

import Data.List
import Data.Function

main=interact $ show . getAns . getArrays

getArrays :: String -> [Int]
getArrays = tail . map read . words

getAns :: [Int] -> Int
getAns (v:xs) = getMax 1 0 v $ (map (\l@(x:xs) -> (fst x, (sum . map snd) l)) . groupBy (\x y -> fst x == fst y) . sort . toPairs) xs

toPairs :: [Int] -> [(Int, Int)]
toPairs [] = []
toPairs (x:y:xs) = (x, y) : toPairs xs

getMax :: Int -> Int -> Int -> [(Int, Int)] -> Int
getMax _ 0 _ [] = 0
getMax d r v ((y, x):xs) | y == d =
	let gets = min (r + x) v
	    nr = if gets >= r then x + r - gets else x
	in gets + getMax (d + 1) nr v xs
getMax d r v xs = min v r + getMax (d + 1) 0 v xs

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Array.Unboxed
import Data.Array.IO

solve maxi v !s d i rarr | i > maxi =
  let s1 = min v d in s+s1

solve maxi v !s d i rarr =
  -- v - picking capacilty
  -- s - total fruit picked
  -- maxi - maximum value of i
  -- d - amount of day-old fruit
  -- i - day number
  -- rarr - array of ripened fruit
  let r = rarr!i
      s1 = min v (d+r)      -- amount of day-old fruit picked
      d' = min (d+r-s1) r   -- new amount of day-old fruit
  in solve maxi v (s+s1) d' (i+1) rarr

main = do
  (n:v:_) <- fmap (map read . words) getLine
  rarr <- newArray (1,3001) 0 :: IO (IOUArray Int Int)
  replicateM_ n $ do
    (a:b:_) <- fmap (map read . words) getLine
    x <- readArray rarr a
    writeArray rarr a (b+x)
  rarr <- freeze rarr  :: IO (UArray Int Int)
  let answer = solve 3001 v 0 0 1 rarr
  print answer

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List (sort, insertBy)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Debug.Trace

readInts :: B.ByteString -> [Int]
readInts = map fst . mapMaybe B.readInt . B.words

getInts :: IO [Int]
getInts = readInts <$> B.getLine

main = do
  [n, v] <- getInts
  ts <- replicateM n $ do {[a, c] <- getInts; return (a, 0, c);}
  let
    comp (x1,y1,_) (x2,y2,_) = (x1 `compare` x2) `mappend` (y2 `compare` y1)
    f [] _ _ = 0
    f ts@((a,b,c):rs) day limit
      | b == 2 || c == 0 = f rs day limit
      | a == day = let fruit = min c limit in fruit + f (insertBy comp (a+1, b+1, c-fruit) rs) day (limit-fruit)
      | otherwise = f ts (day+1) v
    in print $ f (sort ts) 1 v

import Data.List
import Data.Function

main=interact $ show . getAns . getArrays

getArrays :: String -> [Int]
getArrays = tail . map read . words

getAns :: [Int] -> Int
getAns (v:xs) = getMax 1 0 v $ (sort . toPairs) xs

toPairs :: [Int] -> [(Int, Int)]
toPairs [] = []
toPairs (x:y:xs) = (x, y) : toPairs xs

getMax :: Int -> Int -> Int -> [(Int, Int)] -> Int
getMax _ 0 _ [] = 0
getMax d r v ((y, x):xs) | y == d =
	let gets = min (r + x) v
	    tr = if gets >= r then x - (gets - r) else 0
	    nr = if tr > 0 then tr else 0
	in gets + getMax (d + 1) nr v xs
getMax d r v xs = min v r + getMax (d + 1) 0 v xs

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List

main = do
  [_, v] <- map read.words <$> getLine
  xys <- parse.map read.words <$> getContents
  print $ solve v xys

parse (x:y:xys) = (x, y) : parse xys
parse _ = []

solve :: Int -> [(Int, Int)] -> Int
solve v xys = go 0 1 v (sort xys)
   where
     go !res !day !num ((a,b):rest)
       | day < a = go res a v rest
       | a + 1 < day = go res day num rest
       | num <= b = go (res+num) (day+1) v $ (a,b-num) : rest
       | otherwise = go (res+b) day (num-b) rest
     go res _ _ _ = res


data S=A|B deriving Eq
data SL = SL [S]

readS::Char->S
readS 'a' = A
readS 'b' = B

readSL::String->[S]
readSL str = map readS str

showS::S->Char
showS A = 'a'
showS B = 'b'

showSL::[S]->String
showSL str = map showS str

beat2::[S]->[(S,S)]
beat2 [] = []
beat2 (x:y:xs) = (x,y):(beat2 xs)

inv::(S,S)->(Int,(S,S))
inv (A,A) = (1,(A,B))
inv (B,B) = (1,(B,A))
inv a=(0,a)

backConc::[(a,a)]->[a]
backConc [] =[]
backConc ((x,y):xs)=x:y:(backConc xs)

getFinal::[S]->(Int,[S])
getFinal str = let
   (ns,fs) = unzip $ map inv (beat2 str)
    in (sum ns,backConc fs)

main::IO()
main = do
   n <- getLine
   str <- getLine
   let (n,str') = getFinal (readSL str)
   print n
   putStrLn (showSL str')

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

tr "aa" = "ab"
tr "bb" = "ab"
tr x = x

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

main = do
	n<- read <$> getLine ::IO Int
	s<-chunksOf 2 <$> getLine
	print $  length $ filter (\z-> elem z ["aa","bb"]) s
	putStrLn $ concat $ map tr s


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

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let cntEven = length $ filter (even . length) blocks

        let answer = length blocks

        answer <- return (if odd cntEven then answer - 1 else answer)

        putStrLn $ show answer

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

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

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let cntEven = length $ filter (even . length) blocks

        let answer = (-) (length blocks) (if odd cntEven then 1 else 0)

        putStrLn $ show answer

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

listToCountListMod2 :: [Int] -> [Int]
listToCountListMod2 = map (`mod` 2) . M.elems . M.fromListWith (+) . flip zip (repeat 1)

oneAndTwoToAnswer :: [Int] -> Int
oneAndTwoToAnswer lst = oneCount + twoCount - twoCount `mod` 2
  where
    oneAndTwoCount = M.fromListWith (+) $ zip lst (repeat 1)
    oneCount = fromMaybe 0 $ oneAndTwoCount !? 1
    twoCount = fromMaybe 0 $ oneAndTwoCount !? 0

solution :: IO ()
solution = do
  [_] <- getNumbers
  nums <- getNumbers
  print $ oneAndTwoToAnswer $ listToCountListMod2 nums

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

module Main where

import Control.Monad (replicateM_)
import qualified Data.Map as M
import Data.Map.Internal ((!?))
import Data.Maybe (fromMaybe)

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

listToCountListMod2 :: [Int] -> [Int]
listToCountListMod2 = map (`mod` 2) . M.elems . M.fromListWith (+) . flip zip (repeat 1)

oneAndTwoToAnswer :: [Int] -> Int
oneAndTwoToAnswer lst = oneCount + (if twoCount `mod` 2 == 1 then twoCount - 1 else twoCount)
  where
    oneAndTwoCount = M.fromListWith (+) $ zip lst (repeat 1)
    oneCount = fromMaybe 0 $ oneAndTwoCount !? 1
    twoCount = fromMaybe 0 $ oneAndTwoCount !? 0

solution :: IO ()
solution = do
  [_] <- getNumbers
  nums <- getNumbers
  print $ oneAndTwoToAnswer $ listToCountListMod2 nums

main :: IO ()
main = do
  [t] <- getNumbers
  replicateM_ t solution

{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import Control.Monad.State.Class
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.Functor.Identity
import qualified Data.IntMap as M
import Data.Maybe
import Debug.Trace

type ParserT = StateT C.ByteString

type ComputationT m = StateT (M.IntMap Bool) (ParserT m)

-- A computation is a monadic action with an input string and an intmap "variable" as state.
type Computation = ComputationT Identity

runComputation :: Computation a -> C.ByteString -> a
runComputation computation = runIdentity . evalStateT (evalStateT computation M.empty)

main :: IO ()
main = do
  t <- int <$> C.getLine
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- int <$> C.getLine
  C.getLine >>= output . runComputation (replicateM_ n populateTree >> eliminateTree)

eliminateTree :: Computation Int
eliminateTree = do
  list <- gets M.toList
  return $ length list - ((`mod` 2) . length . filter id . map snd $ list)

populateTree :: Computation ()
populateTree = do
  val <- lift getInt
  modify $ M.alter (pure . maybe False not) val

getInt :: Monad m => ParserT m Int
getInt = StateT $ pure . fromJust . C.readInt . C.dropWhile isSpace

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

output :: Int -> IO ()
output = L.putStrLn . B.toLazyByteString . B.intDec

module Main where

import Data.List

main = do
  tStr <- getLine
  let t = read tStr :: Int
  input <- getContents
  let inputs = map ((map read) . words) $ take t $ dropOdd $ lines input
  mapM_ (print . solve) inputs
    where dropOdd [] = []
          dropOdd (_:x:xs) = x:(dropOdd xs)

solve :: [Int] -> Int
solve xs = unique - abs ((length xs + unique) `mod` 2)
  where unique = length $ nub xs

{-# LANGUAGE ScopedTypeVariables #-}

import Data.List
import Control.Monad
--import Control.Monad.State.Strict

-- parseLine = fmap (map read . words)

toSpaced :: Show a => [a] -> String
toSpaced = intercalate " " . map show

printSpaced :: Show a => [a] -> IO ()
printSpaced = putStrLn . toSpaced

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

f :: Int -> Int -> Int
f x y = mod (x - y + 10) 10

main :: IO ()
main = do
    t <- readInt
    forM_ [1..t] $ \t -> do
        n <- readInt
        a <- readInts

        let fs = map length (group $ sort a)

        {-
        offsets <- (forM [1..n] $ \i -> do
            line <- getLine;
            let [b_i_s, s_i] = words line;
            -- print $ (b_i_s, s_i)
            let b_i :: Int = read b_i_s;
            let up_count = (length . filter (=='U')) s_i;
            let down_count = (length . filter (=='D')) s_i;
            return $ up_count - down_count)

        let res :: [Int] = zipWith f a offsets
        -}

        let o = length $ filter (\x -> (x `mod` 2) == 1) fs
        let e = length $ filter (\x -> (x `mod` 2) == 0) fs

        -- printSpaced fs
        print $ o + e - (e `mod` 2)

        return ()

import Data.List (sort)

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

checkH :: Int -> Int -> [Int] -> (Int, Int)
checkH _ c [] = if c `mod` 2 == 0
  then (1, 0)
  else (0, 1)
checkH a c (x: xs) = if x == a
  then checkH a (c + 1) xs
  else let (r, l) = checkH x 1 xs in if c `mod` 2 == 0
    then (r + 1, l)
    else (r, l + 1)

check :: [Int] -> (Int, Int)
check a = checkH (head a) 0 a

solve :: Int -> IO ()
solve 0 = pure ()
solve i = do
  n <- readLn :: IO Int
  a <- readArr
  let (x, y) = check $ sort a
  print $ (x - x `mod` 2) + y
  solve $ i - 1

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

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

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve n as
    | n == 1 = putStrLn "1"
    | otherwise = do
        let blocks = group $ sort as
        let lengths = sum $ map length blocks

        putStrLn $ show $ (length blocks) - (fromEnum $ odd lengths)

read = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)

    solve n as

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) Main.read

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

import Data.Maybe
import Control.Monad
import Data.List (group, sort)

solve = do
    s <- C.getLine

    let n = fst $ fromJust $ C.readInt s

    s <- C.getLine

    let as = map (fst . fromJust . C.readInt) (C.words s)
    let blocks = group $ sort as
    let lengths = sum $ map length blocks

    putStrLn $ show $ (length blocks) - (fromEnum $ odd lengths)

main = do
   t <- C.getLine

   replicateM_ (fst $ fromJust $ C.readInt t) solve

{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Monad.State
import Control.Monad.State.Class
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Char
import Data.Functor.Identity
import qualified Data.IntMap as M
import Data.Maybe

type ParserT = StateT C.ByteString

type ComputationT m = StateT (M.IntMap Int) (ParserT m)

-- A computation is a monadic action with an input string and an intmap "variable" as state.
type Computation = ComputationT Identity

runComputation :: Computation a -> C.ByteString -> a
runComputation computation = runIdentity . evalStateT (evalStateT computation M.empty)

main :: IO ()
main = do
  t <- int <$> C.getLine
  replicateM_ t solve

solve :: IO ()
solve = do
  n <- int <$> C.getLine
  C.getLine >>= output . runComputation (replicateM_ n populateTree >> eliminateTree)

eliminateTree :: Computation Int
eliminateTree = (length . filter odd . map snd . M.toList) <$> get

populateTree :: Computation ()
populateTree = do
  val <- lift getInt
  modify $ M.alter (pure . maybe 1 succ) val

getInt :: Monad m => ParserT m Int
getInt = StateT $ pure . fromJust . C.readInt . C.dropWhile isSpace

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

output :: Int -> IO ()
output = L.putStrLn . B.toLazyByteString . B.intDec


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

main = do
	n <- read `fmap` getLine
	a <- ri
	let a' = map (+(-1)) a
	putStrLn $ show $ n + sum (zipWith (*) a' [1..])

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

solve = fst . foldl' f (0,1)
    where f (c,p) n = c' `seq` p' `seq` (c',p')
              where c' = c + 1 + (n-1)*p
                    p' = p + 1

main = print . solve . map (fst . fromJust . B.readInteger) . tail . B.words =<< B.getContents

import Control.Arrow ((>>>), second)
main = getLine >> getLine >>= print . sum . zipWith (curry (second (subtract 1) >>> uncurry (*) >>> (1+))) [1..] . map read . words

solve :: [Integer] -> Integer
solve = sum . zipWith (\i x -> (x - 1) * i + 1) [1..]
main = putStrLn.show.solve.map read.tail.words =<< getContents

readInteger :: String -> Integer
readInteger token = read token :: Integer

solve :: [Integer] -> Integer
solve ans = sum $ zipWith (*) [1 ..] $ (map pred begin) ++ [end]
            where begin = init ans
                  end   = last ans

main :: IO ()
main = interact (show . solve . map readInteger . tail . words)

module Main where

import Control.Monad

main = do
    n <- read `liftM` getLine
    a <- ( map read . words ) `liftM` getLine :: IO [Integer]
    putStrLn $ show $ n + ( sum $ zipWith (\a k -> (a-1) * k) a [1..] )

solve :: [Integer] -> Integer
solve (n:xs) = foldl (\dp (x, i) -> dp + (x - 1) * i + 1) 0 $ zip xs $ iterate (+1) 1

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

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    a <- replicateM n readInteger
    return a
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve :: [Integer] -> Integer
solve a = sum a' + fromIntegral n
  where
    n = length a
    a' = zipWith (*) [1..] (map pred a)

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

s w=sum[(x-1)*i|(i,x)<-zip[1..](w++[2])]-1
main=interact$show.s.map read.tail.words

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Integer) (words ss)

solve [n] = n
solve nums = loop 0 1 nums

loop total _ [] = total
loop total last (n:ums) = loop (total + last*(n-1) + 1) (last+1) ums

main = interact (show . solve . parse)

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

solve = fst . foldl' f (0,1)
    where f (c,p) n = c' `seq` p' `seq` (c',p')
              where c' = c + 1 + (n-1)*p
                    p' = p + 1

main = print . solve . map (fst . fromJust . B.readInt) . tail . B.words =<< B.getContents

solve :: [Int] -> Int
solve (n:xs) = foldl (\dp (x, i) -> dp + (x - 1) * i + 1) 0 $ zip xs $ iterate (+1) 1

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

s w=sum[x*(i-1)|(i,x)<-zip[1..](w++[2])]-1
main=interact$show.s.map read.tail.words

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Int) (words ss)

solve [n] = n
solve nums = loop 0 1 nums

loop total _ [] = total
loop total last (n:ums) = loop (total + last*(n-1) + 1) (last+1) ums

main = interact (show . solve . parse)

import Data.List

parse s =
    let ss = (lines s) !! 1
    in map (read::String->Int) (words ss)

solve [n] = n
solve nums = length ones + (if rest /= [] then sum rest + 1 else 0 )
    where
      (ones, rest) = partition ((==) 1) nums

main = interact (show . solve . parse)


import Data.List

enumerate :: Int -> [Int] -> [(Int, Int)]
enumerate n [] = []
enumerate n (x:xs) = (x, n):enumerate (n+1) xs

eliminate :: [(Int, Int)] -> [(Int, Int)]
eliminate [] = []
eliminate [a] = [a]
eliminate (a:b:xs) = if fst a == fst b then eliminate (a:xs) else a:eliminate (b:xs)

compress :: [Int] -> [(Int,Int)]
compress xs = eliminate(reverse.sort $ enumerate 1 xs)

solve :: [Int] -> String
solve [] = "-1"
solve xs = if length compressed < 1100 then show $ maximum $ [maximum[if gcd (fst x) (fst y) == 1 then snd x + snd y else -1 | y <- compressed] | x <- compressed] else error "11"
    where compressed = compress xs

testCase = do
    n <- getLine
    wordList <- words `fmap` getLine
    let numList = read `fmap` wordList
    putStrLn $ solve numList

repeatDo 0 m = return []

repeatDo n m = do
    x1 <- m
    x2 <- repeatDo (n - 1) m
    return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatDo n testCase

import Data.List

enumerate :: Int -> [Int] -> [(Int, Int)]
enumerate n [] = []
enumerate n (x:xs) = (x, n):enumerate (n+1) xs

eliminate :: [(Int, Int)] -> [(Int, Int)]
eliminate [] = []
eliminate [a] = [a]
eliminate (a:b:xs) = if fst a == fst b then eliminate (a:xs) else a:eliminate (b:xs)

compress :: [Int] -> [(Int,Int)]
compress xs = eliminate(reverse.sort $ enumerate 1 xs)

solve :: [Int] -> String
solve [] = "-1"
solve xs = show $ maximum $ [maximum[if gcd (fst x) (fst y) == 1 then snd x + snd y else -1 | y <- compressed] | x <- compressed]
    where compressed = compress xs

testCase = do
    n <- getLine
    wordList <- words `fmap` getLine
    let numList = read `fmap` wordList
    putStrLn $ solve numList

repeatDo 0 m = return []

repeatDo n m = do
    x1 <- m
    x2 <- repeatDo (n - 1) m
    return (x1 : x2)

main = do
    n <- read `fmap` getLine :: IO Int
    repeatDo n testCase


{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, cs::[[Int]]}
data Output = Output Bool deriving Show

solve :: Input -> Output
solve (Input n cs)
  | odd n = Output False
  | otherwise = Output $ solve' n cs

solve' :: Int -> [[Int]] -> Bool
solve' n cs' = foldr (||) False $ [works c1 c2 | (c1:c3:cs3) <- L.tails cs, c2<-(c3:cs3)] where
  majority ds = sum ds >= (n `div` 2)
  cs = filter majority cs'
  works x y = all (>0) $ zipWith (+) x y

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  rs <- replicateM n $ getIntegrals 5
  return $ Input n (L.transpose rs)

output :: Output -> Bu.Builder
output = go where
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec
  go (Output False) = str "NO" <> nl
  go (Output True) = str "YES" <> nl

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

----------------------------- library -------------------------------
modp :: Integral t=>t->t
modp = (`mod` (10^9+7))

fastPow :: Integral t=>(t->t)->t->t->t
fastPow modf base' p' = go base' p' where
  go base 0 = base
  go base p = go (base`times`base) (p`div`2)  `times`  base^(p`mod`2)
  times = (modf.).(*)

primeFac :: Integral t=> t -> [(t,Int)]
primeFac  = map (\xs-> (head xs,length xs)).L.group.tryDiv 2 where
  tryDiv d n
    | n `mod` d == 0 = d : tryDiv d (n `div` d)
    | n == 1 = []
    | d*d < n = tryDiv (d+1+d`mod`2) n
    | otherwise = tryDiv n n

umakeset xs = (M.fromList (zip xs xs), M.fromList (zip xs (repeat 0)))
ufind uf@(parents,ranks) x = if parents M.! x == x then x else ufind uf (parents M.! x)
uunion uf@(parents, ranks) x y = if fx==fy then (False,uf) else (True, (parents1, ranks1)) where
  (fx, fy) = (ufind uf x, ufind uf y)
  [(r0,f0), (r1,f1)] = L.sort [(ranks M.! fx, fx), (ranks M.! fy, fy)]
  parents1 = M.insert f0 f1 parents
  ranks1 = if r0 /= r1 then ranks else M.insert f1 (r1+1) ranks

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

doTestcase :: St Bu.Builder
doTestcase = input >>= (solve >>> output >>> return)

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        let answers = replicateM nTc doTestcase
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString outputs

import Control.Monad
import Data.List
import qualified Data.IntMap as M
import qualified Data.IntSet as S

type Students = S.IntSet
type Days = M.IntMap Students

calc :: Int -> Days -> Bool
calc n tree =
  let days = [(i,j) | i <- [1..5], j <- [i+1..5]]
  in
    any (\(i,j) ->
         let left = M.findWithDefault S.empty i tree
             right = M.findWithDefault S.empty j tree
             intersectionSize = S.size $ S.intersection left right
             leftDifSize = S.size $ S.difference left right
             rightDifSize = S.size $ S.difference right left
         in
           leftDifSize <= (n `div` 2) &&
           rightDifSize <= (n `div` 2) &&
           intersectionSize >= n - leftDifSize - rightDifSize
        ) days

updateStudent :: Int -> Maybe Students -> Maybe Students
updateStudent i Nothing = Just (S.insert i S.empty)
updateStudent i (Just s) = Just (S.insert i s)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    daysMap <- foldM (\tree i -> do
      line <- getLine
      let days = map (\(i,j) -> i) $ filter (\(i,j) -> j>0) $ zip [1..] $ map read $ words line :: [Int]
      let newTree = foldl (\t d -> M.alter (updateStudent i) d t) tree days
      return newTree) M.empty [1..n]
    if (calc n daysMap) then
      putStrLn "YES"
    else
      putStrLn "NO"


import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)
import Data.Maybe

result :: Integer -> Integer -> String -> Int
result n k str = length indices where
	starS = S.fromList star
	strM = M.fromList $ zip [0..] str
	star = foldr (\(i, s) l -> if s=='*' then i:l else l) [] $ zip [0..] str

	nextId i = fromJust $ S.lookupLE (i+k) starS

	indices = L.nub $ aux (star !! 0) star where
		aux _ [] = []
		aux v (x:xs)
			| x == v = x : aux (nextId x) xs
			| otherwise = aux v xs

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		[n, k] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		str <- getLine
		print $ result n k str
		loop $ t - 1
	loop t

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe)

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

testCase :: Scanner String
testCase = do
  (n, k) <- pair int int
  s <- str
  return . show $ compute k s

compute :: Int -> String -> Int
compute k s = replace (-10^9) [i | (c, i) <- zip s [1..], c == '*']
  where
    replace _ [] = 0
    replace _ [_] = 1
    replace p (x:x':xs)
      | x' <= p + k = replace p (x':xs)
      | otherwise = 1 + replace x (x':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

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

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

solve a n k i
            | i >= n = 1
            | a!i == '*' = 1 + solve a n k (i+k)
            | otherwise = solve a n k (i-1)

printResult = do
    [n,k] <- readInts
    s <- getLine
    let a = dropWhile (=='.') s
        b = dropWhile (=='.') $ reverse a
        m = length b
        z = listArray (1,n) b
    print $ solve z m k 1

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

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

solve a n k i
            | i >= n = 1
            | a!i == '*' = 1 + solve a n k (i+k)
            | otherwise = solve a n k (i-1)

printResult = do
    [n,k] <- readInts
    s <- getLine
    let a = dropWhile (=='.') s
        b = dropWhile (=='.') $ reverse a
        m = length b
        z = listArray (1,n) b
    print b
    print $ solve z m k 1

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

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)
import Data.Maybe

result :: Integer -> Integer -> String -> Int
result n k str = length indices where
	starS = S.fromList star
	strM = M.fromList $ zip [0..] str
	star = foldr (\(i, s) l -> if s=='*' then i:l else l) [] $ zip [0..] str

	nextId i = fromJust $ S.lookupLT (i+k) starS

	indices = L.nub $ aux (-1) star where
		aux _ [] = []
		aux _ [x] = [x]
		aux v (x:xs)
			| x > v = x : aux (nextId x) xs
			| otherwise = aux v xs

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		[n, k] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		str <- getLine
		print $ result n k str
		loop $ t - 1
	loop t


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

factor x = factor' x 2
  where
    factor' x y
        | y * y > x      = if x /= 1 then [(x, 1)] else []
        | x `mod` y == 0 = (y, divTime) : (factor' divFinal (y+1))
        | otherwise      = factor' x (y+1)
        where
          divList = takeWhile ((==0) . snd) $ iterate (\(d,r) -> divMod d y) (x, 0)
          divTime = length divList - 1
          divFinal = fst $ last divList

flist :: [(Int, Int)] -> [Int]
flist [] = [1]
flist lt = map fst lt

type Request = (Char, Int)
type Status = IOUArray Int Int

process :: Status -> Request -> IO ()

process st ('+', num) = do
    let fts = flist $ factor num

    cur <- readArray st (head fts)
    if cur == num
      then putStrLn "Already on"
      else do
        chk <- forM fts $ readArray st
        if all (== 0) chk
          then do
            forM_ fts $ \x -> writeArray st x num
            putStrLn "Success"
          else putStrLn $ "Conflict with " ++ show (fromJust (find (/= 0) chk))

process st ('-', num) = do
    let fts = flist $ factor num

    cur <- readArray st (head fts)
    if cur /= num
      then putStrLn "Already off"
      else do
        forM_ fts $ \x -> writeArray st x 0
        putStrLn "Success"

main = do
    [n, m] <- liftM (map read . words) getLine

    st <- newArray (1, n) 0

    replicateM_ m $ do
        [[c], num] <- liftM words getLine
        process st (c, read num)

import Data.List
import Data.IntMap(IntMap)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do _ <- getLine
          cis <- map ((\[x,y]->(B.head x,read' y)) . B.words) <$> B.lines <$> B.getContents
          putStr $ unlines $ solve cis

read' s = let Just (n,_) = B.readInt s in n

solve :: [(Char,Int)] -> [String]
solve cis = snd $ mapAccumL step state0 cis
   where state0 = IM.empty

step :: IntMap [Int] -> (Char,Int) -> (IntMap [Int], String)
step state ('+',n) = activate state n
step state ('-',n) = deactivate state n

activate :: IntMap [Int] -> Int -> (IntMap [Int], String)
activate state n = case IM.lookup p state of
 		     Just (x:xs)  -> if elem n (x:xs)
				      then (state, "Already on")
                                      else (state, "Conflict with "++(show x))
                     _ -> case isConflict ps of
		             Nothing -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                        in (state', "Success")
			     Just y -> (state, "Conflict with "++(show y))
  where (p:ps) = primeFactors n
        isConflict :: [Int] -> Maybe Int
	isConflict [] = Nothing
	isConflict (x:xs) = case IM.lookup x state of
	                      Just (y:_) -> Just y
			      _ -> isConflict xs

deactivate :: IntMap [Int] -> Int -> (IntMap [Int], String)
deactivate state n = case IM.lookup p state of
 		     Just xs  -> if elem n xs
			           then let state' = IM.unionWith del state $ IM.fromList . zip (p:ps) $ repeat [n]
			                in (state', "Success")
                                   else (state, "Already off")
                     _ -> (state, "Already off")
  where (p:ps) = primeFactors n
        del xs [y] = let (zs,(_:ws)) = span (y/=) xs
	             in zs++ws

primeFactors :: Int -> [Int]
primeFactors 1 = [1]
primeFactors n = primeFactors' n (2:[3,5..])
primeFactors' 1 _ = []
primeFactors' n (p:ps)
  | n < p*p = [n]
  | r == 0 = p:primeFactors' q (p:ps)
  | otherwise = primeFactors' n ps
  where (q,r) = divMod n p

import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Control.Arrow
import Data.IntMap(IntMap, (!))
import Data.IntSet(IntSet)
import Data.List

primes :: [Int]
primes = 2 : filter (\c -> all (\p -> c `mod` p /= 0) (takeWhile (\p -> p * p <= c) primes)) [3..]

facts :: Integer -> [Int] -> Int -> [Int] -> [(Int, [Int])]
facts lim p@(h:t) c l | fromIntegral c > lim = []
                      | otherwise = tryH ++ tryT where
  tryH | fromIntegral h * fromIntegral c <= lim = [(h * c, h : l)] ++ facts lim p (h*c) (h : l)
       | otherwise = []
  tryT | fromIntegral h * fromIntegral c <= lim = facts (lim :: Integer) t c l
       | otherwise = []

cache :: IntMap IntSet
cache = Map.fromList $ map (second Set.fromList) $ (1,[]) : facts 100000 primes 1 []

factors :: Int -> [Int]
factors = Set.toList . (cache !)

type State = ( IntSet -- turned on
             , IntMap Int -- taken by
             )

step :: [String] -> State -> (State, String)
step ["+", ns] s@(on,taken)
  | Set.member n on = (s, "Already on")
  | not (null bad) = (s, "Conflict with " ++ show (taken ! head bad))
  | otherwise = ((Set.insert n on, Map.union taken (Map.fromList $ map (\x -> (x, n)) $ factors n)), "Success")
  where
    n = read ns
    bad = filter (`Map.member` taken) (factors n)
step ["-", ns] s@(on, taken)
  | not (Set.member n on) = (s, "Already off")
  | otherwise = ((Set.delete n on, Map.difference taken (Map.fromList $ map (\x -> (x, n)) $ factors n) ), "Success") where
    n = read ns

main = interact $ unlines . snd . mapAccumL (flip step) (Set.empty, Map.empty) . tail . map words . lines

import Char (ord)
import Control.Monad (liftM)
import Data.List (foldl')
import Data.Map (Map, (!), delete, empty, insert, member)
import Data.Set (Set, delete, empty, insert, member)

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

isPrime :: Int -> Bool
isPrime n  =  all (\x -> mod n x /= 0) $ takeWhile (\x -> x * x <= n) primes

primes :: [Int]
primes  =  2 : [n | n <- [3,5..], isPrime n]

factorize :: Int -> [Int]
factorize  =  factorize' primes
  where
    factorize' _ 1  =  []
    factorize' ps'@(p:ps) n
      | mod n p == 0  =  p : factorize' ps' (div n p)
      | p * p > n  =  [n]
      | otherwise  =  factorize' ps n

primesDivisors :: Int -> [Int]
primesDivisors  =  delEq . factorize
  where
    delEq []  =  []
    delEq [x]  =  [x]
    delEq (x:y:xs)
      | x == y  =  delEq (y:xs)
      | otherwise  =  x : (delEq (y:xs))

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

readQuery :: String -> Either Int Int
readQuery (c : ' ' : s)  =  readQuery' s (if c == '+' then Right else Left) 0
  where
    readQuery' [] f a  =  f a
    readQuery' (c:s) f a  =  readQuery' s f (10*a + ord c - ord '0')

data OnOff  =  On | Off
data Result  =  Success | Already OnOff | ConflictWith Int

instance Show Result
  where
    show Success  =  "Success"
    show (Already On)  =  "Already on"
    show (Already Off)  =  "Already off"
    show (ConflictWith n)  =  concat ["Conflict with ", show n]

findConflict :: Map Int Int -> [Int] -> Maybe Int
findConflict map divisors  =  findConflict' divisors
  where
    findConflict' []  =  Nothing
    findConflict' (d:ds)
      | M.member d map  =  Just (map ! d)
      | otherwise  =  findConflict' ds

solve :: [Either Int Int] -> [Result]
solve xs  =  solve' (M.empty, S.empty) xs
  where
    solve' _ []  =  []
    solve' (map, set) (Right n : xs)
      | S.member n set  =  Already On : (solve' (map, set) xs)
      | otherwise  =  case findConflict map divisors of
          Nothing  ->  Success : (solve' (map', set') xs)
          Just m   ->  ConflictWith m : (solve' (map, set) xs)
      where
        divisors  =  primesDivisors n
        map'  =  foldl (\map d -> M.insert d n map) map divisors
        set'  =  S.insert n set
    solve' (map, set) (Left n : xs)
      | S.member n set  =  Success : (solve' (map', set') xs)
      | otherwise  =  Already Off : (solve' (map, set) xs)
      where
        map'  =  foldl (\map d -> M.delete d map) map (primesDivisors n)
        set'  =  S.delete n set

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let [n, m]  =  map read $ words $ head lines'
    let qs  =  map readQuery $ take m $ tail lines'
    mapM_ print $ solve qs

import Data.List
import Data.IntMap(IntMap)
import qualified Data.IntMap as IM
import qualified Data.ByteString.Char8 as B
import Control.Applicative

main = do _ <- getLine
          cis <- map ((\[x,y]->(B.head x,read' y)) . B.words) <$> B.lines <$> B.getContents
          putStr $ unlines $ solve cis

read' s = let Just (n,_) = B.readInt s in n

solve :: [(Char,Int)] -> [String]
solve cis = snd $ mapAccumL step state0 cis
   where state0 = IM.empty

step :: IntMap [Int] -> (Char,Int) -> (IntMap [Int], String)
step state ('+',n) = activate state n
step state ('-',n) = deactivate state n

activate :: IntMap [Int] -> Int -> (IntMap [Int], String)
activate state n = case IM.lookup p state of
                     Nothing -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                in (state', "Success")
                     Just [] -> let state' = IM.unionWith (++) state $ IM.fromList . zip (p:ps) $ repeat [n]
		                in (state', "Success")
		     Just (x:xs)  -> if elem n (x:xs)
				  then (state, "Already on")
                                  else (state, "Conflict with "++(show x))
  where (p:ps) = primeFactors n

deactivate :: IntMap [Int] -> Int -> (IntMap [Int], String)
deactivate state n = case IM.lookup p state of
                     Nothing -> (state, "Already off")
                     Just [] -> (state, "Already off")
		     Just (x:xs)  -> if elem n (x:xs)
				  then let state' = IM.unionWith del state $ IM.fromList . zip (p:ps) $ repeat [n]
				       in (state', "Success")
                                  else (state, "Already off")
  where (p:ps) = primeFactors n
        del xs [y] = let (zs,(_:ws)) = span (y/=) xs
	             in zs++ws

primeFactors :: Int -> [Int]
primeFactors 1 = [1]
primeFactors n = primeFactors' n (2:[3,5..])
primeFactors' 1 _ = []
primeFactors' n (p:ps)
  | n < p*p = [n]
  | r == 0 = p:primeFactors' q (p:ps)
  | otherwise = primeFactors' n ps
  where (q,r) = divMod n p


{-# LANGUAGE Safe #-}

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

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

process :: [[Int]] -> [Int]
process [] = []
process ((n:x:[]) : as : rest) = solve x as : process rest

solve :: Int -> [Int] -> Int
solve x as = rec 0 1 $ sortBy (flip compare) as where
             rec c _ [] = c
             rec c pc (a:as) | pc*a >= x = rec (c+1) 1 as
                            | otherwise = rec c (pc+1) as

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, x] <- map read . words <$> getLine
  as <- reverse . sort . map read . words <$> getLine
  print $ solve 1 x as

solve c x (a : as)
  | c * a >= x = 1 + solve 1 x as
  | otherwise = solve (c + 1) x as
solve _ _ _ = 0


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

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

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

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

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

main = do
	getLine
	board <- lines <$> getContents
	putStrLn $ which "YES" "NO" $ correct_flag board || correct_flag ( transpose board )

correct_flag board
	| has_valid_lines board && three_colored board = let hs = map length . group . map head $ board in length hs == 3 && ( ( == 1 ) . length . group . sort $ hs )
	| otherwise = False
	where
		has_valid_lines = all ( ( == 1 ) . length . group )
		three_colored = ( == 3 ) . length . group . sort . map ( ord . head )

import           Control.Monad
import           Data.Set      (Set)
import qualified Data.Set      as Set

colors :: [String] -> Int -> Int -> Int -> Int -> Set Char
colors s n n' m m' = foldl (\r (i, j) -> Set.insert (s !! i !! j) r)
                     Set.empty [(i, j) | (i, j) <- idx]
  where idx = [(i, j) | i <- [n..n'-1], j <- [m..m'-1]]

main :: IO ()
main = do
  line <- getLine
  let [n, m] = map read (words line)
  flag <- replicateM n getLine
  let sa = colors flag 0 (n `div` 3) 0 m
  let sb = colors flag (n `div` 3) (2 * (n `div` 3)) 0 m
  let sc = colors flag (2 * (n `div` 3)) n 0 m
  let ta = colors flag 0 n 0 (m `div` 3)
  let tb = colors flag 0 n (m `div` 3) (2 * (m `div` 3))
  let tc = colors flag 0 n (2 * (m `div` 3)) m
  let b = ((n `mod` 3 == 0) &&
            (Set.size sa == 1) &&
            (Set.size sb == 1) &&
            (Set.size sc == 1) &&
            (Set.size (Set.unions [sa, sb, sc]) == 3)) ||
          ((m `mod` 3 == 0) &&
           (Set.size ta == 1) &&
           (Set.size tb == 1) &&
           (Set.size tc == 1) &&
           (Set.size (Set.unions [ta, tb, tc]) == 3))
  if b then putStrLn "YES" else putStrLn "NO"

import Data.List
import Control.Monad

main =
  do
    nks <- getLine
    let [n, k] = map read $ words nks

    flag <- forM [1..n] (\x -> getLine)
    let g1 = group flag
        g2 = group.transpose $ flag

    let t1 = length $ group.sort $ g1
        t2 = length $ group.sort $ g2

    let s1 = map length g1
        s2 = map length g2

    if (t1 == 1 || t1 == 3) && (t2 == 1 || t2 == 3)
       then if length s1 == 1 && length s2 == 3 && (length.group $ s2) == 1
         then putStrLn "YES"
         else
         if length s2 == 1 && length s1 == 3 && (length.group $ s1) == 1
           then putStrLn "YES"
           else putStrLn "NO"
       else putStrLn "NO"

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok :: [String] -> Bool
ok f = sort (map (head . head) gs) == sort "RGB" && allEq (map length gs) && all (allEq . concat) gs
  where gs = group f
allEq :: Eq a => [a] -> Bool
allEq = null . tail . nub

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok :: [String] -> Bool
ok f = sort (map (head . head) gs) == sort ['B', 'R', 'G'] && allEq (map length gs) && all (allEq . concat) gs
  where gs = group f
allEq :: Eq a => [a] -> Bool
allEq = null . tail . nub

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok f = (\(x:xs) -> all (== x) xs) (map length gs) && length gs == 3
  where gs = group f

import Data.List
import Control.Monad

main =
  do
    nks <- getLine
    let [n, k] = map read $ words nks

    flag <- forM [1..n] (\x -> getLine)
    let s1 = map length $ group flag
        s2 = map length $ group.transpose $ flag

    if length s1 == 1 && length s2 == 3 && (length.group $ s2) == 1
       then putStrLn "YES"
       else
       if length s2 == 1 && length s1 == 3 && (length.group $ s1) == 1
          then putStrLn "YES"
          else putStrLn "NO"


import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:b:xs) = (func' b) ++ (func xs)
                where
                  func' = solve.map toInt.words
func _        = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[Int]->String
solve = unwords.map toString.findAns
          where
            findAns' (x:xs) = findMin (diff (x:xs++[x]))
            findAns a | n == (length a) = n:1:[]
                      | otherwise       = n:(n+1):[]
                      where
                        n = findAns' a

diff (a:b:xs) = (abs (a-b)):diff (b:xs)
diff _        =  []

findMin::[Int]->Int
findMin = snd.findMin' 1
          where
            findMin'::Int->[Int]->(Int,Int)
            findMin' a (b:c:xs) | b < (fst next) = (b, a)
                                | otherwise      = next
                              where
                                  next = (findMin' (a+1) (c:xs))
            findMin' a (b:xs)                    =  (b,a)

main = do
	getLine
	a <- fmap (zip [1 ..] . map read . words) getLine
	putStrLn $ unwords $ map show $ (\(_,(a,b))->[a,b]) $ minimum $ gao $ last a : a
gao :: [(Int, Int)] -> [(Int, (Int, Int))]
gao ((a,b):x@((c,d):_)) = (abs(b-d),(a,c)): gao x
gao _ = []

main = do
	a<-getLine
	b<-getLine
	let c = words b
	let (n1,n2)=solve3 (map read c)
	putStrLn $ (show n1)++" "++ (show n2)

solve [] = []
solve (s1:[]) = []
solve (s1:s2:ss) = [dist] ++ solve (s2:ss)
	 where dist = abs (s1 - s2)

solve2 s = solve s ++ [(abs (head s - last s))]

solve3 s = if pairNum+1 == length s then (1,length s)
	       else (pairNum+1,pairNum+2)
     where mdist = minimum (solve2 s)
           pairNum = length $takeWhile (/=mdist) (solve2 s)

import qualified Data.List as List

rotate xs = tail xs ++ [head xs]

min_diff = List.minimumBy (\(_, a) (_, b) -> compare a b)
height_diff (a, b) = abs (a - b)
neighbours heights ct = zip (zip [1..ct] (rotate [1..ct])) (map height_diff (zip heights (rotate heights)))

print_result heights count =
    let ((s1, s2), _) = min_diff (neighbours heights count) in
    show s1 ++ " " ++ show s2

main :: IO ()
main = do
  soldier_count <- getLine >>= return . read
  heights <- getLine >>= return . (map read . words)
  putStr (print_result heights soldier_count)

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

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

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

main = do
  n <- readLn
  xs <- getInts

  let
    next i = (i+1) `mod` n
    i = minimumBy (compare `on` f) [0..n-1]
      where
        f :: Int -> Int
        f i = abs (xs!!i - xs!!j) where j = next i

  putStrLn $ show (i+1) ++ " " ++ show (next i + 1)

rec :: [Int] -> Int
rec (x1 : (x2 : xs)) = min (rec (x2 : xs)) (abs (x1 - x2))
rec _ = maxBound

fld :: [Int] -> Int
fld xs = abs ((head xs) - (last xs))

md :: [Int] -> Int
md xs = min (fld xs) (rec xs)

fnd :: Int -> Int -> [Int] -> [Int]
fnd i d (x1 : (x2 : xs))
  | d == abs (x2 - x1) = [i, i + 1]
  | otherwise = fnd (i + 1) d (x2 : xs)

solve :: [Int] -> [Int]
solve xs
  | fld xs == md xs = [1, length xs]
  | otherwise = fnd 1 (md xs) xs

io :: String -> String
io s = unwords $ map show $ solve $ map (read :: String -> Int) $ words $ head $ drop 1 $ lines s

main :: IO ()
main = do
  interact io

main = do
	n <- readLn
	s <- getLine
	let q = solve n (map read (words s))
	putStr (show (fst q) ++ " " ++ show (snd q))
solve :: Int -> [Int] -> (Int, Int)
solve n sp = let s = zipWith (\a b -> abs (a - b)) sp (tail $ cycle sp);
				 a = f (minimum s) s
			 in (a, if a == n then 1 else (a + 1))
f x (s:ss)
	| x == s = 1
	| otherwise = 1 + f x ss

getDifference :: [Int] -> [Int]
getDifference a = solve_ (head a) a
  where
    solve_ a1 [a2] = [abs(a1 - a2)]
    solve_ a1 (a2:a3:as) = (abs(a2-a3)):(solve_ a1 (a3:as))

findMin :: [Int] -> Int
findMin a = fst (findMin2 1 (0, head a) (tail a))
  where
    findMin2 :: Int -> (Int, Int) -> [Int] -> (Int, Int)
    findMin2 _ (n, m) [] = (n, m)
    findMin2 cur (n, m) (a:as) = if a < m then findMin2 (cur + 1) (cur, a) as else findMin2 (cur + 1) (n, m) as

solve :: Int -> Int -> String
solve len num = if len == num then "1 " ++ show num else (show num) ++ " " ++ show (num + 1)

main = do
    n <- readLn::(IO Int)
    line <- getLine
    let a = map read (words line)
    putStrLn (solve n (1 + findMin (getDifference a)))

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List
import Data.Function

main = do
  n <- read <$> getLine :: IO [Int]
  h:hs <- zip [1..] . map read . words <$> getLine :: IO [(Int, Int)]
  let heights = h:hs ++ [h]
      diff (a, b) (c, d) = ((a,c), abs (b-d))
      dhs = zipWith diff heights (tail heights)
      ((i, j), _) = minimumBy (compare `on` snd) dhs
  putStrLn $ show i ++ " " ++ show j

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = putStrLn <$> unwords <$> map show =<< solve <$> readLn <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> [Integer]
solve n as = snd $ minimum [ (abs (a - b), [ i, i `mod` n + 1 ]) | (i, a, b) <- zip3 [1..] as (tail $ cycle as) ]

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = solve <$> readLn <*> (map read . words <$> getLine) >>= putStrLn . unwords . map show

solve :: Integer -> [Integer] -> [Integer]
solve n as = snd $ minimum [ (abs (a - b), [ i, i `mod` n + 1 ]) | (i, a, b) <- zip3 [1..] as (tail $ cycle as) ]

import Data.List
main = do
  n <- readLn
  ss <- fmap (map read . words) getLine
  let ds = map abs $ zipWith (-) ss (last ss : ss)
      Just k = findIndex (== minimum ds) ds
  putStrLn $ show ((k - 1) `mod` n + 1) ++ " " ++ show (k + 1)

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:b:xs) = (func' b)
                where
                  func' = solve.map toInt.words
func _        = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[Int]->String
solve = unwords.map toString.findAns
          where
            findAns' (x:xs) = findMin (diff (x:xs++[x]))
            findAns a | n == (length a) = n:1:[]
                      | otherwise       = n:(n+1):[]
                      where
                        n = findAns' a

diff (a:b:xs) = (abs (a-b)):diff (b:xs)
diff _        =  []

findMin::[Int]->Int
findMin = snd.findMin' 1
          where
            findMin'::Int->[Int]->(Int,Int)
            findMin' a (b:c:xs) | b < (fst next) = (b, a)
                                | otherwise      = next
                              where
                                  next = (findMin' (a+1) (c:xs))
            findMin' a (b:xs)                    =  (b,a)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
-- import qualified Data.ByteString.Char8 as BS
import Text.Printf

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n <- readLn
  ps@(p : _) <- zip [1 ..] . take n <$> readData
  let check (i, x) (j, y) = ((i, j), abs (x - y))
      xs = zipWith check ps (tail ps ++ [p])
      answer@(i, j) = fst $ minimumBy (comparing snd) xs
  printf "%d %d\n" (i :: Int) (j :: Int)

main = interact f

f s =
    let w = words s
        x = read (head w)
        y = map read (tail w)
        p = recon x y
    in show (fst p) ++ " " ++ show (snd p)

recon :: Int -> [Int] -> (Int, Int)
recon n (x:xs) = let fperson = snd(subrecon n 0 ((x:xs)++ [x])) + 1
                 in
                 if n == fperson
                 then (fperson, 1)
                 else (fperson, fperson+1)

subrecon n c (x:x':xs)
    | c < n-1         = pairmin  (abs(x - x'),c) (subrecon n (c + 1) (x':xs) )
    | otherwise       = (abs(x - x'),c)

pairmin :: (Int,a) -> (Int,a) -> (Int,a)
pairmin (a,x) (b,x')
    | a < b           = (a,x)
    | otherwise       = (b,x')

getnum :: IO [Int]
getnum = fmap (map read . words) getLine

get n num = minimum s
    where s = (f (last num) (head num), n, 1) : zip3 left [1..] [2..]
          left = zipWith f num (tail num)
          f a b = abs $ a - b

ans (_, a, b) = show a ++ " " ++ show b

main = do
    n <- readLn
    num <- getnum
    putStrLn . ans $ get n num

main = interact (ans)
ans theInput = unwords [show ans0,show $ mod ans0 n + 1] where
  [[n],a] = map ( map (read::String->Int)) $ map words $ lines theInput
  a0 = zip a [1..]
  a1 = [(abs (x-y),u)|((x,u),(y,v))<-zip a0 (tail $ a0 ++ [head a0])]
  ans0 = snd $ foldl1 min a1

main = interact (ans)
ans theInput = unwords [show ans0,show $ mod ans0 n + 1] where
  theLines = lines theInput
  n = read (head theLines) ::Int
  a = zip (map (read ::String->Int) (take n $ words $ theLines !! 1)) [1..]
  a0 = a ++ [head a]
  a1 = zip a0 (tail a0)
  a2 = [(abs (x-y),u)|((x,u),(y,v))<-a1]
  minfst (x,u) (y,v) = if x<y then (x,u) else (y,v)
  ans0 = snd $ foldl1 minfst a2

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

main = do
		n<- read <$> getLine::IO Int
		x<- map read <$> words <$> getLine ::IO [Int]
		let c=(zipWith (\a b-> abs (a-b)) x (tail x))
		let d = c ++ [abs (head x - last x)]
		let e = minimum d
		let f = fromJust $elemIndex e d

		putStrLn $ intercalate " " $ map show [f+1, 1+ mod (f+1) n]

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

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

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

main = do
  getLine
  xs <- getInts

  let
    (a, b) = minimumBy (compare `on` (\(a, b) -> abs $ a-b)) $ zip xs (tail xs ++ [head xs])
    i = fromJust (a `elemIndex` xs)
    j = length xs - 1 - fromJust (b `elemIndex` (reverse xs))

  putStrLn $ show (i+1) ++ " " ++ show (j+1)

main = do
    n <- readLn
    s <- getLine
    let q = solve n (map read (words s))
    putStr (show (fst q) ++ " " ++ show (snd q))
solve :: Int -> [Int] -> (Int, Int)
solve n sp = let s = zipWith (+) sp (tail $ cycle sp);
                 a = f (minimum s) s
             in (a, if a == n then 1 else (a + 1))
f x (s:ss)
    | x == s = 1
    | otherwise = 1 + f x ss

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

main = do
		n<- read <$> getLine::IO Int
		x<- map read <$> words <$> getLine ::IO [Int]
		let c=(zipWith (\a b-> abs (a-b)) x (tail x))
		let d = c ++ [abs (head x - last x)]
		let e = minimum d
		let f = fromJust $elemIndex e d

		putStrLn $ intercalate " " $ map show [f+1, mod (f+2) n]


{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m) <- liftM2 (,) get get
    a <- replicateM n get
    p <- replicateM m get
    putln $ if f2 a p then "YES" else "NO"

f2 :: [Int] -> [Int] -> Bool
f2 a p =    let pk = runSTUArray $ do
                a <- newArray (1, 101) 0 :: ST s (STUArray s Int Int)
                forM_ p (\c -> writeArray a c 1)
                return a
            in
            let ax = zip a [1..] in
            all (\(ai, i) ->
                all (\(aj, j) ->
                    if i < j && ai > aj then
                        all (\k ->
                            pk ! k /= 0)
                        [i..j-1]
                    else True
                ) ax
            ) ax

import Data.List as L

subarrays' :: [Int] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
subarrays' [] acc l r = (l,r):acc
subarrays' (x:xs) acc l r
  | x == r+1 = subarrays' xs acc l x
  | r < l = subarrays' xs acc x x
  | otherwise = subarrays' xs ((l, r):acc) x x

subarrays :: [Int] -> [(Int, Int)]
subarrays [] = []
subarrays xs = L.map (\(l, r) -> (l, r+1)) (subarrays' array' [] 0 (-1))
  where array' = L.map (\x -> x - 1) $ L.sort xs

mysort :: [Int] -> [(Int, Int)] -> [Int]
mysort xs [] = xs
mysort xs ((l, r):rest) = mysort currAns rest
  where currAns = (L.take l xs) ++ (L.sort $ L.take (r-l+1) $ L.drop l xs) ++ (drop (r+1) xs)

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted (a:b:rest) = a <= b && isSorted (b:rest)

parse :: [String] -> String
parse [_, xs', ps'] = if ans then "YES" else "NO"
  where xs = toIntArray xs'
        ps = toIntArray ps'
        intervals = subarrays ps
        ans = isSorted $ mysort xs intervals

toIntArray :: String -> [Int]
toIntArray s = L.map (\x -> read x :: Int) $ words s

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n ws = [L.take n ws] ++ groupByNLines n (L.drop n ws)

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 3 . tail . lines)


main = do
    n <- readLn::(IO Int)
    as <- return . map (read::String->Integer) . words =<< getLine
    let as' = as++[0]
	neighborPlus [a1,a2] = [a1+a2]
	neighborPlus (a1:tl@(a2:as)) = (a1+a2):neighborPlus tl
    mapM_ (putStr . (' ':) . show) $ neighborPlus as'

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

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

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

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

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

  solve :: [Integer] -> [Integer]
  solve xs =
    let ys = zip xs (drop 1 xs)
        zs = map (\(x, y) -> -1 * (-x - y)) ys
        in (head xs):(zs)

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . map (read :: String -> Integer) . words
    let solution = (solve . reverse) $ xs
    putStrLn $ intercalate " " $ map show $ reverse solution

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

process [a] = putStrLn $ show  a
process (a:b:as) = do
			putStr $ show  (a+b)
			putStr " "
			process (b:as)

main = do
		getLine
		a<-map read <$> words <$> getLine ::IO [Int]
		process a

import Data.List

main :: IO()
main = do
  n <- readLn :: IO Int
  arrays <- getLine
  putStrLn $ intercalate " " $ map show $ reverse . solve . reverse $ map read $ words arrays

solve ::[Int]->[Int]
solve a = zipWith (+) (0 : a) a

import Data.List

f ::Integer->Integer->[Integer]->[Integer]
f _ _ []=[]
f a d (x:xs)=(x+a+d):f (a+x) (-a)  xs

main = do
       a<-getLine
       b<-getLine
       let xs=map read (words b)::[Integer]
           ys=reverse xs
       putStrLn $ unwords $ map show $ reverse (f 0 0 ys)

main = do
    n <- readLn::(IO Int)
    as <- return . map (read::String->Integer) . words =<< getLine
    let as' = as++[0]
	neighborPlus [a1,a2] = [a1+a2]
	neighborPlus (a1:tl@(a2:as)) = (a1+a2):neighborPlus tl
    print $ neighborPlus as'


import List
import Control.Monad

makeList _ 0 = []
makeList (x:xs) m =
    [[x,y] | y <- rest] ++ makeList xs (m - length rest)
    where
      rest = take m xs

genBaseList n m =
    [0,n-1] : makeList [0..n-2] (m-1)

genList n m v =
    updateList (genBaseList n m) v n

updateList lst v n =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap (map read . words) getLine
      case (n-1 <= m && m <= ((n-1)*(n-2)) `div` 2 + 1) of
        True -> mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) (genList n m v))
        otherwise -> putStrLn ( show (-1) )

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m n i j
	| m == 0			= []
	| j > n				= getAns v w m n (i + 1) 1
	| i >= j			= getAns v w m n i (j + 1)
	| i == w			= getAns v w m n (i + 1) 1
	| j == w	        = getAns v w m n i (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) n i (j + 1))

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) n 1 1))

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m i j
	| m == 0			= []
	| i >= j			= getAns v w m 1 (j + 1)
	| i == w			= getAns v w m (i + 1) j
	| j == w	        = getAns v w m 1 (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) (i + 1) j)

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) 1 1))

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m i j
	| m == 0			= []
	| i >= j			= getAns v w m 1 (j + 1)
	| i == v || i == w	= getAns v w m (i + 1) j
	| j == v || j == w	= getAns v w m 1 (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) (i + 1) j)

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) 1 1))

import List
import Control.Monad

makeList _ 0 = []
makeList (x:xs) m =
    [[x,y] | y <- rest] ++ makeList xs (m - length rest)
    where
      rest = take m xs

genBaseList n m =
    [0,n-1] : makeList [0..n-2] (m-1)

genList n m v =
    updateList (genBaseList n m) v n

updateList lst v n =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap (map read . words) getLine
      case (n-1 <= m && m <= ((n-1)*(n-2)) `div` 2) of
        True -> mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) (genList n m v))
        otherwise -> putStrLn ( show (-1) )

import List
import Numeric
import Control.Monad

fact 0 = 1;
fact n = n * fact (n-1)

comb k n = (fact n) `div` (fact k * fact (n-k))

good (n1, n2, m1, m2)
    | (n1 <= m1 && m1 <= cmb1) &&
      (n2 <= m2 && m2 <= cmb2) =
          ("YES", n1, n2, m1, m2)
    | otherwise =
        ("NO", n1, n2, m1, m2)
    where
      cmb1 = comb 2 (n1+1)
      cmb2 = comb 2 (n2+1)

check (n1, n2, m)
    | m2 >= cmb =
        good (n1, n2, m1 + m2 - cmb, cmb)
    | otherwise =
        good (n1, n2, m1, m2)
    where
      m1 = n1
      m2 = m - n1
      cmb = comb 2 (n1+1)

findBest (n,m) =
    if (null yesLst) then ("NO",1,1,1,1) else head yesLst
    where
      var = map check [(i, n-1-i, m) | i <- [2..n-3], i <= (n-1-i)]
      yesLst = filter (\(str,_,_,_,_) -> (str == "YES")) var

subSeq _ 0 = []
subSeq (x:xs) m =
    [[x,y] | y <- lst] ++ subSeq xs (m - length lst)
    where
      lst = take m xs

genSeq (_,n1,n2,m1,m2) =
    (subSeq (0:[n1+1..n1+n2]) m2) ++
    (subSeq (0:[1..n1]) m1)

addNum v n lst =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap ((map read) . words) getLine
      let tupleAnsw = findBest (n,m)
      case tupleAnsw of
        ("NO",_,_,_,_) ->
            putStrLn( show (-1) )
        otherwise ->
            do
              let answ = addNum v n $ genSeq tupleAnsw
              mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) answ)

import List
import Numeric
import Control.Monad

fact 0 = 1;
fact n = n * fact (n-1)

comb k n = (fact n) `div` (fact k * fact (n-k))

good (n1, n2, m1, m2)
    | (n1 <= m1 && m1 <= cmb1) &&
      (n2 <= m2 && m2 <= cmb2) =
          ("YES", n1, n2, m1, m2)
    | otherwise =
        ("NO", n1, n2, m1, m2)
    where
      cmb1 = comb 2 (n1+1)
      cmb2 = comb 2 (n2+1)

check (n1, n2, m)
    | m2 >= cmb =
        good (n1, n2, m1 + m2 - cmb, cmb)
    | otherwise =
        good (n1, n2, m1, m2)
    where
      m1 = n1
      m2 = m - n1
      cmb = comb 2 (n1+1)

findBest (n,m) =
    if (null yesLst) then ("NO",1,1,1,1) else head yesLst
    where
      var = map check [(i, n-1-i, m) | i <- [1..n-2], i <= (n-1-i)]
      yesLst = filter (\(str,_,_,_,_) -> (str == "YES")) var

subSeq _ 0 = []
subSeq (x:xs) m =
    [[x,y] | y <- lst] ++ subSeq xs (m - length lst)
    where
      lst = take m xs

genSeq (_,n1,n2,m1,m2) =
    (subSeq (0:[n1+1..n1+n2]) m2) ++
    (subSeq (0:[1..n1]) m1)

addNum v n lst =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap ((map read) . words) getLine
      let tupleAnsw = findBest (n,m)
      case tupleAnsw of
        ("NO",_,_,_,_) ->
            putStrLn( show (-1) )
        otherwise ->
            do
              let answ = addNum v n $ genSeq tupleAnsw
              mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) answ)