import Control.Applicative ((<$>))

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

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

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

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

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

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

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

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

import qualified Data.Set as Set

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

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

main = do

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

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

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

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

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

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

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

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

main = do
  s <- getLine
  k <- readLn

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

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

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

import Data.List

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

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

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

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

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

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

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

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

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

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

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

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

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

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

isPalindrome s = s == reverse s

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

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

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

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

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

import Control.Applicative
import Data.List

palindrome x = x== reverse x

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

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

import Data.List

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

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

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

import Control.Applicative
import Data.List

palindrome x = x== reverse x

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

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

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

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

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

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

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

main = do

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

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

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

	return ()

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

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

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

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

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

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

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

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

main = do

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

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

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

	return ()

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

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

import qualified Data.Set as Set

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

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

main = do

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

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

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

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

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

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

import qualified Data.Set as Set

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

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

main = do

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

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

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

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

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

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

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

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

main = do
  s <- getLine
  k <- readLn

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

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List

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

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

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


import Data.Either

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

main = getLine >>= test . read

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

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

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

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

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

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

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

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

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


-- import Debug.Trace

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

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

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

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

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

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

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

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

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

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

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

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

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

import Data.List
import Data.Maybe

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

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

type Sign = Char

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

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

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

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

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

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

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

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

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

        pairs = merge signs pos neg

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

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

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

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

-- import Debug.Trace

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

main = do
	[ n, m ] <- readInts
	as <- readInts
	segments <- replicateM m $ do
		lr <- readInts
		return $ mp lr
	let
		sublists = map ( $ as ) $ map sublist segments
	print $ sum $ filter ( >= 0 ) $ map sum sublists

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

module Main (main) where

import Control.Monad
import Data.List

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

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

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

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


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

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

readInt = fst . M.fromJust . C.readInt

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

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

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

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

import Data.List

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

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

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

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

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

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

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

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

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

main = do
	s <- getLine
	putStrLn $ which "TAK" "NIE" $ and $ zipWith f s $ reverse s

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

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

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

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

import Data.List

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

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

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

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

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

import Data.List

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

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

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

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

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

import Data.List

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

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

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

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

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

import Data.List

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


import Data.List
import Data.Char

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

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

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

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

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

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

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

import Data.List

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

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

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

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

import Data.List

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

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

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

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


import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Char
import Text.Printf

main = do
	n <- readLn
	ss <- replicateM n getLine
	print $ solve " " ss

--solve :: String -> [String] -> Int
solve prev [] = 0
solve prev (s:ss) = solve s ss + if prev == s then 0 else 1

module Main
    where

import System.IO

--2215

main = do
    first <- getLine
    groups <- solve "" 0 $ read first
    print groups
    where
        solve last c 0 = do
            return c
        solve last c n = do
            magnet <- getLine
            solve magnet (if magnet == last then c else c + 1) (n - 1)

import Control.Monad

sol :: [String] -> String -> Int
sol [] _ = 0
sol mags last_s = if (head mags) == last_s
  then (sol (tail mags) last_s)
  else 1 + (sol (tail mags) (head mags))

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [[Char]]
  print(1 + (sol inputs (head inputs)))

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Char
import Text.Printf

main = do
	n <- readLn
	res <- length . group <$> replicateM n getLine
	print res

import Control.Monad
import Control.Applicative

groups [x] = 0
groups (x:y:xs) = (if x == y then 1 else 0) + groups (y:xs)

genAns [] = 0
genAns xs = 1 + (groups xs)

main = do
  n <- readLn :: IO Int
  gs <- concat <$> replicateM n getLine
  print $ genAns gs

import Data.List (group)

numGroups :: Eq a => [a] -> Int
numGroups = length . group

main :: IO ()
main = do
  n <- getLine
  magnets <- sequence $ replicate (read n) getLine
  print $ numGroups magnets

module Main (main)
    where

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

addMag :: [[String]] -> String -> [[String]]
addMag [] y = [[y]]
addMag xt@(x:xs) y
    | head x == y = (y:x):xs
    | otherwise   = [y]:xt

main :: IO ()
main = print . length . foldl' addMag [] =<< flip replicateM getLine =<< readLn

solve [] = 0
solve (m1:[]) = 0
solve (m1:m) | m1==head m = 1+ solve m
             | otherwise = solve m

main = do
	n<-getLine
	d<-getContents
	let b=concat $ lines d
	putStrLn $ show $ (solve b + 1)

import Control.Applicative
main :: IO ()
main = do
    n <- read <$> getLine
    solve n 0 >>= print

