Polycarp found a rectangular table consisting of $$$n$$$ rows and $$$m$$$ columns. He noticed that each cell of the table has its number, obtained by the following algorithm "by columns":   cells are numbered starting from one;  cells are numbered from left to right by columns, and inside each column from top to bottom;  number of each cell is an integer one greater than in the previous cell. For example, if $$$n = 3$$$ and $$$m = 5$$$, the table will be numbered as follows:$$$$$$ \begin{matrix} 1 & 4 & 7 & 10 & 13 \\ 2 & 5 & 8 & 11 & 14 \\ 3 & 6 & 9 & 12 & 15 \\ \end{matrix} $$$$$$However, Polycarp considers such numbering inconvenient. He likes the numbering "by rows":   cells are numbered starting from one;  cells are numbered from top to bottom by rows, and inside each row from left to right;  number of each cell is an integer one greater than the number of the previous cell. For example, if $$$n = 3$$$ and $$$m = 5$$$, then Polycarp likes the following table numbering: $$$$$$ \begin{matrix} 1 & 2 & 3 & 4 & 5 \\ 6 & 7 & 8 & 9 & 10 \\ 11 & 12 & 13 & 14 & 15 \\ \end{matrix} $$$$$$Polycarp doesn't have much time, so he asks you to find out what would be the cell number in the numbering "by rows", if in the numbering "by columns" the cell has the number $$$x$$$?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. Each test case consists of a single line containing three integers $$$n$$$, $$$m$$$, $$$x$$$ ($$$1 \le n, m \le 10^6$$$, $$$1 \le x \le n \cdot m$$$), where $$$n$$$ and $$$m$$$ are the number of rows and columns in the table, and $$$x$$$ is the cell number. Note that the numbers in some test cases do not fit into the $$$32$$$-bit integer type, so you must use at least the $$$64$$$-bit integer type of your programming language.

For each test case, output the cell number in the numbering "by rows".

