Mike has always been thinking about the harshness of social inequality. He's so obsessed with it that sometimes it even affects him while solving problems. At the moment, Mike has two sequences of positive integers A = [a1, a2, ..., an] and B = [b1, b2, ..., bn] of length n each which he uses to ask people some quite peculiar questions.To test you on how good are you at spotting inequality in life, he wants you to find an "unfair" subset of the original sequence. To be more precise, he wants you to select k numbers P = [p1, p2, ..., pk] such that 1 ≤ pi ≤ n for 1 ≤ i ≤ k and elements in P are distinct. Sequence P will represent indices of elements that you'll select from both sequences. He calls such a subset P "unfair" if and only if the following conditions are satisfied: 2·(ap1 + ... + apk) is greater than the sum of all elements from sequence A, and 2·(bp1 + ... + bpk) is greater than the sum of all elements from the sequence B. Also, k should be smaller or equal to  because it will be to easy to find sequence P if he allowed you to select too many elements!Mike guarantees you that a solution will always exist given the conditions described above, so please help him satisfy his curiosity!

The first line contains integer n (1 ≤ n ≤ 105) — the number of elements in the sequences.  On the second line there are n space-separated integers a1, ..., an (1 ≤ ai ≤ 109) — elements of sequence A. On the third line there are also n space-separated integers b1, ..., bn (1 ≤ bi ≤ 109) — elements of sequence B.

On the first line output an integer k which represents the size of the found subset. k should be less or equal to . On the next line print k integers p1, p2, ..., pk (1 ≤ pi ≤ n) — the elements of sequence P. You can print the numbers in any order you want. Elements in sequence P should be distinct.

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

{-# 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 _ = []
                 in res

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


Let's call a string "s-palindrome" if it is symmetric about the middle of the string. For example, the string "oHo" is "s-palindrome", but the string "aa" is not. The string "aa" is not "s-palindrome", because the second half of it is not a mirror reflection of the first half.  English alphabet You are given a string s. Check if the string is "s-palindrome".

The only line contains the string s (1 ≤ |s| ≤ 1000) which consists of only English letters.

Print "TAK" if the string s is "s-palindrome" and "NIE" otherwise.

-- 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

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

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


Alyona has recently bought a miniature fridge that can be represented as a matrix with $$$h$$$ rows and $$$2$$$ columns. Initially there is only one shelf at the bottom of the fridge, but Alyona can install arbitrary number of shelves inside the fridge between any two rows. A shelf is two cells wide, does not occupy any space but separates the inside of the fridge to the lower and upper part.  An example of a fridge with $$$h = 7$$$ and two shelves. The shelves are shown in black. The picture corresponds to the first example. Alyona has $$$n$$$ bottles of milk that she wants to put in the fridge. The $$$i$$$-th bottle is $$$a_i$$$ cells tall and $$$1$$$ cell wide. She can put a bottle on some shelf if the corresponding space above the shelf is at least as tall as the bottle. She can not put a bottle on top of another bottle (if there is no shelf between them). Two bottles can not share a cell.Alyona is interested in the largest integer $$$k$$$ such that she can put bottles $$$1$$$, $$$2$$$, ..., $$$k$$$ in the fridge at the same time. Find this largest $$$k$$$.

The first line contains two integers $$$n$$$ and $$$h$$$ ($$$1 \le n \le 10^3$$$, $$$1 \le h \le 10^9$$$) — the number of bottles and the height of the fridge. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le h$$$) — the heights of the bottles.

Print the single integer $$$k$$$ — the maximum integer such that Alyona can put the bottles $$$1$$$, $$$2$$$, ..., $$$k$$$ in the fridge at the same time. If Alyona can put all bottles in the fridge, print $$$n$$$. It is easy to see that Alyona can always put at least one bottle in the fridge.

