import Control.Applicative

main=do
	[n,a,b]<-  map read . words <$> getLine:: IO [Int]
	r<- map read. words <$> getLine ::IO [Int]
	let r1 = length $ filter (==1) r
	let r2 = length $ filter (==2) r
	let r3=  (max (r1-a) 0)
	let r4 = max ( (max (r2-b) 0) - (if a>r1 then a-r1 else 0)) 0
	print $ r3+r4

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

main = do
	[ n, m, k ] <- map ( read :: String -> Int ) . words <$> getLine
	as <- map read . words <$> getLine
	print $ solve as m k

solve [] m k = ( - min m 0 ) + ( - min k 0 )
solve (a:as) m k
	| a == 1 = solve as ( m - 1 ) k
	| a == 2 = if 0 < k then solve as m ( k - 1 ) else solve as ( m - 1 ) k

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

solve :: [Int] -> Int
solve (n:m:k:a) = solve' m k a

solve' :: Int -> Int -> [Int] -> Int
solve' _ _ []    = 0
solve' 0 m (1:x) = 1 + solve' 0 m x
solve' n m (1:x) = solve' (n - 1) m x
solve' 0 0 (2:x) = 1 + solve' 0 0 x
solve' n 0 (2:x) = solve' (n - 1) 0 x
solve' n m (2:x) = solve' n (m - 1) x

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

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

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

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

main = do
    [n,m,k] <- readInts
    as <- readInts
    print $ solve n m k as

solve n m k as = go m k as
    where
    go _ _ [] = 0
    go 0 k (1:as) = 1+ go 0 k as
    go m k (1:as) = go (m-1) k as
    go 0 0 (2:as) = length as+1
    go m 0 (2:as) = go (m-1) 0 as
    go m k (2:as) = go m (k-1) as

import Control.Applicative

data Type = One | Two deriving Eq
type Bowl = Int
type Plate = Int

main = do
    [n,bowls,plates] <- map read.words <$> getLine :: IO [Int]
    types <- getPlan n
    putStrLn.show $ washPlan bowls plates types

getPlan _ = map convert.words <$> getLine where
    convert "1" = One
    convert "2" = Two

washPlan :: Bowl -> Plate -> [Type] -> Int
washPlan b p [] = 0
washPlan 0 p (One:ts) = 1 + washPlan 0 p ts
washPlan b p (One:ts) = washPlan (b-1) p ts
washPlan 0 0 (Two:ts) = 1 + washPlan 0 0 ts
washPlan 0 p (Two:ts) = washPlan 0 (p-1) ts
washPlan b 0 (Two:ts) = washPlan (b-1) 0 ts
washPlan b p (Two:ts) = washPlan b (p-1) ts

import Control.Applicative
import Control.Monad

main = do
  [[n,m,k],xs] <- replicateM 2 $ map read . words <$> getLine
  print $ eat 0 m k xs
eat c _ _ []     = c
eat c 0 k (1:xs) = eat (c+1) 0 k xs
eat c m k (1:xs) = eat c (m-1) k xs
eat c 0 0 (2:xs) = eat (c+1) 0 0 xs
eat c 0 k (2:xs) = eat c 0 (k-1) xs
eat c m 0 (2:xs) = eat c (m-1) 0 xs
eat c m k (2:xs) = eat c m (k-1) xs

import Control.Monad
import Control.Applicative

solve :: Int -> Int -> [Int] -> Int
solve _ _ [] = 0
solve bowls plates (d:ds)
  | d == 1    =  if ( bowls > 0 )   then solve (bowls-1) plates ds
                                    else 1 + solve bowls plates ds
  | otherwise =  if ( plates > 0 )  then solve bowls (plates-1) ds
                                    else if ( bowls > 0 ) then  solve (bowls-1) plates ds
                                                          else  1 + solve bowls plates ds
main :: IO ()
main = do
  firstLine <- getLine
  let [n,bowls,plates] = map read (words firstLine) :: [Int]

  secondLine <- getLine
  let days = map read (words secondLine) :: [Int]

  print $ solve bowls plates days

import Data.List (foldl')

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

solve :: [Int] -> Int
solve (_:m:k:as) = snd $ foldl' f ((m, k), 0) as
  where f ((b, c), d) 1 | b > 0 = ((b - 1, c), d)
                        | otherwise = ((b, c), d + 1)
        f ((b, c), d) _ | c > 0 = ((b, c - 1), d)
                        | b > 0 = ((b - 1, c), d)
                        | otherwise = ((b, c), d + 1)
solve _ = undefined

module Main  where

data DishType = Flat | Deep deriving (Eq, Show)

main = do
	dishesString <- getLine
	let dishes = map read $ drop 1 $ words dishesString
	foodString <- getLine
	let food = map read $ words foodString
	print $ useDishes (food :: [Int]) (head (dishes :: [Int]), head $ drop 1 (dishes :: [Int]))

useDishes :: Integral a => [a] -> (a, a) -> a
useDishes dishes (deep, flat) = useDishes0 dishes (deep, flat) 0 (deep, flat)

useDishes0 :: Integral a => [a] -> (a, a) -> a -> (a, a) -> a
useDishes0 [] (totalDeep, totalFlat) washes (deep, flat) = washes
useDishes0 (x:xs) (totalDeep, totalFlat) washes (deep, flat)
	| x == 2 && flat > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep, flat-1)
	| x == 2 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
	| x == 2 			 = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washAnyDish (deep, flat) (totalDeep, totalFlat)
	| x == 1 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
	| otherwise 		 = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washADish Deep (deep, flat) (totalDeep, totalFlat)

washAnyDish :: Integral a => (a, a) -> (a, a) -> (a, a)
washAnyDish (deep, flat) (totalDeep, totalFlat)
	| totalDeep > 0  = (deep, flat)
	| totalFlat > 0  = (deep, flat)
	| otherwise = error "no dishes exception, sorry"

washADish :: Integral a => DishType -> (a, a) -> (a, a) -> (a, a)
washADish dishType (deep, flat) (totalDeep, totalFlat)
	| dishType == Deep && totalDeep > 0  = (deep, flat)
	| dishType == Flat && totalFlat > 0  = (deep, flat)
	| otherwise = error "no dishes exception, sorry"

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

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

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

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

main = do
    [n,m,k] <- readInts
    as <- readInts
    print $ solve n m k as

solve n m k as = go m k as
    where
    go _ _ [] = 0
    go 0 _ (1:as) = length as+1
    go m k (1:as) = go (m-1) k as
    go 0 0 (2:as) = length as+1
    go m 0 (2:as) = go (m-1) 0 as
    go m k (2:as) = go m (k-1) as

module Main  where

data DishType = Flat | Deep deriving (Eq, Show)

main = do
    dishesString <- getLine
    let dishes = map read $ drop 1 $ words dishesString
    foodString <- getLine
    let food = map read $ words foodString
    print $ useDishes (food :: [Int]) (head (dishes :: [Int]), head $ drop 1 (dishes :: [Int]))

useDishes :: Integral a => [a] -> (a, a) -> a
useDishes dishes (deep, flat) = useDishes0 dishes (deep, flat) 0 (deep, flat)

useDishes0 :: Integral a => [a] -> (a, a) -> a -> (a, a) -> a
useDishes0 [] (totalDeep, totalFlat) washes (deep, flat) = washes
useDishes0 (x:xs) (totalDeep, totalFlat) washes (deep, flat)
    | x == 2 && flat > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep, flat-1)
    | x == 2 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
    | x == 2             = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washAnyDish (deep, flat) (totalDeep, totalFlat)
    | x == 1 && deep > 0 = useDishes0 xs (totalDeep, totalFlat) washes (deep-1, flat)
    | otherwise          = useDishes0 xs (totalDeep, totalFlat) (washes+1) $ washADish Deep (deep, flat) (totalDeep, totalFlat)

washAnyDish :: Integral a => (a, a) -> (a, a) -> (a, a)
washAnyDish (deep, flat) (totalDeep, totalFlat)
    | totalDeep > 0  = (deep + 1, flat)
    | totalFlat > 0  = (deep, flat + 1)
    | otherwise = error "no dishes exception, sorry"

washADish :: Integral a => DishType -> (a, a) -> (a, a) -> (a, a)
washADish dishType (deep, flat) (totalDeep, totalFlat)
    | dishType == Deep && totalDeep > 0  = (deep + 1, flat)
    | dishType == Flat && totalFlat > 0  = (deep, flat + 1)
    | otherwise = error "no dishes exception, sorry"

