Each year in the castle of Dwarven King there is a competition in growing mushrooms among the dwarves. The competition is one of the most prestigious ones, and the winner gets a wooden salad bowl. This year's event brought together the best mushroom growers from around the world, so we had to slightly change the rules so that the event gets more interesting to watch.Each mushroom grower has a mushroom that he will grow on the competition. Under the new rules, the competition consists of two parts. The first part lasts t1 seconds and the second part lasts t2 seconds. The first and the second part are separated by a little break.After the starting whistle the first part of the contest starts, and all mushroom growers start growing mushrooms at once, each at his individual speed of vi meters per second. After t1 seconds, the mushroom growers stop growing mushrooms and go to have a break. During the break, for unexplained reasons, the growth of all mushrooms is reduced by k percent. After the break the second part of the contest starts and all mushrooms growers at the same time continue to grow mushrooms, each at his individual speed of ui meters per second. After a t2 seconds after the end of the break, the competition ends. Note that the speeds before and after the break may vary.Before the match dwarf Pasha learned from all participants, what two speeds they have chosen. However, the participants did not want to disclose to him all their strategy and therefore, did not say in what order they will be using these speeds. That is, if a participant chose speeds ai and bi, then there are two strategies: he either uses speed ai before the break and speed bi after it, or vice versa.Dwarf Pasha really wants to win the totalizer. He knows that each participant chooses the strategy that maximizes the height of the mushroom. Help Dwarf Pasha make the final table of competition results.The participants are sorted in the result table by the mushroom height (the participants with higher mushrooms follow earlier in the table). In case of equal mushroom heights, the participants are sorted by their numbers (the participants with a smaller number follow earlier).

The first input line contains four integer numbers n, t1, t2, k (1 ≤ n, t1, t2 ≤ 1000; 1 ≤ k ≤ 100) — the number of participants, the time before the break, the time after the break and the percentage, by which the mushroom growth drops during the break, correspondingly. Each of the following n lines contains two integers. The i-th (1 ≤ i ≤ n) line contains space-separated integers ai, bi (1 ≤ ai, bi ≤ 1000) — the speeds which the participant number i chose.

Print the final results' table: n lines, each line should contain the number of the corresponding dwarf and the final maximum height of his mushroom with exactly two digits after the decimal point. The answer will be considered correct if it is absolutely accurate.

Note  First example: for each contestant it is optimal to use firstly speed 2 and afterwards speed 4, because 2·3·0.5 + 4·3 > 4·3·0.5 + 2·3.

import Control.Monad (liftM)
import Data.List (sortBy)

parseLine :: String -> (Int, Int)
parseLine line  =  (a, b)
  where
    [a, b]  =  map read (words line)

myCompare :: (Int, Int) -> (Int, Int) -> Ordering
myCompare (n1, x1) (n2, x2)
  | x1 > x2  =  LT
  | x1 < x2  =  GT
  | n1 < n2  =  LT
  | n1 > n2  =  GT
  | otherwise  =  EQ

solve :: Int -> Int -> Int -> [(Int, Int)] -> [(Int, Int)]
solve t1 t2 k  =  (sortBy myCompare . solve' . zip [1..])
  where
    solve'  =  map calcMaxHeight
    calcMaxHeight (n, (a, b))  =  (n, max (calcMaxHeight' a b) (calcMaxHeight' b a))
    calcMaxHeight' a b  =  a * t1 * (100 - k) + 100 * b * t2

printAns :: [(Int, Int)] -> IO ()
printAns  =  mapM_ printAns'
  where
    printAns' (n, x)  =  putStrLn $ concat [show n, " ", show a, ".", b']
      where
        (a, b)  =  divMod x 100
        b'  =  if b < 10 then '0' : show b else show b

main :: IO ()
main  =  do
    lines'  <-  liftM lines getContents
    let [n, t1, t2, k]  =  (map read . words . head) lines'
    let ps  =  (map parseLine . take n . tail) lines'
    printAns (solve t1 t2 k ps)

import Data.List
import Data.Ord
import Control.Applicative
import Control.Monad
import Text.Printf

main = do
  [n,t1,t2,k] <- map read.words <$> getLine
  uvs <- replicateM n $ map read.words <$> getLine
  mapM_ (\ (i,f) -> printf "%d %.2f\n" i f) $ solve [n,t1,t2,k] uvs

solve :: [Int] -> [[Int]] -> [(Int,Double)]
solve [n,t1,t2,k] uvs = sortBy (flip $ comparing snd).zip [1..].map calc $ uvs
   where calc [v,u] = max (f[v,u]) (f[u,v])
         f [v,u] = (fromIntegral $ (100-k)*v*t1+100*u*t2)/100

import Control.Monad
import Data.List

main =
    do
        vals <- getLine
        let (n:t1:t2:k:_) = map (read :: String -> Int) $ words vals
        input <- getContents
        mapM (putStrLn.printSol) (sortBy myCmp (solve t1 t2 (100-k) 1 n $ lines input))

myCmp :: Ord a => (a,a) -> (a,a) -> Ordering
myCmp (x1,y1) (x2,y2) =
    if x1 == x2
    then
        compare y1 y2
    else
        compare x2 x1

solve :: Int -> Int -> Int -> Int -> Int -> [String] -> [(Int, Int)]
solve _ _ _ _ _ [] = []
solve t1 t2 k i n (x:xs)
    | i > n = []
    | otherwise =
        let
            (speed1:speed2:_) = map (read :: String -> Int) $ words x
            m = max (t1 * speed1 * k + t2 * speed2 * 100) (t1 * speed2 * k + t2 * speed1 * 100)
        in
            (m, i) : (solve t1 t2 k (i+1) n xs)

printSol :: (Int, Int) -> String
printSol (a,b) = (show b ++ " " ++ addDot a)

addDot :: Int -> String
addDot = snd . foldr (\x (p,ys) -> (p+1, if p == 2 then '.':x:ys else x:ys)) (1,[]) . show

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

process :: [(Integer, Integer)] -> Integer -> Integer -> Integer -> [Integer]
process [] t1 t2 k = []
process ((a, b): as) t1 t2 k = ( max (a*t1 + b*t2 - (a*t1*k `div` 100)) (a*t2 + b*t1 - (b*t1*k `div` 100)) ) : process (as) t1 t2 k

main :: IO ()
main = do
	line1 <- getLine
	let
		[n, tt1, tt2, k] = map (\x -> read x :: Integer).words $ line1
		t1 = tt1*100
		t2 = tt2*100
	content <- getContents
	let
	 	arr =  map (\x -> let [a, b] = words$ x in (read a :: Integer, read b :: Integer)). lines $ content
		arr1 = reverse. sortBy (\(a, b) (c, d) -> if b /= d then compare b  d else compare c a). zip [1..] $ process arr t1 t2 k
	mapM_ (\(x, y) -> putStrLn$ (show x) ++ " " ++ (show$ y `div` 100) ++ "." ++ appendZero (show $ y `mod` 100)) arr1
	where
		appendZero x
		 | length x == 2 = x
		 | otherwise = appendZero ('0': x)

import Data.List   (sortBy)
import Text.Printf (printf)

sortGT (a1, b1) (a2, b2)
  | b1 <  b2 = GT
  | b1 >  b2 = LT
  | b1 == b2 = EQ

answer :: Double -> Double -> Double -> [(Double, Double)] -> [(Int, Double)]
answer t1 t2 k gnomes = sortBy sortGT $ zipWith maxHeight [1..] gnomes
	where
		maxHeight n (a, b) = (n, max (height a b) (height b a))
		height a b = t1 * a * k + t2 * b

showGnome :: (Int, Double) -> String
showGnome (i, h) = printf "%i %.2f" i h

toTuple :: [a] -> (a, a)
toTuple (x:y:[]) = (x,y)
toTuple _        = error "wrong input"

main = do
	tmp <- getLine
	let (n:t1:t2:k:[]) = map read . words $ tmp
	gnomeTmp <- getContents
	let gnomes = map (toTuple . map read . words) . lines $ gnomeTmp
	putStrLn . unlines . map showGnome $ answer t1 t2 (1 - k/100) gnomes

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

process :: [(Int, Int)] -> Int -> Int -> Int -> [Int]
process [] t1 t2 k = []
process ((a, b): as) t1 t2 k = ( max (a*t1 + b*t2 - (a*t1*k `div` 100)) (a*t2 + b*t1 - (b*t1*k `div` 100)) ) : process (as) t1 t2 k

main :: IO ()
main = do
	line1 <- getLine
	let
		[n, tt1, tt2, k] = map (\x -> read x :: Int).words $ line1
		t1 = tt1*100
		t2 = tt2*100
	content <- getContents
	let
	 	arr =  map (\x -> let [a, b] = words$ x in (read a :: Int, read b :: Int)). lines $ content
		arr1 = reverse. sortBy (\(a, b) (c, d) -> if b /= d then compare b  d else compare c a). zip [1..] $ process arr t1 t2 k
	mapM_ (\(x, y) -> putStrLn$ (show x) ++ " " ++ (show$ y `div` 100) ++ "." ++ appendZero (show $ y `mod` 100)) arr1
	where
		appendZero x
		 | length x == 2 = x
		 | otherwise = appendZero (x++"0")

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

process :: [(Int, Int)] -> Int -> Int -> Int -> [Int]
process [] t1 t2 k = []
process ((a, b): as) t1 t2 k = ( max (a*t1 + b*t2 - (a*t1*k `div` 100)) (a*t2 + b*t1 - (b*t1*k `div` 100)) ) : process (as) t1 t2 k

main :: IO ()
main = do
	line1 <- getLine
	let
		[n, tt1, tt2, k] = map (\x -> read x :: Int).words $ line1
		t1 = tt1*100
		t2 = tt2*100
	content <- getContents
	let
	 	arr =  map (\x -> let [a, b] = words$ x in (read a :: Int, read b :: Int)). lines $ content
		arr1 = reverse. sortBy (\(a, b) (c, d) -> if b /= d then compare b  d else compare c a). zip [1..] $ process arr t1 t2 k
--	print arr
--	mapM_ (print) arr1
	mapM_ (\(x, y) -> putStrLn$ (show x) ++ " " ++ (show$ y `div` 100) ++ "." ++ (show $ y `mod` 100)) arr1

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

process :: [(Int, Int)] -> Int -> Int -> Int -> [Int]
process [] t1 t2 k = []
process ((a, b): as) t1 t2 k = ( max (a*t1 + b*t2 - (a*t1*k `div` 100)) (a*t2 + b*t1 - (b*t1*k `div` 100)) ) : process (as) t1 t2 k