NoteOne of optimal locations in the first example is shown on the picture in the statement.One of optimal locations in the second example is shown on the picture below.  One of optimal locations in the third example is shown on the picture below.

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.List
import Data.Ord

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:h:a) = intDec (res) <> char7 '\n'
  where
    loop [] _ r = r
    loop [x] h r = r + (if x <= h then 1 else 0)
    loop (x:y:xs) h r
      | y' <= h = loop xs (h - y') (r + 2)
      | x' <= h = r + 1
      | otherwise = r
      where
        y' = max x y
        x' = min x y
    check k
      | k == c = True
      | c < k = False
      where c = loop (sortOn Down $ take k a) h 0
    binsearch l r
      | r - l <= 1 = l
      | not $ check m = binsearch l m
      | True = binsearch m r
      where m = (l + r) `div` 2
    !res = last $ filter check [1 .. n]

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents


Little Victor adores the sets theory. Let us remind you that a set is a group of numbers where all numbers are pairwise distinct. Today Victor wants to find a set of integers S that has the following properties:  for all x  the following inequality holds l ≤ x ≤ r;  1 ≤ |S| ≤ k;  lets denote the i-th element of the set S as si; value  must be as small as possible. Help Victor find the described set.

The first line contains three space-separated integers l, r, k (1 ≤ l ≤ r ≤ 1012; 1 ≤ k ≤ min(106, r - l + 1)).

Print the minimum possible value of f(S). Then print the cardinality of set |S|. Then print the elements of the set in any order. If there are multiple optimal sets, you can print any of them.

NoteOperation  represents the operation of bitwise exclusive OR. In other words, it is the XOR operation.

