{-# LANGUAGE TupleSections #-}
import Control.Monad ( replicateM_ )
import Data.List ( sortOn )

evensThenOdds = sortOn (`mod` 2)

pairs (x : xs) = map (x,) xs ++ pairs xs
pairs _ = []

maxGoodIndices :: [Int] -> Int
maxGoodIndices = length . filter isGood . pairs . evensThenOdds
    where isGood (a, b) = gcd a (2 * b) > 1

main = do n <- read <$> getLine
          replicateM_ n (getLine >> getLine >>= print . solve)
    where solve = maxGoodIndices . map read . words

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    print $ sum [1 | (x:ys) <- tails $ sortOn odd a, y <- ys, gcd x (2 * y) > 1]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    print $ sum $ [fromEnum $ gcd x (2 * y) > 1 | (x:ys) <- tails $ sortOn odd a, y <- ys]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

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

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

readInts = fmap (map read.words) getLine :: IO [Integer]
fori [x]  = 0
fori (x:xs) = forj x xs + fori xs

forj x [] = 0
forj x (y:xs) = forj x xs + if (gcd x (2*y) > 1) then 1 else 0

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let o = [x|x<-a, odd x]
        e = [x|x<-a, even x]
    let b = (reverse $ sort e) ++ (reverse $ sort o)
    print $ fori b

main = do
    t<-readLn :: IO Int
    replicateM_ t printS

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

solve a = length [ 1 | (x:rest) <- tails a , y <- rest, gcd x (2*y) > 1 ]

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- getLine
    a <- map read . words <$> getLine
    print $ solve $ filter even a ++ filter odd a

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

main :: IO ()
main = interact $ lines >>> drop 1 >>> chunksOf 2
         >>> map (last >>> words >>> map read >>> solve >>> show) >>> unlines

count :: (a -> Bool) -> [a] -> Int
count f = length . filter f

solve :: [Int] -> Int
solve xs = (`div` 2) $ count id [True | x <- xs, y <- xs, even x || even y || gcd x y > 1] - count (> 1) xs

import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import System.IO
import System.IO.Unsafe

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        BS.getLine
        xs <- sortOn (`mod` 2) . map parseInt . BS.words <$> BS.getLine
        print $ sum [1 | (x:ys) <- tails xs, y <- ys, gcd x (2*y) > 1]

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = readInt >>= flip replicateM solve

solve = do
	getLine
	as <- readInts
	print $ sum $ do
		( a1, i ) <- zip as [ 0 .. ]
		( a2, j ) <- zip as [ 0 .. ]
		guard $ i < j
		return $ if 1 < gcd a1 a2 || ( a1 `mod` 2 == 0 || a2 `mod` 2 == 0 )
			then 1
			else 0

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

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

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

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- (\(s1, s2) -> s1 ++ s2) . partition even <$> getInts
    let ts = take n $ tails as
        result = sum[1 | (x : xs) <- ts, y <- xs, gcd x (2 * y) > 1]
    return $ intDec result `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad ( replicateM_ )

evens = filter even
odds = filter odd
evensThenOdds = (++) . evens <*> odds

pairsWith f (x : xs) = map (f x) xs ++ pairsWith f xs
pairsWith _ _ = []

maxGoodIndices :: [Int] -> Int
maxGoodIndices = length . filter id . pairsWith isGood . evensThenOdds
    where isGood a b = gcd a (2 * b) > 1

main = do n <- read <$> getLine
          replicateM_ n (getLine >> getLine >>= print . solve)
    where solve = maxGoodIndices . map read . words

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

readInts = fmap (map read.words) getLine :: IO [Integer]
fori [x]  = 0
fori (x:xs) = forj x xs + fori xs

forj x [] = 0
forj x (y:xs) = forj x xs + if (gcd x (2*y) > 1) then 1 else 0

printS = do
    n<-readLn :: IO Int
    a<-readInts
    let b = reverse $ sort a
    print $ fori b

main = do
    t<-readLn :: IO Int
    replicateM_ t printS


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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
              (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                (if ((length ll) == 2) then ll else
                  (if ((length rr) == 2) then rr else
                    (if ((length ll) == 1) then ll else
                      (if ((length rr) == 1) then rr else
                        (if (ar /= []) then [head ar] else
                          (if (bl /= []) then [head bl] else
                            (if (al /= []) then [head al] else
                              (if (br /= []) then [head br] else
                                []
                                  ))))))))))
           | otherwise = if (((length lr) == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))
    ll = (gg al bl k (div i 2))
    rr = (gg ar br k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.Bits
import Data.Foldable
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

data MaxLenList = MaxLenList { len :: !Int, vals :: [Int] }

instance Semigroup MaxLenList where
    a <> b = if len a >= len b then a else b

instance Monoid MaxLenList where
    mempty = MaxLenList 0 []

data Trie = Leaf { getList :: !MaxLenList }
          | Node { getList :: !MaxLenList, l_ :: Trie, r_ :: Trie }

addToList :: Int -> MaxLenList -> MaxLenList
addToList v (MaxLenList l vs) = MaxLenList (l + 1) (v:vs)

highestBit :: Int
highestBit = 29

empty :: Trie
empty = foldl' (const . join (Node mempty)) (Leaf mempty) [0..highestBit]

setMax :: Int -> MaxLenList -> Trie -> Trie
setMax x v' = go highestBit where
    go _ (Leaf v) = Leaf (v <> v')
    go i (Node v l r)
        | x `testBit` i = Node (v <> v') l              (go (i - 1) r)
        | otherwise     = Node (v <> v') (go (i - 1) l) r

getMax :: Int -> Int -> Trie -> MaxLenList
getMax k x = go highestBit where
    go _ (Leaf v) = v
    go i (Node _ l r) = case (k `testBit` i, x `testBit` i) of
        (False, False)  -> go (i - 1) l <> getList r
        (False, True)   -> getList l    <> go (i - 1) r
        (True,  False)  -> go (i - 1) r
        (True,  True)   -> go (i - 1) l

solve :: IO ()
solve = do
    ~[_, k] <- readInts
    as <- sort . flip zip [1 :: Int ..] <$> readInts
    let f t (ai, i) = (t', best) where
            best = addToList i $ getMax k ai t
            t' = setMax ai best t
        ans = foldMap' id $ snd $ mapAccumL f empty as
    putStr $ unlines $ if len ans >= 2
        then [show $ len ans, unwords $ map show $ vals ans]
        else ["-1"]

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

main :: IO ()
main = solve

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                 (if (ar /= []) then [head ar] else
                   (if (bl /= []) then [head bl] else
                     (if (al /= []) then [head al] else
                      (if (br /= []) then [head br] else
                        []
                          ))))))
           | otherwise = if (((length lr) == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else
                 (if (ar /= []) then [head ar] else
                   (if (bl /= []) then [head bl] else
                     (if (al /= []) then [head al] else
                      (if (br /= []) then [head br] else
                        []
                          ))))))
           | otherwise = if ((length lr == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if ((length lr == 2) || (length lr) > (length rl)) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] && b == []) = []
           | (a == []) = [head b]
           | (b == []) = [head a]
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (lr /= []) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] || b == []) = []
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (lr /= []) then lr else rl
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    lr = (gg al br k (div i 2))
    rl = (gg ar bl k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

-- 1000

gg a b k i | (a == [] || b == []) = []
           | i == 0 = [head a] ++ [head b]
           | (((.&.) k i) == 0) = (if ((al /= []) && (br /= [])) then ([head al] ++ [head br]) else
               (if ((ar /= []) && (bl /= [])) then ([head ar] ++ [head bl]) else []))
           | otherwise = if (gl /= []) then gl else gr
  where
    al = [x | x <- a, ((.&.) (fst x) i) /= 0]
    ar = [x | x <- a, ((.&.) (fst x) i) == 0]
    bl = [x | x <- b, ((.&.) (fst x) i) /= 0]
    br = [x | x <- b, ((.&.) (fst x) i) == 0]
    gl = (gg al br k (div i 2))
    gr = (gg al br k (div i 2))

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = gg l r k (div i 2)
          -- (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

-- 1111
-- 2 8
-- 2 14

--- 1111

--- 110101

    -- 00
    -- 01
    -- 10
    -- 11

--- 1
---

-- 0010
-- 1110

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'

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

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

import Data.List
import Data.Bits
-- import Data.Vector.Unboxed
import qualified Data.Map as M

rev :: Int -> State [Int] ()
rev k = do
  ~(sp, ss) <- splitAt k <$> get
  put (reverse sp ++ ss)

solve :: Int -> State [Int] [Int]
solve 1 = pure []
solve n = do
  ~(Just npos) <- elemIndex n <$> get
  rev (npos + 1)
  ~(Just ppos) <- elemIndex (n-1) <$> get
  rev ppos
  rev (ppos + 2)
  rev 3
  rev n
  (\res -> npos + 1 : ppos : ppos + 2 : 3 : n : res) <$> solve (n-2)

ff a k i | (i == 0 || (length a) <= 1) = a
         | (((.&.) k i) == 0) = (ff l k (div i 2)) ++ ((ff r k (div i 2)))
         | otherwise = (if (l == []) then [] else [head l]) ++ (if (r == []) then [] else [head r])
  where
    l = [x | x <- a, ((.&.) (fst x) i) /= 0]
    r = [x | x <- a, ((.&.) (fst x) i) == 0]

-- encode a i | ((length a) == 0) = (M.empty)
   --        | otherwise = M.insert (head a) i (encode (tail a) (i+1))

-- encode a i | ((length a) == 0) = (M.empty)
           -- | otherwise = M.insert 1 2 M.empty --(M.insert 1 1 M.empty)

-- decode a hash | (length a == 0) = []
              -- | otherwise = [head (hash M.! (head a))] ++ (decode (tail a) (M.insert (head a) (tail (hash M.! (head a))) hash))

encode a i | (a == []) = []
           | otherwise = [(head a, i)] ++ (encode (tail a) (i+1))

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
    [n, k] <- getInts 2
    a <- getInts n
    let
      aa = encode a 1
      ans = ff aa k 1073741824
    if (length ans <= 1) then putInts [-1] else putInts [length (map snd ans)] >> putInts (map snd ans)

type SP = StateT [P.ByteString]
type SIO = SP IO

getNext :: Monad m => Int -> SP m [P.ByteString]
getNext = state . splitAt

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'


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

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'

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

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

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

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


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

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


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

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

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


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


{-# 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.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 ' ')

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

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


{-# 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' == 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))

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)


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

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


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" $ sum as - maximum as < maximum as || odd (sum as)

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


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

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

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


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)

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)

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


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

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

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


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

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

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