main :: IO ()
main = do
	line1 <- getLine
	let
		[n, tt1, tt2, k] = map (\x -> read x :: Int).words $ line1
		t1 = tt1*100
		t2 = tt2*100
	content <- getContents
	let
	 	arr =  map (\x -> let [a, b] = words$ x in (read a :: Int, read b :: Int)). lines $ content
		arr1 = reverse. sortBy (\(a, b) (c, d) -> if b /= d then compare b  d else compare c a). zip [1..] $ process arr t1 t2 k
	mapM_ (\(x, y) -> putStrLn$ (show x) ++ " " ++ (show$ y `div` 100) ++ "." ++ appendZero (show $ y `mod` 100)) arr1
	where
		appendZero x
		 | length x == 2 = x
		 | otherwise = appendZero ('0': x)

import Data.List   (sortBy)
import Text.Printf (printf)

sortGT (a1, b1) (a2, b2)
  | b1 <  b2 = GT
  | b1 >  b2 = LT
  | b1 == b2 = EQ

answer :: Double -> Double -> Double -> [(Double, Double)] -> [(Int, Double)]
answer t1 t2 k gnomes = sortBy sortGT $ zipWith maxHeight [1..] gnomes
	where
		maxHeight n (a, b) = (n, max (height a b) (height b a))
		height a b = t1 * a * k + t2 * b

showGnome :: (Int, Double) -> String
showGnome (i, h) = printf "%i %.2f" i h

toTuple :: [a] -> (a, a)
toTuple (x:y:[]) = (x,y)
toTuple _        = error "wrong input"

main = do
	tmp <- getLine
	let (n:t1:t2:k:[]) = map read . words $ tmp
	gnomeTmp <- getContents
	let gnomes = map (toTuple . map read . words) . lines $ gnomeTmp
	putStrLn . unlines . map showGnome $ answer t1 t2 (k/100) gnomes


Mishka has got n empty boxes. For every i (1 ≤ i ≤ n), i-th box is a cube with side length ai.Mishka can put a box i into another box j if the following conditions are met:  i-th box is not put into another box;  j-th box doesn't contain any other boxes;  box i is smaller than box j (ai < aj). Mishka can put boxes into each other an arbitrary number of times. He wants to minimize the number of visible boxes. A box is called visible iff it is not put into some another box.Help Mishka to determine the minimum possible number of visible boxes!

The first line contains one integer n (1 ≤ n ≤ 5000) — the number of boxes Mishka has got. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109), where ai is the side length of i-th box.

Print the minimum possible number of visible boxes.

NoteIn the first example it is possible to put box 1 into box 2, and 2 into 3.In the second example Mishka can put box 2 into box 3, and box 4 into box 1.

module Main where
import qualified Data.ByteString.Char8 as B
import Data.List
import Control.Applicative

main = B.interact exec
exec = B.pack . show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve = maximum . map length . group . sort

import Data.List

main :: IO ()
main =
    interact
    $ show
    . maximum
    . map length
    . group
    . sort
    . map (read :: String -> Int)
    . tail
    . words

import Data.List

groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds
-------------------------------------------------------------------------------

main = interact $ unlines . parse . lines