import Control.Applicative

main=do
	[n,a,b]<-  map read . words <$> getLine:: IO [Int]
	r<- map read. words <$> getLine ::IO [Int]
	let r1 = length $ filter (==1) r
	let r2 = length $ filter (==2) r
	let r3=  (max (r1-a) 0)
	let r4 = (max (r2-b) 0) - (if a>r1 then a-r1 else 0)
	print $ r3+r4


import Control.Applicative
import Data.List
import Text.Printf
import Data.Ratio
import Data.Array.IO.Safe
import Control.Monad
import Data.Int

main = do
  n <- readLn :: IO Int
  dat <- map ((\[a,b] -> (read a, sort b)) . words) . lines <$> getContents :: IO [(Int64,String)]

  let
    inf = 10^9
    a = minimum $ inf : (map fst . filter ((=="A") . snd) $ dat)
    b = minimum $ inf : (map fst . filter ((=="B") . snd) $ dat)
    c = minimum $ inf : (map fst . filter ((=="C") . snd) $ dat)
    ab = minimum $ inf : (map fst . filter ((=="AB") . snd) $ dat)
    bc = minimum $ inf : (map fst . filter ((=="BC") . snd) $ dat)
    ac = minimum $ inf : (map fst . filter ((=="AC") . snd) $ dat)
    abc = minimum $ inf : (map fst . filter ((=="ABC") . snd) $ dat)

    ans = minimum [abc, a+b+c, ab+(minimum [c,bc,ac]), bc+(minimum [a,ab,ac]), ac+(minimum [b,ab,bc])]

  print $ if ans < inf then ans else -1

import Control.Applicative
import Data.List
import Data.Int

main = do
  n <- readLn :: IO Int
  dat <- map ((\[a,b] -> (read a, sort b)) . words) . lines <$> getContents :: IO [(Int64,String)]

  let
    inf = 10^9
    f str = minimum $ inf : (map fst . filter ((==str) . snd) $ dat)
    a = f "A"
    b = f "B"
    c = f "C"
    ab = f "AB"
    bc = f "BC"
    ac = f "AC"
    abc = f "ABC"

    ans = minimum [abc, a+b+c, ab+(minimum [c,bc,ac]), bc+(minimum [a,ab,ac]), ac+(minimum [b,ab,bc])]

  print $ if ans < inf then ans else -1


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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [n, m] <- ri
    hgts   <- ri
    qs     <- replicateM m ri
    let psumsLR = makePSums [1    ..]           $ hgts
    let psumsRL = makePSums [n,n-1..] . reverse $ hgts
    mapM_ (putStrLn . show . solve (psumsLR,psumsRL)) qs

solve (psN,psR) [s,t] = ans
  where
    ans | (s < t)    = (psN!t) - (psN!s)
        | otherwise  = (psR!t) - (psR!s)
    (!) = (Map.!)
solve _    _     = error "Input error query"

makePSums inds hgts = Map.fromList . zip (inds::[Int]) . scanl (+) 0 $ dmgs
  where
    dmgs = zipWith damage hgts (tail hgts)
    damage a b = max 0 (a - b)

import Data.Array
import Control.Monad (replicateM_)

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

main = getN >>=
       \[n, m] -> getN >>=
       \as -> replicateM_ m $
              pFall (processDamages n as) (processDamages n (reverse as))

processDamages :: Int -> [Int] -> Array Int Int
processDamages n (a:as) = let (_, _, ds) = foldl f (a, 0, [0]) as in
                            listArray (1, n) (reverse ds)
  where f (prevH, prevD, acc) currH = if prevH <= currH
                                      then (currH, prevD, prevD:acc)
                                      else let currD = prevD + prevH - currH in
                                             (currH, currD, currD:acc)

pFall :: Array Int Int -> Array Int Int -> IO ()
-- pFall l r = print l >> print r
pFall l r = let (1, n) = bounds l in
              getN >>=
              \[s, t] -> print $ if s <= t
                                 then (l!t) - (l!s)
                                 else (r!(n-t+1)) - (r!(n-s+1))


pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. 1 + (x - d) `div` 10] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. d] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"

pairUp :: [String] -> [(String, String)]
pairUp [] = []
pairUp (x : y : t) = (x, y) : pairUp t

solve :: Int -> Int -> Bool
solve d x
    | x >= 10 * d = True
    | x == 0      = True
    | x < 0       = False
    | otherwise   = any (solve d) [ x - d - 10 * k | k <- [0 .. 9] ]

process :: Int -> [Int] -> [Bool]
process d = map (solve d)

getInput :: (String, String) -> (Int, [Int])
getInput (s, t) = (d, strToArr t)
    where [_, d] = strToArr s
          strToArr = map (read :: String -> Int) . words

main :: IO ()
main = interact (unlines . map (showBs . uncurry process . getInput) . pairUp . tail . lines)
    where showBs = unlines . map showB
          showB True = "YES"
          showB False = "NO"


f :: [Integer]->Integer

f (x:xs) = f' 0 x xs
  where
    f' n x [] = n
    f' n x (y:ys) | x > y + n = f' (n + (x - n - y)) x ys
    f' n x (y:ys) = f' n (y+n) ys

main = do
  num <- readLn
  nums <- getLine >>= (return.map read.take num.words)
  putStrLn (show (f nums))

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative

readInput :: IO [Integer]
readInput = do
  _ <- B.getLine
  map (fst . fromJust . B.readInteger) . B.words <$> B.getLine

solve :: [Integer] -> Integer
solve xs = sum $ zipWith (\a b -> max 0 (a - b)) xs (tail xs)

main :: IO ()
main = readInput >>= (print . solve)

import Control.Monad (liftM)

solve :: [Integer] -> Integer
solve [_]  =  0
solve (a : b : xs)
  | a <= b  =  solve (b : xs)
  | otherwise  =  (a - b) + solve (b : xs)

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

f :: [Integer] -> Integer
f (x:y:s) = (max 0 (x-y)) + (f$y:s)
f _ = 0
main=interact$show.f.map read.tail.words

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

readInteger s = let Just (n,_) = B.readInteger s in n

main = getLine >> B.getContents >>= print.solve 0.map readInteger.B.words

solve !cnt [] = cnt
solve !cnt [x] = cnt
solve !cnt (x:y:xs)
  | x<=y = solve cnt (y:xs)
  | otherwise = solve (cnt+x-y) (y:xs)

import Control.Monad (liftM)

solve :: [Int] -> Int
solve [_]  =  0
solve (a : b : xs)
  | a <= b  =  solve (b : xs)
  | otherwise  =  (a - b) + solve (b : xs)

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

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as B

readInteger s = let Just (n,_) = B.readInteger s in n

main = getLine >> B.getContents >>= print.solve 0.map readInteger.B.words

solve !cnt [] = cnt
solve !cnt [x] = cnt
solve !cnt (x:y:xs)
  | x<=y = solve cnt (y:xs)
  | otherwise = solve (inc+cnt) gx
   where
     (lx,gx) = span (<x) xs
     inc = (x-) $ minimum $ y:lx


import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (reverse (a:as))++acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
import Debug.Trace

solve :: String -> String -> String
solve a b = solve' a $ reverse $ sort b
    where
      solve'     []      _ = []
      solve'      x     [] = x
      solve' (x:xs) (y:ys)
          | x < y     = y : solve' xs ys
          | otherwise = x : solve' xs (y:ys)

main = do
  a <- getLine
  s <- getLine
  putStrLn $ solve a s

import List

solve :: String -> String -> IO ()
solve a s  =  solve' a (reverse $ sort s)
  where
    solve' :: String -> String -> IO ()
    solve' a []  =  putStrLn a
    solve' a (x:xs)
      | null t  =  putStrLn a
      | otherwise  =  putStr h >> putStr [x] >> solve' (tail t) xs
      where
        (h, t)  =  span (>= x) a

main :: IO ()
main  =  do
    a <- getLine
    s <- getLine
    solve a s

import List
g(a:b)(c:d)|c>a=c:g b d|1>0=a:g b(c:d)
g l _=l
s[a,b]=g a(reverse$sort b)
main=interact$s.words

import Data.List