solve :: Int -> Int -> IO Int
solve 0 _        = return 0
solve n previous = do
    current <- read <$> getLine
    if current == previous
        then
            solve (n-1) previous
        else
            solve (n-1) current >>= return . (+1)

import Data.List (group)
main = getLine >> getContents >>= return . length . group . words >>= print

import Data.List
main = getContents >>= print . length . group . tail . lines

import Control.Monad

-- Snippet: partitionWith
partitionWith1 eq (a1 : an)
    | not (null an) && eq a1 (head an) = (a1 : r, aLeft)
    | otherwise = ([a1], an)
    where (r, aLeft) = partitionWith1 eq an

partitionWith eq a
    | null a = []
    | otherwise = r : partitionWith eq aLeft
    where (r, aLeft) = partitionWith1 eq a

main = do
    n <- readLn
    a <- replicateM n getLine
    putStrLn $ show $ length $ partitionWith (==) a

readData :: Int -> IO [Int]
readData 0 = return []
readData n = do
        x <- readLn :: IO Int
        xs <- readData (n-1)
        return (x:xs)

countIsles n (x1:[]) = n
countIsles n (x1:x2:xs)
        | x1==x2 = countIsles n (x2:xs)
        | otherwise = countIsles (n+1) (x2:xs)

main = do
        n <- readLn :: IO Int
        mags <- readData n
        print $ countIsles 1 mags

main = do
  getLine
  ls <- fmap lines getContents
  let c = length $ filter (== True) $ zipWith (\a b -> last a == head b) ls (tail ls)
  print $ c + 1

solve :: [Int] -> Int
solve [] = 0
solve (a:x) = 1 + (solve $ (dropWhile (a==)) x)
main = interact $ show . solve . map read . tail . lines

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \x -> interact $ solve.take (read x) . lines
solve :: [String]->String
solve xss = show $ fst $ foldr solv1 (0,"") xss
  where solv1 a (b1,b2) = if a /= b2 then (1+b1, a) else (b1,b2)

import Data.List (group)

main :: IO ()
main  =  getContents >>= print . length . group . tail . words

module Main where
import Control.Monad
main :: IO ()
main = do
    input <- getLine
    inputs <- replicateM (read input) getLine
    let second_chars = map tail inputs
        magnets = map read second_chars
        (ans,_) = foldl (\(acc,curr) new -> (if curr == new then acc else acc+1, new)) (0,2) magnets
    print ans

import Control.Applicative
import Data.List (group)
import qualified Data.ByteString.Lazy.Char8 as C

main = do
  n <- getLine
  xs <- C.lines <$> C.getContents
  print . length . group $ xs

import Control.Applicative
import Control.Monad
import Data.List (group)

main = do
  n <- read <$> getLine
  xs <- replicateM n getLine
  print . length . group $ xs

import Control.Monad

main = getLine >>= getMags . read >>= putStrLn . show . count

getMags :: Int -> IO [String]
getMags n = mapM (\_ -> getLine) [1..n]

count :: [String] -> Int
count (x:xs) = snd ans
  where ans = foldl (\(lst, res) curr -> if lst == curr
                                         then (curr, res)
                                         else (curr, res + 1)) (x, 1) xs

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function

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

main :: IO ()
main = do
    n <- readInt <$> getLine
    magnets <- replicateM n getLine
    printf "%d" . length . group $ magnets

import Prelude
import Data.String
import Text.Printf
import Control.Monad

readNums:: Int -> [Int] -> IO [Int]
readNums 0 numbers = return numbers
readNums n numbers = do
                        c <- getChar
                        if (c /= ' ')
                            then
                                readNums (n - 1) ((read [c] :: Int):numbers)
                            else
                                readNums n numbers

solver:: Int -> Int -> Int -> IO Int
solver 0 count _ = return count
solver n count lastFlag = do
                            str <- getLine
                            let newFlag = if (str == "01")
                                            then 1
                                            else 2
                            if (lastFlag == newFlag)
                                then solver (n - 1) count newFlag
                                else solver (n - 1) (count + 1) newFlag
main = do
        str <- getLine
        let n = read str :: Int
        str <- getLine
        let initFlag = if (str == "01")
                        then 1
                        else 2
        numbers <- solver (n - 1) 1 initFlag
        print numbers
        return ()

import Control.Monad
import Data.List

countIslands :: [Int] -> Int
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands $ map read a

import Control.Monad
import Data.List

countIslands :: [String] -> Integer
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands a

import Control.Monad
import Data.List

countIslands :: [Integer] -> Integer
countIslands [] = 0
countIslands (x:xs) = 1 + (countIslands $ dropWhile (== x) xs)