parse [_,ops'] = sol ops
  where
    ops = fn $ words ops'
    fn :: [String] -> [Int]
    fn xs = map read xs

sol bs = [ show res ]
  where
    res = length $ maximumBy cmp $ group $ sort bs
    cmp a b = compare (length a) (length b)


Vasiliy is fond of solving different tasks. Today he found one he wasn't able to solve himself, so he asks you to help.Vasiliy is given n strings consisting of lowercase English letters. He wants them to be sorted in lexicographical order (as in the dictionary), but he is not allowed to swap any of them. The only operation he is allowed to do is to reverse any of them (first character becomes last, second becomes one before last and so on).To reverse the i-th string Vasiliy has to spent ci units of energy. He is interested in the minimum amount of energy he has to spent in order to have strings sorted in lexicographical order.String A is lexicographically smaller than string B if it is shorter than B (|A| < |B|) and is its prefix, or if none of them is a prefix of the other and at the first position where they differ character in A is smaller than the character in B.For the purpose of this problem, two equal strings nearby do not break the condition of sequence being sorted lexicographically.

The first line of the input contains a single integer n (2 ≤ n ≤ 100 000) — the number of strings. The second line contains n integers ci (0 ≤ ci ≤ 109), the i-th of them is equal to the amount of energy Vasiliy has to spent in order to reverse the i-th string.  Then follow n lines, each containing a string consisting of lowercase English letters. The total length of these strings doesn't exceed 100 000.

If it is impossible to reverse some of the strings such that they will be located in lexicographical order, print  - 1. Otherwise, print the minimum total amount of energy Vasiliy has to spent.

NoteIn the second sample one has to reverse string 2 or string 3. To amount of energy required to reverse the string 3 is smaller.In the third sample, both strings do not change after reverse and they go in the wrong order, so the answer is  - 1.In the fourth sample, both strings consists of characters 'a' only, but in the sorted order string "aa" should go before string "aaa", thus the answer is  - 1.

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

readIntList = fmap ((map read) . words) getLine :: IO [Int64]

inf = 1000000000000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf then print (-1) else print ans

solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

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

readIntList = fmap ((map read) . words) getLine :: IO [Int64]

inf = 1000000000000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf
        then print (-1)
        else print ans

solve :: [Int64] -> [String] -> (Int64,Int64,String) -> Int64
solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = 10^18
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = 10^18
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

    m = min a b

  if m == 10^18
     then print $ -1
     else print m

import Data.List (foldl')
data ExtInt = Finite Integer | Infinity deriving (Eq, Ord)
type Iter = (String, ExtInt, String, ExtInt)

plus :: ExtInt -> ExtInt -> ExtInt
(Finite a) `plus` (Finite b) = Finite (a + b)
_ `plus` _ = Infinity

extract :: ExtInt -> Integer
extract (Finite a) = a
extract Infinity   = (-1)

solve :: [Integer] -> [String] -> Integer
solve vals strs = let (_, u, _, v) = foldl' f ("", Finite 0, "", Finite 0) (zip vals strs) in extract (min u v)

f :: Iter -> (Integer, String) -> Iter
f (s, c, s', c') (k, t) = (t, min w x, t', min y z)
    where t' = reverse t
          k' = Finite k
          w  = if s  <= t  then c  else Infinity
          x  = if s' <= t  then c' else Infinity
          y  = if s  <= t' then c  `plus` k' else Infinity
          z  = if s' <= t' then c' `plus` k' else Infinity

main = do getLine
          vals <- getLine
          strs <- getContents
          putStrLn . show $ solve (map read $ words vals) (lines strs)

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

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

inf = 1000000000

main = do
    n <- readLn
    (a:as) <- readIntList
    (b:bs) <- mapM (\_ -> getLine) [1..n]
    let ans = solve as bs (0,a,b)
    if ans == inf
        then print (-1)
        else print ans

solve :: [Int] -> [String] -> (Int,Int,String) -> Int
solve [] [] (a,b,_) = min a b
solve (x:xs) (y:ys) (a,b,c) =
    let [p,q] = map fn [(0,y),(x,reverse y)]
        fn (cost,str) = foldl' (\acc (pcost,fl) -> if fl then min (pcost+cost) acc else acc) inf [(a,c<=str),(b,(reverse c)<=str)]
    in if all (==inf) [p,q]
            then inf
            else solve xs ys (p,q,y)

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n getLine

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s < t
            c2 = s < (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' < t
            c2 = s' < (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s < t
            c2 = s < (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' < t
            c2 = s' < (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n getLine

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

{-# OPTIONS_GHC -O2 #-}

import Control.Monad (replicateM)
import Control.Applicative ((<$>))
import Data.ByteString.Char8 (ByteString, words, lines, readInt, getLine, getContents, reverse)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents, reverse)
import Data.Int (Int64)
import Data.Char (isSpace)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

main = do
  [n] <- readInts
  cs <- readInts
  ss <- replicateM n (B.takeWhile (not . isSpace) <$> getLine)

  let
    f :: [Int] -> [ByteString] -> (Int64, Int64)
    f [c] [s] = (0, fromIntegral c)
    f (c:cs) (s:t:ss) = (a, b)
      where
        (a', b') = f cs (t:ss)

        a
          | c1 && c2 = min a' b'
          | c1 = a'
          | c2 = b'
          | otherwise = -1
          where
            c1 = s <= t
            c2 = s <= (reverse t)

        b
          | c1 && c2 = c' + min a' b'
          | c1 = c' + a'
          | c2 = c' + b'
          | otherwise = -1
          where
            c' = fromIntegral c
            s' = reverse s
            c1 = s' <= t
            c2 = s' <= (reverse t)

    (a, b) = f cs ss :: (Int64, Int64)

  print $ min a b

import Data.List (foldl')
data ExtInt = Finite Int | Infinity deriving (Eq, Ord)
type Iter = (String, ExtInt, String, ExtInt)

plus :: ExtInt -> ExtInt -> ExtInt
(Finite a) `plus` (Finite b) = Finite (a + b)
_ `plus` _ = Infinity

extract :: ExtInt -> Int
extract (Finite a) = a
extract Infinity   = (-1)

solve :: [Int] -> [String] -> Int
solve vals strs = let (_, u, _, v) = foldl' f ("", Finite 0, "", Finite 0) (zip vals strs) in extract (min u v)

f :: Iter -> (Int, String) -> Iter
f (s, c, s', c') (k, t) = (t, min w x, t', min y z)
    where t' = reverse t
          k' = Finite k
          w  = if s  <= t  then c  else Infinity
          x  = if s' <= t  then c' else Infinity
          y  = if s  <= t' then c  `plus` k' else Infinity
          z  = if s' <= t' then c' `plus` k' else Infinity

main = do getLine
          vals <- getLine
          strs <- getContents
          putStrLn . show $ solve (map read $ words vals) (lines strs)


Arkady decides to observe a river for n consecutive days. The river's water level on each day is equal to some real value.Arkady goes to the riverside each day and makes a mark on the side of the channel at the height of the water level, but if it coincides with a mark made before, no new mark is created. The water does not wash the marks away. Arkady writes down the number of marks strictly above the water level each day, on the i-th day this value is equal to mi.Define di as the number of marks strictly under the water level on the i-th day. You are to find out the minimum possible sum of di over all days. There are no marks on the channel before the first day.

The first line contains a single positive integer n (1 ≤ n ≤ 105) — the number of days. The second line contains n space-separated integers m1, m2, ..., mn (0 ≤ mi < i) — the number of marks strictly above the water on each day.

Output one single integer — the minimum possible sum of the number of marks strictly below the water level among all days.

NoteIn the first example, the following figure shows an optimal case.  Note that on day 3, a new mark should be created because if not, there cannot be 3 marks above water on day 4. The total number of marks underwater is 0 + 0 + 2 + 0 + 3 + 1 = 6.In the second example, the following figure shows an optimal case.

import Data.List
import Data.Int
main = interact (show . (fmap sum ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t :: Int64 in (t', t')) 0) >>= zipWith (\a b -> a - b - 1)) . tail) . map read . words)

import Data.List
import Data.Int
main = interact exec
exec = show . (\(_:xs) -> solve xs) . map read . words
solve :: [Int64] -> Int64
solve = fmap sum  ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t in (t', t')) 0) >>= zipWith (\a b -> a - b - 1))

import Data.List
main = interact exec
exec = show . (\(_:xs) -> solve xs) . map read . words
solve :: [Int] -> Int
solve = fmap sum  ((snd . mapAccumR (\m (i, t) -> let t' = max t $ m + i in (max m $ t' - i, t')) minBound . zip [1..] . snd . mapAccumL (\t x -> let t' = max (x + 1) t in (t', t')) 0) >>= zipWith (\a b -> a - b - 1))


Helen works in Metropolis airport. She is responsible for creating a departure schedule. There are n flights that must depart today, the i-th of them is planned to depart at the i-th minute of the day.Metropolis airport is the main transport hub of Metropolia, so it is difficult to keep the schedule intact. This is exactly the case today: because of technical issues, no flights were able to depart during the first k minutes of the day, so now the new departure schedule must be created.All n scheduled flights must now depart at different minutes between (k + 1)-th and (k + n)-th, inclusive. However, it's not mandatory for the flights to depart in the same order they were initially scheduled to do so — their order in the new schedule can be different. There is only one restriction: no flight is allowed to depart earlier than it was supposed to depart in the initial schedule.Helen knows that each minute of delay of the i-th flight costs airport ci burles. Help her find the order for flights to depart in the new schedule that minimizes the total cost for the airport.

The first line contains two integers n and k (1 ≤ k ≤ n ≤ 300 000), here n is the number of flights, and k is the number of minutes in the beginning of the day that the flights did not depart. The second line contains n integers c1, c2, ..., cn (1 ≤ ci ≤ 107), here ci is the cost of delaying the i-th flight for one minute.

The first line must contain the minimum possible total cost of delaying the flights. The second line must contain n different integers t1, t2, ..., tn (k + 1 ≤ ti ≤ k + n), here ti is the minute when the i-th flight must depart. If there are several optimal schedules, print any of them.

NoteLet us consider sample test. If Helen just moves all flights 2 minutes later preserving the order, the total cost of delaying the flights would be (3 - 1)·4 + (4 - 2)·2 + (5 - 3)·1 + (6 - 4)·10 + (7 - 5)·2 = 38 burles. However, the better schedule is shown in the sample answer, its cost is (3 - 1)·4 + (6 - 2)·2 + (7 - 3)·1 + (4 - 4)·10 + (5 - 5)·2 = 20 burles.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, FlexibleContexts, Rank2Types, ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Int
import qualified Data.Set as S
import Data.Array.ST.Safe
import Control.Monad.ST.Safe
import Data.Array.Unboxed

main = SB.putStr . SB.unlines . map (SB.pack . show) . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  k <- poi
  cs <- replicateM n poi
  return $ solve n k cs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

solve n k cs = elems $ runSTUArray $ do
  arr <- newArray (0, n) 0 :: ST s (STUArray s Int Int64)
  foldM_ (go arr) ((\(f, s) -> (S.fromList f, s)) . splitAt k $ flip (zipWith P) [1..] $ map to64 cs) [to64 (k + 1)..to64 (k + n)]
  return arr
  where
  go arr (!f, !ss) t = do
    tot <- readArray arr 0
    writeArray arr 0 (tot + (t - i) * c)
    writeArray arr (fromIntegral i) t
    return (f', ss')
    where
    ((P c i, f'), ss') = (\(a, b) -> (S.deleteFindMax a, b)) $ case ss of
      [] -> (f, [])
      s:rs -> (S.insert s f, rs)

data P = P !Int64 !Int64 deriving (Eq, Show, Ord)

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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import qualified Data.IntMap.Strict as MP (insertWith, delete, findMax, empty, adjust)
import qualified Data.Int as I (Int64)
import qualified Data.List as L (intercalate)
import qualified Data.Array.MArray.Safe as A (newArray, writeArray, getElems)
import qualified Data.Array.ST.Safe as ST (STUArray)
import qualified Control.Monad.ST.Safe as ST (runST, ST)
import qualified Data.STRef as ST (STRef, newSTRef, readSTRef, modifySTRef)
import qualified Control.Monad as M (forM_)

readInt = fst . M.fromJust . C.readInt

run n k xs = ST.runST $ do
    ans <- A.newArray (0, n - 1) 0 :: ST.ST s (ST.STUArray s Int Int)
    cost <- ST.newSTRef 0 :: ST.ST s (ST.STRef s I.Int64)
    mset <- ST.newSTRef MP.empty
    let (xsl, xsr) = splitAt k (zip xs [0..])
    M.forM_ xsl $ \(x, i) -> do
        ST.modifySTRef mset (MP.insertWith (++) x [i])
    M.forM_ xsr $ \(x, i) -> do
        ST.modifySTRef mset (MP.insertWith (++) x [i])
        (MP.findMax -> (xa, (xb:xt))) <- ST.readSTRef mset
        ST.modifySTRef cost (+ fromIntegral xa * fromIntegral (i - xb))
        A.writeArray ans xb (i + 1)
        if xt == [] then ST.modifySTRef mset (MP.delete xa)
        else ST.modifySTRef mset (MP.adjust (const xt) xa)
    M.forM_ [n..n + k - 1] $ \i -> do
        (MP.findMax -> (xa, (xb:xt))) <- ST.readSTRef mset
        ST.modifySTRef cost (+ fromIntegral xa * fromIntegral (i - xb))
        A.writeArray ans xb (i + 1)
        if xt == [] then ST.modifySTRef mset (MP.delete xa)
        else ST.modifySTRef mset (MP.adjust (const xt) xa)
    ans <- A.getElems ans
    cost <- ST.readSTRef cost
    return (cost, ans)

main = do
    (map readInt . C.words -> [n, k]) <- B.getLine
    (map readInt . C.words -> xs) <- B.getLine
    let (cost, ans) = run n k xs
    print (cost :: I.Int64)
    putStrLn $ L.intercalate " " $ map show $ ans


There are less than 60 years left till the 900-th birthday anniversary of a famous Italian mathematician Leonardo Fibonacci. Of course, such important anniversary needs much preparations.Dima is sure that it'll be great to learn to solve the following problem by the Big Day: You're given a set A, consisting of numbers l, l + 1, l + 2, ..., r; let's consider all its k-element subsets; for each such subset let's find the largest common divisor of Fibonacci numbers with indexes, determined by the subset elements. Among all found common divisors, Dima is interested in the largest one.Dima asked to remind you that Fibonacci numbers are elements of a numeric sequence, where F1 = 1, F2 = 1, Fn = Fn - 1 + Fn - 2 for n ≥ 3.Dima has more than half a century ahead to solve the given task, but you only have two hours. Count the residue from dividing the sought largest common divisor by m.

The first line contains four space-separated integers m, l, r and k (1 ≤ m ≤ 109; 1 ≤ l < r ≤ 1012; 2 ≤ k ≤ r - l + 1). Please, do not use the %lld specifier to read or write 64-bit integers in С++. It is preferred to use cin, cout streams or the %I64d specifier.

Print a single integer — the residue from dividing the sought greatest common divisor by m.

recfib n m | n == 0 = (0, 1)
           | mod n 2 == 1 = (mod (b*b+a*a) m, mod (b*(2*a+b)) m)
           | otherwise = (mod (a*(2*b-a)) m, mod (b*b+a*a) m)
    where (a, b) = recfib (n `div` 2) m
next_d d l r k | 1 + div r d - div (l + d - 1) d >= k = d
               | otherwise =
                  next_d (d - (d - mod r d + div r d) `div` (1 + div r d)) l r k
main = do
    line <- getLine
    let [m, l, r, k] = map read $ words line :: [Integer]
    (putStrLn.show.fst) (recfib (next_d (div (r - l)(k - 1)) l r k) m)


Robot Bender decided to make Fray a birthday present. He drove n nails and numbered them from 1 to n in some order. Bender decided to make a picture using metal rods. The picture is a closed polyline, which vertices should be nails (in the given order). The segments of the polyline should be parallel to the coordinate axes. Polyline is allowed to have self-intersections. Bender can take a rod and fold it exactly once in any place to form an angle of 90 degrees. Then he can attach the place of the fold to some unoccupied nail and attach two ends of this rod to adjacent nails. A nail is considered unoccupied if there is no rod attached to it (neither by it's end nor the by the fold place). No rod could be used twice. It is not required to use all the rods.Help Bender to solve this difficult task.

The first line contains two positive integers n and m (4 ≤ n ≤ 500, 2 ≤ m ≤ 500, n is even) — the amount of nails and the amount of rods. i-th of the following n lines contains a pair of integers, denoting the coordinates of the i-th nail. Nails should be connected in the same order as they are given in the input. The last line contains m integers — the lenghts of the rods. All coordinates do not exceed 104 by absolute value. Lengths of the rods are between 1 and 200 000. No rod can be used twice. It is guaranteed that all segments of the given polyline are parallel to coordinate axes. No three consecutive nails lie on the same line.

If it is impossible to solve Bender's problem, output NO. Otherwise, output YES in the first line, and in the second line output n numbers — i-th of them should be the number of rod, which fold place is attached to the i-th nail, or -1, if there is no such rod. If there are multiple solutions, print any of them.

import Data.Maybe
import qualified Data.Map as M
import Control.Applicative
import Data.List
import Data.Function
import Debug.Trace
import Control.Monad

zipPairs f [] = []
zipPairs f (x:y:xs) = (f x y):zipPairs f xs

dist [x1, y1] [x2, y2] = abs (x1 - x2) + abs (y1 - y2)
dists pts = {-trace (show pts) $ -}zipPairs (+) $ zipWith dist pts (tail pts)

findD have [] = Just []
findD have (x:xs) | null av = Nothing
                  | otherwise = (head av:) <$> findD (M.insert x (tail av) have) xs
  where
    av = M.findWithDefault [] x have

format xs = (-1:(intersperse (-1) xs)) ++ [-1]

solve :: [[Int]] -> M.Map Int [Int] -> Maybe [Int]
solve pts lens = tail <$> try (last pts : pts) <|>
                 take (length pts) <$> try (pts ++ [head pts])
  where
    try pts = format <$> findD lens (dists pts)

buildMap xs = M.fromListWith (++) $ zip xs $ map pure [1..]

main = do
  [n, _] <- map read <$> words <$> getLine
  pts <- replicateM n $ map read <$> words <$> getLine
  lens <- map read <$> words <$> getLine
  case solve pts (buildMap lens) of
    Nothing -> putStrLn "NO"
    Just res -> (putStrLn "YES") >> (putStrLn $ unwords $ map show res)

import Control.Monad (liftM, replicateM, replicateM_)
import Data.IntMap (findWithDefault, fromListWith, member, update)
import Data.List (delete, intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

toPair :: [a] -> (a, a)
toPair [a, b]  =  (a, b)

solve :: [(Int, Int)] -> [Int] -> Maybe [Int]
solve ps as  =  case solve2 of
  Nothing  ->  solve1
  Just qs  ->  Just (last qs : init qs)
  where
    map'  =  fromListWith (++) $ zip as $ map (\x -> [x]) [1..]
    solve1  =  solve' (last ps : ps) map' []
    solve2  =  solve' (ps ++ [head ps]) map' []
    solve' [_] _ ans  =  Just $ reverse ans
    solve' ((x1, y1) : (x2, y2) : (x3, y3) : ps) map' ans
      | l `member` map'  =  solve' ((x3, y3) : ps) (update tail' l map') (-1 : num : ans)
      | otherwise  =  Nothing
      where
        num  =  head $ findWithDefault [] l map'
        tail' [x]  =  Nothing
        tail' xs  =  Just $ tail xs
        l  =  sum [abs (x1-x2), abs (y1-y2), abs (x2-x3), abs (y2-y3)]

print' :: Maybe [Int] -> IO ()
print' Nothing  =  putStrLn "NO"
print' (Just xs)  =  putStrLn "YES" >> prints xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM n reads
    as  <-  reads
    print' $ solve (map toPair ps) as

import Control.Monad (liftM, replicateM, replicateM_)
import Data.IntMap (findWithDefault, fromListWith, member, update)
import Data.List (delete, intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

prints :: Show a => [a] -> IO ()
prints  =  putStrLn . intercalate " " . map show

toPair :: [a] -> (a, a)
toPair [a, b]  =  (a, b)

solve :: [(Int, Int)] -> [Int] -> Maybe [Int]
solve ps as  =  case solve2 of
  Nothing  ->  solve1
  Just qs  ->  Just (tail qs ++ [head qs])
  where
    map'  =  fromListWith (++) $ zip as $ map (\x -> [x]) [1..]
    solve1  =  solve' (last ps : ps) map' []
    solve2  =  solve' (ps ++ [head ps]) map' []
    solve' [_] _ ans  =  Just $ reverse ans
    solve' ((x1, y1) : (x2, y2) : (x3, y3) : ps) map' ans
      | l `member` map'  =  solve' ((x3, y3) : ps) (update tail' l map') (-1 : num : ans)
      | otherwise  =  Nothing
      where
        num  =  head $ findWithDefault [] l map'
        tail' [x]  =  Nothing
        tail' xs  =  Just $ tail xs
        l  =  sum [abs (x1-x2), abs (y1-y2), abs (x2-x3), abs (y2-y3)]

print' :: Maybe [Int] -> IO ()
print' Nothing  =  putStrLn "NO"
print' (Just xs)  =  putStrLn "YES" >> prints xs

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ps  <-  replicateM n reads
    as  <-  reads
    print' $ solve (map toPair ps) as


Duff is addicted to meat! Malek wants to keep her happy for n days. In order to be happy in i-th day, she needs to eat exactly ai kilograms of meat.  There is a big shop uptown and Malek wants to buy meat for her from there. In i-th day, they sell meat for pi dollars per kilogram. Malek knows all numbers a1, ..., an and p1, ..., pn. In each day, he can buy arbitrary amount of meat, also he can keep some meat he has for the future.Malek is a little tired from cooking meat, so he asked for your help. Help him to minimize the total money he spends to keep Duff happy for n days.

The first line of input contains integer n (1 ≤ n ≤ 105), the number of days. In the next n lines, i-th line contains two integers ai and pi (1 ≤ ai, pi ≤ 100), the amount of meat Duff needs and the cost of meat in that day.

Print the minimum money needed to keep Duff happy for n days, in one line.

NoteIn the first sample case: An optimal way would be to buy 1 kg on the first day, 2 kg on the second day and 3 kg on the third day.In the second sample case: An optimal way would be to buy 1 kg on the first day and 5 kg (needed meat for the second and third day) on the second day.

module Main where

import Control.Monad
import qualified Data.ByteString.Lazy.Char8 as L

parseInt :: L.ByteString -> Int
parseInt bs = case L.readInt bs of
                Just (x, _) -> x
                Nothing     -> error $ "Can't parse Int from: " ++ (L.unpack bs)

solve :: [Int] -> Int -> Int
solve [] _ = 0
solve (a:p:vs) bestPrice | p < bestPrice = a * p + solve vs p
                         | otherwise = a * bestPrice + solve vs bestPrice

main :: IO ()
main = do
  (_:vs) <- liftM (map parseInt . L.words) L.getContents
  print $ solve vs maxBound

main = interact $ show . solve . parse
  where parse = group2 . map read . tail . words
        group2 (x:y:zs) = (x, y) : group2 zs
        group2 [] = []

solve :: [(Int, Int)] -> Int
solve = fst . foldl folder (0, maxBound)
  where folder (acc, minCost) (a, p) = (acc + a * mC', mC')
          where mC' = min minCost p

main = do
         line <- getLine
         let n = read line :: Int
         inputLines <- fmap (take n . lines) getContents
         let input = [(tokens!!0,tokens!!1) | line <- inputLines, let tokens = map read (words line)] :: [(Int, Int)]
         let mins = scanl1 (\x y -> minimum [x,y]) (map snd input)
         let days = map fst input
         let cost = foldl (\x y -> x+(fst y * snd y)) 0 $ zip mins days
         putStrLn $ show cost

main :: IO()
main = print . solve 100 . map read . tail . words =<< getContents

solve :: Int -> [Int] -> Int
solve _ []      = 0
solve m (a:p:x) = let n = min m p
                  in n * a + solve n x

main = do
  getLine
  (as, ps) <- fmap (unzip . map ((\[a, b] -> (a, b)) . map read . words) . lines) getContents

  let ms = scanl1 min ps

  print $ sum $ zipWith (*) as ms

main = interact $ show . f 1000 . map read . tail . words
f _ [] = 0
f x (a:p:ap) = f p' ap + p' * a where p' = min x p

main = interact $ show . solve 100 . tail . map read . words
solve _ [] = 0
solve cMin (a : p : xs) = let nMin = min cMin p in nMin * a + solve nMin xs

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
answer::[[Int]] -> Int -> Int
answer [] _ = 0
answer ([a,p]:ps) pmin = a*nextMin+ answer ps nextMin
    where nextMin = min p pmin
main = do
  n <- readLn::IO Int
  a <- readMatrix
  print $ answer a (maxBound::Int)

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = readLn >>= \ n -> solve =<< forM [1..n] (\i-> map (fst.fromJust.C.readInt).C.words<$>C.getLine)
--solve::Int->IO()
solve xs = print $ sum $ map (\[a,b]->a*b) $ tail $ slv1 xs
slv1 xs = scanl (\[b1,b2] [a1,a2]  -> [a1, minimum [b2,a2]]) (head xs) xs

import Control.Monad
import Data.List

main = do
 n <- liftM (\x->read x::Int) getLine
 aps <- liftM (map ((\[x,y]->(x,y)) . map (\x->read x::Int).words)) $replicateM n getLine
 print $ fst
       $ foldl' (\(sum, p')  (a,p)  -> let p'' = min p p' in (sum + p''*a, p'')) ((\(x,y) -> (x*y,y))
       $ (head aps))
       $ tail aps

import Control.Applicative
import Data.List

solve :: [[Int]] -> Int
solve [a,b] = sum $ zipWith (*) a $ tail $ scanl min 101 b

parse :: String -> [[Int]]
parse = transpose.(fmap $ fmap read).fmap words.lines

main = do
    getLine
    l <- getContents
    print.solve $ parse l

import Control.Applicative

process s _ [] = s
process s m ([a1,a2]:as) = process (s+a1*(min m a2)) (min m a2) as

main::IO ()
main=do
   n<-read <$> getLine ::IO Int
   x<- map(map read) <$> map words <$> lines <$> getContents ::IO [[Int]]
   print $ process 0 10000 x

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

solve :: [[Int]] -> Int
solve = fst . foldl (\(s, q) [a, p] -> (s + a * min p q, min p q)) (0, 100)

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

solve :: [(Int, Int)] -> Int
solve = fst . foldl (\(s, q) (a, p) -> (s + a * min p q, min p q)) (0, 1000000000)

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

main = interact $ show . uncurry solve . parse
parse = unzip . pairs . map read . tail . words
pairs (x:y:z) = (x,y) : pairs z
pairs [] = []
solve as ps = sum $ zipWith (*) as (scanl1 min ps)

minPrice' :: [(Int, Int)] -> Int
minPrice' [x] = prod x
minPrice' (x:xs)
  | snd x > snd (head xs) = prod x + minPrice' (xs)
  | otherwise = prod x + minPrice' ((fst (head xs), snd x) : tail xs)

prod :: Num a => (a, a) -> a
prod (a,b) = a*b

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

main :: IO ()
main = do
  inputNum <- readLn
  ans <- fmap minPrice' (getInput inputNum)
  print ans

getInput :: Int -> IO [(Int, Int)]
getInput 0 = return []
getInput n = do
  x <- getLine
  let numAmtPrice = map read (words x) :: [Int]
      as = head numAmtPrice
      ps = last numAmtPrice
  nextLine <- getInput (n-1)
  return ((as, ps) : nextLine)

minPrice :: [Int] -> [Int] -> Int
minPrice as ps = thrd final where
  final = foldl1 (\acc x -> if snd1 acc > snd1 x then
    (1, snd1 x, (snd1 x * fst1 x) + thrd acc)
    else (1, snd1 acc, (snd1 acc * fst1 x) + thrd acc)) (zip3 as ps ds)
  ds = (head as * head ps) : repeat 0

fst1 (a, _, _) = a
snd1 (_, b, _) = b
thrd (_, _, c) = c

getInput :: Int -> IO [(Int, Int)]
getInput 0 = return []
getInput n = do
  line <- getLine
  let as = head $ map read (words (line)) :: Int
      ps = last $ map read (words (line)) :: Int
  next <- getInput (n-1)
  return ((as, ps) : next)

main :: IO ()
main = do
  numInput <- readLn
  vals <- getInput numInput
  let as = map fst vals
      ps = map snd vals
      ans = minPrice as ps
  print ans

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as C
import Data.Maybe

solve :: [[Int]] -> Int -> Int
solve [] _ = 0
solve ([a,p]:xs) mn = a*nextmn + solve xs nextmn
    where
        nextmn = min mn p

main :: IO ()
main = do
    n <- readLn :: IO Int
    ap <- map (map fst . mapMaybe C.readInt . C.words) <$> replicateM n C.getLine
    print $ solve ap 101

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

process [] _ s = s
process ([a,p]:as) x s | p<=x = process as p (s+p*a)
                       | otherwise = process as x (s+x*a)

main=do
	getLine
	r<- map (map (fst.fromJust.C.readInt)). map C.words. C.lines <$> C.getContents:: IO [[Int]]
	print $ process r 1000 0

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

process [] _ s = s
process ([a,p]:as) x s | p<=x = process as p (s+p*a)
                       | otherwise = process as x (s+x*a)

main=do
	getLine
	r<- map (map read). map words.lines <$> getContents:: IO [[Int]]
	print $ process r 1000 0

process :: [Int] -> [Int] -> Int
process as ps = sum $ zipWith (*) as ps'
    where ps' = scanl1 min ps

readInt :: String -> Int
readInt = read

readPair :: String -> (Int, Int)
readPair s = (l,r)
    where [l,r] = (map readInt.words) s

main :: IO ()
main = do
    t <- fmap readInt getLine
    (as,ps) <- fmap (unzip.map readPair.lines) getContents
    print $ process as ps

import Data.Char

minimumMoney :: [Int] -> [Int] -> Int -> IO Int
minimumMoney [] [] min = return 0
minimumMoney (a:as) (p:ps) min = if p < min then (do m <- minimumMoney as ps p
						     return (a*p + m))
					    else (do m <- minimumMoney as ps min
						     return (a*min + m))

getNumbers :: Int -> IO ([Int],[Int])
getNumbers 0 = return ([],[])
getNumbers n = do s <- getLine
		  let (a',rest) = span isDigit s
		      (p',rest') = span isDigit (tail rest)
		      a = read a' :: Int
		      p = read p' :: Int in do (as,ps) <- getNumbers (n-1)
					       return (a:as,p:ps)

main :: IO()
main = do s <- getLine
	  let n = read s :: Int in do (as,ps) <- getNumbers n
				      result <- minimumMoney as ps (2*10^9)
				      print result

main :: IO ()
main = interact solve

accumulator :: (Int, Int) -> [Int] -> (Int, Int)
accumulator (_, _) [] = undefined
accumulator (_, _) [_] = undefined
accumulator (total, bestPrice) (a:p:_) = (total', bestPrice')
    where bestPrice' = min bestPrice p
          total' = total + a * bestPrice'

solve :: String -> String
solve s = show $ fst $ foldl accumulator (0, 200) xs
    where xs = fmap (fmap read . words) (tail $ lines s) :: [[Int]]

import Data.List (sort, sortBy)

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

solve :: [(Int, Int)] -> Int
solve xas = sum $ zipWith (\(_, x) (_, y) -> x + y) (sort (filter ((>0) . fst) xas) ++ [(0, 0)]) (sortBy (flip compare) (filter ((<0) . fst) xas) ++ [(0, 0)])

toTuple :: [a] -> (a, a)
toTuple xs = (head xs, xs !! 1)

import Data.Char

minimumMoney :: [Int] -> [Int] -> IO Int
minimumMoney [] [] = return 0
minimumMoney (a:as) (p:ps) = if minimum (p:ps) == p then return (p*sum (a:as)) else do m <- minimumMoney as ps
										       return (a*p + m)

getNumbers :: Int -> IO ([Int],[Int])
getNumbers 0 = return ([],[])
getNumbers n = do s <- getLine
		  let (a',rest) = span isDigit s
		      (p',rest') = span isDigit (tail rest)
		      a = read a' :: Int
		      p = read p' :: Int in do (as,ps) <- getNumbers (n-1)
					       return (a:as,p:ps)

main :: IO()
main = do s <- getLine
	  let n = read s :: Int in do (as,ps) <- getNumbers n
				      result <- minimumMoney as ps
				      print result


There is a game called "I Wanna Be the Guy", consisting of n levels. Little X and his friend Little Y are addicted to the game. Each of them wants to pass the whole game.Little X can pass only p levels of the game. And Little Y can pass only q levels of the game. You are given the indices of levels Little X can pass and the indices of levels Little Y can pass. Will Little X and Little Y pass the whole game, if they cooperate each other?

The first line contains a single integer n (1 ≤  n ≤ 100).  The next line contains an integer p (0 ≤ p ≤ n) at first, then follows p distinct integers a1, a2, ..., ap (1 ≤ ai ≤ n). These integers denote the indices of levels Little X can pass. The next line contains the levels Little Y can pass in the same format. It's assumed that levels are numbered from 1 to n.

If they can pass all the levels, print "I become the guy.". If it's impossible, print "Oh, my keyboard!" (without the quotes).

NoteIn the first sample, Little X can pass levels [1 2 3], and Little Y can pass level [2 4], so they can pass all the levels both.In the second sample, no one can pass level 4.

import Control.Monad
import Control.Applicative
import Data.List (sort, nub)
main = do
  n <- readLn :: IO Int
  aa <- map read . words <$> getLine
  bb <- map read . words <$> getLine
  let xs = tail aa
      ys = tail bb
      p = head aa
      q = head bb
      levels = sort (nub $ xs ++ ys) == [1..n]
  putStrLn $ if levels then "I become the guy." else "Oh, my keyboard!"

import Data.List

main :: IO()
main = printResult . solve . map read . words =<< getContents

printResult :: Bool -> IO()
printResult b = putStrLn (if b then "I become the guy." else "Oh, my keyboard!")

solve :: [Int] -> Bool
solve (n:na:x) =
    let a = take na x
        b = drop (na + 1) x
    in  (length $ nub (a ++ b)) == n

import Data.List

conv lst res
  | (null lst) = res
  | otherwise = conv (tail lst) (res ++ [(read (head lst))::Int])

spanning lst cnt
  | (null lst) = cnt
  | (head lst) == (cnt+1) = spanning (tail lst) (cnt+1)
  | otherwise = spanning (tail lst) cnt

main = do
  ss <- getLine
  let ii = (read ss)::Int
  ww <- getLine
  oo <- getLine
  let qq = (tail (conv (words ww) []))
      cc = (tail (conv (words oo) []))
      jj = qq ++ cc
      hh = sort jj
      spans = spanning hh 0
  if spans < ii
    then putStrLn "Oh, my keyboard!"
    else putStrLn "I become the guy."

import Data.List

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

main = do
    n <- readLn
    a1 <- readItems
    a2 <- readItems
    putStrLn $ if null ([1 .. n] \\ ((tail a1) ++ (tail a2)))
               then "I become the guy."
               else "Oh, my keyboard!"

import Data.Set

main = interact $ g.f
f inp = (Prelude.map (\x -> Prelude.map read (words x) :: [Integer]) (lines inp))

a (x:y:z:[]) = head x
b (x:y:z:[]) = tail y
c (x:y:z:[]) = tail z

g inp
  | fromList [1..(a inp)] == union (fromList (b inp)) (fromList (c inp)) = "I become the guy."
  | otherwise = "Oh, my keyboard!"

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

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

main = B.interact $ B.pack . getAns . getIntArray

getAns :: [Int] -> String
getAns (n:p:xs) = if ([1..n] == sort (union ls rs)) then "I become the guy." else "Oh, my keyboard!"
			where (ls, (_:rs)) = splitAt p xs

import Data.List

main = do
  n <- readLn
  as <- fmap (map read . words) getLine
  bs <- fmap (map read . words) getLine

  putStrLn $ if sort (nub (tail as ++ tail bs)) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList an) (HS.fromList bn)) == n
        then putStrLn "I become the guy."
        else putStrLn "Oh, my keyboard!"

import Data.List as L
solve [[n],_:a,_:b] = length (L.nub $ L.sort (a++b) ) == n
tores True = "I become the guy."
tores False = "Oh, my keyboard!"
main = interact $ tores . solve . map (map read . words) . lines

import qualified Data.Set as S

main = do
   n <- fmap read getLine
   (p:ls) <- fmap (map read . words) getLine
   (q:ls') <- fmap (map read . words) getLine
   printSol (solve n (S.fromList ls) (S.fromList ls'))

printSol True = putStrLn "I become the guy."
printSol False = putStrLn "Oh, my keyboard!"

solve :: Int -> S.Set Int -> S.Set Int -> Bool
solve n s s' = n == S.size (S.union s s')

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.ttail.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = if x/=0 then x:(solve [y|y<-xs, y/=x, y/=0]) else solve [y|y<-xs, y/=x, y/=0]
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"
ttail (xs:xss) =xs : map tail xss

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

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

solve :: Int -> [Int] -> [Int] -> Bool
solve n a b = List.all id $ map (\i -> Set.member i s) [1 .. n]
  where
    s = Set.fromList (a ++ b)

ans :: Bool -> String
ans True  = "I become the guy."
ans False = "Oh, my keyboard!"

main :: IO ()
main = do
  n     <- read <$> getLine
  _ : a <- (map read . words) <$> getLine
  _ : b <- (map read . words) <$> getLine
  putStrLn $ ans $ solve n a b

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- L.nub . tail . map read . words <$> getLine :: IO [Int]
  ys <- L.nub . tail . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

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

solve :: Int -> [Int] -> [Int] -> Bool
-- solve lv a b = all (liftM2 (||) (`elem` a) (`elem` b)) [1..lv]
solve lv a b = (==[1..lv]) . map head . group . sort $ a ++ b

main :: IO ()
main = do
        lv <- fmap read getLine
        a  <- fmap tail getIntList
        b  <- fmap tail getIntList
        putStrLn $ if solve lv a b then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import Data.List

main = do
  n <- readLn
  (_:xs) <- map read . words <$> getLine :: IO [Int]
  (_:ys) <- map read . words <$> getLine :: IO [Int]
  let
    l = length . group . sort $ xs ++ ys
   in putStrLn $ if l == n then "I become the guy." else "Oh, my keyboard!"

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

main=do
      n<- read <$> getLine ::IO Int
      a<- (replicateM 2 (tail <$> map read <$>   words   <$> getLine))::IO [[Int]]
      let b = length $ map head $ group $ sort $ concat a
      putStrLn $ if n==b then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub, sort)

main :: IO ()
main = getContents >>= putStrLn . output . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[n], (_:xs), (_:ys)] = length (nub (xs ++ ys)) == n

output :: Bool -> String
output True = "I become the guy."
output _ = "Oh, my keyboard!"

import Data.List (nub, sort)

main :: IO ()
main = getContents >>= putStrLn . output . solve . map (map read . words) . lines

solve :: [[Int]] -> Bool
solve [[n], (_:xs), (_:ys)] = sort (nub (xs ++ ys)) == [1..n]

output :: Bool -> String
output True = "I become the guy."
output _ = "Oh, my keyboard!"

import Data.List (nub)
main = do
  n <- readLn
  as <- fmap (map read . tail . words) getLine
  bs <- fmap (map read . tail . words) getLine
  putStrLn $ if length (nub (as ++ bs :: [Int])) == n then "I become the guy." else "Oh, my keyboard!"

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

import Data.List

main :: IO ()
main = do
  n <- readLn :: IO Int
  a <- getLine >>= return. tail. map read. words :: IO [Int]
  b <- getLine >>= return. (++a). tail. map read. words :: IO [Int]
  putStrLn $ if n == (length. nub $ b) then "I become the guy." else "Oh, my keyboard!"

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

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

getIntList :: IO [Int]
getIntList = fmap (unfoldr (B.readInt . B.dropWhile isSpace)) B.getLine

solve :: Int -> [Int] -> [Int] -> Bool
solve lv a b = (==[1..lv]) . map head . group . sort $ a ++ b

main :: IO ()
main = do
    lv <- fmap read getLine
    a  <- fmap tail getIntList
    b  <- fmap tail getIntList
    putStrLn $ if solve lv a b then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.Set  as S

main= do
	n<- read <$> getLine  :: IO Int
	x<- tail.map read. words <$> getLine::IO [Int]
	y<- tail.map read. words <$> getLine::IO [Int]
	putStrLn $  if length (S.toList(S.fromList(x++y)))==n then "I become the guy." else "Oh, my keyboard!"

import Data.List
main = do
  n <- readLn :: IO Int
  a <- getLine >>= return. tail. map read. words :: IO [Int]
  b <- getLine >>= return. (++a). tail. map read. words :: IO [Int]
  putStrLn $ if n == (length. nub $ b) then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    s1 <- tail . map (read :: String -> Int) . words <$> getLine
    s2 <- tail . map (read :: String -> Int) . words <$> getLine
    putStrLn $ if sort (s1 `union` s2) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    comb <- sort . uncurry union . (\[a,b]->(a,b)) . map (tail . map (read :: String -> Int) . words) <$> sequence [getLine, getLine]
    putStrLn $ if length comb == n then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub)

process :: Int -> [Int] -> [Int] -> Bool
process n ps qs = n == length (nub (ps ++ qs))

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    n <- fmap readInt getLine
    (p:ps) <- fmap (map readInt.words) getLine
    (q:qs) <- fmap (map readInt.words) getLine
    putStrLn $ ["Oh, my keyboard!","I become the guy."] !! fromEnum (process n ps qs)

import Data.List
main = do
    let readint = read :: String -> Int
    n <- fmap readint getLine
    m <- fmap (length . nub . concat . map (tail . map readint . words) . lines) getContents
    putStrLn $ if m == n then "I become the guy." else "Oh, my keyboard!"

import Data.List

main = interact $ (\(n:p:xs) -> if n == (length . nub $ drop (p+1) xs ++ take p xs) then "I become the guy." else "Oh, my keyboard!") . map read . words

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | (length . group . sort) (xs ++ ys) == n = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . tail. words) . tail $ l

main :: IO ()
main = interact $ solve

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | n == length (nub (xs ++ ys)) = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . tail. words) . tail $ l