main::IO ()
main = do
  cs <- getContents
  (putStr .solve.parseIn)  cs

parseIn::String->([Int],[Int])
parseIn s = (num,(reverse $ sort se))
    where
      [num,se] = map (\x -> map (\y->read [y]::Int) x) $ lines s

solve::([Int],[Int])->String
solve = concat . map show . solveS

solveS::([Int],[Int])->[Int]
solveS ([],_) = []
solveS (a,[])=a
solveS ((a:as),(b:bs))
    | (a>=b) = a:solveS(as,(b:bs))
    | otherwise = b:solveS(as,bs)

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

solve orig repl =
    reverse $ loop orig repl []

loop [] repl acc = acc
loop (o:os) repl acc =
    if getMax repl > o
    then loop os (decMax repl) ((getMax repl):acc)
    else loop os repl (o:acc)

getMax mset
    | M.null mset  = 0
    | otherwise    = fst $ M.findMax mset

decMax :: M.Map k Int -> M.Map k Int
decMax =
    M.updateMax (\x -> if x > 1 then Just (x-1) else Nothing)

makeMap l = M.fromList [(head x, length x) | x <- (group $ sort l)]

prepare = map intToDigit

main = do
  orig <- (getLine >>= (return . map digitToInt))
  repl <- (getLine >>= (return . map digitToInt))
  putStrLn . prepare $ solve orig (makeMap repl)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (reverse acc)++(a:as)
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n >= a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.show.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g _ [] acc = acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (a:as)++acc
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

import Data.List
main=putStrLn.slv.(take 2).lines=<<getContents
f :: Char -> Int;f '0' = 0; f '1'=1; f '2' = 2; f '3'=3; f '4' = 4; f '5'=5; f '6' = 6; f '7'=7; f '8' = 8; f '9'=9;
slv [s1,s2] = dropWhile (=='0') $ concat $ map show $ reverse $ g ns1 ns2 []
    where
        ns1 = map f s1
        ns2 = reverse.sort $ map f s2

g [] _ acc = acc
g (a:as) [] acc = (a:as)++(reverse acc)
g (a:as) (n:ns) acc
    | (n > a) = g as ns (n:acc)
    | True = g as (n:ns) (a:acc)

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

solve orig repl =
    reverse $ loop orig repl []

loop [] repl acc = acc
loop (o:os) repl acc =
    if getMax repl > o
    then loop os (decMax repl) ((getMax repl):acc)
    else loop os repl (o:acc)

getMax mset =
    fst $ M.findMax mset

decMax :: M.Map k Int -> M.Map k Int
decMax =
    M.updateMax (\x -> if x > 1 then Just (x-1) else Nothing)

makeMap l = M.fromList [(head x, length x) | x <- (group $ sort l)]

main = do
  orig <- (getLine >>= (return . map digitToInt))
  repl <- (getLine >>= (return . map digitToInt))
  print $ solve orig (makeMap repl)


module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        print $ f n

f :: Int -> Int
f n = n `div` (head $ filter (\x -> n `mod` x == 0) $ drop 1 $ scanl1 (+) $ takeWhile (<=n) $ iterate (*2) 1)

solve :: Integer -> Integer -> Integer
solve n k = if mod n (2^k - 1) == 0 then div n (2^k - 1)
                                    else solve n (k+1)

parse :: String -> String
parse raw = show $ solve n 2
  where n = read raw :: Integer

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

import Control.Monad

main =
    interact $
    unlines .
    map (show . (\n -> div n $ head $ filter ((==) 0 . mod n) $ subtract 1 . (^) 2 <$> [2 ..]) . read) . tail . words

solveFor :: Int -> Integer -> Integer
solveFor k n | n `mod` (2 ^ k - 1) == 0 = n `div` (2 ^ k - 1)
             | otherwise                = solveFor (k + 1) n

solveCase :: IO ()
solveCase = do
  nLine <- getLine
  let n   = read nLine :: Integer
  let res = solveFor 2 n
  print res

main :: IO ()
main = do
  tline <- getLine
  let ts = read tline :: Int
  sequence_ [ solveCase | _ <- [1 .. ts] ]

import Control.Monad

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

routine :: IO ()
routine = do
  n <- readLn
  print $ solve n

solve :: Int -> Int
solve n = n `div ` head filtered
  where
    powers = 4: map (*2) powers
    powers' = map (\x -> x-1) powers
    filtered = filter (\x -> n `mod` x ==0) powers'

import Control.Monad (replicateM_)

main :: IO ()
main = readLn >>= flip replicateM_ solveIO

solveIO :: IO ()
solveIO = readLn >>= print . f

f :: Integer -> Integer
f n = fst . head . filter (\(_,c)->c==0) $ [(n `div` (2^k-1), n `mod` (2^k-1))  | k <- [2..]]

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

a= [2^i-1|i<-[2..35]]

onecase = do
	c<-  read <$> getLine ::IO Int
	let x = head $ filter (\z-> mod c z==0)  a
	print $ div c x

main = do

	n<-  read <$> getLine ::IO Int
	replicateM_ n onecase

process :: Int -> Int
process n = f 3
    where
        f t
            | n `mod` t == 0 = n `div` t
            | otherwise = f (2*t+1)

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    print $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Control.Monad

main =
    interact $
    unlines .
    map (show . (\n -> div n $ head $ filter ((==) 0 . mod n) $ subtract 1 . (^) 2 <$> [2 ..]) . read) . words


