Lunar New Year is approaching, and Bob is struggling with his homework – a number division problem.There are $$$n$$$ positive integers $$$a_1, a_2, \ldots, a_n$$$ on Bob's homework paper, where $$$n$$$ is always an even number. Bob is asked to divide those numbers into groups, where each group must contain at least $$$2$$$ numbers. Suppose the numbers are divided into $$$m$$$ groups, and the sum of the numbers in the $$$j$$$-th group is $$$s_j$$$. Bob's aim is to minimize the sum of the square of $$$s_j$$$, that is $$$$$$\sum_{j = 1}^{m} s_j^2.$$$$$$Bob is puzzled by this hard problem. Could you please help him solve it?

The first line contains an even integer $$$n$$$ ($$$2 \leq n \leq 3 \cdot 10^5$$$), denoting that there are $$$n$$$ integers on Bob's homework paper. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^4$$$), describing the numbers you need to deal with.

A single line containing one integer, denoting the minimum of the sum of the square of $$$s_j$$$, which is $$$$$$\sum_{i = j}^{m} s_j^2,$$$$$$ where $$$m$$$ is the number of groups.

NoteIn the first sample, one of the optimal solutions is to divide those $$$4$$$ numbers into $$$2$$$ groups $$$\{2, 8\}, \{5, 3\}$$$. Thus the answer is $$$(2 + 8)^2 + (5 + 3)^2 = 164$$$.In the second sample, one of the optimal solutions is to divide those $$$6$$$ numbers into $$$3$$$ groups $$$\{1, 2\}, \{1, 2\}, \{1, 2\}$$$. Thus the answer is $$$(1 + 2)^2 + (1 + 2)^2 + (1 + 2)^2 = 27$$$.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

main = do
	n <- readInt
	as <- sort <$> readInts
	let
		rev = reverse as
	print $ sum $ map ( ^ 2 ) $ zipWith (+) as $ take ( n `div` 2 ) rev

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

main = do
    let int = fst .fromJust . B.readInteger
        ints = map int . B.words
    n <- readLn :: IO Int
    as <- ints <$> B.getLine
    let (b,c) = splitAt (n`div`2) $ sort as
    print $ sum $ map (^2) $ zipWith (+) b $ reverse c

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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 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.Safe
-- import Control.Monad.ST
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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as_ <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let as = runSTUArray $ do
        as <- A.newListArray (0,n-1) (map fromIntegral as_ :: [Int64])
        sortMArray as
        return as
  print $ sum $ [ (as A.! i + as A.! (n-i-1))^2
                | i <- [0..n `shiftR` 1 - 1]]

type Comparison e = e -> e -> Ordering

