Vasya has the sequence consisting of n integers. Vasya consider the pair of integers x and y k-interesting, if their binary representation differs from each other exactly in k bits. For example, if k = 2, the pair of integers x = 5 and y = 3 is k-interesting, because their binary representation x=101 and y=011 differs exactly in two bits.Vasya wants to know how many pairs of indexes (i, j) are in his sequence so that i < j and the pair of integers ai and aj is k-interesting. Your task is to help Vasya and determine this number.

The first line contains two integers n and k (2 ≤ n ≤ 105, 0 ≤ k ≤ 14) — the number of integers in Vasya's sequence and the number of bits in which integers in k-interesting pair should differ. The second line contains the sequence a1, a2, ..., an (0 ≤ ai ≤ 104), which Vasya has.

Print the number of pairs (i, j) so that i < j and the pair of integers ai and aj is k-interesting.

NoteIn the first test there are 4 k-interesting pairs:  (1, 3),  (1, 4),  (2, 3),  (2, 4). In the second test k = 0. Consequently, integers in any k-interesting pair should be equal to themselves. Thus, for the second test there are 6 k-interesting pairs:  (1, 5),  (1, 6),  (2, 3),  (2, 4),  (3, 4),  (5, 6).

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = array (0, top) $ IntMap.toList $ IntMap.fromListWith (+) $ zip xs [1,1..] :: UArray Int Int
  if k == 0 then
    print $ sum $ (\x -> x *~ (x - 1) `quot` 2) <$> elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- assocs xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = xm ! y
        return $ cx *~ cy
  where (*~)::Int->Int->Int64
        x *~ y = fromIntegral x * fromIntegral y

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)
import           Data.Maybe

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = IntMap.fromListWith (+) $ zip xs [1,1..]
  if k == 0 then
    print $ sum $ (\x -> x *~ (x - 1) `quot` 2) <$> IntMap.elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- IntMap.toList xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = fromMaybe 0 $ IntMap.lookup y xm
        return $ cx *~ cy
  where (*~)::Int->Int->Int64
        x *~ y = fromIntegral x * fromIntegral y

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let nums = zip xs [1,1..] ++ zip [0..top] [0,0..]
      xm = array (0, top) $ IntMap.toList $ IntMap.fromListWith (+) nums :: Array Int Integer
  if k == 0 then
    print $ sum $ (\x -> x * (x - 1) `quot` 2) <$> elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- assocs xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = xm ! y
        return $ cx * cy

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)
import           Data.Maybe

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = IntMap.fromListWith (+) $ zip xs [1,1..]
  if k == 0 then
    print $ sum $ (\x -> x * (x - 1) `quot` 2) <$> IntMap.elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- IntMap.toList xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = fromMaybe 0 $ IntMap.lookup y xm
        return $ cx * cy

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = array (0, top) $ IntMap.toList $ IntMap.fromListWith (+) $ zip xs [1,1..] :: UArray Int Int64
  if k == 0 then
    print $ sum $ (\x -> x * (x - 1) `quot` 2) <$> elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- assocs xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = xm ! y
        return $ cx * cy

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)
import           Data.Maybe

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = IntMap.fromListWith (+) $ zip xs [1,1..]
  if k == 0 then
    print $ sum $ (\x -> x *~ (x - 1) `quot` 2) <$> IntMap.elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- IntMap.toList xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        cy <- maybeToList $ IntMap.lookup y xm
        return $ cx *~ cy
  where (*~)::Int->Int->Int64
        x *~ y = fromIntegral x * fromIntegral y

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import           Data.Int
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = array (0, top) $ IntMap.toList $ IntMap.fromListWith (+) $ zip xs [1,1..] :: UArray Int Int
  if k == 0 then
    print $ sum $ (\x -> x * (x - 1) `quot` 2) <$> elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    print $ sum $ do
        (x, cx) <- assocs xm
        guard $ cx > 0
        mut <- mutators
        let y = xor x mut
        guard $ x > y
        let cy = xm ! y
        return $ fromIntegral cx * fromIntegral cy :: [Int64]

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}

import           Data.Array.Unboxed
import           Data.Bits
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap.Strict    as IntMap
import           Data.List             (unfoldr)
import           Control.Monad
import           Control.Applicative

getInts::IO [Int]
getInts = unfoldr readOne <$> BS.getLine where
  readOne s = do
    (x , s') <- BS.readInt s
    return (x, BS.dropWhile (== ' ') s')

main :: IO ()
main = do
  let top = 2^(14 :: Int) - 1
  [_, k] <- getInts
  xs <- getInts
  let xm = array (0, top) $ IntMap.toList $ IntMap.fromListWith (+) $ zip xs [1,1..] :: UArray Int Int
  if k == 0 then
    print $ sum $ (\x -> x * (x - 1) `quot` 2) <$> elems xm
  else do
    let mutators = filter ((k==).popCount) [0..top] :: [Int]
    let res = sum $ do
        (x, cx) <- assocs xm
        guard $ cx > 0
        mut <- mutators
        let cy = xm ! xor x mut
        return $ cx * cy
    print $ res `quot` 2


Polycarp doesn't like integers that are divisible by $$$3$$$ or end with the digit $$$3$$$ in their decimal representation. Integers that meet both conditions are disliked by Polycarp, too.Polycarp starts to write out the positive (greater than $$$0$$$) integers which he likes: $$$1, 2, 4, 5, 7, 8, 10, 11, 14, 16, \dots$$$. Output the $$$k$$$-th element of this sequence (the elements are numbered from $$$1$$$).

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing one integer $$$k$$$ ($$$1 \le k \le 1000$$$).

For each test case, output in a separate line one integer $$$x$$$ — the $$$k$$$-th element of the sequence that was written out by Polycarp.

main=interact$unlines.map(show.(!!)[x+3|x<-[-4..],mod x 3*mod x 10/=0].read).tail.lines

import Control.Monad

isPolycarpInteger :: Integer -> Bool
isPolycarpInteger x = (x `mod` 3 /= 0) && (x `mod` 10 /= 3)

getPolycarpIntegerByIndex :: Integer -> Integer
getPolycarpIntegerByIndex index = polycarp_sequence !! (fromIntegral index)
    where polycarp_sequence = filter isPolycarpInteger [1..]

main :: IO()
main = do
    tests_n_input <- getLine
    tests_inputs <- replicateM (read tests_n_input) getLine
    let required_indices = map (\x -> (read x) - 1) tests_inputs
    let results = map getPolycarpIntegerByIndex required_indices
    mapM_ print results

import Control.Monad

isGood :: Int -> Bool
isGood x = ((rem x 3) /= 0) && ((last $ show x) /= '3')

solve k = (filter isGood (iterate(+1) 1)) !! (k - 1)

-- main :: IO ()
main = do
  t <- readLn :: IO Int
  inputs <- replicateM (t) (readLn :: IO Int)

  let answers = map solve inputs

  mapM_ putStrLn (map show answers)

--ghc 8.6.3

readLnInt :: IO (Int)
readLnInt = do
  input <- getLine
  return (read input)

getLns' :: Int -> IO([String])
getLns' n
  | n == 0 = return []
  | otherwise = do
    ln <- getLine
    lns <- getLns' (n - 1)
    return (ln:lns)

getLns :: Read a => Int -> IO([a])
getLns n = fmap (fmap read) $ getLns' n

ans = [x | x <- [1..],
           mod x 3 /= 0,
           mod x 10 /= 3]

main = do
  n <- readLnInt
  qs <- getLns n
  mapM_ print $ map (ans !!) (map (subtract 1) qs)

kthNum 1 i = do
    print(i)

kthNum k i = do
    let newI = i+1
    let newK = if (newI `mod` 3 /= 0) && (newI `mod` 10 /= 3) then k-1 else k
    kthNum newK newI

doTask 0 = return ()

doTask t = do
    input <- getLine
    let k = read input :: Int
    kthNum k 1
    doTask (t-1)

main :: IO ()
main =  do
    input <- getLine
    let t = read input :: Int
    doTask t

import Control.Monad
import Data.List

calc :: Int -> Int
calc k =
  (filter (\x ->
            (x `mod` 3 /= 0) && (x `mod` 10 /= 3)
            ) [1..]) !! (k-1)

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

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -Wno-error=unsafe -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > tmp.txt  &&  diff -sdu -- output.txt tmp.txt  &&  cat -- tmp.txt)

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn :: IO [Int]

    (putStr . unlines . map (show . solve)) tcs

solve k = xs !! (k-1)
  where
    xs = [x | x <-[1..], x `mod` 3 /= 0 && x `mod` 10 /= 3] :: [Int]

nTh :: Int -> Int
nTh n = iter 1 1
  where
    iter :: Int -> Int -> Int
    iter a b
      | b `mod` 3 == 0 || b `mod` 10 == 3 = iter a (b + 1)
      | a == n = b
      | otherwise = iter (a + 1) (b + 1)

loop :: Int -> IO()
loop 0 = return ()
loop n = do
    number <- readLn :: IO Int
    print (nTh number)
    loop $ n - 1

main :: IO()
main = do
    input <- getLine
    let n = read input :: Int
    loop n

import Data.Array
z  =  listArray (1,1000) $ filter (\x -> x `mod` 3 /= 0 &&   x `mod` 10 /= 3) [1..]
main = interact $ unlines . map (show . ((!) z) . (read :: String -> Int)) . tail  . lines

main = do
    t <- read <$> getLine :: IO Int
    mapM_ solve [1..t]

solve :: Int -> IO ()
solve _ = do
    k <- read <$> getLine :: IO Int
    print $ (filter (\x -> x `mod` 3 /= 0 && x `mod` 10 /= 3) [1..]) !! (k - 1)

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

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

type InType  = Int
type OutType = Int

inpLines :: Int
inpLines = 1

solve :: InType -> OutType
solve x = liked !! (x - 1)
    where liked = [ y
                  | y <- [1 .. ]
                  , y `mod` 3 /= 0
                  , y `mod` 10 /= 3
                  ]

receive :: [String] -> InType
receive [s] = read s :: Int
receive _   = error "unexpected input"

main :: IO ()
main = interact $
  unlines . map (show . solve . receive) . chunksOf inpLines . tail . lines
    where showb True = "YES"
          showb False = "NO"

module Main where

import Control.Monad ( replicateM_ )

main = do
  t <- read <$> getLine
  replicateM_ t
    $ do
      getLine >>= print . solve . read

solve :: Int -> Int
solve k = helper 0 k
  where
    helper itr 0 = itr
    helper itr k = if (itr + 1) `rem` 3 == 0 || (itr + 1) `rem` 10 == 3
                   then helper (itr + 1) k
                   else helper (itr + 1) (k - 1)
{-
>>>solve 1000
1666

-}

--ghc 8.6.3

readLnInt :: IO (Int)
readLnInt = do
  input <- getLine
  return (read input)

getLns' :: Int -> IO([String])
getLns' n
  | n == 0 = return []
  | otherwise = do
    ln <- getLine
    lns <- getLns' (n - 1)
    return (ln:lns)

getLns :: Read a => Int -> IO([a])
getLns n = fmap (fmap read) $ getLns' n

ans = [x | x <- [1..],
           mod x 3 /= 0,
           mod x 10 /= 3]

main = do
  n <- readLnInt
  qs <- (getLns n) :: IO([Int])
  print $ map (\x -> ans !! (x - 1)) qs


Coming up with a new problem isn't as easy as many people think. Sometimes it is hard enough to name it. We'll consider a title original if it doesn't occur as a substring in any titles of recent Codeforces problems. You've got the titles of n last problems — the strings, consisting of lowercase English letters. Your task is to find the shortest original title for the new problem. If there are multiple such titles, choose the lexicographically minimum one. Note, that title of the problem can't be an empty string.A substring s[l... r] (1 ≤ l ≤ r ≤ |s|) of string s = s1s2... s|s| (where |s| is the length of string s) is string slsl + 1... sr.String x = x1x2... xp is lexicographically smaller than string y = y1y2... yq, if either p < q and x1 = y1, x2 = y2, ... , xp = yp, or there exists such number r (r < p, r < q), that x1 = y1, x2 = y2, ... , xr = yr and xr + 1 < yr + 1. The string characters are compared by their ASCII codes.

The first line contains integer n (1 ≤ n ≤ 30) — the number of titles you've got to consider. Then follow n problem titles, one per line. Each title only consists of lowercase English letters (specifically, it doesn't contain any spaces) and has the length from 1 to 20, inclusive.