main :: IO ()
main = interact $ solve

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

main = do
  n <- readLn :: IO Int
  aa <- map read . words <$> getLine
  bb <- map read . words <$> getLine
  let xs = tail aa
      ys = tail bb
      p = head aa
      q = head bb
      levels = (nub $ xs ++ ys) == [1..n]
  putStrLn $ if levels then "I become the guy." else "Oh, my keyboard!"

import Data.List

main = do
  n <- readLn
  as <- fmap (map read . words) getLine
  bs <- fmap (map read . words) getLine

  putStrLn $ if sort (nub (as ++ bs)) == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList ps) (HS.fromList qs)) == n
        then putStrLn "I become the guy."
        else putStrLn "Oh, my keyboard!"

import Data.Functor ( (<$>) )
import qualified Data.Set as HS

main :: IO ()
main = do
    n <- read <$> getLine
    ps <- map read . words <$> getLine
    qs <- map read . words <$> getLine
    let (_:an) = ps :: [Int]
    let (_:bn) = qs :: [Int]
    if HS.size (HS.union (HS.fromList ps) (HS.fromList qs)) == n
        then putStrLn "I become the guy"
        else putStrLn "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = if x/=0 then x:(solve [y|y<-xs, y/=x, y/=0]) else solve [y|y<-xs, y/=x, y/=0]
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = x:(solve [y|y<-xs, y/=x, y/=0])
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve2 . concat.map (map read.words).take 3 . lines
solve :: [Int]->[Int]
solve []=[]
solve (x:xs) = x:(solve [y|y<-xs, y/=x])
solve2 :: [Int]->String
solve2 (x:xs) = if x==length (solve xs) then "I become the guy." else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- L.nub . map read . words <$> getLine :: IO [Int]
  ys <- L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- filter (/=0) . L.nub . map read . words <$> getLine :: IO [Int]
  ys <- filter (/=0) . L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import qualified Data.List as L