main = do
    n <- read `fmap` getLine
    a <- replicateM n getLine
    print $ countIslands $ map read a

import Control.Monad
import Data.Array
import Data.Char
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        _ <- B.getLine
        a <- fmap B.lines B.getContents
        print $ solve a

import Control.Monad
import Data.Array
import Data.Char
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        n <- fmap read getLine
        a <- replicateM n B.getLine
        print $ solve a

import Control.Monad
import Data.Array
import Data.Char
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        _ <- getLine
        a <- fmap lines getContents
        print $ solve a

import Control.Monad
import Data.Array
import Data.Char
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = fmap (map (read . B.unpack) . B.words) B.getLine
getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Eq a => [a] -> Int
solve = length . group

main :: IO ()
main = do
        n <- fmap read getLine
        a <- replicateM n getLine
        print $ solve a

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

data MagnetType = Type01 | Type10

main = do
  interact $ show . s . words
    where
      s (numStr:restStr) = solve (read numStr) restStr

mtype "10" = Type10
mtype "01" = Type01

solve :: Integer -> [String] -> Integer
solve n (magnet:rest) = solve' (n-1) 1 (mtype magnet) rest
solve _ _ = error "Bad input."

solve' 0 sum _ [] = sum
solve' n sum lastType (magnet:rest) = recur
  where
    recur = solve' (n-1) (sum + s) thisType rest
    thisType = mtype magnet
    s = cntNewGroup lastType thisType
    cntNewGroup Type01 Type01 = 0
    cntNewGroup Type10 Type10 = 0
    cntNewGroup _      _      = 1
solve' _ _ _ _ = error "Unexpected."

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

data MagnetType = Type01 | Type10

main = do
  interact $ show . s . words
    where
      s (numStr:restStr) = solve (read numStr) restStr

mtype "10" = Type10
mtype "01" = Type01

solve :: Int -> [String] -> Int
solve n (magnet:rest) = solve' (n-1) 1 (mtype magnet) rest
solve _ _ = error "Bad input."

solve' 0 sum _ [] = sum
solve' n sum lastType (magnet:rest) = recur
  where
    recur = solve' (n-1) (sum + s) thisType rest
    thisType = mtype magnet
    s = cntNewGroup lastType thisType
    cntNewGroup Type01 Type01 = 0
    cntNewGroup Type10 Type10 = 0
    cntNewGroup _      _      = 1
solve' _ _ _ _ = error "Unexpected."

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

main=do
    getLine
    show <$> length <$> group <$> lines <$> getContents   >>=putStrLn

import Data.List (group)

main :: IO ()
main = getContents >>= print . length . group . tail . lines

-- import Debug.Trace
-- import System.IO.Unsafe
-- import Text.Printf
import System.IO
import Control.Monad
import Data.List

glwr = fmap (map read . words) getLine

main = do
  hSetBuffering stdout NoBuffering
  solve

solve :: IO ()
solve = do
  n:_ <- glwr
  magnets <- forM [1..n] $ const getLine
  print $ magnet n magnets

magnet :: Int -> [String] -> Int
magnet n = fst . foldr ko (1, '2')

ko :: String -> (Int, Char) -> (Int, Char)
ko (m:ms) (acc, prev)
  | last ms == prev = (acc+1, m)
  | 0 < 1 = (acc, m)

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

import Data.List

main :: IO ()
main = getContents >>= print . length . group . tail . lines

import Data.List
solve :: [Int] -> Int
solve = length . group
main = interact $ show . solve . map read . tail . words

import Data.List
main = interact $ show . length . group . tail . words

import Data.List
main = interact $ show . length . group . tail . lines

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

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

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

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getContents
  print . length $ group xs

loop 0 c p = putStrLn $ show c

loop n c p = do
    q <- getLine
    loop (n-1) (if p == q then c else c+1) q

main = do
    n <- getLine
    loop (read n :: Int) 0 ""

main = interact $ show.calc.tail.lines

calc (x:y:xs) = ( calc $ y:xs ) + ( if x == y then 0 else 1 )
calc _ = 1

solve :: [String] -> String -> Int -> Int
solve [] _ grp = grp
solve (x : xs) prev grp | x == prev = solve xs x grp
                        | otherwise = solve xs x grp + 1

prepare :: [String] -> Int
prepare lst = solve lst (head lst) 1

main :: IO ()
main = interact $ show . prepare . tail . words

magnetGroups ts = 1 + (length $ filter (uncurry (/=)) $ zip ts (tail ts))
readNLines (ln:ls) = take (read ln) ls
main = interact $ (++ "\n") . show . magnetGroups . readNLines . lines

