Petya loves lucky numbers. We all know that lucky numbers are the positive integers whose decimal representations contain only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya wonders eagerly what minimum lucky number has the sum of digits equal to n. Help him cope with the task.

The single line contains an integer n (1 ≤ n ≤ 106) — the sum of digits of the required lucky number.

Print on the single line the result — the minimum lucky number, whose sum of digits equals n. If such number does not exist, print -1.

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import Data.Array
import Control.Monad (forM_)
maxn = 10^6

dp :: Array Int Int
dp = array bnds [(i, f i) | i <- range bnds]
    where
    bnds = (-6, maxn)
    f 0 = 1
    f i
        | i < 0         = 0
        | dp!(i-7) /= 0 = 7
        | dp!(i-4) /= 0 = 4
        | otherwise     = 0

lucky n
    | dp!n == 0 = [-1]
    | otherwise = f n
    where
    f 0 = []
    f n = dp!n : f (n - dp!n)

main = do
    ls <- lines `fmap` getContents
    let ns = map read ls
    forM_ [lucky n | n <- ns] $
        putStrLn . concat . map show . reverse

module Main where

import Control.Monad

main = do
    n <- read `liftM` getLine
    let k = 2 * n `div` 7
        a = 2 * n - 7 * k
        b = 4 * k - n
    putStrLn $ if a >= 0 && b >= 0
        then replicate a '4' ++ replicate b '7'
        else "-1"

solve :: Int -> Maybe String
solve 0 = Just ""
solve n
	| n < 0 = Nothing
	| n `mod` 7 == 0 = Just $ take (n `div` 7) $ repeat '7'
	| otherwise = solve (n-4) >>= Just . (++) "4"

putLn :: Maybe String -> IO ()
putLn Nothing = putStrLn "-1"
putLn (Just x) = putStrLn x

main = do
	getLine >>= putLn . solve . read

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Char
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn

  let
    abs = [(a, b) | a <- [0..n`div`4], (n-4*a)`mod`7 == 0, let b = (n-4*a) `div` 7]

  if null abs
     then print $ -1
     else let (a, b) = head abs in putStrLn $ replicate a '4' ++ replicate b '7'

num7_4 :: Int -> (Int, Int)
num7_4 n = let (quot, rem) = (div n 7, mod n 7) in
  (case rem of
     0 -> (quot, 0)
     1 -> (quot - 1, 2)
     2 -> (quot - 2, 4)
     3 -> (quot - 3, 6)
     4 -> (quot, 1)
     5 -> (quot - 1, 3)
     6 -> (quot - 2, 5))

solve :: Int -> String
solve n = let (n7, n4) = num7_4 n in
  if (n7 < 0) then
    "-1"
  else
    ((replicate n4 '4')++(replicate n7 '7'))

main = do
  n <- getLine
  putStrLn (solve (read n :: Int))

main = do
    n <- getLine
    putStr (solve . read $ n)

solve n =
    let
        atLeast = negate . div (- 5 * n) $ 7
        atMost = div (3 * n) 4
    in
        if atLeast > atMost then "-1"
        else
            let
                sevens = 3 * n - 4 * atLeast
                fours = - 5 * n + 7 * atLeast
            in  (replicate fours '4') ++ (replicate sevens '7')

import Monad (liftM)

solve :: Int -> Maybe (Int, Int)
solve n
  | m < 0  =  Nothing
  | otherwise  =  Just (m, k)
  where
    m'  =  div n 7
    (m, k)  =  findMK m'
    findMK m'
      | mod (n - 7*m') 4 == 0  =  (m', div (n - 7*m') 4)
      | otherwise  =  findMK (m'-1)

main :: IO ()
main  =  do
    ans  <-  liftM solve readLn
    case ans of
        Nothing  ->  print (-1)
        Just (m, k)  ->  putStrLn $ replicate k '4' ++ replicate m '7'

{-# 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
    return n
  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 = putStrLn =<< solve . evalState parseInput <$> BS.getContents

solve sum
    | null lst  = "-1"
    | otherwise = head lst
  where
    lst = [ replicate num4 '4' ++ replicate num7 '7'
          | num4 <- [0..sum `div` 4]
          , (sum - num4 * 4) `mod` 7 == 0
          , let num7 = (sum - num4 * 4) `div` 7
          ]

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

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

num7_4 :: Int -> (Int, Int)
num7_4 n = let (quot,rem) = (div n 7,mod n 7) in
           case rem of
             0 -> (quot,0)
             1 -> (quot-1,2)
             2 -> (quot-2,4)
             3 -> (quot-3,6)
             4 -> (quot,1)
             5 -> (quot-1,3)
             6 -> (quot-2,5)

solve :: Int -> String
solve n = let (n7,n4) = num7_4 n in
          if n7<0 then
              "-1"
          else
              ((replicate n4 '4')++(replicate n7 '7'))

main = do n <- getLine
          putStrLn (solve (read n::Int))

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

solve :: Int -> String
solve n = f n ""
            where f n s
                    | n < 0 = "-1"
                    | n `mod` 7 == 0 = s ++ (take (n `div` 7) (repeat '7'))
                    | otherwise = f (n-4) ("4"++s)

main = interact$solve.read.head.words

import Control.Applicative
import Data.List

process n = if z ==[] then "-1" else (replicate (snd(head z)) '4')++ (replicate (fst(head z)) '7')
	where z= [ (n7,n4)| n7<-[(div n 7), (div n 7)-1..0], let nn= n-n7*7, mod nn 4 ==0, let n4 = div nn 4]

main= do
	n<- read <$> getLine ::IO Int
	putStrLn $ process n

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Char
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  n <- readLn

  let
    abs = [(a, b) | a <- [1..n`div`4], (n-4*a)`mod`7 == 0, let b = (n-4*a) `div` 7]

  if null abs
     then print $ -1
     else let (a, b) = head abs in putStrLn $ replicate a '4' ++ replicate b '7'

{-# 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
    return n
  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 = putStrLn =<< solve . evalState parseInput <$> BS.getContents

solve sum
    | null lst  = "-1"
    | otherwise = head lst
  where
    lst = [ replicate num4 '4' ++ replicate num7 '7'
          | num7 <- [0..sum `div` 7]
          , (sum - num7 * 7) `mod` 4 == 0
          , let num4 = (sum - num7 * 7) `div` 4
          ]

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

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

num7_4 :: Int -> (Int, Int)
num7_4 n = let (quot,rem) = (div n 7,mod n 7) in
           case rem of
             0 -> (quot,0)
             1 -> (quot-1,2)
             2 -> (quot-2,4)
             3 -> (quot-3,6)
             4 -> (quot,1)
             5 -> (quot-1,3)
             6 -> (quot-2,5)

solve :: Int -> Int
solve n = let (n7,n4) = num7_4 n in
          if n7<0 then
              -1
          else
              read ((replicate n4 '4')++(replicate n7 '7'))::Int

main = do n <- getLine
          print (solve (read n::Int))

import Control.Applicative
import Data.List

process n = (replicate y '4')++ (replicate x '7')
	where (x,y) = head [ (n7,n4)| n7<-[(div n 7), (div n 7)-1..0], let nn= n-n7*7, mod nn 4 ==0, let n4 = div nn 4]

main= do
	n<- read <$> getLine ::IO Int
	print $ process n

import Control.Applicative
import Data.List

luc = (4,4):(7,7):[(b1*10+a,b2+a)| (b1,b2)<-luc,a<-[4,7]]::[(Integer,Integer)]

main= do
	n<- read <$> getLine ::IO Integer
	let x =   dropWhile (\z-> snd z < n) luc
	let y = takeWhile (\z-> (fromIntegral (length (show (fst z)))*4)<n) x
	let yy= filter (\z-> snd z ==n) y
	print $ if yy==[] then (-1) else fst $ head yy

import Control.Applicative
import Data.List

luc = (4,4):(7,7):[(b1*10+a,b2+a)| (b1,b2)<-luc,a<-[4,7]]::[(Integer,Integer)]

main= do
	n<- read <$> getLine ::IO Integer
	let x = head $ dropWhile (\z-> snd z < n) luc
	print $ if snd x == n then fst x else (-1)

import Control.Applicative
import Data.List

luc = (4,4):(7,7):[(b1*10+a,b2+a)| (b1,b2)<-luc,a<-[4,7]]

main= do
	n<- read <$> getLine ::IO Int
	let x = head $ dropWhile (\z-> snd z < n) luc
	print $ if snd x == n then fst x else (-1)


$$$n$$$ students are taking an exam. The highest possible score at this exam is $$$m$$$. Let $$$a_{i}$$$ be the score of the $$$i$$$-th student. You have access to the school database which stores the results of all students.You can change each student's score as long as the following conditions are satisfied:   All scores are integers  $$$0 \leq a_{i} \leq m$$$  The average score of the class doesn't change. You are student $$$1$$$ and you would like to maximize your own score.Find the highest possible score you can assign to yourself such that all conditions are satisfied.

Each test contains multiple test cases.  The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 200$$$). The description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n \leq 10^{3}$$$, $$$1 \leq m \leq 10^{5}$$$)  — the number of students and the highest possible score respectively. The second line of each testcase contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$ 0 \leq a_{i} \leq m$$$)  — scores of the students.

For each testcase, output one integer  — the highest possible score you can assign to yourself such that both conditions are satisfied._

NoteIn the first case, $$$a = [1,2,3,4] $$$, with average of $$$2.5$$$. You can change array $$$a$$$ to $$$[10,0,0,0]$$$. Average remains $$$2.5$$$, and all conditions are satisfied.In the second case, $$$0 \leq a_{i} \leq 5$$$. You can change $$$a$$$ to $$$[5,1,1,3]$$$. You cannot increase $$$a_{1}$$$ further as it will violate condition $$$0\le a_i\le m$$$.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

main = getLine >>= test.read
test 0 = return ()
test i = do
  (n:m:_) <- map read.words <$> getLine
  as <- map read.words <$> getLine
  print $ min (sum as) m
  test (i - 1)

import Control.Monad

solve :: [Int] -> Int -> Int -> Int
solve xs len max = min (sum xs) max

main = do
  cases <- read <$> getLine
  replicateM_ cases $ do
    [len, max] <- fmap read <$> words <$> getLine
    nums <- fmap read <$> words <$> getLine
    print $ solve nums len max

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

onecase = do
		[n,m]<- map read <$> words <$> getLine ::IO [Int]
		s<- sum <$> map read <$> words <$> getLine ::IO Int
		print $ min s m

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

--ghc 7.10

maxScore :: Int -> [Int] -> Int
maxScore m as = min m (sum as)

process :: Int -> IO ()
process 0 = return ()
process t = do
    nmStr <- getLine
    let [n,m] = map read . words $ nmStr
    aStrs <- getLine
    let as = map read .words $ aStrs
    print $ maxScore m as
    process (t-1)

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


You received a notebook which is called Death Note. This notebook has infinite number of pages. A rule is written on the last page (huh) of this notebook. It says: "You have to write names in this notebook during $$$n$$$ consecutive days. During the $$$i$$$-th day you have to write exactly $$$a_i$$$ names.". You got scared (of course you got scared, who wouldn't get scared if he just receive a notebook which is named Death Note with a some strange rule written in it?).Of course, you decided to follow this rule. When you calmed down, you came up with a strategy how you will write names in the notebook. You have calculated that each page of the notebook can contain exactly $$$m$$$ names. You will start writing names from the first page. You will write names on the current page as long as the limit on the number of names on this page is not exceeded. When the current page is over, you turn the page. Note that you always turn the page when it ends, it doesn't matter if it is the last day or not. If after some day the current page still can hold at least one name, during the next day you will continue writing the names from the current page.Now you are interested in the following question: how many times will you turn the page during each day? You are interested in the number of pages you will turn each day from $$$1$$$ to $$$n$$$.

The first line of the input contains two integers $$$n$$$, $$$m$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le m \le 10^9$$$) — the number of days you will write names in the notebook and the number of names which can be written on each page of the notebook. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ means the number of names you will write in the notebook during the $$$i$$$-th day.

Print exactly $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$, where $$$t_i$$$ is the number of times you will turn the page during the $$$i$$$-th day.

NoteIn the first example pages of the Death Note will look like this $$$[1, 1, 1, 2, 2], [2, 2, 2, 2, 2], [3, 3, 3, 3, 3], [3, 3, 3, 3]$$$. Each number of the array describes during which day name on the corresponding position will be written. It is easy to see that you should turn the first and the second page during the second day and the third page during the third day.

import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)

f::Integer->[Integer]->[Integer]
f k (x:[])=[]
f k (x:y:xs)=((y `div` k)-(x `div` k)):f k (y:xs)

main = do
       e1<-BC.getLine
       e2<-BC.getLine
       let (e:k:[]) = map (fst . fromJust . BC.readInteger) . BC.words $ e1
           ys = map (fst . fromJust . BC.readInteger) . BC.words $ e2
       putStrLn $ unwords $ map show $ f k $ scanl (+) 0 ys

import Data.List
main = interact $ unwords . map show . solve . map read . tail . words
solve (m:as) = snd $ mapAccumL f 0 as where
  f l l' = (r,d) where (d,r) = (l+l') `divMod` m