{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solve [] used nth = -1
solve (a:as) used nth
  | check == False = solve as newUsed (nth + 1)
  | otherwise = nth
  where check = Set.member a used
        newUsed = Set.insert a used

read_ints :: Int -> IO [Int]
read_ints 0 = return []
read_ints n = do
  a <- getint
  nxt <- read_ints (n - 1)
  return (a:nxt)

main = do
  [p, n] <- getints
  as <- map (`mod` p) <$> read_ints n
  putStrLn (show $ solve as Set.empty 1)

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

f :: Int -> [Int] -> Int
f p xs = if length a > 0
         then length xs - fromJust (elemIndex (fst $ last a) xs)
         else (-1)
    where
        h x = mod x p
        a = filter (\p -> g (fst p) (snd p)) $ zip xs (tail $ tails xs)
        g :: Int -> [Int] -> Bool
        g y ys = any (h y ==) $ map h ys

main = do
    [p, n] <- fmap (map read . words) getLine :: IO [Int]
    xs <- replicateM n readLn
    print $ f p $ reverse xs

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

solve :: [Int] -> Int
solve (p:_:x) = solve' [] 1 x
    where solve' :: [Int] -> Int -> [Int] -> Int
          solve' _ _ []     = -1
          solve' h i (x:xs) | elem (mod x p) h = i
                            | otherwise = solve' ((mod x p):h) (i + 1) xs

readInt x = read x :: Int
main = interact $ show . solve . (map readInt) . words

go os [] = -1
go os (x:xs) = if elem x os then 1 else p $ go (x:os) xs
	where p i = if i < 0 then i else i+1

solve (p:n:xs) = go [] $ map (`mod` p) xs

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

main = do
    [p,n] <- map (read :: String -> Int) . words <$> getLine
    xs <- replicateM n (readLn :: IO Int)
    let (as,b) = mapAccumL (\a b -> (((b`mod`p):head a):a,b`mod`p)) [[]] xs
        m = length $ takeWhile  (uncurry notElem) $ zip b $ reverse as
    print $ if m == n then -1 else m+1

import Data.List

f::Int->[Int]->[Int]->Int
f _ [] es=(-1)
f p (n:ns) es
    |(n `mod` p) `elem` es=(length es)+1
    |otherwise=f p ns ((n `mod` p):es)

main =do
      e<-getLine
      es<-getContents
      let (p:n:[])=map read (words e)::[Int]
          xs=map read (lines es)::[Int]
      print $ f p xs []

import Text.Printf
import Data.List
import Data.Functor
import Data.Function
import Control.Monad
import Data.Maybe
import Data.Foldable (foldr', foldr1)
import Prelude
import Control.Monad.State.Strict
import qualified Data.ByteString.Char8 as B8
import qualified Data.Map.Strict as MapS
import qualified Data.Set as Set

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

solve :: Int -> [Int] -> State (Set.Set Int) Int
solve p queries = do
    processedQueries <- forM queries $ \query -> do
        let value = query `mod` p
        has <- gets $ Set.member value
        if has
            then return False
            else (modify $ Set.insert value) >> return True
    let queryId = length . takeWhile id $ processedQueries
    if queryId == (length queries) then return (-1) else return (queryId + 1)

main :: IO ()
main = do
    [p, n] <- (map readB8Int) <$> B8.words <$> B8.getLine
    queries <- replicateM n $ readB8Int <$> B8.getLine
    let answer = (flip evalState) Set.empty $ solve p queries
    printf "%d\n" answer

import Control.Applicative
import Data.Set

solve :: Int -> [Int] -> Set Int -> Int
solve p (x:rst) set =
  if (x `mod` p) `member` set then 1 + (size set) else solve p rst (insert (x `mod` p) set)
solve _ [] _ = -1

main :: IO ()
main = do
  [p, _] <- Prelude.map read . words <$> getLine
  x <- Prelude.map read . lines <$> getContents
  putStrLn $ show $ solve p x Data.Set.empty

import Control.Applicative ((<$>), (<*>), (<|>))
import qualified Data.Set as S
import Data.Maybe (fromMaybe, listToMaybe)
import Data.List (mapAccumL)

main :: IO ()
main = solve <$> (head . map read . words <$> getLine) <*> (map read . words <$> getContents) >>= print

solve :: Int -> [Int] -> Int
solve p = fromMaybe (-1) . foldl (<|>) Nothing . snd . mapAccumL f S.empty . zip [1..] . map (`mod` p)
  where f s (i, x) = (S.insert x s, listToMaybe [ i | S.member x s ])

import Control.Applicative ((<$>), (<*>), (<|>))
import Data.List (mapAccumL)
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = solve <$> (head . map read . words <$> getLine) <*> (map read . words <$> getContents) >>= print

solve :: Int -> [Int] -> Int
solve p = fromMaybe (-1) . foldl (<|>) Nothing . snd . mapAccumL f [] . zip [1..] . map (`mod` p)
  where f xs (i, x) = (x:xs, listToMaybe [ i | x `elem` xs ])

main=interact$show.f.map read.words
f(p:n:xs)=go [] 1 xs
   where
     go used i (x:xs)
       | h <- mod x p, elem h used = i
       | otherwise = go (mod x p:used) (i+1) xs
     go _ _ _ = -1

readLi :: Int -> IO [Int]
readLi 0 = return []
readLi n = do
	x <- fmap read getLine :: IO Int
	y <- readLi (n-1)
	return (x:y)

isTrue :: [Bool] -> Int -> Bool
isTrue (x:xs) 0 = x
isTrue (x:xs) n = isTrue xs (n-1)

putTrue :: [Bool] -> Int -> [Bool]
putTrue (x:xs) 0 = (True:xs)
putTrue (x:xs) n = x:putTrue xs (n-1)

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
	let y = x `mod` length al
	in if isTrue al y
		then pos + 1
		else firstEq xs (putTrue al y) (pos + 1)

main = do
	x <- fmap (map read . words) getLine :: IO [Int]
	let p = head x
	let n = last x
	l <- readLi n
	let al = [False | _ <- [1..p]]
	print $ firstEq l al 0

import Control.Applicative

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
    let y = x `mod` length al
    in if al!!y
        then pos + 1
        else firstEq xs (take y al ++ [True] ++ drop (y+1) al) (pos + 1)

main = do
    p <- head . map read . words <$> getLine
    l <- map read . lines <$> getContents
    print $ firstEq l [False | x <- [1..p]] 0

firstEq :: [Int] -> [Bool] -> Int -> Int
firstEq [] _ _ = -1
firstEq (x:xs) al pos =
	let y = x `mod` length al
	in if al!!y
		then pos + 1
		else firstEq xs (take y al ++ [True] ++ drop (y+1) al) (pos + 1)

main = do
	x <- fmap (map read . words) getLine :: IO [Int]
	let p = head x
	let n = last x
	l <- fmap (map read . lines) getContents :: IO [Int]
	let al = [False | _ <- [1..p]]
	print $ firstEq l al 0

import qualified Data.Set as Set
c=go Set.empty where
  go s [] = -1
  go s (x : xs) = if Set.member x s then 1 else case go (Set.insert x s) xs of
     -1 -> -1
     n -> n + 1
s(p:_:n)=c$map(`mod`p)n
main=interact$show.s.map read.words

import Data.List
import Data.Function
import qualified Data.IntSet as IS
import Text.Printf (printf)
import Control.Monad

solve :: Int -> [Int] -> Int
solve p xs = go IS.empty 1 xs
  where
    hash x = x `mod` p
    go _ _ [] = -1
    go seen i (x : xs)
      | IS.member h seen = i
      | otherwise = go (IS.insert h seen) (i + 1) xs
      where h = hash x

main :: IO ()
main = do
  [p, n] <- fmap (map read . words) getLine :: IO [Int]
  xs <- replicateM n readLn
  print $ solve p xs

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Set as S

process n b x [] = -1
process n b x (c:cs)  	| S.member (mod c b) x = n
			| otherwise = process (n+1) b (S.insert (mod c b) x) cs

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		c<-map read <$> replicateM b getLine ::IO [Int]
		print $ process  1 a S.empty c

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

getnums :: Num a => IO [a]
getnums = map (fromIntegral . fst) . mapMaybe BS.readInteger . BS.words <$> BS.getLine

getstr = getLine

solve [] used nth = -1
solve (a:as) used nth
  | check == False = solve as newUsed (nth + 1)
  | otherwise = nth
  where check = Set.member a used
        newUsed = Set.insert a used

read_ints :: Int -> IO [Int]
read_ints 0 = return []
read_ints n = do
  a <- getint
  nxt <- read_ints (n - 1)
  return (a:nxt)

main = do
  [p, n] <- getints
  as <- read_ints n
  putStrLn (show $ solve as Set.empty 0)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.Set as S

process n b x [] = -1
process n b x (c:cs)  	| S.member (mod c b) x = n
			| otherwise = process (n+1) b (S.insert (mod c b) x) cs

main = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		c<-map read <$> replicateM b getLine ::IO [Int]
		print $ process  1 b S.empty c


import Data.List
process :: [Int] -> ([Int], [Int]) -> Maybe ([Int], [Int])
process (a:b:c:d) (x, y)
  | ((a == b) && (b == c)) = Nothing
  | (a == b) = process (c:d) (a:x, b:y)
  | otherwise = process (b:c:d) (a:x, y)
process [a, b] (x, y) = Just (a:x, b:y)
process [a] (x, y) = Just (a:x, y)
process [] (x, y) = Just (x, y)

output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ reverse a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ b
main = do
  _ <- getLine
  line <- getLine
  let
    a = sort $ map read $ words $ line
  output $ process a ([], [])

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

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

ru, ri :: C.ByteString -> Int

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

sYes = byteString $ C.pack "YES\n"
sNo = byteString $ C.pack "NO\n"

out l = intDec (length l) <> char7 '\n' <> (mconcat $ (intersperse (char7 ' ') l')) <> char7 '\n'
  where
    l' = map (\i -> intDec (fst i) ) l

solve :: [Int] -> Builder
solve (n:a) = if (maximum $ elems c) > 2 then sNo else res
  where
    !m = maximum a
    c = runSTUArray $ do
      d <- newArray (0, m) 0 :: ST s (STUArray s Int Int32)
      forM a $ \j -> readArray d j >>= ((writeArray d j) . succ)
      return d
    res = sYes <> (out s1) <> out (reverse s2)
    s1 = filter ( ( >= 1) . snd ) $ assocs c
    s2 = filter ( ( == 2) . snd ) $ assocs c

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

import Data.Array.Unboxed
hist :: (Int, Int) -> [Int] -> UArray Int Int
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i <- is, inRange bnds i]
process c (x, y) 0
  | (c!0) > 2 = Nothing
  | (c!0) == 2 = Just (0:x, 0:y)
  | (c!0) == 1 = Just (0:x, y)
  | otherwise = Just (x, y)
process c (x, y) i
  | (c!i) > 2 = Nothing
  | (c!i) == 2 = process c (i:x, i:y) (i - 1)
  | (c!i) == 1 = process c (i:x, y) (i - 1)
  | otherwise = process c (x, y) (i - 1)
output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ reverse b
main = do
  _ <- getLine
  line <- getLine
  let
    a = map read $ words $ line
    c = hist (0, 200005) a
  output $ process c ([], []) 200005

import Data.Array.Unboxed
hist :: (Int, Int) -> [Int] -> UArray Int Int
hist bnds is = accumArray (+) 0 bnds [(i, 1) | i <- is, inRange bnds i]
process c (x, y) 0
  | (c!0) > 2 = Nothing
  | (c!0) == 2 = Just (0:x, 0:y)
  | (c!0) == 1 = Just (0:x, y)
  | otherwise = Just (x, y)
process c (x, y) i
  | (c!i) > 2 = Nothing
  | (c!i) == 2 = process c (i:x, i:y) (i - 1)
  | (c!i) == 1 = process c (i:x, y) (i - 1)
  | otherwise = process c (x, y) (i - 1)
output a = case a of
  Nothing -> putStrLn "NO"
  Just (a, b) -> do
    putStrLn "YES"
    putStrLn $ show $ length a
    putStrLn $ unwords $ map show $ reverse a
    putStrLn $ show $ length b
    putStrLn $ unwords $ map show $ b
main = do
  _ <- getLine
  line <- getLine
  let
    a = map read $ words $ line
    c = hist (0, 200005) a
  output $ process c ([], []) 200005


import qualified Data.Set as Set

main = interact $ show.g.parse.lines

parse xs = map (\x -> (map read (words x)) :: [Integer]) xs
g xs
  | (last (head xs)) == 0 = (-1)
  | otherwise = f (init ys) (Set.fromList (last ys)) infinity
  where ys = tail xs

infinity = (read "Infinity")::Double

f [] ys cost
  | cost == infinity = (-1)
  | otherwise = floor cost
f (x:xs) ys cost
  | (a && (not b)) || ((not a) && b) = f xs ys (min cost c)
  | otherwise = f xs ys cost
  where a = Set.member (head x) ys
        b = Set.member (head (tail x)) ys
        c = fromIntegral (last x)

{-# OPTIONS_GHC -O #-}
import Data.List (foldl')
import Control.Monad
import Data.Array

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

inf = truncate 2e9 :: Int

main = do
    [n,m,k] <- readIntList
    a' <- forM [1..m] $ \_ -> do
        [u,v,l] <- readIntList
        return [(u,(v,l)),(v,(u,l))]
    let a = accumArray (\ls pr -> pr:ls) [] (1,n) $ concat a'
    if k == 0
        then print (-1)
        else do
            st <- readIntList
            let storage = accumArray (+) 0 (1,n) $ zip st [1,1..]
                solve x = foldl'(\acc (ch,len) -> if (storage!ch /= 1 && len < acc) then len else acc) (inf) (a!x)
                ans = minimum . map solve $ st
            if ans == inf then print (-1) else print ans

{-# OPTIONS_GHC -O #-}
import Data.List (foldl')
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B

readIntList = fmap ((map fn) . B.words) B.getLine :: IO [Int]
 where fn x = let Just (y,_) = B.readInt x in y

inf = truncate 2e9 :: Int

main = do
    [n,m,k] <- readIntList
    a' <- forM [1..m] $ \_ -> do
        [u,v,l] <- readIntList
        return [(u,(v,l)),(v,(u,l))]
    let a = accumArray (\ls pr -> pr:ls) [] (1,n) $ concat a'
    if k == 0
        then print (-1)
        else do
            st <- readIntList
            let storage = accumArray (+) 0 (1,n) $ zip st [1,1..]
                solve x = foldl'(\acc (ch,len) -> if (storage!ch /= 1 && len < acc) then len else acc) (inf) (a!x)
                ans = minimum . map solve $ st
            if ans == inf then print (-1) else print ans

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.Array (accumArray, (!))
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Maybe (fromJust)
import Data.List (minimumBy)
import Data.Ord (comparing)
import Prelude hiding (words, lines, getLine, getContents)

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

main = do
  [n, m, k] <- readInts
  es <- replicateM m readInts

  as <- if k > 0 then readInts else return []

  let
    as' = accumArray (flip const) False (1, n) $ zip as (repeat True)

    cs = filter f es
      where
        f [u, v, _] = as'!u && (not $ as'!v) || as'!v && (not $ as'!u)

    [_, _, r] = minimumBy (comparing (\[_, _, w] -> w)) cs

  if null cs
     then print $ -1
     else print r

import Control.Applicative
import Control.Monad
import Data.Set (Set, member, fromList)

main = do
	[n, m, k] <- map read . words <$> getLine :: IO [Int]
	g <- map (map read . words) <$> replicateM m getLine :: IO [[Int]]

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		let ls = [l | [u, v, l] <- g, xor (u `member` a) (v `member` a)]
		print $ if null ls then -1 else minimum ls

xor a b = (not a && b) || (a && not b)

import Control.Applicative
import Control.Monad
import Data.Array.IO.Safe
import qualified Data.Set

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	[n, m, k] <- map read . words <$> getLine :: IO [Int]
	graph <- newArray (1, n) [] :: IO (IOArray Int [(Int, Int)])

	forM_ [1..m] $ \_ -> do
		[u, v, l] <- map read . words <$> getLine :: IO	[Int]
		modifyArray graph u ((v, l):)
		modifyArray graph v ((u, l):)

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- Data.Set.fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		ls <- concat <$> (forM [1..n] $ \u -> do
			gu <- readArray graph u
			return [l | (v, l) <- gu, u `Data.Set.member` a, v `Data.Set.notMember` a])

		print $ if null ls then -1 else minimum ls

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

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

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

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

  storageCity :: Int -> IO [Int]
  storageCity 0 = return []
  storageCity _ = getLine >>= return . (map readInt) . words

  eelem :: Int -> S.Set Int -> Bool
  eelem y xs =
    let found = y `S.lookupIndex` xs
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  isStoragePath :: S.Set Int -> [Int] -> Bool
  isStoragePath storages path =
      let checkPath1 = not $ (path !! 1) `eelem` storages
          checkPath2 = not $ (path !! 0) `eelem` storages
          path1isStorage = (path !! 0) `eelem` storages
          path2isStorage = (path !! 1) `eelem` storages
          in (path1isStorage && (not path2isStorage)) || (path2isStorage && (not path1isStorage))

  getMinimumPrice :: [[Int]] -> Int
  getMinimumPrice [] = -1
  getMinimumPrice storagePath = minimum $ (map (!!2)) storagePath

  main :: IO()
  main = do
    [n,m,k] <- getLine >>= return . (map readInt) . words
    paths <- readMultilineInput m (return . (map readInt)  . words)
    storageList <- storageCity k
    let storages = S.fromList storageList
        storagePath = filter (isStoragePath storages) paths
        minimumPrice = getMinimumPrice storagePath
    putStrLn $ show minimumPrice

import Prelude hiding (getLine, lookup)
import Data.List (unfoldr)
import Control.Applicative ((<$>), (<*>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

import Control.Monad (replicateM)
import Data.Set (Set, empty, fromList, member)

solve :: [(Int, Int, Int)] -> Set Int -> Int
solve e s = if out /= maxBound then out else -1
    where
    out = foldr go maxBound e :: Int
    go :: (Int, Int, Int) -> Int -> Int
    go (u, v, c) acc
        | acc < c + 1  = acc
        | u `member` s = if v `member` s then acc else c
        | otherwise    = if v `member` s then c else acc

parse :: ByteString -> [Int]
parse = unfoldr (B.readInt . B.dropWhile (== ' '))

main :: IO ()
main = do
    _:m:k:_ <- parse <$> getLine
    e <- map ((\[u, v, c] -> (u, v, c)) . parse) <$> replicateM m getLine
    if k /= 0 then getLine >>= print . solve e . fromList . parse
    else print $ solve e empty

module Main where

import Control.Monad
import Prelude
import Text.Printf
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Set as Set

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                                   Just (x, _) -> (x, ss)
                                   Nothing -> error $ "Can't parse Int:" ++ (show s)

infinity = 10000000000 :: Int

findBest :: [(Int, Int, Int)] -> (Set.Set Int) -> Int
findBest [] s = infinity
findBest ((a, b, l):es) s | (Set.member a s) /= (Set.member b s) = l `min` v
                          | otherwise                            = v
                          where v = findBest es s

solve :: Tokenizer Int
solve = do
    n <- nextInt
    m <- nextInt
    k <- nextInt
    edges <- replicateM m $ do
        a <- nextInt
        b <- nextInt
        l <- nextInt
        return (a, b, l)
    as <- replicateM k $ do
        nextInt
    let bs = Set.fromList as
    let res = findBest edges bs
    if res >= infinity then return (-1)
    else return (res)

main = do
    contents <- L.getContents
    let ans = evalState solve (L.words contents)
    print ans

import Data.Maybe
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map.Strict as Map
import qualified Data.IntSet as Set

getInt = read `fmap` getLine :: IO Int
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

type Visited = Map.Map Int Bool
type Links = Map.Map Int [(Int,Int)] -- (dest, weight)

main = do
    [n,m,k] <- getInts
    edges <- replicateM m getInts   -- m numbers of [u,v,l]
    if k == 0 || k == n
    then print (-1)
    else do
        storages <- getInts             -- length: k
        let links = foldl mkLink Map.empty edges :: Links
        let storageCities = Set.fromList storages
        let inf = 10^9 + 7
        -- for each stroage, find the nearest empty city
        let soln = foldl findNearest inf storages where
            findNearest minCost storage = if costs == [] then minCost else min (minimum costs) minCost where
                costs = (map snd . filter notStorage) (neighbors storage)
                neighbors storage = if storage `Map.member` links then links Map.! storage else []
                notStorage (city,len) = city `Set.notMember` storageCities
        if soln == inf
        then print (-1)
        else print soln

mkLink links [u,v,l] = links2 where
    links1 = Map.insertWith (++) u [(v,l)] links
    links2 = Map.insertWith (++) v [(u,l)] links1

import qualified Data.Set as Set

main = interact $ show.g.parse.tail.lines

parse xs = map (\x -> (map read (words x)) :: [Integer]) xs
g xs = f (init xs) (Set.fromList (last xs)) infinity

infinity = (read "Infinity")::Double

f [] ys cost
  | cost == infinity = (-1)
  | otherwise = floor cost
f (x:xs) ys cost
  | (a && (not b)) || ((not a) && b) = f xs ys (min cost c)
  | otherwise = f xs ys cost
  where a = Set.member (head x) ys
        b = Set.member (head (tail x)) ys
        c = fromIntegral (last x)

import Control.Applicative
import Control.Monad
import Data.Set (Set, member, notMember, fromList)

main = do
	[n, m, k] <- map read . words <$> getLine :: IO [Int]
	g <- map (map read . words) <$> replicateM m getLine :: IO [[Int]]

	when (k == 0) $ putStrLn "-1"
	when (k /= 0) $ do
		a <- fromList . map read . words <$> getLine :: IO (Data.Set.Set Int)

		let ls = [l | [u, v, l] <- g, u `member` a, v `notMember` a]
		print $ if null ls then -1 else minimum ls


import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Integer

solve :: Long -> Long -> Long -> Long -> Long
solve a b c d
    | a <= b    = b
    | otherwise =
        case solve' (a-b) c d of
            Nothing -> -1
            Just ans -> b+ans

ceilDiv a b
    | a `mod` b == 0    = a `div` b
    | otherwise         = 1 + (a `div` b)

solve' :: Long -> Long -> Long -> Maybe Long
solve' a c d
    | d >= c    = Nothing
    | otherwise = Just $ c * ceilDiv a (c-d)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (a:b:c:d:_) <- readWords
    print $ solve a b c d
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine

main = interact $ f . map (map read) . map words . tail . lines

g (a:b:c:d:_)
  | b >= a = b
  | d >= c = -1
  | otherwise = b + (c*rans)
  where i = (a - b)
        interv = c-d
        ans = quot i interv
        r = rem i interv
        rans = if r==0 then ans else ans+1

f xs = unlines (map show (map g xs))

import Data.List

solve :: String -> String
solve s = intercalate "\n" $ map show $ solve' $ map read $ drop 1 $ words s

solve' :: [Integer] -> [Integer]
solve' (a:b:c:d:s) = (solve'' a b c d) : (solve' s)
solve' [] = []

solve'' :: Integer -> Integer -> Integer -> Integer -> Integer
solve'' a b c d =
  if a <= b
    then b
    else
     if restPerWake > 0
      then ((a - b + restPerWake - 1) `div` restPerWake) * c + b
      else -1
  where
    restPerWake = c - d

main :: IO ()
main = interact solve

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

onecase = do
		[a,b,c,d]<-map read <$> words <$> getLine ::IO [Integer]
		print $ if a <=b then b
				 else if d>=c then (-1)
				      else b+ c*((div (a-b) (c-d))+if mod (a-b) (c-d) >0 then 1 else 0)

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

import Control.Monad

-- parse :: [String] -> [[Integer]]
-- parse = map (\l -> map read . words $ l)

solve :: [Integer]->Integer
solve (a:b:c:d:[])
  | a<=b = b
  | c<=d = -1
  | otherwise = b + c*(div' needSleep timeAsleep)
    where needSleep = (a-b)
          timeAsleep = (c-d)

div' :: Integer -> Integer -> Integer
div' a b
  | a `mod` b == 0 = div a b
  | otherwise = 1+(div a b)

testCase :: Int -> IO ()
testCase 0 = return ()
testCase t = do
  test <- getLine
  putStrLn . show . solve . map read . words $ test
  testCase (t-1)

main :: IO ()
main = do
  n <- getLine
  testCase . read $ n
  --content <- replicateM (read n :: Int) getLine
  -- putStrLn . unlines . map (show . solve) . parse $ content

main = interact $ f . map (map read) . map words . tail . lines

g (a:b:c:d:_)
  | b > a = b
  | d >= c = -1
  | otherwise = b + (c*rans)
  where i = (a - b)
        interv = c-d
        ans = quot i interv
        r = rem i interv
        rans = if r==0 then ans else ans+1

f xs = unlines (map show (map g xs))

import Data.List

solve :: String -> String
solve s = intercalate "\n" $ map show $ solve' $ map read $ drop 1 $ words s

solve' :: [Int] -> [Int]
solve' (a:b:c:d:s) = (solve'' a b c d) : (solve' s)
solve' [] = []

solve'' :: Int -> Int -> Int -> Int -> Int
solve'' a b c d =
  if a <= b
    then b
    else
     if restPerWake > 0
      then ((a - b + restPerWake - 1) `div` restPerWake) * c + b
      else -1
  where
    restPerWake = c - d

main :: IO ()
main = interact solve

import qualified Data.List as L
import qualified Data.Map as M
import Data.Map (Map)
import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntSet as IS
import Data.IntSet (IntSet)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)

type Long = Int

solve :: Long -> Long -> Long -> Long -> Long
solve a b c d
    | a <= b    = b
    | otherwise =
        case solve' (a-b) c d of
            Nothing -> -1
            Just ans -> b+ans

ceilDiv a b
    | a `mod` b == 0    = a `div` b
    | otherwise         = 1 + (a `div` b)

solve' :: Long -> Long -> Long -> Maybe Long
solve' a c d
    | d >= c    = Nothing
    | otherwise = Just $ c * ceilDiv a (c-d)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (a:b:c:d:_) <- readWords
    print $ solve a b c d
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readWords
    testCases t

readWords :: (Read a) => IO [a]
readWords = map read . words <$> getLine


import Control.Arrow

main = do
  [n, m] <- fmap (map read . words) getLine
  s <- getLine
  let (x, y) = gao m s
  print x
  putStrLn y

gao 2 s = min (go s $ cycle "AB") (go s $ cycle "BA")
  where
    go a b = (length $ filter id $ zipWith (/=) a b, take (length a) b)

gao _ s = go s
  where
    go (x:y:z)
      | x == y    = first succ $ second ([x,y']++) $ go z
      | otherwise = second (x:) $ go (y:z)
      where
        z' = if null z then x else head z
        y' = head $ filter (`notElem`[x,z']) "ABC"
    go s = (0, s)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char

{-computeColor colour1 colour2 numberOfColours =
      chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
 -}

computeColour colour1 colour2 numberOfColours =
  let
       newColour = chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
  in
       if (newColour /= colour2) then newColour
       else chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 2) numberOfColours))

generateTwoColourStripes stripeLength =
   let generateTwoColourStripes_aux strpLen 'A' result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'B' ('A' : result)
       generateTwoColourStripes_aux strpLen _ result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'A' ('B' : result)
   in generateTwoColourStripes_aux stripeLength 'A' []

solveTwo stripe stripeLength =
  let (startingWithA,startingWithB) = generateTwoColourStripes stripeLength
      computeChanges [] _ numOfChanges = numOfChanges
      computeChanges (h1 : t1) (h2 : t2) numOfChanges =
              if (h1 == h2) then computeChanges t1 t2 numOfChanges
              else computeChanges t1 t2 (numOfChanges+1)
  in
     let numOfChangesStartingWith_A = computeChanges stripe startingWithA 0
         numOfChangesStartingWith_B = computeChanges stripe startingWithB 0
     in
         if (numOfChangesStartingWith_A < numOfChangesStartingWith_B) then
            (numOfChangesStartingWith_A,startingWithA)
         else
             (numOfChangesStartingWith_B,startingWithB)

solveMany stripe numberOfColours =
  let solve_aux [] numberOfchanges result = (numberOfchanges, (reverse result))
      solve_aux (h : rest) numberOfchanges result =
	    if ((head result) == h) then
                 if (rest == []) then
                       solve_aux rest (numberOfchanges+1) ((computeColour h h numberOfColours) : result)
                 else
                       solve_aux rest (numberOfchanges+1) ((computeColour h (head rest) numberOfColours) : result)
            else  solve_aux rest numberOfchanges (h : result)
  in
      solve_aux (tail stripe) 0 [(head stripe)]

solve stripe numberOfColours stripeLength =
   if (numberOfColours > 2) then solveMany stripe numberOfColours
   else solveTwo stripe stripeLength

main = do
  all <- getContents
  let (sl : nc : stripe : ignore) = words all
  let stringLength = ((read sl) :: Int)
  let numberOfColours = ((read nc) :: Int)
  let (numberOfChanges,solution) = solve stripe numberOfColours stringLength
  print numberOfChanges
  putStrLn solution
{-  let (startingWithA,startingWithB) = generateTwoColourStripes 10
  print startingWithA
  print startingWithB
  print stringLength
  print numberOfColours
  print stripe-}

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Char

{-computeColor colour1 colour2 numberOfColours =
      chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
 -}

computeColour colour1 colour2 numberOfColours =
  let
       newColour = chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 1) numberOfColours))
  in
       if (newColour /= colour2) then newColour
       else chr ((ord 'A') + (mod ((ord colour1) -(ord 'A') + 2) numberOfColours))