module Main where

import Control.Applicative

main = do
    n <- read <$> getLine
    l1 <- read <$> getLine
    res <- solve (n-1) l1 1
    print res

solve :: Int -> Int -> Int -> IO Int
solve 0 _ m = return m
solve n c m = do
    li <- read <$> getLine
    if li == c
    then solve (n-1) c m
    else solve (n-1) li (m+1)

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

main= do
	getLine
	x<-   words <$> getContents
	print $ length $ group x

import           Control.Monad
import           Data.List

unfolder :: [String] -> Maybe (Bool, [String])
unfolder (a:b:as) = Just (a == b, b:as)
unfolder _ = Nothing

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< (1+) . sum . map (fromEnum . not) . unfoldr unfolder <$> replicateM n getLine

import Data.List
import Control.Monad
main = getLine >>= flip replicateM getLine.read >>= putStrLn.show.length.group

--ghc 7.10

import Data.List

countMagnets :: (Eq a) => [a] -> Int
countMagnets = length . group

main = do
    nStr <- getLine
    aStr <- getContents
    let a = map read . words $ aStr :: [Int]
    print $ countMagnets a

import Data.List

main = do
    m<-getLine
    n<-getContents
    print.length.group $ lines n

import Control.Monad

process :: [String] -> Int
process source = snd (foldr (\z (x, y) -> (z, if x == z then y else y+1) ) (" ", 0) source)

main :: IO()
main = do
    count <- readLn
    inputs <- replicateM count getLine
    putStrLn (show $ process inputs)

import Data.List
addIfRepell l r
	| (snd l) !! 1 == (snd r) !! 0 = ( (+1) $ fst l, snd r)
	| otherwise = (fst l, snd r)
cal ls =
	let mags = map (\m -> (1,m)) $ tail ls
	in fst $ foldl1 addIfRepell mags

main = interact (show . cal . lines)

data Magnet = Magnet Char Char deriving (Show)

readmagnet :: String -> Magnet
readmagnet (x:y:_) = Magnet x y

ans :: [Magnet] -> Int -> Int
ans f@(x : y : _) z = if ((check x y) == True) then (ans (tail f) (z + 1)) else (ans (tail f) z)
	where
	check :: Magnet -> Magnet -> Bool
	check (Magnet x1 y1) (Magnet x2 y2) = if (y1 == x2) then True else False
ans _ z = z

main = do
	n <- getLine
	magnets <- getContents
	putStr $ show $ (ans (map readmagnet (lines magnets) :: [Magnet]) 1)

import Control.Monad

sol :: [String] -> String -> Int
sol [] _ = 0
sol mags last_s = if (head mags) == last_s
  then 1 + (sol (tail mags) last_s)
  else (sol (tail mags) (head mags))

main :: IO ()
main = do
  n_s <- getLine
  let n = read n_s :: Int
  inputs <- replicateM n getLine :: IO [[Char]]
  print(sol (tail inputs) (head inputs))

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Char
import Text.Printf

main = do
	n <- readLn
	ss <- group . sort <$> replicateM n getLine
	let
		n1 = length $ ss !! 0
		n2 = length $ ss !! 1
	print $ 2 * min n1 n2 + if n1 == n2 then 0 else 1

import Control.Applicative
main :: IO ()
main = do
    n <- read <$> getLine
    solve n 0 >>= print

solve :: Int -> Int -> IO Int
solve 0 _        = return 0
solve n previous = do
    current <- read <$> getLine
    if current == previous
        then
            solve (n-1) previous
        else
            solve (n-1) previous >>= return . (+1)

main = interact $ show.calc.lines

calc (x:y:xs) = ( calc $ y:xs ) + ( if x == y then 0 else 1 )
calc _ = 1

import           Control.Monad
import           Data.List

unfolder :: [String] -> Maybe (Bool, [String])
unfolder (a:b:as) = Just (a == b, b:as)
unfolder _ = Nothing

main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    print =<< maximum . (1:) . map((1+) . length) . filter or . group . unfoldr unfolder <$> replicateM n getLine

import Data.List

main = do
    m<-getLine
    n<-getLine
    print.length.group $ lines n

data Magnet = Magnet Char Char deriving (Show)

readmagnet :: String -> Magnet
readmagnet (x:y:_) = Magnet x y

ans :: [Magnet] -> Int -> Int
ans f@(x : y : _) z = if ((check x y) == True) then (ans (tail f) (z + 1)) else (ans (tail f) z)
	where
	check :: Magnet -> Magnet -> Bool
	check (Magnet x1 y1) (Magnet x2 y2) = if (y1 == x2) then False else True