{-# LANGUAGE BlockArguments #-}

module Main where
import Control.Monad

main :: IO()
main =
  readLn >>= flip replicateM_ do
    [n, m, x] <- fmap read.words <$> getLine
    let prev = x - 1
    let (col, row) = quotRem prev n
     in print $ row * m + col + 1

module Main where

solve :: [Integer] -> IO Integer
solve (n : m : x : _) = return $ row * m + col + 1
  where
    prev = x - 1
    col = prev `div` n
    row = prev `mod` n

output :: [IO Integer] -> IO ()
output collection = do
  out <- head collection
  print out
  if not (null $ tail collection)
    then output $ tail collection
    else pure()

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  let ans = replicate t ((map read . words <$> getLine :: IO [Integer]) >>= solve)
    in output ans

module Main where

readArguments :: IO [Integer]
readArguments = do
  line <- getLine
  let array = map read (words line) :: [Integer]
    in return array

solve :: IO [Integer] -> IO Integer
solve arr = do
  params <- arr
  let (n : m : x : _) = params
  let prev = x - 1
  let col = prev `div` n
  let row = prev `mod` n
    in return $ row * m + col + 1

output :: [IO Integer] -> IO ()
output collection = do
  out <- head collection
  print out
  if not (null $ tail collection)
    then output $ tail collection
    else pure()

main :: IO ()
main = do
  t <- getLine
  let count = read t :: Int
  let solves = replicate count (solve readArguments)
   in output solves

{-# LANGUAGE TypeApplications #-}

import Control.Monad
main :: IO ()
main = do
    cases <- (read @Int) <$> getLine
    replicateM_ cases solve

solve :: IO ()
solve = do
    [r, c, x] <- map (read @Integer) . words <$> getLine
    let which_row = ((x - 1) `mod` r) + 1
        which_col = (x - 1) `div` r + 1
    print $ (which_row - 1) * c + which_col

{-# LANGUAGE BlockArguments #-}

import Control.Monad

main :: IO ()
main = readLn >>= flip replicateM_ do
  [n, m, a] <- fmap read . words <$> getLine
  let
    (x, y) = quotRem (a - 1) n
  print $ y * m + x + 1

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe)

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

testCase :: Scanner String
testCase = show . solve <$> three integer

type I64 = Integer

solve :: [I64] -> I64
solve [n, m, x] = let (c, r) = (x - 1) `divMod` n in 1 + r * m + c

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

import Control.Monad

searchByRows target m = ((div (target - 1) m) + 1, (mod (target - 1) m) + 1)

buildByColumn n (x, y) = (+ x) $ (y - 1) * n

solve n m target = buildByColumn m $ searchByRows target n

main = do
  n <- read <$> getLine
  replicateM_ n $ do
    [n, m, target] <- map read . words <$> getLine
    print $ solve n m target

import qualified Data.Map as M
import Data.Map((!))

import qualified Data.Set as S
import qualified Data.List as L
import Data.Bits((.&.), (.|.), xor)

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		[n, m, x] <- getLine >>= return . (fmap read) . words
		print $ 1 + (mod (x-1) n) * m + (div (x-1) n)
		loop $ t - 1
	loop t

module Main where

readArguments :: IO [Int]
readArguments = do
  line <- getLine
  let array = map read (words line) :: [Int]
    in return array

solve :: IO [Int] -> IO Int
solve arr = do
  params <- arr
  let (n : m : x : _) = params
  let prev = x - 1
  let col = prev `div` n
  let row = prev `mod` n
    in return $ row * m + col + 1

output :: [IO Int] -> IO ()
output collection = do
  out <- head collection
  print out
  if not (null $ tail collection)
    then output $ tail collection
    else pure()

main :: IO ()
main = do
  t <- getLine
  let count = read t :: Int
  let solves = replicate count (solve readArguments)
   in output solves

{-# LANGUAGE TypeApplications #-}

import Control.Monad
main :: IO ()
main = do
    cases <- (read @Int) <$> getLine
    replicateM_ cases solve

solve :: IO ()
solve = do
    [r, c, x] <- map (read @Int) . words <$> getLine
    let which_row = ((x - 1) `mod` r) + 1
        which_col = (x - 1) `div` r + 1
    print $ (which_row - 1) * c + which_col

{-# LANGUAGE TypeApplications #-}

import Control.Monad
main :: IO ()
main = do
    cases <- (read @Int) <$> getLine
    replicateM_ cases solve

solve :: IO ()
solve = do
    [r, c, x] <- map (read @Int) . words <$> getLine
    let which_row = (x - 1) `mod` c
        which_col = (x - 1) `div` r
    print $ which_row * r + which_col + 1


You are given a string $$$s$$$ consisting of lowercase Latin letters and $$$q$$$ queries for this string.Recall that the substring $$$s[l; r]$$$ of the string $$$s$$$ is the string $$$s_l s_{l + 1} \dots s_r$$$. For example, the substrings of "codeforces" are "code", "force", "f", "for", but not "coder" and "top".There are two types of queries:   $$$1~ pos~ c$$$ ($$$1 \le pos \le |s|$$$, $$$c$$$ is lowercase Latin letter): replace $$$s_{pos}$$$ with $$$c$$$ (set $$$s_{pos} := c$$$);  $$$2~ l~ r$$$ ($$$1 \le l \le r \le |s|$$$): calculate the number of distinct characters in the substring $$$s[l; r]$$$.

The first line of the input contains one string $$$s$$$ consisting of no more than $$$10^5$$$ lowercase Latin letters. The second line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. The next $$$q$$$ lines contain queries, one per line. Each query is given in the format described in the problem statement. It is guaranteed that there is at least one query of the second type.

For each query of the second type print the answer for it — the number of distinct characters in the required substring in this query.

{-# LANGUAGE LambdaCase,MultiWayIf #-}
import Data.Bits
import Control.Monad
import Control.Arrow
import Data.Maybe
main = do
  s <- getLine
  let (t,h) = buildTree s
  q <- readLn
  qs <- replicateM q (words <$> getLine)
  foldM_ (op (h `div` 2)) t qs

buildTree s = construct (map (Tip . readC) s) 1

construct :: [Tree] -> Int -> (Tree,Int)
construct [t] h = (t,h)
construct ts h = construct (map (uncurry bin) ps ++ (maybeToList (uni <$> p))) (2*h) where
  (ps,p)= pairs ts
  pairs (a:b:xs) = first ((a,b) :) (pairs xs)
  pairs [c] = ([],Just c)
  pairs [] = ([],Nothing)

data Tree = Tip !Int | Bin !Int Tree Tree | Uni !Int Tree
          deriving Show
bin l r = Bin (value l .|. value r) l r
uni m = Uni (value m) m
value (Tip v) = v
value (Bin v _ _) = v
value (Uni v _) = v

op :: Int -> Tree -> [String] -> IO Tree
op h t ["1",pos,c] = return (update h (read pos) (readC (head c)) t)
op h t ["2",l,r] = print (popCount (query h (read l) (read r) t)) *> pure t

readC c = bit (fromEnum c - fromEnum 'a')

update h pos v = \case Tip _ -> Tip v
                       Bin _ l r ->
                         let (l',r') | pos <= h = (update h' pos v l,r)
                                     | otherwise = (l,update h' (pos - h) v r)
                         in Bin (value l' .|. value r') l' r'
                       Uni _ m -> let m' = update h' pos v m
                                  in Uni (value m') m'
  where h' = h `div` 2

query :: Int -> Int -> Int -> Tree -> Int
query h a b = \case Tip v -> if a == 1 && b == 1 && h == 0 then v else error "WTF"
                    Uni v m -> if a == 1 && b == h then v else query h' a b m
                    Bin v l r -> if | a == 1 && b == 2*h -> v
                                    | b <= h -> query h' a b l
                                    | a > h -> query h' (a-h) (b-h) r
                                    | otherwise -> query h' a h l .|.
                                                   query h' 1 (b-h) r
  where h' = h `div` 2

{-# LANGUAGE LambdaCase #-}
import Data.Bits
import Control.Monad
import Control.Arrow
import Data.Maybe
main = do
  s <- getLine
  let (t,h) = buildTree s
  q <- readLn
  qs <- replicateM q (words <$> getLine)
  foldM_ (op (h `div` 2)) t qs

buildTree s = construct (map (Tip . readC) s) 1

construct :: [Tree] -> Int -> (Tree,Int)
construct [t] h = (t,h)
construct ts h = construct (map (uncurry bin) ps ++ (maybeToList (uni <$> p))) (2*h) where
  (ps,p)= pairs ts
  pairs (a:b:xs) = first ((a,b) :) (pairs xs)
  pairs [c] = ([],Just c)
  pairs [] = ([],Nothing)

data Tree = Tip !Int | Bin !Int Tree Tree | Uni !Int Tree
          deriving Show
bin l r = Bin (value l .|. value r) l r
uni m = Uni (value m) m
value (Tip v) = v
value (Bin v _ _) = v
value (Uni v _) = v

op :: Int -> Tree -> [String] -> IO Tree
op h t ["1",pos,c] = return (update h (read pos) (readC (head c)) t)
op h t ["2",l,r] = print (popCount (query h (read l) (read r) t)) *> pure t

readC c = bit (fromEnum c - fromEnum 'a')

update h pos v = \case Tip _ -> Tip v
                       Bin _ l r ->
                         let (l',r') | pos <= h = (update h' pos v l,r)
                                     | otherwise = (l,update h' (pos - h) v r)
                             h' = h `div` 2
                         in Bin (value l' .|. value r') l' r'
                       Uni _ m -> let m' = update h pos v m
                                  in Uni (value m') m'
query :: Int -> Int -> Int -> Tree -> Int
query h a b = \case Tip v -> if a == 1 && b == 1 && h == 0 then v else error "WTF"
                    Uni v m -> if a == 1 && b == h then v else query h' a b m
                    Bin v l r -> if a == 1 && b == 2*h then v
                                 else if b <= h then query h' a b l
                                      else if a > h then query h' (a-h) (b-h) r
                                           else query h' a h l .|.
                                                query h' 1 (b-h) r
  where h' = h `div` 2


Theofanis has a string $$$s_1 s_2 \dots s_n$$$ and a character $$$c$$$. He wants to make all characters of the string equal to $$$c$$$ using the minimum number of operations.In one operation he can choose a number $$$x$$$ ($$$1 \le x \le n$$$) and for every position $$$i$$$, where $$$i$$$ is not divisible by $$$x$$$, replace $$$s_i$$$ with $$$c$$$. Find the minimum number of operations required to make all the characters equal to $$$c$$$ and the $$$x$$$-s that he should use in his operations.

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 the integer $$$n$$$ ($$$3 \le n \le 3 \cdot 10^5$$$) and a lowercase Latin letter $$$c$$$ — the length of the string $$$s$$$ and the character the resulting string should consist of. The second line of each test case contains a string $$$s$$$ of lowercase Latin letters — the initial string. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case, firstly print one integer $$$m$$$ — the minimum number of operations required to make all the characters equal to $$$c$$$. Next, print $$$m$$$ integers $$$x_1, x_2, \dots, x_m$$$ ($$$1 \le x_j \le n$$$) — the $$$x$$$-s that should be used in the order they are given. It can be proved that under given constraints, an answer always exists. If there are multiple answers, print any.

NoteLet's describe what happens in the third test case:   $$$x_1 = 2$$$: we choose all positions that are not divisible by $$$2$$$ and replace them, i. e. bzyx $$$\rightarrow$$$ bzbx;  $$$x_2 = 3$$$: we choose all positions that are not divisible by $$$3$$$ and replace them, i. e. bzbx $$$\rightarrow$$$ bbbb.

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

calc1 :: Maybe Int -> Int -> [Int]
calc1 (Just i) _ = [i]
calc1 Nothing l = [l,l-1]

calc :: Int->Char->String->[Int]
calc n c s =
  if all (\x -> x==c) s then []
  else
    let l = length s
        indices = S.fromList $ map (\(x,i) -> i) $ filter (\(x,i) -> x==c) $ zip s [1..]
        flag = find (\i ->
                      all (\j -> S.member j indices) [i,i+i..l]
               ) [1..l]
    in
      calc1 flag l

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b] = words line
    let (n,c) = ((read a),head b)
    line <- getLine
    let ans = calc n c line
    if (length ans) == 0 then do
      print 0
    else do
      print $ length ans
      putStrLn $ intercalate " " $ map show ans

import Control.Monad
import Data.List

calc1 :: [(Char,Int)]->Int-> [Int]
calc1 [] _ = []
calc1 [(ch,i)] l | i==(l-1) = [i-1]
                 | otherwise = [i+1]
calc1 ((ch1,i):(ch2,j):_) _ = [j,i]

calc :: Int->Char->String->[Int]
calc n c s =
  if all (\x -> x==c) s then []
  else
    let l = length s
        s1 = filter (\(x,i) -> x/=c) $ reverse $ zip s [1..]
    in
      calc1 s1 l

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b] = words line
    let (n,c) = ((read a),head b)
    line <- getLine
    let ans = calc n c line
    if (length ans) == 0 then do
      print 0
    else do
      print $ length ans
      putStrLn $ intercalate " " $ map show ans


You are given three integers $$$a$$$, $$$b$$$, and $$$c$$$. Determine if one of them is the sum of the other two.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 9261$$$) — the number of test cases. The description of each test case consists of three integers $$$a$$$, $$$b$$$, $$$c$$$ ($$$0 \leq a, b, c \leq 20$$$).

For each test case, output "YES" if one of the numbers is the sum of the other two, and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

NoteIn the first test case, $$$1 + 3 = 4$$$.In the second test case, none of the numbers is the sum of the other two.In the third test case, $$$9 + 11 = 20$$$.

solve :: [Int] -> String
solve xs = if 2 * maximum xs == sum xs then "Yes" else "No"

testCase = do
    numList <- words `fmap` getLine
    let nums = read `map` numList :: [Int]
    putStrLn $ solve nums
    return 0

repeatN 0 m = return []

repeatN n m = do
    x1 <- m
    x2 <- repeatN (n - 1) m
    return []

main = do
    n <- read `fmap` getLine :: IO Int
    repeatN n testCase

import Control.Monad (forM_)

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

main = do
  n <- readLn :: IO Int
  forM_
    [1 .. n]
    ( \_ -> do
        [x, y, z] <- readInts
        putStrLn $
          if x + y == z || y + z == x || x + z == y
            then "YES"
            else "NO"
    )


Recently, Dima met with Sasha in a philatelic store, and since then they are collecting coins together. Their favorite occupation is to sort collections of coins. Sasha likes having things in order, that is why he wants his coins to be arranged in a row in such a way that firstly come coins out of circulation, and then come coins still in circulation. For arranging coins Dima uses the following algorithm. One step of his algorithm looks like the following:  He looks through all the coins from left to right;  If he sees that the i-th coin is still in circulation, and (i + 1)-th coin is already out of circulation, he exchanges these two coins and continues watching coins from (i + 1)-th.  Dima repeats the procedure above until it happens that no two coins were exchanged during this procedure. Dima calls hardness of ordering the number of steps required for him according to the algorithm above to sort the sequence, e.g. the number of times he looks through the coins from the very beginning. For example, for the ordered sequence hardness of ordering equals one.Today Sasha invited Dima and proposed him a game. First he puts n coins in a row, all of them are out of circulation. Then Sasha chooses one of the coins out of circulation and replaces it with a coin in circulation for n times. During this process Sasha constantly asks Dima what is the hardness of ordering of the sequence. The task is more complicated because Dima should not touch the coins and he should determine hardness of ordering in his mind. Help Dima with this task.

The first line contains single integer n (1 ≤ n ≤ 300 000) — number of coins that Sasha puts behind Dima. Second line contains n distinct integers p1, p2, ..., pn (1 ≤ pi ≤ n) — positions that Sasha puts coins in circulation to. At first Sasha replaces coin located at position p1, then coin located at position p2 and so on. Coins are numbered from left to right.

Print n + 1 numbers a0, a1, ..., an, where a0 is a hardness of ordering at the beginning, a1 is a hardness of ordering after the first replacement and so on.

NoteLet's denote as O coin out of circulation, and as X — coin is circulation.At the first sample, initially in row there are coins that are not in circulation, so Dima will look through them from left to right and won't make any exchanges.After replacement of the first coin with a coin in circulation, Dima will exchange this coin with next three times and after that he will finally look through the coins and finish the process.XOOO  →  OOOXAfter replacement of the third coin, Dima's actions look this way:XOXO  →  OXOX  →  OOXXAfter replacement of the fourth coin, Dima's actions look this way:XOXX  →  OXXXFinally, after replacement of the second coin, row becomes consisting of coins that are in circulation and Dima will look through coins from left to right without any exchanges.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.IntSet as S

main = B.interact (B.pack . evalState app . B.words)

app = do
  n <- poi
  (unwords . map  show) `fmap` solve n `fmap` replicateM n poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n xs = map fst $ scanl (\(_, s) (i, x) -> let s' = S.delete x s in (if S.null s' then 1 else i - (n - S.findMax s') + 1, s')) (1, S.fromAscList [1..n]) $ zip [1..] xs


Amr lives in Lala Land. Lala Land is a very beautiful country that is located on a coordinate line. Lala Land is famous with its apple trees growing everywhere.Lala Land has exactly n apple trees. Tree number i is located in a position xi and has ai apples growing on it. Amr wants to collect apples from the apple trees. Amr currently stands in x = 0 position. At the beginning, he can choose whether to go right or left. He'll continue in his direction until he meets an apple tree he didn't visit before. He'll take all of its apples and then reverse his direction, continue walking in this direction until he meets another apple tree he didn't visit before and so on. In the other words, Amr reverses his direction when visiting each new apple tree. Amr will stop collecting apples when there are no more trees he didn't visit in the direction he is facing.What is the maximum number of apples he can collect?

The first line contains one number n (1 ≤ n ≤ 100), the number of apple trees in Lala Land. The following n lines contains two integers each xi, ai ( - 105 ≤ xi ≤ 105, xi ≠ 0, 1 ≤ ai ≤ 105), representing the position of the i-th tree and number of apples on it. It's guaranteed that there is at most one apple tree at each coordinate. It's guaranteed that no tree grows in point 0.

Output the maximum number of apples Amr can collect.

NoteIn the first sample test it doesn't matter if Amr chose at first to go left or right. In both cases he'll get all the apples.In the second sample test the optimal solution is to go left to x =  - 1, collect apples from there, then the direction will be reversed, Amr has to go to x = 1, collect apples from there, then the direction will be reversed and Amr goes to the final tree x =  - 2.In the third sample test the optimal solution is to go right to x = 1, collect apples from there, then the direction will be reversed and Amr will not be able to collect anymore apples because there are no apple trees to his left.

import Data.List
answer::[(Int,Int)]->Int
answer a = (sumData (getLen lsx0 lsx1) sx0) + (sumData (getLen lsx1 lsx0) sx1)
  where (x0,x1) = partition (\x -> (fst x) < 0) a
        sx0 = sortData (map (\x-> (negate (fst x),snd x)) x0)
        sx1 = sortData x1
        lsx0 = length sx0
        lsx1 = length sx1
getLen::Int -> Int -> Int
getLen l0 l1 | l0 == l1 = l0
             | l0  < l1 = l0
             | otherwise = l1+1
sumData::Int -> [(Int,Int)] -> Int
sumData 0 a = 0
sumData n a = (snd (head a)) + (sumData (n-1) (tail a))
sortData::[(Int,Int)]->[(Int,Int)]
sortData a = sortBy (\x y -> compare (fst x) (fst y)) a
readInput::Int -> IO [(Int,Int)]
readInput 0 = return []
readInput n = do
  winput <- getLine
  let w = words winput
  let x0 = read (w !! 0)::Int
  let x1 = read (w !! 1)::Int
  next <- readInput (n-1)
  return ([(x0,x1)] ++ next)
main = do
  w <- getLine
  let n = read w::Int
  a <- readInput n
  print $ answer a

{-# LANGUAGE TypeApplications #-}

import Control.Monad (replicateM)
import Data.List (partition, sortOn)

main :: IO ()
main = do
  n <- read @ Int <$> getLine
  apples <- replicateM n $ (\[x, y] -> (x, y)) . fmap (read @ Int) . words <$> getLine
  print $ solve n apples

solve :: Int -> [(Int, Int)] -> Int
solve n apples = maximum [goLeftCount, goRightCount]
  where
    (leftApples, rightApples) = partition ((< 0) . fst) . sortOn fst $ apples
    leftCount  = length leftApples
    rightCount = length rightApples

    minSide = minimum [leftCount, rightCount]

    goLeftCount  = gatherApples $ take (minSide + 1) (reverse leftApples) ++ take minSide rightApples
    goRightCount = gatherApples $ take minSide (reverse leftApples) ++ take (minSide + 1) rightApples

gatherApples :: [(Int, Int)] -> Int
gatherApples = sum . fmap snd

import Data.List (sort, sortBy)

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

solve :: [(Int, Int)] -> Int
solve xas = sum $ zipWith (\(_, x) (_, y) -> x + y) (sort (filter ((>0) . fst) xas) ++ [(0, 0)]) (sortBy (flip compare) (filter ((<0) . fst) xas) ++ [(0, 0)])

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

import Data.List
import Data.Function

main = do
    n <- fmap read getLine
    trees <- mapM (\_ -> fmap ((\[a,b]->(a,b)) . map read . words) getLine) [1..n]
    print $ solve trees

solve :: [(Int, Int)] -> Int
solve trees | l1 == l2 = sum . map snd $ trees
            | l1 < l2 = sum (map snd neg) + sum (map snd (take (l1+1) pos))
            | l1 > l2 = sum (map snd pos) + sum (map snd (take (l2+1) (reverse neg)))
    where sorted = sortBy (compare `on` fst) trees
          (neg, pos) = span (\(a,_) -> a < 0) sorted
          l1 = length neg
          l2 = length pos

import Data.List

furry (a:_:c) = a:furry c
furry (h:_) = [h]
furry _ = []

fuck :: [Int] -> String
fuck (n:s) = let
    li = take (n*2) s
    lu = zip (furry li) $ furry $ tail li
    ze = (0,0)
    in show $ sum $ zipWith (\(_,x) (_,y) -> x + y)
        ((sort [x | x <- lu, x > ze]) ++ [ze])
        ((reverse $ sort [x | x <- lu, x < ze]) ++ [ze])

main = getContents >>= putStrLn . fuck . map read . words

import Data.List

main :: IO ()

furry :: [Int] -> [Int]
furry (a:b:c) = a:furry c
furry (h:t) = [h]
furry [] = []

fuck :: [Int] -> String
fuck (n:s) = let
    li = take (n*2) s
    lu = zip (furry li) $ furry $ tail li
    in show $ sum $ zipWith (\x y -> (snd x) + (snd y))
        ((sort [x | x <- lu, x > (0,0)]) ++ [(0,0)])
        ((reverse $ sort [x | x <- lu, x < (0,0)]) ++ [(0,0)])

main = getContents >>= putStrLn . fuck . map (read::String->Int) . words

import Control.Applicative
import Data.List
import Data.Char

process u1 u2 n | abs(length u1 -length u2)<=1 = (length u1, length u2)
                | length u1> length u2 = (length u2+1, length u2)
                | otherwise = (length u1, length  u1+1)

main= do
	n<- read <$>getLine  :: IO Int
	s<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	let t= sort $ map (\z->(head z,last z)) s
	let u1 =   filter (\z-> fst z>0) t
	let u2 = reverse $ filter (\z->fst z <0) t
	let (v1,v2)=process u1 u2 n
	let w1 = sum $ map snd $ take v1 u1
	let w2= sum $ map snd $ take v2 u2
	print $ w1+w2

import Data.List
import Control.Monad

process :: [[Int]] -> Int
process aps =
  let
    sorted = sort aps
    pos = (map (head . tail) $ filter (\[x,y] -> x > 0) sorted) ++ [0]
    neg = (map (head . tail) . reverse $ filter (\[x,y] -> x < 0) sorted) ++ [0]
  in sum $ zipWith (+) pos neg

main = do
  n <- readLn
  aps <- liftM (map (map read . words) . take n . lines) getContents
  putStrLn . show $ process aps

import Control.Applicative
import Data.List
import Data.Char

process n u | n==u*2 = (0,n)
            | n>u*2 = (n-u-u-1,n)
	    | otherwise = (0, u+u+1)

main= do
	n<- read <$>getLine  :: IO Int
	s<- map (map read). map words. lines <$> getContents ::IO [[Int]]
	let t= sort $ map (\z->(head z,last z)) s
	let u = length $ filter (\z-> fst z>0) t
	let (v1,v2)=process n u
	print $ sum $ map snd $ take v2  $ drop v1 t

import Control.Monad

process :: [[Int]] -> Int
process aps =
  let
    pos = (map (head . tail) $ filter (\[x,y] -> x > 0) aps) ++ [0]
    neg = (map (head . tail) $ filter (\[x,y] -> x < 0) aps) ++ [0]
  in sum $ zipWith (+) pos neg

main = do
  n <- readLn
  aps <- liftM (map (map read . words) . take n . lines) getContents
  putStrLn . show $ process aps


In a far away galaxy there are n inhabited planets, numbered with numbers from 1 to n. They are located at large distances from each other, that's why the communication between them was very difficult until on the planet number 1 a hyperdrive was invented. As soon as this significant event took place, n - 1 spaceships were built on the planet number 1, and those ships were sent to other planets to inform about the revolutionary invention. Paradoxical thought it may be, but the hyperspace is represented as simple three-dimensional Euclidean space. The inhabited planets may be considered fixed points in it, and no two points coincide and no three points lie on the same straight line. The movement of a ship with a hyperdrive between two planets is performed along a straight line at the constant speed, the same for all the ships. That's why the distance in the hyperspace are measured in hyperyears (a ship with a hyperdrive covers a distance of s hyperyears in s years).When the ship reaches an inhabited planet, the inhabitants of the planet dissemble it, make n - 2 identical to it ships with a hyperdrive and send them to other n - 2 planets (except for the one from which the ship arrived). The time to make a new ship compared to the time in which they move from one planet to another is so small that it can be disregarded. New ships are absolutely identical to the ones sent initially: they move at the same constant speed along a straight line trajectory and, having reached a planet, perform the very same mission, i.e. are dissembled to build new n - 2 ships and send them to all the planets except for the one from which the ship arrived. Thus, the process of spreading the important news around the galaxy continues.However the hyperdrive creators hurried to spread the news about their invention so much that they didn't study completely what goes on when two ships collide in the hyperspace. If two moving ships find themselves at one point, they provoke an explosion of colossal power, leading to the destruction of the galaxy!Your task is to find the time the galaxy will continue to exist from the moment of the ships' launch from the first planet.

The first line contains a number n (3 ≤ n ≤ 5000) — the number of inhabited planets in the galaxy. The next n lines contain integer coordinates of the planets in format "xi yi zi" ( - 104 ≤ xi, yi, zi ≤ 104).

Print the single number — the solution to the task with an absolute or relative error not exceeding 10 - 6.

module Main where

import Control.Monad
import Text.Read
import Data.List

data Pt = Pt { ptX, ptY, ptZ :: !Int } deriving Show

instance Read Pt where
    readPrec = do
        x <- readPrec :: ReadPrec Int
        y <- readPrec :: ReadPrec Int
        z <- readPrec :: ReadPrec Int
        return $ Pt x y z

main = do
    n <- read `liftM` getLine
    pos <- replicateM n $ read `liftM` getLine :: IO [Pt]

    --putStrLn $ show pos

    let o = head pos
        res = foldr (\p (res, ps) ->
                let po = distance p o
                    res' = foldl' (\res q ->
                            let pq = distance p q
                                qo = distance q o
                            in min ( po + pq + qo ) res
                        ) res ps
                in (res', p:ps)
            ) (1e30, []) $ tail pos

    putStrLn $ show ( fst res / 2 )

sqr x = x * x

distance :: Pt -> Pt -> Double
distance a b = sqrt $ fromIntegral $ sqr ( ptX a - ptX b ) + sqr ( ptY a - ptY b ) + sqr ( ptZ a - ptZ b )

import Array
import Data.List
main = interact solve
solve input = output where
  [n]:c:cs = map (map (read::String->Int)) $ map words $ lines input
  output = show $ answer ds / 2
  ds = [(x,dist c x)|x<-cs]
  dist x y = sqrt(
    read ( show $ sum $ map (^2) $ zipWith (-) x y ) ::Double)
  answer [x,y] = distSum x y
  answer (x:xs) = foldl' (min' x) (answer xs) xs
  min' (x,u) a (y,v) = if a<=u+v then a else min a $ distSum (x,u) (y,v)
  distSum (x,u) (y,v) = dist x y + u + v


You are given a string $$$s$$$ of lowercase Latin letters. The following operation can be used:   select one character (from 'a' to 'z') that occurs at least once in the string. And replace all such characters in the string with the previous one in alphabetical order on the loop. For example, replace all 'c' with 'b' or replace all 'a' with 'z'. And you are given the integer $$$k$$$ — the maximum number of operations that can be performed. Find the minimum lexicographically possible string that can be obtained by performing no more than $$$k$$$ operations.The string $$$a=a_1a_2 \dots a_n$$$ is lexicographically smaller than the string $$$b = b_1b_2 \dots b_n$$$ if there exists an index $$$k$$$ ($$$1 \le k \le n$$$) such that $$$a_1=b_1$$$, $$$a_2=b_2$$$, ..., $$$a_{k-1}=b_{k-1}$$$, but $$$a_k < b_k$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases in the test. This is followed by descriptions of the test cases. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le k \le 10^9$$$) — the size of the string $$$s$$$ and the maximum number of operations that can be performed on the string $$$s$$$. The second line of each test case contains a string $$$s$$$ of length $$$n$$$ consisting of lowercase Latin letters.  It is guaranteed that the sum $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output the lexicographically minimal string that can be obtained from the string $$$s$$$ by performing no more than $$$k$$$ operations.

4

3 2

cba

4 5

fgde

7 5

gndcafb

4 19

ekyv

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

readInt :: String -> Int
readInt = read

solve :: Int -> String -> String
solve k = impl k Set.empty
    where impl :: Int -> Set.Set Char -> String -> String
          impl _ _ "" = ""
          impl k set (h:t) | Set.member h set = impl k set (dec h : t)
                           | h /= 'a' && k > 0 = impl (k - 1) (Set.insert h set) (dec h : t)
                           | otherwise = h : impl k set t
          dec c = if c == 'a'
                  then c
                  else chr $ ord c - 1

testCaseMain :: IO ()
testCaseMain = do firstLine <- getLine
                  secondLine <- getLine
                  putStrLn $ solve (head . tail . map readInt . words $ firstLine) secondLine

main :: IO ()
main = do numTestCases <- (readLn :: IO Int)
          forM_ [1 .. numTestCases] (\_ -> testCaseMain)


You are given two positive integers $$$n$$$ and $$$s$$$. Find the maximum possible median of an array of $$$n$$$ non-negative integers (not necessarily distinct), such that the sum of its elements is equal to $$$s$$$.A median of an array of integers of length $$$m$$$ is the number standing on the $$$\lceil {\frac{m}{2}} \rceil$$$-th (rounding up) position in the non-decreasing ordering of its elements. Positions are numbered starting from $$$1$$$. For example, a median of the array $$$[20,40,20,50,50,30]$$$ is the $$$\lceil \frac{m}{2} \rceil$$$-th element of $$$[20,20,30,40,50,50]$$$, so it is $$$30$$$. There exist other definitions of the median, but in this problem we use the described definition.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Description of the test cases follows. Each test case contains a single line with two integers $$$n$$$ and $$$s$$$ ($$$1 \le n, s \le 10^9$$$) — the length of the array and the required sum of the elements.

For each test case print a single integer — the maximum possible median.

NotePossible arrays for the first three test cases (in each array the median is underlined):  In the first test case $$$[\underline{5}]$$$  In the second test case $$$[\underline{2}, 3]$$$  In the third test case $$$[1, \underline{2}, 2]$$$

import Control.Monad

solve :: IO ()
solve = do
    [n, s] <- readMany :: IO [Int]
    print $ s `div` (n `div` 2 + 1)

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

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

import Control.Arrow ((>>>))

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

solve :: [Int] -> Int
solve [n, s] = s `div` (n `div` 2 + 1)

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

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, s] <- getInts 2
    let
      nplaces = div (n + 2) 2
      score = div s nplaces
    pure $ putInts [score]

type SP = State [P.ByteString]
type SO = SP Builder

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

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

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

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


A lot of students spend their winter holidays productively. Vlad has advanced very well in doing so! For three days already, fueled by salads and tangerines — the leftovers from New Year celebration — he has been calibrating his rating in his favorite MOBA game, playing as a hero named Perun.Perun has an ultimate ability called "Thunderwrath". At the instant of its activation, each enemy on the map (n of them in total) loses  health points as a single-time effect. It also has a restriction: it can only activated when the moment of time is an integer. The initial bounty for killing an enemy is . Additionally, it increases by  each second. Formally, if at some second t the ability is activated and the i-th enemy is killed as a result (i.e. his health drops to zero or lower), Vlad earns  units of gold.Every enemy can receive damage, as well as be healed. There are multiple ways of doing so, but Vlad is not interested in details. For each of n enemies he knows:    — maximum number of health points for the i-th enemy;   — initial health of the enemy (on the 0-th second);   — the amount of health the i-th enemy can regenerate per second. There also m health updates Vlad knows about:    — time when the health was updated;   — the enemy whose health was updated;   — updated health points for enemyj. Obviously, Vlad wants to maximize his profit. If it's necessary, he could even wait for years to activate his ability at the right second. Help him determine the exact second (note that it must be an integer) from 0 (inclusively) to  + ∞ so that a single activation of the ability would yield Vlad the maximum possible amount of gold, and print this amount.

In the first line, two integers are given (separated by spaces) — n and m (1 ≤ n ≤ 105, 0 ≤ m ≤ 105). In the second line, there are three integers: ,  and  (, ). Each of the following n lines has three integers — , ,  (, ). The next m lines contain three integers each — , ,  (, , ). It is guaranteed that there is no more than one hearth change per second for each enemy: more formally, for each a, b so that 1 ≤ a, b ≤ m, a ≠ b holds that if , then .

Output the single integer — the maximum amount of gold Vlad can obtain if he applies "Thunderwrath" exactly once, or -1 if this amount can be infinitely large.

NoteOn the pictures you can see health points of each enemy versus time in sample cases.Periods when Vlad can kill one enemy are marked with yellow color.Periods when Vlad can kill two enemies are marked with purple color.  In the first sample case, Vlad can activate the ability at the 50-th second: the enemies 2 and 3 will die since they would have 40 and 50 health points correspondingly. Vlad will earn 2·(1000 + 50·10) = 3000 gold.  In the second sample case, the maximum amount of health for the enemy 1 is less than the damage dealt by the ability. Hence, the enemy could be killed anytime. As the bounty increases by 50 over the time, the maximum possible amount of gold is infinite.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Set as S
import qualified Data.IntMap as M
import Data.Array
import Data.Int

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  bounty <- p64
  increase <- p64
  damage <- poi
  es <- replicateM n $ liftM3 Enemy poi poi poi
  eus <- replicateM m $ liftM3 (\t i h -> (i, Updt t h)) poi poi poi
  return $ show $ solve n bounty increase damage es eus
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  p64 = fmap to64 poi
  int = maybe undefined fst . B.readInt

data Updt = Updt { ut :: !Int, uh :: !Int } deriving (Show, Eq, Ord)
data Enemy = Enemy { emax :: !Int, estart :: !Int, eregen :: !Int } deriving (Show, Eq, Ord)

hi = 2000000000 :: Int

solve n bounty increase damage es eus0
  | increase > 0 && any (\(e, us) -> emax e <= damage || eregen e == 0 && uh (last us) <= damage) (zip es eus) = -1
  | otherwise = fst $ M.foldlWithKey (\(!r, !a) t (e, l) -> (max r $ (to64 a + to64 e) * (bounty + increase * to64 t), a + e - l)) (0, 0 :: Int) delta
  where
  eus = map S.toAscList $ elems $ accumArray (flip S.insert) S.empty (1, n) $ map (\(i, e) -> (i, Updt 0 (estart e))) (zip [1..] es) ++ eus0
  delta = foldl (\(!delta) (e, us) -> foldl (\(!delta) (u, v) -> let dt = min (ut v - ut u - 1) (if eregen e == 0 then hi else (min damage (emax e) - uh u) `quot` eregen e) in M.insertWith pairAdd (ut u) (1 :: Int, 0 :: Int) $ M.insertWith pairAdd (ut u + dt) (0, 1) delta) delta $ filter ((<= damage) . uh . fst) $ zip us $ tail us ++ [Updt hi 0]) M.empty $ zip es eus

pairAdd (a, b) (c, d) = (a + c, b + d)
to64 x = fromIntegral x :: Int64

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.Set as S
import qualified Data.IntMap as M
import Data.Array
import Data.Int

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  bounty <- p64
  increase <- p64
  damage <- poi
  es <- replicateM n $ liftM3 Enemy poi poi poi
  eus <- replicateM m $ liftM3 (\t i h -> (i, Updt t h)) poi poi poi
  return $ show $ solve n bounty increase damage es eus
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  p64 = fmap to64 poi
  int = maybe undefined fst . B.readInt

data Updt = Updt { ut :: !Int, uh :: !Int } deriving (Show, Eq, Ord)
data Enemy = Enemy { emax :: !Int, estart :: !Int, eregen :: !Int } deriving (Show, Eq, Ord)

hi = 2000000000 :: Int

solve n bounty increase damage es eus0
  | increase > 0 && any (\(e, us) -> emax e <= damage || eregen e == 0 && uh (last us) <= damage) (zip es eus) = -1
  | otherwise = fst $ M.foldlWithKey (\(!r, !a) t (e, l) -> (max r $ (to64 a + to64 e) * (bounty + increase * to64 t), a + e - l)) (0, 0 :: Int) delta
  where
  eus = map S.toAscList $ elems $ accumArray (flip S.insert) S.empty (1, n) $ map (\(i, e) -> (i, Updt 0 (estart e))) (zip [1..] es) ++ eus0
  delta = foldl (\(!delta) (e, us) -> foldl (\(!delta) (u, v) -> let dt = min (ut v - ut u - 1) (if eregen e == 0 then hi else (min damage (emax e) - uh u) `quot` eregen e) in M.insertWith pairAdd (ut u) (1 :: Int, 0 :: Int) $ M.insertWith pairAdd (ut u + dt) (0, 1) delta) delta $ filter ((<= damage) . uh . fst) $ zip us $ tail us ++ [Updt hi 0]) M.empty $ zip es eus

pairAdd (a, b) (c, d) = (a + c, b + d)
to64 x = fromIntegral x :: Int64

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Strict
import qualified Data.Set as S
import qualified Data.IntMap as M
import Data.Array
import Data.Int

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  bounty <- p64
  increase <- p64
  damage <- poi
  es <- replicateM n $ liftM3 Enemy poi poi poi
  eus <- replicateM m $ liftM3 (\t i h -> (i, Updt t h)) poi poi poi
  return $ show $ solve n bounty increase damage es eus
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  p64 = fmap to64 poi
  int = maybe undefined fst . B.readInt

data Updt = Updt { ut :: !Int, uh :: !Int } deriving (Show, Eq, Ord)
data Enemy = Enemy { emax :: !Int, estart :: !Int, eregen :: !Int } deriving (Show, Eq, Ord)

hi = 2000000000 :: Int

solve n bounty increase damage es eus0
  | increase > 0 && any (\(e, us) -> emax e <= damage || eregen e == 0 && uh (last us) <= damage) (zip es eus) = -1
  | otherwise = fst $ M.foldlWithKey (\(!r, !a) t (e, l) -> (max r $ (to64 a + to64 e) * (bounty + increase * to64 t), a + e - l)) (0, 0 :: Int) delta
  where
  eus = map S.toAscList $ elems $ accumArray (flip S.insert) S.empty (1, n) $ map (\(i, e) -> (i, Updt 0 (estart e))) (zip [1..] es) ++ eus0
  delta = foldl (\(!delta) (e, us) -> foldl (\(!delta) (u, v) -> let dt = min (ut v - ut u - 1) (if eregen e == 0 then hi else (min damage (emax e) - uh u) `quot` eregen e) in M.insertWith pairAdd (ut u) (1 :: Int, 0 :: Int) $ M.insertWith pairAdd (ut u + dt) (0, 1) delta) delta $ filter ((<= damage) . uh . fst) $ zip us $ tail us ++ [Updt hi 0]) M.empty $ zip es eus

pairAdd (a, b) (c, d) = (a + c, b + d)
to64 x = fromIntegral x :: Int64


Of course our child likes walking in a zoo. The zoo has n areas, that are numbered from 1 to n. The i-th area contains ai animals in it. Also there are m roads in the zoo, and each road connects two distinct areas. Naturally the zoo is connected, so you can reach any area of the zoo from any other area using the roads.Our child is very smart. Imagine the child want to go from area p to area q. Firstly he considers all the simple routes from p to q. For each route the child writes down the number, that is equal to the minimum number of animals among the route areas. Let's denote the largest of the written numbers as f(p, q). Finally, the child chooses one of the routes for which he writes down the value f(p, q).After the child has visited the zoo, he thinks about the question: what is the average value of f(p, q) for all pairs p, q (p ≠ q)? Can you answer his question?

The first line contains two integers n and m (2 ≤ n ≤ 105; 0 ≤ m ≤ 105). The second line contains n integers: a1, a2, ..., an (0 ≤ ai ≤ 105). Then follow m lines, each line contains two integers xi and yi (1 ≤ xi, yi ≤ n; xi ≠ yi), denoting the road between areas xi and yi. All roads are bidirectional, each pair of areas is connected by at most one road.

Output a real number — the value of . The answer will be considered correct if its relative or absolute error doesn't exceed 10 - 4.

NoteConsider the first sample. There are 12 possible situations:  p = 1, q = 3, f(p, q) = 10.  p = 2, q = 3, f(p, q) = 20.  p = 4, q = 3, f(p, q) = 30.  p = 1, q = 2, f(p, q) = 10.  p = 2, q = 4, f(p, q) = 20.  p = 4, q = 1, f(p, q) = 10. Another 6 cases are symmetrical to the above. The average is .Consider the second sample. There are 6 possible situations:  p = 1, q = 2, f(p, q) = 10.  p = 2, q = 3, f(p, q) = 20.  p = 1, q = 3, f(p, q) = 10. Another 3 cases are symmetrical to the above. The average is .

{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad         hiding (forM, forM_, mapM_)
import           Data.Array.IO
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Int
import           Data.List             hiding (concat, concatMap, foldl',
                                        product, sum)
import           Data.Maybe
import qualified Data.Set              as S
import           Data.Traversable
import           Text.Printf           (printf)

import           Prelude               hiding (concat, concatMap, mapM_,
                                        product, sum)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

type UnionFind = IOArray Int (Int, Int)

newUF :: Int -> IO UnionFind
newUF n = newListArray (0, n-1) $ map (,1) [0..n-1]

root :: UnionFind -> Int -> IO (Int, Int)
root uf v = do
  (p, _) <- readArray uf v
  if p == v
    then readArray uf v
    else do
      (r, w) <- root uf p
      writeArray uf v (r, w)
      return (r, w)

unite :: UnionFind -> Int -> Int -> IO ()
unite uf v w = do
  (r, m) <- root uf v
  (s, n) <- root uf w
  writeArray uf r (s, m+n)
  writeArray uf s (s, m+n)

nubOrd :: Ord a => [a] -> [a]
nubOrd = S.toList . S.fromList

main :: IO ()
main = do
  [n, _m] <- getInts
  vs <- getInts
  ns' <- readInts <$> C.getContents

  let ccc [] = []
      ccc (x:y:z) = (x, y) : ccc z

      !es = ccc $ map pred ns'
      -- !g = M.fromListWith (++) [ (f, [t]) | (f, t) <- es ]

  g <- newArray (0, n-1) [] :: IO (IOArray Int [Int])
  for_ es $ \(f, t) -> do
    writeArray g f . (t:) =<< readArray g f
    writeArray g t . (f:) =<< readArray g t

  uf <- newUF n
  ss <- newArray (0, n-1) False :: IO (IOUArray Int Bool)

  let ws = sortBy (flip compare) $ zip vs [0..]

      f !acc (v, ix) = do
        us' <- readArray g ix
        us <- filterM (readArray ss) us'
        rs <- forM us $ \u ->
          root uf u

        forM_ us $ \u -> do
          (r1, _n1) <- root uf ix
          (r2, _n2) <- root uf u
          when (r1 /= r2) $ unite uf u ix

        let sums = tail $ scanr (+) 0 ns

            go [] _ !acc = acc
            go (x:xs) (y:ys) !acc = go xs ys (acc + x * y)

            !ns = map (fromIntegral . snd) $ nubOrd rs

        writeArray ss ix True
        return $! acc + v * (sum ns + go ns sums 0)

  ans <- foldM f (0 :: Double) $ map (first fromIntegral) ws

  printf "%.10f\n" (ans / fromIntegral n / fromIntegral (n-1) * 2 :: Double)

{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}

import           Control.Applicative
import           Control.Monad         hiding (forM, forM_, mapM_)
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Function
import           Data.Int
import           Data.List             hiding (concat, concatMap, foldl',
                                        product, sum)
import           Data.Maybe
import qualified Data.Set              as S
import           Text.Printf           (printf)

import           Prelude               hiding (concat, concatMap, mapM_,
                                        product, sum)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

-----

type UF = IOUArray Int Int

newUF :: Int -> IO UF
newUF n = newListArray (0, n-1) [0..n-1]

root :: UF -> Int -> IO Int
root uf v = do
  p <- readArray uf v
  if p == v
    then readArray uf v
    else do
      r <- root uf p
      writeArray uf v r
      return r

unite :: UF -> Int -> Int -> IO ()
unite uf v w = do
  r <- root uf v
  s <- root uf w
  writeArray uf r s

nubOrd :: Ord a => [a] -> [a]
nubOrd = S.toList . S.fromList

main :: IO ()
main = do
  [n, m] <- getInts
  vs :: UArray Int Int <- listArray (0, n-1) <$> getInts
  es <- replicateM m getInts

  uf <- newUF n
  sz :: IOUArray Int Int <- newArray (0, n) (1 :: Int)

  let f !acc [v, u] = do
        rv <- root uf v
        ru <- root uf u
        if rv == ru
          then return acc
          else do
          unite uf v u
          sv <- readArray sz rv
          su <- readArray sz ru
          rr <- root uf v
          writeArray sz rr $ su + sv
          return $ acc + fromIntegral (min (vs!v) (vs!u)) * fromIntegral su * fromIntegral sv

  ans <- foldM f (0 :: Double)
    $ sortBy (flip compare `on` \[v, u] -> min (vs!v) (vs!u))
    $ map (map pred) es

  printf "%.10f\n" (ans / fromIntegral n / fromIntegral (n-1) * 2 :: Double)

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns, TupleSections, FlexibleContexts, BangPatterns        #-}

import           Control.Applicative
import           Control.Monad         hiding (forM, forM_, mapM_)
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import qualified Data.IntMap.Strict    as M
import qualified Data.Set    as S
import           Data.List             hiding (concat, foldl', product, sum, concatMap)
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)
import Data.Int
import Control.Arrow

import           Prelude               hiding (concat, product, sum, mapM_, concatMap)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

-- type UF = IORef (M.HashMap Int (Int, Int))
type UF a = (IOUArray Int Int, IOUArray Int a)

newUF :: MArray IOUArray a IO => Int -> a -> IO (UF a)
newUF n v =
  (,) <$> newListArray (0, n-1) [0..n-1]
      <*> newListArray (0, n-1) (replicate n v)

root :: MArray IOUArray a IO => UF a -> Int -> IO (Int, a)
root (uf, wf) v = do
  p <- readArray uf v
  if p == v
    then (p, ) <$> readArray wf v
    else do
      (r, w) <- root (uf, wf) p
      writeArray uf v r
      return (r, w)

unite :: (MArray IOUArray a IO, Num a) => UF a -> Int -> Int -> IO ()
unite (uf, wf) v w = do
  (r, m) <- root (uf, wf) v
  (s, n) <- root (uf, wf) w
  writeArray uf r s
  writeArray wf s (m+n)

nubOrd :: Ord a => [a] -> [a]
nubOrd = S.toList . S.fromList

main :: IO ()
main = do
  [n, _m] <- getInts
  vs <- getInts
  ns' <- readInts <$> C.getContents

  let ccc [] = []
      ccc (x:y:z) = (x, y) : ccc z

      !es = ccc $ map pred ns'
      -- !g = M.fromListWith (++) [ (f, [t]) | (f, t) <- es ]

  g <- newArray (0, n-1) [] :: IO (IOArray Int [Int])
  for_ es $ \(f, t) -> do
    writeArray g f . (t:) =<< readArray g f
    writeArray g t . (f:) =<< readArray g t

  uf <- newUF n (1 :: Int)
  ss <- newArray (0, n-1) False :: IO (IOUArray Int Bool)

  let ws = sortBy (flip compare) $ zip vs [0..]

      f !acc (v, ix) = do
        us' <- readArray g ix
        us <- filterM (readArray ss) us'
        rs <- forM us $ \u ->
          root uf u

        forM_ us $ \u -> do
          (r1, _n1) <- root uf ix
          (r2, _n2) <- root uf u
          when (r1 /= r2) $ unite uf u ix

        let sums = tail $ scanr (+) 0 ns

            go [] _ !acc = acc
            go (x:xs) (y:ys) !acc = go xs ys (acc + x * y)

            !ns = map (fromIntegral . snd) $ nubOrd rs

        writeArray ss ix True
        return $! acc + v * (sum ns + go ns sums 0)

  ans <- foldM f (0 :: Double) $ map (first fromIntegral) ws

  printf "%.10f\n" (ans / fromIntegral n / fromIntegral (n-1) * 2 :: Double)

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies, ViewPatterns, BangPatterns        #-}

import           Control.Applicative
import           Control.Monad hiding (forM, forM_)
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)
import Data.List hiding (concat, foldl', sum, product)
import qualified Data.IntMap as M
import Data.IORef
import qualified Data.IntSet as S

import           Prelude hiding (sum, product, concat)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

type UF = IORef (M.IntMap (Int, Integer))

newUF :: Int -> IO UF
newUF n = newIORef $ M.fromList [ (i, (i, 1)) | i <- [0..n-1] ]

root :: UF -> Int -> IO (Int, Integer)
root ior v = do
  uf <- readIORef ior
  let (p, n) = uf M.! v
  if p == v
    then return (p, n)
    else do
      r <- root ior p
      writeIORef ior $! M.insert v r uf
      return r

unite :: UF -> Int -> Int -> IO ()
unite ior v w = do
  (r, m) <- root ior v
  (s, n) <- root ior w
  modifyIORef' ior $ M.insert s (s, m+n) . M.insert r (s, m+n)

main :: IO ()
main = do
  [n, m] <- getInts
  vs <- getInts
  (concat -> cs) <- replicateM m $ do
    [f, t] <- getInts
    return [(f-1, t-1), (t-1, f-1)]

  let g = M.fromList $ map (\xs -> (fst $ head xs, map snd xs)) $ groupBy ((==) `on` fst) $ sort cs
  uf <- newUF n

  let ws = sortBy (flip compare) $ zip vs [0..]

      f (!ss, !acc) (v, ix) = do
        let us = M.findWithDefault [] ix g
        (map snd . nub -> ns) <- forM (filter (`S.member` ss) us) $ \u ->
          root uf u
        print (v, ix, us, ss, ns)

        for_ (filter (`S.member` ss) us) $ \u -> do
          (r1, n1) <- root uf ix
          (r2, n2) <- root uf u
          when (r1 /= r2) $ unite uf u ix

        let go [] = 0
            go (x:xs) = x * sum xs + go xs

        return (S.insert ix ss, acc + fromIntegral v * (sum ns + go ns))

  (_, ans) <- foldM f (S.empty, 0) ws

  printf "%.10f\n" $
    ((fromIntegral (ans :: Integer) / fromIntegral n / fromIntegral (n-1) * 2) :: Double)

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns, TupleSections        #-}

import           Control.Applicative
import           Control.Monad         hiding (forM, forM_, mapM_)
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import qualified Data.IntMap.Strict    as M
import qualified Data.IntSet           as S
import           Data.IORef
import           Data.List             hiding (concat, foldl', product, sum)
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)

import           Prelude               hiding (concat, product, sum, mapM_)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

-- type UF = IORef (M.HashMap Int (Int, Int))
type UF = (IOUArray Int Int, IOUArray Int Int)

newUF :: Int -> IO UF
newUF n = (,) <$> newListArray (0, n-1) [0..n-1]
              <*> newListArray (0, n-1) (replicate n 1)

root :: UF -> Int -> IO (Int, Int)
root (uf, wf) v = do
  p <- readArray uf v
  if p == v
    then (p, ) <$> readArray wf v
    else do
      (r, w) <- root (uf, wf) p
      writeArray uf v r
      return (r, w)

unite :: UF -> Int -> Int -> IO ()
unite (uf, wf) v w = do
  (r, m) <- root (uf, wf) v
  (s, n) <- root (uf, wf) w
  writeArray uf r s
  writeArray wf s (m+n)

main :: IO ()
main = do
  [n, m] <- getInts
  vs <- getInts
  (concat -> cs) <- replicateM m $ do
    [f, t] <- getInts
    return [(f-1, t-1), (t-1, f-1)]

  let g = M.fromList $ map (\xs -> (fst $ head xs, map snd xs)) $ groupBy ((==) `on` fst) $ sort cs

  uf <- newUF n
  ssr <- newIORef S.empty
  ansr <- newIORef 0

  let ws = sortBy (flip compare) $ zip vs [0..]

      f (v, ix) = do
        ss <- readIORef ssr
        let us = filter (`S.member` ss) $ M.findWithDefault [] ix g
        (map snd . nub -> ns) <- forM us $ \u ->
          root uf u
        -- print (v, ix, us, ss, ns)

        for_ us $ \u -> do
          (r1, _n1) <- root uf ix
          (r2, _n2) <- root uf u
          when (r1 /= r2) $ unite uf u ix

        let go [] = 0
            go (x:xs) = x * sum xs + go xs

        modifyIORef' ssr $ S.insert ix
        modifyIORef' ansr (+ fromIntegral v * fromIntegral (sum ns + go ns))

  mapM_ f ws
  ans <- readIORef ansr

  printf "%.10f\n" (ans / fromIntegral n / fromIntegral (n-1) * 2 :: Double)

{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns, TupleSections        #-}

import           Control.Applicative
import           Control.Monad         hiding (forM, forM_, mapM_)
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import           Data.Foldable
import           Data.Function
import           Data.Functor
import qualified Data.IntMap.Strict    as M
import qualified Data.IntSet           as S
import           Data.IORef
import           Data.List             hiding (concat, foldl', product, sum)
import           Data.Maybe
import           Data.Traversable
import           Text.Printf           (printf)

import           Prelude               hiding (concat, product, sum, mapM_)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

-----

-- type UF = IORef (M.HashMap Int (Int, Int))
type UF = (IOUArray Int Int, IOUArray Int Int)

newUF :: Int -> IO UF
newUF n = (,) <$> newListArray (0, n-1) [0..n-1]
              <*> newListArray (0, n-1) (replicate n 1)

root :: UF -> Int -> IO (Int, Int)
root (uf, wf) v = do
  p <- readArray uf v
  if p == v
    then (p, ) <$> readArray wf v
    else do
      (r, w) <- root (uf, wf) p
      writeArray uf v r
      return (r, w)

unite :: UF -> Int -> Int -> IO ()
unite (uf, wf) v w = do
  (r, m) <- root (uf, wf) v
  (s, n) <- root (uf, wf) w
  writeArray uf r s
  writeArray wf s (m+n)

main :: IO ()
main = do
  [n, m] <- getInts
  vs <- getInts
  (concat -> cs) <- replicateM m $ do
    [f, t] <- getInts
    return [(f-1, t-1), (t-1, f-1)]

  let g = M.fromList $ map (\xs -> (fst $ head xs, map snd xs)) $ groupBy ((==) `on` fst) $ sort cs

  uf <- newUF n
  ssr <- newIORef S.empty
  ansr <- newIORef 0

  let ws = sortBy (flip compare) $ zip vs [0..]

      f (v, ix) = do
        ss <- readIORef ssr
        let us = filter (`S.member` ss) $ M.findWithDefault [] ix g
        (map snd . nub -> ns) <- forM us $ \u ->
          root uf u
        -- print (v, ix, us, ss, ns)

        for_ us $ \u -> do
          (r1, _n1) <- root uf ix
          (r2, _n2) <- root uf u
          when (r1 /= r2) $ unite uf u ix

        let go [] = 0
            go (x:xs) = x * sum xs + go xs

        modifyIORef' ssr $ S.insert ix
        modifyIORef' ansr (+ fromIntegral v * fromIntegral (sum ns + go ns))

  mapM_ f ws
  ans <- readIORef ansr

  printf "%.10f\n" (fromIntegral (ans :: Integer) / fromIntegral n / fromIntegral (n-1) * 2 :: Double)


One common way of digitalizing sound is to record sound intensity at particular time moments. For each time moment intensity is recorded as a non-negative integer. Thus we can represent a sound file as an array of $$$n$$$ non-negative integers.If there are exactly $$$K$$$ distinct values in the array, then we need $$$k = \lceil \log_{2} K \rceil$$$ bits to store each value. It then takes $$$nk$$$ bits to store the whole file.To reduce the memory consumption we need to apply some compression. One common way is to reduce the number of possible intensity values. We choose two integers $$$l \le r$$$, and after that all intensity values are changed in the following way: if the intensity value is within the range $$$[l;r]$$$, we don't change it. If it is less than $$$l$$$, we change it to $$$l$$$; if it is greater than $$$r$$$, we change it to $$$r$$$. You can see that we lose some low and some high intensities.Your task is to apply this compression in such a way that the file fits onto a disk of size $$$I$$$ bytes, and the number of changed elements in the array is minimal possible.We remind you that $$$1$$$ byte contains $$$8$$$ bits.$$$k = \lceil log_{2} K \rceil$$$ is the smallest integer such that $$$K \le 2^{k}$$$. In particular, if $$$K = 1$$$, then $$$k = 0$$$.

The first line contains two integers $$$n$$$ and $$$I$$$ ($$$1 \le n \le 4 \cdot 10^{5}$$$, $$$1 \le I \le 10^{8}$$$) — the length of the array and the size of the disk in bytes, respectively. The next line contains $$$n$$$ integers $$$a_{i}$$$ ($$$0 \le a_{i} \le 10^{9}$$$) — the array denoting the sound file.

Print a single integer — the minimal possible number of changed elements.

NoteIn the first example we can choose $$$l=2, r=3$$$. The array becomes 2 2 2 3 3 3, the number of distinct elements is $$$K=2$$$, and the sound file fits onto the disk. Only two values are changed.In the second example the disk is larger, so the initial file fits it and no changes are required.In the third example we have to change both 1s or both 3s.

import Data.List
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = print . solve . map readI . B.words =<< B.getContents
solve (n:i:as) = minimum $ go ll rr
 where
  k = (8*i) `div` n
  kk = if k < 30 then 2^k else 2^30
  kk0 = length fs
  fs = map length $ group $ sort as
  ll = scanl (\(d,s) n -> (d+1,s+n)) (0,0) fs
  rr = scanr (\n (d,s) -> (d+1,s+n)) (0,0) fs
  go ((dl,sl):l) ((dr,sr):r) | dl + dr >= kk0 - kk = (sl+sr) : go ((dl,sl):l) r
                             | otherwise = go l ((dr,sr):r)
  go _ _ = []

-- import Debug.Trace

import Data.List
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = print . solve . map readI . B.words =<< B.getContents
solve (n:i:as) = -- traceShow (n,i,k,kk,kk0) $
                 go fs (reverse fs) (kk0 - kk) 0 where
  k = (8*i) `div` n
  kk = 2^k
  kk0 = length fs
  fs = map length $ group $ sort as
  go :: [Int] -> [Int] -> Int -> Int -> Int
--  go ls rs d a | traceShow (ls,rs,d,a) False = undefined
  go _ _ d a | d <= 0 = a
  go (l:ls) (r:rs) d a | l < r = go ls (r:rs) (d-1) $! a+l
                       | otherwise = go (l:ls) rs (d-1) $! a+r

import Data.List
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = print . solve . map readI . B.words =<< B.getContents
solve (n:i:as) = minimum $ go ll rr
 where
  k = last $ takeWhile ((<= 8*i) . (*n)) [0..]
  kk = 2^k
  kk0 = length fs
  fs = map length $ group $ sort as
  ll = scanl (\(d,s) n -> (d+1,s+n)) (0,0) fs
  rr = scanr (\n (d,s) -> (d+1,s+n)) (0,0) fs
  go ((dl,sl):l) ((dr,sr):r) | dl + dr >= kk0 - kk = (sl+sr) : go ((dl,sl):l) r
                             | otherwise = go l ((dr,sr):r)
  go _ _ = []

-- import Debug.Trace

import Data.List
import qualified Data.ByteString.Char8 as B
readI b = i where Just (i,_) = B.readInt b
main = print . solve . map readI . B.words =<< B.getContents
solve (n:i:as) = -- traceShow (n,i,k,kk,kk0) $
                 go fs (reverse fs) (kk0 - kk) 0 where
  k = last $ takeWhile ((<= 8*i) . (*n)) [0..]
  kk = 2^k
  kk0 = length fs
  fs = map length $ group $ sort as
  go :: [Int] -> [Int] -> Int -> Int -> Int
--  go ls rs d a | traceShow (ls,rs,d,a) False = undefined
  go _ _ d a | d <= 0 = a
  go (l:ls) (r:rs) d a | l < r = go ls (r:rs) (d-1) $! a+l
                       | otherwise = go (l:ls) rs (d-1) $! a+r


In a kindergarten, the children are being divided into groups. The teacher put the children in a line and associated each child with his or her integer charisma value. Each child should go to exactly one group. Each group should be a nonempty segment of consecutive children of a line. A group's sociability is the maximum difference of charisma of two children in the group (in particular, if the group consists of one child, its sociability equals a zero). The teacher wants to divide the children into some number of groups in such way that the total sociability of the groups is maximum. Help him find this value.

The first line contains integer n — the number of children in the line (1 ≤ n ≤ 106). The second line contains n integers ai — the charisma of the i-th child ( - 109 ≤ ai ≤ 109).

Print the maximum possible total sociability of all groups.

NoteIn the first test sample one of the possible variants of an division is following: the first three children form a group with sociability 2, and the two remaining children form a group with sociability 1.In the second test sample any division leads to the same result, the sociability will be equal to 0 in each group.

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Int (Int64)
import Control.Monad(replicateM)
import Data.Functor
import Data.List
import Data.Array
import Data.Maybe

isDigit '-' = True
isDigit x = x>='0' && x<='9'
split f (a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])

readInts :: IO [Int]
readInts = (map ((fst.fromJust) . B.readInt)) . (B.split ' ') <$> B.getLine

data Mono = INC | DEC
fn::([[Int]], Mono) -> Int -> ([[Int]], Mono)
fn ((t:ts):as, INC) x = if x >= t then ((x:t:ts):as, INC) else ((x:[t]):(t:ts):as, DEC)
fn ((t:ts):as, DEC) x = if x <= t then ((x:t:ts):as, DEC) else ((x:[t]):(t:ts):as, INC)
break :: [Int] -> [[Int]]
break l@(f:s:r) =
	let
		nature = if f<s then INC else DEC
	in
		fst $ foldl fn ([s:f:[]], nature) r
break (f:[]) = [[f]]

cost :: [Int] -> Int64
cost [] = 0
cost [a] = 0
cost l =
	let
		a = fromIntegral . head $ l
		b = fromIntegral . last $ l
	in
		(max a b) - (min a b)

ff (incl, excl) l@(a:as) =
	let
		inside = reverse . tail . reverse $ as
	in
		(max (incl + (cost as)) (excl + (cost l)), max (incl + (cost inside)) (excl + (cost $ a:inside)))
main = do
	getLine
	nums <- Main.break . reverse <$> readInts
	print $ fst $ foldl ff (0::Int64, 0::Int64) nums
	return ()

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Control.Monad(replicateM)
import Data.Functor
import Data.List
import Data.Array
import Data.Maybe

isDigit '-' = True
isDigit x = x>='0' && x<='9'
split f (a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])

readInts :: IO [Int]
readInts = (map ((fst.fromJust) . B.readInt)) . (B.split ' ') <$> B.getLine

data Mono = INC | DEC
fn::([[Int]], Mono) -> Int -> ([[Int]], Mono)
fn ((t:ts):as, INC) x = if x >= t then ((x:t:ts):as, INC) else ((x:[t]):(t:ts):as, DEC)
fn ((t:ts):as, DEC) x = if x <= t then ((x:t:ts):as, DEC) else ((x:[t]):(t:ts):as, INC)
break :: [Int] -> [[Int]]
break l@(f:s:r) =
	let
		nature = if f<s then INC else DEC
	in
		fst $ foldl fn ([s:f:[]], nature) r
break (f:[]) = [[f]]

cost [] = 0
cost [a] = 0
cost l =
	let
		a = head l
		b = head.reverse $ l
	in
		(max a b) - (min a b)

ff (incl, excl) l@(a:as) =
	let
		inside = reverse . tail . reverse $ as
	in
		(max (incl + (cost as)) (excl + (cost l)), max (incl + (cost inside)) (excl + (cost $ a:inside)))
main = do
	getLine
	nums <- Main.break . reverse <$> readInts
	print $ fst $ foldl ff (0, 0) nums
	return ()

module Main(main) where

import Control.Monad(replicateM)
import Data.Functor
import Data.List
import Data.Array

isDigit x = x>='0' && x<='9'
split f (a:as) lft
	| f a = split f as (a:lft)
	| otherwise = (reverse lft, as)
split _ [] lft = (reverse lft, [])
readInts::String -> [Int]
readInts [] = []
readInts l@(x:xs)
	| isDigit x = let (a, b) = split isDigit l [] in (read a):(readInts b)
	| otherwise = readInts xs

data Mono = INC | DEC
fn::([[Int]], Mono) -> Int -> ([[Int]], Mono)
fn ((t:ts):as, INC) x = if x >= t then ((x:t:ts):as, INC) else ((x:[t]):(t:ts):as, DEC)
fn ((t:ts):as, DEC) x = if x <= t then ((x:t:ts):as, DEC) else ((x:[t]):(t:ts):as, INC)
break :: [Int] -> [[Int]]
break l@(f:s:r) =
	let
		nature = if f<s then INC else DEC
	in
		fst $ foldl fn ([s:f:[]], nature) r
break (f:[]) = [[f]]

cost [] = 0
cost [a] = 0
cost l =
	let
		a = head l
		b = head.reverse $ l
	in
		(max a b) - (min a b)

ff (incl, excl) l@(a:as) =
	let
		inside = reverse . tail . reverse $ as
	in
		(max (incl + (cost as)) (excl + (cost l)), max (incl + (cost inside)) (excl + (cost $ a:inside)))
main = do
	getLine
	nums <- Main.break . reverse . readInts <$> getLine
	print $ fst $ foldl ff (0, 0) nums
	return ()