generateTwoColourStripes stripeLength =
   let generateTwoColourStripes_aux strpLen 'A' result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'B' ('A' : result)
       generateTwoColourStripes_aux strpLen _ result =
          if (strpLen == 0) then ((reverse result),('B' : (reverse (tail result))))
          else generateTwoColourStripes_aux (strpLen-1) 'A' ('B' : result)
   in generateTwoColourStripes_aux stripeLength 'A' []

solveTwo stripe stripeLength =
  let (startingWithA,startingWithB) = generateTwoColourStripes stripeLength
      computeChanges [] _ numOfChanges = numOfChanges
      computeChanges (h1 : t1) (h2 : t2) numOfChanges =
              if (h1 == h2) then computeChanges t1 t2 numOfChanges
              else computeChanges t1 t2 (numOfChanges+1)
  in
     let numOfChangesStartingWith_A = computeChanges stripe startingWithA 0
         numOfChangesStartingWith_B = computeChanges stripe startingWithB 0
     in
         if (numOfChangesStartingWith_A < numOfChangesStartingWith_B) then
            (numOfChangesStartingWith_A,startingWithA)
         else
             (numOfChangesStartingWith_B,startingWithB)

solveMany stripe numberOfColours =
  let solve_aux [] numberOfchanges result = (numberOfchanges, (reverse result))
      solve_aux (h : rest) numberOfchanges result =
	    if ((head result) == h) then
                 if (rest == []) then
                       solve_aux rest (numberOfchanges+1) ((computeColour h h numberOfColours) : result)
                 else
                       solve_aux rest (numberOfchanges+1) ((computeColour h (head rest) numberOfColours) : result)
            else  solve_aux rest numberOfchanges (h : result)
  in
      solve_aux (tail stripe) 0 [(head stripe)]