ans _ z = z

main = do
	n <- getLine
	magnets <- getContents
	putStr $ show $ (ans (map readmagnet (lines magnets) :: [Magnet]) 1)


import Array

m = 10

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

getArray :: [Int] -> Array Int Integer
getArray xs = accumArray (+) 0 (-m, m) [(x, 1) | x <- xs]

solve :: [Int] -> Integer
solve xs = notZeroPairs + zeroPairs
  where
    array = getArray xs
    notZeroPairs = sum (map (\i -> (array ! i) * (array ! (-i))) [1..m])
    zeroPairs = div (n * (n - 1)) 2
    n = array ! 0

main :: IO ()
main = do
    getLine >> Main.reads >>= print . solve

main :: IO()
main = do
	getLine
	stringNumbers <- getLine
	let numbers = map read $ words stringNumbers :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ integerLength (filter (== 0) numbers) - 1 where
			fib :: Integer -> Integer
			fib (-1) = 0
			fib n = n + (fib $ n - 1)
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list = integerLength positive * integerLength negative + countPairs others where
			positive = [x | x <- list, x == head list]
			negative = [x | x <- list, x == -head list]
			others   = [x | x <- list, x /= head list, x /= -head list]
	putStrLn $ show n

integerLength :: [Integer] -> Integer
integerLength [] = 0
integerLength (x:xs) = 1 + integerLength xs

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ForeignFunctionInterface, ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
import Foreign
import Foreign.C.Types
import Foreign.C.String
import Foreign.Marshal.Alloc
import Debug.Trace
import Data.List
import Control.Monad
import Control.Monad.ST
import qualified Data.Array.Unboxed as UB
import Data.Array.ST
import Data.Array
import Data.Char
class IOtyp a where scan' :: String -> a; show' :: a -> String
instance IOtyp Int where scan' = read; show' = show
instance IOtyp Char where scan' (x:_) = x;show' = (:[])
instance IOtyp Float where scan' = read;show' = show
instance IOtyp Double where scan' = read;show' = show
instance IOtyp Integer where scan' = read;show' = show
instance IOtyp String where scan' = id;show' = id
instance (IOtyp a,IOtyp b) => IOtyp (a,b) where scan' = (\(x:y:_) -> (scan' x,scan' y)).words;show' (x,y) = show' x++' ':show' y
instance (IOtyp a,IOtyp b,IOtyp c) => IOtyp (a,b,c) where scan' = (\(x:y:z:_) -> (scan' x,scan' y,scan' z)).words;show' (x,y,z) = show' x++' ':show' y++' ':show' z
foreign import ccall "stdio.h puts" c_puts :: CString -> IO ()
scan :: (IOtyp a) => IO a; scan = getLine>>=return.scan'
scans :: (IOtyp a) => Int -> IO [a]; scans = (flip replicateM) scan
scanlist :: (IOtyp a) => IO [a]; scanlist = getLine>>=return.map scan'.words
scanlists :: (IOtyp a) => Int -> IO [[a]]; scanlists = (flip replicateM) scanlist
puts :: (IOtyp a) => a -> IO (); puts ans = do {str<-newCString $ show' ans;c_puts str;free str}

count c = foldl (\n -> \x -> if x==c then n+1 else n) 0

solve :: [Int] -> Integer
solve l = let ary = array (-10,10) [(i,count i l)|i<-[-10..10]]
              zero = fromIntegral ((ary!0)*((ary!0)-1) `div` 2)
              other = fromIntegral (foldl (\n -> \m -> (ary!m)*(ary!(-m))+n) 0 [1..10])
          in
           zero + other

main = do n <- scan :: IO Int
          l <- scanlist :: IO [Int]
          puts.show $ solve l

import Data.List
import Debug.Trace

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' (0 :: Integer)  lis' where
           lis' = group . sort $ map (read :: String -> Integer) lis

length' = toInteger . length

solve' :: (Ord a, Num a) => Integer -> [[a]] -> Integer
solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length' x) * ((length' x) - 1) `div` (2 :: Integer) else n
solve' n (x1:x2:xs)
             | d > 0 =  solve' n $ x2:xs
             | d < 0 =  solve' n $ init $ x1:x2:xs
             | otherwise = solve' (n + (length' x1) * (length' . last $ x2:xs)) (init $ x2:xs) where
               d = diff (x1:x2:xs)

diff [] = 0
diff xs =  (abs . head . head $ xs) - (abs . last . last $ xs)

main = do
    getLine
    ts <- fmap (map read . words) getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x xs = foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

import Data.ByteString.Char8 as BS (readInt, getLine, split)
import Data.Maybe (fromJust)

main = do
    BS.getLine
    ts <- fmap (map (fst . fromJust . BS.readInt) . BS.split ' ') BS.getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x xs = foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

{-# 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
    cs = accumArray (+) 0 (-10, 10) $ zip xs $ repeat 1 :: UArray Int Int64

  print $ sum [cs!i * cs!(-i) | i <- [1..10]] + cs!0 * (cs!0 - 1) `div` 2

count :: (Eq a, Num b) => a -> [a] -> b
count item lst = count' lst item 0
    where count'     []    _ ret = ret
          count' (x:xs) item ret
            | x == item = count' xs item (ret + 1)
            | otherwise = count' xs item ret

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- getLine
          tt <- getLine
          let
            n = read nn :: Int
            t = map read $ words tt :: [Int]
          print $ solve t

import qualified Data.ByteString.Char8 as BS

count :: (Eq a, Num b) => a -> [a] -> b
count item = fromIntegral . length . filter (== item)

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- BS.getLine
          tt <- BS.getLine
          let
            n = toNumber $ BS.readInt nn
            t = map (toNumber . BS.readInt) (BS.words tt)
          print $ solve t

toNumber :: Num a => Maybe (a, BS.ByteString) -> a
toNumber (Just (x, _)) = x
toNumber Nothing       = 0

count :: (Eq a, Num b) => a -> [a] -> b
count item = fromIntegral . length . filter (== item)

solve :: [Int] -> Integer
solve lst = let zero = count 0 lst                             :: Integer
                pcnt = map (flip count lst) [1..10]            :: [Integer]
                ncnt = map (flip count lst) [(-1),(-2)..(-10)] :: [Integer]
            in (zero * (zero - 1)) `div` 2 +
               (sum $ (map (\(x, y) -> x * y) $ zip pcnt ncnt))

main :: IO ()
main = do nn <- getLine
          tt <- getLine
          let
            n = read nn :: Int
            t = map read $ words tt :: [Int]
          print $ solve t

import Data.List

main = interact $ show . (count (repeat 0) 0). map (10+) . map read . words . head . tail . lines
	where
		count list n [] = n
		count list n (x:xs) = count (plusIndex list x) (if (list !! (inverse x) == 0) then n else (n+(list !! (inverse x)))) xs
		inverse n = 20 - n
		plusIndex (x:xs) 0 = x+1: xs
		plusIndex (x:xs) n = x: plusIndex xs (n-1)

import Array
import qualified Data.ByteString.Char8 as BS
import Data.Maybe

main = BS.interact $ BS.pack . show . sumMatches . count
		. map readInt' . BS.words . head . tail . BS.lines
	where
		count ns = accumArray (+) 0 (-10,10) [(n,1)| n<-ns]
		sumMatches arr = sum [arr ! x * arr ! (-x)| x<-[1..10]] + (arr ! 0) * (arr ! 0 - 1) `div` 2
		readInt' bs = fst $ fromJust $ BS.readInt bs

import Array

main = interact $ show . sumMatches . count . map read . words . head . tail . lines
	where
		count ns = accumArray (+) 0 (-10,10) [(n,1)| n<-ns]
		sumMatches arr = sum [arr ! x * arr ! (-x)| x<-[1..10]] + (arr ! 0) * (arr ! 0 - 1) `div` 2

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

main = do
  n <- readLn :: IO Int
  a <- getList
  let zeroList = count 0 a
      otherList = sum $ map (\x -> (count x a) * (count (-x) a)) [1..10]
  print $ zeroList * (zeroList - 1) `div` 2 + otherList
  where
    count element xs = foldl' (\x e -> if e == element then x+1 else x) 0 xs
    getList = fmap (map read . words) getLine :: IO [Int]

import Data.List
import Data.Int
main = print . solve . map read . tail . words =<< getContents
solve ts = nzs * (nzs-1) `div` 2 + sum (merge (group ps) (group ns))
    where (ps',ns') = partition (>= 0) ts
          (zs,ps) = break (> 0) (sort ps')
          ns = sort (map negate ns')
          nzs = genericLength zs :: Int64
merge (x:xs) (y:ys) | head x < head y = merge xs (y:ys)
                    | head x > head y = merge (x:xs) ys
                    | otherwise     = (genericLength x * genericLength y) :
                                      merge xs ys
merge _ _ = []

import Data.List

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis

solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
solve' n (x1:x2:xs)
             | d > 0 = solve' n $ x2:xs
             | d < 0 = solve' n $ init x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ x2:xs)) (init $ x2:xs) where
               d = diff xs

diff [] = 0
diff xs = (abs . head . head $ xs) - (abs . last . last $ xs)

import Data.List

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis
           solve' n [] = n
           solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
           solve' n (x1:x2:xs)
             | d > 0 = solve' n $ x2:xs
             | d < 0 = solve' n $ init x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ xs)) (tail $ x2:xs) where
               d = diff xs

diff xs = (abs . head . head $ xs) - (abs . last . last $ xs)

import Data.List
import Debug.Trace

main = getContents >>= doit . lines where
     doit [] = putStrLn ""
     doit (n:lis:xs) = do
          print . solve $ words lis
          doit xs

     solve lis = solve' 0 lis' where
           lis' = group . sort $ map (read :: String -> Int) lis

solve' n [] = n
solve' n (x:[]) = if (head x) == 0 then n + (length x) * ((length x) - 1) `div` 2 else n
solve' n (x1:x2:xs)
             | d > 0 =  solve' n $ x2:xs
             | d < 0 =  solve' n $ init $ x1:x2:xs
             | otherwise = solve' (n + (length x1) * (length . last $ x2:xs)) (init $ x2:xs) where
               d = diff (x1:x2:xs)

diff [] = 0
diff xs =  (abs . head . head $ xs) - (abs . last . last $ xs)

main = do
    getLine
    ts <- fmap (map read . words) getLine
    let zs = count 0 ts
    print $ zs * (zs - 1) `div` 2 + (sum $ map (\x -> (count x ts) * (count (-x) ts)) [1..10])
    where
        count x = length . filter (==x) --foldl (\acc y -> if x == y then acc + 1 else acc) 0 xs

import Array

m = 10

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

getArray :: [Int] -> Array Int Integer
getArray xs = accumArray (+) 0 (-m, m) [(x, 1) | x <- xs]

solve :: [Int] -> Integer
solve xs = notZeroPairs + zeroPairs
  where
    array = getArray xs
    notZeroPairs = sum (map (\i -> (array ! i) * (array ! (-i))) [1..m])
    zeroPairs = div (n * (n - 1)) 2
    n = array ! 0

main :: IO ()
main = do
    Main.reads >>= print . solve

import Data.List
main = print . solve . map read . tail . words =<< getContents
solve ts = nzs * (nzs-1) `div` 2 + sum (merge (group ps) (group ns))
    where (ps',ns') = partition (>= 0) ts
          (zs,ps) = break (> 0) (sort ps')
          ns = sort (map negate ns')
          nzs = length zs
merge (x:xs) (y:ys) | head x < head y = merge xs (y:ys)
                    | head x > head y = merge (x:xs) ys
                    | otherwise     = (length x * length y) : merge xs ys
merge _ _ = []

main :: IO()
main = do
	stringNumbers <- getLine
	let numbers = map read $ words stringNumbers :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ integerLength (filter (== 0) numbers) - 1 where
			fib :: Integer -> Integer
			fib (-1) = 0
			fib n = n + (fib $ n - 1)
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list = integerLength positive * integerLength negative + countPairs others where
			positive = [x | x <- list, x == head list]
			negative = [x | x <- list, x == -head list]
			others   = [x | x <- list, x /= head list, x /= -head list]
	putStrLn $ show n

integerLength :: [Integer] -> Integer
integerLength [] = 0
integerLength (x:xs) = 1 + integerLength xs

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= 0, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib :: Integer -> Integer
fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs :: Integer
		zeroPairs = fib $ toInteger $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs :: [Integer] -> Integer
		countPairs [] = 0
		countPairs list@(h:_) = toInteger (length positive * length negative) + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n

main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = makePairs numbers where
		makePairs [_] = 0
		makePairs (man:others) = (+) (foldl (\x -> if man == negate x then (+1) else (+0)) 0 others)
									 (makePairs others)
	putStrLn $ show n

import Data.List

fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs = fib $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs [] = 0
		countPairs list@(h:_) = length positive * length negative + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + (fib $ n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Int]
	let n = countPairs numbers where
		countPairs [] = 0
		countPairs nums = length positive * length negative + fib (length zeroes - 1) + countPairs restNums where
			positive = [x | x <- nums, x /= 0, x == head nums]
			negative = [x | x <- nums, x /= 0, negate x == head nums]
			zeroes   = filter (== 0) nums
			restNums = [x | x <- nums, x /= 0, x /= head nums, x /= -head nums]
	putStrLn $ show n

import Data.List

fib (-1) = 0
fib 0 = 0
fib n = n + fib (n - 1)

main :: IO()
main = do
	getLine
	strNumbers <- getLine
	let numbers = map read (words strNumbers) :: [Integer]
	let n = zeroPairs + countPairs numbersWithOutZeroes where
		zeroPairs = fib $ length (filter (== 0) numbers) - 1
		numbersWithOutZeroes = filter (/= 0) numbers
		countPairs [] = 0
		countPairs list@(h:_) = length positive * length negative + countPairs others where
			positive = filter (==  h) list
			negative = filter (== -h) list
			others   = [x | x <- list, x /= h, x /= -h]
	putStrLn $ show n


{-# LANGUAGE Strict #-}
import Control.Arrow ((>>>))

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

solve :: [[Int]] -> Int
solve [_, as] = rec 0 (reverse as)
  where
    v = last as
    rec _ [] = 0
    rec c (x : xs)
      | x == v = rec (c + 1) xs
      | otherwise = 1 + rec (2 * c) (drop (c - 1) xs)

-- helpers
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

import Control.Monad

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

solve :: IO ()
solve = do n <- readLn
           line <- getLine
           let a = reverse $ map read $ words line
           print $ operate (tail a) (n - 1) 1 (head a)

operate :: [Int] -> Int -> Int -> Int -> Int
operate a n l v | n <= 0    = 0
                | x == v    = operate xs (n - 1) (l + 1) v
                | otherwise = 1 + operate (drop l a) (n - l) (l * 2) v
                where x:xs = a

module Main where

(|>) = flip ($)

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

parse :: [String] -> [Int]
parse = map read . words . last

solve' :: [Int] -> Int -> Int -> Int -> Int
solve' [] n el ans = ans
solve' (x:xs) n el ans =
    if x == el
       then solve' (xs) (n+1) el ans
       else solve' (drop n (x:xs)) (2*n) el (ans+1)

solve :: [Int] -> Int
solve a =
    let el = last a in
    let a' = reverse a in
    solve' a' 0 el 0

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

import Control.Arrow ((>>>))

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

solve :: [[Int]] -> Int
solve [_, as] = rec 0 (reverse as)
  where
    v = last as
    rec _ [] = 0
    rec c (x:xs)
      | x == v = rec (c + 1) xs
      | otherwise = 1 + rec (2 * c) (drop c xs)

-- helpers
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts


import Control.Monad
main = do
    [x,y] <- liftM (map read . words) getLine :: IO [Integer]
    putStrLn $ show $ (fromIntegral x) * ((1.000000011)^^(y))

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

solve :: Integer -> Integer -> Double
solve n m = (1.000000011 ^^ m) * (fromIntegral n)

module Main where

main :: IO ()
main =
  do
    a <- getLine
    let b = read $ words a !! 0 :: Double
        e = read $ words a !! 1 :: Int in
          putStrLn $ show $ b * 1.000000011 ^ e

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

import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    a <-(\(x:y:ys) -> (x,y)) . map (fst.fromJust.C.readInt) . C.words<$> C.getLine
    print $ ((1.000000011) ^^ (snd a)) * ((fromIntegral.fst) a)

main = fmap (map read. words ) getLine >>= \[n,t] -> print $ n * 1.000000011 ** t

module Main where

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

main::IO()
main = do
       line <- readInts
       let a = line !! 0
       let b = line !! 1
       let result  = fromIntegral(a)*(1.000000011)^b
       print result

import Numeric

explg :: (Fractional a) => a -> Int -> a
explg _ 0 = 1
explg x 1 = x
explg x n
	| even n = explg (x * x) (div n 2)
 	| otherwise = x * explg (x * x) (div n 2)

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

growth ::Double
growth = 1.000000011

main :: IO ()
main = do
	ints <- readInts
 	let init' = ints !! 0;
	  	time' = ints !! 1
	putStr . show $ fromIntegral init' * (explg growth time')

import Control.Applicative

main= do
	[a,b]<-map read. words <$>getLine::IO [Double]
	putStrLn $ show $ a*(1.000000011**b)

import Control.Monad (liftM)

main :: IO ()
main = do
    [n, t] <- (map read . words) `liftM` getContents :: IO [Double]
    print $ n * (1.000000011 ** t)

main :: IO ()
main = do
  [n_str, t_str] <- fmap words getLine
  let n = read n_str :: Int
  let t = read t_str :: Int
  let ans = (fromIntegral n) * ((1+1.1e-8) ^ t)
  print ans