main = do
  n <- read <$> getLine :: IO Int
  xs <- tail . L.nub . map read . words <$> getLine :: IO [Int]
  ys <- tail . L.nub . map read . words <$> getLine
  putStrLn $
    if length (xs `L.union` ys) == n then "I become the guy."
                                     else "Oh, my keyboard!"

import Control.Applicative
import Data.List

main=do
      n<- read <$> getLine ::IO Int
      a<-concatMap (map read) <$> map words <$> lines <$> getContents ::IO [Int]
      let b = length $ map head $ group $ sort a
      putStrLn $ if n==b then "I become the guy." else "Oh, my keyboard!"

import Data.List (nub)
main = do
  n <- readLn
  as <- fmap (map read . tail . words) getLine
  bs <- fmap (map read . tail . words) getLine
  putStrLn $ if length (nub (as ++ bs :: [Int])) == n then "I become the guy" else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    s1 <- tail . map (read :: String -> Int) . words <$> getLine
    s2 <- tail . map (read :: String -> Int) . words <$> getLine
    putStrLn $ if union s1 s2 == [1..n] then "I become the guy." else "Oh, my keyboard!"

import           Data.List
main :: IO ()
main = do
    n <- (read :: String -> Int) <$> getLine
    comb <- sort . uncurry union . (\[a,b]->(a,b)) . map (map (read :: String -> Int) . words) <$> sequence [getLine, getLine]
    putStrLn $ if comb == [1..n] then "I become the guy." else "Oh, my keyboard!"