solve stripe numberOfColours stripeLength =
   if (numberOfColours > 2) then solveMany stripe numberOfColours
   else solveTwo stripe stripeLength

main = do
  all <- getContents
  let (sl : nc : stripe : ignore) = words all
  let stringLength = ((read sl) :: Int)
  let numberOfColours = ((read nc) :: Int)
  let (numberOfChanges,solution) = solve stripe numberOfColours stringLength
  print numberOfChanges
  print solution
{-  let (startingWithA,startingWithB) = generateTwoColourStripes 10
  print startingWithA
  print startingWithB
  print stringLength
  print numberOfColours
  print stripe-}


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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (drop (n-k) bs) ps
    where
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (zipWith f (drop (n-k) bs) ps)
    where
    f bi pi = max 0 (fromIntegral (pi - bi))
    go a _ | a < 0 = False
    go a (x:xs) = go (a-x) xs
    go a [] = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = sum (zipWith f (drop (n-k) bs) ps) <= fromIntegral a
    where
    f bi pi = max 0 (fromIntegral (pi - bi)) :: Int64

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= fromIntegral a
    where
    f bi pi = max 0 (fromIntegral (pi - bi)) :: Int64

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check n a bs ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> Int -> [Int] -> [Int] -> Int -> Bool
check n a bs ps k = go a (drop (n-k) bs) ps
    where
    {-# INLINE go #-}
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = go a (reverse (take k bs)) ps
    where
    {-# INLINE go #-}
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = go a (reverse (take k bs)) ps
    where
    go a _ _ | a < 0 = False
    go a (b:bs) (p:ps) | b >= p = go a bs ps
                       | otherwise = go (a - (p - b)) bs ps
    go a [] _ = True

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= a
    where
    f bi pi = max 0 (pi - bi)

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    when (a == 399) $ do
        let bs' = map (head &&& length) $ group $ bs
        let ps' = map (head &&& length) $ group $ ps
        print bs'
        print ps'
    printf "%d %d\n" r s

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

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

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

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

solve :: Int -> Int -> Int -> [Int] -> [Int] -> (Int,Int)
solve n m a bs ps = (r,s)
    where
    r = binSearch (check a (reverse bs) ps) 0 (min n m)
    s = max 0 (sum (take r ps) - a)

binSearch f a b = if f b then b else go a b
    where
    go a b | b - a == 1 = a
           | f m = go m b
           | otherwise = go a m
        where m = (a+b)`div`2

check :: Int -> [Int] -> [Int] -> Int -> Bool
check a bs ps k = sum (zipWith f (reverse $ take k bs) ps) <= a
    where
    f bi pi = max 0 (pi - bi)

main = do
    [n,m,a] <- readInts
    bs <- sort <$> readInts
    ps <- sort <$> readInts
    let (r,s) = solve n m a bs ps
    printf "%d %d\n" r s


module Main where

import Data.List (group, sort)

output :: Bool -> IO ()
output b = putStrLn $ if b then "Yes" else "No"

solve :: String -> Bool
solve str = case map length . group . sort $ str of
  [m, n] -> m >= 2 && n >= 2
  [m, n, k] -> m + n + k >= 4
  [_, _, _, _] -> True
  _ -> False

main :: IO ()
main = output . solve =<< getLine

import qualified Data.Map as Map

func :: String -> String
func str =
    let mp = Map.toList $ helper str Map.empty where
            helper :: String -> Map.Map Char Int -> Map.Map Char Int
            helper (s:ss) m = case Map.lookup s m of
                Nothing -> helper ss (Map.insert s 1 m)
                Just(v)-> helper ss (Map.insert s (v + 1) m)
            helper _ m = m
    in
        if (length mp) > 4 || (length mp) < 2 || (length str) < 4  then "NO"
        else if (length mp) == 2 && (length (filter (\x -> (snd x) == 1) mp)) > 0 then "NO"
        else "YES"

main :: IO ()
main = do
    l <- getLine
    putStrLn $ func l
    return ()

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; xs@[_, _, _] | last xs > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, _, b] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

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

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

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

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

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

main = getLine >>= putStrLn . which "Yes" "No" . solve . sort . map length . group . sort

solve [ a, b ] = 2 <= a && 2 <= b
solve [ a, b, c ] = 2 <= c
solve [ a, b, c, d ] = True
solve _ = False

import qualified Data.Map as Map

func :: String -> String
func str =
    let mp = Map.toList $ helper str Map.empty where
            helper :: String -> Map.Map Char Int -> Map.Map Char Int
            helper (s:ss) m = case Map.lookup s m of
                Nothing -> helper ss (Map.insert s 1 m)
                Just(v)-> helper ss (Map.insert s (v + 1) m)
            helper _ m = m
    in
        if (length mp) > 4 || (length mp) < 2  then "NO"
        else if (length mp) == 2 && (length (filter (\x -> (snd x) == 1) mp)) > 0 then "NO"
        else "YES"

main :: IO ()
main = do
    l <- getLine
    putStrLn $ func l
    return ()

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= putStr . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, b, _] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = getLine >>= print . exec
exec = (\case { [a, _] | a > 1 -> "Yes"; [_, b, _] | b > 1 -> "Yes";  [_, _, _, _] -> "Yes"; _ -> "No" }) . sort . map length . group . sort