{-# LANGUAGE BangPatterns #-}
import           Control.Applicative
import           Control.Monad
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Int
import qualified Data.List             as L

main :: IO ()
main = do
    [_, m] <- map read.words <$> getLine
    xs <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    putStrLn.unwords.map show $ solve m xs

solve :: Int64 -> [Int64] -> [Int64]
solve m xs0 = go 0 xs0
  where
    go !acc (x:xs)
        | acc + x < m = 0 : go (acc + x) xs
        | (q, r) <- quotRem (x - (m - acc)) m = (q + 1) : go r xs
    go _ [] = []

module Main where
import Data.List

default (Int)

main = interact exec
exec = unwords . map show . snd . (\(_:m:xs) -> mapAccumL (\l x -> let (q, r) = (x - l) `divMod` m in ((m - r) `rem` m, max 0 q + fromEnum (r == 0 && q == 0) + fromEnum (l < x) - fromEnum (l == 0))) 0 xs) . map read . words

main = interact $ show . solve . map read . tail . words
solve (m:as) = sum as `div` m


Cowboy Vlad has a birthday today! There are $$$n$$$ children who came to the celebration. In order to greet Vlad, the children decided to form a circle around him. Among the children who came, there are both tall and low, so if they stand in a circle arbitrarily, it may turn out, that there is a tall and low child standing next to each other, and it will be difficult for them to hold hands. Therefore, children want to stand in a circle so that the maximum difference between the growth of two neighboring children would be minimal possible.Formally, let's number children from $$$1$$$ to $$$n$$$ in a circle order, that is, for every $$$i$$$ child with number $$$i$$$ will stand next to the child with number $$$i+1$$$, also the child with number $$$1$$$ stands next to the child with number $$$n$$$. Then we will call the discomfort of the circle the maximum absolute difference of heights of the children, who stand next to each other.Please help children to find out how they should reorder themselves, so that the resulting discomfort is smallest possible.

The first line contains a single integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the number of the children who came to the cowboy Vlad's birthday. The second line contains integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) denoting heights of every child.

Print exactly $$$n$$$ integers — heights of the children in the order in which they should stand in a circle. You can start printing a circle with any child. If there are multiple possible answers, print any of them.

NoteIn the first example, the discomfort of the circle is equal to $$$1$$$, since the corresponding absolute differences are $$$1$$$, $$$1$$$, $$$1$$$ and $$$0$$$. Note, that sequences $$$[2, 3, 2, 1, 1]$$$ and $$$[3, 2, 1, 1, 2]$$$ form the same circles and differ only by the selection of the starting point.In the second example, the discomfort of the circle is equal to $$$20$$$, since the absolute difference of $$$10$$$ and $$$30$$$ is equal to $$$20$$$.

module Main where
import Data.List

arrange _ (as,bs) [] = reverse as ++ bs
arrange b (as,bs) (x:xs) = arrange (not b) (if b then (x:as,bs) else (as,x:bs)) xs

main = do
    getLine
    as <- map (read :: String -> Int) . words <$> getLine
    let bs = sort as
        cs = arrange True ([],[]) bs
    putStrLn $ concat $ intersperse " " $ map show cs

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B

import Data.Maybe
import Data.List

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

main = do
    _ <- readLn :: IO (Int)
    xs <- sort <$> readInts
    let (a,b) = partition (\(x,y) -> x `mod` 2 == 0) $ zip [1..] xs
    putStr . unwords . map (\(x,y) -> show y) $ a ++ reverse b


Mahmoud was trying to solve the vertex cover problem on trees. The problem statement is:Given an undirected tree consisting of n nodes, find the minimum number of vertices that cover all the edges. Formally, we need to find a set of vertices such that for each edge (u, v) that belongs to the tree, either u is in the set, or v is in the set, or both are in the set. Mahmoud has found the following algorithm:  Root the tree at node 1.  Count the number of nodes at an even depth. Let it be evenCnt.  Count the number of nodes at an odd depth. Let it be oddCnt.  The answer is the minimum between evenCnt and oddCnt. The depth of a node in a tree is the number of edges in the shortest path between this node and the root. The depth of the root is 0.Ehab told Mahmoud that this algorithm is wrong, but he didn't believe because he had tested his algorithm against many trees and it worked, so Ehab asked you to find 2 trees consisting of n nodes. The algorithm should find an incorrect answer for the first tree and a correct answer for the second one.

The only line contains an integer n (2 ≤ n ≤ 105), the number of nodes in the desired trees.

The output should consist of 2 independent sections, each containing a tree. The algorithm should find an incorrect answer for the tree in the first section and a correct answer for the tree in the second. If a tree doesn't exist for some section, output "-1" (without quotes) for that section only. If the answer for a section exists, it should contain n - 1 lines, each containing 2 space-separated integers u and v (1 ≤ u, v ≤ n), which means that there's an undirected edge between node u and node v. If the given graph isn't a tree or it doesn't follow the format, you'll receive wrong answer verdict. If there are multiple answers, you can print any of them.

NoteIn the first sample, there is only 1 tree with 2 nodes (node 1 connected to node 2). The algorithm will produce a correct answer in it so we printed  - 1 in the first section, but notice that we printed this tree in the second section.In the second sample:In the first tree, the algorithm will find an answer with 4 nodes, while there exists an answer with 3 nodes like this:  In the second tree, the algorithm will find an answer with 3 nodes which is correct:

main = putStr . (\(a, b) -> p a ++ "\n" ++ p b) . f . read =<< getLine
p Nothing = "-1"
p (Just es) = unlines [show u ++ " " ++ show v | (u, v) <- es]
f n = (if n < 6 then Nothing else Just $ take (n - 1) $ (1, 2):(1, 3):(1, 4):[(4, i) | i <- [5..]], Just [(1, i) | i <-  [2..n]])

main = putStr . (\(a, b) -> p a ++ "\n" ++ p b) . f . read =<< getLine
p Nothing = "-1"
p (Just es) = unlines [show u ++ " " ++ show v | (u, v) <- es]
f n = (if n > 6 then Just $ take (n - 1) $ (1, 2):(1, 3):(1, 4):[(4, i) | i <- [5..]] else Nothing, Just [(1, i) | i <-  [2..n]])

main = putStr . (\(a, b) -> p a ++ p b) . f . read =<< getLine
p Nothing = "-1"
p (Just es) = unlines [show u ++ " " ++ show v | (u, v) <- es]
f n = (if n > 6 then Just $ take (n - 1) $ (1, 2):(1, 3):(1, 4):[(4, i) | i <- [5..]] else Nothing, Just [(1, i) | i <-  [2..n]])


You have a new professor of graph theory and he speaks very quickly. You come up with the following plan to keep up with his lecture and make notes.You know two languages, and the professor is giving the lecture in the first one. The words in both languages consist of lowercase English characters, each language consists of several words. For each language, all words are distinct, i.e. they are spelled differently. Moreover, the words of these languages have a one-to-one correspondence, that is, for each word in each language, there exists exactly one word in the other language having has the same meaning.You can write down every word the professor says in either the first language or the second language. Of course, during the lecture you write down each word in the language in which the word is shorter. In case of equal lengths of the corresponding words you prefer the word of the first language.You are given the text of the lecture the professor is going to read. Find out how the lecture will be recorded in your notes.

The first line contains two integers, n and m (1 ≤ n ≤ 3000, 1 ≤ m ≤ 3000) — the number of words in the professor's lecture and the number of words in each of these languages. The following m lines contain the words. The i-th line contains two strings ai, bi meaning that the word ai belongs to the first language, the word bi belongs to the second language, and these two words have the same meaning. It is guaranteed that no word occurs in both languages, and each word occurs in its language exactly once. The next line contains n space-separated strings c1, c2, ..., cn — the text of the lecture. It is guaranteed that each of the strings ci belongs to the set of strings {a1, a2, ... am}. All the strings in the input are non-empty, each consisting of no more than 10 lowercase English letters.

Output exactly n words: how you will record the lecture in your notebook. Output the words of the lecture in the same order as in the input.

4 3
codeforces codesecrof
contest round
letter message
codeforces contest letter contest

5 3
joll wuqrd
euzf un
hbnyiyc rsoqqveh
hbnyiyc joll joll euzf joll

codeforces round letter round
hbnyiyc joll joll un joll

main = do
	t<-getLine
	rest<-getContents
	let [n,m] = map read $ words t :: [Int]
	let dict = map words $ init $ lines rest
	let lect = words $ last $ lines rest
	putStrLn $ init $ solve lect dict

solve [] _ = []
solve (l:ls) dict = chooseWord l dict ++ " "++ solve ls dict
      where chooseWord l dict = if length word1 <= length word2 then word1 else word2
            [word1, word2]=concat $ filter (elem l) dict

import Data.Map

main :: IO()
main = putStrLn . solve . words =<< getContents

solve :: [String] -> String
solve (_:sm:strs) =
    let m = read sm
        (words, sentence) = splitAt (m*2) strs
        wordMap = getMap words Data.Map.empty
    in  unwords (trans sentence wordMap)

getMap :: [String] -> Map String String -> Map String String
getMap []       wordMap = wordMap
getMap (a:b:ss) wordMap | (length a) <= (length b) = getMap ss (insert b a (insert a a wordMap))
                        | otherwise                = getMap ss (insert a b (insert b b wordMap))

trans :: [String] -> Map String String -> [String]
trans []     _       = []
trans (s:ss) wordMap = (removeMaybe (Data.Map.lookup s wordMap)):(trans ss wordMap)

removeMaybe :: Maybe a -> a
removeMaybe (Just a) = a

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

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

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

main = do
  [n, m] <- getInts
  ps <- replicateM m $ words <$> getLine
  ws <- words <$> getLine

  let
    m = HashMap.fromList $ concat $ map f ps
      where
        f [a, b] = [(a, c), (b, c)]
          where
            c = if length a <= length b then a else b

  putStrLn $ unwords $ map (m HashMap.!) ws

import qualified Data.Map as Map
import Data.Functor

parseLine :: IO (Map.Map String String) -> Int -> IO (Map.Map String String)
parseLine ms index = do
    m <- ms
    [x, y] <- words <$> getLine
    return $ Map.insert x (if length x <= length y then x else y) m

unwrap (Just x) = x

main = do
    [n, m] <- map read <$> words <$> getLine :: IO [Int]
    p <- foldl parseLine (return Map.empty) [1..m]
    as <- words <$> getLine
    bs <- return $ map (\x -> unwrap (Map.lookup x p)) as
    putStrLn . unwords $ bs

import Control.Monad
import Data.Ord
import Data.List
import Data.Map (Map,fromList,(!))
dict pairs = fromList $ do
    l <- pairs
    let y = minimumBy (comparing length) l
    w <- l
    return (w,y)
getWords = fmap words getLine
main = do
    [_n,ms] <- getWords
    d <- fmap dict $ replicateM (read ms) getWords
    l <- getWords
    putStrLn $ intercalate " " $ map (d !) l

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
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 = C.getLine >>=  \ns-> (solve =<< forM [1..  (1 +) $ last $ map (fst.fromJust.C.readInt) $ C.words ns] ( \i -> C.words<$>C.getLine))
solve xs = let ms = Map.fromList $concat $ map (\[a1,a2] -> let m =minimumBy (\ a b ->C.length a `compare` C.length b) [a1,a2] in [(a1,m),(a2,m)]) $ init xs; l =last xs in forM_ l $ \i-> C.putStr $ C.append (ms Map.! i) (C.singleton ' ')

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List
import qualified Data.Map.Strict as Map

import Data.Maybe

type Dictionary = Map.Map B.ByteString B.ByteString

main :: IO ()
main = do
  [n, m] <- readIntsIO
  dic <- foldl' insertDictionary Map.empty . map B.words <$> replicateM m B.getLine
  B.putStrLn . B.unwords . map (fromJust . flip Map.lookup dic) . B.words =<< B.getLine
  return ()

insertDictionary :: Dictionary -> [B.ByteString] -> Dictionary
insertDictionary dic [w1, w2]
  | B.length w1 > B.length w2 = Map.insert w1 w2 $ Map.insert w2 w2 $ dic
  | otherwise                 = Map.insert w2 w2 $ Map.insert w1 w1 $ dic

readIntsIO :: IO [Int]
readIntsIO = map (fst . fromJust . B.readInt) . B.words <$> B.getLine

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

main = do
  [a,b]<-map read <$> words <$> getLine ::IO [Int]
  m<-replicateM b (  words <$> getLine) ::IO [[String]]
  let mm = map (\[z1,z2]-> (z1,if length z1<=length z2 then z1 else z2)) m
  let mymap = M.fromList mm
  s<- words <$> getLine ::IO [String]
  putStrLn $ intercalate " " $ map (\z-> fromJust(M.lookup z mymap)) s

import qualified Data.Map as Map
import qualified Data.List as List
import qualified Data.Maybe as Maybe

main = do
    contents <- getContents
    let allLines = lines contents
    let (nWordsInLecture, mWordsInLanguage) =
            (intsInLine !! 0, intsInLine !! 1)
                where intsInLine = lineToInts $ head allLines

    let wordMapping = Map.fromList $ linesToWordsInSameMeaning $ init $ tail allLines
    putStrLn $ unwords $ List.intersperse " "
        $ map (firstWordToShorterWord wordMapping)
        $ words $ last allLines

lineToInts :: String -> [Int]
lineToInts line = map read $ words line

linesToWordsInSameMeaning :: [String] -> [(String, String)]
linesToWordsInSameMeaning [] = []
linesToWordsInSameMeaning (line:remain) =
    (twoWords !! 0, twoWords !! 1) :
    linesToWordsInSameMeaning remain
        where twoWords = words line

firstWordToShorterWord :: Map.Map String String -> String -> String
firstWordToShorterWord mapping firstWord =
    if length firstWord <= length secondWord
        then firstWord else secondWord
        where secondWord = Maybe.fromJust $ Map.lookup firstWord mapping

import qualified Data.Map as M

main :: IO ()
main = getContents >>= putStrLn . unwords . solve . map words . tail . lines

solve :: [[String]] -> [String]
solve cs = map (\s -> M.findWithDefault s s m) $ last cs
  where m = M.fromList $ filter (\(x, y) -> length x > length y) $ map toTuple $ init cs

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

import Data.Ord (comparing)
import Data.List (minimumBy)
import Data.Map ((!))
import qualified Data.Map as M
import Control.Monad (replicateM)
readPair = getLine >>= \l -> let [a,b] = words l in return (a,b)
main = do
  [n,m] <- fmap (map read . words) getLine
  ws <- fmap M.fromList (replicateM m readPair)
  putStrLn . unwords . map (\w -> minimumBy (comparing length) [w,ws!w]) . words =<< getLine

import System.IO
import Control.Monad
import Data.List
import qualified Data.Map as M

glw  = fmap words getLine
glwr = fmap (map read . words) getLine

main = do
  hSetBuffering stdout NoBuffering
  solve

solve :: IO ()
solve = do
  n:m:_ <- glwr
  mappings <- forM [1..m] $ const glw
  note <- glw
  putStrLn $ lecture n m mappings note

lecture :: Int -> Int -> [[String]] -> [String] -> String
lecture n m mappings = unwords . map (ko m)
  where
    m = M.fromList $ map (\[a,b] -> (a,b)) mappings

ko :: M.Map String String -> String -> String
ko m a
  | length a <= length b = a
  | 0 < 1 = b
  where
    b = m M.! a

import Data.List
import Data.Ord
decode d w = minimumBy (\x y -> compare (length x) (length y)). head . filter (w`elem`) $ d
solve m = let
            dict = map (id . words) .  init $ m
          in
            map (decode dict) ((words . last) m)
main = interact $ unwords  . solve . tail . lines

import qualified Data.Map as M
import Data.List

type Vocab = (String, String)

--create dictionary from list of tuples (input)
arrange :: Vocab -> Vocab
arrange w@(a, b)
  | length a <= length b = (b, a)
  | otherwise = w

makeDict :: [Vocab] -> M.Map String String
makeDict = M.fromList . map arrange
--------------------------------

--main solver
solve :: M.Map String String -> String -> String
solve ms s
  | result /= Nothing = unwrap result
  | otherwise = s
  where result = M.lookup s ms

unwrap (Just a) = a
---------------------------------

--stdin, IO
toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
  g <- (fmap words getContents)
  let [n, m] = map read (take 2 g)
      mks = makeDict . toTuple . take (m*2) . drop 2 $ g
      line = drop (m*2 + 2) g
  putStr . intercalate " " . map (solve mks) $ line

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

type BS = B.ByteString

shorterWord :: [(BS, BS)] -> BS -> BS
shorterWord choices word =
  if B.length a > B.length b then b else a where
    (a, b) = findWord word choices

findWord :: BS -> [(BS, BS)] -> (BS, BS)
findWord word choices =
  head . filter (isBelong word) $ choices where
   isBelong x (a, b) = x `elem` [a, b]

solve :: [(BS, BS)] -> [BS] -> [BS]
solve choices = map (shorterWord choices)

main = do
  g <- B.getContents
  let ws = B.words g
      m = a where Just (a, b) = B.readInt (ws !! 1)
      w = totuple (take (2*m) (drop 2 ws))
      lec = drop (2*m + 2) ws
  mapM_ B.putStr . intersperse (B.pack " ") $ (solve w lec)

totuple [] = []
totuple (l:ls:lss) =
  (l, ls) : totuple lss

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

main= do
	[n,m]<- map read. words <$> getLine ::IO [Int]
	q1<- replicateM m ( words <$>getLine)
	let q= M.fromList $ map (\[a,b] ->(a,b)) $ filter (\[a,b] -> length a >length b) q1
	le<-  words <$> getLine
	putStrLn $ intercalate " " $ map (\z-> let r=M.lookup z q in if r==Nothing then z else fromJust r ) le

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

main= do
	[n,m]<- map read. words <$> getLine ::IO [Int]
	q1<- replicateM m ( words <$>getLine)
	let q= map (\[a,b] ->(a,b)) $ filter (\[a,b] -> length a >length b) q1
	le<-  words <$> getLine
	putStrLn $ intercalate " " $ map (\z-> let r=lookup z q in if r==Nothing then z else fromJust r ) le

import Control.Applicative
import Control.Monad
import qualified Data.Map.Strict as M (empty, insert, (!))

solve dict lecture = map (ls M.!) lecture
  where
    ins m [a,b] =
      let v = if length a <= length b then a else b
      in M.insert a v $ M.insert b v m
    ls = foldl ins M.empty dict

main = do
  [n, m] <- map read . words <$> getLine
  dict <- replicateM m $ words <$> getLine
  lecture <- words <$> getLine
  putStrLn $ unwords $ solve dict lecture

import Control.Monad
import Data.Ord
import Data.List
import Data.Map (Map,fromList,(!))
dict pairs = fromList $ do
    l <- pairs
    let y = minimumBy (comparing length) l
    w <- l
    return (w,y)
getWords = fmap words getLine
main = do
    [_n,ms] <- getWords
    d <- fmap dict $ replicateM (read ms) getWords
    l <- getWords
    print $ intercalate " " $ map (d !) l

import qualified Data.Map as M
import Data.List

type Vocab = (String, String)

--create dictionary from list of tuples (input)
arrange :: Vocab -> Vocab
arrange w@(a, b)
  | length a <= length b = (b, a)
  | otherwise = w

makeDict :: [Vocab] -> M.Map String String
makeDict = M.fromList . map arrange
--------------------------------

--main solver
solve :: M.Map String String -> String -> String
solve ms s
  | result /= Nothing = unwrap result
  | otherwise = s
  where result = M.lookup s ms

unwrap (Just a) = a
---------------------------------

--stdin, IO
toTuple [] = []
toTuple (x:xs:xss) = (x, xs) : toTuple xss

main = do
  g <- (fmap words getContents)
  let [n, m] = map read (take 2 g)
      mks = makeDict . toTuple . drop 2 . take (m*2) $ g
      line = drop (m*2 + 2) g
  putStr . intercalate " " . map (solve mks) $ line


You are given two rectangles on a plane. The centers of both rectangles are located in the origin of coordinates (meaning the center of the rectangle's symmetry). The first rectangle's sides are parallel to the coordinate axes: the length of the side that is parallel to the Ox axis, equals w, the length of the side that is parallel to the Oy axis, equals h. The second rectangle can be obtained by rotating the first rectangle relative to the origin of coordinates by angle α.  Your task is to find the area of the region which belongs to both given rectangles. This region is shaded in the picture.

The first line contains three integers w, h, α (1 ≤ w, h ≤ 106; 0 ≤ α ≤ 180). Angle α is given in degrees.

In a single line print a real number — the area of the region which belongs to both given rectangles. The answer will be considered correct if its relative or absolute error doesn't exceed 10 - 6.

NoteThe second sample has been drawn on the picture above.

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | a' == 0 || a' == 180 = w * h
  | a' == 90 = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan (a / 2) + 1 / tan (a / 2))

import Data.Ord
import Data.List
import Control.Monad

main :: IO ()
main = do
  [w, h, a] <- map read . words <$> getLine
  let a' = (min a (180 - a)) * pi / 180
  let pts = [(w/2, h/2), (w/2, -h/2), (-w/2,-h/2), (-w/2,h/2)] :: [(Double, Double)]
  let pts' = map (rotate a') pts
  let lines = zip pts (tail $ cycle pts)
  let lines' = zip pts' (tail $ cycle pts')
  let ints = concatMap (getints lines') lines
  print . area . uniq $ sortBy (comparing theta) ints

uniq [] = []
uniq [x] = [x]
uniq (x:y:xs)
  | x == y = uniq (x:xs)
  | otherwise = x : uniq (y:xs)

rotate a (x, y) = (x * cos a - y * sin a, x * sin a + y * cos a)

theta (x, y) = atan2 y x

getints xs y = concatMap (\x -> getints' x y) xs

getints' l'@((x1', y1'), (x2', y2')) l@((x, y), (x', y'))
  | x == x' =
    let y'' = y1' + (x - x1') / (x2' - x1') * (y2' - y1')
    in if min y y' <= y'' && y'' <= max y y' then [(x, y'')] else []
  | y == y' = map swap $ getints' (swap' l') (swap' l)
  where
    swap (a, b) = (b, a)
    swap' (p1, p2) = (swap p1, swap p2)

area ps =
  let
    xs = map fst ps
    ys = map snd ps
  in
    0.5 * abs (sum $ zipWith4 (\x y y' x' -> x * y - y' * x') xs (tail $ cycle ys) ys (tail $ cycle xs))

{-# LANGUAGE BangPatterns, FlexibleInstances #-}

main = getLine>>=print.solve.map read.words

solve :: [Integer] -> Double
solve [w,h,0] = fromIntegral $ w*h
solve [w,h,180] = fromIntegral $ w*h
solve [w,h,90] = fromIntegral $ min w h * min w h
solve wha@[w',h',a']
  | a'>90 = solve[w',h',180-a']
  | w<h && not (segIntersect ((-w,h),(w,h)) (rot(-w,h)a,rot(w,h)a)) = w*w / sin a
  | w>h && not (segIntersect ((-w,h),(-w,-h)) (rot(-w,h)a,rot(-w,-h)a)) = h*h / sin a
  | otherwise = go 0 $ ps ++ map negate ps
   where
     [w,h,_] = map fromIntegral wha
     a = fromIntegral a' / 180 * pi
     ps@(x:_) = [(w/2,w*(1-cos a)/(2*sin a))
                , ((w-h*sin a)/(2*cos a),h/2)
                ,(h*(1-1/cos a)/(2*tan a),h/2)
                ,(-w/2,(h-w*sin a)/(2*cos a))
                ]
     go acc (p0:p1:ps) = go (acc + p0 `cross` p1 / 2.0) (p1:ps)
     go acc [p] = acc + (p `cross` x / 2.0)

eps :: Double
eps = 1e-9

type Point = (Double,Double)
type Seg = (Point,Point)

instance Num (Double,Double) where
  (!x0,!y0) + (!x1,!y1) = (x0+x1,y0+y1)
  (!x0,!y0) - (!x1,!y1) = (x0-x1,y0-y1)
  (!x0,!y0) * (!x1,!y1) = (x0*x1-y0*y1,x0*y1+x1*y0)
  negate (!x,!y) = (negate x,negate y)
  abs (!x,!y) = (sqrt(x*x + y*y),0)
  signum (!x,!y) = case sqrt $ x*x + y*y of
                     r | r < eps   -> (0,0)
                       | otherwise -> (x/r,y/r)
  fromInteger n = (fromInteger n, 0)

infixr 7 *:
(*:) :: Double -> (Double,Double) -> (Double,Double)
(*:) !k (!x,!y) = (k*x,k*y)
{-# INLINE (*:) #-}

cross :: (Double,Double) -> (Double,Double) -> Double
cross (!x0,!y0) (!x1,!y1) = x0*y1 - y0*x1
{-# INLINE cross #-}

rot :: (Double,Double) -> Double -> (Double,Double)
rot (!x,!y) !a = (x,y)*(cos a,sin a)
{-# INLINE rot #-}

segIntersect :: Seg -> Seg -> Bool
segIntersect (p0,p1) (q0,q1) = (area p0 q0 q1) * (area p1 q0 q1) < eps
                  && (area q0 p0 p1) * (area q1 p0 p1) < eps
{-# INLINE segIntersect #-}

area :: Point -> Point -> Point -> Double
area o u v = (u-o)`cross`(v-o)
{-# INLINE area #-}

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | a' == 90 = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan (a / 2) + 1 / tan (a / 2))

import Debug.Trace

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | a' == 90 = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = trace (show x ++ " " ++ show y) $ w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan a + 1 / tan a)

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | a' == 0 || a' == 90 = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan (a / 2) + 1 / tan (a / 2))

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | elem a' [0, 90, 180] = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan (a / 2) + 1 / tan (a / 2))

main :: IO ()
main = interact $ show . solve . map read . words

solve :: [Double] -> Double
solve [w', h', a']
  | a' == 90 = h * h
  | sin (a / 2) > h / d = s * s * sin a
  | otherwise = w * h - (x * x + y * y) * tan a
  where
  w = max w' h'
  h = min w' h'
  a = min a' (180 - a') * pi / 180
  d = sqrt $ w * w + h * h
  x = w / 2 - h / 2 * (1 - cos a) / sin a
  y = (h - x * tan a) * cos a / (1 + cos a)
  s = h / 2 * (tan a + 1 / tan a)


The teacher gave Anton a large geometry homework, but he didn't do it (as usual) as he participated in a regular round on Codeforces. In the task he was given a set of n lines defined by the equations y = ki·x + bi. It was necessary to determine whether there is at least one point of intersection of two of these lines, that lays strictly inside the strip between x1 < x2. In other words, is it true that there are 1 ≤ i < j ≤ n and x', y', such that:   y' = ki * x' + bi, that is, point (x', y') belongs to the line number i;  y' = kj * x' + bj, that is, point (x', y') belongs to the line number j;  x1 < x' < x2, that is, point (x', y') lies inside the strip bounded by x1 < x2. You can't leave Anton in trouble, can you? Write a program that solves the given task.

The first line of the input contains an integer n (2 ≤ n ≤ 100 000) — the number of lines in the task given to Anton. The second line contains integers x1 and x2 ( - 1 000 000 ≤ x1 < x2 ≤ 1 000 000) defining the strip inside which you need to find a point of intersection of at least two lines. The following n lines contain integers ki, bi ( - 1 000 000 ≤ ki, bi ≤ 1 000 000) — the descriptions of the lines. It is guaranteed that all lines are pairwise distinct, that is, for any two i ≠ j it is true that either ki ≠ kj, or bi ≠ bj.

Print "Yes" (without quotes), if there is at least one intersection of two distinct lines, located strictly inside the strip. Otherwise print "No" (without quotes).

NoteIn the first sample there are intersections located on the border of the strip, but there are no intersections located strictly inside it.

--fast read
import qualified Data.ByteString.Char8 as B
import qualified Data.List as L
import Data.Maybe
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInteger) $ fmap B.words a
readLists = readInts $ B.getLine
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
mycompare0 x y
  | g == EQ = compare (snd x) (snd y)
  | otherwise = g
  where g = compare (fst x) (fst y)
mycompare1 x y
  | g == EQ = compare (snd y) (snd x)
  | otherwise = g
  where g = compare (fst x) (fst y)
zipSortBy func refs as = map snd $ L.sortBy (\x y -> func (fst x) (fst y)) $ zip refs as
main = do
  n <- readLn
  [x1,x2] <- readLists
  a <- readMatrix
  let ks = map (\x -> x !! 0) a
  let bs = map (\x -> x !! 1) a
  let vx1 = zipWith (\k b -> k*x1+b) ks bs
  let vx2 = zipWith (\k b -> k*x2+b) ks bs
  let isIntersect = (zipSortBy mycompare0 (zip vx1 ks) [1..n]) /= (zipSortBy mycompare1 (zip vx2 ks) [1..n])
  putStrLn $ if isIntersect then "YES" else "NO"

import qualified Data.List as L
import Control.Arrow

read2 :: String -> (Integer, Integer)
read2 l =
    let (x:y:_) = map read $ words l
    in (x,y)

getY :: (Integer, Integer) -> Integer -> Integer
getY (k,b) x = k*x+b

solve :: [String] -> String
solve (x12:lns)
    | crossExists = "YES"
    | otherwise   = "NO"
    where
        (x1,x2) = read2 x12
        coeffs = map read2 lns
        ys = L.sort $ map ((`getY` x1) &&& (`getY` x2)) coeffs
        crossExists = map snd ys /= (L.sort $ map snd ys)

a :: String
a = solve ["1 2", "1 2", "1 0", "0 1", "0 2"]

b :: String
b = solve ["22290 75956", "-66905 -22602", "-88719 12654", "-191 -81032", "0 -26057", "-39609 0", "0 51194", "2648 88230", "90584 15544", "0 23060", "-29107 26878"]

main :: IO ()
main = interact $ solve . tail . lines

import Data.Char (ord)
import Data.List (sort)

type Input  = (Integer, Integer, [(Integer, Integer)])
type Output = Bool

readInteger :: String -> Integer
readInteger ('-' : s) = - (readInteger s)
readInteger s = foldl (\t c -> t * 10 + toInteger (ord c) - 48) 0 s

parse :: String -> Input
parse contents = (x_1, x_2, map pair ls)
    where (_ : l1 : ls) = lines contents
          (x_1, x_2)    = pair l1
          pair l        = let [a, b] = map readInteger . words $ l in (a, b)

check :: [(Integer, Integer)] -> Bool
check []  = False
check [_] = False
check ((x, y) : (x', y') : xss) = (x < x' && y > y') || check ((x', y') : xss)

solve :: Input -> Output
solve (x_1, x_2, ls) = check . sort . map y $ ls
    where y (k, b) = (k * x_1 + b, k * x_2 + b)

format :: Output -> String
format True  = "Yes"
format False = "No"

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import qualified Data.List as L
import Control.Arrow

read2 :: String -> (Int, Int)
read2 l =
    let (x:y:_) = map read $ words l
    in (x,y)

getY :: (Int, Int) -> Int -> Int
getY (k,b) x = k*x+b

solve :: [String] -> String
solve (x12:lns)
    | crossExists = "YES"
    | otherwise   = "NO"
    where
        (x1,x2) = read2 x12
        coeffs = map read2 lns
        ys = L.sort $ map ((`getY` x1) &&& (`getY` x2)) coeffs
        crossExists = map snd ys /= (L.sort $ map snd ys)

a :: String
a = solve ["1 2", "1 2", "1 0", "0 1", "0 2"]

main :: IO ()
main = interact $ solve . tail . lines

import qualified Data.List as L

read2 :: String -> (Int, Int)
read2 l =
    let (x:y:_) = map read $ words l
    in (x,y)

getY :: (Int, Int) -> Int -> Int
getY (k,b) x = k*x+b

solve :: [String] -> String
solve (x12:lns)
    | crossExists = "YES"
    | otherwise   = "NO"
    where
        (x1,x2) = read2 x12
        coeffs = map read2 lns
        ys1 = L.sort $ zip (map (\c -> (getY c x1, fst c)) coeffs) [0..]
        ys2 = L.sort $ zip (map (\c -> (getY c x2, -(fst c))) coeffs) [0..]
        crossExists = map snd ys1 /= map snd ys2

a :: String
a = solve ["1 2", "1 2", "1 0", "0 1", "0 2"]

main :: IO ()
main = interact $ solve . tail . lines

import Data.Char (ord)
import Data.List (sort)

type Input  = (Integer, Integer, [(Integer, Integer)])
type Output = Bool

readInteger :: String -> Integer
readInteger = foldl (\s c -> s * 10 + toInteger (ord c) - 48) 0

parse :: String -> Input
parse contents = (x_1, x_2, map pair ls)
    where (_ : l1 : ls) = lines contents
          (x_1, x_2)    = pair l1
          pair l        = let [a, b] = map readInteger . words $ l in (a, b)

check :: [(Integer, Integer)] -> Bool
check []  = False
check [_] = False
check ((x, y) : (x', y') : xss) = (x < x' && y > y') || check ((x', y') : xss)

solve :: Input -> Output
solve (x_1, x_2, ls) = check . sort . map y $ ls
    where y (k, b) = (k * x_1 + b, k * x_2 + b)

format :: Output -> String
format True  = "Yes"
format False = "No"

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents


T is playing a game with his friend, HL.There are $$$n$$$ piles of stones, the $$$i$$$-th pile initially has $$$a_i$$$ stones. T and HL will take alternating turns, with T going first. In each turn, a player chooses a non-empty pile and then removes a single stone from it. However, one cannot choose a pile that has been chosen in the previous turn (the pile that was chosen by the other player, or if the current turn is the first turn then the player can choose any non-empty pile). The player who cannot choose a pile in his turn loses, and the game ends.Assuming both players play optimally, given the starting configuration of $$$t$$$ games, determine the winner of each game.

The first line of the input contains a single integer $$$t$$$ $$$(1 \le t \le 100)$$$ — the number of games. The description of the games follows. Each description contains two lines: The first line contains a single integer $$$n$$$ $$$(1 \le n \le 100)$$$ — the number of piles. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 100)$$$.

For each game, print on a single line the name of the winner, "T" or "HL" (without quotes)

NoteIn the first game, T removes a single stone from the only pile in his first turn. After that, although the pile still contains $$$1$$$ stone, HL cannot choose from this pile because it has been chosen by T in the previous turn. Therefore, T is the winner.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.Bool

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ bool "HL" "T" $ sum as - maximum as < maximum as || odd (sum as)

import Control.Monad

solve :: [Int] -> String
solve li = let
  s = sum li
  w = maximum li
  in  if  2*w > s
      then  "T"
      else  if  even s  then  "HL"  else  "T"

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    a <- map read . words <$> getLine
    putStrLn (solve a)

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.Bool

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ bool "HL" "T" $ play True as

play turn (1 : b : as) = play (not turn) (b : as)
play turn (a : b : as) = play (not turn) (b : a - 1 : as)
play turn _ = turn

import Control.Monad

solve :: Int -> [Int] -> String
solve 1 [_] = "T"
solve n li = if  even (sum li)  then  "HL"  else  "T"

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


You are given a string $$$s$$$ consisting only of lowercase Latin letters.You can rearrange all letters of this string as you wish. Your task is to obtain a good string by rearranging the letters of the given string or report that it is impossible to do it.Let's call a string good if it is not a palindrome. Palindrome is a string which is read from left to right the same as from right to left. For example, strings "abacaba", "aa" and "z" are palindromes and strings "bba", "xd" are not.You have to answer $$$t$$$ independent queries.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — number of queries. Each of the next $$$t$$$ lines contains one string. The $$$i$$$-th line contains a string $$$s_i$$$ consisting only of lowercase Latin letter. It is guaranteed that the length of $$$s_i$$$ is from $$$1$$$ to $$$1000$$$ (inclusive).

Print $$$t$$$ lines. In the $$$i$$$-th line print the answer to the $$$i$$$-th query: -1 if it is impossible to obtain a good string by rearranging the letters of $$$s_i$$$ and any good string which can be obtained from the given one (by rearranging the letters) otherwise.

NoteIn the first query we cannot rearrange letters to obtain a good string.Other examples (not all) of correct answers to the second query: "ababaca", "abcabaa", "baacaba".In the third query we can do nothing to obtain a good string.

main = interact $ unlines . map solve . tail . lines

solve (x:xs) = head $ filter (\xs -> xs /= reverse xs) [(x:xs), (xs ++ [x]), "-1"]

import Data.List

f::[String]->[String]
f []=[]
f (x:xs)=let t=sort x
         in if t==(reverse t) then "-1":f xs else t:f xs

main = do
       e<-getLine
       ts<-getContents
       let xs=lines ts
       mapM_ putStrLn $ f xs


A flowerbed has many flowers and two fountains.You can adjust the water pressure and set any values r1(r1 ≥ 0) and r2(r2 ≥ 0), giving the distances at which the water is spread from the first and second fountain respectively. You have to set such r1 and r2 that all the flowers are watered, that is, for each flower, the distance between the flower and the first fountain doesn't exceed r1, or the distance to the second fountain doesn't exceed r2. It's OK if some flowers are watered by both fountains.You need to decrease the amount of water you need, that is set such r1 and r2 that all the flowers are watered and the r12 + r22 is minimum possible. Find this minimum value.

The first line of the input contains integers n, x1, y1, x2, y2 (1 ≤ n ≤ 2000,  - 107 ≤ x1, y1, x2, y2 ≤ 107) — the number of flowers, the coordinates of the first and the second fountain. Next follow n lines. The i-th of these lines contains integers xi and yi ( - 107 ≤ xi, yi ≤ 107) — the coordinates of the i-th flower. It is guaranteed that all n + 2 points in the input are distinct.

Print the minimum possible value r12 + r22. Note, that in this problem optimal answer is always integer.

NoteThe first sample is (r12 = 5, r22 = 1):  The second sample is (r12 = 1, r22 = 32):

main = interact $ solve. lines
solve (h:t) = let [n,x1,y1,x2,y2] = map read . words $ h
                  xs = map (map read . words) t
                  getDis x1 y1 x2 y2 = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)
                  find [x, y] = let r = getDis x1 y1 x y
                                in r + (maximum . (0:) . map (\[x,y] -> getDis x y x2 y2) $ filter (\[x,y] -> getDis x y x1 y1 > r) xs)
              in show . minimum $ map find ([x1,y1]:xs)

main = interact $ solve. lines
solve (h:t) = let [n,x1,y1,x2,y2] = map read . words $ h
                  xs = map ((\[x,y] -> (x,y)) . map read . words) t
                  getDis x1 y1 x2 y2 = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)
                  find (x, y) = let r = getDis x1 y1 x y
                                in r + (maximum . (0:) . map (\(x,y) -> getDis x y x2 y2) $ filter (\(x,y) -> getDis x y x1 y1 > r) xs)
              in show . minimum $ map find ((x1,y1):xs)

-- A flowerbed has many flowers and two fountains.
--
-- You can adjust the water pressure and set any values r1(r1 ≥ 0) and r2(r2 ≥ 0),
-- giving the distances at which the water is spread from the first and second
-- fountain respectively. You have to set such r1 and r2 that all the flowers
-- are watered, that is, for each flower, the distance between the flower and
-- the first fountain doesn't exceed r1, or the distance to the second fountain
-- doesn't exceed r2. It's OK if some flowers are watered by both fountains.
--
-- You need to decrease the amount of water you need, that is set such r1 and r2
-- that all the flowers are watered and the r1^2 + r2^2 is minimum possible.
-- Find this minimum value.
--
-- Input
-- The first line of the input contains integers n, x1, y1, x2, y2 (1 ≤ n ≤ 2000,
-- -107 ≤ x1, y1, x2, y2 ≤ 107) — the number of flowers, the coordinates of
-- the first and the second fountain.
--
-- Next follow n lines. The i-th of these lines contains integers xi and yi
-- (-107 ≤ xi, yi ≤ 107) — the coordinates of the i-th flower.
--
-- It is guaranteed that all n + 2 points in the input are distinct.
--
-- Output
-- Print the minimum possible value r1^2 + r2^2. Note, that in this problem
-- optimal answer is always integer.
--
-- Found at: http://codeforces.com/contest/617/problem/C
--

module Main where

type Point = (Int,Int)

dist2 :: Point -> Point -> Integer
dist2 (x1,y1) (x2,y2) = (toInteger $ x1 - x2) ^ 2 + (toInteger $ y1 - y2) ^ 2

brute :: Point -> Point -> [Point] -> (Integer,Integer)
brute s1 s2 flowers = minimumWith (uncurry (+)) possibleRs
  where r12s = map (dist2 s1) flowers
        possibleRs = map (\r12 -> bruteGivenR12 s1 s2 r12 flowers) r12s

bruteGivenR12 s1 s2 r12 flowers = (r12,r22)
  where dist2s = map (\flower -> (dist2 flower s1, dist2 flower s2)) flowers
        notCoveredByS1 = filter (\(d12,d22) -> r12 < d12) dist2s
        r22s = map snd notCoveredByS1
        r22 = foldl max 0 r22s

minimumWith :: (Ord b) => (a -> b) -> [a] -> a
minimumWith _ [] = error "List cannot be empty"
minimumWith f lst = minimumWith' (head lst, f (head lst)) lst
  where minimumWith' (xmin, _) [] = xmin
        minimumWith' (xmin, fxmin) (x:xs)
          | f x < fxmin  = minimumWith' (x, f x) xs
          | otherwise    = minimumWith' (xmin, fxmin) xs

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

main :: IO ()
main = do
  line1 <- getLine
  let [n, s1x, s1y, s2x, s2y] = (map read . words) line1 :: [Int]
  flowerLines <- getLines n
  let flowers = map ((\[x, y] -> (x,y)) . (map read) . words) flowerLines :: [Point]
  -- have to brute force for all possibilities of r12 being non-zero and r22 being non-zero
  let (r12', r22')  = brute (s1x,s1y) (s2x,s2y) flowers
      (r12'',r22'') = (0, maximum $ map (dist2 (s2x,s2y)) flowers)
      (r12,r22) = minimumWith (uncurry (+)) [(r12', r22'), (r12'',r22'')]
  putStrLn $ show (r12 + r22)

main = interact $ solve. lines
solve (h:t) = let [n,x1,y1,x2,y2] = map read . words $ h
                  xs = map (map read . words) t
                  getDis x1 y1 x2 y2 = (x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2)
                  find [x, y] = let r = getDis x1 y1 x y
                                in r + (maximum . (0:) . map (\[x,y] -> getDis x y x2 y2) $ filter (\[x,y] -> getDis x y x1 y1 > r) xs)
              in show . minimum $ map find xs

-- A flowerbed has many flowers and two fountains.
--
-- You can adjust the water pressure and set any values r1(r1 ≥ 0) and r2(r2 ≥ 0),
-- giving the distances at which the water is spread from the first and second
-- fountain respectively. You have to set such r1 and r2 that all the flowers
-- are watered, that is, for each flower, the distance between the flower and
-- the first fountain doesn't exceed r1, or the distance to the second fountain
-- doesn't exceed r2. It's OK if some flowers are watered by both fountains.
--
-- You need to decrease the amount of water you need, that is set such r1 and r2
-- that all the flowers are watered and the r1^2 + r2^2 is minimum possible.
-- Find this minimum value.
--
-- Input
-- The first line of the input contains integers n, x1, y1, x2, y2 (1 ≤ n ≤ 2000,
-- - 107 ≤ x1, y1, x2, y2 ≤ 107) — the number of flowers, the coordinates of
-- the first and the second fountain.
--
-- Next follow n lines. The i-th of these lines contains integers xi and yi
-- ( - 107 ≤ xi, yi ≤ 107) — the coordinates of the i-th flower.
--
-- It is guaranteed that all n + 2 points in the input are distinct.
--
-- Output
-- Print the minimum possible value r1^2 + r2^2. Note, that in this problem
-- optimal answer is always integer.

-- Found at: http://codeforces.com/contest/617/problem/C
--

module Main where

type Point = (Int,Int)

dist2 :: Point -> Point -> Integer
dist2 (x1,y1) (x2,y2) = (toInteger $ x1 - x2) ^ 2 + (toInteger $ y1 - y2) ^ 2

brute :: Point -> Point -> [Point] -> (Integer,Integer)
brute s1 s2 flowers = minimumWith (uncurry (+)) possibleRs
  where r12s = map (dist2 s1) flowers
        possibleRs = map (\r12 -> bruteGivenR12 s1 s2 r12 flowers) r12s

bruteGivenR12 s1 s2 r12 flowers = (r12,r22)
  where dist2s = map (\flower -> (dist2 flower s1, dist2 flower s2)) flowers
        notCoveredByS1 = filter (\(d12,d22) -> r12 < d12) dist2s
        r22s = map snd notCoveredByS1
        r22 = foldl max 0 r22s

minimumWith :: (Ord b) => (a -> b) -> [a] -> a
minimumWith _ [] = error "List cannot be empty"
minimumWith f lst = minimumWith' (head lst, f (head lst)) lst
  where minimumWith' (xmin, _) [] = xmin
        minimumWith' (xmin, fxmin) (x:xs)
          | f x < fxmin  = minimumWith' (x, f x) xs
          | otherwise    = minimumWith' (xmin, fxmin) xs

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

main :: IO ()
main = do
  line1 <- getLine
  let [n, s1x, s1y, s2x, s2y] = (map read . words) line1 :: [Int]
  flowerLines <- getLines n
  let flowers = map ((\[x, y] -> (x,y)) . (map read) . words) flowerLines :: [(Int,Int)]
  let (r12,r22) = brute (s1x,s1y) (s2x,s2y) flowers
  putStrLn $ show (r12 + r22)

module Main where
import GHC.Exts(sortWith)

dist2 :: (Int,Int) -> (Int,Int) -> Integer
dist2 (x1,y1) (x2,y2) = (toInteger $ x1 - x2) ^ 2 + (toInteger $ y1 - y2) ^ 2

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

grow1 :: (Integer,Integer) -> (Integer,Integer) -> (Integer,Integer)
grow1 (r2a,r2b) (r2toA,r2toB)
  | r2toA <= r2a              = (r2a,r2b)
  | r2toB <= r2b              = (r2a,r2b)
  | r2toA + r2b < r2a + r2toB = (r2toA,r2b)
  | otherwise                 = (r2a,r2toB)

shrink :: (Integer,Integer) -> [(Integer,Integer)] -> (Integer,Integer)
shrink (r2a,r2b) flowerR2s = foldl grow1 (r2aMin,r2bMin) abBoth
  where aOnly  = filter (\(r2toA,r2toB) -> r2toB > r2b) flowerR2s
        bOnly  = filter (\(r2toA,r2toB) -> r2toA > r2a) flowerR2s
        abBoth = filter (\(r2toA,r2toB) -> r2toA <= r2a && r2toB <= r2b) flowerR2s
        r2aMin = maximum $ map fst aOnly
        r2bMin = maximum $ map snd bOnly

main :: IO ()
main = do
  line1 <- getLine
  let [n, x1, y1, x2, y2] = (map read . words) line1 :: [Int]
  flowerLines <- getLines n
  let flowerCoords = map ((\[x, y] -> (x,y)) . (map read) . words) flowerLines :: [(Int,Int)]
  let dist2A = map (dist2 (x1,y1)) flowerCoords
      dist2B = map (dist2 (x2,y2)) flowerCoords
      flowerR2s = zip dist2A dist2B
  let (r2a,r2b) = foldl grow1 (0,0) flowerR2s
      (r2a',r2b') = shrink (r2a,r2b) flowerR2s
  putStrLn $ show (r2a' + r2b')

module Main where

dist2 :: (Int,Int) -> (Int,Int) -> Integer
dist2 (x1,y1) (x2,y2) = (toInteger $ x1 - x2) ^ 2 + (toInteger $ y1 - y2) ^ 2

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

main :: IO ()
main = do
  line1 <- getLine
  let [n, x1, y1, x2, y2] = (map read . words) line1 :: [Int]
  flowerLines <- getLines n
  let flowerCoords = map ((\[x, y] -> (x,y)) . (map read) . words) flowerLines :: [(Int,Int)]
  let dist2A = map (dist2 (x1,y1)) flowerCoords
      dist2B = map (dist2 (x2,y2)) flowerCoords
  let (rA2,rB2) = foldl compute (0,0) (zip dist2A dist2B)
  putStrLn $ show (rA2 + rB2)
    where compute (rA2,rB2) (r2toA,r2toB)
            | r2toA <= rA2              = (rA2,rB2)
            | r2toB <= rB2              = (rA2,rB2)
            | r2toA + rB2 < rA2 + r2toB = (r2toA,rB2)
            | otherwise                 = (rA2,r2toB)

--where compute (rA2,rB2) (r2toA,r2toB)
--        | r2toA <= rA2  = (rA2,rB2)
--        | r2toB <= rB2  = (rA2,rB2)
--        | r2toA < r2toB = (r2toA,rB2)
--        | otherwise     = (rA2,r2toB)

module Main where

dist2 :: (Int,Int) -> (Int,Int) -> Integer
dist2 (x1,y1) (x2,y2) = (toInteger $ x1 - x2) ^ 2 + (toInteger $ y1 - y2) ^ 2

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
  line <- getLine
  rest <- getLines (n-1) -- sadly, not tail recursion
  return $ line:rest

main :: IO ()
main = do
  line1 <- getLine
  let [n, x1, y1, x2, y2] = (map read . words) line1 :: [Int]
  flowerLines <- getLines n
  let flowerCoords = map ((\[xStr, yStr] -> (read xStr, read yStr)) . words) flowerLines :: [(Int,Int)]
  let dist2A = map (dist2 (x1,y1)) flowerCoords
      dist2B = map (dist2 (x2,y2)) flowerCoords
  let (rA2,rB2) = foldl compute (0,0) (zip dist2A dist2B)
  putStrLn $ show (rA2 + rB2)
    where compute (rA2,rB2) (r2toA,r2toB)
            | r2toA <= rA2  = (rA2,rB2)
            | r2toB <= rB2  = (rA2,rB2)
            | r2toA < r2toB = (r2toA,rB2)
            | otherwise     = (rA2,r2toB)


Kyoya Ootori has a bag with n colored balls that are colored with k different colors. The colors are labeled from 1 to k. Balls of the same color are indistinguishable. He draws balls from the bag one by one until the bag is empty. He noticed that he drew the last ball of color i before drawing the last ball of color i + 1 for all i from 1 to k - 1. Now he wonders how many different ways this can happen.

The first line of input will have one integer k (1 ≤ k ≤ 1000) the number of colors. Then, k lines will follow. The i-th line will contain ci, the number of balls of the i-th color (1 ≤ ci ≤ 1000). The total number of balls doesn't exceed 1000.

A single integer, the number of ways that Kyoya can draw the balls from the bag as described in the statement, modulo 1 000 000 007.

NoteIn the first sample, we have 2 balls of color 1, 2 balls of color 2, and 1 ball of color 3. The three ways for Kyoya are: 1 2 1 2 31 1 2 2 32 1 1 2 3

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.Array.IArray as IA
import Data.Array.Unboxed as UA
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

solve :: [Int] -> Integer
solve [x] = 1
solve (x:xs) =
  let
    k = x - 1
    n = sum(xs) + k
  in
    ((newton n k) * (solve xs)) `mod` 1000000007

newton n k = fac n `div` (fac k * fac (n - k))

factorials :: IA.Array Int Integer
factorials = IA.listArray (0, 1000) $ L.scanl (*) 1 [1..1000]

fac :: Int -> Integer
fac x = factorials IA.! x

main = do
  !k <- readInt <$> getLine
  !gs <- reverse <$> forM [1..k] (const (readInt <$> getLine))
  print $ solve gs

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

solve :: [Integer] -> Integer
solve [x] = 1
solve (x:xs) =
  let
    k = x - 1
    n = sum(xs) + k
  in
    ((newton n k) * (solve xs)) `mod` 1000000007

newton n k = fac n `div` (fac k * fac (n - k))

fac 0 = 1
fac n = n * (fac (n - 1))

main = do
  k <- readInt <$> getLine
  gs <- reverse <$> forM [1..k] (const (fromIntegral . readInt <$> getLine))
  print $ solve gs

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

f::Integer->Integer
f n = product [1..n]

main= do
	getLine
	t<- map read. words <$> getContents::IO [Integer]
	let n = sum t
	let ans1 =  product (  map f t )
	let ans2 = f n
      	let ans = div ans2  ans1
	let t1 = product $ scanl1 (+) t
	let t2 = product t
	print $ mod (div (ans *t2) t1) 1000000007

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

f::Integer->Integer
f n = product [1..n]

main= do
	getLine
	t<- map read. words <$> getContents::IO [Integer]
	let n = sum t
	let ans1 =  product (  map f t )
	let ans2 = f n
      	let ans = div ans2  ans1
	print ans
	let t1 = product $ scanl1 (+) t
	let t2 = product t
	print $ mod (div (ans *t2) t1) 1000000007

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

f::Integer->Integer
f n = product [1..n]

main= do
	getLine
	t<- map read. words <$> getContents::IO [Integer]
	let n = sum t
	let ans1 =  product (  map f t )
	let ans2 = f n
      	let ans = div ans2  ans1
	let t1 = product $ scanl1 (+) t
	let t2 = product t
	print $ div (ans *t2) t1


You are given an integer $$$n$$$. Find any string $$$s$$$ of length $$$n$$$ consisting only of English lowercase letters such that each non-empty substring of $$$s$$$ occurs in $$$s$$$ an odd number of times. If there are multiple such strings, output any. It can be shown that such string always exists under the given constraints.A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3 \cdot 10^5$$$.

For each test case, print a single line containing the string $$$s$$$. If there are multiple such strings, output any. It can be shown that such string always exists under the given constraints.

NoteIn the first test case, each substring of "abc" occurs exactly once.In the third test case, each substring of "bbcaabbba" occurs an odd number of times. In particular, "b" occurs $$$5$$$ times, "a" and "bb" occur $$$3$$$ times each, and each of the remaining substrings occurs exactly once.

{-# LANGUAGE Strict #-}
{-# LANGUAGE LambdaCase #-}
import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = solve <$> int

solve :: Int -> String
solve n
  | n <= 3 = take n ['a'..'z']
  | odd n = let s = replicate (n `div` 2) 'a' in s ++ ("bc" ++ tail s)
  | even n = let s = replicate (n `div` 2) 'a' in s ++ ('b' : tail s)

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)


A bracket sequence is a string containing only characters "(" and ")". A regular bracket sequence is a bracket sequence that can be transformed into a correct arithmetic expression by inserting characters "1" and "+" between the original characters of the sequence. For example, bracket sequences "()()" and "(())" are regular (the resulting expressions are: "(1)+(1)" and "((1+1)+1)"), and ")(", "(" and ")" are not.Subsequence is a sequence that can be derived from another sequence by deleting some elements without changing the order of the remaining elements.You are given a regular bracket sequence $$$s$$$ and an integer number $$$k$$$. Your task is to find a regular bracket sequence of length exactly $$$k$$$ such that it is also a subsequence of $$$s$$$.It is guaranteed that such sequence always exists.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \le k \le n \le 2 \cdot 10^5$$$, both $$$n$$$ and $$$k$$$ are even) — the length of $$$s$$$ and the length of the sequence you are asked to find. The second line is a string $$$s$$$ — regular bracket sequence of length $$$n$$$.

Print a single string — a regular bracket sequence of length exactly $$$k$$$ such that it is also a subsequence of $$$s$$$. It is guaranteed that such sequence always exists.

toint s = (read s) :: Int

doit [] k [] = ""
doit (x:xs) k s =
  if x == '(' then
    if k > 0 then
      '(':(doit xs (k-1) (True:s))
    else
      doit xs (k-1) (False:s)
  else
    let b = head s in
    if b then
      ')': (doit xs k $ tail s)
    else
      doit xs k $ tail s

solve::String -> String
solve ss =
  let _:kk:s:_ = words ss in
  let k = div (toint kk)  2 in
  (doit s k []) ++ "\n"

main = interact solve


There are $$$n$$$ athletes in front of you. Athletes are numbered from $$$1$$$ to $$$n$$$ from left to right. You know the strength of each athlete — the athlete number $$$i$$$ has the strength $$$s_i$$$.You want to split all athletes into two teams. Each team must have at least one athlete, and each athlete must be exactly in one team.You want the strongest athlete from the first team to differ as little as possible from the weakest athlete from the second team. Formally, you want to split the athletes into two teams $$$A$$$ and $$$B$$$ so that the value $$$|\max(A) - \min(B)|$$$ is as small as possible, where $$$\max(A)$$$ is the maximum strength of an athlete from team $$$A$$$, and $$$\min(B)$$$ is the minimum strength of an athlete from team $$$B$$$.For example, if $$$n=5$$$ and the strength of the athletes is $$$s=[3, 1, 2, 6, 4]$$$, then one of the possible split into teams is:   first team: $$$A = [1, 2, 4]$$$,  second team: $$$B = [3, 6]$$$. In this case, the value $$$|\max(A) - \min(B)|$$$ will be equal to $$$|4-3|=1$$$. This example illustrates one of the ways of optimal split into two teams.Print the minimum value $$$|\max(A) - \min(B)|$$$.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case consists of two lines.  The first line contains positive integer $$$n$$$ ($$$2 \le n \le 50$$$) — number of athletes.  The second line contains $$$n$$$ positive integers $$$s_1, s_2, \ldots, s_n$$$ ($$$1 \le s_i \le 1000$$$), where $$$s_i$$$ — is the strength of the $$$i$$$-th athlete. Please note that $$$s$$$ values may not be distinct.

For each test case print one integer — the minimum value of $$$|\max(A) - \min(B)|$$$ with the optimal split of all athletes into two teams. Each of the athletes must be a member of exactly one of the two teams.

NoteThe first test case was explained in the statement. In the second test case, one of the optimal splits is $$$A=[2, 1]$$$, $$$B=[3, 2, 4, 3]$$$, so the answer is $$$|2-2|=0$$$.

module Main where

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        arr <- sort <$> map (read) <$> words <$> getLine
        print $ f arr

f :: [Int] -> Int
f (x:y:[]) = y - x
f (x:y:xs) = min (y - x) (f (y:xs))

import           Data.List
import           Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t solve

solve :: IO ()
solve = do
    _  <- getLine
    as <- map read . words <$> getLine
    let as' = sort as
    print . minimum $ zipWith (-) (tail as') as'

{-- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- map read . words <$> getLine
    print $ minimum $ zipWith subtract <*> tail $ sort as

import Control.Monad (replicateM_)
import Data.List (sort)

maxInt = maxBound :: Int

minAbsDiff z (x, y) = min z $ abs (x - y)

readLine = read <$> getLine

getMinDiff xs =
    foldl minAbsDiff maxInt (zip ys (tail ys)) where ys = sort xs

getAthletes =
    readLine >> (map read) . words <$> getLine

main =
    readLine >>= \t ->
    replicateM_ t (getMinDiff <$> getAthletes >>= print)

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_
    t
    (do getLine
        s <- solve . map read . words <$> getLine
        print s)

solve :: [Int] -> Int
solve l = minimum $ zipWith (-) (tail x) x
  where
    x = sort l

import Control.Monad
import Data.List

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t (getLine >> getLine >>= print . solve . map read . words)

solve :: [Int] -> Int
solve l = minimum $ zipWith (-) (tail x) x
  where
    x = sort l

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/B

import Control.Monad ( replicateM_ )

honestCoach :: [Int] -> Int
honestCoach = minSeparation . quickSort

quickSort :: Ord a => [a] -> [a]
quickSort [] = []
quickSort [x] = [x]
quickSort a = quickSort l ++ pivot : quickSort r
    where l = filter (<=pivot) rest
          r = filter ( >pivot) rest
          (pivot : rest) = a

minSeparation :: (Ord a, Num a) => [a] -> a
minSeparation a = minimum $ zipWith subtract a (tail a)

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

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (honestCoach <$> readInput >>= print)

import Control.Monad ( replicateM_ )

readInput = getLine >> (map read . words <$> getLine)

honestCoach :: [Int] -> Int
honestCoach s = minDiff (quickSort s)

quickSort [] = []
quickSort [x] = [x]
quickSort a = quickSort l ++ pivot:quickSort r
    where l = filter (<=pivot) rest
          r = filter ( >pivot) rest
          (pivot:rest) = a

minDiff a = foldr min maxBound $ map (uncurry subtract) $ zip a (tail a)

main = do
    t <- read <$> getLine
    replicateM_ t (honestCoach <$> readInput >>= print)

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

onecase = do
		getLine
		a<- sort<$> map read <$> words <$> getLine ::IO [Int]
		print $ minimum $ zipWith (\c d-> c-d) (tail a) a

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

import Data.List (sort)
import Data.Traversable (for)

solveCase :: [Int] -> Int
solveCase li = let  sli = sort li  in  minimum $ zipWith (-) (tail sli) sli

main :: IO ()
main = do
  nCases <- fmap read getLine :: IO Int
  _ <- for [1..nCases] $ \_ -> do
    _ <- fmap read getLine :: IO Int
    s <- fmap (map read . words) getLine
    print $ solveCase s
  return ()