Suppose you are given two strings $$$a$$$ and $$$b$$$. You can apply the following operation any number of times: choose any contiguous substring of $$$a$$$ or $$$b$$$, and sort the characters in it in non-descending order. Let $$$f(a, b)$$$ the minimum number of operations you have to apply in order to make them equal (or $$$f(a, b) = 1337$$$ if it is impossible to make $$$a$$$ and $$$b$$$ equal using these operations).For example:   $$$f(\text{ab}, \text{ab}) = 0$$$;  $$$f(\text{ba}, \text{ab}) = 1$$$ (in one operation, we can sort the whole first string);  $$$f(\text{ebcda}, \text{ecdba}) = 1$$$ (in one operation, we can sort the substring of the second string starting from the $$$2$$$-nd character and ending with the $$$4$$$-th character);  $$$f(\text{a}, \text{b}) = 1337$$$. You are given $$$n$$$ strings $$$s_1, s_2, \dots, s_k$$$ having equal length. Calculate $$$\sum \limits_{i = 1}^{n} \sum\limits_{j = i + 1}^{n} f(s_i, s_j)$$$.

The first line contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of strings. Then $$$n$$$ lines follow, each line contains one of the strings $$$s_i$$$, consisting of lowercase Latin letters. $$$|s_1| = |s_2| = \ldots = |s_n|$$$, and $$$n \cdot |s_1| \le 2 \cdot 10^5$$$. All these strings are pairwise distinct.

Print one integer: $$$\sum \limits_{i = 1}^{n} \sum\limits_{j = i + 1}^{n} f(s_i, s_j)$$$.

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Function
import Data.Int
import Data.List
import qualified Data.IntMap as M

-- Using Um_nik's neat approach in O(s log s), s = sum of lengths of the strings

type IntArray = Array Int Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- replicateM n getLine
    let sa = reverse $ sort $ map (\x -> (sort x, x)) a
        gs = map snd <$> groupBy ((==) `on` fst) sa
        n64 = fromIntegral n
    print $ 1337 * n64 * (n64 - 1) `div` 2 - sum (map calcSaved gs)