import Data.List

play :: Int -> [[Int]] -> String
play n [xs, ys]
    | (length . group . sort) (xs ++ ys) == n = "I become the guy."
    | otherwise = "Oh, my keyboard!"

solve :: String -> String
solve s = play n [xs, ys]
    where l = lines s
          n = read . head $ l
          [xs, ys] = fmap (fmap read . words) . tail $ l

main :: IO ()
main = interact $ solve


Vasya writes his own library for building graphical user interface. Vasya called his creation VTK (VasyaToolKit). One of the interesting aspects of this library is that widgets are packed in each other. A widget is some element of graphical interface. Each widget has width and height, and occupies some rectangle on the screen. Any widget in Vasya's library is of type Widget. For simplicity we will identify the widget and its type. Types HBox and VBox are derivatives of type Widget, so they also are types Widget. Widgets HBox and VBox are special. They can store other widgets. Both those widgets can use the pack() method to pack directly in itself some other widget. Widgets of types HBox and VBox can store several other widgets, even several equal widgets — they will simply appear several times. As a result of using the method pack() only the link to the packed widget is saved, that is when the packed widget is changed, its image in the widget, into which it is packed, will also change. We shall assume that the widget a is packed in the widget b if there exists a chain of widgets a = c1, c2, ..., ck = b, k ≥ 2, for which ci is packed directly to ci + 1 for any 1 ≤ i < k. In Vasya's library the situation when the widget a is packed in the widget a (that is, in itself) is not allowed. If you try to pack the widgets into each other in this manner immediately results in an error.Also, the widgets HBox and VBox have parameters border and spacing, which are determined by the methods set_border() and set_spacing() respectively. By default both of these options equal 0.    The picture above shows how the widgets are packed into HBox and VBox. At that HBox and VBox automatically change their size depending on the size of packed widgets. As for HBox and VBox, they only differ in that in HBox the widgets are packed horizontally and in VBox — vertically. The parameter spacing sets the distance between adjacent widgets, and border — a frame around all packed widgets of the desired width. Packed widgets are placed exactly in the order in which the pack() method was called for them. If within HBox or VBox there are no packed widgets, their sizes are equal to 0 × 0, regardless of the options border and spacing. The construction of all the widgets is performed using a scripting language VasyaScript. The description of the language can be found in the input data. For the final verification of the code Vasya asks you to write a program that calculates the sizes of all the widgets on the source code in the language of VasyaScript.