{-# LANGUAGE Arrows #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List (sort, insertBy, tails, minimumBy, permutations)
import Data.Ord (comparing)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Data.Int
import Data.Bits
import Debug.Trace
import Text.Printf

readInt64s :: B.ByteString -> [Int64]
readInt64s = map (fromIntegral . fst) . mapMaybe B.readInteger . B.words

getInt64s :: IO [Int64]
getInt64s = readInt64s <$> B.getLine

combinations :: Int64 -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations n xs = do
  (x:ys) <- tails xs
  zs <- combinations (n-1) ys
  return (x:zs)

main = do
  [l, r, k] <- getInt64s
  let
    mn = minimumBy comp ((if k >= 3 then g else []) ++ (f [l..min r (l+6)]))
    f :: [Int64] -> [(Int64, [Int64])]
    f xs = do
      n <- [1..min k 4]
      cs <- combinations n xs
      return (foldr xor 0 cs, cs)
    g :: [(Int64, [Int64])]
    g = do
      d <- [0..40]
      let t = shift 1 d - 1
      xs <- map (\xs -> getZipList $ (+) <$> ZipList xs <*> ZipList [0, t, t]) $ permutations [shift 1 d, shift 2 d, shift 3 d]
      guard (all (\x -> l <= x && x <= r) xs)
      return (0, xs)
    comp = comparing fst
    in (printf "%d\n%d\n" (fst mn) (length . snd $ mn)) >> (putStrLn $ unwords . map show . snd $ mn)

{-# LANGUAGE Arrows #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List (sort, insertBy, tails, minimumBy)
import Data.Ord (comparing)
import Data.Maybe (mapMaybe)
import Data.Monoid
import Data.Int
import Data.Bits
import Debug.Trace
import Text.Printf

readInt64s :: B.ByteString -> [Int64]
readInt64s = map (fromIntegral . fst) . mapMaybe B.readInteger . B.words

getInt64s :: IO [Int64]
getInt64s = readInt64s <$> B.getLine

combinations :: Int64 -> [a] -> [[a]]
combinations 0 _ = [[]]
combinations n xs = do
  (x:ys) <- tails xs
  zs <- combinations (n-1) ys
  return (x:zs)

main = do
  [l, r, k] <- getInt64s
  let
    mn = minimumBy comp . f $ trace (show [l..min r (l+6)]) [l..min r (l+6)]
    f :: [Int64] -> [(Int64, [Int64])]
    f xs = do
      n <- [1..min k 4]
      cs <- combinations n xs
      return (foldr xor 0 cs, cs)
    comp = comparing fst
    in (printf "%d\n%d\n" (fst mn) (length . snd $ mn)) >> (putStrLn $ unwords . map show . snd $ mn)


When Masha came to math classes today, she saw two integer sequences of length $$$n - 1$$$ on the blackboard. Let's denote the elements of the first sequence as $$$a_i$$$ ($$$0 \le a_i \le 3$$$), and the elements of the second sequence as $$$b_i$$$ ($$$0 \le b_i \le 3$$$).Masha became interested if or not there is an integer sequence of length $$$n$$$, which elements we will denote as $$$t_i$$$ ($$$0 \le t_i \le 3$$$), so that for every $$$i$$$ ($$$1 \le i \le n - 1$$$) the following is true:   $$$a_i = t_i | t_{i + 1}$$$ (where $$$|$$$ denotes the bitwise OR operation) and  $$$b_i = t_i \& t_{i + 1}$$$ (where $$$\&$$$ denotes the bitwise AND operation). The question appeared to be too difficult for Masha, so now she asked you to check whether such a sequence $$$t_i$$$ of length $$$n$$$ exists. If it exists, find such a sequence. If there are multiple such sequences, find any of them.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the length of the sequence $$$t_i$$$.  The second line contains $$$n - 1$$$ integers $$$a_1, a_2, \ldots, a_{n-1}$$$ ($$$0 \le a_i \le 3$$$) — the first sequence on the blackboard. The third line contains $$$n - 1$$$ integers $$$b_1, b_2, \ldots, b_{n-1}$$$ ($$$0 \le b_i \le 3$$$) — the second sequence on the blackboard.

In the first line print "YES" (without quotes), if there is a sequence $$$t_i$$$ that satisfies the conditions from the statements, and "NO" (without quotes), if there is no such sequence. If there is such a sequence, on the second line print $$$n$$$ integers $$$t_1, t_2, \ldots, t_n$$$ ($$$0 \le t_i \le 3$$$) — the sequence that satisfies the statements conditions. If there are multiple answers, print any of them.

import Control.Monad
import Control.Applicative
import Data.Maybe (isJust, fromJust)
import Data.List (intercalate)
combine :: Int -> Int -> [(Int, Int)]
combine a b
    | a < b = []
    | a == 2 && b == 1 = []
    | a == 3 && b == 0 = [(3, 0), (0, 3), (1, 2), (2, 1)]
    | otherwise = [(a, b), (b, a)]

combineList :: [Int] -> [Int] -> [[(Int, Int)]]
combineList a b = if [] `elem` zippedList then [] else zippedList
    where zippedList = zipWith combine a b

findRoute :: [[(Int, Int)]] -> Maybe [Int]
findRoute [] = Nothing
findRoute list = case results of
    [] -> Nothing
    _  -> head results
    where results = filter isJust $ map (\x -> (x:) <$> findRoute' x list) [0..3]
findRoute' :: Int -> [[(Int, Int)]] -> Maybe [Int]
findRoute' _ [] = Just []
findRoute' val (x:xs) = case bs of
    [] -> Nothing
    _  -> case results of
          [] -> Nothing
          _  -> head results
    where bs = map snd $ filter (\v -> fst v == val) x
          results = filter isJust $ map (\b -> (b:) <$> (findRoute' b xs)) bs

routesFold :: [[(Int, Int)]] -> [[Int]]
routesFold [] = []
routesFold list = foldr fun [] list
    where fun l [] = do
                (x, y) <- l
                return [x, y]
          fun l ls = do
                (x, y) <- l
                rs <- ls
                guard (y == head rs)
                return (x:rs)

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

main :: IO ()
main = do
    n <- getLine
    a <- getLine
    b <- getLine
    let as = map (read :: String -> Int) (words a)
    let bs = map (read :: String -> Int) (words b)
    let rs = findRoute (combineList as bs)
    if isJust rs then do putStrLn "YES"
                         putStrLn (unwords $ (map show $ fromJust rs))
    else putStrLn "NO"

import Control.Monad
import Control.Applicative
import Data.Maybe (isJust, fromJust)
import Data.List (intercalate)
combine :: Int -> Int -> [(Int, Int)]
combine a b
    | a < b = []
    | a == 3 && b == 0 = [(3, 0), (0, 3), (1, 2), (2, 1)]
    | otherwise = [(a, b), (b, a)]

combineList :: [Int] -> [Int] -> [[(Int, Int)]]
combineList a b = if [] `elem` zippedList then [] else zippedList
    where zippedList = zipWith combine a b

findRoute :: [[(Int, Int)]] -> Maybe [Int]
findRoute [] = Nothing
findRoute list = case results of
    [] -> Nothing
    _  -> head results
    where results = filter isJust $ map (\x -> (x:) <$> findRoute' x list) [0..3]
findRoute' :: Int -> [[(Int, Int)]] -> Maybe [Int]
findRoute' _ [] = Just []
findRoute' val (x:xs) = case bs of
    [] -> Nothing
    _  -> case results of
          [] -> Nothing
          _  -> head results
    where bs = map snd $ filter (\v -> fst v == val) x
          results = filter isJust $ map (\b -> (b:) <$> (findRoute' b xs)) bs

routesFold :: [[(Int, Int)]] -> [[Int]]
routesFold [] = []
routesFold list = foldr fun [] list
    where fun l [] = do
                (x, y) <- l
                return [x, y]
          fun l ls = do
                (x, y) <- l
                rs <- ls
                guard (y == head rs)
                return (x:rs)

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

main :: IO ()
main = do
    n <- getLine
    a <- getLine
    b <- getLine
    let as = map (read :: String -> Int) (words a)
    let bs = map (read :: String -> Int) (words b)
    let rs = findRoute (combineList as bs)
    if isJust rs then do putStrLn "YES"
                         putStrLn (unwords $ (map show $ fromJust rs))
    else putStrLn "NO"


The problem uses a simplified TCP/IP address model, please read the statement carefully.An IP address is a 32-bit integer, represented as a group of four decimal 8-bit integers (without leading zeroes), separated by commas. For example, record 0.255.1.123 shows a correct IP address and records 0.256.1.123 and 0.255.1.01 do not. In the given problem an arbitrary group of four 8-bit integers is a correct IP address.Our hero Polycarpus still works as a system administrator in some large corporation. He likes beautiful IP addresses. To check if some IP address is beautiful, he should do the following:  write out in a line four 8-bit numbers of the IP address, without the commas;  check if the resulting string is a palindrome. Let us remind you that a palindrome is a string that reads the same from right to left and from left to right.For example, IP addresses 12.102.20.121 and 0.3.14.130 are beautiful (as strings "1210220121" and "0314130" are palindromes), and IP addresses 1.20.20.1 and 100.4.4.1 are not.Polycarpus wants to find all beautiful IP addresses that have the given set of digits. Each digit from the set must occur in the IP address at least once. IP address must not contain any other digits. Help him to cope with this difficult task.

The first line contains a single integer n (1 ≤ n ≤ 10) — the number of digits in the set. The second line contains the set of integers a1, a2, ..., an (0 ≤ ai ≤ 9). It is guaranteed that all digits in the set are distinct.

In the first line print a single integer k — the number of beautiful IP addresses that contain the given set of digits. In the following k lines print the IP addresses, one per line in the arbitrary order.

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
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 = 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


Mad scientist Mike entertains himself by arranging rows of dominoes. He doesn't need dominoes, though: he uses rectangular magnets instead. Each magnet has two poles, positive (a "plus") and negative (a "minus"). If two magnets are put together at a close distance, then the like poles will repel each other and the opposite poles will attract each other.Mike starts by laying one magnet horizontally on the table. During each following step Mike adds one more magnet horizontally to the right end of the row. Depending on how Mike puts the magnet on the table, it is either attracted to the previous one (forming a group of multiple magnets linked together) or repelled by it (then Mike lays this magnet at some distance to the right from the previous one). We assume that a sole magnet not linked to others forms a group of its own.  Mike arranged multiple magnets in a row. Determine the number of groups that the magnets formed.

The first line of the input contains an integer n (1 ≤ n ≤ 100000) — the number of magnets. Then n lines follow. The i-th line (1 ≤ i ≤ n) contains either characters "01", if Mike put the i-th magnet in the "plus-minus" position, or characters "10", if Mike put the magnet in the "minus-plus" position.

On the single line of the output print the number of groups of magnets.

NoteThe first testcase corresponds to the figure. The testcase has three groups consisting of three, one and two magnets.The second testcase has two groups, each consisting of two magnets.

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.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

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)


Everybody knows that opposites attract. That is the key principle of the "Perfect Matching" dating agency. The "Perfect Matching" matchmakers have classified each registered customer by his interests and assigned to the i-th client number ti ( - 10 ≤ ti ≤ 10). Of course, one number can be assigned to any number of customers."Perfect Matching" wants to advertise its services and publish the number of opposite couples, that is, the couples who have opposite values of t. Each couple consists of exactly two clients. The customer can be included in a couple an arbitrary number of times. Help the agency and write the program that will find the sought number by the given sequence t1, t2, ..., tn. For example, if t = (1,  - 1, 1,  - 1), then any two elements ti and tj form a couple if i and j have different parity. Consequently, in this case the sought number equals 4.Of course, a client can't form a couple with him/herself.

The first line of the input data contains an integer n (1 ≤ n ≤ 105) which represents the number of registered clients of the "Couple Matching". The second line contains a sequence of integers t1, t2, ..., tn ( - 10 ≤ ti ≤ 10), ti — is the parameter of the i-th customer that has been assigned to the customer by the result of the analysis of his interests.

Print the number of couples of customs with opposite t. The opposite number for x is number  - x (0 is opposite to itself). Couples that only differ in the clients' order are considered the same. Note that the answer to the problem can be large enough, so you must use the 64-bit integer type for calculations. Please, do not use the %lld specificator to read or write 64-bit integers in С++. It is preferred to use cin, cout streams or the %I64d specificator.

NoteIn the first sample the couples of opposite clients are: (1,2), (1,5) и (3,4).In the second sample any couple of clients is opposite.

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 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

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 _ _ = []

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

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


You are given an array $$$a$$$ of $$$n$$$ elements. You can apply the following operation to it any number of times:  Select some subarray from $$$a$$$ of even size $$$2k$$$ that begins at position $$$l$$$ ($$$1\le l \le l+2\cdot{k}-1\le n$$$, $$$k \ge 1$$$) and for each $$$i$$$ between $$$0$$$ and $$$k-1$$$ (inclusive), assign the value $$$a_{l+k+i}$$$ to $$$a_{l+i}$$$. For example, if $$$a = [2, 1, 3, 4, 5, 3]$$$, then choose $$$l = 1$$$ and $$$k = 2$$$, applying this operation the array will become $$$a = [3, 4, 3, 4, 5, 3]$$$.Find the minimum number of operations (possibly zero) needed to make all the elements of the array equal.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 2 \cdot 10^4$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of the array. The second line of each test case consists of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq n$$$) — the elements of the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

Print $$$t$$$ lines, each line containing the answer to the corresponding test case — the minimum number of operations needed to make equal all the elements of the array with the given operation.

NoteIn the first test, all elements are equal, therefore no operations are needed.In the second test, you can apply one operation with $$$k=1$$$ and $$$l=1$$$, set $$$a_1 := a_2$$$, and the array becomes $$$[1, 1]$$$ with $$$1$$$ operation.In the third test, you can apply one operation with $$$k=1$$$ and $$$l=4$$$, set $$$a_4 := a_5$$$, and the array becomes $$$[4, 4, 4, 4, 4]$$$.In the fourth test, you can apply one operation with $$$k=1$$$ and $$$l=3$$$, set $$$a_3 := a_4$$$, and the array becomes $$$[4, 2, 3, 3]$$$, then you can apply another operation with $$$k=2$$$ and $$$l=1$$$, set $$$a_1 := a_3$$$, $$$a_2 := a_4$$$, and the array becomes $$$[3, 3, 3, 3]$$$.In the fifth test, there is only one element, therefore no operations are needed.

{-# 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


Vanya is doing his maths homework. He has an expression of form , where x1, x2, ..., xn are digits from 1 to 9, and sign  represents either a plus '+' or the multiplication sign '*'. Vanya needs to add one pair of brackets in this expression so that to maximize the value of the resulting expression.

The first line contains expression s (1 ≤ |s| ≤ 5001, |s| is odd), its odd positions only contain digits from 1 to 9, and even positions only contain signs  +  and  * .  The number of signs  *  doesn't exceed 15.

In the first line print the maximum possible value of an expression.

NoteNote to the first sample test. 3 + 5 * (7 + 8) * 4 = 303.Note to the second sample test. (2 + 3) * 5 = 25.Note to the third sample test. (3 * 4) * 5 = 60 (also many other variants are valid, for instance, (3) * 4 * 5 = 60).

import Data.Char

type Pair = (Integer, Integer)
type State = (Integer, Integer, Integer, Integer)

splitEvenOdd :: [a] -> ([a], [a])
splitEvenOdd = foldr f ([], []) where f v (xs, ys) = (ys, v:xs)

main = getLine >>= putStrLn . show . solve . splitEvenOdd

solve :: (String, String) -> Integer
solve (os, vs) = ans where
    xs = map (toInteger . digitToInt) vs
    (ans, _, _) = go (1, 0) os xs

go :: Pair -> [Char] -> [Integer] -> (Integer, [State], Pair)
go (u, v) [] (x:xs) = (u * x + v, [(x, 0, 1, 0)], (1, 0))
go l (o:os) (x:xs) = (ans', states', pair') where
    (ans, states, pair) = go (updatePair l o x) os xs
    pair' = updatePair pair o (head xs)
    states' = updateStates states o x pair'
    ans' = max ans $ updateAns l states'

updatePair (u, v) o x = if o == '+' then (1, u * x + v) else (u * x, v)

updateStates :: [State] -> Char -> Integer -> Pair -> [State]
updateStates states o x (ru, rv) = tmp' where
    tmp = [if o == '+' then (x, u + v, w, z) else (x * u, v, w, z) | (u, v, w, z) <- states]
    tmp' = if ru > 1 then (x, 0, ru, rv):tmp else tmp

updateAns (lu, lv) states = foldr1 max [(u + v) * w * lu + lv + z | (u, v, w, z) <- states]


The city administration of IT City decided to fix up a symbol of scientific and technical progress in the city's main square, namely an indicator board that shows the effect of Moore's law in real time.Moore's law is the observation that the number of transistors in a dense integrated circuit doubles approximately every 24 months. The implication of Moore's law is that computer performance as function of time increases exponentially as well.You are to prepare information that will change every second to display on the indicator board. Let's assume that every second the number of transistors increases exactly 1.000000011 times.

The only line of the input contains a pair of integers n (1000 ≤ n ≤ 10 000) and t (0 ≤ t ≤ 2 000 000 000) — the number of transistors in the initial time and the number of seconds passed since the initial time.

Output one number — the estimate of the number of transistors in a dence integrated circuit in t seconds since the initial time. The relative error of your answer should not be greater than 10 - 6.

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

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