calcSaved :: [String] -> Int64
calcSaved g = saved where
    n = length g
    m = length $ head g
    getLcp s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2
    getNotSorted s = listArray (0, length a - 1) a :: IntArray where
        a = map (+1) (elemIndices True $ zipWith (<) (tail s) s) ++ [m]
    lookup = mkLookup n m g
    calc :: Int -> String -> String -> [(Int, Int)] -> (Int64, [(Int, Int)])
    calc i curs prvs st = (total, st') where
        ns = getNotSorted curs
        st' = (lcp, i - 1) : dropWhile ((>= lcp) . fst) st where lcp = getLcp curs prvs
        calcSt :: (Int, Int) -> (Int, Int) -> Int64
        calcSt (lcp, curi) (_, prvi) = fromIntegral cnt where
            nxt = ns ! binSearchA (> lcp) ns
            ar = lookup!(i, nxt)
            cnt = binSearchA (> curi) ar - binSearchA (> prvi) ar
        total = foldl' f 0 $ zip st' (tail st') where f acc (cur, last) = acc + calcSt cur last
    total = fst $ foldl' f (0, [(-1, -1)]) $ zip3 [1..] (tail g) g where
        f (acc, st) (i, curs, prvs) = (acc + acc', st') where (acc', st') = calc i curs prvs st
    saved = one * 1336 + two * 1335 where
        one = total
        n64 = fromIntegral n
        two = n64 * (n64 - 1) `div` 2 - one

data Trie = Node (M.IntMap Trie) [Int]

emptyT :: Trie
emptyT = Node M.empty []

insertT :: Int -> String -> Trie -> Trie
insertT i [] (Node m is) = Node m (i:is)
insertT i (x:xs) (Node m is) = Node m' (i:is) where
    m' = M.insert o (insertT i xs $ M.findWithDefault emptyT o m) m
    o = fromEnum x

mkLookup :: Int -> Int -> [String] -> Array (Int, Int) IntArray
mkLookup n m g = runSTArray $ do
    a :: STArray s (Int, Int) IntArray <- newArray ((0, 0), (n - 1, m)) undefined
    let go :: Int -> Trie -> ST s ()
        go d (Node m is) = do
            let isa = listArray (0, length is - 1) is
            forM_ is $ \i -> writeArray a (i, d) isa
            forM_ (M.elems m) $ go (d - 1)
    go m $ foldr (uncurry insertT) emptyT $ zip [0..] $ map reverse g
    return a

binSearch :: (Integral i) => (i -> Bool) -> i -> i -> i
binSearch f l h
    | l >= h    = l
    | f m       = binSearch f l m
    | otherwise = binSearch f (m + 1) h
    where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l (r + 1) where (l, r) = bounds a

main :: IO ()
main = solve

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.IArray
import Data.Array.ST
import Data.Function
import Data.Int
import Data.List
import qualified Data.IntMap as M

-- Using Um_nik's neat approach in O(s log s), s = sum of lengths of the strings

type IntArray = Array Int Int

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- replicateM n getLine
    let sa = reverse $ sort $ map (\x -> (sort x, x)) a
        gs = map snd <$> groupBy ((==) `on` fst) sa
        n64 = fromIntegral n
    print $ 1337 * (n64 * (n64 - 1) `div` 2) - sum (map calcSaved gs)

calcSaved :: [String] -> Int64
calcSaved g = saved where
    n = length g
    m = length $ head g
    getLcp s1 s2 = length $ takeWhile id $ zipWith (==) s1 s2
    lookup = mkLookup n m g
    calc :: Int -> String -> String -> [(Int, Int)] -> (Int64, [(Int, Int)])
    calc i curs prvs st = (total, st') where
        gt = map (+1) $ elemIndices True $ zipWith (<) (tail curs) curs
        gtn = length gt
        gta = listArray (0, gtn - 1) gt :: IntArray
        st' = (lcp, i - 1) : dropWhile ((>= lcp) . fst) st where lcp = getLcp curs prvs
        calcSt :: (Int, Int) -> (Int, Int) -> Int64
        calcSt (l, curi) (_, prvi) = fromIntegral cnt where
            ar = lookup!(i, nxt) where
                j = binSearchA (> l) gta
                nxt = if j < gtn then gta!j else m
            cnt = binSearchA (> curi) ar - binSearchA (> prvi) ar
        total = foldl' f 0 $ zip st' (tail st') where f acc (cur, last) = acc + calcSt cur last
    total = fst $ foldl' f (0, [(-1, -1)]) $ zip3 [1..] (tail g) g where
        f (acc, st) (i, curs, prvs) = (acc + acc', st') where (acc', st') = calc i curs prvs st
    saved = one * 1336 + two * 1335 where
        one = total
        n64 = fromIntegral n
        two = (n64 * (n64 - 1) `div` 2) - one

data Trie = Node (M.IntMap Trie) [Int]

emptyT :: Trie
emptyT = Node M.empty []

insertT :: Int -> String -> Trie -> Trie
insertT i [] (Node m is) = Node m (i:is)
insertT i (x:xs) (Node m is) = Node m' (i:is) where
    m' = M.insert tx (insertT i xs $ M.findWithDefault emptyT tx m) m
    tx = fromEnum x - 97

mkLookup :: Int -> Int -> [String] -> Array (Int, Int) IntArray
mkLookup n m g = runSTArray $ r trie where
    trie = foldr f emptyT $ zip [0..] $ map reverse g where f (i, xs) t = insertT i xs t
    r t = do
        a :: STArray s (Int, Int) IntArray <- newArray ((0, 0), (n - 1, m)) undefined
        let go :: Int -> Trie -> ST s ()
            go d (Node m is) = do
                forM_ is $ \i -> writeArray a (i, d) $ listArray (0, length is - 1) is
                forM_ (M.elems m) $ go (d - 1)
        go m t
        return a

binSearch :: (Integral i) => (i -> Bool) -> i -> i -> i
binSearch f l h
    | l >= h    = l
    | f m       = binSearch f l m
    | otherwise = binSearch f (m + 1) h
    where m = (l + h) `div` 2

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = binSearch (f . (a!)) l (r + 1) where (l, r) = bounds a

main :: IO ()
main = solve


Berland Government decided to improve relations with neighboring countries. First of all, it was decided to build new roads so that from each city of Berland and neighboring countries it became possible to reach all the others. There are n cities in Berland and neighboring countries in total and exactly n - 1 two-way roads. Because of the recent financial crisis, the Berland Government is strongly pressed for money, so to build a new road it has to close some of the existing ones. Every day it is possible to close one existing road and immediately build a new one. Your task is to determine how many days would be needed to rebuild roads so that from each city it became possible to reach all the others, and to draw a plan of closure of old roads and building of new ones.

The first line contains integer n (2 ≤ n ≤ 1000) — amount of cities in Berland and neighboring countries. Next n - 1 lines contain the description of roads. Each road is described by two space-separated integers ai, bi (1 ≤ ai, bi ≤ n, ai ≠ bi) — pair of cities, which the road connects. It can't be more than one road between a pair of cities. No road connects the city with itself.

Output the answer, number t — what is the least amount of days needed to rebuild roads so that from each city it became possible to reach all the others. Then output t lines — the plan of closure of old roads and building of new ones. Each line should describe one day in the format i j u v — it means that road between cities i and j became closed and a new road between cities u and v is built. Cities are numbered from 1. If the answer is not unique, output any.

import Data.Array
import Data.Graph
import Data.Tree
import Control.Monad
import Control.Applicative
import Text.Printf

edgs tree = concat $ (map ((,) root . rootLabel) children) : map edgs children
    where root = rootLabel tree
          children = subForest tree

solve n ab = zip bad good
    where forest = components . buildG (1, n) $ ab
          rsv = concat $ map edgs forest
          bad = [(a,b) | (a,b) <- ab, notElem (a,b) rsv && notElem (b,a) rsv]
          good = (\x -> zip x $ tail x) $ map rootLabel forest

ints = map read . words <$> getLine

main = do
    [n] <- ints
    ab <- replicateM (n-1) ints
    let r = solve n $ map (\(a:b:_)->(a,b)) ab
    print $ length r
    forM_ r (\((i, j), (u, v)) -> printf "%d %d %d %d\n" i j u v)

import Data.Array
import Data.Graph
import Data.Tree
import Control.Monad
import Control.Applicative
import Text.Printf

mark n vss = array (1,n) $ concat [[(v, i) | v <- vs] | (i, vs) <- zip [1..] vss]

cc n ab = map flatten . components . buildG (1, n) $ ab

solve n ab = zip bad good
    where vss = cc n ab
          color = mark n vss
          bad = [(a, b) | (a, b) <- ab, color ! a == color ! b]
          good = (\x -> zip x $ tail x) $ map head vss

ints = map read . words <$> getLine

main = do
    [n] <- ints
    ab <- replicateM (n-1) ints
    let r = solve n $ map (\(a:b:_)->(a,b)) ab
    print $ length r
    forM_ r (\((i, j), (u, v)) -> printf "%d %d %d %d\n" i j u v)

import Data.Array
import Data.Graph
import Data.Tree
import Control.Monad
import Control.Applicative
import Text.Printf

edgs tree = concat $ (map ((,) root . rootLabel) children) : map edgs children
    where root = rootLabel tree
          children = subForest tree

solve n ab = zip bad good
    where forest = components . buildG (1, n) $ ab
          rsv = concat $ map edgs forest
          bad = [x | x <- ab, notElem x rsv]
          good = (\x -> zip x $ tail x) $ map rootLabel forest

ints = map read . words <$> getLine

main = do
    [n] <- ints
    ab <- replicateM (n-1) ints
    let r = solve n $ map (\(a:b:_)->(a,b)) ab
    print $ length r
    forM_ r (\((i, j), (u, v)) -> printf "%d %d %d %d\n" i j u v)


Katya studies in a fifth grade. Recently her class studied right triangles and the Pythagorean theorem. It appeared, that there are triples of positive integers such that you can construct a right triangle with segments of lengths corresponding to triple. Such triples are called Pythagorean triples.For example, triples (3, 4, 5), (5, 12, 13) and (6, 8, 10) are Pythagorean triples.Here Katya wondered if she can specify the length of some side of right triangle and find any Pythagorean triple corresponding to such length? Note that the side which length is specified can be a cathetus as well as hypotenuse.Katya had no problems with completing this task. Will you do the same?

The only line of the input contains single integer n (1 ≤ n ≤ 109) — the length of some side of a right triangle.

Print two integers m and k (1 ≤ m, k ≤ 1018), such that n, m and k form a Pythagorean triple, in the only line. In case if there is no any Pythagorean triple containing integer n, print  - 1 in the only line. If there are many answers, print any of them.

import Data.Int

getInt64 = read `fmap` getLine :: IO Int64
isqrt :: Int64 -> Int64
isqrt = floor . sqrt . fromIntegral
isSquare x = y * y == x where y = isqrt x

main = do
    n <- getInt64
    solve n

solve n = do
    if n <= 2
    then print (-1)
    else if odd n
    then do
        let n2 = n*n
        let a = n2 `div` 2
        let b = a + 1
        putStrLn $ show a ++ " " ++ show b
    else do
        let n2 = (n `div` 2)^2
        let a = n2 - 1
        let b = n2 + 1
        putStrLn $ show a ++ " " ++ show b

import Data.Int
import Data.List
import Control.Monad
import qualified Data.ByteString.Char8 as B

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

search :: Int64 -> Int64 -> Int64 -> Int64
search x l h = if l>=h then -1
                else if diff == x then m
                else if diff<x then search x (m+1) h else search x l m
                    where m = (l+h) `div` 2
                          diff = (m+1)^2 - m^2

pfactor 6 _ = 3
pfactor n [] = if n `rem` 2 == 0 then n `div` 2 else n
pfactor n (i:is)
 |n `rem` i == 0 = i
 |otherwise = pfactor n is

main = do
    [n] <- readIntList
    if n <= 2 then print (-1)
    else do
        if n `rem` 4 == 0 then do
            let x = n `div` 4
            putStrLn . unwords . map show $ [3*x,5*x]
        else do
            let a = pfactor n [3,5..(round . sqrt . fromIntegral $ n)]
                mult = n `div` a
                b = search (a^2) 1 (round (1e18)+10)
            if (b+1)^2 - b^2 /= a^2 then error "Fail" else putStrLn . unwords . map show $ [b*mult,(b+1)*mult]

-- 30 ms
import Data.Int
import Data.List
{-# OPTIONS_GHC -O #-}
import Control.Monad
import qualified Data.ByteString.Char8 as B

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

search x l h = if l>=h then -1
                else if diff == x then m
                else if diff<x then search x (m+1) h else search x l m
                    where m = (l+h) `div` 2
                          diff = (m+1)^2 - m^2

pfactor 6 _ = 3
pfactor n [] = if n `rem` 2 == 0 then n `div` 2 else n
pfactor n (i:is)
 |n `rem` i == 0 = i
 |otherwise = pfactor n is

main = do
    [n] <- readIntList
    if n <= 2 then print (-1)
    else do
        if n `rem` 4 == 0 then do
            let x = n `div` 4
            putStrLn . unwords . map show $ [3*x,5*x]
        else do
            let a = pfactor n [3,5..(round . sqrt . fromIntegral $ n)]
                mult = n `div` a
                b = search (a^2) 1 (round (1e18)+10)
            if (b+1)^2 - b^2 /= a^2 then error "Fail" else putStrLn . unwords . map show $ [b*mult,(b+1)*mult]

main = interact $ g.f
f x = read x :: Integer
g x
  | y < 5 = "-1"
  | y `rem` 4 /= 0 = (show a) ++ " " ++ (show (a+1))
  | otherwise = (show (b-1)) ++ " " ++ (show (b+1))
  where a = y `div` 2
        b = y `div` 4
        y = x*x

{-# OPTIONS_GHC -O2 #-}
import Data.Int (Int64)
import Data.List (genericLength)

main = do
  a <- readLn :: IO Integer

  let
    (b, c) = if even a then (a^2`div`4 - 1, a^2`div`4 + 1) else ((a^2-1) `div`2, (a^2+1)`div`2)

  if a == 1 || a == 2
     then print $ -1
     else putStrLn $ show b ++ " " ++ show c

main = getLine >>= putStrLn . f . read

f n
	| n <= 2 = "-1"
	| otherwise = show a ++ " " ++ show b
		where
			p = if n `mod` 2 == 0 then 2 else 1
			q = if n `mod` 2 == 0 then n ^ 2 `div` 2 else n ^ 2
			a = (q - p) `div` 2
			b = (q + p) `div` 2

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  n <- read @ Integer <$> getLine
  let (m, k) = solve n
  putStrLn $ if n < 3 then "-1" else show m ++ " " ++ show k

solve :: Integer -> (Integer, Integer)
solve n | odd n = let root1 = (n - 1) `div` 2
                      root2 = succ root1
                  in (2 * root1 * root2, root1 * root1 + root2 * root2)
solve n | even n = let root = n `div` 2
                   in (root * root - 1, root * root + 1)

main = interact $ unwords . map show . solve . read
solve n | n <= 2 = [-1]
        | odd n  = [(n^2+1) `div` 2, (n^2-1) `div` 2]
        | even n = [n^2 `div` 4 + 1, n^2 `div` 4 - 1]

module Main where
  import Data.List
  import Control.Monad
  import Data.Array

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

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

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

  pythagorasOf :: Integer -> Maybe (Integer, Integer)
  pythagorasOf x
    | x == 1 = Nothing
    | x == 2 = Nothing
    | x == 4 = Just (3, 5)
    | x `mod` 4 == 0 =
      let y = (x `div` 4) -1
          y1 = (y * x) + (x - 1)
          in return (y1, y1 + 2)
    | x `mod` 4 == 2 = do
       (a, b) <- pythagorasOf (x `div` 2)
       return (a * 2, b * 2)
    | x `mod` 2 == 1 =
      let y = x `div` 2
          y1 = (y * x) + y
          in return (y1, y1 + 1)

  strify :: Maybe (Integer, Integer) -> String
  strify Nothing = "-1"
  strify (Just (x, y)) = show x ++ " " ++ show y

  main :: IO()
  main = do
    x <- getLine >>= return . readInteger
    putStrLn $ strify$ pythagorasOf x

module Main where
  import Data.List
  import Control.Monad
  import Data.Array

  ($!$) :: Int -> () -> Int
  ($!$) 0 _ = 1
  ($!$) n _ = (n - 1) * (n $!$ ())

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

  readInteger :: String -> Integer
  readInteger s = read s :: Integer

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

  pythagorasOf :: Integer -> Maybe (Integer, Integer)
  pythagorasOf x
    | x == 1 = Nothing
    | x == 2 = Nothing
    | x == 3 = Just (4, 5)
    | x == 4 = Just (3, 5)
    | x `mod` 2 == 1 =
      let y = x `div` 2
          y1 = (y * x) + y
          in return (y1, y1 + 1)
    | otherwise = do
      (a, b) <- pythagorasOf (x `div` 2)
      return (a * 2, b * 2)

  strify :: Maybe (Integer, Integer) -> String
  strify Nothing = "-1"
  strify (Just (x, y)) = show x ++ " " ++ show y

  main :: IO()
  main = do
    x <- getLine >>= return . readInteger
    putStrLn $ strify$ pythagorasOf x

module Main where

import Control.Monad
import Prelude
import Text.Printf

solve :: Integer -> (Integer, Integer)
solve n | n <= 2    = (-1, -1)
        | odd n     = ((x + 1) `div` 2, (x + 1) `div` 2 - 1)
        | otherwise = ((x `div` 4) + 1, (x `div` 4) - 1)
        where x = n * n

main = do
    n <- liftM read getLine
    let (a, b) = solve n
    if a < 0 then printf "%d\n" a
    else printf "%d %d\n" a b

process :: String -> String
process str =
  let n = read str
      r = if even n then n - 2 else n - 1
      s = if even n then 2 else 1
      t = div (r*r) (2*s)
  in
    if n < 3
    then "-1"
    else show (r + t) ++ " " ++ show (r + s + t)

main :: IO ()
main = interact process

main = interact $ printRes . sol . read
    where
    printRes [] = "-1"
    printRes [a, b] = show a ++ " " ++ show b

sol :: Integer -> [Integer]
sol 1 = []
sol 4 = [3, 5]
sol n
    | n `mod` 2 == 0 = map (*2) $ sol (n `div` 2)
    | otherwise = [2*k*k + 2*k, 2*k*k + 2*k + 1]
    where
    k = (n-1) `div` 2

import Data.Int
import Data.List
import Control.Monad
import qualified Data.ByteString.Char8 as B

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

search :: Int64 -> Int64 -> Int64 -> Int64
search x l h = if l>=h then -1
                else if diff == x then m
                else if diff<x then search x (m+1) h else search x l m
                    where m = (l+h) `div` 2
                          diff = (m+1)^2 - m^2

pfactor 6 _ = 3
pfactor n [] = n
pfactor n (i:is)
 |n `rem` i == 0 = i
 |otherwise = pfactor n is

main = do
    [n] <- readIntList
    if n <= 2 then print (-1)
    else do
        if n `rem` 4 == 0 then do
            let x = n `div` 4
            putStrLn . unwords . map show $ [3*x,5*x]
        else do
            let a = pfactor n [3,5..(round . sqrt . fromIntegral $ n)]
                mult = n `div` a
                b = search (a^2) 1 (round (1e18))
            putStrLn . unwords . map show $ [b*mult,(b+1)*mult]

import Data.Int
import Data.List
import Control.Monad
import qualified Data.ByteString.Char8 as B

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

search :: Int64 -> Int64 -> Int64 -> Int64
search x l h = if l>=h then -1
                else if diff == x then m
                else if diff<x then search x (m+1) h else search x l m
                    where m = (l+h) `div` 2
                          diff = (m+1)^2 - m^2

pfactor n [] = n
pfactor n (i:is)
 |n `rem` i == 0 = i
 |otherwise = pfactor n is

main = do
    [n] <- readIntList
    if n <= 2 then print (-1)
    else do
        if n `rem` 4 == 0 then do
            let x = n `div` 4
            putStrLn . unwords . map show $ [3*x,5*x]
        else do
            let a = pfactor n [3,5..(round . sqrt . fromIntegral $ n)]
                mult = n `div` a
                b = search (a^2) 1 (round (1e18))
            putStrLn . unwords . map show $ [b*mult,(b+1)*mult]

main = interact $ g.f
f x = read x :: Int
g x
  | x <= 2 = "-1"
  | odd x = (show j) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show a) ++ " " ++ (show (a+2))
  where j = ((x^2 + 1) `div` 2)
        i = j^2 - x^2
        a = (x `div` 2)^2 -1

main = interact $ g.f
f x = read x :: Int
g x
  | x <= 2 = "-1"
  | odd x = (show j) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show a) ++ " " ++ (show (floor (sqrt (fromIntegral b))))
  where j = ((x^2 + 1) `div` 2)
        i = j^2 - x^2
        a = (x `div` 2)^2 -1
        b = a + 2

main = interact $ g.f
f x = read x :: Int
g x
  | x <= 2 = "-1"
  | odd x = (show j) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show a) ++ " " ++ (show (floor (sqrt (fromIntegral b))))
  where j = ((x^2 + 1) `div` 2)
        i = j^2 - x^2
        a = ((x^2 + 4) `div` 4)
        b = a^2 - x^2

main = interact $ g.f
f x = read x :: Integer
g x
  | x <= 2 = "-1"
  | odd x = (show (floor (sqrt (fromIntegral j)))) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show (floor (sqrt (fromIntegral a)))) ++ " " ++ (show (floor (sqrt (fromIntegral b))))
  where j = ((x^2 + 1) `div` 2)^2
        i = j - x^2
        a = ((x^2 + 4) `div` 4)^2
        b = a - x^2

main = interact $ h.f
f x = read x :: Integer
h x
  | x <= 2 = "-1"
  | odd x = (show j) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show a) ++ " " ++ (show (floor (sqrt (fromIntegral b))))
  where j = ((x^2 + 1) `div` 2)
        i = j^2 - x^2
        a = ((x^2 + 4) `div` 4)
        b = a^2 - x^2

main = interact $ g.f
f x = read x :: Integer
g x
  | x <= 2 = "-1"
  | odd x = (show j) ++ " " ++ (show (floor (sqrt (fromIntegral i))))
  | otherwise = (show a) ++ " " ++ (show (a+2))
  where j = ((x^2 + 1) `div` 2)
        i = j^2 - x^2
        a = (x `div` 2)^2 -1

{-# OPTIONS_GHC -O2 #-}
import Data.Int (Int64)
import Data.List (genericLength)

main = do
  a <- readLn :: IO Integer

  let
    k = (head $ dropWhile even $ iterate (`div` 2) a) `div` 2
    m = 2*2 ^ (genericLength $ takeWhile even $ iterate (`div` 2) a)
    (b, c) = (m*k^2 + m*k + (m`div`2), m*k^2 + m*k)

  if a == 1 || a == 2
     then print $ -1
     else if a == 4
       then putStrLn "3 5"
       else putStrLn $ show b ++ " " ++ show c

{-# OPTIONS_GHC -O2 #-}
import Data.Int (Int64)
import Data.List (genericLength)

main = do
  a <- readLn :: IO Int64

  let
    k = (head $ dropWhile even $ iterate (`div` 2) a) `div` 2
    m = 2*2 ^ (genericLength $ takeWhile even $ iterate (`div` 2) a)
    (b, c) = (m*k^2 + m*k + (m`div`2), m*k^2 + m*k)

  if a == 1 || a == 2
     then print $ -1
     else if a == 4
       then putStrLn "3 5"
       else putStrLn $ show b ++ " " ++ show c

{-# LANGUAGE TypeApplications #-}

main :: IO ()
main = do
  n <- read @ Integer <$> getLine
  let (m, k) = solve n
  putStrLn $ if n == 1 then "-1" else show m ++ " " ++ show k

solve :: Integer -> (Integer, Integer)
solve n | odd n = let root1 = (n - 1) `div` 2
                      root2 = succ root1
                  in (2 * root1 * root2, root1 * root1 + root2 * root2)
solve n | even n = let root = n `div` 2
                   in (root * root - 1, root * root + 1)

module Main where
  import Data.List
  import Control.Monad
  import Data.Array

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

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

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

  data Coordinat = Coordinat { x :: Int, y :: Int } deriving (Show, Eq)
  data Taxi = Taxi { coordinat :: Coordinat, speed :: Int } deriving (Show, Eq)

  mkTaxi :: String -> Taxi
  mkTaxi s =
    let [xi, yi, vi] = map readInt $ words s
        in Taxi (Coordinat xi yi) vi

  mkCoordinat :: [Int] -> Coordinat
  mkCoordinat [x,y] = Coordinat x y

  distance :: Floating a => Coordinat -> Coordinat -> a
  distance (Coordinat p q) (Coordinat x y) =
    let dx = fromIntegral $ p - x
        dy = fromIntegral $ q - y
        in (sqrt $ dx * dx + dy * dy)

  timeToArrive :: Floating a => Coordinat -> Taxi -> a
  timeToArrive co1@(Coordinat _ _) (Taxi co2@(Coordinat _ _) v) = (distance co1 co2) / (fromIntegral v)

  pythagorasOf :: Int -> Maybe (Int, Int)
  pythagorasOf x
    | x == 1 = Nothing
    | x == 2 = Nothing
    | x == 4 = Just (3, 5)
    | x `mod` 4 == 0 =
      let y = (x `div` 4) -1
          y1 = (y * x) + (x - 1)
          in return (y1, y1 + 2)
    | x `mod` 4 == 2 = do
       (a, b) <- pythagorasOf (x `div` 2)
       return (a * 2, b * 2)
    | x `mod` 2 == 1 =
      let y = x `div` 2
          y1 = (y * x) + y
          in return (y1, y1 + 1)

  strify :: Maybe (Int, Int) -> String
  strify Nothing = "-1"
  strify (Just (x, y)) = show x ++ " " ++ show y

  main :: IO()
  main = do
    x <- getLine >>= return . readInt
    putStrLn $ strify$ pythagorasOf x

    -- [x,y] <- getLine >>= return . (map readInt) . words
    -- n <- getLine >>= return . readInt
    -- taxis <- readMultilineInput n $ return . mkTaxi
    -- putStrLn $ show $ minimum $ map (timeToArrive (Coordinat x y)) taxis

module Main where

import Control.Monad
import Prelude
import Text.Printf

solve :: Int -> (Int, Int)
solve n | n <= 2    = (-1, -1)
        | odd n     = ((x + 1) `div` 2, (x + 1) `div` 2 - 1)
        | otherwise = ((x `div` 4) + 1, (x `div` 4) - 1)
        where x = n * n

main = do
    n <- liftM read getLine
    let (a, b) = solve n
    if a < 0 then printf "%d\n" a
    else printf "%d %d\n" a b

main = interact $ printRes . sol . read
    where
    printRes [] = "-1"
    printRes [a, b] = show a ++ " " ++ show b

sol :: Integer -> [Integer]
sol n
    | n == 1 = []
    | n `mod` 2 == 0 = map (*2) $ sol (n `div` 2)
    | otherwise = [2*k*k + 2*k, 2*k*k + 2*k + 1]
    where
    k = (n-1) `div` 2


Mrs. Smith is trying to contact her husband, John Smith, but she forgot the secret phone number!The only thing Mrs. Smith remembered was that any permutation of $$$n$$$ can be a secret phone number. Only those permutations that minimize secret value might be the phone of her husband.The sequence of $$$n$$$ integers is called a permutation if it contains all integers from $$$1$$$ to $$$n$$$ exactly once.The secret value of a phone number is defined as the sum of the length of the longest increasing subsequence (LIS) and length of the longest decreasing subsequence (LDS). A subsequence $$$a_{i_1}, a_{i_2}, \ldots, a_{i_k}$$$ where $$$1\leq i_1 < i_2 < \ldots < i_k\leq n$$$ is called increasing if $$$a_{i_1} < a_{i_2} < a_{i_3} < \ldots < a_{i_k}$$$. If $$$a_{i_1} > a_{i_2} > a_{i_3} > \ldots > a_{i_k}$$$, a subsequence is called decreasing. An increasing/decreasing subsequence is called longest if it has maximum length among all increasing/decreasing subsequences.For example, if there is a permutation $$$[6, 4, 1, 7, 2, 3, 5]$$$, LIS of this permutation will be $$$[1, 2, 3, 5]$$$, so the length of LIS is equal to $$$4$$$. LDS can be $$$[6, 4, 1]$$$, $$$[6, 4, 2]$$$, or $$$[6, 4, 3]$$$, so the length of LDS is $$$3$$$.Note, the lengths of LIS and LDS can be different.So please help Mrs. Smith to find a permutation that gives a minimum sum of lengths of LIS and LDS.

The only line contains one integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of permutation that you need to build.

Print a permutation that gives a minimum sum of lengths of LIS and LDS.  If there are multiple answers, print any.

NoteIn the first sample, you can build a permutation $$$[3, 4, 1, 2]$$$. LIS is $$$[3, 4]$$$ (or $$$[1, 2]$$$), so the length of LIS is equal to $$$2$$$. LDS can be ony of $$$[3, 1]$$$, $$$[4, 2]$$$, $$$[3, 2]$$$, or $$$[4, 1]$$$. The length of LDS is also equal to $$$2$$$. The sum is equal to $$$4$$$. Note that $$$[3, 4, 1, 2]$$$ is not the only permutation that is valid.In the second sample, you can build a permutation $$$[2, 1]$$$. LIS is $$$[1]$$$ (or $$$[2]$$$), so the length of LIS is equal to $$$1$$$. LDS is $$$[2, 1]$$$, so the length of LDS is equal to $$$2$$$. The sum is equal to $$$3$$$. Note that permutation $$$[1, 2]$$$ is also valid.

import Control.Monad
import Data.List

f :: Int -> Int -> Int -> Ordering
f st a b = case compare (a `div` st) (b `div` st) of
	GT -> LT
	LT -> GT
	EQ -> compare a b

main = do
	n <- readLn :: IO Int
	let st = snd . minimum . zip [k + (n + k - 1) `div` k | k <- [1..]] $ [1..n]
	putStrLn . unwords . map show . map succ . sortBy (f st) $ [0..n-1]


Let's consider all integers in the range from $$$1$$$ to $$$n$$$ (inclusive).Among all pairs of distinct integers in this range, find the maximum possible greatest common divisor of integers in pair. Formally, find the maximum value of $$$\mathrm{gcd}(a, b)$$$, where $$$1 \leq a < b \leq n$$$.The greatest common divisor, $$$\mathrm{gcd}(a, b)$$$, of two positive integers $$$a$$$ and $$$b$$$ is the biggest integer that is a divisor of both $$$a$$$ and $$$b$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$)  — the number of test cases. The description of the test cases follows. The only line of each test case contains a single integer $$$n$$$ ($$$2 \leq n \leq 10^6$$$).

For each test case, output the maximum value of $$$\mathrm{gcd}(a, b)$$$ among all $$$1 \leq a < b \leq n$$$.

NoteIn the first test case, $$$\mathrm{gcd}(1, 2) = \mathrm{gcd}(2, 3) = \mathrm{gcd}(1, 3) = 1$$$.In the second test case, $$$2$$$ is the maximum possible value, corresponding to $$$\mathrm{gcd}(2, 4)$$$.

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

main=interact$unlines.map(show.(`div`2).read).tail.words

import Control.Monad

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

routine :: IO ()
routine = do
  n <- readLn
  print $ (n `div` 2)

main = interact $ unlines . map (show . (flip div 2) . read) . tail . words

cardProd :: [a] -> [b] -> [(a,b)]
cardProd xs ys = [(x,y) | x<-xs, y<-ys]

solve :: Integer -> Integer
--solve n = foldr max 0 . map ( uncurry gcd) . filter (\(a,b)-> a<b) . cardProd [1..n] $ [1..n]
solve n = div n 2

parse :: String -> Integer
parse = read . head . words

solveCase :: Int -> IO()
solveCase 0 = return ()
solveCase t = do
  test <- getLine
  putStrLn . show . solve . parse  $ test
  solveCase (t-1)

getInt :: IO Int
getInt = fmap read getLine

main :: IO()
main = do
  n <- getInt
  solveCase n

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

process a = div a 2

main = do
		n<-read <$> getLine ::IO Int
		a<- map read <$> replicateM n getLine ::IO [Int]
		mapM_ print $ map  process a


You are given $$$n$$$ positive integers $$$a_1, \ldots, a_n$$$, and an integer $$$k \geq 2$$$. Count the number of pairs $$$i, j$$$ such that $$$1 \leq i < j \leq n$$$, and there exists an integer $$$x$$$ such that $$$a_i \cdot a_j = x^k$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \leq n \leq 10^5$$$, $$$2 \leq k \leq 100$$$). The second line contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^5$$$).

Print a single integer — the number of suitable pairs.

import qualified Data.Map.Strict as M
import Control.Arrow
import Data.List

factorsK :: Int -> Int -> [(Int, Int)]
factorsK k = filter ((/=0) . snd) . map (head &&& (`mod` k) . length) . group . go [] 2
  where
    go a c n
      | c * c > n = if n /= 1 then n:a else a
      | n `rem` c == 0 = go (c:a) c (n `div` c)
      | otherwise = go a (c + 1) n

folder k (hist, cnt) n = (M.insertWith (+) fcs 1 hist, cnt + M.findWithDefault 0 fi hist)
  where fcs = factorsK k n
        fi = filter ((/=0) . snd) $ map (\(f, c) -> (f, k - c)) fcs

rl = map read . words <$> getLine

main = do
  [_, k] <- rl
  inp <- rl

  print $ snd $ foldl' (folder k) (M.empty, 0) inp

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char
import Data.Semigroup
import Data.Monoid

aMax = 100000 :: Int

aMax64 = fromIntegral aMax :: Int64

main :: IO ()
main = do
  [n,k] <- map readInt . words <$> getLine
  as <- unfoldr (runStateT rIntS) <$> BS.getLine
  print $ query k as

maxPowerable :: UArray Int Int64
maxPowerable = A.array (1,100)
  $ [(1,100000),(2,316),(3,46),(4,17),(5,10),(6,6),(7,5),(8,4),(9,3),(10,3)]
  ++ map (,2) [11..16]
  ++ map (,1) [17..100]

corrPair :: Int -> Int -> Maybe (Int,Int)
corrPair k v_ = (\(x,y) -> (fromIntegral x, fromIntegral y))
  <$> foldM (\ (!red,!compl) (!p,!e) -> do
                let eRed = e `rem` k
                    eRev | eRed == 0 = 0
                         | otherwise = k-eRed
                guard $ eRev == 0 || p <= maxPowerable A.! eRev
                let !redNew   = red * p ^ eRed
                    !complNew = compl * p ^ eRev
                guard $ complNew <= aMax64
                return (redNew,complNew))
               (1::Int64,1::Int64)
               (primeDecp v)
   where v = fromIntegral v_

data DictElement
  = DE {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64
  | Same {-# UNPACK #-} !Int64

instance Semigroup DictElement where
  DE cntThis1 cntCompl1 <> DE cntThis2 cntCompl2
    = DE (cntThis1+cntThis2) (cntCompl1+cntCompl2)
  Same l0 <> Same l1 = Same (l0+l1)
  _ <> _ = undefined

query :: Int -> [Int] -> Int64
query k as = sum $ map match $ IM.elems dict
  where
    match (DE x y) = x*y
    match (Same x) = (x*x-x) `shiftR` 1
    dict
      = foldl'
        (\ !dict !a ->
           maybe dict
           (\(!red,!compl) ->
              case compare red compl of
                EQ -> IM.insertWith (<>) red (Same 1) dict
                LT -> IM.insertWith (<>) red (DE 1 0) dict
                GT -> IM.insertWith (<>) compl (DE 0 1) dict)
           $ corrPair k a)
        IM.empty
        as

#define IL(f) {-# INLINE f #-}; f

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

primes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,
          71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,
          151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,
          233,239,241,251,257,263,269,271,277,281,283,293,307,311,313]

primeDecp :: (Integral i, FiniteBits i) => i -> [(i,Int)]
primeDecp !n = (\f -> f (:)[]) $ \cons nil ->
  let !expt2 = countTrailingZeros n
      nDiv2 = n `unsafeShiftR` expt2
      start a | a > 1 = go (tail primes) a
              | otherwise = nil
      {-# INLINE start #-}
      go (!p:ps) !a | r == 0    = goExpt p ps q 1
                    | q > p     = go ps a
                    | otherwise = cons (a,1) nil
        where (!q,!r) = a `quotRem` p
      go [] !a | a == 1    = nil
               | otherwise = cons (a,1) nil
      goExpt !p ps 1 !j = cons (p,j) nil
      goExpt !p ps !a !j
        | r == 0    = goExpt p ps q (j+1)
        | otherwise = cons (p,j) $ if q > p then go ps a
                                            else cons (a,1) nil
        where (!q,!r) = a `quotRem` p
  in if expt2 /= 0 then cons (2,expt2) $ start nDiv2 else start n

-- unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char
import Data.Semigroup
import Data.Monoid

aMax = 100000 :: Int

aMax64 = fromIntegral aMax :: Int64

main :: IO ()
main = do
  [n,k] <- map readInt . words <$> getLine
  as <- unfoldr (runStateT rIntS) <$> BS.getLine
  print $ query k as

maxPowerable :: UArray Int Int64
maxPowerable = A.array (1,100)
  $ [(1,100000),(2,316),(3,46),(4,17),(5,10),(6,6),(7,5),(8,4),(9,3),(10,3)]
  ++ map (,2) [11..16]
  ++ map (,1) [17..100]

corrPair :: Int -> Int -> Maybe (Int,Int)
corrPair k v_ = (\(x,y) -> (fromIntegral x, fromIntegral y))
  <$> foldM (\ (!red,!compl) (!p,!e) -> do
                let eRed = e `rem` k
                    eRev | eRed == 0 = 0
                         | otherwise = k-eRed
                guard $ eRev == 0 || p <= maxPowerable A.! eRev
                let !redNew   = red * p ^ eRed
                    !complNew = compl * p ^ eRev
                guard $ complNew <= aMax64
                return (redNew,complNew))
               (1::Int64,1::Int64)
               (primeDecp v)
   where v = fromIntegral v_

data DictElement
  = DE {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64
  | Same {-# UNPACK #-} !Int64

instance Semigroup DictElement where
  DE cntThis1 cntCompl1 <> DE cntThis2 cntCompl2
    = DE (cntThis1+cntThis2) (cntCompl1+cntCompl2)
  Same l0 <> Same l1 = Same (l0+l1)
  _ <> _ = undefined

query :: Int -> [Int] -> Int64
query k as
  | k >= 34 = let x = fromIntegral $ length $ elemIndices 1 $ as :: Int64
              in shiftR (x*(x-1)) 1
  | otherwise = sum $ map match $ IM.elems dict
  where
    match (DE x y) = x*y
    match (Same x) = x * (x-1) `shiftR` 1
    dict
      = foldl'
        (\ !dict !a ->
           maybe dict
           (\(!red,!compl) ->
              case compare red compl of
                EQ -> IM.insertWith (<>) red (Same 1) dict
                LT -> IM.insertWith (<>) red (DE 1 0) dict
                GT -> IM.insertWith (<>) compl (DE 0 1) dict)
           $ corrPair k a)
        IM.empty
        as

#define IL(f) {-# INLINE f #-}; f

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

primes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,
          71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,
          151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,
          233,239,241,251,257,263,269,271,277,281,283,293,307,311,313]

primeDecp :: (Integral i, FiniteBits i) => i -> [(i,Int)]
primeDecp !n = (\f -> f (:)[]) $ \cons nil ->
  let !expt2 = countTrailingZeros n
      nDiv2 = n `unsafeShiftR` expt2
      start a | a > 1 = go (tail primes) a
              | otherwise = nil
      {-# INLINE start #-}
      go (!p:ps) !a | r == 0    = goExpt p ps q 1
                    | q > p     = go ps a
                    | otherwise = cons (a,1) nil
        where (!q,!r) = a `quotRem` p
      goExpt !p ps 1 !j = cons (p,j) nil
      goExpt !p ps !a !j
        | r == 0    = goExpt p ps q (j+1)
        | otherwise = cons (p,j) $ if q > p then go ps a
                                            else cons (a,1) nil
        where (!q,!r) = a `quotRem` p
  in if expt2 /= 0 then cons (2,expt2) $ start nDiv2 else start n

-- unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char
import Data.Semigroup
import Data.Monoid

aMax = 100000 :: Int

aMax64 = fromIntegral aMax :: Int64

main :: IO ()
main = do
  [n,k] <- map readInt . words <$> getLine
  as <- unfoldr (runStateT rIntS) <$> BS.getLine
  print $ query k as

maxPowerable :: UArray Int Int64
maxPowerable = A.array (1,100)
  $ [(1,100000),(2,316),(3,46),(4,17),(5,10),(6,6),(7,5),(8,4),(9,3),(10,3)]
  ++ map (,2) [11..16]
  ++ map (,1) [17..100]

corrPair :: Int -> Int -> Maybe (Int,Int)
corrPair k v_ = (\(x,y) -> (fromIntegral x, fromIntegral y))
  <$> foldM (\ (!red,!compl) (!p,!e) -> do
                let eRed = e `rem` k
                    eRev | eRed == 0 = 0
                         | otherwise = k-eRed
                guard $ eRev == 0 || p <= maxPowerable A.! eRev
                let !redNew   = red * p ^ eRed
                    !complNew = compl * p ^ eRev
                guard $ complNew <= aMax64
                return (redNew,complNew))
               (1::Int64,1::Int64)
               (primeDecp v)
   where v = fromIntegral v_

data DictElement
  = DE {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64
  | Same {-# UNPACK #-} !Int64

instance Semigroup DictElement where
  DE cntThis1 cntCompl1 <> DE cntThis2 cntCompl2
    = DE (cntThis1+cntThis2) (cntCompl1+cntCompl2)
  Same l0 <> Same l1 = Same (l0+l1)
  _ <> _ = undefined

query :: Int -> [Int] -> Int64
query k as = sum $ map match $ IM.elems dict
  where
    match (DE x y) = x*y
    match (Same x) = x * (x-1) `shiftR` 1
    dict
      = foldl'
        (\ !dict !a ->
           maybe dict
           (\(!red,!compl) ->
              case compare red compl of
                EQ -> IM.insertWith (<>) red (Same 1) dict
                LT -> IM.insertWith (<>) red (DE 1 0) dict
                GT -> IM.insertWith (<>) compl (DE 0 1) dict)
           $ corrPair k a)
        IM.empty
        as

#define IL(f) {-# INLINE f #-}; f

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

primes = [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,
          71,73,79,83,89,97,101,103,107,109,113,127,131,137,139,149,
          151,157,163,167,173,179,181,191,193,197,199,211,223,227,229,
          233,239,241,251,257,263,269,271,277,281,283,293,307,311,313]

primeDecp :: (Integral i, FiniteBits i) => i -> [(i,Int)]
primeDecp !n = (\f -> f (:)[]) $ \cons nil ->
  let !expt2 = countTrailingZeros n
      nDiv2 = n `unsafeShiftR` expt2
      start a | a > 1 = go (tail primes) a
              | otherwise = nil
      {-# INLINE start #-}
      go (!p:ps) !a | r == 0    = goExpt p ps q 1
                    | q > p     = go ps a
                    | otherwise = cons (a,1) nil
        where (!q,!r) = a `quotRem` p
      goExpt !p ps 1 !j = cons (p,j) nil
      goExpt !p ps !a !j
        | r == 0    = goExpt p ps q (j+1)
        | otherwise = cons (p,j) $ if q > p then go ps a
                                            else cons (a,1) nil
        where (!q,!r) = a `quotRem` p
  in if expt2 /= 0 then cons (2,expt2) $ start nDiv2 else start n

-- unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL


You are given an array of n integer numbers a0, a1, ..., an - 1. Find the distance between two closest (nearest) minimums in it. It is guaranteed that in the array a minimum occurs at least two times.

The first line contains positive integer n (2 ≤ n ≤ 105) — size of the given array. The second line contains n integers a0, a1, ..., an - 1 (1 ≤ ai ≤ 109) — elements of the array. It is guaranteed that in the array a minimum occurs at least two times.

Print the only number — distance between two nearest minimums in the array.

module Main where

import Control.Applicative
import Control.Monad

minIndices :: [Int] -> [Int]
minIndices xs = map fst . filter isMin $ zip [1 ..] xs
    where minx = minimum xs
          isMin (_, x) = x == minx

diffs :: [Int] -> [Int]
diffs xs = zipWith (-) (tail xs) (init xs)

solve :: [Int] -> Int
solve = minimum . diffs . minIndices

test0 = [3, 3] :: [Int]
test1 = [5, 6, 5] :: [Int]
test2 = [2, 1, 3, 5, 4, 1, 2, 3, 1] :: [Int]

main :: IO ()
main = do
  _ <- getLine
  xs <- map read . words <$> getLine
  print $ solve xs

import Data.List
import Data.Function
main = getLine >> getLine >>= print . minimum . (\xs@(_:xs') -> zipWith (\a b -> abs $ a - b) xs xs') . map snd . head . groupBy ((==) `on` fst) . sort . flip zip [(0 :: Int)..] . map (read :: String -> Int) . words

-- Codeforces 911A

{-# OPTIONS_GHC -O0 #-}
{-# OPTIONS_GHC -optc-O0 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as BC
import Data.List
import Data.Maybe

main :: IO ()
main = do
    (n:ns) <- (map (fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents :: IO [Int]
    let a = minimum ns
        indices = elemIndices a ns
        diff = zipWith (-) (tail indices) indices
        ans = minimum diff
    print ans

import Data.List

main = do
    _ <- getLine
    inputLines <- fmap words getLine
    let intList = map read inputLines :: [Int]
    print $ distance $ elemIndices (minimum intList) intList

distance [] = maxBound
distance [_] = maxBound
distance (x:y:xs)
    | (abs (x - y)) > (distance $ y:xs) = distance $ y:xs
    | otherwise = abs (x - y)

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

main = sol <$> (C.getLine *> get) >>= print

get = fmap fst . mapMaybe C.readInt . C.words <$> C.getLine

sol =  mds . fmap fst . mis
    where
    mds = minimum . uncurry (zipWith (-)) <<< tail &&& id
    mis = (\m -> filter ((m==) . snd)) <$> minimum <*> zip ([0..]::[Int])

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [_,xs] = let
    m = minimum xs
    in
     wrap.show $ minimum $ diffs $ map fst $ filter ((m==).snd) $ zip [0..] xs

diffs [_] = []
diffs []  = []
diffs (x:y:xs) = abs (x-y) : diffs (y:xs)

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

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

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

main = sol <$> (C.getLine *> get) >>= print

get = fmap fst . mapMaybe C.readInt . C.words <$> C.getLine

sol as = minimum $ minimum <$> ds
    where
    mp = M.filter ((>1) . length) . M.fromListWith (++) $ zipWith (\a i -> (a,[i])) as [0..]
    ds = (\bs -> zipWith (-) bs (tail bs)) . snd <$> M.toList mp


Jzzhu have n non-negative integers a1, a2, ..., an. We will call a sequence of indexes i1, i2, ..., ik (1 ≤ i1 < i2 < ... < ik ≤ n) a group of size k. Jzzhu wonders, how many groups exists such that ai1 & ai2 & ... & aik = 0 (1 ≤ k ≤ n)? Help him and print this number modulo 1000000007 (109 + 7). Operation x & y denotes bitwise AND operation of two numbers.

The first line contains a single integer n (1 ≤ n ≤ 106). The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 106).

Output a single integer representing the number of required groups modulo 1000000007 (109 + 7).

{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import Data.List
import Data.Int
import Data.Bits
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

modulo = 1000000007 :: Int64
constN = 1000000

bitOR = (.|.)
allSet = ((1::Int) `shiftL` 20) - 1

main = do
  head <$> getints >>= \n -> getints >>= \as -> do
  f   <- newArray (0, allSet) 0 :: IO (IOUArray Int Int)
  pw2 <- newArray (0, constN) 1 :: IO (IOUArray Int Int64)
  forM_ [1.. constN] $ \e -> readArray pw2 (e - 1) >>= \prev -> writeArray pw2 e (prod prev 2)
  forM_ as $ \x -> readArray f x >>= \c -> writeArray f x (c + 1)
  forM_ [0.. 19] $ \i -> forM_ [0.. allSet] $ \set -> do
    let mask = (1 `shiftL` i)
    unless (testBit set i) $ readArray f set >>= \a -> readArray f (bitOR set mask) >>= \b -> writeArray f set $! (a + b)
  res <- newIORef 0 :: IO (IORef Int64)
  forM_ [0.. allSet] $ \set -> do
    let sgn = if popCount set `mod` 2 == 0 then (1) else (-1)
    e <- readArray f set
    r <- (\x -> x - 1::Int64) <$> readArray pw2 e
    p <- readIORef res
    writeIORef res $! (modulo + (r * sgn + p) `mod `modulo) `mod` modulo
  readIORef res >>= putStrLn . show
  where getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine
        prod x y = x * y `mod` modulo


The Greatest Secret Ever consists of n words, indexed by positive integers from 1 to n. The secret needs dividing between k Keepers (let's index them by positive integers from 1 to k), the i-th Keeper gets a non-empty set of words with numbers from the set Ui = (ui, 1, ui, 2, ..., ui, |Ui|). Here and below we'll presuppose that the set elements are written in the increasing order.We'll say that the secret is safe if the following conditions are hold:  for any two indexes i, j (1 ≤ i < j ≤ k) the intersection of sets Ui and Uj is an empty set;  the union of sets U1, U2, ..., Uk is set (1, 2, ..., n);  in each set Ui, its elements ui, 1, ui, 2, ..., ui, |Ui| do not form an arithmetic progression (in particular, |Ui| ≥ 3 should hold). Let us remind you that the elements of set (u1, u2, ..., us) form an arithmetic progression if there is such number d, that for all i (1 ≤ i < s) fulfills ui + d = ui + 1. For example, the elements of sets (5), (1, 10) and (1, 5, 9) form arithmetic progressions and the elements of sets (1, 2, 4) and (3, 6, 8) don't.Your task is to find any partition of the set of words into subsets U1, U2, ..., Uk so that the secret is safe. Otherwise indicate that there's no such partition.

The input consists of a single line which contains two integers n and k (2 ≤ k ≤ n ≤ 106) — the number of words in the secret and the number of the Keepers. The numbers are separated by a single space.

If there is no way to keep the secret safe, print a single integer "-1" (without the quotes). Otherwise, print n integers, the i-th of them representing the number of the Keeper who's got the i-th word of the secret. If there are multiple solutions, print any of them.

import Control.Monad (liftM, replicateM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> [Int]
solve [n, k]
  | 3 * k > n  =  [-1]
  | otherwise  =  take n (k : [1..k-1] ++ cycle [1..k])

main :: IO ()
main  =  reads >>= prints . solve

  where

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

main = interact (unwords . map show . (\[n, k] -> ans k n) . map read . words)

ans :: Int -> Int -> [Int]
ans k n = if 3*k > n then [-1] else gen k
  where
    gen 3 = [3, 3, 2, 3, 2, 1, 1, 2, 1] ++ replicate (n - 3*k) 1
    gen 2 = [2, 2, 1, 2, 1, 1]          ++ replicate (n - 3*k) 1
    gen x = [x, x, x-1, x, x-1, x-1]    ++ gen (x-2)

{-# OPTIONS_GHC -O2 #-}
main=interact$unwords.map show.f.map read.words
f[n,k]
  | n `div` k < 3 = [-1]
  | even k = take n $ cycle ([1..k] ++ [k,k-1..1])
  | otherwise = (take (n-1) $ k:k:cycle ([1..k-1] ++ [k-1,k-2..1]))++[k]


You are given two arrays $$$a$$$ and $$$b$$$, both of length $$$n$$$.You can perform the following operation any number of times (possibly zero): select an index $$$i$$$ ($$$1 \leq i \leq n$$$) and swap $$$a_i$$$ and $$$b_i$$$.Let's define the cost of the array $$$a$$$ as $$$\sum_{i=1}^{n} \sum_{j=i + 1}^{n} (a_i + a_j)^2$$$. Similarly, the cost of the array $$$b$$$ is $$$\sum_{i=1}^{n} \sum_{j=i + 1}^{n} (b_i + b_j)^2$$$.Your task is to minimize the total cost of two arrays.

Each test case consists of several test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 40$$$) — the number of test cases. The following is a description of the input data sets. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the length of both arrays. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 100$$$) — elements of the first array. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \leq b_i \leq 100$$$) — elements of the second array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$100$$$.

For each test case, print the minimum possible total cost.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

import Data.Bits -- use Integer as bitset

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    a <- replicateM n getInt
    b <- replicateM n getInt
    let
      tot1 = sum (a ++ b)
      tot2 = sum $ map (\v -> v * v) (a ++ b)
      step :: Integer -> (Int, Int) -> Integer
      step v (x, y) = shiftL v x .|. shiftL v y
      ok = foldl' step 1 $ zip a b

      score v = (n - 2) * tot2 + v * v + (tot1 - v) * (tot1 - v)
      ans = foldl' min maxBound $ [score v | v <- [0 .. tot1], testBit ok v]
    pure $ putInts [ans]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp


Of course you have heard the famous task about Hanoi Towers, but did you know that there is a special factory producing the rings for this wonderful game? Once upon a time, the ruler of the ancient Egypt ordered the workers of Hanoi Factory to create as high tower as possible. They were not ready to serve such a strange order so they had to create this new tower using already produced rings.There are n rings in factory's stock. The i-th ring has inner radius ai, outer radius bi and height hi. The goal is to select some subset of rings and arrange them such that the following conditions are satisfied:  Outer radiuses form a non-increasing sequence, i.e. one can put the j-th ring on the i-th ring only if bj ≤ bi.  Rings should not fall one into the the other. That means one can place ring j on the ring i only if bj > ai.  The total height of all rings used should be maximum possible.

The first line of the input contains a single integer n (1 ≤ n ≤ 100 000) — the number of rings in factory's stock. The i-th of the next n lines contains three integers ai, bi and hi (1 ≤ ai, bi, hi ≤ 109, bi > ai) — inner radius, outer radius and the height of the i-th ring respectively.

Print one integer — the maximum height of the tower that can be obtained.

NoteIn the first sample, the optimal solution is to take all the rings and put them on each other in order 3, 2, 1.In the second sample, one can put the ring 3 on the ring 4 and get the tower of height 3, or put the ring 1 on the ring 2 and get the tower of height 4.

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

type Ring = (Int, Int, Integer)
type Tower = (Int, Integer)

acc :: Tower -> [Tower] -> Ring -> [Tower]
acc t [] _ = [t]
acc (w, h) towers@((width, height):ts) ring@(inner, outer, thick)
  |inner < width = acc (outer, height+thick) ts ring
  |h >= height = acc (w, h) ts ring
  |otherwise = (w, h):towers

build :: [Tower] -> Ring -> [Tower]
build towers ring@(inner, outer, thick) = acc (outer, thick) towers ring

cmp (inner0, outer0, _) (inner1, outer1, _) = mappend (compare outer0 outer1) (compare inner0 inner1)

--result = scanl' build [] test

getRing [a, b, c] = (read a, read b, read c)

getRings :: IO [Ring]
getRings = do
  contents <- C.getContents
  let liness = (C.lines contents)
  return $ map (getRing . words . C.unpack) liness

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  rings <- getRings
  let rings' = List.sortBy cmp rings
  print $ snd $ last $ foldl' build [] rings'

readInts :: String -> [Int]
readInts str = map read (words str)

build :: [[Int]] -> [(Int, Int)]
build [] = [(0, 0)]
build ([inner, outer, height]:rings) =
  (inner, height''):towers
  where
    towers = build rings
    height'' = height + maximum [height' |(inner', height')<-towers, outer>inner']

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  inputs <- sequence $ replicate n getLine
  let rings = map readInts inputs
  print $ maximum $ map snd $ build rings

import Data.List as List

type Ring = (Int, Int, Integer)
type Tower = (Int, Integer)

acc :: Tower -> [Tower] -> Ring -> [Tower]
acc t [] _ = [t]
acc (w, h) towers@((width, height):ts) ring@(inner, outer, thick)
  |inner < width = acc (outer, height+thick) ts ring
  |h >= height = acc (w, h) ts ring
  |otherwise = (w, h):towers

build :: [Tower] -> Ring -> [Tower]
build towers ring@(inner, outer, thick) = acc (outer, thick) towers ring

--result = scanl' build [] test

getRing :: IO Ring
getRing = do
  line <- getLine
  let [a, b, c] = words line
  return (read a, read b, read c)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  rings <- sequence $ replicate n getRing
  print $ snd $ last $ foldl' build [] rings

test = [(1, 5, 1),
        (2, 6, 2),
        (3, 7, 3)] :: [Ring]

test1 = [(1, 2, 1),
        (1, 3, 3),
        (4, 6, 2),
        (5, 7, 1)] :: [Ring]

import Data.List as List

readInts :: String -> [Int]
readInts str = map read (words str)

build :: [[Int]] -> [(Int, Int)]
build [] = [(0, 0)]
build ([inner, outer, height]:rings) =
  (inner, height''):towers
  where
    towers = build rings
    height'' = height + maximum [height' |(inner', height')<-towers, outer>inner']

on f g x y = f (g x) (g y)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  inputs <- sequence $ replicate n getLine
  let rings = map readInts inputs
  let rings'=List.sortBy (on compare (head . tail)) rings
  print $ maximum $ map snd $ build rings'

import Data.List as List

type Ring = (Int, Int, Integer)
type Tower = (Int, Integer)

acc :: Tower -> [Tower] -> Ring -> [Tower]
acc t [] _ = [t]
acc (w, h) towers@((width, height):ts) ring@(inner, outer, thick)
  |inner < width = acc (outer, height+thick) ts ring
  |h >= height = acc (w, h) ts ring
  |otherwise = (w, h):towers

build :: [Tower] -> Ring -> [Tower]
build towers ring@(inner, outer, thick) = acc (outer, thick) towers ring

cmp (_, outer0, _) (_, outer1, _) = compare outer0 outer1

--result = scanl' build [] test

getRing [a, b, c] = (read a, read b, read c)

getRings :: IO [Ring]
getRings = do
  contents <- getContents
  let liness = (lines contents)
  return $ map (getRing . words) liness

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  rings <- getRings
  let rings' = List.sortBy cmp rings
  print $ snd $ last $ foldl' build [] rings'

test = [(1, 5, 1),
        (2, 6, 2),
        (3, 7, 3)] :: [Ring]

test1 = [(1, 2, 1),
        (1, 3, 3),
        (4, 6, 2),
        (5, 7, 1)] :: [Ring]

import Data.List as List

type Ring = (Int, Int, Integer)
type Tower = (Int, Integer)

acc :: Tower -> [Tower] -> Ring -> [Tower]
acc t [] _ = [t]
acc (w, h) towers@((width, height):ts) ring@(inner, outer, thick)
  |inner < width = acc (outer, height+thick) ts ring
  |h >= height = acc (w, h) ts ring
  |otherwise = (w, h):towers

build :: [Tower] -> Ring -> [Tower]
build towers ring@(inner, outer, thick) = acc (outer, thick) towers ring

cmp (_, outer0, _) (_, outer1, _) = compare outer0 outer1

--result = scanl' build [] test

getRing :: [String] ->[Ring]
getRing [] = []
getRing (a:b:c:line) = (read a, read b, read c):(getRing line)

getRings :: IO [Ring]
getRings = do
  contents <- getContents
  return $ getRing (words contents)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  rings <- getRings
  let rings' = List.sortBy cmp rings
  print $ snd $ last $ foldl' build [] rings'

test = [(1, 5, 1),
        (2, 6, 2),
        (3, 7, 3)] :: [Ring]

test1 = [(1, 2, 1),
        (1, 3, 3),
        (4, 6, 2),
        (5, 7, 1)] :: [Ring]

import Data.List as List

readInts :: String -> [Integer]
readInts str = map read (words str)

build :: [[Integer]] -> [(Integer, Integer)]
build [] = [(0, 0)]
build ([inner, outer, height]:rings) =
  (inner, height''):[(inner', height') |(inner', height')<-towers, inner'<inner]
  where
    towers = build rings
    height'' = height + maximum [height' |(inner', height')<-towers, outer>inner']

on f g x y = f (g x) (g y)

main :: IO ()
main = do
  n <- fmap read getLine :: IO Int
  inputs <- sequence $ replicate n getLine
  let rings = map readInts inputs
  let rings'=List.sortBy (on compare (head . tail)) rings
  print $ maximum $ map snd $ build rings'

test =[[1,5,1000000000],[2,6,1000000000],[3,7,1000000000],[5,9,1000000000],[6,10,1000000000],[23,27,834000000],[25,28,23400000],[24,29,132400000],[26,30,234500000]] :: [[Integer]]


Nauuo is a girl who loves playing chess.One day she invented a game by herself which needs $$$n$$$ chess pieces to play on a $$$m\times m$$$ chessboard. The rows and columns are numbered from $$$1$$$ to $$$m$$$. We denote a cell on the intersection of the $$$r$$$-th row and $$$c$$$-th column as $$$(r,c)$$$.The game's goal is to place $$$n$$$ chess pieces numbered from $$$1$$$ to $$$n$$$ on the chessboard, the $$$i$$$-th piece lies on $$$(r_i,\,c_i)$$$, while the following rule is satisfied: for all pairs of pieces $$$i$$$ and $$$j$$$, $$$|r_i-r_j|+|c_i-c_j|\ge|i-j|$$$. Here $$$|x|$$$ means the absolute value of $$$x$$$.However, Nauuo discovered that sometimes she couldn't find a solution because the chessboard was too small.She wants to find the smallest chessboard on which she can put $$$n$$$ pieces according to the rules.She also wonders how to place the pieces on such a chessboard. Can you help her?

The only line contains a single integer $$$n$$$ ($$$1\le n\le 1000$$$) — the number of chess pieces for the game.

The first line contains a single integer — the minimum value of $$$m$$$, where $$$m$$$ is the length of sides of the suitable chessboard. The $$$i$$$-th of the next $$$n$$$ lines contains two integers $$$r_i$$$ and $$$c_i$$$ ($$$1\le r_i,c_i\le m$$$) — the coordinates of the $$$i$$$-th chess piece. If there are multiple answers, print any.

NoteIn the first example, you can't place the two pieces on a $$$1\times1$$$ chessboard without breaking the rule. But you can place two pieces on a $$$2\times2$$$ chessboard like this:In the second example, you can't place four pieces on a $$$2\times2$$$ chessboard without breaking the rule. For example, if you place the pieces like this:then $$$|r_1-r_3|+|c_1-c_3|=|1-2|+|1-1|=1$$$, $$$|1-3|=2$$$, $$$1<2$$$; and $$$|r_1-r_4|+|c_1-c_4|=|1-2|+|1-2|=2$$$, $$$|1-4|=3$$$, $$$2<3$$$. It doesn't satisfy the rule.However, on a $$$3\times3$$$ chessboard, you can place four pieces like this:

main :: IO ()
main = do
  n <- readLn
  let m = head [x | x<-[1..n],n<=2*x-1]
  print m
  flip mapM_ [1..m] $ \i -> do
    putStr "1 " >> print i
  flip mapM_ (take (n-m) [2..]) $ \i -> do
    putStrLn $ shows i " " ++ show m


In the evening, after the contest Ilya was bored, and he really felt like maximizing. He remembered that he had a set of n sticks and an instrument. Each stick is characterized by its length li.Ilya decided to make a rectangle from the sticks. And due to his whim, he decided to make rectangles in such a way that maximizes their total area. Each stick is used in making at most one rectangle, it is possible that some of sticks remain unused. Bending sticks is not allowed.Sticks with lengths a1, a2, a3 and a4 can make a rectangle if the following properties are observed:  a1 ≤ a2 ≤ a3 ≤ a4  a1 = a2  a3 = a4 A rectangle can be made of sticks with lengths of, for example, 3 3 3 3 or 2 2 4 4. A rectangle cannot be made of, for example, sticks 5 5 5 7.Ilya also has an instrument which can reduce the length of the sticks. The sticks are made of a special material, so the length of each stick can be reduced by at most one. For example, a stick with length 5 can either stay at this length or be transformed into a stick of length 4.You have to answer the question — what maximum total area of the rectangles can Ilya get with a file if makes rectangles from the available sticks?

The first line of the input contains a positive integer n (1 ≤ n ≤ 105) — the number of the available sticks. The second line of the input contains n positive integers li (2 ≤ li ≤ 106) — the lengths of the sticks.

The first line of the output must contain a single non-negative integer — the maximum total area of the rectangles that Ilya can make from the available sticks.

import Data.List
main=print.g.f.reverse.sort.map read.tail.words=<<getContents
f(x:y:zs)|x-y>1=f(y:zs)|0<1=y:f zs;f _=[]
g(x:y:zs)=x*y+g zs;g _=0

import Data.List (sortBy)

main :: IO ()
main = getContents >>= print . solve . sortBy (flip compare) . map read . tail . words

solve :: [Integer] -> Integer
solve (a:b:c:d:xs) | a <= b + 1 && c <= d + 1 = b * d + solve xs
                   | a <= b + 1 = solve (a:b:d:xs)
                   | otherwise = solve (b:c:d:xs)
solve _ = 0

import Data.List (sortBy, unfoldr)

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

solve :: [Integer] -> Integer
solve = sum . map product . splitN 2 . go . sortBy (flip compare)
  where go (a:yss@(b:ys)) | b `elem` [ a, a - 1 ] = b : go ys
                          | otherwise = go yss
        go _ = [0, 0]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

import Data.List (sortBy, unfoldr)

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

solve :: [Integer] -> Integer
solve = sum . map product . splitN 2 . go . sortBy (flip compare)
  where go (a:yss@(b:ys)) | a == b = a : go ys
                          | a == b + 1 = b : go ys
                          | otherwise = go yss
        go _ = [0, 0]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

import Data.List (sortBy, unfoldr)

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

solve :: [Integer] -> Integer
solve = sum . map product . filter ((==2) . length) . splitN 2 . go . sortBy (flip compare)
  where go (a:yss@(b:ys)) | a == b = a : go ys
                          | a == b + 1 = b : go ys
                          | otherwise = go yss
        go _ = [0, 0]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- sortBy (flip compare).map (fromIntegral.readInt).B.words <$> B.getLine
  print $ solve xs

solve :: [Integer] -> Integer
solve xs = go 0 xs
   where
     go !res (x:y:z:w:xs)
       | x == y || x - 1 == y = if z == w || z - 1 == w
                                then go (res + y * w) xs
                                else go res (x:y:w:xs)
       | otherwise = go res (y:z:w:xs)
     go res _ = res

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import Data.List (group, sort)
import Data.Int (Int64)
import Data.Bits ((.&.))
import Control.Applicative ((<$>), liftA)
import Data.ByteString (ByteString)
import Control.Monad (replicateM, sequence)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

press :: [(Int64, Int)] -> [(Int64, Int64)]
press ((l, n):(l', n'):rest)
    | l == l' + 1 && n .&. 1 == 1 = (l, n'' - 1):press ((l', n' + 1):rest)
    | otherwise = (l, n''): press ((l', n'):rest)
    where n'' = fromIntegral n :: Int64
press [(l, n)] = [(l, fromIntegral n)]

area :: Int64 -> [(Int64, Int64)] -> Int64
area acc [] = acc
area acc ((l, n):rest)
    | 3 < n = area (acc + (n `div` 4) * l * l) ((l, n `mod` 4):rest)
area acc ((l, n):(l', n'):rest)
    | 1 < n = area (acc + l * l') ((l', n' - 2):rest)
area acc (_:rest) = area acc rest

parse :: ByteString -> Maybe [Int64]
parse = sequence . fmap readInt64 . C8.words
    where
    readInt64 :: ByteString -> Maybe Int64
    readInt64 = liftA (fromIntegral . fst) . C8.readInt

main = B.getLine >> parse <$> B.getLine >>= \(Just a) ->
    print . area 0 . filter ((1 < ) . snd) .  press .
    fmap (\l -> (head l, length l)) . group . reverse . sort $ a

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

maximizePairs :: [Int] -> [Int]
maximizePairs = snd . foldr step ((0 :: Int, 0 :: Int), []) . group . sort
    where
        step xs ((lastVal, cnt), list)
            | length xs `mod` 2 == 0 || lastVal /= h + 1 || cnt == 0 =
                let add = if lastVal == h + 1 then cnt else 0
                in
                    ((h, max add (length xs `mod` 2)), replicate pairs h ++ list)
            | otherwise =
                ((h, 0), replicate (pairs + 1) h ++ list)
            where
                pairs = length xs `div` 2
                h = head xs

groupPairs :: [Int] -> Int64
groupPairs [] = 0
groupPairs [x] = 0
groupPairs (x:y:xys) = fromIntegral x * fromIntegral y + groupPairs xys

readIntList :: IO [Int]
readIntList = do
    _ <- B.getLine
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

main = do
    a <- readIntList
    print $ groupPairs . reverse . maximizePairs $ a

import Control.Monad
import Data.List

trimSticks :: [Integer] -> [Integer]
trimSticks [] = []
trimSticks [_] = []
trimSticks (x:y:rest)
  | x - y < 2 = (y:trimSticks rest)
  | otherwise  = trimSticks (y:rest)

prepare :: [Integer] -> [Integer]
prepare ls =
  let sls = reverse . sort $ ls
  in trimSticks sls

maxArea :: [Integer] -> Integer
maxArea [] = 0
maxArea [_] = 0
maxArea (x:y:rest) = x * y + maxArea rest

main :: IO ()
main = do
  n <- readLn
  ls <- liftM (map read . take n . words) $ getLine
  putStrLn . show . maxArea . prepare $ ls

import Data.List

main = print . g . f . reverse . sort . map read . tail . words =<< getContents

f (x:y:zs)
  | x - y <= 1 = y : f zs
  | otherwise = f (y:zs)
f _ = []

g (x:y:zs) = x*y + g zs
g _ = 0

import Data.List (sortBy)

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

solve :: [Integer] -> Integer
solve = product . take 2 . go . sortBy (flip compare)
  where go (a:yss@(b:ys)) | a == b = a : go ys
                          | a == b + 1 = b : go ys
                          | otherwise = go yss
        go _ = [0, 0]

import Data.List (sortBy)

main :: IO ()
main = getContents >>= print . solve . sortBy (flip compare) . map read . tail . words

solve :: [Integer] -> Integer
solve (a:b:c:d:xs) | a <= b - 1 && c <= d - 1 = b * d + solve xs
                   | a <= b - 1 = solve (a:b:d:xs)
                   | otherwise = solve (b:c:d:xs)
solve _ = 0

import Data.List (sortBy)

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

solve :: [Integer] -> Integer
solve = go . sortBy (flip compare)
  where go (a:b:c:d:xs) | a >= b - 1 && c >= d - 1 = b * d + go xs
                        | a >= b - 1 = go (a:b:d:xs)
                        | otherwise = go (b:c:d:xs)
        go _ = 0

import Data.List (group, sort)
import Data.Int (Int64)
import Data.Bits ((.&.))
import Control.Applicative ((<$>), liftA)
import Data.ByteString (ByteString)
import Control.Monad (replicateM, sequence)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C8

press :: [(Int64, Int)] -> [(Int64, Int64)]
press ((l, n):(l', n'):rest)
    | l == l' + 1 && n .&. 1 == 1 = (l, n'' - 1):press ((l', n' + 1):rest)
    | otherwise = (l, n''): press ((l', n'):rest)
    where n'' = fromIntegral n :: Int64
press [(l, n)] = [(l, fromIntegral n)]

area :: Int64 -> [(Int64, Int64)] -> Int64
area acc [] = acc
area acc ((l, n):rest)
    | 4 < n = area (acc + (n `div` 4) * l * l) ((l, n `mod` 4):rest)
area acc ((l, n):(l', n'):rest)
    | 1 < n = area (acc + l * l') ((l', n' - 2):rest)
area acc (_:rest) = area acc rest

parse :: ByteString -> Maybe [Int64]
parse = sequence . fmap readInt64 . C8.words
    where
    readInt64 :: ByteString -> Maybe Int64
    readInt64 = liftA (fromIntegral . fst) . C8.readInt

main = B.getLine >> parse <$> B.getLine >>= \(Just a) ->
    print . area 0 . filter ((1 < ) . snd) .  press .
    fmap (\l -> (head l, length l)) . group . reverse . sort $ a

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

maximizePairs :: [Int] -> [Int]
maximizePairs = snd . foldr step ((0 :: Int, 0 :: Int), []) . group . sort
    where
        step xs ((lastVal, cnt), list)
            | length xs `mod` 2 == 0 || lastVal /= h + 1 || cnt == 0 =
                ((h, max cnt (length xs `mod` 2)), replicate pairs h ++ list)
            | otherwise =
                ((h, 0), replicate (pairs + 1) h ++ list)
            where
                pairs = length xs `div` 2
                h = head xs

groupPairs :: [Int] -> Int64
groupPairs [] = 0
groupPairs [x] = 0
groupPairs (x:y:xys) = fromIntegral x * fromIntegral y + groupPairs xys

readIntList :: IO [Int]
readIntList = do
    _ <- B.getLine
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

main = do
    a <- readIntList
    print $ groupPairs . reverse . maximizePairs $ a


Vasya has found a piece of paper with a coordinate system written on it. There are n distinct squares drawn in this coordinate system. Let's number the squares with integers from 1 to n. It turned out that points with coordinates (0, 0) and (ai, ai) are the opposite corners of the i-th square.Vasya wants to find such integer point (with integer coordinates) of the plane, that belongs to exactly k drawn squares. We'll say that a point belongs to a square, if the point is located either inside the square, or on its boundary. Help Vasya find a point that would meet the described limits.

The first line contains two space-separated integers n, k (1 ≤ n, k ≤ 50). The second line contains space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109). It is guaranteed that all given squares are distinct.

In a single line print two space-separated integers x and y (0 ≤ x, y ≤ 109) — the coordinates of the point that belongs to exactly k squares. If there are multiple answers, you are allowed to print any of them.  If there is no answer, print "-1" (without the quotes).

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

main = do
	[ n, k ] <- map read . words <$> getLine
	as <- reverse . sort . map read . words <$> getLine
	let
		tmp = show $ solve k as
		res = if tmp == "-1" then "-1" else tmp ++ " " ++ tmp
	putStrLn res

solve :: Int -> [Int] -> Int
solve k as
	| k == 0 = ( as !! 0 ) + 1
	| length as < k = -1
	| otherwise = as !! ( k - 1 )

import Data.List

main :: IO ()
main = do
  [n, k] <- fmap (map read . words) getLine
  a <- fmap (reverse . sort . map read . words) getLine
  if k == 0 then p $ succ $ a!!0
  else if k <= n then p $ a!!(k-1)
  else putStrLn "-1"
  where
    p :: Int -> IO ()
    p x = putStrLn $ show x ++ " " ++ show x

import Data.List

main :: IO()
main = do
    str1 <- getLine
    str2 <- getLine
    let n = read ((words str1) !! 0)
    let k = read ((words str1) !! 1)
    let a = (reverse . sort) (map read (words str2)) :: [Int]
    if (n < k)
        then putStrLn "-1"
        else putStrLn ((show (a !! (k - 1))) ++ " " ++ (show (a !! (k - 1))))

import qualified Data.List  as L
calc :: Int -> Int -> [Int] -> String
calc n k a
    | k > n     = "-1"
    | otherwise = let y = a !! (k - 1) in show y ++ " " ++ show y

main = do
    s1 <- getLine
    s2 <- getLine
    let
        n : k : _ = map read . words $ s1
        a = L.reverse . L.sort . map read . words $ s2
    putStrLn . calc n k $ a

import qualified Data.List as L
import qualified Data.Maybe as M

main :: IO ()
main = do
    [n,k] <- getLine >>= return . map read . words
    l     <- getLine >>= return . map read . words
    putStrLn . M.fromMaybe ("-1") $ solve k l

solve :: Int -> [Int] -> Maybe String
solve k l = do
    x <- fmap snd . L.find ((>=k) . fst) . L.zip [1..] . L.reverse . L.sort $ l
    return (show x ++ " " ++ show x)

import Data.Ord
import Data.List
import Control.Arrow
main = do
    let int x = read x :: Int
    let ints  = map int . words <$> getLine
    let join (x,y) = x++" "++y
    [n,k] <- ints
    as <- ints
    putStrLn $
        if k > n
            then "-1"
            else show &&& show >>> join $  head $ drop (k - 1) $ sortBy (flip $ comparing id) as

import Control.Monad (liftM)
import Data.List (sort)
import Data.Maybe (fromMaybe)

solve :: Int -> [Int] -> Int -> Maybe (Int, Int)
solve n as k
  | k > n  =  Nothing
  | otherwise  =  Just (x, x)
  where
    x  =  (reverse $ sort as) !! (k - 1)

main :: IO ()
main  =  do
    [n, k]  <-  liftM (map read . words) getLine
    as  <-  liftM (map read . words) getLine
    putStrLn $ maybe "-1" show' $ solve n as k
  where
    show' (x, y)  =  show x ++ " " ++ show y

import Data.List
main=interact$unwords.map show.f.map read.words
f(n:k:x)|k>n=[-1]|1>0=[sort x!!(n-k),0]

import Data.List (sort)

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (n:k:as) | k <= n = [ sort as !! (n - k), 0 ]
               | otherwise = [ -1 ]
solve _ = undefined

import Data.List
main=interact$unwords.map show.f.map read.words
f(n:k:x)|k<=n=[sort x!!(n-k),0]|1>0=[-1]

import Data.List (sortBy)

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Int] -> [Int]
solve (_:k:as) | k <= length as = [ sortBy (flip compare) as !! (k - 1), 0 ]
               | otherwise = [ -1 ]
solve _ = undefined

import Data.List
main=interact$solve.map read.words
solve(n:k:xs)
  | n < k = "-1"
  | otherwise = shows x " "++show x
   where
     x = head $ drop (n-k) $ sort xs

import Data.List

main = do
	ct <- getContents
	let
		(n:k:a) = map read $ words ct
	putStrLn $ solve k $ sort a

solve :: Int -> [Int] -> String
solve k a
	| k > length a = "-1"
	| otherwise = ax ++ " " ++ ax
	where
		ax = show $ a !! (length a - k)

module Main where

import Data.List

qsort [] = []
qsort (x:xs) = qsort more ++ [x] ++ qsort less
      where
      (less, more) = partition (< x) xs

solve :: Int -> [Int] -> [Int]
solve k a = if last kFirst == head rest
              then [-1]
              else [last kFirst, 0]
                 where
                 (kFirst, rest) = splitAt k a

main = do
     nkStr <- getLine
     let [n, k] = map read $ words nkStr
     aStr <- getLine
     let a = qsort $ map read $ words aStr
     if k < n
       then putStrLn $ unwords $ map show $ solve k a
       else if k == n
              then putStrLn "0 0"
              else putStrLn "-1"

import Data.List
qsort [] = []
qsort (x:xs) = qsort more ++ [x] ++ qsort less
      where
      (less, more) = partition (< x) xs

solve :: [Int] -> Int-> [Int]
solve a k = if last kFirst == head rest
              then [-1]
              else [last kFirst, 0]
                 where
                 (kFirst, rest) = splitAt k a

main = do
     nkStr <- getLine
     let [n, k] = map read $ words nkStr
     aStr <- getLine
     let a = qsort $ map read $ words aStr
     if k < n
       then putStrLn $ unwords $ map show $ solve a k
       else if k == n
              then putStrLn "0 0"
              else putStrLn "-1"

module Main where

import Data.List

qsort [] = []
qsort (x:xs) = qsort more ++ [x] ++ qsort less
      where
      (less, more) = partition (\ x' -> x' < x) xs

solve :: Int -> [Int] -> [Int]
solve k a = if (last kFirst) == (head rest)
            then [-1]
            else [last kFirst, 0]
                 where
                 (kFirst, rest) = splitAt k a

main = do
     nkStr <- getLine
     let nk = map (read :: String -> Int) $ words nkStr
         n = nk!!0
         k = nk!!1
     aStr <- getLine
     let a = qsort $ map (read :: String -> Int) $ words aStr
     if k < n
     then putStrLn $ unwords $ map show $ solve k a
     else if k == n
          then putStrLn "0 0"
          else putStrLn "-1"

import Control.Applicative
import Data.List

main= do
	[n,k]<-  map read.words  <$> getLine ::IO [Int]
	s<-reverse.sort .map read. words <$> getLine:: IO [Int]
	putStrLn $ if length s <k then "-1" else intercalate " "$ map show  $ replicate 2  $ head $ drop (k-1) s

import Control.Applicative
import Data.List
import Control.Exception
import Data.Either
main = do
    [n,k]<-map read.words<$>getLine
    as<-map read.take n.words<$>getLine::IO[Int]
    let
        c = reverse $ take (1+k) $ reverse $ sort as
        b = (head c == (head.tail $ c)) -- || ((head.tail $ c) == head.tail.tail$c)
        ch=show(head.tail$c)
    res<-try(evaluate b)::IO(Either SomeException Bool)
    case (compare k n) of
      GT -> do
        print(-1)
        return()
      EQ -> putStrLn "0 0"
      _ ->
        case res of
            Left _ -> print (-1)
            Right r -> case r of
                            True -> print (-1)
                            False -> putStrLn(ch++" 0")

import Data.List

solve n k as    | k > n     = ["-1"]
                | otherwise = map show [x, y]
                where
                    xs = sort as
                    x = head $ drop (n - k) xs
                    y = x

parseInput input = (n, k, as) where
    ls = lines input
    [n, k] = map read $ words $ head ls :: [Int]
    as = map read $ words $ last ls :: [Int]

main = do
    input <- getContents
    let (n, k, as) = parseInput input
    putStrLn $ intercalate " " $ solve n k as

import Data.List
main=interact$unwords.map show.f.map read.words
f(n:k:x)|k<n=[-1]|1>0=[sort x!!(n-k),0]