The first line contains an integer n — the number of instructions (1 ≤ n ≤ 100). Next n lines contain instructions in the language VasyaScript — one instruction per line. There is a list of possible instructions below.   "Widget [name]([x],[y])" — create a new widget [name] of the type Widget possessing the width of [x] units and the height of [y] units.  "HBox [name]" — create a new widget [name] of the type HBox.  "VBox [name]" — create a new widget [name] of the type VBox.  "[name1].pack([name2])" — pack the widget [name2] in the widget [name1]. At that, the widget [name1] must be of type HBox or VBox.  "[name].set_border([x])" — set for a widget [name] the border parameter to [x] units. The widget [name] must be of type HBox or VBox.  "[name].set_spacing([x])" — set for a widget [name] the spacing parameter to [x] units. The widget [name] must be of type HBox or VBox.  All instructions are written without spaces at the beginning and at the end of the string. The words inside the instruction are separated by exactly one space. There are no spaces directly before the numbers and directly after them.  The case matters, for example, "wiDget x" is not a correct instruction. The case of the letters is correct in the input data. All names of the widgets consist of lowercase Latin letters and has the length from 1 to 10 characters inclusive. The names of all widgets are pairwise different. All numbers in the script are integers from 0 to 100 inclusive It is guaranteed that the above-given script is correct, that is that all the operations with the widgets take place after the widgets are created and no widget is packed in itself. It is guaranteed that the script creates at least one widget.

For each widget print on a single line its name, width and height, separated by spaces. The lines must be ordered lexicographically by a widget's name.  Please, do not use the %lld specificator to read or write 64-bit integers in C++. It is preferred to use cout stream (also you may use %I64d specificator)

12
Widget me(50,40)
VBox grandpa
HBox father
grandpa.pack(father)
father.pack(me)
grandpa.set_border(10)
grandpa.set_spacing(20)
Widget brother(30,60)
father.pack(brother)
Widget friend(20,60)
Widget uncle(100,20)
grandpa.pack(uncle)

15
Widget pack(10,10)
HBox dummy
HBox x
VBox y
y.pack(dummy)
y.set_border(5)
y.set_spacing(55)
dummy.set_border(10)
dummy.set_spacing(20)
x.set_border(10)
x.set_spacing(10)
x.pack(pack)
x.pack(dummy)
x.pack(pack)
x.set_border(0)

brother 30 60
father 80 60
friend 20 60
grandpa 120 120
me 50 40
uncle 100 20

NoteIn the first sample the widgets are arranged as follows:

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

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

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

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

data Widget = Widget { name :: String, width :: Integer, height :: Integer }
            | VBox { name :: String, border :: Integer, spacing :: Integer, contains :: [String] }
            | HBox { name :: String, border :: Integer, spacing :: Integer, contains :: [String] }

solve :: [String] -> String
solve seq = unlines $ map (show . calcWidget mapping) (Map.keys mapping)
  where
    mapping = execState (sequence_ $ map simulating seq) Map.empty

simulating :: String -> State (Map String Widget) ()
simulating ('V':'B':'o':'x':' ':name) = modify $ Map.insert name (VBox name 0 0 [])
simulating ('H':'B':'o':'x':' ':name) = modify $ Map.insert name (HBox name 0 0 [])
simulating ('W':'i':'d':'g':'e':'t':' ':def) = modify $ Map.insert name (Widget name x y)
  where
    (name, xy) = span (/='(') def
    (x, y) = read xy
simulating stmt
    | op == ".pack"        = modify $ Map.update (Just . addContains param) name
    | op == ".set_border"  = modify $ Map.update (Just . setBorder (read param)) name
    | op == ".set_spacing" = modify $ Map.update (Just . setSpacing (read param)) name
  where
    (name, stmt2) = span (/='.') stmt
    (op, stmt3) = span (/='(') stmt2
    param = tail $ init stmt3

addContains chd (VBox name border spacing contains) = VBox name border spacing (chd:contains)
addContains chd (HBox name border spacing contains) = HBox name border spacing (chd:contains)

setSpacing spacing (VBox name border _ contains) = VBox name border spacing contains
setSpacing spacing (HBox name border _ contains) = HBox name border spacing contains

setBorder border (VBox name _ spacing contains) = VBox name border spacing contains
setBorder border (HBox name _ spacing contains) = HBox name border spacing contains

calcWidget mapping = (cache Map.!)
  where
    cache = Map.fromList [(names, goName names) | names <- Map.keys mapping]

    goName name = go (mapping Map.! name)
    go w@(Widget _ _ _) = w
    go (VBox name _ _ []) = Widget name 0 0
    go (HBox name _ _ []) = Widget name 0 0
    go (VBox name border spacing contains) = Widget name (maximum widths + border * 2) (sum heights + (len - 1) * spacing + border * 2)
      where
        widgets = map (calcWidget mapping) contains
        heights = map height widgets
        widths = map width widgets
        len = genericLength widgets

    go (HBox name border spacing contains) = Widget name (sum widths + (len - 1) * spacing + border * 2) (maximum heights + border * 2)
      where
        widgets = map (calcWidget mapping) contains
        heights = map height widgets
        widths = map width widgets
        len = genericLength widgets

instance Show Widget where
    show (Widget name x y) = name ++ " " ++ show x ++ " " ++ show y

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

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

import Text.ParserCombinators.ReadP hiding (get)
import Control.Applicative
import Control.Monad
import Data.Char
import Data.Traversable hiding (mapM)
import Data.List
import Data.Function
import Data.Map(Map, (!))
import qualified Data.Map as Map
-- import Data.MemoTrie

instance Applicative ReadP where
  pure x = return x
  f <*> x = do
    f' <- f
    x' <- x
    return (f' x')

data Statement =
 Widget String Integer Integer
 | HBox String
 | VBox String
 | Pack String String
 | SetBorder String Integer
 | SetSpacing String Integer
 deriving (Show)

identifier = munch (\c -> isAlpha c || c=='_')

translateCommand :: String -> String -> String -> Statement
translateCommand w1 "pack" w2 = Pack w1 w2
translateCommand w1 "set_border" x = SetBorder w1 (read x)
translateCommand w1 "set_spacing" x = SetSpacing w1 (read x)

integer :: ReadP Integer
integer = read <$> munch isDigit

parseStatement = choice
  [
    Widget <$> (string "Widget " *> identifier) <*> (char '(' *> integer) <*> (char ',' *> integer <* char ')')
    , HBox <$> (string "HBox " *> identifier)
    , VBox <$> (string "VBox " *> identifier)
    , translateCommand <$> identifier <*> (char '.' *> identifier) <*> (char '(' *> munch (\c -> isAlpha c || isDigit c) <* char ')')
  ]

type Dimensions = (Integer, Integer)
type Spacing = Integer
type Border = Integer

data Direction = Vertical | Horisontal

data Widget = SimpleWidget Dimensions | BoxWidget Direction [String] Spacing Border

executeStatement :: Statement -> Map String Widget -> Map String Widget
executeStatement (Widget name x y) = Map.insert name (SimpleWidget (x,y))
executeStatement (HBox name) = Map.insert name (BoxWidget Horisontal [] 0 0)
executeStatement (VBox name) = Map.insert name (BoxWidget Vertical [] 0 0)
executeStatement (Pack box containee) = Map.adjust (addChild containee) box
executeStatement (SetBorder box b) = Map.adjust (setBorder b) box
executeStatement (SetSpacing box b) = Map.adjust (setSpacing b) box

addChild containee (BoxWidget d ch s b) = BoxWidget d (containee : ch) s b
setBorder border (BoxWidget d c s _b) = BoxWidget d c s border
setSpacing spacing (BoxWidget d c _s b) = BoxWidget d c spacing b

runScript :: [Statement] -> Map String Widget
runScript = foldl (flip executeStatement) Map.empty

memo :: ((String -> InMemo Dimensions) -> (String -> InMemo Dimensions)) -> (String -> InMemo Dimensions)
memo f = mf where
  mf k = do
    m <- get
    case Map.lookup k m of
      Nothing -> do
        x <- f mf k
        put $ Map.insert k x m
        return x
      Just x -> return x

put :: Map String Dimensions -> InMemo ()
put m = InMemo $ \_ -> ((), m)

get :: InMemo (Map String Dimensions)
get = InMemo $ \m -> (m, m)

data InMemo a = InMemo { runMemo :: Map String Dimensions -> (a, Map String Dimensions) }

instance Functor InMemo where
  fmap f x = x >>= return . f
instance Monad InMemo where
  x >>= f = InMemo $ \s0 -> let (x', s1) = runMemo x s0 in runMemo (f x') s1
  return x = InMemo $ \s -> (x, s)

evalInMemo x s = fst $ runMemo x s

calculateM :: Map String Widget -> (String -> InMemo Dimensions) -> (String -> InMemo Dimensions)
calculateM widgets r s = case widgets ! s of
      SimpleWidget d -> return d
      BoxWidget _ [] _ _ -> return (0, 0)
      BoxWidget dir children spacing border -> sw . layout <$> mapM ((sw <$>) . r) children
        where
          layout dims = (ly (map fst dims), ly [maximum $ map snd dims])
          ly xs = sum xs + spacing * (genericLength xs - 1) + border * 2
          sw = swd dir
          swd Horisontal (x, y) = (x, y)
          swd Vertical (x, y) = (y, x)

calculate :: Map String Widget -> Map String Dimensions
calculate widgets = evalInMemo doCalculate Map.empty
  where
    doCalculate :: InMemo (Map String Dimensions)
    doCalculate = Map.fromList <$> mapM (\(key, _) -> doCalc key >>= \val -> return (key, val)) (Map.toList widgets)
    doCalc = memo (calculateM widgets)

{-calculate :: Map String Widget -> Map String Dimensions
calculate widgets = Map.mapWithKey (\k v -> mcalc k) widgets
  where
    mcalc = {- memo -} calc
    calc s =    -}

main = do
  n <- read <$> getLine
  script <- (map ((\[(r, "")] -> r) . readP_to_S parseStatement)) <$> replicateM n getLine
  mapM putStrLn $ map (\(k,(x,y)) -> unwords [k, show x, show y]) $ Map.toList $ calculate $ runScript script


PolandBall lives in a forest with his family. There are some trees in the forest. Trees are undirected acyclic graphs with k vertices and k - 1 edges, where k is some integer. Note that one vertex is a valid tree.There is exactly one relative living in each vertex of each tree, they have unique ids from 1 to n. For each Ball i we know the id of its most distant relative living on the same tree. If there are several such vertices, we only know the value of the one with smallest id among those.How many trees are there in the forest?

The first line contains single integer n (1 ≤ n ≤ 104) — the number of Balls living in the forest. The second line contains a sequence p1, p2, ..., pn of length n, where (1 ≤ pi ≤ n) holds and pi denotes the most distant from Ball i relative living on the same tree. If there are several most distant relatives living on the same tree, pi is the id of one with the smallest id. It's guaranteed that the sequence p corresponds to some valid forest. Hacking: To hack someone, you should provide a correct forest as a test. The sequence p will be calculated according to the forest and given to the solution you try to hack as input. Use the following format: In the first line, output the integer n (1 ≤ n ≤ 104) — the number of Balls and the integer m (0 ≤ m < n) — the total number of edges in the forest. Then m lines should follow. The i-th of them should contain two integers ai and bi and represent an edge between vertices in which relatives ai and bi live. For example, the first sample is written as follows: 5 31 23 44 5