{-# LANGUAGE LambdaCase #-}
import Data.List
main = interact exec
exec = (\case { [a, b] | a > 1 -> "Yes"; [a, b, c] | b > 1 -> "Yes";  [a, b, c, d] -> "Yes"; _ -> "No" }) . sort . map length . group . sort


main = do
  d <- readLn
  getLine
  as <- fmap (map read . words) getLine
  print $ sum $ map ((`mod` d) . (d -)) $ init as

main=putStrLn.show.(\(d:z:as) -> slv d (take (z-1) $ as)).map read.words=<<getContents
slv d [] = 0
slv d (a:as) = f d (a:as) 1 0
f d [] t acc = acc
f d (a:as) t acc = (length (a:as))*d - sum(a:as)

main :: IO()
main = do
    str1 <- getLine
    str2 <- getLine
    str3 <- getLine
    let d = read str1 :: Int
    let n = read str2 :: Int
    let a = map read (words str3) :: [Int]
    putStrLn $ show ((n - 1) * d - (sum . tail . reverse) a)

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: Integer -> [Integer] -> Integer
solve d []  =  error "Empty List!"
solve d [a]  =  0
solve d (a:as)  =  (d-a) + solve d as

main :: IO ()
main  =  do
    d <- readLn
    getLine
    as <- Main.reads
    print $ solve d as

solve :: (Integral a) => a -> a -> [a] -> a
solve d n xs =
    let
        full = (n-1)*d
        act = sum.init $ xs
    in
        full - act

main =
    do
        dstr <- getLine
        nstr <- getLine
        astr <- getLine
        putStrLn.show $ solve (read dstr) (read nstr) (map read $ words astr)

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

process :: Int -> [Int] -> Int
process d [] = 0
process d [a] = 0
process d (a: as) = (d - a) + (process d as)

main :: IO ()
main = do
	line <- getLine
	_ <- getLine
	arr1 <- getLine
	let
		d = read line:: Int
		a = map (\x -> read x :: Int).words $ arr1
	print $ process d a

answer :: Int -> [Int] -> Int
answer d as = sum . map (d -) . init $ as

main = do
	d <- getLine
	_ <- getLine
	as <- getLine
	putStrLn . show $ answer (read d) (map read . words $ as)

answer d a = sum . map(d-) . init $ a
main = do
    line <- getLine
    let d = read line :: Int
    getLine
    line <- getLine
    let a = map read . words $ line
    putStrLn . show $ answer d a

main = do
  d <- readLn
  getLine
  as <- fmap (map read . words) getLine
  print $ sum $ map ((`mod` d) . (d -)) $ tail as

main=putStrLn.show.(\(d:z:as) -> slv d (take z $ as)).map read.words=<<getContents
slv d (a:as) = f d (as) 1 0
f d [] t acc = acc
f d (a:as) t acc
    | (t > a) = f d as 1 (acc + d - a)
    | otherwise = f d (a:as) (t+1) acc

main=putStrLn.show.(\(d:z:as) -> slv d (take z $ as)).map read.words=<<getContents
slv d [a] = 0
slv d (a:as) = f d (as) 1 0
f d [] t acc = acc
f d (a:as) t acc
    | (t > d) = f d as 1 (acc + d - a)
    | otherwise = f d (a:as) (t+1) acc

main=putStrLn.show.(\(d:z:as) -> slv d (take z $ as)).map read.words=<<getContents
slv d [a] = 0
slv d (a:as) = f d (as) 1 0
f d [] t acc = acc
f d (a:as) t acc
    | (t > a) = f d as 1 (acc + d - a)
    | otherwise = f d (a:as) (t+1) acc


import Data.List

solve :: String -> Int
solve x | n_threes > 0 || n_twos > 1 = 2 + n_groups
        | n_twos == 1 = 1 + n_groups
        | otherwise = n_groups
  where
    groups = map length $ group x
    n_groups = length groups
    f :: Int -> [Int] -> Int
    f i = length . filter (>=i)
    n_twos = f 2 groups
    n_threes = f 3 groups

main = interact $ show . solve . last . lines

import Data.Char (ord)

parse :: String -> String
parse = (!! 1) . lines

solve :: String -> Int
solve s = 1 + ones + min zeros 2
    where a = map (\c -> ord c - 48) s
          zeros = length . filter id $ zipWith (==) a (tail a)
          ones = length a - 1 - zeros

main :: IO ()
main = print . solve . parse =<< getContents

import Data.List

(|>) a b = b a

main = do
  s1 <- getLine
  s2 <- getLine
  let n = s1 |> (read :: String -> Int)
      d = s2 |> group |> map length |> length
      r = min (d + 2) (length s2)
  print r

import Data.List

(|>) a b = b a

getInt = do
  s <- getLine
  return (s |> (read :: String -> Int))

main = do
  n <- getInt
  s <- getLine
  f n s |> print

f n s = let
  ms = s |> group |> map length in
  length ms + if any (>= 3) ms then 2 else
    min 2 (ms |> filter (== 2) |> length)

count :: Char -> String -> Int
count _ [] = 0
count a (b:bs)
  | a == b = count a bs
  | otherwise = 1 + count b bs

solve' :: String -> Int
solve' (x:xs) = count x xs
solve' _ = 0

solve :: Int -> String -> Int
solve a b = min a $ ( (solve' b) + 3 )

parse :: String -> String
parse a = show $ solve (read $ head x) $ last x where x = words a

main = interact parse

import Data.List

parse :: String -> String
parse = (!! 1) . lines

adder :: [[Char]]->Int
adder s = min 2 $ sum $ map (\a -> length a - 1) s

solve :: String->Int
solve s = (length a) + adder a
 where a = group s

main :: IO ()
main = print . solve . parse =<< getContents

import Data.List

solve :: String -> Int
solve x | n_threes > 0 || n_twos > 1 = 2 + n_groups
        | otherwise = n_groups
  where
    groups = map length $ group x
    n_groups = length groups
    f :: Int -> [Int] -> Int
    f i = length . filter (>=i)
    n_twos = f 2 groups
    n_threes = f 3 groups

main = interact $ show . solve . last . lines

import Data.List

solve :: String -> Int
solve x | n_threes > 0 || n_twos > 1 = 2 + n_groups
        | head groups == 2 || last groups == 2 = 1 + n_groups
        | otherwise = n_groups
  where
    groups = map length $ group x
    n_groups = length groups
    f :: Int -> [Int] -> Int
    f i = length . filter (>=i)
    n_twos = f 2 groups
    n_threes = f 3 groups

main = interact $ show . solve . last . lines

import Data.List

(|>) a b = b a

getInt = do
  s <- getLine
  return (s |> (read :: String -> Int))

main = do
  n <- getInt
  s <- getLine
  f n s |> print

f n s = let
  ms = s |> group |> map length in
  length ms + if any (>= 3) ms then 2 else
    (if head ms >= 2 then 1 else 0) + (if last ms >= 2 then 1 else 0)

import Data.List

parse :: String -> String
parse = (!! 1) . lines

adder :: [[Char]]->Int
adder s = min 2 $ sum $ map (\a -> length a + 1) s

solve :: String->Int
solve s = (length a) + adder a
 where a = group s

main :: IO ()
main = print . solve . parse =<< getContents