Print a string, consisting of lowercase English letters — the lexicographically minimum shortest original title.

5
threehorses
goodsubstrings
secret
primematrix
beautifulyear

NoteIn the first sample the first 9 letters of the English alphabet (a, b, c, d, e, f, g, h, i) occur in the problem titles, so the answer is letter j.In the second sample the titles contain 26 English letters, so the shortest original title cannot have length 1. Title aa occurs as a substring in the first title.

import Data.List

main = interact $ solve . words

solve :: [String] -> String
solve (_ : ts) = head $ concatMap (comp' $ dropWhile null $ sort $ concatMap tails ts) newTitles
-- solve (_ : ts) = unlines $ dropWhile null $ sort $ concatMap tails ts

comp' :: [String] -> (Int, [String]) -> [String]
comp' s (i, t) = comp (map (take i) $ filter ((>= i) . length) s) t
  where
  comp _ [] = []
  comp [] (n : ns) = [n]
  comp (o : os) (n : ns)
    | n < o = [n]
    | otherwise = comp (dropWhile (<= n) $ o : os) ns

newTitles :: [(Int, [String])]
newTitles = tail $ zip [0..] $ iterate f [""]
  where
  f xs = [c : x | c <- ['a'..'z'], x <- xs]

module Main(build,find, main, tails) where

import Control.Monad
import Data.Array
import Data.Char (ord, chr)

readi :: [Char] -> Int
readi x = read x :: Int

tails :: [Char] -> [[Char]]
tails [] = []
--tails (x:xs) = [[x]] ++ (map ([x]++) (tails xs))
tails xs = [xs] ++ (tails (tail xs))

data Node = Node (Array Int Node) | Null
	deriving (Show)

instance Eq Node where
	Null == Null = True
	Null == _ = False
	_ == Null = False
	(Node a1) == (Node a2) = a1 == a2

decode x = (ord x) - (ord 'a') + 1
encode x = chr (x - 1 + (ord 'a'))

build :: [[Char]] -> Node
build [] = Null
build ss = Node $ array (1, 26) [(x, call x) | x <- [1..26]]
	where
		fl ss = filter (/=[]) ss
		call x = build $ scanF (fl ss) (encode  x)
		scanF :: [[Char]] -> Char -> [[Char]]
		scanF ss x
			| ss == [] = []
			| head w == x = (tail w):(scanF st x)
			| otherwise = (scanF st x)
				where
					w = head ss
					st = tail ss

merge = foldl (++) []

find :: Node -> [Char]
find v =  minimum $ filtmin $ leafs v
	where
		filtmin ss = filter ((==mm) . length) ss
			where
				mm = minimum $ map (length) ss
		leafs :: Node -> [[Char]]
		leafs Null = [[]]
		leafs (Node arr) = merge [map ([c]++) (acc c) | c <- ['a'..'z']]
			where
				acc :: Char -> [[Char]]
				acc c = leafs (arr ! (decode c))
extract (Node arr) = arr

find2 :: Node -> [Char]
find2 v = reverse $ firstR $ iterate (extendl) (Left [("", v)])
	where
		firstR (x:xs) = case x of
							Left x -> firstR xs
							Right y -> y
		extendl (Left l) = extend l
		extend ls = if ffml == [] then Left ml else Right $ fst $ head $ ffml
			where
				ffml = filter (ff) ml
				ml = mul ls
				ff (_, Null) = True
				ff bb = False
		mul xs = merge [map (\(a,b) -> (([encode a]++rs), b)) (assocs n) | (rs, Node n) <- xs]

main = do
	n <- readi `liftM` getLine
	wrd <- forM [1..n] (\x->getLine)
	--putStrLn $ show $ merge (map (tails) wrd)
	putStr $ find2 $ build $ merge (map (tails) wrd)

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

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

strsOf n = sequence $ take n $ repeat ['a'..'z']
infStrs = concat [strsOf x | x <- [1..]]

solve strs =
    let isValid x = not $ any (isInfixOf x) strs in
    head (filter isValid infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn (solve strs)

import Control.Monad (replicateM)
import Data.List (nub)

solve :: [String] -> String
solve ss
  | length chars == 26  =  aa
  | otherwise  =  a
  where
    chars  =  nub $ concat ss
    a  =  [head $ filter (not . flip elem chars) ['a' .. 'z']]
    pairs  =  nub $ concat $ map (\s -> zipWith (\a b -> [a,b]) s (tail s)) ss
    aa  =  head [[a,b] | a <- ['a'..'z'], b <- ['a'..'z'], not (elem [a,b] pairs)]

main :: IO ()
main  =  do
    n  <-  readLn
    ss  <-  replicateM n getLine
    putStrLn $ solve ss

{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.List

main = getLine >> interact f
cs = ['a'..'z']
f x | Just res <- find p $ replicateM 1 cs ++ replicateM 2 cs = res
     where
       p y = not.or $ map (isPrefixOf y) $ tails x

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

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

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    print (solve strs)

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

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

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    print ("\"" ++ solve strs ++ "\"")

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

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

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
    let isValid x = not $ any (isInfixOf x) strs in
    head (filter isValid infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn (solve strs)

import Data.List

getInt :: IO Int
getInt = do
    nStr <- getLine
    return (read nStr)

getStr :: IO String
getStr = do
    str <- getLine
    return str

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

aToZ = [[c] | c <- ['a'..'z']]

infStrs = aToZ ++ map concat (sequence [aToZ, infStrs])

solve strs =
     let subs = concat (map subsequences strs) in
     head (filter (`notElem` subs) infStrs)

main = do
    n <- getInt
    strs <- getStrs n
    putStrLn ("\"" ++ solve strs ++ "\"")


These days Arkady works as an air traffic controller at a large airport. He controls a runway which is usually used for landings only. Thus, he has a schedule of planes that are landing in the nearest future, each landing lasts $$$1$$$ minute.He was asked to insert one takeoff in the schedule. The takeoff takes $$$1$$$ minute itself, but for safety reasons there should be a time space between the takeoff and any landing of at least $$$s$$$ minutes from both sides.Find the earliest time when Arkady can insert the takeoff.

The first line of input contains two integers $$$n$$$ and $$$s$$$ ($$$1 \le n \le 100$$$, $$$1 \le s \le 60$$$) — the number of landings on the schedule and the minimum allowed time (in minutes) between a landing and a takeoff. Each of next $$$n$$$ lines contains two integers $$$h$$$ and $$$m$$$ ($$$0 \le h \le 23$$$, $$$0 \le m \le 59$$$) — the time, in hours and minutes, when a plane will land, starting from current moment (i. e. the current time is $$$0$$$ $$$0$$$). These times are given in increasing order.

Print two integers $$$h$$$ and $$$m$$$ — the hour and the minute from the current moment of the earliest time Arkady can insert the takeoff.

NoteIn the first example note that there is not enough time between 1:20 and 3:21, because each landing and the takeoff take one minute.In the second example there is no gaps in the schedule, so Arkady can only add takeoff after all landings. Note that it is possible that one should wait more than $$$24$$$ hours to insert the takeoff.In the third example Arkady can insert the takeoff even between the first landing.

import Control.Applicative
import Control.Monad

main = do
  [n, s] <- map read . words <$> getLine :: IO [Int]
  ls <- forM [1..n] (const $ map read . words <$> getLine)
  let res = solve s $ map (\[h, m] -> 60*h + m) ls
  putStrLn $ unwords . map show $ [div res 60, mod res 60]

solve s ls =
  case filter (/= -1) (zipWith (\m m' -> if m'-m-2 >= 2*s then m + s + 1 else -1) (-s-1:ls) ls) of
    [] -> last ls + s + 1
    (t:_) -> t


You are given a keyboard that consists of $$$26$$$ keys. The keys are arranged sequentially in one row in a certain order. Each key corresponds to a unique lowercase Latin letter.You have to type the word $$$s$$$ on this keyboard. It also consists only of lowercase Latin letters.To type a word, you need to type all its letters consecutively one by one. To type each letter you must position your hand exactly over the corresponding key and press it.Moving the hand between the keys takes time which is equal to the absolute value of the difference between positions of these keys (the keys are numbered from left to right). No time is spent on pressing the keys and on placing your hand over the first letter of the word.For example, consider a keyboard where the letters from 'a' to 'z' are arranged in consecutive alphabetical order. The letters 'h', 'e', 'l' and 'o' then are on the positions $$$8$$$, $$$5$$$, $$$12$$$ and $$$15$$$, respectively. Therefore, it will take $$$|5 - 8| + |12 - 5| + |12 - 12| + |15 - 12| = 13$$$ units of time to type the word "hello". Determine how long it will take to print the word $$$s$$$.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The next $$$2t$$$ lines contain descriptions of the test cases. The first line of a description contains a keyboard — a string of length $$$26$$$, which consists only of lowercase Latin letters. Each of the letters from 'a' to 'z' appears exactly once on the keyboard. The second line of the description contains the word $$$s$$$. The word has a length from $$$1$$$ to $$$50$$$ letters inclusive and consists of lowercase Latin letters.

Print $$$t$$$ lines, each line containing the answer to the corresponding test case. The answer to the test case is the minimal time it takes to type the word $$$s$$$ on the given keyboard.

5
abcdefghijklmnopqrstuvwxyz
hello
abcdefghijklmnopqrstuvwxyz
i
abcdefghijklmnopqrstuvwxyz
codeforces
qwertyuiopasdfghjklzxcvbnm
qqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqqq
qwertyuiopasdfghjklzxcvbnm
abacaba

{-# Options_GHC -O2 #-}
import Data.Char
import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.List

readInt = fst . fromJust . BS.readInt
readIntList = map readInt . BS.words

getInt = readInt <$> BS.getLine
getIntList = readIntList <$> BS.getLine

calcEditDist :: [Int] -> [Int] -> Int
calcEditDist [] [] = 0
calcEditDist (x:xs) (y:ys) = (calcEditDist xs ys) + (abs (x-y))

elemIndexwithList :: [Char] -> Char -> Maybe Int
elemIndexwithList a b = elemIndex b a

process 0 = return ()
process t = do
    s <- getLine
    p <- getLine
    let _:a = p
    let b = init p
    let idx0 = map (fromJust . elemIndexwithList s) a
    let idx1 = map (fromJust . elemIndexwithList s) b
    print (calcEditDist idx0 idx1)
    process (t-1)

main = do
    t <- getInt
    process t

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

charFind (s:ss) charToFind = if s == charToFind then 0
    else 1 + charFind ss charToFind

solve keyMap (c:cs) = if null cs then 0
    else abs(charFind keyMap c-charFind keyMap (head cs)) + solve keyMap cs

run 0 = do return 0
run count = do
    keyMap <- getLine
    textToType <- getLine
    print(solve keyMap textToType)
    run (count-1)
main = do
    n <- getLine
    let n' = read n
    run n'

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

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    s <- getLine
    t <- getLine
    let indices = map (fromJust . (`elemIndex` s)) t
        moves = map abs $ zipWith (-) indices $ tail indices
    print $ sum moves

module Main (main) where

import qualified Data.Array as Array
import Data.Array (Array, (!))

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

solve :: (String, String) -> Int
solve (alphabet, letters) =
  let arr = Array.array ('a', 'z') (zip alphabet [1..])
   in sum (zipWith (\a b -> abs (arr ! a - arr ! b)) letters (tail letters))

go :: String -> String
go input =
  let ls :: [String]
      ls = lines input
      x :: String
      xs :: [String]
      (x:xs) = ls
      n :: Int
      n = read x
      ys :: [(String, String)]
      ys = pairs xs
   in unlines $ fmap (show . solve) ys

main :: IO ()
main = interact go

import Data.Char
import qualified Data.Map as M
import System.IO

merge :: [a] -> [b] -> [(a, b)]
merge [] _ = []
merge _ [] = []
merge (x : xs) (y : ys) = (x, y) : merge xs ys

distance' :: [Int] -> Int
distance' [] = 0
distance' [x] = 0
distance' (x : y : xs) = abs (y - x) + distance' (y : xs)

distance :: String -> String -> Int
distance keyboard w
  | lenw == 1 = 0
  | otherwise = distance' $ map (km M.!) w
  where
    lenw = length w
    km = M.fromList $ merge keyboard [1 ..]

solve :: [String] -> [String]
solve [] = []
solve (k : w : xs) = ((show $ distance k w) : []) ++ solve xs

main :: IO ()
main = do
  inputs <- getContents
  let lns = lines inputs
  --print lns
  putStr $ unlines $ solve $ tail lns

import qualified Data.Map as M
import Data.Maybe

main = interact solve
solve = unlines . s . tail . lines
s (a:b:xs) = (show (cnt a b)):(s xs)
s _ = []
cnt k w = let m = M.fromList $ zip k [1..]
              s = mapMaybe (flip M.lookup m) w
          in sum $ zipWith (\x y->abs(x-y)) s (tail s)

import Prelude

test :: Int -> IO ()
test 0 = putStrLn ""
test n = do
    alphabets <- getLine
    s <- getLine
    let first  = findIndex alphabets (head s) 0
    let ans = solve alphabets s first
    print ans
    test (n - 1)

main :: IO ()
main = do
    tt <- getLine
    let t = (read tt :: Int)
    test t

solve :: String -> String -> Int -> Int
solve alphabets "" prev = 0
solve alphabets (x : xs) prev =
    let ind = findIndex alphabets x 0
    in abs (ind - prev) + solve alphabets xs ind

findIndex :: String -> Char -> Int -> Int
findIndex "" _ n = -1
findIndex (a : as) x n =
    if x == a
        then n
        else findIndex as x (n + 1)

import Control.Monad
import Data.Char
import Data.Maybe

solve :: IO ()
solve = do
    s <- takeWhile (not . isSpace) <$> getLine
    w <- takeWhile (not . isSpace) <$> getLine
    let pos = zip s [1 :: Int ..]
        getPos c = fromJust $ lookup c pos
    print $ sum [abs (getPos a - getPos b) | (a, b) <- zip w (tail w)]

main :: IO ()
main = flip replicateM_ solve =<< readLn


Little Vasya likes very much to play with sets consisting of positive integers. To make the game more interesting, Vasya chose n non-empty sets in such a way, that no two of them have common elements.One day he wanted to show his friends just how interesting playing with numbers is. For that he wrote out all possible unions of two different sets on n·(n - 1) / 2 pieces of paper. Then he shuffled the pieces of paper. He had written out the numbers in the unions in an arbitrary order.For example, if n = 4, and the actual sets have the following form {1, 3}, {5}, {2, 4}, {7}, then the number of set pairs equals to six. The six pieces of paper can contain the following numbers:   2, 7, 4.  1, 7, 3;  5, 4, 2;  1, 3, 5;  3, 1, 2, 4;  5, 7. Then Vasya showed the pieces of paper to his friends, but kept the n sets secret from them. His friends managed to calculate which sets Vasya had thought of in the first place. And how about you, can you restore the sets by the given pieces of paper?

The first input file line contains a number n (2 ≤ n ≤ 200), n is the number of sets at Vasya's disposal. Then follow sets of numbers from the pieces of paper written on n·(n - 1) / 2 lines. Each set starts with the number ki (2 ≤ ki ≤ 200), which is the number of numbers written of the i-th piece of paper, and then follow ki numbers aij (1 ≤ aij ≤ 200). All the numbers on the lines are separated by exactly one space. It is guaranteed that the input data is constructed according to the above given rules from n non-intersecting sets.

Print on n lines Vasya's sets' description. The first number on the line shows how many numbers the current set has. Then the set should be recorded by listing its elements. Separate the numbers by spaces. Each number and each set should be printed exactly once. Print the sets and the numbers in the sets in any order. If there are several answers to that problem, print any of them. It is guaranteed that there is a solution.

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Data.Function
import Debug.Trace

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (map read . drop 1 . words <$> getLine)
  let yss = solve xss
      divide 0 zss                  = zss
      divide i (zs@(_ : _) : zss)   = as ++ concat bs : divide (i - length as) zss
        where (as, bs) = splitAt (min i (length zs)) (map (: []) zs)
      divide i (zs : zss)           = zs : divide i zss
      divide _ []                   = error "Never happens"
  forM_ [length ys : ys | ys <- divide (n - length yss) yss] $ \ys -> do
    putStrLn $ intercalate " " $ map show ys

solve :: [[Int]] -> [[Int]]
solve xss = map (snd . unzip) . groupBy ((==) `on` fst) . sort $ do
  let elements = unique $ concat xss
       where unique = map head . group . sort
  e <- elements
  let identity = do
        (i, xs) <- zip [0 ..] xss
        guard $ e `elem` xs
        return i
  return (identity, e)

import Data.Set
main = interact solve
solve input = output where
  inputs = Prelude.map (fromList . Prelude.map (read::String->Int) . tail . words) $ tail $ lines input
  f [x] = fromList [fromList[head y],fromList(tail y)] where y = toList x
  f (x:xs) = g x xs
  g _ [] = empty
  g x (y:xs) = if Data.Set.null z then g x xs else union (fromList [v,w,z]) (g x xs) where
    z = intersection x y
    v = difference x y
    w = difference y x
  output0 = Prelude.map toList $ toList $ f inputs
  output1 = Prelude.map (\xs->length xs:xs) output0
  output = unlines $ Prelude.map ( unwords . (Prelude.map show)) output1

module Main where

import Data.List
import Text.Printf

main = interact in2out

in2out input
  = output
  where
    [n]:ls = map (map (read :: String->Int))
           $ map words
           $ lines input
    output = unlines
           $ itrSolve n
           $ sort
           $ map sort
           $ take (div (n*(n-1)) 2)
           $ map tail ls

itrSolve 2 [x:xs]
  = [format [x] , format xs]

itrSolve n ls@(x:y:_)
  = format fst : solve ls' fst
  where
    fst = myInter x y
    ls' = take (n-1) ls

myInter alla@(a:as) allb@(b:bs)
  | a==b
  = a : myInter as bs
  | a<b
  = myInter as allb
  | otherwise
  = myInter alla bs

myInter _ _
  = []

format xs
  = unwords
  $ map show
  $ length xs : xs

solve [] _
  = []

solve (x:xs) ls
  = format (remove x ls) : solve xs ls

remove [] _
  = []

remove x []
  = x

remove (x:xs) alll@(l:ls)
  | x==l
  = remove xs ls
  | otherwise
  = x : remove xs alll

import List

set n = [n]

sets n = map set [1..n]

test n = [mergerSorted (sets n !! i) (sets n !! j) | i <- [0..n-1], j <- [0..n-1], i < j]

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

mergerSorted :: [Int] -> [Int] -> [Int]
mergerSorted as [] = as
mergerSorted [] bs = bs
mergerSorted (a:as) (b:bs)
  | a <  b  =  a:(mergerSorted as (b:bs))
  | a >  b  =  b:(mergerSorted (a:as) bs)
  | a == b  =  a:(mergerSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (mergerSorted b d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = if n > 2 then take n (solve mns) else [[head (head mns)]] ++ [tail (head mns)]
  printAns ans

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

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

solve :: Int -> [[Int]] -> [[Int]]
solve n pairsets
    | n == 2    = [[head $ head pairsets],tail $ head pairsets]
    | otherwise = map (map fst) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ IntMap.assocs ans
  where
    inSet = accumArray (||) False (0,222) [(x,True) | x <- [0..222], y <- [0..222], (arr ! (min x y, max x y)) > 0]
    arr = accumArray (+) 0 ((0,0),(222,222)) $ concatMap list2pairs pairsets
    list2pairs lst = [((x,y),1) | x <- lst, y <- lst, x < y]

    ans = execState (rec (0, 0)) IntMap.empty

    rec :: (Int, Int) -> State (IntMap Int) ()
    rec (v, l) | v > 222 = return ()
    rec (v, l) = do
        map <- get
        let doit = (inSet ! v) && IntMap.notMember v map
        when doit $ dfs (v, l)
        rec (v + 1, if doit then l + 1 else l)

    dfs (v, l) = do
        modify $ IntMap.insert v l
        forM_ [0..222] $ \t -> when (inSet ! t && (arr ! (min v t, max v t)) > 1) $ do
            map <- get
            when (IntMap.notMember t map) $ dfs (t, l)

parseInput = do
    n <- readInt
    pairsets <- replicateM (n * (n - 1) `div` 2) $ do
        k <- readInt
        replicateM k readInt
    return (n, pairsets)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace

main = do
    (n, pairsets) <- evalState parseInput <$> BS.getContents
    let answer = solve n pairsets
    forM_ answer $ \lst -> do
        putStr $ show $ length lst
        forM_ lst $ \num -> do
            putChar ' '
            putStr $ show num
        putChar '\n'

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

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

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

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

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

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

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

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

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

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

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

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

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

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Debug.Trace

solve :: [[Int]] -> [[Int]] -> [[Int]]
solve acc []          = [length ys : ys | ys <- sort acc]
solve acc (xs : xss)  = do
  let x = head xs
      (ass, bss) = span ((== x) . head) xss
      ys | null ass   = [x]
         | otherwise  =  foldl' intersect xs ass
  solve (ys : acc) (sort . filter (not. null) $ (map (\\ ys) ass) ++ bss)

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (sort . map read . drop 1 . words <$> getLine)
  forM_ (solve [] (sort xss)) $ \xs -> do
    putStrLn $ intercalate " " $ map show xs

import List

set n = [n]

sets n = map set [1..n]

test n = [mergerSorted (sets n !! i) (sets n !! j) | i <- [0..n-1], j <- [0..n-1], i < j]

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

mergerSorted :: [Int] -> [Int] -> [Int]
mergerSorted as [] = as
mergerSorted [] bs = bs
mergerSorted (a:as) (b:bs)
  | a <  b  =  a:(mergerSorted as (b:bs))
  | a >  b  =  b:(mergerSorted (a:as) bs)
  | a == b  =  a:(mergerSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (mergerSorted b d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = take n (solve mns)
  printAns ans

import List

notEmpty :: [a] -> Bool
notEmpty    []  =  False
notEmpty    _   =  True

intersectSorted :: [Int] -> [Int] -> [Int]
intersectSorted as [] = []
intersectSorted [] bs = []
intersectSorted (a:as) (b:bs)
  | a <  b  =  intersectSorted as (b:bs)
  | a >  b  =  intersectSorted (a:as) bs
  | a == b  =  a:(intersectSorted as bs)

setDifference :: [Int] -> [Int] -> [Int]
setDifference as [] = as
setDifference [] bs = []
setDifference (a:as) (b:bs)
  | a == b  =  setDifference as bs
  | a <  b  =  a:(setDifference as (b:bs))
  | a >  b  =  setDifference (a:as) bs

getSet :: [[Int]] -> [Int]
getSet []     = []
getSet [a]    = a
getSet (a:as) = getSet_ a as
  where
    getSet_ a [] = []
    getSet_ a (b:bs)
      | length ab > 0  =  ab
      | otherwise      =  getSet_ a bs
      where
        ab = intersectSorted a b

solve :: [[Int]] -> [[Int]]
solve []      =  []
solve (a:as)  =  filter notEmpty ([b, d] ++ solve (filter notEmpty (map (\x -> setDifference x (b ++ d)) as)))
  where
    b = getSet (a:as)
    d = setDifference a b

intsToString :: [Int] -> String
intsToString a = show (length a) ++ intsToString_ a
  where
    intsToString_ []      =  ""
    intsToString_ (a:as)  =  " " ++ (show a) ++ (intsToString_ as)

printAns :: [[Int]] -> IO ()
printAns ans = sequence_ (map (\x -> putStrLn (intsToString x)) ans)

parseLine :: String -> [Int]
parseLine line = sort (map read (tail (words line)))

main = do
  n <- readLn
  lines <- sequence (map (\x -> getLine) [1..(div (n*(n-1)) 2)])
  let mns = map parseLine lines
  let ans = solve mns
  printAns ans

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

import Data.List
import Data.Maybe
import Data.Char
import Data.Array
import Data.Int
import Data.Function
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map

solve :: Int -> [[Int]] -> [[Int]]
solve n pairsets =
    map (map fst) . groupBy ((==) `on` snd) . sortBy (compare `on` snd) $ Map.assocs ans
  where
    inSet = accumArray (||) False (0,222) [(x,True) | x <- [0..222], y <- [0..222], (arr ! (min x y, max x y)) > 0]
    arr = accumArray (+) 0 ((0,0),(222,222)) $ concatMap list2pairs pairsets
    list2pairs lst = [((x,y),1) | x <- lst, y <- lst, x < y]

    ans = execState (rec (0, 0)) Map.empty

    rec :: (Int, Int) -> State (Map.Map Int Int) ()
    rec (v, l) | v > 222 = return ()
    rec (v, l) = do
        map <- get
        let doit = (inSet ! v) && Map.notMember v map
        when doit $ dfs (v, l)
        rec (v + 1, if doit then l + 1 else l)

    dfs (v, l) = do
        modify $ Map.insert v l
        forM_ [0..222] $ \t -> when (inSet ! t && (arr ! (min v t, max v t)) > 1) $ do
            map <- get
            when (Map.notMember t map) $ dfs (t, l)

parseInput = do
    n <- readInt
    pairsets <- replicateM (n * (n - 1) `div` 2) $ do
        k <- readInt
        replicateM k readInt
    return (n, pairsets)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace

main = do
    (n, pairsets) <- evalState parseInput <$> BS.getContents
    let answer = solve n pairsets
    forM_ answer $ \lst -> do
        putStr $ show $ length lst
        forM_ lst $ \num -> do
            putChar ' '
            putStr $ show num
        putChar '\n'

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

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

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

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

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

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

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

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

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

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

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

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

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

{-# LANGUAGE ScopedTypeVariables, BangPatterns, PatternGuards, ViewPatterns, RecordWildCards, ForeignFunctionInterface, CPP, TypeSynonymInstances, FlexibleInstances, FlexibleContexts, UndecidableInstances, ImplicitParams, ExplicitForAll #-}
{-# OPTIONS_GHC -O2 -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-unused-imports #-}

import Control.Applicative
import Control.Monad
import Control.Exception
import Foreign
import Foreign.C
import Data.List
import Unsafe.Coerce
import qualified Data.IntSet as Set

solve :: [[Int]] -> [[Int]] -> [[Int]]
solve acc []          = [length ys : ys | ys <- sort acc]
solve acc (xs : xss)  = do
  let x = head xs
      (ass, bss) = partition ((== x) . head) xss
      ys = foldl' intersect xs ass
  solve (ys : acc) (sort . filter (not. null) $ (map (\\ ys) ass) ++ bss)

main :: IO ()
main = do
  n               <- readLn
  xss :: [[Int]]  <- replicateM (n * (n - 1) `quot` 2) (sort . map read . drop 1 . words <$> getLine)
  forM_ (solve [] (sort xss)) $ \xs -> do
    putStrLn $ intercalate " " $ map show xs


The problem describes the properties of a command line. The description somehow resembles the one you usually see in real operating systems. However, there are differences in the behavior. Please make sure you've read the statement attentively and use it as a formal document.In the Pindows operating system a strings are the lexemes of the command line — the first of them is understood as the name of the program to run and the following lexemes are its arguments. For example, as we execute the command " run.exe one, two . ", we give four lexemes to the Pindows command line: "run.exe", "one,", "two", ".". More formally, if we run a command that can be represented as string s (that has no quotes), then the command line lexemes are maximal by inclusion substrings of string s that contain no spaces.To send a string with spaces or an empty string as a command line lexeme, we can use double quotes. The block of characters that should be considered as one lexeme goes inside the quotes. Embedded quotes are prohibited — that is, for each occurrence of character """ we should be able to say clearly that the quotes are opening or closing. For example, as we run the command ""run.exe o" "" " ne, " two . " " ", we give six lexemes to the Pindows command line: "run.exe o", "" (an empty string), " ne, ", "two", ".", " " (a single space).It is guaranteed that each lexeme of the command line is either surrounded by spaces on both sides or touches the corresponding command border. One of its consequences is: the opening brackets are either the first character of the string or there is a space to the left of them.You have a string that consists of uppercase and lowercase English letters, digits, characters ".,?!"" and spaces. It is guaranteed that this string is a correct OS Pindows command line string. Print all lexemes of this command line string. Consider the character """ to be used only in order to denote a single block of characters into one command line lexeme. In particular, the consequence is that the given string has got an even number of such characters.

The single line contains a non-empty string s. String s consists of at most 105 characters. Each character is either an uppercase or a lowercase English letter, or a digit, or one of the ".,?!"" signs, or a space. It is guaranteed that the given string is some correct command line string of the OS Pindows. It is guaranteed that the given command line string contains at least one lexeme.

In the first line print the first lexeme, in the second line print the second one and so on. To make the output clearer, print the "<" (less) character to the left of your lexemes and the ">" (more) character to the right. Print the lexemes in the order in which they occur in the command. Please, follow the given output format strictly. For more clarifications on the output format see the test samples.

"RUn.exe O" "" "   2ne, " two! . " "
firstarg   second   ""

import Control.Applicative
import Data.Char
import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- fmap (C.map (\i -> if isSpace i then ' ' else i)) C.getLine
  C.putStr $ C.unlines $ map (('<' `C.cons`) . (`C.snoc` '>')) $ parse s

import System.IO (isEOF)
import Data.Char (isSpace)
import Control.Monad (when)

data State = Argument | Quotes
    deriving Eq

main = do
    solve Nothing

solve state = do
    end <- isEOF
    if end
        then do
            when (state == Just Argument) $ putChar '>'
            return ()
        else do
            ch <- fmap (\ch -> if isSpace ch then ' ' else ch) getChar
            case state of
                Nothing       -> case ch of
                                     ' ' -> solve Nothing
                                     '"' -> putChar '<' >> solve (Just Quotes)
                                     _   -> putChar '<' >> putChar ch  >> solve (Just Argument)
                Just Argument -> case ch of
                                     ' ' -> putChar '>' >> putChar '\n' >> solve Nothing
                                     _   -> putChar ch  >> solve (Just Argument)
                Just Quotes   -> case ch of
                                     '"' -> putChar '>' >> putChar '\n' >> solve Nothing
                                     _   -> putChar ch  >> solve (Just Quotes)

import Data.List
import Data.Char(isSpace)

rstrip = reverse . dropWhile isSpace . reverse

main = interact $ write . solve . rstrip

write :: [String] -> String

write = unlines . (map (\x -> "<" ++ x ++ ">"))

solve :: String -> [String]

solve ('"' : rest) =
    [token] ++ (solve rest')
        where
            token = takeWhile (/= '"') rest
            rest' = tail $ dropWhile (/= '"') rest

solve (' ' : rest) =
    solve $ dropWhile (== ' ') rest

solve "" =
    []

solve rest =
    [takeWhile (/= ' ') rest] ++ (solve $ dropWhile (/= ' ') rest)

solve :: String -> [String]
solve s  =  solveSpace "" s
  where
    solveSpace word ""
      | null word  =  []
      | otherwise  =  [reverse word]
    solveSpace word (c:s)
      | c == ' ' && null word  =  solveSpace "" s
      | c == ' '  =  (reverse word) : solveSpace "" s
      | c == '"'  =  solveQuote "" s
      | otherwise  =  solveSpace (c : word) s
    solveQuote word (c:s)
      | c == '"'  =  (reverse word) : solveSpace "" s
      | otherwise  =  solveQuote (c : word) s

putStrLn' :: String -> IO ()
putStrLn' s  =  putStrLn $ concat ["<", s, ">"]

main :: IO ()
main  =  getLine >>= mapM_ putStrLn' . solve

import Data.List

split :: (Show a, Eq a) => a -> [a] -> [[a]]
split x xs = let (fst, rest) = break (== x) xs in case rest of
    [] -> [fst]
    (_:rest) -> fst:split x rest

main = do
    s <- getLine
    putStr $ concatMap (\x -> "<" ++ x ++ ">\n")
           $ concat $ zipWith ($) (cycle [words, return]) $ split '"' s

import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- C.getLine
  C.putStr $ C.unlines $ map (('<' `C.cons`) . (`C.snoc` '>')) $ parse s

import qualified Data.ByteString.Char8 as C

parse :: C.ByteString -> [C.ByteString]
parse s =
  case C.uncons s of
    Nothing       -> []
    Just (' ', t) -> parse $ C.dropWhile (==' ') t
    Just ('"', t) -> let (i, j) = C.span (/='"') t in (i:) $ parse $ C.tail j
    _             -> let (i, j) = C.span (/=' ') s in (i:) $ parse j

main :: IO ()
main = do
  s <- C.getLine
  C.putStrLn $ ('<' `C.cons`) $ (`C.snoc` '>') $ C.intercalate (C.pack ">\n<") $ parse s


Daniel is watching a football team playing a game during their training session. They want to improve their passing skills during that session.The game involves $$$n$$$ players, making multiple passes towards each other. Unfortunately, since the balls were moving too fast, after the session Daniel is unable to know how many balls were involved during the game. The only thing he knows is the number of passes delivered by each player during all the session.Find the minimum possible amount of balls that were involved in the game.

There are several test cases in the input data. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 5 \cdot 10^4$$$) — the number of test cases. This is followed by the test cases description. The first line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 10^5$$$) — the number of players. The second line of the test case contains a sequence of integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_i \leq 10^9$$$), where $$$a_i$$$ is the number of passes delivered by the $$$i$$$-th player. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$10^5$$$.

For each test case print a single integer — the answer to the problem.

NoteIn the first test case, with the only ball, the game can go like this:$$$2 \rightarrow 1 \rightarrow 3 \rightarrow 4 \rightarrow 1 \rightarrow 2 \rightarrow 3 \rightarrow 4 \rightarrow 2 \rightarrow 3 \rightarrow 2$$$.In the second test case, there is no possible way to play the game with only one ball. One possible way to play with two balls:$$$2 \rightarrow 1 \rightarrow 2 \rightarrow 3 \rightarrow 2 \rightarrow 1$$$.$$$2 \rightarrow 3 \rightarrow 2 \rightarrow 1$$$In the third example, there were no passes, so $$$0$$$ balls are possible.

import Control.Monad
import Data.List
import Data.Containers.ListUtils

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

solve = do
  n <- getInt
  arr <- getList
  let m = maximum arr
      s = sum arr - m
  print $ if s == 0 && m == 0 then 0 else if m > s then m - s else 1

main = do
n <- readLn::IO Int
forM [1..n] (\t -> do solve)

import Control.Monad
import Data.List
import Data.Containers.ListUtils

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

solve = do
  n <- getInt
  arr <- getList
  let m = maximum arr
      s = sum arr - m
  print $ if s == 0 && s == 0 then 0 else if m > s then m - s else 1

main = do
n <- readLn::IO Int
forM [1..n] (\t -> do solve)


Indian summer is such a beautiful time of the year! A girl named Alyona is walking in the forest and picking a bouquet from fallen leaves. Alyona is very choosy — she doesn't take a leaf if it matches the color and the species of the tree of one of the leaves she already has. Find out how many leaves Alyona has picked.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of leaves Alyona has found. The next n lines contain the leaves' descriptions. Each leaf is characterized by the species of the tree it has fallen from and by the color. The species of the trees and colors are given in names, consisting of no more than 10 lowercase Latin letters. A name can not be an empty string. The species of a tree and the color are given in each line separated by a space.

Output the single number — the number of Alyona's leaves.

5
birch yellow
maple red
birch yellow
maple yellow
maple green

main=interact((\(n:s)->show$length$foldl(\b x->if(elem x b)then(b)else(x:b)) [] s).map(words).lines)

import Data.List (sort, group)
main = do interact (show . length . group . sort . tail . lines)
{-

-}

import Data.List
main = do
	n<-getLine
	s<-getContents
	putStrLn $ show $ solve (lines s)
solve s = length $ nub s

import List
main = interact (show.length.nub.tail.lines)

import Data.List (sort, group)

main = do
  		interact (show. length. group. sort. tail. lines)

--  44A

import List (nub)

getTuple :: String -> (String, String)
getTuple s  =  (s1, s2)
  where
    [s1, s2]  = words s

main :: IO ()
main  =  getLine >> fmap lines getContents >>= print . length . nub . map getTuple

main = interact solve
solve input = output where
  n0:leaves = lines input
  n = read n0::Int
  output = show $ answer leaves
  answer [] = 0
  answer (x:xs) = answer xs + if or $ map (== x) xs then 0 else 1


While searching for the pizza, baby Hosssam came across two permutations $$$a$$$ and $$$b$$$ of length $$$n$$$.Recall that a permutation is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).Baby Hosssam forgot about the pizza and started playing around with the two permutations. While he was playing with them, some elements of the first permutation got mixed up with some elements of the second permutation, and to his surprise those elements also formed a permutation of size $$$n$$$.Specifically, he mixed up the permutations to form a new array $$$c$$$ in the following way.  For each $$$i$$$ ($$$1\le i\le n$$$), he either made $$$c_i=a_i$$$ or $$$c_i=b_i$$$.  The array $$$c$$$ is a permutation. You know permutations $$$a$$$, $$$b$$$, and values at some positions in $$$c$$$. Please count the number different permutations $$$c$$$ that are consistent with the described process and the given values. Since the answer can be large, print it modulo $$$10^9+7$$$.It is guaranteed that there exists at least one permutation $$$c$$$ that satisfies all the requirements.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1\le n\le 10^5$$$) — the length of the permutations. The next line contains $$$n$$$ distinct integers $$$a_1,a_2,\ldots,a_n$$$ ($$$1\le a_i\le n$$$) — the first permutation. The next line contains $$$n$$$ distinct integers $$$b_1,b_2,\ldots,b_n$$$ ($$$1\le b_i\le n$$$) — the second permutation. The next line contains $$$n$$$ distinct integers $$$d_1,d_2,\ldots,d_n$$$ ($$$d_i$$$ is either $$$0$$$, $$$a_i$$$, or $$$b_i$$$) — the description of the known values of $$$c$$$. If $$$d_i=0$$$, then there are no requirements on the value of $$$c_i$$$. Otherwise, it is required that $$$c_i=d_i$$$. It is guaranteed that there exists at least one permutation $$$c$$$ that satisfies all the requirements. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$5 \cdot 10^5$$$.

For each test case, print the number of possible permutations $$$c$$$, modulo $$$10^9+7$$$.

NoteIn the first test case, there are $$$4$$$ distinct permutation that can be made using the process: $$$[2,3,1,4,5,6,7]$$$, $$$[2,3,1,7,6,5,4]$$$, $$$[2,3,1,4,6,5,7]$$$, $$$[2,3,1,7,5,6,4]$$$.In the second test case, there is only one distinct permutation that can be made using the process: $$$[1]$$$.In the third test case, there are $$$2$$$ distinct permutation that can be made using the process: $$$[6,5,2,1,4,3]$$$, $$$[6,5,3,1,4,2]$$$.In the fourth test case, there are $$$2$$$ distinct permutation that can be made using the process: $$$[1,2,8,7,4,3,6,5]$$$, $$$[1,6,4,7,2,3,8,5]$$$.In the fifth test case, there is only one distinct permutation that can be made using the process: $$$[1,9,2,3,4,10,8,6,7,5]$$$.

import Control.Monad
import Data.List
import qualified Data.Array as A
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS

fixedModulo :: Int
fixedModulo = 10^9 + 7

powerOfTwo :: Int -> Int
powerOfTwo 0 = 1
powerOfTwo x = let prevPower = powerOfTwo (x `div` 2) in
               let answ = (prevPower * prevPower) `mod` fixedModulo in
               if odd x
               then (answ + answ) `mod` fixedModulo
               else answ

solve :: A.Array Int Int -> A.Array Int Int -> Int
solve perm mark = length . filter (\x -> sum x == 0 && length x > 1) . map (map (\x -> mark A.! x)) $ cycles
    where invalidIndex :: Int -> Bool
          invalidIndex i = i < fst (A.bounds perm) || i > snd (A.bounds perm)
          cycles :: [[Int]]
          cycles = findCycles S.empty 0
          findCycles :: S.Set Int -> Int -> [[Int]]
          findCycles set i | invalidIndex i = []
                           | S.member i set = findCycles set (i + 1)
                           | otherwise = let cycle = findCycle set i in
                                         let set' = foldr S.insert set cycle in
                                         cycle : findCycles set' i
          findCycle :: S.Set Int -> Int -> [Int]
          findCycle set i | S.member i set = []
                          | otherwise = i : findCycle (S.insert i set) (perm A.! i)

fromList :: [a] -> A.Array Int a
fromList lst = A.listArray (0, length lst - 1) lst

readInt :: BS.ByteString -> Int
readInt bs = let Just (x, _) = BS.readInt bs in
             x

getArray :: IO [Int]
getArray = do line <- BS.getLine
              return . map readInt . BS.words $ line

testCaseMain :: IO ()
testCaseMain = do _ <- BS.getLine
                  a <- getArray
                  b <- getArray
                  c <- getArray
                  let c' = map (\x -> if x > 0 then 1 else 0) c
                  let (b', c'') = unzip $ map snd $ sort $ zip a (zip b c')
                  let b'' = map (\x -> x - 1) b'
                  print $ (powerOfTwo) $ solve (fromList b'') (fromList c'')

main :: IO ()
main = do line <- BS.getLine
          let t = readInt line
          forM_ [1..t] (\_ -> testCaseMain)


Let's suppose you have an array a, a stack s (initially empty) and an array b (also initially empty).You may perform the following operations until both a and s are empty:  Take the first element of a, push it into s and remove it from a (if a is not empty);  Take the top element from s, append it to the end of array b and remove it from s (if s is not empty). You can perform these operations in arbitrary order.If there exists a way to perform the operations such that array b is sorted in non-descending order in the end, then array a is called stack-sortable.For example, [3, 1, 2] is stack-sortable, because b will be sorted if we perform the following operations:  Remove 3 from a and push it into s;  Remove 1 from a and push it into s;  Remove 1 from s and append it to the end of b;  Remove 2 from a and push it into s;  Remove 2 from s and append it to the end of b;  Remove 3 from s and append it to the end of b. After all these operations b = [1, 2, 3], so [3, 1, 2] is stack-sortable. [2, 3, 1] is not stack-sortable.You are given k first elements of some permutation p of size n (recall that a permutation of size n is an array of size n where each integer from 1 to n occurs exactly once). You have to restore the remaining n - k elements of this permutation so it is stack-sortable. If there are multiple answers, choose the answer such that p is lexicographically maximal (an array q is lexicographically greater than an array p iff there exists some integer k such that for every i < k qi = pi, and qk > pk). You may not swap or change any of first k elements of the permutation.Print the lexicographically maximal permutation p you can obtain.If there exists no answer then output -1.

The first line contains two integers n and k (2 ≤ n ≤ 200000, 1 ≤ k < n) — the size of a desired permutation, and the number of elements you are given, respectively. The second line contains k integers p1, p2, ..., pk (1 ≤ pi ≤ n) — the first k elements of p. These integers are pairwise distinct.

If it is possible to restore a stack-sortable permutation p of size n such that the first k elements of p are equal to elements given in the input, print lexicographically maximal such permutation. Otherwise print -1.

import qualified Data.Array as V

main :: IO ()
main = do
    (n:_) <- fmap (map read . words) getLine
    as <- fmap (map read . words) getLine
    let rank = V.array (1, n) (zip [1..n] (repeat n) ++ zip as (enumFrom 1))
    let ans = fill [] [] [n, n-1 .. 1] rank
    if all id (zipWith (==) ans as) then printAns ans else print (-1)
    where
        fill as [] (c:cs) rank = fill as [c] cs rank
        fill as bs [] _ = reverse bs ++ as
        fill as (b:bs) (c:cs) rank =
            if rank V.! c < rank V.! b
                then fill (b:as) bs (c:cs) rank
                else fill as (c:b:bs) cs rank

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (a:as) = do
    putStr ((show a)++" ")
    printAns as

import qualified Data.Array as V

main :: IO ()
main = do
    (n:_) <- fmap (map read . words) getLine
    as <- fmap (map read . words) getLine
    let rank = V.listArray (1, n) ([1..length as] ++ replicate (n - length as) n)
    let ans = fill [] [] [n, n-1 .. 1] rank
    if all id (zipWith (==) ans as) then printAns ans else print (-1)
    where
        fill as [] (c:cs) rank = fill as [c] cs rank
        fill as bs [] _ = reverse bs ++ as
        fill as (b:bs) (c:cs) rank =
            if rank V.! c < rank V.! b
                then fill (b:as) bs (c:cs) rank
                else fill as (c:b:bs) cs rank

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (a:as) = do
    putStr ((show a)++" ")
    printAns as


Many modern text editors automatically check the spelling of the user's text. Some editors even suggest how to correct typos.In this problem your task to implement a small functionality to correct two types of typos in a word. We will assume that three identical letters together is a typo (for example, word "helllo" contains a typo). Besides, a couple of identical letters immediately followed by another couple of identical letters is a typo too (for example, words "helloo" and "wwaatt" contain typos).Write a code that deletes the minimum number of letters from a word, correcting described typos in the word. You are allowed to delete letters from both ends and from the middle of the word.

The single line of the input contains word s, its length is from 1 to 200000 characters. The given word s consists of lowercase English letters.

Print such word t that it doesn't contain any typos described in the problem statement and is obtained from s by deleting the least number of letters. If there are multiple solutions, print any of them.

NoteThe second valid answer to the test from the statement is "heloo".

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

encode :: String -> [(Char,Int)]
encode = map (head &&& length) . group

decode :: [(Char,Int)] -> String
decode = concat . map (\(ch,i) -> take i (repeat ch))

fixTypo :: [(Char,Int)] -> [(Char,Int)]
fixTypo = go False
    where
    go _ [] = []
    go _ ((ch,1):l) = (ch,1):go False l
    go False ((ch,i):l) = (ch,2):go True l
    go True  ((ch,i):l) = (ch,1):go False l

main = do
    s <- encode <$> getLine
    let s1 = fixTypo s
    putStrLn $ decode s1

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: String -> String
solve (a:b:c:d:s)
  | a == b && b == c  =  solve (b:c:d:s)
  | a == b && c == d  =  solve (a:b:c:s)
  | otherwise  =  a : solve (b:c:d:s)
solve (a:b:c:[])  =  [a, b] <?> [a, b, c] $ a == b && b == c
solve s  =  s

main :: IO ()
main  =  getLine >>= putStrLn . solve

module Main where
-- import Control.Applicative
import Data.List (group)
main :: IO ()
main = do
  w <- getLine
  let gw = map (\ g@(c:_) -> (c, length g)) $ group w
      ff (c,n) (b,l) =
        if b && n > 1
          then (False, (c,1):l)
          else (n > 1, (c,min 2 n):l)
      (_, fixed) = foldr ff (False, []) gw
      s = concatMap (uncurry $ flip replicate) fixed
  putStrLn s

import Data.List

solve :: String -> String
solve s
  = r
    where
      lowered = concatMap (take 2) (group s)
      r = concat $ no2cons (group lowered) False

      no2cons :: [[Char]] -> Bool -> [[Char]]
      no2cons [] _                 = []
      no2cons ([x] : rest) _       = [x] : no2cons rest False
      no2cons ([x,y] : rest) False = [x,y] : no2cons rest True
      no2cons ([x,y] : rest) True  = [x] : no2cons rest False

main = interact solve

import Data.List

solve :: String -> String
solve s
  = r
    where
      lowered = concatMap (take 2) (group s)
      r = concat $ no2cons (group lowered) False

      no2cons :: [[Char]] -> Bool -> [[Char]]
      no2cons [] _                 = []
      no2cons ([x] : rest) _       = [x] : no2cons rest False
      no2cons ([x,y] : rest) False = [x,y] : no2cons rest True
      no2cons ([x,y] : rest) True  = [x] : no2cons rest True

main = interact solve


You have $$$r$$$ red and $$$b$$$ blue beans. You'd like to distribute them among several (maybe, one) packets in such a way that each packet:   has at least one red bean (or the number of red beans $$$r_i \ge 1$$$);  has at least one blue bean (or the number of blue beans $$$b_i \ge 1$$$);  the number of red and blue beans should differ in no more than $$$d$$$ (or $$$|r_i - b_i| \le d$$$) Can you distribute all beans?

The first line contains the single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first and only line of each test case contains three integers $$$r$$$, $$$b$$$, and $$$d$$$ ($$$1 \le r, b \le 10^9$$$; $$$0 \le d \le 10^9$$$) — the number of red and blue beans and the maximum absolute difference in each packet.

For each test case, if you can distribute all beans, print YES. Otherwise, print NO. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes and YES are all recognized as positive answer).

NoteIn the first test case, you can form one packet with $$$1$$$ red and $$$1$$$ blue bean. The absolute difference $$$|1 - 1| = 0 \le d$$$.In the second test case, you can form two packets: $$$1$$$ red and $$$4$$$ blue beans in the first packet and $$$1$$$ red and $$$3$$$ blue beans in the second one.In the third test case, since $$$b = 1$$$, you can form only one packet with $$$6$$$ red and $$$1$$$ blue beans. The absolute difference $$$|6 - 1| = 5 > d$$$.In the fourth test case, since $$$d = 0$$$ so each packet should contain the same number of red and blue beans, but $$$r \neq b$$$.

{-# LANGUAGE BangPatterns #-}

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

import qualified Data.Array as A

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

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Bool

solve :: Integer -> Integer -> Integer -> Output
solve r b d = (d+1) * (min r b) >= max r b

plotResult :: Output -> IO ()
plotResult False = putStrLn "NO"
plotResult True = putStrLn "YES"

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[r, b, d] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve r b d
	return ()

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

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let j = sort $ take 2 n :: [Int]

        let u = if last j `rem` head j == 0
            then (last j - head j) `div` head j
            else (last j - head j) `div` head j + 1

        putStrLn $ if u <= last n
            then "YES"
            else "NO"

    forM_ [1..t] solve

import Control.Monad
import Data.List
import Data.Int

calc :: Int64 -> Int64 -> Int64 -> String
calc r b d | r > b = calc b r d
calc r b d =
  if b - r <= r * d then
    "YES"
  else
    "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [r,b,d] = map read $ words line :: [Int64]
    putStrLn $ calc r b d

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

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

printS = do
    [r,b,d]<-readInts
    let red = min r b
        blue = max r b
    putStrLn $ if blue >= red && blue <= red + d*red then "YES"
        else "NO"

main = do
    t<-readLn
    replicateM_ t printS

solve::[Int]->[String]
solve (r:b:d:xs)
  | ((max r b) `div` (min r b)) - t > d = "No" : solve xs
  | otherwise                       = "Yes" : solve xs
  where t = if ((max r b) `rem` (min r b)) == 0 then 1 else 0
solve [] = []

main = interact $ unlines . solve . map read . tail . words

import Control.Monad

readInt :: IO Integer
readInt = readLn

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

readInts :: IO [Integer]
readInts = readArray

solve :: Integer -> Integer -> Integer -> Bool
solve mi ma d = ma <= (d + 1) * mi

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

solveCase :: IO String
solveCase = do
  [a, b, d] <- readInts
  return $ ans $ solve (min a b) (max a b) d

main :: IO ()
main = readLn >>= flip replicateM_ (solveCase >>= putStrLn)

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
  lines >>>
  tail >>> map (words >>> map read >>> solve >>> bool "NO" "YES") >>> unlines

solve :: [Int] -> Bool
solve [r, b, d] =
  let x = min r b
      y = max r b
   in (y - 1) `div` x <= d

{-# LANGUAGE BangPatterns #-}

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

import qualified Data.Array as A

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

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Bool

solve :: Integer -> Integer -> Integer -> Output
solve r b d
	| max (r-b) (b-r) <= d = True
	| d > 1 && r > b && b > 1 = solve (max 1 $ r - (b+d)) (b-1) d
	| d > 1 && b > r && r > 1 = solve (max 1 $ b - (r+d)) (r-1) d
	| otherwise = False

plotResult :: Output -> IO ()
plotResult False = putStrLn "NO"
plotResult True = putStrLn "YES"

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[r, b, d] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve r b d
	return ()

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

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let j = sort $ take 2 n :: [Int]

        putStrLn $ if last j <= (head j * (last n + 1))
            then "YES"
            else "NO"
    forM_ [1..t] solve

import Control.Monad.RWS.Lazy (forM_)

main :: IO ()
main = do
    a <- getLine
    let t = read a :: Int

    let solve _ = do
        b <- getLine
        let n = read <$> words b :: [Int]
        let p = min (head n) (n !! 1) :: Int
        let u = sum (take 2 n) - 2 * p :: Int
        let x = u `div` p + u `rem` p :: Int

        putStrLn $ if x <= last n
            then "YES"
            else "NO"

    forM_ [1..t] solve

import Control.Monad
import Data.List

calc :: Int -> Int -> Int -> String
calc r b d | r > b = calc b r d
calc r b d =
  if b - r <= r * d then
    "YES"
  else
    "NO"

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [r,b,d] = map read $ words line :: [Int]
    putStrLn $ calc r b d

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

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

printS = do
    [r,b,d]<-readInts
    let red = min r b
        blue = max r b
    putStrLn $ if blue >= red && blue <= red + d*red then "YES"
        else "NO"

main = do
    t<-readLn
    replicateM_ t printS


There are two types of burgers in your restaurant — hamburgers and chicken burgers! To assemble a hamburger you need two buns and a beef patty. To assemble a chicken burger you need two buns and a chicken cutlet. You have $$$b$$$ buns, $$$p$$$ beef patties and $$$f$$$ chicken cutlets in your restaurant. You can sell one hamburger for $$$h$$$ dollars and one chicken burger for $$$c$$$ dollars. Calculate the maximum profit you can achieve.You have to answer $$$t$$$ independent queries.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) – the number of queries. The first line of each query contains three integers $$$b$$$, $$$p$$$ and $$$f$$$ ($$$1 \le b, ~p, ~f \le 100$$$) — the number of buns, beef patties and chicken cutlets in your restaurant. The second line of each query contains two integers $$$h$$$ and $$$c$$$ ($$$1 \le h, ~c \le 100$$$) — the hamburger and chicken burger prices in your restaurant.

For each query print one integer — the maximum profit you can achieve.

NoteIn first query you have to sell two hamburgers and three chicken burgers. Your income is $$$2 \cdot 5 + 3 \cdot 10 = 40$$$.In second query you have to ell one hamburgers and two chicken burgers. Your income is $$$1 \cdot 10 + 2 \cdot 12 = 34$$$.In third query you can not create any type of burgers because because you have only one bun. So your income is zero.

f -. g = g . f

main = do
	getLine
	interact $ lines -. map words -. map (map read) -. foo -. map bar -. map show -. unlines

foo [] = []
foo  (x1:x2:xs) = (x1++x2) : (foo xs)

bar :: [Int] -> Int
bar (b:p:f:h:c:[]) =
	let
		b2 = div b 2
	in if h>c
		then h*(min p b2)+c*(min f (b2-(min p b2)))
		else c*(min f b2)+h*(min p (b2-(min f b2)))

import Control.Monad
import Data.Maybe
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    print $ maximum $ 0 : catMaybes [ guard (2*(n1+n2) <= b) *>
                                  guard (n1 <= r1) *>
                                  guard (n2 <= r2) *>
                                  return (n1*p1 + n2*p2)
                                | n1 <- [0..100], n2 <- [0..100] ]

import Control.Monad ( forM_ )

main = do
  n <- readLn
  forM_ [1..n] $ const $ do
    let myGet = fmap (fmap read . words) getLine
    [b, hC, cC] <- myGet
    [hP, cP] <- myGet
    let maxBC = b `div` 2
    if hP > cP then do
      let hBC = min maxBC hC
          cBC = min (maxBC - hBC) cC
      print $ hBC * hP + cBC * cP
    else do
      let cBC = min maxBC cC
          hBC = min (maxBC - cBC) hC
      print $ hBC * hP + cBC * cP

gint :: IO Int
gint = fmap read getLine

main = do
    t <- gint
    mymain t

mymain 0 = return ()
mymain x = do
    strabc <- getLine
    strde <- getLine
    let [a,b,c] = map read $ words strabc
    let [d,e] = map read $ words strde
    let aa = a `div` 2
    if (d > e)
        then print (solve aa b c d e)
        else print (solve aa c b e d)
    mymain (x - 1)

solve a b c d e =
    let one = min a b
        two = max 0 (min (a-one) c) in
    (one * d + two * e)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M
import Data.Maybe

onecase= do
		[b,p,f]<- map read <$> words <$> getLine ::IO [Int]
		[h,c]<- map read <$> words <$> getLine :: IO [Int]
		let pp1 = (min p (div b 2)) *h
		let cp1 = (min f (div (b-p*2) 2)) *c
		let cp2 = (min f (div b 2)) *c
		let pp2 = (min p (div (b-f*2) 2)) *h
		print $ if h>c then (max 0 pp1)+(max 0 cp1) else (max 0 pp2)+(max 0 cp2)

main::IO ()
main=do
	s<- read <$> getLine:: IO Int
	replicateM_ s onecase

--ghc 7.10

import Data.List(sortBy)

makeBurgers :: (Integral a, Num b) => a -> a -> b -> (a,b)
makeBurgers b p c = (b',v')
    where
        d = min (b `div` 2) p
        b' = b - 2 * d
        v' = fromIntegral d * c

makeAllBurgers :: (Integral a, Num b, Ord b) => a -> [a] -> [b] -> b
makeAllBurgers b' ps' cs' = f b' (sortBy (\(_,c1) (_,c2) -> compare c2 c1) $ zip ps' cs')
    where
        f 0 _ = 0
        f _ [] = 0
        f b ((p,c):xs) = v + f bnew xs
            where (bnew, v) = makeBurgers b p c

process :: Int -> IO ()
process t
    | t <= 0 = return ()
    | otherwise = do
        line1 <- getLine
        let words1 = words line1
        let b = read $ head words1 :: Int
        let ps = map read $ tail words1 :: [Int]
        line2 <- getLine
        let cs = map read . words $ line2 :: [Int]
        print $ makeAllBurgers b ps cs
        process (t-1)

main = do
    tStr <- getLine
    let t = read tStr :: Int
    process t

import Control.Monad
import Data.Maybe
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    print $ maximum $ 0 : catMaybes [ guard (2*(n1+n2) <= b) *>
                                  guard (n1 <= r1) *>
                                  guard (n2 <= r2) *>
                                  return (n1*p1 + n2*p2)
                                | n1 <- [1..100], n2 <- [1..100] ]

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [b,p,f] <- map read . words <$> getLine
    [h,c] <- map read . words <$> getLine
    if h > c then let n1 = min (b `div` 2) p
                      b' = b - 2*n1
                  in print $ h*n1 * c*min (b' `div` 2) f
      else let n1 = min (b `div` 2) f
               b' = b - 2*n1
               in print $ c*n1 + h*min (b' `div` 2) p

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [b,r1,r2] <- map read . words <$> getLine
    [p1,p2] <- map read . words <$> getLine
    if p1 > p2 then let n = min (b `div` 2) r1
                        b' = b - 2*n
                  in print $ p1*n * p2*min (b' `div` 2) r2
      else let n = min (b `div` 2) r2
               b' = b - 2*n
               in print $ p2*n + p1*min (b' `div` 2) r1

import Control.Monad

main = do
  n <- readLn
  forM_ [1..n] $ const $ do
    let myGet = fmap (fmap read . words) getLine
    [b, hC, cC] <- myGet
    [hP, cP] <- myGet
    let maxBC = b `div` 2
    if hP < cP then do
      let hBC = min maxBC hC
          cBC = min (maxBC - hBC) cC
      print $ hBC * hP + cBC * cP
    else do
      let cBC = min maxBC cC
          hBC = min (maxBC - cBC) hC
      print $ hBC * hP + cBC * cP


William is a huge fan of planning ahead. That is why he starts his morning routine by creating a nested list of upcoming errands.A valid nested list is any list which can be created from a list with one item "1" by applying some operations. Each operation inserts a new item into the list, on a new line, just after one of existing items $$$a_1 \,.\, a_2 \,.\, a_3 \,.\, \,\cdots\, \,.\,a_k$$$ and can be one of two types:   Add an item $$$a_1 \,.\, a_2 \,.\, a_3 \,.\, \cdots \,.\, a_k \,.\, 1$$$ (starting a list of a deeper level), or  Add an item $$$a_1 \,.\, a_2 \,.\, a_3 \,.\, \cdots \,.\, (a_k + 1)$$$ (continuing the current level).  Operation can only be applied if the list does not contain two identical items afterwards. And also, if we consider every item as a sequence of numbers, then the sequence of items should always remain increasing in lexicographical order. Examples of valid and invalid lists that are shown in the picture can found in the "Notes" section.When William decided to save a Word document with the list of his errands he accidentally hit a completely different keyboard shortcut from the "Ctrl-S" he wanted to hit. It's not known exactly what shortcut he pressed but after triggering it all items in the list were replaced by a single number: the last number originally written in the item number.William wants you to help him restore a fitting original nested list.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^3$$$), which is the number of lines in the list. Each of the next $$$n$$$ lines contains a single integer $$$a_i$$$ ($$$1 \le a_i \le n$$$), which is what remains of William's nested list. It is guaranteed that in each test case at least one fitting list exists. It is guaranteed that the sum of values $$$n$$$ across all test cases does not exceed $$$10^3$$$.

For each test case output $$$n$$$ lines which represent a valid nested list, which could become the data provided to you by William. If there are multiple answers, print any.

NoteIn the second example test case one example of a fitting list is:11.1 1.1.11.1.21.21.2.122.12.2This list can be produced by using the sequence of operations shown below:    Original list with a single item $$$1$$$.  Insert item $$$2$$$ by using the insertion operation of the second type after item $$$1$$$.  Insert item $$$1.1$$$ by using the insertion operation of the first type after item $$$1$$$.  Insert item $$$1.2$$$ by using the insertion operation of the second type after item $$$1.1$$$.  Insert item $$$1.1.1$$$ by using the insertion operation of the first type after item $$$1.1$$$.  Insert item $$$1.1.2$$$ by using the insertion operation of the second type after item $$$1.1.1$$$.  Insert item $$$1.2.1$$$ by using the insertion operation of the first type after item $$$1.2$$$.  Insert item $$$2.1$$$ by using the insertion operation of the first type after item $$$2$$$.  Insert item $$$2.2$$$ by using the insertion operation of the second type after item $$$2.1$$$.

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

getInt :: IO Int
getInt = parseInt <$> C.getLine

data Tree = Empty | Node Int Tree Tree

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    as <- replicateM n getInt
    let func _ [] = (Empty, [])
        func i (x : xs)
          | i == x = (Node i t' t'', xs'')
          | otherwise = (Empty, x : xs)
          where (t', xs') = func 1 xs
                (t'', xs'') = func (i + 1) xs'
        dfs :: Bool -> Builder -> Tree -> IO ()
        dfs _ _ Empty = return ()
        dfs flag builder (Node x child sibling) = do
          let builder' = if flag then builder `mappend` charUtf8 '.' `mappend` intDec x else intDec x
          hPutBuilder stdout $ builder' `mappend` charUtf8 '\n'
          dfs True builder' child
          dfs flag builder sibling
    dfs False mempty $ fst $ func 1 as

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

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

nextLi :: Int -> [Int] -> [Int]
nextLi ai pre = let
  rv (v : vs)
    | ai == v + 1  = ai : vs
    | otherwise = rv vs
  rv [] = error "bad input"
  in  if  ai == 1
  then  1 : pre
  else  rv pre

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    (\fun -> foldM_ fun [] (replicate n ())) $ \pre () -> do
      [ai] <-  readInts
      let  res = nextLi ai pre
      res <$ putInts (reverse res)

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 '.') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


"The Chamber of Secrets has been opened again" — this news has spread all around Hogwarts and some of the students have been petrified due to seeing the basilisk. Dumbledore got fired and now Harry is trying to enter the Chamber of Secrets. These aren't good news for Lord Voldemort. The problem is, he doesn't want anybody to be able to enter the chamber. The Dark Lord is going to be busy sucking life out of Ginny.The Chamber of Secrets is an n × m rectangular grid in which some of the cells are columns. A light ray (and a basilisk's gaze) passes through the columns without changing its direction. But with some spell we can make a column magic to reflect the light ray (or the gaze) in all four directions when it receives the ray. This is shown in the figure below.   The left light ray passes through a regular column, and the right ray — through the magic column.  The basilisk is located at the right side of the lower right cell of the grid and is looking to the left (in the direction of the lower left cell). According to the legend, anyone who meets a basilisk's gaze directly dies immediately. But if someone meets a basilisk's gaze through a column, this person will get petrified. We know that the door to the Chamber is located on the left side of the upper left corner of the grid and anyone who wants to enter will look in the direction of its movement (in the direction of the upper right cell) from that position.   This figure illustrates the first sample test.  Given the dimensions of the chamber and the location of regular columns, Lord Voldemort has asked you to find the minimum number of columns that we need to make magic so that anyone who wants to enter the chamber would be petrified or just declare that it's impossible to secure the chamber.

The first line of the input contains two integer numbers n and m (2 ≤ n, m ≤ 1000). Each of the next n lines contains m characters. Each character is either "." or "#" and represents one cell of the Chamber grid. It's "." if the corresponding cell is empty and "#" if it's a regular column.

Print the minimum number of columns to make magic or -1 if it's impossible to do.

NoteThe figure above shows the first sample test. In the first sample we should make both columns magic. The dragon figure represents the basilisk and the binoculars represent the person who will enter the Chamber of secrets. The black star shows the place where the person will be petrified. Yellow lines represent basilisk gaze moving through columns.

import Control.Monad
import Data.List
import Data.Array

solve n m a = d!(n-1)
  where
    ix = (0, n + m - 1)
    e = accumArray (flip (:)) [] ix $ concat
      [[(i, n + j), (n + j, i)] | (i, b) <- zip [0 ..] a, (j, c) <- zip [0 ..] b, c == '#']
    d = snd $ until (null . snd . fst) bfs ((0, [0]), accumArray (+) (-1) ix [(0, 1)])
    bfs ((u, v), d) = ((u', v'), d // zip v' (repeat u'))
      where
        u' = succ u
        v' = map fst $ filter snd $ assocs $ accumArray (||) False ix [(j, True) | i <- v, j <- e!i, d!j == -1]

main = do
  [n,m] <- fmap (map read . words) getLine
  a <- replicateM n getLine
  print $ solve n m a

import Control.Monad
import Data.List

inf = 1000000

col a b = minimum $ inf:[i | (i, j) <- zip a b, j == '#']

gao a b = [if j == '#' then min i c else i | (i, j) <- zip a b]
  where
    c = col a b + 2

main = do
  [n,m] <- fmap (map read . words) getLine
  (h:t) <- replicateM n getLine
  print $ (\i -> if i < inf then i else -1) $
    col (foldl gao (map (\i -> if i == '#' then 2 else inf) h) t) $ last t

import Control.Monad
import Data.List

inf = 1000000

col a b = minimum $ inf:[i | (i, j) <- zip a b, j == '#']

gao a b = [if j == '#' then min i c else i | (i, j) <- zip a b]
  where
    c = col a b + 1
main = do
  [n,m] <- fmap (map read . words) getLine
  (h:t) <- replicateM n getLine
  print $ (\i -> if i < inf then i else -1) $
    col (foldl gao (map (\i -> if i == '#' then 2 else inf) h) t) $ last t