You should output the number of trees in the forest where PolandBall lives.

NoteIn the first sample testcase, possible forest is: 1-2 3-4-5. There are 2 trees overall.In the second sample testcase, the only possible graph is one vertex and no edges. Therefore, there is only one tree.

import Control.Applicative
import Data.Graph

main = do
  n <- readLn :: IO Int
  p <- map read <$> words <$> getLine  :: IO [Int]
  let g = buildG (1, n) (zip [1..n] p)
  print (length (components g))

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Array
import Data.Foldable
import qualified Data.Set as S

readInt = maybe undefined fst . B.readInt
readInts = map readInt . B.words

main = do
  n <- readInt <$> B.getLine
  ps <- listArray (1, n) . readInts <$> B.getLine
  print . S.size . foldl' (\s (i, v) -> if ps!v == i then S.insert (min v i) s else s) S.empty . assocs $ ps

import Data.Array.IArray
import qualified Data.Array.IArray as A
import Data.Array.Unboxed
import Data.List( nub)

main = do
    n_ <- readLn::IO Int
    connections_ <- return . map read . words =<< getLine
    let
	ary = A.listArray (1,n_) connections_:: (UArray Int Int)
	backRt ix = let
			to = ary!ix
		    in
			if to < ix
			    then backRt to
			    else ix
	numTrees = let arrayList = A.elems ary
		   in length . nub $ map backRt arrayList
    print numTrees


You are playing the game "Arranging The Sheep". The goal of this game is to make the sheep line up. The level in the game is described by a string of length $$$n$$$, consisting of the characters '.' (empty space) and '*' (sheep). In one move, you can move any sheep one square to the left or one square to the right, if the corresponding square exists and is empty. The game ends as soon as the sheep are lined up, that is, there should be no empty cells between any sheep.For example, if $$$n=6$$$ and the level is described by the string "**.*..", then the following game scenario is possible:   the sheep at the $$$4$$$ position moves to the right, the state of the level: "**..*.";  the sheep at the $$$2$$$ position moves to the right, the state of the level: "*.*.*.";  the sheep at the $$$1$$$ position moves to the right, the state of the level: ".**.*.";  the sheep at the $$$3$$$ position moves to the right, the state of the level: ".*.**.";  the sheep at the $$$2$$$ position moves to the right, the state of the level: "..***.";  the sheep are lined up and the game ends. For a given level, determine the minimum number of moves you need to make to complete the level.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 10^6$$$). The second line of each test case contains a string of length $$$n$$$, consisting of the characters '.' (empty space) and '*' (sheep) — the description of the level. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^6$$$.

For each test case output the minimum number of moves you need to make to complete the level.

import Control.Monad
import Data.Int (Int64)
import Data.List (sort)

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- getLine
        print $ solve $ map fst $ filter ((== '*') . snd) $ zip [1 .. n] a

solve :: [Int64] -> Int64
solve [] = 0
solve xs' = sum $ map (abs . (m -)) xs
  where
    n = length xs'
    xs = sort $ zipWith ((-) . fromIntegral) [1 .. n] xs'
    m = xs !! div n 2

import Control.Arrow
import Data.List(sort, group)

chunksOf :: Int -> [a] -> [[a]]
chunksOf k [] = []
chunksOf k xs = let (g, xs') = splitAt k xs in g : chunksOf k xs'

type LL = Integer

main = interact $
         lines >>> drop 1 >>> chunksOf 2
         >>> map ((!! 1) >>> solve >>> show)
         >>> unlines

solve :: String -> LL
solve s =
    let xs = zipWith (-) [i | (c, i) <- zip s [0..], c == '*'] [0..]
        m = xs !! (length xs `div` 2)
    in sum $ map (abs . (m -)) xs


It's time polar bears Menshykov and Uslada from the zoo of St. Petersburg and elephant Horace from the zoo of Kiev got down to business. In total, there are n tasks for the day and each animal should do each of these tasks. For each task, they have evaluated its difficulty. Also animals decided to do the tasks in order of their difficulty. Unfortunately, some tasks can have the same difficulty, so the order in which one can perform the tasks may vary.Menshykov, Uslada and Horace ask you to deal with this nuisance and come up with individual plans for each of them. The plan is a sequence describing the order in which an animal should do all the n tasks. Besides, each of them wants to have its own unique plan. Therefore three plans must form three different sequences. You are to find the required plans, or otherwise deliver the sad news to them by stating that it is impossible to come up with three distinct plans for the given tasks.

The first line contains integer n (1 ≤ n ≤ 2000) — the number of tasks. The second line contains n integers h1, h2, ..., hn (1 ≤ hi ≤ 2000), where hi is the difficulty of the i-th task. The larger number hi is, the more difficult the i-th task is.

In the first line print "YES" (without the quotes), if it is possible to come up with three distinct plans of doing the tasks. Otherwise print in the first line "NO" (without the quotes). If three desired plans do exist, print in the second line n distinct integers that represent the numbers of the tasks in the order they are done according to the first plan. In the third and fourth line print two remaining plans in the same form. If there are multiple possible answers, you can print any of them.

NoteIn the first sample the difficulty of the tasks sets one limit: tasks 1 and 4 must be done before tasks 2 and 3. That gives the total of four possible sequences of doing tasks : [1, 4, 2, 3], [4, 1, 2, 3], [1, 4, 3, 2], [4, 1, 3, 2]. You can print any three of them in the answer.In the second sample there are only two sequences of tasks that meet the conditions — [3, 1, 2, 4, 5] and [3, 1, 4, 2, 5]. Consequently, it is impossible to make three distinct sequences of tasks.

import Data.List
main = interact $ solve .map read. drop 1.words
findA index n xs acc
	|index>=n || length acc > 1 = acc
	|otherwise = if (fst $head xs)==(fst $head $tail xs) then findA (index+1) n (tail xs) (index:acc) else findA (index+1) n (tail xs) acc
printAns xs equals=
	("YES\n"++p xs++"\n")++(p $ swap xs $head equals)++"\n"++(p $ swap xs $last equals)
	where p=unwords.map show.map snd
 	      swap ys k=take (k-1) ys ++ [xs!!k, xs!!(k-1)]++drop (k+1) ys
solve :: [Int]->String
solve xs =
	if length equals>1 then printAns ys equals else "NO"
	where ys=sort $ zip xs [1..]
	      equals=findA 1 (length xs) ys []

import Data.Ord (comparing)
import Data.List (groupBy, sortBy, transpose, permutations)
import Data.Function (on)

main :: IO ()
main = do
    _ <- getLine
    xs <- (fmap (map read . words) getLine) :: IO [Int]
    let res = calc xs
    putStr res

has3 :: [[a]] -> Bool
has3 = any ((<=3) . length)

has2twice :: [[a]] -> Bool
has2twice = (>=2) . length . filter ((<=3) . length)

calc :: [Int] -> String
calc xs
    | canDo = "YES\n" ++ output
    | otherwise = "NO\n"
    where
        ys = zip [1..] $ xs
        zs = groupBy (on (==) snd) $ sortBy (comparing snd) ys
        res = take 3 $ findAll zs
        canDo = length res == 3
        output = unlines res

findAll :: [[(Int,Int)]] -> [String]
findAll = map fmt . ((foldr (\xs ys -> [x++y|x<-xs,y<-ys]) [[]])::[[[(Int,Int)]]]->[[(Int,Int)]]) . ((map permutations)::[[(Int,Int)]]->[[[(Int,Int)]]])

fmt :: [(Int,Int)] -> String
fmt = unwords . map show . map fst

import Data.List
import Data.Function
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B

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

main = B.interact $ B.pack . unlines . getAns . getIntArray

getAns :: [Int] -> [String]
getAns (n:xs) = let anss =  gettop3 $ groupA $ zip xs [1..n]
				in if (length anss) < 3 then ["NO"] else ["YES"] ++ (map (unwords . map show)) anss

groupA :: [(Int, Int)] -> [[Int]]
groupA = map (map (\(_, x) -> x)) . groupBy (\(x, _) (y, _) -> x == y) . sort

gettop3 :: [[Int]] -> [[Int]]
gettop3 = (map concat . take 3 . mapM permutations)

import Data.List (sort, groupBy, permutations)
import Debug.Trace

solve :: [Int] -> [[Int]]
solve x =
  take 3 $ crossProduct groupings
  where
    track q = trace (show q) q
    groupings = map (map snd) . groupBy (\a -> \b -> fst a == fst b) . sort . zip x $ [1..]
    crossProduct (grouping:rst) =
      cross grouping (crossProduct rst)
    crossProduct [] = []
    cross grouping [] = permutations grouping
    cross grouping solns =
      [a ++ soln | a <- permutations grouping, soln <- solns]

showSoln :: [[Int]] -> String
showSoln x
  | length x /= 3 = "NO"
  | otherwise =
    "YES\n" ++ (unlines . map (unwords . map show) $ x)

main = do
  getLine
  putStrLn . showSoln . solve . map read . words =<< getContents

import Data.Function (on)
import Data.Functor ((<$>))
import Data.List (groupBy, inits, permutations, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> tail <$> map read <$> words <$> getContents

solve :: [Integer] -> Maybe [[Integer]]
solve = listToMaybe . drop 3 . inits . f . map (permutations . map fst)
      . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [1..]

f :: [[[a]]] -> [[a]]
f [] = []
f [xs] = xs
f (xs:xss) = [ x ++ xs' | x <- xs, xs' <- f xss ]

printSolution :: Show a => Maybe [[a]] -> IO ()
printSolution xs = putStrLn (maybe "NO" (const "YES") xs)
                 >> mapM_ (putStrLn . unwords . map show) (fromMaybe [] xs)

import Data.Function (on)
import Data.Functor ((<$>))
import Data.List (groupBy, inits, permutations, sortBy)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = printSolution =<< solve <$> tail <$> map read <$> words <$> getContents

solve :: [Integer] -> Maybe [[Integer]]
solve = listToMaybe . drop 3 . inits . map concat . mapM (permutations . map fst)
      . groupBy ((==) `on` snd) . sortBy (compare `on` snd) . zip [1..]

printSolution :: Show a => Maybe [[a]] -> IO ()
printSolution xs = putStrLn (maybe "NO" (const "YES") xs)
                 >> mapM_ (putStrLn . unwords . map show) (fromMaybe [] xs)