{-# INLINE sortMArray #-}
sortMArray :: (MArray a e m, Ord e, A.Ix i, Integral i, Bits i)
           => a i e -> m ()
sortMArray = sortMArrayBy compare

{-# INLINE sortMArrayBy #-}
sortMArrayBy :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> m ()
sortMArrayBy cmp = \arr -> A.getBounds arr >>= sortMArrayByBounds cmp arr

-- sort the interval [l,u] of arr.
{-# INLINE sortMArrayByBounds #-}
sortMArrayByBounds :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> (i,i) -> m ()
sortMArrayByBounds cmp = \arr (l,u) -> sortMArrayByBounds_ cmp arr l (u+1)

-- sort the interval [l,u) of arr.
{-# INLINE sortMArrayByBounds_ #-}
sortMArrayByBounds_ :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> i -> i -> m ()
sortMArrayByBounds_ cmp = \arr l u -> do
  let len = u - l
  tmp <- A.newArray_ (0,len `shiftR` 1 - 1)
  mergesort cmp arr tmp l u

mergesort cmp arr tmp l u
  | u - l <= 1 = return ()
  | otherwise  = do mergesort cmp arr tmp l mid
                    mergesort cmp arr tmp mid u
                    merge cmp arr tmp l mid u
    where
      len = u - l
      mid = (u + l) `shiftR` 1

{-# INLINE merge #-}
merge :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> a i e -> i -> i -> i -> m ()
merge cmp arr tmp l mid u = do
  copyMArray arr (l,mid-1) tmp (0,mml-1)
  eLow <- A.readArray tmp 0
  eHigh <- A.readArray arr mid
  loop eLow 0 eHigh mid l
  where
    mml = mid - l
    loop !eLow !iLow !eHigh !iHigh !iIns = case cmp eHigh eLow of
      LT -> do A.writeArray arr iIns eHigh
               wroteHigh eLow iLow (iHigh+1) (iIns+1)
      _  -> do A.writeArray arr iIns eLow
               wroteLow (iLow+1) eHigh iHigh (iIns+1)
    wroteHigh !eLow !iLow !iHigh !iIns
      | iHigh >= u = copyMArray tmp (iLow,mml-1) arr (iIns,u-1)
      | otherwise  = do eHigh <- A.readArray arr iHigh
                        loop eLow iLow eHigh iHigh iIns
    wroteLow !iLow !eHigh !iHigh !iIns
      | iLow >= mml = return ()
      | otherwise   = do eLow <- A.readArray tmp iLow
                         loop eLow iLow eHigh iHigh iIns

{-# INLINE copyMArray #-}
copyMArray :: (MArray a0 e m, A.Ix i0, MArray a1 e m, A.Ix i1)
  => a0 i0 e -> (i0,i0) -> a1 i1 e -> (i1,i1) -> m ()
copyMArray src srcRange dst dstRange =
  forM_ (zip (A.range srcRange) (A.range dstRange))
  $ \(i,j) -> A.writeArray dst j =<< A.readArray src i

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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 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.Safe
-- import Control.Monad.ST
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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let (pre,suf) = splitAt (shiftR n 1) $ sort $ map fromIntegral as
        :: ([Int64],[Int64])
  print $ sum $ map (^2) $ zipWith (+) pre $ reverse suf

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

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

div2 = (flip div) 2
zipEnd xs = zip xs (reverse $ drop (div2 (length xs)) xs)

solve :: [Int] -> Integer
solve = sum
      . map (^2)
      . map toInteger
      . map (uncurry (+))
      . zipEnd
      . sort

main :: IO ()
main = do
    _ <- readInt
    v <- readInts
    print $ solve v

import Data.Int
import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = sum $ genericTake (n `div` 2) $ map (^2) $ zipWith (+) s (reverse s)
  where s = sort as :: [Int64]

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

main = do
    let int = fst .fromJust . B.readInt
        ints = map int . B.words
    n <- readLn :: IO Int
    as <- ints <$> B.getLine
    let (b,c) = splitAt (n`div`2) $ sort as
    print $ sum $ map (^2) $ zipWith (+) b $ reverse c

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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 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.Safe
-- import Control.Monad.ST
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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as_ <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let as = runSTUArray $ do
        as <- A.newListArray (0,n-1) as_
        sortMArray as
        return as
  print $ sum $ [ (as A.! i + as A.! (n-i-1))^2
                | i <- [0..n `shiftR` 1 - 1]]

type Comparison e = e -> e -> Ordering

{-# INLINE sortMArray #-}
sortMArray :: (MArray a e m, Ord e, A.Ix i, Integral i, Bits i)
           => a i e -> m ()
sortMArray = sortMArrayBy compare

{-# INLINE sortMArrayBy #-}
sortMArrayBy :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> m ()
sortMArrayBy cmp = \arr -> A.getBounds arr >>= sortMArrayByBounds cmp arr

-- sort the interval [l,u] of arr.
{-# INLINE sortMArrayByBounds #-}
sortMArrayByBounds :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> (i,i) -> m ()
sortMArrayByBounds cmp = \arr (l,u) -> sortMArrayByBounds_ cmp arr l (u+1)

-- sort the interval [l,u) of arr.
{-# INLINE sortMArrayByBounds_ #-}
sortMArrayByBounds_ :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> i -> i -> m ()
sortMArrayByBounds_ cmp = \arr l u -> do
  let len = u - l
  tmp <- A.newArray_ (0,len `shiftR` 1 - 1)
  mergesort cmp arr tmp l u

mergesort cmp arr tmp l u
  | u - l <= 1 = return ()
  | otherwise  = do mergesort cmp arr tmp l mid
                    mergesort cmp arr tmp mid u
                    merge cmp arr tmp l mid u
    where
      len = u - l
      mid = (u + l) `shiftR` 1

{-# INLINE merge #-}
merge :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> a i e -> i -> i -> i -> m ()
merge cmp arr tmp l mid u = do
  copyMArray arr (l,mid-1) tmp (0,mml-1)
  eLow <- A.readArray tmp 0
  eHigh <- A.readArray arr mid
  loop eLow 0 eHigh mid l
  where
    mml = mid - l
    loop !eLow !iLow !eHigh !iHigh !iIns = case cmp eHigh eLow of
      LT -> do A.writeArray arr iIns eHigh
               wroteHigh eLow iLow (iHigh+1) (iIns+1)
      _  -> do A.writeArray arr iIns eLow
               wroteLow (iLow+1) eHigh iHigh (iIns+1)
    wroteHigh !eLow !iLow !iHigh !iIns
      | iHigh >= u = copyMArray tmp (iLow,mml-1) arr (iIns,u-1)
      | otherwise  = do eHigh <- A.readArray arr iHigh
                        loop eLow iLow eHigh iHigh iIns
    wroteLow !iLow !eHigh !iHigh !iIns
      | iLow >= mml = return ()
      | otherwise   = do eLow <- A.readArray arr iLow
                         loop eLow iLow eHigh iHigh iIns

{-# INLINE copyMArray #-}
copyMArray :: (MArray a0 e m, A.Ix i0, MArray a1 e m, A.Ix i1)
  => a0 i0 e -> (i0,i0) -> a1 i1 e -> (i1,i1) -> m ()
copyMArray src srcRange dst dstRange =
  forM_ (zip (A.range srcRange) (A.range dstRange))
  $ \(i,j) -> A.writeArray dst j =<< A.readArray src i

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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 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.Safe
-- import Control.Monad.ST
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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let (pre,suf) = splitAt (shiftR n 1) $ sort as
  print $ sum $ map (^2) $ zipWith (+) pre $ reverse suf

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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 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.Safe
-- import Control.Monad.ST
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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as_ <- unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let as = runSTUArray $ do
        as <- A.newListArray (0,n-1) as_
        sortMArray as
        return as
  print $ sum $ [ (as A.! i + as A.! (n-i-1))^2
                | i <- [0..n `shiftR` 1 - 1]]

type Comparison e = e -> e -> Ordering

{-# INLINE sortMArray #-}
sortMArray :: (MArray a e m, Ord e, A.Ix i, Integral i, Bits i)
           => a i e -> m ()
sortMArray = sortMArrayBy compare

{-# INLINE sortMArrayBy #-}
sortMArrayBy :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> m ()
sortMArrayBy cmp = \arr -> A.getBounds arr >>= sortMArrayByBounds cmp arr

-- sort the interval [l,u] of arr.
{-# INLINE sortMArrayByBounds #-}
sortMArrayByBounds :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> (i,i) -> m ()
sortMArrayByBounds cmp = \arr (l,u) -> sortMArrayByBounds_ cmp arr l (u+1)

-- sort the interval [l,u) of arr.
{-# INLINE sortMArrayByBounds_ #-}
sortMArrayByBounds_ :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> i -> i -> m ()
sortMArrayByBounds_ cmp = \arr l u -> do
  let len = u - l
  tmp <- A.newArray_ (0,len `shiftR` 1 - 1)
  mergesort cmp arr tmp l u

mergesort cmp arr tmp l u
  | u - l <= 1 = return ()
  | otherwise  = do mergesort cmp arr tmp l mid
                    mergesort cmp arr tmp mid u
                    merge cmp arr tmp l mid u
    where
      len = u - l
      mid = (u + l) `shiftR` 1

{-# INLINE merge #-}
merge :: (MArray a e m, A.Ix i, Integral i, Bits i)
  => Comparison e -> a i e -> a i e -> i -> i -> i -> m ()
merge cmp arr tmp l mid u = do
  copyMArray arr (l,mid-1) tmp (0,mml-1)
  eLow <- A.readArray tmp 0
  eHigh <- A.readArray arr mid
  loop eLow 0 eHigh mid l
  where
    mml = mid - l
    loop !eLow !iLow !eHigh !iHigh !iIns = case cmp eHigh eLow of
      LT -> do A.writeArray arr iIns eHigh
               wroteHigh eLow iLow (iHigh+1) (iIns+1)
      _  -> do A.writeArray arr iIns eLow
               wroteLow (iLow+1) eHigh iHigh (iIns+1)
    wroteHigh !eLow !iLow !iHigh !iIns
      | iHigh >= u = copyMArray tmp (iLow,mml-1) arr (iIns,u-1)
      | otherwise  = do eHigh <- A.readArray arr iHigh
                        loop eLow iLow eHigh iHigh iIns
    wroteLow !iLow !eHigh !iHigh !iIns
      | iLow >= mml = return ()
      | otherwise   = do eLow <- A.readArray tmp iLow
                         loop eLow iLow eHigh iHigh iIns

{-# INLINE copyMArray #-}
copyMArray :: (MArray a0 e m, A.Ix i0, MArray a1 e m, A.Ix i1)
  => a0 i0 e -> (i0,i0) -> a1 i1 e -> (i1,i1) -> m ()
copyMArray src srcRange dst dstRange =
  forM_ (zip (A.range srcRange) (A.range dstRange))
  $ \(i,j) -> A.writeArray dst j =<< A.readArray src i

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

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

div2 = (flip div) 2
zipEnd xs = zip xs (reverse $ drop (div2 (length xs)) xs)

solve :: [Int] -> Int
solve = sum
      . map (^2)
      . map (uncurry (+))
      . zipEnd
      . sort

main :: IO ()
main = do
    _ <- readInt
    v <- readInts
    print $ solve v

import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = sum $ take (n `div` 2) $ zipWith (*) s (reverse s)
  where s = sort as

import Data.List
main = interact $ show . solve . map read . words
solve (n:as) = sum $ take (n `div` 2) $ map (^2) $ zipWith (+) s (reverse s)
  where s = sort as


One day Polycarp decided to rewatch his absolute favourite episode of well-known TV series "Tufurama". He was pretty surprised when he got results only for season 7 episode 3 with his search query of "Watch Tufurama season 3 episode 7 online full hd free". This got Polycarp confused — what if he decides to rewatch the entire series someday and won't be able to find the right episodes to watch? Polycarp now wants to count the number of times he will be forced to search for an episode using some different method.TV series have n seasons (numbered 1 through n), the i-th season has ai episodes (numbered 1 through ai). Polycarp thinks that if for some pair of integers x and y (x < y) exist both season x episode y and season y episode x then one of these search queries will include the wrong results. Help Polycarp to calculate the number of such pairs!

The first line contains one integer n (1  ≤ n  ≤  2·105) — the number of seasons. The second line contains n integers separated by space a1, a2, ..., an (1 ≤ ai ≤ 109) — number of episodes in each season.

Print one integer — the number of pairs x and y (x < y) such that there exist both season x episode y and season y episode x.

NotePossible pairs in the second example:  x = 1, y = 2 (season 1 episode 2  season 2 episode 1);  x = 2, y = 3 (season 2 episode 3  season 3 episode 2);  x = 1, y = 3 (season 1 episode 3  season 3 episode 1). In the third example:  x = 1, y = 2 (season 1 episode 2  season 2 episode 1);  x = 1, y = 3 (season 1 episode 3  season 3 episode 1).

import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Set as S

compute_intervals :: Integer -> [Integer] -> [(Integer, Integer, Integer)]
compute_intervals n xs = loop (zip [1 .. n] xs) []
  where loop [] intrvls = intrvls
        loop ((i, x) : xs) intrvls
          | (i + 1) > x' = loop xs intrvls
          | otherwise = loop xs ((i, i + 1, x') : intrvls)
          where x' = min n x

count_pairs :: Integer -> [Integer] -> Integer
count_pairs n xs = loop intrvl_start intrvl_end (S.empty) 1 0
  where intrvls = compute_intervals n xs
        intrvl_start = L.sort [(x, i) | (i, x, _) <- intrvls]
        intrvl_end = L.sort [(x, i) | (i, _, x) <- intrvls]
        xs_map = M.fromList $ zip [1 .. n] xs
        process_interval_start _ [] cur_intrvls = ([], cur_intrvls)
        process_interval_start c i_s@((s, i) : ys) cur_intrvls
          | s <= c = process_interval_start c ys (S.insert i cur_intrvls)
          | otherwise = (i_s, cur_intrvls)
        process_interval_end _ [] cur_intrvls = ([], cur_intrvls)
        process_interval_end c i_e@((e, i) : ys) cur_intrvls
          | e <= c = process_interval_end c ys (S.delete i cur_intrvls)
          | otherwise = (i_e, cur_intrvls)
        loop i_s i_e cur_intrvls c p
          | c > n = p
          | otherwise = let (i_s', cur_intrvls') = process_interval_start c i_s cur_intrvls
                            s = toInteger $ S.size $ fst $ S.split ((xs_map M.! c) + 1) cur_intrvls'
                            (i_e', cur_intrvls'') = process_interval_end c i_e cur_intrvls'
                            p' = p + s
                            c' = c + 1
                        in loop i_s' i_e' cur_intrvls'' c' p'

main :: IO ()
main =
  do
    first_line <- getLine
    second_line <- getLine
    let n = (read first_line) :: Integer
    let xs = [(read w) | w <- (words second_line)] :: [Integer]
    putStrLn $ show $ count_pairs n xs

import qualified Data.List as L
import qualified Data.Map.Strict as M
import qualified Data.Set as S

compute_intervals :: Int -> [Int] -> [(Int, Int, Int)]
compute_intervals n xs = loop (zip [1 .. n] xs) []
  where loop [] intrvls = intrvls
        loop ((i, x) : xs) intrvls
          | (i + 1) > x' = loop xs intrvls
          | otherwise = loop xs ((i, i + 1, x') : intrvls)
          where x' = min n x

count_pairs :: Int -> [Int] -> Int
count_pairs n xs = loop intrvl_start intrvl_end (S.empty) 1 0
  where intrvls = compute_intervals n xs
        intrvl_start = L.sort [(x, i) | (i, x, _) <- intrvls]
        intrvl_end = L.sort [(x, i) | (i, _, x) <- intrvls]
        xs_map = M.fromList $ zip [1 .. n] xs
        process_interval_start _ [] cur_intrvls = ([], cur_intrvls)
        process_interval_start c i_s@((s, i) : ys) cur_intrvls
          | s <= c = process_interval_start c ys (S.insert i cur_intrvls)
          | otherwise = (i_s, cur_intrvls)
        process_interval_end _ [] cur_intrvls = ([], cur_intrvls)
        process_interval_end c i_e@((e, i) : ys) cur_intrvls
          | e <= c = process_interval_end c ys (S.delete i cur_intrvls)
          | otherwise = (i_e, cur_intrvls)
        loop i_s i_e cur_intrvls c p
          | c > n = p
          | otherwise = let (i_s', cur_intrvls') = process_interval_start c i_s cur_intrvls
                            s = S.size $ fst $ S.split ((xs_map M.! c) + 1) cur_intrvls'
                            (i_e', cur_intrvls'') = process_interval_end c i_e cur_intrvls'
                            p' = p + s
                            c' = c + 1
                        in loop i_s' i_e' cur_intrvls'' c' p'

main :: IO ()
main =
  do
    first_line <- getLine
    second_line <- getLine
    let n = (read first_line) :: Int
    let xs = [(read w) | w <- (words second_line)] :: [Int]
    putStrLn $ show $ count_pairs n xs

import qualified Data.Set as S

count_pairs :: Int -> [Int] -> Int
count_pairs n xs = loop interval_start_set interval_end_set 1 0
  where interval_start_set = S.fromAscList [1 .. n]
        interval_end_set = S.fromList (zip [min x n | x <- xs] [1 .. n])
        loop i_s_s i_e_s c p
          | c > n = p
          | otherwise = let (i_e_s_l, i_e_s_g) = S.split (c, 0) i_e_s
                            done_intervals_start_set = S.map snd i_e_s_l
                            not_done_i_s_s = S.difference i_s_s done_intervals_start_set
                            (not_done_i_s_s_l, _) = S.split c not_done_i_s_s
                            s = S.size not_done_i_s_s_l
                            p' = p + s
                            c' = c + 1
                        in loop not_done_i_s_s i_e_s_g c' p'

main :: IO ()
main =
  do
    first_line <- getLine
    second_line <- getLine
    let n = (read first_line) :: Int
    let xs = [(read w) | w <- (words second_line)] :: [Int]
    putStrLn $ show $ count_pairs n xs


It's been almost a week since Polycarp couldn't get rid of insomnia. And as you may already know, one week in Berland lasts k days!When Polycarp went to a doctor with his problem, the doctor asked him about his sleeping schedule (more specifically, the average amount of hours of sleep per week). Luckily, Polycarp kept records of sleep times for the last n days. So now he has a sequence a1, a2, ..., an, where ai is the sleep time on the i-th day.The number of records is so large that Polycarp is unable to calculate the average value by himself. Thus he is asking you to help him with the calculations. To get the average Polycarp is going to consider k consecutive days as a week. So there will be n - k + 1 weeks to take into consideration. For example, if k = 2, n = 3 and a = [3, 4, 7], then the result is .You should write a program which will calculate average sleep times of Polycarp over all weeks.

The first line contains two integer numbers n and k (1 ≤ k ≤ n ≤ 2·105). The second line contains n integer numbers a1, a2, ..., an (1 ≤ ai ≤ 105).

Output average sleeping time over all weeks.  The answer is considered to be correct if its absolute or relative error does not exceed 10 - 6. In particular, it is enough to output real number with at least 6 digits after the decimal point.

NoteIn the third example there are n - k + 1 = 7 weeks, so the answer is sums of all weeks divided by 7.

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

readInt = maybe undefined (fromIntegral . fst) . B.readInt
readInts = (readInt <$>) . B.words

chiến :: [Int64] -> Int64 -> Int64 -> Double
chiến as n k = sum $ map (\p -> (fromIntegral p) / d) $ scanl (\p (hf, hs) -> p - hf + hs) (sum f) $ zip (f ++ s) s
  where
    (f, s) = splitAt (fromIntegral k) as
    d = fromIntegral $ n - k + 1

main = do
  n:k:_ <- readInts <$> B.getLine
  as <- readInts <$> B.getLine
  print $ chiến as n k

-- Codeforces 808B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
    (n:k:xs) <- (map (fromIntegral . fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents :: IO [Int64]
    let v = min k (n - k + 1)
        s = sum $ zipWith (\x i -> if | i <= v -> i * x
                                      | i > v && i <= n - v -> v * x
                                      | i > n - v -> (n - i + 1) * x) xs [1..]
        s' = fromIntegral s :: Double
        t' = fromIntegral (n - k + 1) :: Double
    print (s' / t')

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

run [] _ _ _ ans = ans
run (x:xs) i n k ans = run xs (i + 1) n k (fromIntegral ((minimum [n - i + 1, i, k, n - k + 1]) * x) + ans)

main = do
    (map read . words -> [n, k]) <- getLine
    (map read . words -> (xs :: [Integer])) <- getLine
    print $ run xs 1 n k 0.0 / fromIntegral (n - k + 1)

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

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến as n k = (fromIntegral $ sum $ scanl (\p (hf, hs) -> p - hf + hs) (sum f) $ zip (f ++ s) s) / (fromIntegral $ n - k + 1)
  where
    (f, s) = splitAt k as

main = do
  n:k:_ <- readInts <$> B.getLine
  as <- readInts <$> B.getLine
  print $ chiến as n k

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

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

chiến as n k = sum $ map (\p -> (fromIntegral p) / d) $ scanl (\p (hf, hs) -> p - hf + hs) (sum f) $ zip (f ++ s) s
  where
    (f, s) = splitAt k as
    d = fromIntegral $ n - k + 1

main = do
  n:k:_ <- readInts <$> B.getLine
  as <- readInts <$> B.getLine
  print $ chiến as n k

-- Codeforces 808B

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-O2 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-}

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

main :: IO ()
main = do
    (n:k:xs) <- (map (fromIntegral . fst . fromJust . BC.readInt) . BC.words) <$> BC.getContents :: IO [Int64]
    let s = sum $ zipWith (\x i -> if | i < k -> i * x
                                      | i >= k && i <= n - k -> k * x
                                      | i > n - k -> (n - i + 1) * x) xs [1..]
        s' = fromIntegral s :: Double
        t' = fromIntegral (n - k + 1) :: Double
    print (s' / t')

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

run [] _ _ _ ans = ans
run (x:xs) i n k ans = run xs (i + 1) n k (fromIntegral ((minimum [n - i + 1, i, k]) * x) + ans)

main = do
    (map read . words -> [n, k]) <- getLine
    (map read . words -> xs) <- getLine
    print $ run xs 1 n k 0.0 / fromIntegral (n - k + 1)


A plane is flying at a constant height of $$$h$$$ meters above the ground surface. Let's consider that it is flying from the point $$$(-10^9, h)$$$ to the point $$$(10^9, h)$$$ parallel with $$$Ox$$$ axis.A glider is inside the plane, ready to start his flight at any moment (for the sake of simplicity let's consider that he may start only when the plane's coordinates are integers). After jumping from the plane, he will fly in the same direction as the plane, parallel to $$$Ox$$$ axis, covering a unit of distance every second. Naturally, he will also descend; thus his second coordinate will decrease by one unit every second.There are ascending air flows on certain segments, each such segment is characterized by two numbers $$$x_1$$$ and $$$x_2$$$ ($$$x_1 < x_2$$$) representing its endpoints. No two segments share any common points. When the glider is inside one of such segments, he doesn't descend, so his second coordinate stays the same each second. The glider still flies along $$$Ox$$$ axis, covering one unit of distance every second.     If the glider jumps out at $$$1$$$, he will stop at $$$10$$$. Otherwise, if he jumps out at $$$2$$$, he will stop at $$$12$$$. Determine the maximum distance along $$$Ox$$$ axis from the point where the glider's flight starts to the point where his flight ends if the glider can choose any integer coordinate to jump from the plane and start his flight. After touching the ground the glider stops altogether, so he cannot glide through an ascending airflow segment if his second coordinate is $$$0$$$.

The first line contains two integers $$$n$$$ and $$$h$$$ $$$(1 \le n \le 2\cdot10^{5}, 1 \le h \le 10^{9})$$$ — the number of ascending air flow segments and the altitude at which the plane is flying, respectively. Each of the next $$$n$$$ lines contains two integers $$$x_{i1}$$$ and $$$x_{i2}$$$ $$$(1 \le x_{i1} < x_{i2} \le 10^{9})$$$ — the endpoints of the $$$i$$$-th ascending air flow segment. No two segments intersect, and they are given in ascending order.

Print one integer — the maximum distance along $$$Ox$$$ axis that the glider can fly from the point where he jumps off the plane to the point where he lands if he can start his flight at any integer coordinate.

NoteIn the first example if the glider can jump out at $$$(2, 4)$$$, then the landing point is $$$(12, 0)$$$, so the distance is $$$12-2 = 10$$$.In the second example the glider can fly from $$$(16,10)$$$ to $$$(34,0)$$$, and the distance is $$$34-16=18$$$.In the third example the glider can fly from $$$(-100,1000000000)$$$ to $$$(1999999899,0)$$$, so the distance is $$$1999999899-(-100)=1999999999$$$.

{-# LANGUAGE Safe #-}

import Control.Applicative
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS
import Data.Array.Unboxed

readIntBS = fst . fromJust . BS.readInt

main = do
  [n,h] <- map read . words <$> getLine :: IO [Int]
  seg <- map (map readIntBS . BS.words) . BS.lines <$> BS.getContents :: IO [[Int]]

  let
    arr = listArray (0,n) $ scanl (+) 0 (map (\[x1,x2] -> x2-x1) seg) :: UArray Int Int
    arr2 = listArray (0,n) $ scanl (+) 0 $ zipWith (\[x1,x2] [y1,y2] -> y1-x2) seg (tail seg) ++ [2*10^9] :: UArray Int Int

  print $ maximum $ (flip map) (zip [1..] seg) $
    \(i,[x1,x2]) -> let j = lowerBound arr2 (arr2!(i-1)+h) i n in arr!j - arr!(i-1)+h

lowerBound :: UArray Int Int -> Int -> Int -> Int -> Int
lowerBound arr x lower upper = lowerBound' lower upper
  where
    lowerBound' l r
      | r - l <= 1 = if arr!l < x then r else l
      | otherwise = let m = div (l+r) 2 in
                      if arr!m < x then
                        lowerBound' m r
                      else
                        lowerBound' l m


The student council is preparing for the relay race at the sports festival.The council consists of $$$n$$$ members. They will run one after the other in the race, the speed of member $$$i$$$ is $$$s_i$$$. The discrepancy $$$d_i$$$ of the $$$i$$$-th stage is the difference between the maximum and the minimum running speed among the first $$$i$$$ members who ran. Formally, if $$$a_i$$$ denotes the speed of the $$$i$$$-th member who participated in the race, then $$$d_i = \max(a_1, a_2, \dots, a_i) - \min(a_1, a_2, \dots, a_i)$$$.You want to minimize the sum of the discrepancies $$$d_1 + d_2 + \dots + d_n$$$. To do this, you are allowed to change the order in which the members run. What is the minimum possible sum that can be achieved?

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 2000$$$)  — the number of members of the student council. The second line contains $$$n$$$ integers $$$s_1, s_2, \dots, s_n$$$ ($$$1 \le s_i \le 10^9$$$)  – the running speeds of the members.

Print a single integer  — the minimum possible value of $$$d_1 + d_2 + \dots + d_n$$$ after choosing the order of the members.

NoteIn the first test case, we may choose to make the third member run first, followed by the first member, and finally the second. Thus $$$a_1 = 2$$$, $$$a_2 = 3$$$, and $$$a_3 = 1$$$. We have:  $$$d_1 = \max(2) - \min(2) = 2 - 2 = 0$$$.  $$$d_2 = \max(2, 3) - \min(2, 3) = 3 - 2 = 1$$$.  $$$d_3 = \max(2, 3, 1) - \min(2, 3, 1) = 3 - 1 = 2$$$. The resulting sum is $$$d_1 + d_2 + d_3 = 0 + 1 + 2 = 3$$$. It can be shown that it is impossible to achieve a smaller value.In the second test case, the only possible rearrangement gives $$$d_1 = 0$$$, so the minimum possible result is $$$0$$$.

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
-- {-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             intersect, isPrefixOf, nub, sort,
                                             sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace
traced x = trace (show x) x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

modifyArray :: (MA.MArray a e m, A.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix func = do
    e <- STA.readArray arr ix
    STA.writeArray arr ix $ func e

solve :: Int -> [Int64] -> Int64
solve n ss = ST.runST $ do
    dp <- STA.newArray ((1, 1), (n, n)) 0 :: ST.ST s (STA.STArray s (Int, Int) Int64)
    let ssArray = UA.listArray (1, n) (sort ss) :: UA.Array Int Int64

    forM_ [1 .. n] $ \i -> do
        STA.writeArray dp (i, i) 0

    forM_ [2 .. n] $ \len -> do
        forM_ [1 .. n - len + 1] $ \l -> do
            let r = l + len - 1
            dpR <- STA.readArray dp (l + 1, r)
            dpL <- STA.readArray dp (l, r - 1)
            STA.writeArray dp (l, r) (ssArray UA.! r - ssArray UA.! l + minimum [dpL, dpR])

    STA.readArray dp (1, n)

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    ss <- B8.getLine <&> map (fromInteger . readIntegerB8) . B8.words
    let answer = solve n ss
    printf "%lld\n" answer


Captain Flint and his crew keep heading to a savage shore of Byteland for several months already, drinking rum and telling stories. In such moments uncle Bogdan often remembers his nephew Denis. Today, he has told a story about how Denis helped him to come up with an interesting problem and asked the crew to solve it.In the beginning, uncle Bogdan wrote on a board a positive integer $$$x$$$ consisting of $$$n$$$ digits. After that, he wiped out $$$x$$$ and wrote integer $$$k$$$ instead, which was the concatenation of binary representations of digits $$$x$$$ consists of (without leading zeroes). For example, let $$$x = 729$$$, then $$$k = 111101001$$$ (since $$$7 = 111$$$, $$$2 = 10$$$, $$$9 = 1001$$$).After some time, uncle Bogdan understood that he doesn't know what to do with $$$k$$$ and asked Denis to help. Denis decided to wipe last $$$n$$$ digits of $$$k$$$ and named the new number as $$$r$$$.As a result, Denis proposed to find such integer $$$x$$$ of length $$$n$$$ that $$$r$$$ (as number) is maximum possible. If there are multiple valid $$$x$$$ then Denis is interested in the minimum one.All crew members, including captain Flint himself, easily solved the task. All, except cabin boy Kostya, who was too drunk to think straight. But what about you?Note: in this task, we compare integers ($$$x$$$ or $$$k$$$) as numbers (despite what representations they are written in), so $$$729 < 1999$$$ or $$$111 < 1000$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ lines contain test cases — one per test case. The one and only line of each test case contains the single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the integer $$$x$$$ you need to find. It's guaranteed that the sum of $$$n$$$ from all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print the minimum integer $$$x$$$ of length $$$n$$$ such that obtained by Denis number $$$r$$$ is maximum possible.

NoteIn the second test case (with $$$n = 3$$$), if uncle Bogdan had $$$x = 998$$$ then $$$k = 100110011000$$$. Denis (by wiping last $$$n = 3$$$ digits) will obtain $$$r = 100110011$$$.It can be proved that the $$$100110011$$$ is the maximum possible $$$r$$$ Denis can obtain and $$$998$$$ is the minimum $$$x$$$ to obtain it.

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  let c = (n - 1) `div` 4 + 1
  putStrLn $ replicate (n - c) '9' ++ replicate c '8'

import Data.Char
import Data.List
import Control.Monad

result x = replicate (div (3*x) 4) '9' ++ replicate (x - (div (3*x) 4)) '8'

main = do
    tests <- getLine
    a <- getContents
    putStr $ intercalate "\n" [ result (read x :: Int) | x <- words a ]

module Main where

   solve :: IO ()
   solve = do
       s <- getLine
       let n = read s :: Int
           c = (n + 3) `div` 4
       putStrLn $ replicate (n - c) '9' ++ replicate c '8'

   iter :: Int -> IO ()
   iter 1 = solve
   iter n = do
       solve
       iter $ n - 1

   main :: IO ()
   main = do
       s <- getLine
       iter (read s :: Int)


You are given two integers $$$n$$$ and $$$m$$$. Calculate the number of pairs of arrays $$$(a, b)$$$ such that:  the length of both arrays is equal to $$$m$$$;  each element of each array is an integer between $$$1$$$ and $$$n$$$ (inclusive);  $$$a_i \le b_i$$$ for any index $$$i$$$ from $$$1$$$ to $$$m$$$;  array $$$a$$$ is sorted in non-descending order;  array $$$b$$$ is sorted in non-ascending order. As the result can be very large, you should print it modulo $$$10^9+7$$$.

The only line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 1000$$$, $$$1 \le m \le 10$$$).

Print one integer – the number of arrays $$$a$$$ and $$$b$$$ satisfying the conditions described above modulo $$$10^9+7$$$.

import Control.Monad
import Data.Array
import Data.List
import qualified Data.Map.Strict as M

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

output :: Show a => [a] -> IO ()
output = putStrLn <$> unwords <$> map show

c n k = product [n-k+1..n] `div` product [1..k]

_mod = 1000000007

main = do
  [n,m] <- input
  print (c (2*m+n-1) (2*m) `mod` _mod)

iter :: [Integer] -> [Integer]
iter xs = tail $ scanl (+) 0 xs

cal :: Int -> Int -> [Integer]
cal n 1 =  take n $ repeat 1
cal n m =
  let ls = cal n 1
      itf = foldl (.) (id) $ take (m - 1) $ repeat (iter)
  in
      itf ls
--   let a = cal n (m - 1)
--       b = cal (n - 1) m
--       v = foldr (+) 0 a
--   in
--       b ++ [v]

calSum :: Int -> Int -> Integer -> Integer
calSum n m d =
  let
    xs = map (`mod` d) $ cal n m
    ss = reverse $ tail $ scanl (+) 0 xs
  in
    (`mod` d) . sum $ zipWith ((*)) xs ss

main :: IO ()
main = do
  line <- getLine
  let (n:m:[]) = map (read :: String -> Int) $ words line
  putStrLn $ show $ calSum n m 1000000007

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

a # b = chooses ! (a, b)

chooses :: Array (Int, Int) Integer
chooses = array ((0, 0), (1100, 1100)) [((a, b), choose a b) | a <- [0..1100], b <- [0..1100]]

choose a b
  | b < 0 || b > a = 0
  | b == 0 || a == b = 1
  | otherwise = mod ((a - 1) # (b - 1) + (a - 1) # b) 1000000007

main = getContents >>= print.(\(n:m:_) -> mod (sum [(i + m - 1) # (m - 1) * (n - j + m - 2) # (m - 1) | i <- [0..n - 1], j <- [i..n - 1]]) 1000000007).map read.words

base = 1000000007 :: Integer

n_choose_k :: Int -> Int -> Integer
n_choose_k n k = chooseTab !! n !! k

chooseTab :: [[Integer]]
chooseTab = [[ chooseDef n k | k <- [0..n]] | n <- [0..]]

chooseDef :: Int -> Int -> Integer
chooseDef n k
  | k == 0 || k == n = 1
  | k == 1           = toInteger n
  | otherwise        = mod (n_choose_k (n-1) (k-1) + n_choose_k (n-1) k) base

solveTask :: (Int, Int) -> Integer
solveTask (n, m) =
      let k' = 2*m
          n' = n + k' -1
      in n_choose_k n' k'

groupTaskInput :: [String] -> [(Int, Int)]
groupTaskInput [] = []
groupTaskInput (n:(d:xs)) = (read n, read d) : groupTaskInput(xs)

makeTaskInput :: String -> [(Int, Int)]
makeTaskInput s = groupTaskInput . words $ s

solve :: String -> String
solve s = concat $ (map (++ "\n") ) $ (map $ show.solveTask) $ makeTaskInput s

main' :: IO ()
main' = do interact $ solve

main = main'

import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)

import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    (n, m) <- liftM2 (,) get get :: EIO (Int, Int)
    putln $ f1 n m

f1 :: Int -> Int -> Int64
f1 n m =    let ix a b = a * m + b in
            let a = runSTUArray $ do
                arr <- newArray (0, (n + 1) *  m) 0 :: ST s (STUArray s Int Int64)
                forM_ [0..n] $ \j -> writeArray arr (ix j 0) 1
                forM_ [1..m-1] $ \i ->
                    forM_ [0..n] $ \j ->
                        forM_ [0..j] $ \k -> do
                            a <- readArray arr (ix j i)
                            b <- readArray arr (ix k (i - 1))
                            writeArray arr (ix j i) $ (mod (a + b) 1000000007)
                return arr in
            let v = do
                x <- [1..n]
                y <- [1..n]
                [(x, y)] in
            let x = filter (\(x, y) -> x <= y) v in
            foldl (\s (x, y) -> mod (s + (a ! (ix (x - 1) (m - 1))) * (a ! (ix (n - y) (m - 1)))) 1000000007) 0 x

import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    (n, m) <- liftM2 (,) get get :: EIO (Int, Int)
    putln $ f1 n m

f1 :: Int -> Int -> Int64
f1 n m =    let a = runSTArray $ do
                arr <- newArray ((0, 0), (n+1, m)) 0 :: ST s (STArray s (Int, Int) Int64)
                forM_ [0..n] $ \j -> writeArray arr (j, 0) 1
                forM_ [1..m-1] $ \i ->
                    forM_ [0..n] $ \j ->
                        forM_ [0..j] $ \k -> do
                            a <- readArray arr (j, i)
                            b <- readArray arr (k, i - 1)
                            writeArray arr (j, i) $ (mod (a + b) 1000000007)
                return arr in
            let v = do
                x <- [1..n]
                y <- [1..n]
                [(x, y)] in
            let x = filter (\(x, y) -> x <= y) v in
            foldl (\s (x, y) -> mod (s + (a ! (x - 1, m - 1)) * (a ! (n - y, m - 1))) 1000000007) 0 x

import Data.Ord
import Data.Int
import Data.Sequence as DSeq (null, Seq( Empty ), (|>), (><), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)

import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s |> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn(s)

main_ :: EIO ()
main_ = do
    (n, m) <- liftM2 (,) get get :: EIO (Int, Int)
    putln $ f1 n m

f1 :: Int -> Int -> Int64
f1 n m =    let a = runSTUArray $ do
                arr <- newArray ((0, 0), (n+1, m)) 0 :: ST s (STUArray s (Int, Int) Int64)
                forM_ [0..n] $ \j -> writeArray arr (j, 0) 1
                forM_ [1..m-1] $ \i ->
                    forM_ [0..n] $ \j ->
                        forM_ [0..j] $ \k -> do
                            a <- readArray arr (j, i)
                            b <- readArray arr (k, i - 1)
                            writeArray arr (j, i) $ (mod (a + b) 1000000007)
                return arr in
            let v = do
                x <- [1..n]
                y <- [1..n]
                [(x, y)] in
            let x = filter (\(x, y) -> x <= y) v in
            foldl (\s (x, y) -> mod (s + (a ! (x - 1, m - 1)) * (a ! (n - y, m - 1))) 1000000007) 0 x

import System.IO
import Data.Array

readInt :: IO Int
readInt = readLn

castToInteger x = read x::Integer

main = do
    line <- getLine
    let test_case = (map castToInteger . take 2 . words) line
    solveTask test_case

solveTask :: [Integer] -> IO ()
solveTask [n, m] = do
    let dpVs = getDp m n
    let res = foldl modSum 0 [
                modProd (dpVs!i) (dpVs!(n-j+1)) |
                i <- [1..n], j <- [i..n]]
    print res
    return ()

-- getDp i n =
--     array (1,n) [(j, foldl modSum 0 [dp!(j') | j' <- [1..j]]) | j <- [1..n]]
--     where dp = getDp (i-1) n
getDp :: Integer -> Integer -> Array Integer Integer
getDp i n = array (1,n) $ enumerate $ getDpList i n

getDpList :: Integer -> Integer -> [Integer]
getDpList 1 n = [1 | i <- [1..n]]
getDpList i n = prefSum dp
    where dp = getDpList (i-1) n

prefSum :: [Integer] -> [Integer]
prefSum xs = prefSum' 0 xs
prefSum' agg [] = []
prefSum' agg (x:xs) = s : prefSum' s xs
    where s = modSum agg x

enumerate :: [Integer] -> [(Integer, Integer)]
enumerate xs = enumerate' 1 xs
enumerate' i [] = []
enumerate' i (x:xs) = (i, x) : enumerate' (i+1) xs

customMod :: Integer
customMod = 10^9 + 7

modSum :: Integer -> Integer -> Integer
modSum a b = if a + b < customMod then a + b else a + b - customMod

modProd :: Integer -> Integer -> Integer
modProd a b = (a * b) `mod` customMod

count :: [Integer] -> Integer
count [] = 0
count (x:xs) = 1 + count xs

import System.IO
import Data.Array

readInt :: IO Int
readInt = readLn

castToInteger x = read x::Integer

main = do
    line <- getLine
    let test_case = (map castToInteger . take 2 . words) line
    solveTask test_case

solveTask :: [Integer] -> IO ()
solveTask [n, m] = do
    let dpVs = getDp m n
    let res = foldl modSum 0 [
                modProd (dpVs!i) (dpVs!(n-j+1)) |
                i <- [1..n], j <- [i..n]]
    print res
    return ()

getDp :: Integer -> Integer -> Array Integer Integer
getDp 1 n = array (1,n) [(i, 1) | i <- [1..n]]
getDp i n =
    array (1,n) [(j, foldl modSum 0 [dp!(j') | j' <- [1..j]]) | j <- [1..n]]
    where dp = getDp (i-1) n

customMod :: Integer
customMod = 10^9 + 7

modSum :: Integer -> Integer -> Integer
modSum a b = if a + b < customMod then a + b else a + b - customMod

modProd :: Integer -> Integer -> Integer
modProd a b = (a * b) `mod` customMod

count :: [Integer] -> Integer
count [] = 0
count (x:xs) = 1 + count xs


Let's define the value of the permutation $$$p$$$ of $$$n$$$ integers $$$1$$$, $$$2$$$, ..., $$$n$$$ (a permutation is an array where each element from $$$1$$$ to $$$n$$$ occurs exactly once) as follows:  initially, an integer variable $$$x$$$ is equal to $$$0$$$;  if $$$x < p_1$$$, then add $$$p_1$$$ to $$$x$$$ (set $$$x = x + p_1$$$), otherwise assign $$$0$$$ to $$$x$$$;  if $$$x < p_2$$$, then add $$$p_2$$$ to $$$x$$$ (set $$$x = x + p_2$$$), otherwise assign $$$0$$$ to $$$x$$$;  ...  if $$$x < p_n$$$, then add $$$p_n$$$ to $$$x$$$ (set $$$x = x + p_n$$$), otherwise assign $$$0$$$ to $$$x$$$;  the value of the permutation is $$$x$$$ at the end of this process. For example, for $$$p = [4, 5, 1, 2, 3, 6]$$$, the value of $$$x$$$ changes as follows: $$$0, 4, 9, 0, 2, 5, 11$$$, so the value of the permutation is $$$11$$$.You are given an integer $$$n$$$. Find a permutation $$$p$$$ of size $$$n$$$ with the maximum possible value among all permutations of size $$$n$$$. If there are several such permutations, you can print any of them.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 97$$$) — the number of test cases. The only line of each test case contains one integer $$$n$$$ ($$$4 \le n \le 100$$$).

For each test case, print $$$n$$$ integers — the permutation $$$p$$$ of size $$$n$$$ with the maximum possible value among all permutations of size $$$n$$$.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = Int
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  -- print (n, xs)
  return n

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [1..length xs] xs

newtype I = I (Int,Int)

-- try for the automatically generated if not fixed
solve :: Solver
solve n = putStrLn $ intercalate " " $ map show $ go xs
  where xs = [1..n]
        go :: [Int] -> [Int]
        go [] = []
        go [x] = [x]
        go [x, y] = [x, y]
        go [x, y, z] = [y, x, z]
        go [a, b, x, y, z] = [a, x, b, y, z]
        go (x:y:xs) = y:x:go xs

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

get_my_list :: Int -> [Int]
get_my_list 1 = [1]
get_my_list 2 = [1,2]
get_my_list 3 = [2,1,3]
get_my_list n =
    case (mod n 3) of
        0 -> 1:2:4:3:[5..n]
        1 -> 2:1:[3..n]
        2 -> [1..n]

ints_to_str :: [Int] -> String
ints_to_str = unwords . map show

input_to_output :: String -> IO ()
input_to_output = (putStrLn . ints_to_str . get_my_list . read)

test_case_func :: (Num a,Eq a) => a -> IO ()
test_case_func 0 = return ()
test_case_func t = do
    n <- getLine
    input_to_output n
    test_case_func (t - 1)

main :: IO ()
main = do
    ts <- getLine
    test_case_func $ read ts

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>=
        \n -> mapM_ (\x -> putStr (show x ++ " ")) (getPerm n) >>
              putStrLn ""
getPerm n | mod n 2 == 0 = reverse [1..n-2] ++ [n-1, n]
          | otherwise    = [n-3, n-2] ++ reverse [1..n-4] ++ [n-1, n]

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out  &&  cat -- permutscore.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

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

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

showL = unwords . map show

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [n] <- ri
        return n
    mapM_ (putStrLn.showL.solve) tcs

solve n = answ
  where
    (x:xs,ys) = splitAt (n - 2) [1..n]

    answ | (even n)   =        reverse xs ++ [x] ++ ys
         | otherwise  = [x] ++ reverse xs        ++ ys

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = Int
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  -- print (n, xs)
  return n

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [1..length xs] xs

newtype I = I (Int,Int)

-- try for the automatically generated if not fixed
solve :: Solver
solve n = putStrLn $ intercalate " " $ map show $ go xs
  where xs = [1..n]
        go :: [Int] -> [Int]
        go [] = []
        go [x] = [x]
        go [x, y] = [x, y]
        go [x, y, z] = [y, x, z]
        go [a, b, x, y, z] = [a, x, b, y, z]
        go (x:y:xs) = y:x:xs

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE TupleSections #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when, liftM3)
import Data.Char (digitToInt, toLower)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort, intercalate)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Function (on)
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Data.Bool (bool)
import Data.Foldable (foldlM, Foldable (foldl'), find, sequenceA_, foldrM)
import Control.Arrow ((&&&), Arrow ((***)))
import Data.Coerce (coerce)
import Data.Set.Internal(Set(Bin, Tip))
import Debug.Trace (traceShowId, traceShow)
import Data.Foldable (maximumBy)
import Data.Ord (comparing)
import qualified Data.IntMap as IntMap
import Control.Monad.Trans.Class
import Control.Exception (assert)
import Data.String

-- type IMap = Set (Int, Int)
type Domain = Int
type Solver  = Domain -> IO ()

readChar8 :: IO [Int]
readChar8 = fmap (fst . fromJust) . fmap C.readInt . C.words <$> fromString <$> getLine

parse :: IO Domain
parse = do
  [n] <- readChar8
  -- print (n, xs)
  return n

enumerate :: [a] -> [(Int, a)]
enumerate xs = zip [1..length xs] xs

newtype I = I (Int,Int)

-- try for the automatically generated if not fixed
solve :: Solver
solve n = putStrLn $ intercalate " " $ map show $ go xs
  where xs = [1..n]
        go :: [Int] -> [Int]
        go [] = []
        go [x] = [x]
        go [x, y] = [x, y]
        go [x, y, z] = [y, x, z]
        go [a, b, x, y, z] = [a, b, x, y, z]
        go (x:y:xs) = y:x:xs

main :: IO ()
main = do
  [n] <- readChar8
  sequence_ =<< (replicateM n $ solve <$> parse)

get_my_list :: Int -> [Int]
get_my_list 1 = [1]
get_my_list 2 = [1,2]
get_my_list 3 = [2,1,3]
get_my_list n =
    case (mod n 3) of
        0 -> 1:2:4:3:[5..n]
        1 -> 2:1:[3..n]
        2 -> [1..n]

ints_to_str :: [Int] -> String
ints_to_str = unwords . map show

input_to_output :: String -> IO ()
input_to_output = (print . ints_to_str . get_my_list . read)

test_case_func :: (Num a,Eq a) => a -> IO ()
test_case_func 0 = return ()
test_case_func t = do
    n <- getLine
    input_to_output n
    test_case_func (t - 1)

main :: IO ()
main = do
    ts <- getLine
    test_case_func $ read ts


Anton likes to play chess. Also he likes to do programming. No wonder that he decided to attend chess classes and programming classes.Anton has n variants when he will attend chess classes, i-th variant is given by a period of time (l1, i, r1, i). Also he has m variants when he will attend programming classes, i-th variant is given by a period of time (l2, i, r2, i).Anton needs to choose exactly one of n possible periods of time when he will attend chess classes and exactly one of m possible periods of time when he will attend programming classes. He wants to have a rest between classes, so from all the possible pairs of the periods he wants to choose the one where the distance between the periods is maximal.The distance between periods (l1, r1) and (l2, r2) is the minimal possible distance between a point in the first period and a point in the second period, that is the minimal possible |i - j|, where l1 ≤ i ≤ r1 and l2 ≤ j ≤ r2. In particular, when the periods intersect, the distance between them is 0.Anton wants to know how much time his rest between the classes will last in the best case. Help Anton and find this number!

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000) — the number of time periods when Anton can attend chess classes. Each of the following n lines of the input contains two integers l1, i and r1, i (1 ≤ l1, i ≤ r1, i ≤ 109) — the i-th variant of a period of time when Anton can attend chess classes. The following line of the input contains a single integer m (1 ≤ m ≤ 200 000) — the number of time periods when Anton can attend programming classes. Each of the following m lines of the input contains two integers l2, i and r2, i (1 ≤ l2, i ≤ r2, i ≤ 109) — the i-th variant of a period of time when Anton can attend programming classes.

Output one integer — the maximal possible distance between time periods.

NoteIn the first sample Anton can attend chess classes in the period (2, 3) and attend programming classes in the period (6, 8). It's not hard to see that in this case the distance between the periods will be equal to 3.In the second sample if he chooses any pair of periods, they will intersect. So the answer is 0.

import Data.List
import Data.Maybe (fromJust)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

main :: IO()
main = print . solve . map (fst . fromJust . C.readInt) . C.words =<< B.getContents

solve :: [Int] -> Int
solve (n:a) = let (p, (_:q)) = splitAt (2 * n) a
                  (po, pe) = split p
                  (qo, qe) = split q
                  pomax = maximum po
                  pemin = minimum pe
                  qomax = maximum qo
                  qemin = minimum qe
                  int1 = if qomax > pemin then qomax - pemin else 0
                  int2 = if pomax > qemin then pomax - qemin else 0
              in max int1 int2

split :: [Int] -> ([Int], [Int])
split [] = ([], [])
split (x:y:s) = let (xs, ys) = split s in (x:xs, y:ys)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.ByteString.Char8( words, readInt)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int,Int)
	readPair = do
	    [Just (l,_) ,Just (r,_)] <- map readInt . B.words <$>
							    getLine'
	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max lmax l
		rmin' = min rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.ByteString.Char8( readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int,Int)
	readPair = do
	    Just (l,rest) <- readInt <$> getLine'
	    let
		Just (r,_) = readInt $ B.tail rest

	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let
	searchRMinLMax 	= foldl update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) = (max lmax l, min rmin r)

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.ByteString.Char8( readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int,Int)
	readPair = do
	    Just (l,rest) <- readInt <$> getLine'
	    let
		Just (r,_) = readInt $ B.tail rest

	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max lmax l
		rmin' = min rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.Int( Int32)
import Data.Bits( (.|.), (.&.), xor, shiftR, complement)
import Data.ByteString.Char8( words, readInt)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int32,Int32)
	readPair = do
	    [Just (l,_) ,Just (r,_)] <- map readInt . B.words <$>
							    getLine'
	    return (fromIntegral l, fromIntegral r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max32 lmax l
		rmin' = min32 rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

branchFreeMinMax32:: Int32 -> Int32 -> Int32 -> Int32
branchFreeMinMax32 a b diff =
  let
    mask1 = shiftR	diff	    32
    mask2 = complement mask1

    lose_a = mask1 .&. a
    lose_b = mask2 .&. b
    loser = lose_a .|. lose_b

    ab = a `xor` b
    winner = loser `xor` ab
  in
    winner

max32, min32::Int32 -> Int32 -> Int32
max32 a b = branchFreeMinMax32 a b (a-b)
min32 a b = branchFreeMinMax32 a b (b-a)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.ByteString.Char8( readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int,Int)
	readPair = do
	    Just (l,rest) <- readInt <$> getLine'
	    let
		Just (r,_) = readInt $ B.tail rest

	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let
	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) = (max lmax l, min rmin r)

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.ByteString.Char8( readInt, tail)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int,Int)
	readPair = do
	    Just (l,rest) <- readInt <$> getLine'
	    let
		Just (r,_) = readInt $ B.tail rest

	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max lmax l
		rmin' = min rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.Int( Int32)
import Data.Bits( (.|.), (.&.), xor, shiftR, complement)
import Data.ByteString.Char8( words, readInt)
import qualified Data.ByteString.Char8 as B
import System.IO( stdin)

main = do
    let
	getLine' = B.hGetLine stdin

    Just (n_, _) <- readInt <$> getLine'
    let
	readPair::IO (Int32,Int32)
	readPair = do
	    [Just (l,_) ,Just (r,_)] <- map readInt . B.words <$>
							    getLine'
	    return (fromIntegral l, fromIntegral r)

    chessPeriods_ <- replicateM n_ readPair

    Just (m_, _) <- readInt <$> getLine'
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max32 lmax l
		rmin' = min32 rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

branchFreeMinMax32:: Int32 -> Int32 -> Int32 -> Int32
branchFreeMinMax32 a b diff =
  let
    mask1 = shiftR	diff	    32
    mask2 = complement mask1

    lose_a = mask1 .&. a
    lose_b = mask2 .&. b
    loser = lose_a .|. lose_b

    ab = a `xor` b
    winner = loser `xor` ab
  in
    diff `seq`
    mask1 `seq` mask2 `seq`
    lose_a `seq` lose_b `seq` loser `seq`
    ab `seq`
    winner

max32, min32::Int32 -> Int32 -> Int32
max32 a b = branchFreeMinMax32 a b (a-b)
min32 a b = branchFreeMinMax32 a b (b-a)

{-# LANGUAGE BangPatterns #-}

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

sSpace w = span (/= ' ') w
toInt s = read s :: Int
toIntTup (a, b) = (toInt a, toInt b)

findMinMaxH :: Int -> Int -> Int -> IO((Int, Int))
findMinMaxH 0 cmin cmax = return (cmin, cmax)
findMinMaxH i !cmin !cmax = do
    w <- getLine
    let (newMax, newMin) = toIntTup $ sSpace w in
        findMinMaxH (i-1) (min cmin newMin) (max cmax newMax)

findMinMax :: Int -> IO((Int, Int))
findMinMax i = findMinMaxH i 10000000009 (-1)

main :: IO()
main = do
    chessCount <- getLine
    (cendmin, cstartmax) <- findMinMax $ toInt chessCount
    --print (cendmin, cstartmax)
    programCount <- getLine
    (pendmin, pstartmax) <- findMinMax $ toInt programCount
    --print (pendmin, pstartmax)
    print $ maximum [(pstartmax - cendmin), (cstartmax - pendmin), 0]

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

import Control.Monad (foldM)
import Control.DeepSeq (force)

ffoldM a b f = foldM f b a

calc bn am an bm | am - bn <= 0 && an - bm <= 0 = 0
                 | otherwise = max (an - bm) (am - bn)

xmin a b | length a < length b = a
         | length b < length a = b
         | otherwise = min a b

xmax a b | length a > length b = a
         | length b > length a = b
         | otherwise = max a b

main = do
    (read -> n :: Int) <- getLine
    let (a, b) = (take 10 (repeat '9'), "")
    (map (read :: String -> Int) -> [bn, an]) <- ffoldM [1..n] [a, b] $ \[bn, an] _ -> do
        (words -> [c, c']) <- getLine
        return $ force [xmin bn c', xmax an c]
    (read -> m :: Int) <- getLine
    (map (read :: String -> Int) -> [bm, am]) <- ffoldM [1..m] [a, b] $ \[bm, am] _ -> do
        (words -> [c, c']) <- getLine
        return $ force [xmin bm c', xmax am c]
    putStrLn $ show (calc bn am an bm)

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
import Data.List( foldl')
import Data.Int( Int32)
import Data.Bits( (.|.), (.&.), xor, shiftR)

main = do
    n_ <- readLn::IO Int
    let
	readPair::IO (Int32,Int32)
	readPair = do
	    [l,r] <- map read . words <$> getLine
	    return (l,r)

    chessPeriods_ <- replicateM n_ readPair

    m_ <- readLn::IO Int
    progPeriods_ <- replicateM m_ readPair
    let

	searchRMinLMax 	= foldl' update (0,ten9)
	  where
	    update (lmax, rmin) (l,r) =
	      let
		lmax' = max32 lmax l
		rmin' = min32 rmin r
	      in
		lmax' `seq` rmin' `seq` (lmax', rmin')

	ten9 = 1000000000
	(lmaxChess, rminChess) = searchRMinLMax chessPeriods_
	(lmaxProg, rminProg) = searchRMinLMax progPeriods_

    print $ max 0$max (lmaxChess - rminProg) (lmaxProg - rminChess)

branchFreeMinMax32:: Int32 -> Int32 -> Int32 -> Int32
branchFreeMinMax32 a b diff =
  let
    mask1 = shiftR	diff	    32
    mask2 = shiftR (negate diff)    32

    lose_a = mask1 .&. a
    lose_b = mask2 .&. b
    loser = lose_a .|. lose_b

    ab = a `xor` b
    winner = loser `xor` ab
  in
    diff `seq`
    mask1 `seq` mask2 `seq`
    lose_a `seq` lose_b `seq` loser `seq`
    ab `seq`
    winner

max32, min32::Int32 -> Int32 -> Int32
max32 a b = branchFreeMinMax32 a b (a-b)
min32 a b = branchFreeMinMax32 a b (b-a)

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

sSpace w = span (/= ' ') w
toInt s = read s :: Int
toIntTup (a, b) = (toInt a, toInt b)

findMinMaxH :: Int -> Int -> Int -> IO((Int, Int))
findMinMaxH 0 cmin cmax = return (cmin, cmax)
findMinMaxH i cmin cmax = do
    w <- getLine
    let (newMax, newMin) = toIntTup $ sSpace w in
        findMinMaxH (i-1) (min cmin newMin) (max cmax newMax)

findMinMax :: Int -> IO((Int, Int))
findMinMax i = findMinMaxH i 1000000000000 (-1)

main :: IO()
main = do
    chessCount <- getLine
    (cendmin, cstartmax) <- findMinMax $ toInt chessCount
    programCount <- getLine
    (pendmin, pstartmax) <- findMinMax $ toInt programCount
    print $ maximum [(pstartmax - cendmin), (cstartmax - pendmin), 0]

{-# LANGUAGE BangPatterns #-}

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

sSpace w = span (/= ' ') w
toInt s = read s :: Int
toIntTup (a, b) = (toInt a, toInt b)

findMinMaxH :: Int -> Int -> Int -> IO((Int, Int))
findMinMaxH 0 cmin cmax = return (cmin, cmax)
findMinMaxH i !cmin !cmax = do
    w <- getLine
    let (newMax, newMin) = toIntTup $ sSpace w in
        findMinMaxH (i-1) (min cmin newMin) (max cmax newMax)

findMinMax :: Int -> IO((Int, Int))
findMinMax i = findMinMaxH i 100000009 (-1)

main :: IO()
main = do
    chessCount <- getLine
    (cendmin, cstartmax) <- findMinMax $ toInt chessCount
    programCount <- getLine
    (pendmin, pstartmax) <- findMinMax $ toInt programCount
    print $ maximum [(pstartmax - cendmin), (cstartmax - pendmin), 0]


It is nighttime and Joe the Elusive got into the country's main bank's safe. The safe has n cells positioned in a row, each of them contains some amount of diamonds. Let's make the problem more comfortable to work with and mark the cells with positive numbers from 1 to n from the left to the right.Unfortunately, Joe didn't switch the last security system off. On the plus side, he knows the way it works.Every minute the security system calculates the total amount of diamonds for each two adjacent cells (for the cells between whose numbers difference equals 1). As a result of this check we get an n - 1 sums. If at least one of the sums differs from the corresponding sum received during the previous check, then the security system is triggered.Joe can move the diamonds from one cell to another between the security system's checks. He manages to move them no more than m times between two checks. One of the three following operations is regarded as moving a diamond: moving a diamond from any cell to any other one, moving a diamond from any cell to Joe's pocket, moving a diamond from Joe's pocket to any cell. Initially Joe's pocket is empty, and it can carry an unlimited amount of diamonds. It is considered that before all Joe's actions the system performs at least one check.In the morning the bank employees will come, which is why Joe has to leave the bank before that moment. Joe has only k minutes left before morning, and on each of these k minutes he can perform no more than m operations. All that remains in Joe's pocket, is considered his loot.Calculate the largest amount of diamonds Joe can carry with him. Don't forget that the security system shouldn't be triggered (even after Joe leaves the bank) and Joe should leave before morning.

The first line contains integers n, m and k (1 ≤ n ≤ 104, 1 ≤ m, k ≤ 109). The next line contains n numbers. The i-th number is equal to the amount of diamonds in the i-th cell — it is an integer from 0 to 105.

Print a single number — the maximum number of diamonds Joe can steal.

NoteIn the second sample Joe can act like this:The diamonds' initial positions are 4 1 3.During the first period of time Joe moves a diamond from the 1-th cell to the 2-th one and a diamond from the 3-th cell to his pocket.By the end of the first period the diamonds' positions are 3 2 2. The check finds no difference and the security system doesn't go off.During the second period Joe moves a diamond from the 3-rd cell to the 2-nd one and puts a diamond from the 1-st cell to his pocket.By the end of the second period the diamonds' positions are 2 3 1. The check finds no difference again and the security system doesn't go off.Now Joe leaves with 2 diamonds in his pocket.

solve (n:m:k:as) = if odd n then min s q else 0
  where q = (k * (m `div` ((n + 1) `div` 2)))
        s = minimum $ map snd $ filter (odd.fst) $ zip [1..n] as

main = interact $ show.solve.map read.words

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

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

main = do
   [n, m, k] <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   xs <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   let ans = if even n
             then 0
             else let ratio = div (n+1) 2
                  in if m < ratio
                     then 0
                     else let mD = div m ratio
                              nds = min (mD*k) (minimum (f xs))
                          in nds
   print ans

module Main where

import Control.Monad
import Data.List

main = do
    [n, m, k] <- ( map read . words ) `liftM` getLine
    cells <- ( map read . words ) `liftM` getLine

    if even n
        then putStrLn "0"
        else do
            let m' = m `div` ((n+1) `div` 2)
                minTarget = minimum $ map snd $ filter (odd . fst) $ zip [1..] cells
                res = min minTarget (m' * k)
            putStrLn $ show res

f[]=[0]
f(x:y:t)=x:f t
f l=l
s(n:m:k:a)=minimum$k*(div m$n`div`2+1):f a
main=interact$show.s.map read.words

s(n:m:k:as)|odd n=minimum$(k*(m`div`((n+1)`div`2))):(map snd$filter(odd.fst)$zip[1..n]as)|1>0=0
main=interact$show.s.map read.words

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

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

main = do
   [n, m, k] <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   xs <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   let ans = if even n
             then 0
             else let ratio = div (n+1) 2
                      mD = div m ratio
                      nds = minimum $ mD*k:f xs
                  in nds
   print ans

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

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

main = do
   [n, m, k] <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   xs <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   let ans = if even n
             then 0
             else let ratio = div (n+1) 2
                  in if m < ratio
                     then 0
                     else let mD = div m ratio
                              nT = min k (minimum (map (`div` mD) (f xs)))
                              rems = minimum $ map (`mod` mD) (f xs)
                          in if nT == k
                             then mD*nT
                             else mD*nT + rems
   print ans

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

main = do
   [n, m, k] <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   xs <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   let ans = if even n
             then 0
             else let ratio = div (n+1) 2
                  in if m < ratio
                     then 0
                     else let mD = div m ratio
                              nT = min k (minimum (map (div mD) xs))
                          in mD*nT
   print ans

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

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

main = do
   [n, m, k] <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   xs <- map (fst.fromJust.BS.readInteger) . BS.words <$> BS.getLine
   let ans = if even n
             then 0
             else let ratio = div (n+1) 2
                  in if m < ratio
                     then 0
                     else let mD = div m ratio
                              nT = min k (minimum (map (`div` mD) (f xs)))
                          in mD*nT
   print ans


You are given a tree with $$$n$$$ nodes, numerated from $$$0$$$ to $$$n-1$$$. For each $$$k$$$ between $$$0$$$ and $$$n$$$, inclusive, you have to count the number of unordered pairs $$$(u,v)$$$, $$$u \neq v$$$, such that the MEX of all the node labels in the shortest path from $$$u$$$ to $$$v$$$ (including end points) is $$$k$$$.The MEX of a sequence of integers is the smallest non-negative integer that does not belong to the sequence.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases.  The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^{5}$$$). The next $$$n-1$$$ lines of each test case describe the tree that has to be constructed. These lines contain two integers $$$u$$$ and $$$v$$$ ($$$0 \le u,v \le n-1$$$) denoting an edge between $$$u$$$ and $$$v$$$ ($$$u \neq v$$$). It is guaranteed that the given edges form a tree. It is also guaranteed that the sum of $$$n$$$ for all test cases does not exceed $$$2 \cdot 10^{5}$$$.

For each test case, print $$$n+1$$$ integers: the number of paths in the tree, such that the MEX of all the node labels in that path is $$$k$$$ for each $$$k$$$ from $$$0$$$ to $$$n$$$.

import Control.Monad
import Data.Maybe
import qualified Data.Array as A
import Data.Word
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS
import Data.Array.Base
import Data.Array.IO
import Data.ByteString.Builder
import System.IO

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

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

type State = (IS.IntSet, Int, Int, Int, Int, [Word64])

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    adjs <- A.accumArray (flip (:)) [] (0, n - 1) . concatMap (\[u, v] -> [(u, v), (v, u)]) <$> replicateM (n - 1) getInts
    sizes <- newArray_ (0, n) :: IO (IOUArray Int Int)
    parents <- newArray_ (0, n) :: IO (IOUArray Int Int)
    let dfs :: Int -> Int -> IO Int
        dfs fa u = do
          size <- foldM (\sz v -> dfs u v >>= \sz' -> return (sz + sz')) 1 $ filter (/= fa) $ adjs ! u
          unsafeWrite parents u fa
          unsafeWrite sizes u size
          return size
    _ <- dfs 0 0
    let comb sz = let x = fromIntegral sz in x * (x - 1) `div` 2
    e0 <- foldM (\total v -> unsafeRead sizes v >>= \sz -> return (total + comb sz)) (0 :: Word64) $ adjs ! 0
    let ge1 = comb n - e0
        findPath :: IS.IntSet -> Int -> IO [Int]
        findPath st u
          | IS.member u st = return [u]
          | otherwise = do
              fa <- unsafeRead parents u
              path' <- findPath st fa
              return $ u : path'
        mul x y = fromIntegral x * fromIntegral y
    path0 <- init <$> findPath (IS.singleton 0) 1
    size0 <- unsafeRead sizes (last path0)
    size1 <- unsafeRead sizes 1
    let start = (IS.fromList (0 : path0), 0, n - size0, 1, size1, [mul (n - size0) size1, ge1])
        extend :: Either State State -> Int -> IO (Either State State)
        extend (Left s) _ = return $ Left s
        extend (Right s@(st, f, fs, e, es, rs)) u = do
          path <- findPath st u
          -- putStrLn $ "   " ++ show u ++ " -> " ++ show path
          let st' = foldl' (flip IS.insert) st path
              top = last path
          size' <- unsafeRead sizes u
          let ret | top == f = Right (st', u, size', e, es, mul size' es : rs)
                  | top == e = Right (st', f, fs, u, size', mul fs size' : rs)
                  | top == u = Right (st', f, fs, e, es, mul fs es : rs)
                  | otherwise = Left s
          return ret
    -- putStrLn $ "start from:" ++ show start
    (_, _, _, _, _, results) <- either id id <$> foldM extend (Right start) [2..n-1]
    let results' = reverse $ replicate (n - length results) 0 ++ results
        results'' = (e0:) $ zipWith (-) results' $ tail results' ++ [0]
    return $ foldl' (\s x -> s `mappend` word64Dec x `mappend` charUtf8 ' ') mempty results'' `mappend` charUtf8 '\n'
  hPutBuilder stdout output

import Control.Monad
import Data.Maybe
import qualified Data.Array as A
import Data.Word
import Data.List
import qualified Data.ByteString.Char8 as C
import qualified Data.IntSet as IS
import Data.Array.Base
import Data.Array.IO
import Data.ByteString.Builder
import System.IO

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

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

type State = (IS.IntSet, Int, Int, Int, Int, [Word64])

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    adjs <- A.accumArray (flip (:)) [] (0, n - 1) . concatMap (\[u, v] -> [(u, v), (v, u)]) <$> replicateM (n - 1) getInts
    sizes <- newArray_ (0, n) :: IO (IOUArray Int Int)
    parents <- newArray_ (0, n) :: IO (IOUArray Int Int)
    let dfs :: Int -> Int -> IO Int
        dfs fa u = do
          size <- foldM (\sz v -> unsafeWrite parents v u >> dfs u v >>= \sz' -> return (sz + sz')) 1 $ filter (/= fa) $ adjs ! u
          unsafeWrite sizes u size
          return size
    _ <- dfs 0 0
    let comb sz = let x = fromIntegral sz in x * (x - 1) `div` 2
    e0 <- foldM (\total v -> unsafeRead sizes v >>= \sz -> return (total + comb sz)) (0 :: Word64) $ adjs ! 0
    let ge1 = comb n - e0
        findPath :: IS.IntSet -> Int -> IO [Int]
        findPath st u = do
          fa <- unsafeRead parents u
          if IS.member fa st then return [u, fa] else do
            path' <- findPath st fa
            return $ u : path'
        mul x y = fromIntegral x * fromIntegral y
    path0 <- init <$> findPath (IS.singleton 0) 1
    size0 <- unsafeRead sizes (last path0)
    size1 <- unsafeRead sizes 1
    let start = (IS.fromList (0 : path0), 0, n - size0, 1, size1, [mul (n - size0) size1, ge1])
        extend :: Either State State -> Int -> IO (Either State State)
        extend (Left s) _ = return $ Left s
        extend (Right s@(st, f, fs, e, es, rs)) u = do
          path <- findPath st u
          -- putStrLn $ "   " ++ show u ++ " -> " ++ show path
          let st' = foldl' (flip IS.insert) st path
              top = last path
          size' <- unsafeRead sizes u
          let ret | top == f = Right (st', u, size', e, es, mul size' es : rs)
                  | top == e = Right (st', f, fs, u, size', mul fs size' : rs)
                  | otherwise = Left s
          return ret
    -- putStrLn $ "start from:" ++ show start
    (_, _, _, _, _, results) <- either id id <$> foldM extend (Right start) [2..n-1]
    let results' = reverse $ replicate (n - length results) 0 ++ results
        results'' = (e0:) $ zipWith (-) results' $ tail results' ++ [0]
    return $ foldl' (\s x -> s `mappend` word64Dec x `mappend` charUtf8 ' ') mempty results'' `mappend` charUtf8 '\n'
  hPutBuilder stdout output


On a random day, Neko found $$$n$$$ treasure chests and $$$m$$$ keys. The $$$i$$$-th chest has an integer $$$a_i$$$ written on it and the $$$j$$$-th key has an integer $$$b_j$$$ on it. Neko knows those chests contain the powerful mysterious green Grapes, thus Neko wants to open as many treasure chests as possible.The $$$j$$$-th key can be used to unlock the $$$i$$$-th chest if and only if the sum of the key number and the chest number is an odd number. Formally, $$$a_i + b_j \equiv 1 \pmod{2}$$$. One key can be used to open at most one chest, and one chest can be opened at most once.Find the maximum number of chests Neko can open.

The first line contains integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 10^5$$$) — the number of chests and the number of keys. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the numbers written on the treasure chests. The third line contains $$$m$$$ integers $$$b_1, b_2, \ldots, b_m$$$ ($$$1 \leq b_i \leq 10^9$$$) — the numbers written on the keys.

Print the maximum number of chests you can open.

NoteIn the first example, one possible way to unlock $$$3$$$ chests is as follows:  Use first key to unlock the fifth chest,  Use third key to unlock the second chest,  Use fourth key to unlock the first chest. In the second example, you can use the only key to unlock any single chest (note that one key can't be used twice).In the third example, no key can unlock the given chest.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	[ n, m ] <- readInts
	as <- readInts
	bs <- readInts
	let
		count_odd = length . filter ( ( == 1 ) . ( `mod` 2 ) )
		a_odd = count_odd as
		a_even = n - a_odd
		b_odd = count_odd bs
		b_even = m - b_odd
	print $ min a_odd b_even + min a_even b_odd

analyze a b = let
    ao = length (filter odd a)
    ae = length (filter even a)
    bo = length (filter odd b)
    be = length (filter even b)
  in (min ao be) + (min ae bo)
main = do
  getLine
  linea <- getLine
  lineb <- getLine
  putStrLn $ show $ analyze (map read (words linea)) (map read (words lineb))

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

solve [[x,y],xs,ys] = min ox (y - oy) + min oy (x - ox)
    where countOdd = length . filter odd
          (ox,oy) = (countOdd xs, countOdd ys)

import Data.List
main = do
  getLine
  (eas,oas) <- partition even . map read . words <$> getLine
  (ebs,obs) <- partition even . map read . words <$> getLine
  print $ min (length eas) (length obs) + min (length oas) (length ebs)

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

main = do
		[cl,kl]<- map read <$> words <$> getLine::IO [Int]
		c<- map read <$> words <$> getLine ::IO [Int]
		k<- map read <$> words <$> getLine ::IO [Int]
		let co = length $ filter odd c
		let ko = length $ filter odd k
		let ce = cl-co
		let ke = kl-ko
		print $ (min co ke) + (min ko ce)

import Data.List (partition)

process :: [Int] -> [Int] -> Int
process as bs = min (length ae) (length bo) + min (length ao) (length be)
    where
        (ao,ae) = partition odd as
        (bo,be) = partition odd bs

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n, m] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    bs <- fmap (map readInt.words) getLine
    print $ process as bs