Gerald plays the following game. He has a checkered field of size n × n cells, where m various cells are banned. Before the game, he has to put a few chips on some border (but not corner) board cells. Then for n - 1 minutes, Gerald every minute moves each chip into an adjacent cell. He moves each chip from its original edge to the opposite edge. Gerald loses in this game in each of the three cases:  At least one of the chips at least once fell to the banned cell.  At least once two chips were on the same cell.  At least once two chips swapped in a minute (for example, if you stand two chips on two opposite border cells of a row with even length, this situation happens in the middle of the row). In that case he loses and earns 0 points. When nothing like that happened, he wins and earns the number of points equal to the number of chips he managed to put on the board. Help Gerald earn the most points.

The first line contains two space-separated integers n and m (2 ≤ n ≤ 1000, 0 ≤ m ≤ 105) — the size of the field and the number of banned cells. Next m lines each contain two space-separated integers. Specifically, the i-th of these lines contains numbers xi and yi (1 ≤ xi, yi ≤ n) — the coordinates of the i-th banned cell. All given cells are distinct. Consider the field rows numbered from top to bottom from 1 to n, and the columns — from left to right from 1 to n.

Print a single integer — the maximum points Gerald can earn in this game.

NoteIn the first test the answer equals zero as we can't put chips into the corner cells.In the second sample we can place one chip into either cell (1, 2), or cell (3, 2), or cell (2, 1), or cell (2, 3). We cannot place two chips.In the third sample we can only place one chip into either cell (2, 1), or cell (2, 4).

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

toInt s = (read s :: Int)

cToInt ch = (ord ch) - 48

toInt' :: [Char] -> Int
toInt' ys = let toInt'' [] r = r
                toInt'' (x:xs) r = toInt'' xs (r*10 + (cToInt x))
            in toInt'' ys 0

toIntList s = map toInt' $ words s

bannedSet :: [(Int,Int)] -> ((Int,Int) -> Int) -> Set.Set Int
bannedSet bpos sel = Set.fromList $ [ sel p | p <- bpos ]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m bpos = let nh = (n+1) `div` 2
                     rbs = bannedSet bpos fst
                     cbs = bannedSet bpos snd
                     goodRows = [ r | r <- [2..(n-1)], Set.notMember r rbs ]
                     goodCols = [ c | c <- [2..(n-1)], Set.notMember c cbs ]

                     groupCount = [ (length $ filter (\x -> (x == g || x == (n-g+1))) goodRows) +
                                    (length $ filter (\x -> (x == g || x == (n-g+1))) goodCols) | g <- [2..nh] ]

                 in if n `mod` 2 == 0
                    then sum groupCount
                    else if last groupCount <= 1
                         then sum groupCount
                         else sum groupCount - 1

main = do fline <- getLine
          let [n,m] = toIntList fline
          bpos <- forM [1..m] (\_ -> do
                       bSt <- getLine
                       let items = words bSt
                           r = items !! 0
                           c = items !! 1
                       return (r,c))
          putStrLn $ show $ solve n m (map (\(rs,cs) -> (toInt' rs, toInt' cs)) bpos)

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
swap (a,b) = (b,a)

main = do
    n:m:l <- map readInt . B.words <$> B.getContents
    let banned = parse l
    print $ solve n banned

parse l = go l []
    where
    go [] acc = reverse acc
    go (a:b:l) acc = go l ((a,b):acc)

solve :: Int  -> [(Int,Int)]  -> Int
solve n l = sum [ f i | i <- [2..n `div` 2]] +
            if odd n &&
               (validX A.! (div n 2+1) || validY A.! (div n 2+1))
               then 1 else 0
    where
    validX = A.accumArray (\a e -> False) True (1,n) $ l
    validY = A.accumArray (\a e -> False) True (1,n) $ map swap l
    f i = length $ filter id [a A.! j | a <- [validX,validY],
                                        j <- [i,n+1-i]]

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

import Data.List
import Data.Maybe
import qualified Data.Array.Unboxed as A
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
swap (a,b) = (b,a)

main = do
    n:m:l <- map readInt . B.words <$> B.getContents
    let banned = parse l
    print $ solve n banned

parse l = go l []
    where
    go [] acc = acc
    go (a:b:l) acc = go l ((a,b):acc)

solve :: Int  -> [(Int,Int)]  -> Int
solve n l = sum [ f i | i <- [2..n `div` 2]] +
            if odd n &&
               (validX A.! (div n 2+1) || validY A.! (div n 2+1))
               then 1 else 0
    where
    validX = (A.accumArray (\a e -> False) True (1,n) $ l)::A.UArray Int Bool
    validY = A.accumArray (\a e -> False) True (1,n) $ map swap l
    f i = length $ filter id [a A.! j | a <- [validX,validY],
                                        j <- [i,n+1-i]]

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

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
swap (a,b) = (b,a)

main = do
    n:m:l <- map readInt . B.words <$> B.getContents
    let banned = parse l
    print $ solve n banned

parse l = go l []
    where
    go [] acc = acc
    go (a:b:l) acc = go l ((a,b):acc)

solve :: Int  -> [(Int,Int)]  -> Int
solve n l = sum [ f i | i <- [2..n `div` 2]] +
            if odd n &&
               (validX A.! (div n 2+1) || validY A.! (div n 2+1))
               then 1 else 0
    where
    validX = A.accumArray (\a e -> False) True (1,n) $ l
    validY = A.accumArray (\a e -> False) True (1,n) $ map swap l
    f i = length $ filter id [a A.! j | a <- [validX,validY],
                                        j <- [i,n+1-i]]

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Array.Base
import Data.Array.ST (runSTUArray)

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getContents
  print $ solve n $ map (subtract 1) xs

solve :: Int -> [Int] -> Int
solve n xys =  sum $ map f [1..n-2]
   where
     f i | i < n-i-1  = sum [unsafeAt arr j|arr<-[arrX,arrY],j<-[i,n-i-1]]
         | i == n-i-1 = unsafeAt arrX i `max` unsafeAt arrY i
         | otherwise  = 0

     arrX, arrY :: UArray Int Int
     (arrX, arrY) = runST $ do
       arrX <- newArray (0,n-1) 1 :: ST s (STUArray s Int Int)
       arrY <- newArray (0,n-1) 1 :: ST s (STUArray s Int Int)
       let go (x:y:xys) = do
             unsafeWrite arrX x 0
             unsafeWrite arrY y 0
             go xys
           go _ = return ()
       go xys
       (,) <$> unsafeFreeze arrX <*> unsafeFreeze arrY

import Control.Monad
import qualified Data.Set as Set

toInt s = (read s :: Int)
toIntList s = map toInt $ words s

bannedSet :: [(Int,Int)] -> ((Int,Int) -> Int) -> Set.Set Int
bannedSet bpos sel = Set.fromList $ [ sel p | p <- bpos ]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m bpos = let rbs = bannedSet bpos fst
                     cbs = bannedSet bpos snd
                     goodRows = Set.fromList [ r | r <- [2..(n-1)], Set.notMember r rbs ]
                     goodCols = [ c | c <- [2..(n-1)], Set.notMember c cbs ]
                     usableCols = Set.fromList [ c | c <- goodCols, ((Set.notMember c rbs) || (Set.notMember (n-c+1) rbs)) ]
                 in (Set.size goodRows) + (length goodCols)

main = do fline <- getLine
          let [n,m] = toIntList fline
          bpos <- forM [1..m] (\_ -> do
                       bSt <- getLine
                       let items = map toInt $ words bSt
                           r = items !! 0
                           c = items !! 1
                       return (r,c))
          putStrLn $ show $ solve n m bpos

import Control.Monad
import qualified Data.Set as Set

toInt s = (read s :: Int)
toIntList s = map toInt $ words s

bannedSet :: [(Int,Int)] -> ((Int,Int) -> Int) -> Set.Set Int
bannedSet bpos sel = Set.fromList $ [ sel p | p <- bpos ]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m bpos = let rbs = bannedSet bpos fst
                     cbs = bannedSet bpos snd
                     goodRows = Set.fromList [ r | r <- [2..(n-1)], Set.notMember r rbs ]
                     goodCols = Set.fromList [ c | c <- [2..(n-1)], Set.notMember c cbs ]
                 in Set.size $ Set.union goodRows goodCols

main = do fline <- getLine
          let [n,m] = toIntList fline
          bpos <- forM [1..m] (\_ -> do
                       bSt <- getLine
                       let items = map toInt $ words bSt
                           r = items !! 0
                           c = items !! 1
                       return (r,c))
          putStrLn $ show $ solve n m bpos

import Control.Monad
import qualified Data.Set as Set

toInt s = (read s :: Int)
toIntList s = map toInt $ words s

bannedSet :: [(Int,Int)] -> ((Int,Int) -> Int) -> Set.Set Int
bannedSet bpos sel = Set.fromList $ [ sel p | p <- bpos ]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m bpos = let rbs = bannedSet bpos fst
                     cbs = bannedSet bpos snd
                     goodRows = Set.fromList [ r | r <- [2..(n-1)], Set.notMember r rbs ]
                     goodCols = [ c | c <- [2..(n-1)], Set.notMember c cbs ]
                     usableCols = Set.fromList [ c | c <- goodCols, ((Set.notMember c rbs) || (Set.notMember (n-c+1) rbs)) ]
                 in Set.size $ Set.union goodRows usableCols

main = do fline <- getLine
          let [n,m] = toIntList fline
          bpos <- forM [1..m] (\_ -> do
                       bSt <- getLine
                       let items = map toInt $ words bSt
                           r = items !! 0
                           c = items !! 1
                       return (r,c))
          putStrLn $ show $ solve n m bpos

import Control.Monad
import qualified Data.Set as Set

toInt s = (read s :: Int)
toIntList s = map toInt $ words s

bannedSet :: [(Int,Int)] -> ((Int,Int) -> Int) -> Set.Set Int
bannedSet bpos sel = Set.fromList $ [ sel p | p <- bpos ]

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m bpos = let nh = (n+1) `div` 2
                     rbs = bannedSet bpos fst
                     cbs = bannedSet bpos snd
                     goodRows = [ r | r <- [2..(n-1)], Set.notMember r rbs ]
                     goodCols = [ c | c <- [2..(n-1)], Set.notMember c cbs ]

                     groupCount = [ (length $ filter (\x -> (x == g || x == (n-g+1))) goodRows) +
                                    (length $ filter (\x -> (x == g || x == (n-g+1))) goodCols) | g <- [2..nh] ]

                     fgroupCount = map (\x -> if x > 3 then 3 else x) groupCount

                 in if n `mod` 2 == 0
                    then sum fgroupCount
                    else if last fgroupCount <= 1
                         then sum fgroupCount
                         else sum fgroupCount - 1

main = do fline <- getLine
          let [n,m] = toIntList fline
          bpos <- forM [1..m] (\_ -> do
                       bSt <- getLine
                       let items = map toInt $ words bSt
                           r = items !! 0
                           c = items !! 1
                       return (r,c))
          putStrLn $ show $ solve n m bpos


An ant moves on the real line with constant speed of $$$1$$$ unit per second. It starts at $$$0$$$ and always moves to the right (so its position increases by $$$1$$$ each second).There are $$$n$$$ portals, the $$$i$$$-th of which is located at position $$$x_i$$$ and teleports to position $$$y_i < x_i$$$. Each portal can be either active or inactive. The initial state of the $$$i$$$-th portal is determined by $$$s_i$$$: if $$$s_i=0$$$ then the $$$i$$$-th portal is initially inactive, if $$$s_i=1$$$ then the $$$i$$$-th portal is initially active. When the ant travels through a portal (i.e., when its position coincides with the position of a portal):   if the portal is inactive, it becomes active (in this case the path of the ant is not affected);  if the portal is active, it becomes inactive and the ant is instantly teleported to the position $$$y_i$$$, where it keeps on moving as normal. How long (from the instant it starts moving) does it take for the ant to reach the position $$$x_n + 1$$$? It can be shown that this happens in a finite amount of time. Since the answer may be very large, compute it modulo $$$998\,244\,353$$$.

The first line contains the integer $$$n$$$ ($$$1\le n\le 2\cdot 10^5$$$) — the number of portals. The $$$i$$$-th of the next $$$n$$$ lines contains three integers $$$x_i$$$, $$$y_i$$$ and $$$s_i$$$ ($$$1\le y_i < x_i\le 10^9$$$, $$$s_i\in\{0,1\}$$$) — the position of the $$$i$$$-th portal, the position where the ant is teleported when it travels through the $$$i$$$-th portal (if it is active), and the initial state of the $$$i$$$-th portal. The positions of the portals are strictly increasing, that is $$$x_1<x_2<\cdots<x_n$$$. It is guaranteed that the $$$2n$$$ integers $$$x_1, \, x_2, \, \dots, \, x_n, \, y_1, \, y_2, \, \dots, \, y_n$$$ are all distinct.

Output the amount of time elapsed, in seconds, from the instant the ant starts moving to the instant it reaches the position $$$x_n+1$$$. Since the answer may be very large, output it modulo $$$998\,244\,353$$$.

NoteExplanation of the first sample: The ant moves as follows (a curvy arrow denotes a teleporting, a straight arrow denotes normal movement with speed $$$1$$$ and the time spent during the movement is written above the arrow). $$$$$$ 0 \stackrel{6}{\longrightarrow} 6 \leadsto 5 \stackrel{3}{\longrightarrow} 8 \leadsto 1 \stackrel{2}{\longrightarrow} 3 \leadsto 2 \stackrel{4}{\longrightarrow} 6 \leadsto 5 \stackrel{2}{\longrightarrow} 7 \leadsto 4 \stackrel{2}{\longrightarrow} 6 \leadsto 5 \stackrel{4}{\longrightarrow} 9 $$$$$$ Notice that the total time is $$$6+3+2+4+2+2+4=23$$$.Explanation of the second sample: The ant moves as follows (a curvy arrow denotes a teleporting, a straight arrow denotes normal movement with speed $$$1$$$ and the time spent during the movement is written above the arrow). $$$$$$ 0 \stackrel{454971987}{\longrightarrow} 454971987 \leadsto 406874902 \stackrel{48097086}{\longrightarrow} 454971988 $$$$$$ Notice that the total time is $$$454971987+48097086=503069073$$$.Explanation of the third sample: Since all portals are initially off, the ant will not be teleported and will go straight from $$$0$$$ to $$$x_n+1=899754846+1=899754847$$$.

import Control.Monad
import Data.Array
import Data.Int
import qualified Data.ByteString.Char8 as C

m :: Int64
m = 998244353

data Portal = Portal {px :: Int, py :: Int, ps :: Int}

solve :: IO ()
solve = do
    n <- readInt
    p <- listArray (1, n) <$> replicateM n ((\[x, y, s] -> Portal x y s) <$> readInts)
    let dp = fArray (1, n) f where
            f i = (fromIntegral (x - y) + dpsum!(i - 1) - dpsum!(j - 1)) `mod` m where
                Portal x y s = p!i
                j = binSearchA ((> y) . px) p
        dpsum = fArray (0, n) f where
            f 0 = 0
            f i = (dpsum!(i - 1) + dp!i) `mod` m
    print $ (1 + fromIntegral (px $ p!n) + sum (map (dp!) $ filter ((==1) . ps . (p!)) [1..n])) `mod` m

fArray :: (Ix i) => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = go (f . (a!)) l (h + 1) where
    (l, h) = bounds a
    go f l h
        | l >= h    = l
        | f m       = go f l m
        | otherwise = go f (m + 1) h
        where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInt = parseInt <$> C.getLine
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve

import Control.Monad
import Data.Array
import Data.Int
import qualified Data.ByteString.Char8 as C

m :: Int64
m = 998244353

newtype MInt = MInt {toInt64 :: Int64}

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

data Portal = Portal {px :: Int, py :: Int, ps :: Int}

solve :: IO ()
solve = do
    n <- readInt
    p <- listArray (1, n) <$> replicateM n ((\[x, y, s] -> Portal x y s) <$> readInts)
    let dp = fArray (1, n) f where
            f :: Int -> MInt
            f i = fromIntegral (x - y) + dpsum!(i - 1) - dpsum!(j - 1) where
                Portal x y s = p!i
                j = binSearchA ((> y) . px) p
        dpsum = fArray (0, n) f where
            f 0 = 0
            f i = dpsum!(i - 1) + dp!i
    print $ toInt64 $ 1 + fromIntegral (px $ p!n) + sum (map (dp!) $ filter ((==1) . ps . (p!)) [1..n])

fArray :: (Ix i) => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

binSearchA :: (a -> Bool) -> Array Int a -> Int
binSearchA f a = go (f . (a!)) l (h + 1) where
    (l, h) = bounds a
    go f l h
        | l >= h    = l
        | f m       = go f l m
        | otherwise = go f (m + 1) h
        where m = (l + h) `div` 2

parseInt = f . C.readInt where f (Just (i, _)) = i
readInt = parseInt <$> C.getLine
readInts = map parseInt . C.words <$> C.getLine

main :: IO ()
main = solve


You are given a string $$$s$$$, consisting of lowercase Latin letters. Every letter appears in it no more than twice.Your task is to rearrange the letters in the string in such a way that for each pair of letters that appear exactly twice, the distance between the letters in the pair is the same. You are not allowed to add or remove letters.It can be shown that the answer always exists. If there are multiple answers, print any of them.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of testcases. Each testcase consists of a non-empty string $$$s$$$, consisting of lowercase Latin letters. Every letter appears in the string no more than twice. The length of the string doesn't exceed $$$52$$$.

For each testcase, print a single string. Every letter should appear in it the same number of times as it appears in string $$$s$$$. For each pair of letters that appear exactly twice, the distance between the letters in the pair should be the same. If there are multiple answers, print any of them.

NoteIn the first testcase of the example, the only letter that appears exactly twice is letter 'l'. You can rearrange the letters arbitrarily, since there are no distances to compare.In the second testcase of the example, the letters that appear exactly twice are 'a', 'b' and 'c'. Initially, letters 'a' are distance $$$6$$$ apart, letters 'b' are distance $$$4$$$ apart and letters 'c' are distance $$$2$$$ apart. They are not the same, so we have to rearrange the letters. After rearrangement, letters 'a' are distance $$$2$$$ apart, letters 'b' are distance $$$2$$$ apart and letters 'c' are distance $$$2$$$ apart. They are all the same, so the answer is valid.In the third testcase of the example, there are no letters that appear exactly twice. Thus, any rearrangement is valid. Including not changing the string at all.

import Control.Monad (forM)
import qualified Data.Map as M

solve t = do
  s <- getLine
  let m = M.fromListWith (+) [(c, 1) | c <- s]
      ans = foldl (\x i -> x ++ replicate (snd i) (fst i)) "" (M.toList m)
  putStrLn ans

main = do
tlen <- readLn :: IO Int
forM [0..(tlen - 1)] (\t -> do solve t)

import Data.List
main=interact$unlines.map sort.tail.lines

module Main where

import Control.Monad
import Data.List (sort)

main = do
    t <- fmap read getLine
    forM_ [1..t] $ \_ -> do
        str <- getLine
        putStrLn $ sort str


There are $$$n$$$ cars on a coordinate axis $$$OX$$$. Each car is located at an integer point initially and no two cars are located at the same point. Also, each car is oriented either left or right, and they can move at any constant positive speed in that direction at any moment.More formally, we can describe the $$$i$$$-th car with a letter and an integer: its orientation $$$ori_i$$$ and its location $$$x_i$$$. If $$$ori_i = L$$$, then $$$x_i$$$ is decreasing at a constant rate with respect to time. Similarly, if $$$ori_i = R$$$, then $$$x_i$$$ is increasing at a constant rate with respect to time. We call two cars irrelevant if they never end up in the same point regardless of their speed. In other words, they won't share the same coordinate at any moment.We call two cars destined if they always end up in the same point regardless of their speed. In other words, they must share the same coordinate at some moment.Unfortunately, we lost all information about our cars, but we do remember $$$m$$$ relationships. There are two types of relationships:$$$1$$$ $$$i$$$ $$$j$$$ —$$$i$$$-th car and $$$j$$$-th car are irrelevant.$$$2$$$ $$$i$$$ $$$j$$$ —$$$i$$$-th car and $$$j$$$-th car are destined.Restore the orientations and the locations of the cars satisfying the relationships, or report that it is impossible. If there are multiple solutions, you can output any.Note that if two cars share the same coordinate, they will intersect, but at the same moment they will continue their movement in their directions.

The first line contains two integers, $$$n$$$ and $$$m$$$ $$$(2 \leq n \leq 2 \cdot 10^5; 1 \leq m \leq min(2 \cdot 10^5, \frac{n(n-1)}{2})$$$ — the number of cars and the number of restrictions respectively. Each of the next $$$m$$$ lines contains three integers, $$$type$$$, $$$i$$$, and $$$j$$$ $$$(1 \leq type \leq 2; 1 \leq i,j \leq n; i≠j)$$$. If $$$type$$$ = $$$1$$$, $$$i$$$-th car and $$$j$$$-th car are irrelevant. Otherwise, $$$i$$$-th car and $$$j$$$-th car are destined. It is guaranteed that for each pair of cars, there are at most $$$1$$$ relationship between.

In the first line, print either "YES" or "NO" (in any case), whether it is possible to restore the orientations and the locations of the cars satisfying the relationships. If the answer is "YES", print $$$n$$$ lines each containing a symbol and an integer: $$$ori_i$$$ and $$$x_i$$$ $$$(ori_i \in \{L, R\}; -10^9 \leq x_i \leq 10^9)$$$ — representing the information of the $$$i$$$-th car. If the orientation is left, then $$$ori_i$$$ = $$$L$$$. Otherwise $$$ori_i$$$ = $$$R$$$. $$$x_i$$$ is the where the $$$i$$$-th car is located. Note that all $$$x_i$$$ should be distinct.  We can prove that if there exists a solution, then there must be a solution satisfying the constraints on $$$x_i$$$.

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

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

import Data.Graph
import Data.Tree
import Data.Array.Unboxed

instance  Semigroup (Prim.BoundedPrim a)  where
  p <> q = (\v -> (v, v)) Prim.>$< p Prim.>*< q

data Relation = Irrelevant !Int !Int | Destined !Int !Int

mainFun :: SP Builder
mainFun = do
  n <- getInt
  m <- getInt
  es <- replicateM m $ do
    t <- getInt
    i <- getInt
    j <- getInt
    pure $ case  t  of
      1 -> Irrelevant i j
      2 -> Destined i j
      _ -> error "input format?"
  let
    asPairs :: Relation -> [(Int, Int)]
    asPairs (Irrelevant i j) = [(i, j), (j, i)]
    asPairs (Destined   i j) = [(i, j), (j, i)]
    adju :: Graph
    adju = buildG (1, n) $ concatMap asPairs es

    layersToColor :: Bool -> Forest Int -> [(Int, Bool)]
    layersToColor _ [] = []
    layersToColor c li
      =  map (flip (,) c . rootLabel) li
      ++ layersToColor (not c) (concatMap subForest li)

    orientation :: UArray Int Bool
    orientation = array (1, n) $ layersToColor False (dff adju)

    asDir :: Relation -> (Int, Int)
    asDir (Irrelevant i j) = if  orientation ! i  then  (j, i)  else  (i, j)
    asDir (Destined   i j) = if  orientation ! i  then  (i, j)  else  (j, i)

    adj = buildG (1, n) $ map asDir es

    ans :: UArray Int Int
    ans = array (1, n) $ zip (topSort adj) [1 .. n]

    isOK :: Relation -> Bool
    isOK (Irrelevant i j) = case  (orientation ! i, orientation ! j)  of
      (True, False) -> ans ! i > ans ! j
      (False, True) -> ans ! i < ans ! j
      _ -> False
    isOK (Destined   i j) = case  (orientation ! i, orientation ! j)  of
      (True, False) -> ans ! i < ans ! j
      (False, True) -> ans ! i > ans ! j
      _ -> False

    bc s = const s Prim.>$< Prim.liftFixedToBounded Prim.char7
    showAns :: Prim.BoundedPrim Int
    showAns = Prim.condB (orientation !) (bc 'R') (bc 'L')
      <> bc ' ' <> ((ans !) Prim.>$< Prim.intDec) <> bc '\n'
  pure $ if  all isOK es
    then  string7 "YES\n" <> Prim.primMapListBounded showAns [1 .. n]
    else  string7 "NO\n"

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

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

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

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

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


Alice has just learned addition. However, she hasn't learned the concept of "carrying" fully — instead of carrying to the next column, she carries to the column two columns to the left.For example, the regular way to evaluate the sum $$$2039 + 2976$$$ would be as shown:   However, Alice evaluates it as shown:   In particular, this is what she does:   add $$$9$$$ and $$$6$$$ to make $$$15$$$, and carry the $$$1$$$ to the column two columns to the left, i. e. to the column "$$$0$$$ $$$9$$$";  add $$$3$$$ and $$$7$$$ to make $$$10$$$ and carry the $$$1$$$ to the column two columns to the left, i. e. to the column "$$$2$$$ $$$2$$$";  add $$$1$$$, $$$0$$$, and $$$9$$$ to make $$$10$$$ and carry the $$$1$$$ to the column two columns to the left, i. e. to the column above the plus sign;  add $$$1$$$, $$$2$$$ and $$$2$$$ to make $$$5$$$;  add $$$1$$$ to make $$$1$$$.  Thus, she ends up with the incorrect result of $$$15005$$$.Alice comes up to Bob and says that she has added two numbers to get a result of $$$n$$$. However, Bob knows that Alice adds in her own way. Help Bob find the number of ordered pairs of positive integers such that when Alice adds them, she will get a result of $$$n$$$. Note that pairs $$$(a, b)$$$ and $$$(b, a)$$$ are considered different if $$$a \ne b$$$.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The description of the test cases follows. The only line of each test case contains an integer $$$n$$$ ($$$2 \leq n \leq 10^9$$$) — the number Alice shows Bob.

For each test case, output one integer — the number of ordered pairs of positive integers such that when Alice adds them, she will get a result of $$$n$$$.

import Control.Arrow ((>>>))

main :: IO ()
main = interact $ lines >>> tail >>> map (solve >>> show) >>> unlines

solve :: String -> Int
solve ns = compute odd ns * compute even ns - 2
  where
    compute p = (1 +) . read . ('0' :) . map snd . filter (p . fst) . zip [1 ..]

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Char
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = str

-- output :: Output -> C.ByteString
output = showB

-- solve :: Input -> Output
solve = subtract 2 . fst . fst . foldl compute init . map digitToInt . reverse
  where
    init = ((1, 0), (0, 0))
    withC d = 9 - d
    withoutC d = d + 1
    compute ((at00, at01), (at10, at11)) d =
      ( ( {- dp[0, 0] = -} at00 * withoutC d + at10 * withoutC (d - 1),
          {- dp[0, 1] = -} at00 * withC d + at10 * withC (d - 1)
        ),
        ( {- dp[1, 0] = -} at01 * withoutC d + at11 * withoutC (d - 1),
          {- dp[1, 1] = -} at01 * withC d + at11 * withC (d - 1)
        )
      )

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

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

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Control.Monad
import Data.List

stripIndex lst = map (\(a,b) -> b) lst

strToInt :: String -> Int
strToInt [] = 0
strToInt lst = read lst

calc :: String -> Int
calc s =
  let (left', right') = partition (\(i,a) -> odd i) $ zip [1..] s
      left = stripIndex left'
      right = stripIndex right'
      a = strToInt left
      b = strToInt right
  in
    (a+1)*(b+1)-2

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    --let (left', right') = partition (\(i,a) -> odd i) $ zip [1..] line
    --print line
    --print left'
    --print right'
    putStrLn $ show $ calc line


Alice received a set of Toy Train™ from Bob. It consists of one train and a connected railway network of $$$n$$$ stations, enumerated from $$$1$$$ through $$$n$$$. The train occupies one station at a time and travels around the network of stations in a circular manner. More precisely, the immediate station that the train will visit after station $$$i$$$ is station $$$i+1$$$ if $$$1 \leq i < n$$$ or station $$$1$$$ if $$$i = n$$$. It takes the train $$$1$$$ second to travel to its next station as described.Bob gave Alice a fun task before he left: to deliver $$$m$$$ candies that are initially at some stations to their independent destinations using the train. The candies are enumerated from $$$1$$$ through $$$m$$$. Candy $$$i$$$ ($$$1 \leq i \leq m$$$), now at station $$$a_i$$$, should be delivered to station $$$b_i$$$ ($$$a_i \neq b_i$$$).    The blue numbers on the candies correspond to $$$b_i$$$ values. The image corresponds to the $$$1$$$-st example. The train has infinite capacity, and it is possible to load off any number of candies at a station. However, only at most one candy can be loaded from a station onto the train before it leaves the station. You can choose any candy at this station. The time it takes to move the candies is negligible.Now, Alice wonders how much time is needed for the train to deliver all candies. Your task is to find, for each station, the minimum time the train would need to deliver all the candies were it to start from there.

The first line contains two space-separated integers $$$n$$$ and $$$m$$$ ($$$2 \leq n \leq 5\,000$$$; $$$1 \leq m \leq 20\,000$$$) — the number of stations and the number of candies, respectively. The $$$i$$$-th of the following $$$m$$$ lines contains two space-separated integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i, b_i \leq n$$$; $$$a_i \neq b_i$$$) — the station that initially contains candy $$$i$$$ and the destination station of the candy, respectively.

In the first and only line, print $$$n$$$ space-separated integers, the $$$i$$$-th of which is the minimum time, in seconds, the train would need to deliver all the candies were it to start from station $$$i$$$.

NoteConsider the second sample.If the train started at station $$$1$$$, the optimal strategy is as follows.  Load the first candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the first candy.  Proceed to station $$$1$$$. This step takes $$$1$$$ second.  Load the second candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the second candy.  Proceed to station $$$1$$$. This step takes $$$1$$$ second.  Load the third candy onto the train.  Proceed to station $$$2$$$. This step takes $$$1$$$ second.  Deliver the third candy. Hence, the train needs $$$5$$$ seconds to complete the tasks.If the train were to start at station $$$2$$$, however, it would need to move to station $$$1$$$ before it could load the first candy, which would take one additional second. Thus, the answer in this scenario is $$$5+1 = 6$$$ seconds.

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

dist nNode src dst = if src < dst then dst - src else dst + (nNode - src)

shortestTimeNode :: Int -> Int -> Int -> [Int] -> Int
shortestTimeNode _     _        _    []      = 0
shortestTimeNode nNode initNode node candies = beforeLast + shortestLast where
    nLoop = if initNode == node then length candies - 2 else length candies - 1
    beforeLast = nNode * nLoop + dist nNode initNode node
    shortestLast = minimum $ map (dist nNode node) candies

shortestTimeNodes nNode filteredCandies initNode =
    maximum $ map (uncurry $ shortestTimeNode nNode initNode) filteredCandies

process :: [[Int]] -> [Int]
process nodeCandies = map (shortestTimeNodes n filteredCandies) [0..(n-1)] where
    n = length nodeCandies
    maxCandy = maximum (map length nodeCandies)
    filteredCandies = filter (\(i, nc) -> length nc >= maxCandy - 1) (zip [0..] nodeCandies)

main = do
    n:m:[] <- getInts
    nodeCandyArray <- newArray (1, n) [] :: IO (IA.IOArray Int [Int])
    replicateM_ m (writeCandy nodeCandyArray)
    nodeCandies <- getElems nodeCandyArray :: IO [[Int]]
    putStrLn $ showCandies $ process nodeCandies

writeCandy candies = do
    node:candy:[] <- getInts
    candyList <- readArray candies node
    writeArray candies node ((candy-1) : candyList)

showCandies = unwords . map show

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

dist nNode src dst = if src < dst then dst - src else dst + (nNode - src)

shortestTimeNode :: Int -> Int -> Int -> (Int, Int) -> Int
shortestTimeNode nNode initNode node (nLoop, lastTime) = if lastTime == 0 then 0 else beforeLast + lastTime where
    nLoop' = if initNode == node then nLoop - 1 else nLoop
    beforeLast = nNode * (nLoop'- 1) + dist nNode initNode node

shortestTimeNodes nNode filteredCandiesInfo initNode =
    maximum $ map (uncurry $ shortestTimeNode nNode initNode) filteredCandiesInfo

process :: [[Int]] -> [Int]
process nodeCandies = map (shortestTimeNodes n filteredCandiesInfo) [0..(n-1)] where
    n = length nodeCandies
    maxCandy = maximum (map length nodeCandies)
    filteredCandies = filter (\(i, nc) -> length nc >= max 1 (maxCandy - 1)) (zip [0..] nodeCandies)
    filteredCandiesInfo = map (\(i, nc) -> (i, (length nc, minimum $ map (dist n i) nc))) filteredCandies

main = do
    n:m:[] <- getInts
    nodeCandyArray <- newArray (1, n) [] :: IO (IA.IOArray Int [Int])
    replicateM_ m (writeCandy nodeCandyArray)
    nodeCandies <- getElems nodeCandyArray :: IO [[Int]]
    putStrLn $ showCandies $ process nodeCandies

writeCandy candies = do
    node:candy:[] <- getInts
    candyList <- readArray candies node
    writeArray candies node ((candy-1) : candyList)

showCandies = unwords . map show

{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Char
import Data.Function
import Data.Maybe
import Data.Monoid
import Data.Semigroup

import qualified Data.ByteString.Lazy.Char8 as BS

#if __GLASGOW_HASKELL__ >= 713
import Control.Monad.Trans.State
import Control.Monad.Trans.Reader
import Data.Functor.Identity
#endif

-- {{{ Functors

#if __GLASGOW_HASKELL__ < 713
newtype Identity a = Identity {runIdentity :: a}

instance Functor Identity where
  fmap f (Identity x) = Identity $ f x
#endif

-- }}}

-- {{{ Monads

#if __GLASGOW_HASKELL__ < 713
newtype Reader a b = Reader {runReader :: a -> b}
newtype State s a = State {runState :: s -> (a, s)}

instance Functor (Reader a) where
  fmap f =  Reader . (f . ). runReader
  {-# INLINE fmap #-}

instance Applicative (Reader a) where
  pure = Reader . const
  {-# INLINE pure #-}
  a <*> b = Reader f'
    where
      f1 = runReader a
      f2 = runReader b
      f' = \p -> (f1 p) (f2 p)
  {-# INLINE (<*>) #-}

instance Monad (Reader a) where
  r1 >>= r2 = Reader $ \a -> runReader (r2 $ runReader r1 a) a
  {-# INLINE (>>=) #-}
  return = pure

ask :: Reader a a
ask = Reader id
{-# INLINE ask #-}
local :: (a -> a) -> Reader a b -> Reader a b
local f r = let f' = (runReader r) . f in Reader f'
{-# INLINE local #-}

instance Functor (State s) where
  fmap f st = State $ \s -> let (a, s') = runState st s in (f a, s')

instance Applicative (State s) where
  pure = State . (,)
  {-# INLINE pure #-}
  s1 <*> s2 = State $ \s ->
    let (f, s') = runState s1 s
        (a, s'') = runState s2 s'
    in (f a, s'')

instance Monad (State s) where
  s1 >>= ms2 = State $ \s ->
    let (a, s') = runState s1 s
    in runState (ms2 a) s'
  return = pure

put :: s -> State s ()
put = State . const . ((,) ())
{-# INLINE put #-}
get :: State s s
get = State $ \s -> (s, s)
{-# INLINE get #-}
execState :: State s a -> s -> s
execState st s0 = snd $ runState st s0
#endif

-- }}}

-- {{{ Lens

type CylLens a s b t = forall f. Functor f => (a -> f s) -> b -> f t
type CylLens' a b = CylLens a a b b
lens :: (b -> a) -> (b -> s -> t) -> CylLens a s b t
lens r w g b = w b <$> g (r b)
{-# INLINE lens #-}
iso :: (a -> b) -> (b -> a) -> CylLens' a b
iso f f' = let f'' _ a = f a in lens f' f''
{-# INLINE iso #-}
lensGet :: CylLens a s b t -> b -> a
lensGet lens = getConst . lens Const
{-# INLINE lensGet #-}
lensSet :: CylLens a s b t -> b -> s -> t
lensSet lens b s = runIdentity $ lens (Identity . const s) b
{-# INLINE lensSet #-}

#if __GLASGOW_HASKELL__ < 713
infix 1 &
#endif

infix 8 ^.
infix 4 .=, %=
infixr 4 .~, %~

#if __GLASGOW_HASKELL__ < 713
(&) :: a -> (a -> b) -> b
a & f = f a
{-# INLINE (&) #-}
#endif

(^.) :: b -> CylLens a s b t -> a
b ^. lens = lensGet lens b
{-# INLINE (^.) #-}
(%~) :: CylLens a s b t -> (a -> s) -> (b -> t)
(lens %~ f) b = lensSet lens b (f $ lensGet lens b)
{-# INLINE (%~) #-}
(.~) :: CylLens a s b t -> s -> (b -> t)
(lens .~ v) b = lensSet lens b v
{-# INLINE (.~) #-}
(.=) :: CylLens a a' s s -> a' -> State s ()
lens .= v = do {s <- get; put $ s & lens .~ v}
{-# INLINE (.=) #-}
(%=) :: CylLens a a' s s -> (a -> a') -> State s ()
lens %= f = do {s <- get; put $ s & lens %~ f}
{-# INLINE (%=) #-}
view :: CylLens a a' s s' -> Reader s a
view l = ask >>= return . (^. l)
use :: CylLens a a' s s' -> State s a
use l = get >>= return . (^. l)

-- }}}

-- {{{ Handy IO

type StringReader a = State BS.ByteString a

readFrom :: BS.ByteString -> StringReader a -> a
readFrom s = fst . flip runState s

isLineBreak :: Char -> Bool
isLineBreak c = c == '\n' || c == '\r'

stripLineBreak :: StringReader ()
stripLineBreak = do
  modify $ BS.dropWhile isLineBreak

getLine :: StringReader BS.ByteString
getLine = do
  s <- get
  let (l, s') = BS.span (not . isLineBreak) s
  put s'
  stripLineBreak
  return l

restLines :: StringReader [BS.ByteString]
restLines = do
  s <- get
  put BS.empty
  return $ BS.lines s

getInt :: Num a => StringReader a
getInt = do
  s <- get
  let l' = BS.dropWhile isSpace s
      (d, ll') = BS.span isDigit l'
  put ll'
  return $ case BS.readInt d of
    Just (i, _) -> fromIntegral i
    Nothing -> error $ "Not an integer: " ++ show d

-- }}}

solve :: Int -> [(Int, Int)] -> [Int]
solve n xs = map (fromMaybe 0) $ rot 0 Nothing (zip zs ys)  []
  where
    d s t
      | t >= s = t - s
      | otherwise = n - s + t
    xs' = map (\(a, b) -> (a - 1, Just (Sum n, Min $ d (a - 1) (b - 1)))) xs
    ysR = accumArray (<>) Nothing (0, n - 1) xs'
    ys = map (fmap (\(Sum k, Min dt) -> k + dt - n)) $ elems ysR
    zs = scanr1 (<>) $ map (\(y, i) -> (Max . (+i)) <$> y) $ zip ys [0..]

    mInt :: CylLens' Int (Max Int)
    mInt = iso Max getMax

    rot :: Int -> Maybe (Max Int) -> [(Maybe (Max Int), Maybe Int)] -> [Maybe Int] -> [Maybe Int]
    rot _ _ [] acc = reverse acc
    rot offset prevMax ((maxX, x):t) acc =
      rot (offset + 1)
          (((& (mInt %~ (subtract 1))) <$> prevMax) <> ((Max . (+(n - 1))) <$> x))
          t
          ((getMax <$> prevMax <> ((& mInt %~ (subtract offset)) <$> maxX)):acc)

main :: IO ()
main = do
  contents <- BS.getContents
  let (n, xs) = readFrom contents $ do
        _n <- getInt
        _m <- getInt
        _xs <- replicateM _m $ (,) <$> getInt <*> getInt
        return (_n, _xs)
      ans = solve n xs
  putStrLn $ unwords $ map show ans
  return ()

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

dist nNode src dst = if src < dst then dst - src else dst + (nNode - src)

shortestTimeNode :: Int -> Int -> Int -> [Int] -> Int
shortestTimeNode _     _        _    []      = 0
shortestTimeNode nNode initNode node candies = beforeLast + shortestLast where
    nLoop = if initNode == node then length candies - 2 else length candies - 1
    beforeLast = nNode * nLoop + dist nNode initNode node
    shortestLast = minimum $ map (dist nNode node) candies

shortestTimeNodes nNode filteredCandies initNode =
    maximum $ map (uncurry $ shortestTimeNode nNode initNode) filteredCandies

process :: [[Int]] -> [Int]
process nodeCandies = map (shortestTimeNodes n filteredCandies) [0..(n-1)] where
    n = length nodeCandies
    maxCandy = maximum (map length nodeCandies)
    filteredCandies = filter (\(i, nc) -> length nc == maxCandy) (zip [0..] nodeCandies)

main = do
    n:m:[] <- getInts
    nodeCandyArray <- newArray (1, n) [] :: IO (IA.IOArray Int [Int])
    replicateM_ m (writeCandy nodeCandyArray)
    nodeCandies <- getElems nodeCandyArray :: IO [[Int]]
    putStrLn $ showCandies $ process nodeCandies

writeCandy candies = do
    node:candy:[] <- getInts
    candyList <- readArray candies node
    writeArray candies node ((candy-1) : candyList)

showCandies = unwords . map show

import Control.Monad
import Control.Monad.Trans.State
import Data.Array
import Data.Char

import qualified Data.ByteString.Lazy.Char8 as BS

-- {{{ Handy IO

type StringReader a = State BS.ByteString a

readFrom :: BS.ByteString -> StringReader a -> a
readFrom s = fst . flip runState s

isLineBreak :: Char -> Bool
isLineBreak c = c == '\n' || c == '\r'

stripLineBreak :: StringReader ()
stripLineBreak = do
  modify $ BS.dropWhile isLineBreak

getLine :: StringReader BS.ByteString
getLine = do
  s <- get
  let (l, s') = BS.span (not . isLineBreak) s
  put s'
  stripLineBreak
  return l

restLines :: StringReader [BS.ByteString]
restLines = do
  s <- get
  put BS.empty
  return $ BS.lines s

getInt :: Num a => StringReader a
getInt = do
  s <- get
  let l' = BS.dropWhile isSpace s
      (d, ll') = BS.span isDigit l'
  put ll'
  return $ case BS.readInt d of
    Just (i, _) -> fromIntegral i
    Nothing -> error $ "Not an integer: " ++ show d

-- }}}

solve :: Int -> [(Int, Int)] -> [Int]
solve n xs = rot 0 0 (zip zs ys)  []
  where
    d s t
      | t >= s = t - s
      | otherwise = n - s + t
    xs' = map (\(a, b) -> (a - 1, d (a - 1) (b - 1))) xs
    ysR = accumArray (\(b, l) dt -> (b + n, min l dt)) (0, n) (0, n - 1) xs'
    ys = map ((subtract n) . uncurry (+)) $ elems ysR
    zs = scanr1 max $ map (uncurry (+)) $ zip ys [0..]

    rot :: Int -> Int -> [(Int, Int)] -> [Int] -> [Int]
    rot _ _ [] acc = reverse acc
    rot offset prevMax ((maxX, x):t) acc =
      rot (offset + 1) (max (prevMax - 1) (x + n - 1)) t (max prevMax (maxX - offset):acc)

main :: IO ()
main = do
  contents <- BS.getContents
  let (n, xs) = readFrom contents $ do
        _n <- getInt
        _m <- getInt
        _xs <- replicateM _m $ (,) <$> getInt <*> getInt
        return (_n, _xs)
      ans = solve n xs
  putStrLn $ unwords $ map show ans
  return ()


This problem is same as the next one, but has smaller constraints.Shiro's just moved to the new house. She wants to invite all friends of her to the house so they can play monopoly. However, her house is too small, so she can only invite one friend at a time.For each of the $$$n$$$ days since the day Shiro moved to the new house, there will be exactly one cat coming to the Shiro's house. The cat coming in the $$$i$$$-th day has a ribbon with color $$$u_i$$$. Shiro wants to know the largest number $$$x$$$, such that if we consider the streak of the first $$$x$$$ days, it is possible to remove exactly one day from this streak so that every ribbon color that has appeared among the remaining $$$x - 1$$$ will have the same number of occurrences.For example, consider the following sequence of $$$u_i$$$: $$$[2, 2, 1, 1, 5, 4, 4, 5]$$$. Then $$$x = 7$$$ makes a streak, since if we remove the leftmost $$$u_i = 5$$$, each ribbon color will appear exactly twice in the prefix of $$$x - 1$$$ days. Note that $$$x = 8$$$ doesn't form a streak, since you must remove exactly one day. Since Shiro is just a cat, she is not very good at counting and needs your help finding the longest streak.

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the total number of days. The second line contains $$$n$$$ integers $$$u_1, u_2, \ldots, u_n$$$ ($$$1 \leq u_i \leq 10$$$) — the colors of the ribbons the cats wear.

Print a single integer $$$x$$$ — the largest possible streak of days.

NoteIn the first example, we can choose the longest streak of $$$13$$$ days, since upon removing the last day out of the streak, all of the remaining colors $$$1$$$, $$$2$$$, $$$3$$$, and $$$4$$$ will have the same number of occurrences of $$$3$$$. Note that the streak can also be $$$10$$$ days (by removing the $$$10$$$-th day from this streak) but we are interested in the longest streak.In the fourth example, if we take the streak of the first $$$6$$$ days, we can remove the third day from this streak then all of the remaining colors $$$1$$$, $$$2$$$, $$$3$$$, $$$4$$$ and $$$5$$$ will occur exactly once.

module Main where
import           Data.IntMap (IntMap, Key,  toList, empty, alter, size)
import           Data.List
import           Data.Function

main = do
  getLine
  colors <- (fmap read . words) <$> getLine
  print  $ cp colors

colorCounts' :: [Int] -> [IntMap Int]
colorCounts' = scanl (\ im k -> alter updateCount k im) empty
  where
    updateCount Nothing = Just 1
    updateCount (Just n) = Just (n+1)

oneColor cc = size cc == 1

colorGroups cc = groupBy ((==) `on` snd) $ sortBy (compare `on` snd) $ toList cc

colorCountsCounts :: IntMap Int -> [(Int, Int)]
colorCountsCounts cc = sortBy (compare `on` snd) $ (\x -> (length x, snd $ head x)) <$> colorGroups cc

allOnes cc = all ((== 1) . snd) $ toList cc

twoCounts cc = 2 == (length $ group $ colorCountsCounts cc)

nAndOne cc = twoCounts cc && (head $ colorCountsCounts cc) == (1,1)

nAndNPlus1 cc =
  twoCounts cc && (fst $ (colorCountsCounts cc)!!1) == 1 &&
  (snd $ head $ colorCountsCounts cc) + 1 == (snd ((colorCountsCounts cc)!!1))

goodCounts cc = oneColor cc || allOnes cc || nAndOne cc || nAndNPlus1 cc

cp c = fst $ last $ filter (goodCounts . snd) $ zip [0..] colorCounts
  where
    colorCounts = colorCounts' c

module Main where
import           Data.IntMap (IntMap, Key,  toList, empty, alter, size)
import           Data.List
import           Data.Function

main = do
  getLine
  colors <- (fmap read . words) <$> getLine
  print  $ cp colors

cp c = last goodLengths
  where
    colorCounts :: [IntMap Int]
    colorCounts = scanl (\ im c -> alter updateCount c im) empty c
    updateCount Nothing = Just 1
    updateCount (Just n) = Just (n+1)
    oneColor cc = size cc == 1
    colorCountsCounts :: IntMap Int -> [(Int, Int)]
    colorCountsCounts cc = sortBy (compare `on` snd) $ (\x -> (length x, snd $ head x)) <$> groupBy ((==) `on` snd) (sort $ toList cc)
    allOnes cc = all ((== 1) . snd) $ toList cc
    twoCounts cc = 2 == (length $ group $ colorCountsCounts cc)
    nAndOne cc = twoCounts cc && (head $ colorCountsCounts cc) == (1,1)
    nAndNPlus1 cc =
      twoCounts cc && (fst $ (colorCountsCounts cc)!!1) == 1 &&
      (snd $ head $ colorCountsCounts cc) + 1 == (snd ((colorCountsCounts cc)!!1))
    goodCounts cc = oneColor cc || allOnes cc || nAndOne cc || nAndNPlus1 cc
    goodLengths = map fst $ filter (goodCounts . snd) $ zip [0..] colorCounts

module Main where
import           Data.IntMap (IntMap, Key,  toList, empty, alter, size)
import           Data.List
import           Data.Function

main = do
  getLine
  colors <- (fmap read . words) <$> getLine
  print  $ cp colors

cp c = (last goodLengths, goodLengths, colorCountsCounts <$> colorCounts)
  where
    colorCounts :: [IntMap Int]
    colorCounts = scanl (\ im c -> alter updateCount c im) empty c
    updateCount Nothing = Just 1
    updateCount (Just n) = Just (n+1)
    oneColor cc = size cc == 1
    colorCountsCounts :: IntMap Int -> [(Int, Int)]
    colorCountsCounts cc = sortBy (compare `on` snd) $ (\x -> (length x, snd $ head x)) <$> groupBy ((==) `on` snd) (sort $ toList cc)
    allOnes cc = all ((== 1) . snd) $ toList cc
    twoCounts cc = 2 == (length $ group $ colorCountsCounts cc)
    nAndOne cc = twoCounts cc && (head $ colorCountsCounts cc) == (1,1)
    nAndNPlus1 cc =
      twoCounts cc && (fst $ (colorCountsCounts cc)!!1) == 1 &&
      (snd $ head $ colorCountsCounts cc) + 1 == (snd ((colorCountsCounts cc)!!1))
    goodCounts cc = oneColor cc || allOnes cc || nAndOne cc || nAndNPlus1 cc
    goodLengths = map fst $ filter (goodCounts . snd) $ zip [0..] colorCounts


The life goes up and down, just like nice sequences. Sequence t1, t2, ..., tn is called nice if the following two conditions are satisfied:   ti < ti + 1 for each odd i < n;  ti > ti + 1 for each even i < n. For example, sequences (2, 8), (1, 5, 1) and (2, 5, 1, 100, 99, 120) are nice, while (1, 1), (1, 2, 3) and (2, 5, 3, 2) are not.Bear Limak has a sequence of positive integers t1, t2, ..., tn. This sequence is not nice now and Limak wants to fix it by a single swap. He is going to choose two indices i < j and swap elements ti and tj in order to get a nice sequence. Count the number of ways to do so. Two ways are considered different if indices of elements chosen for a swap are different.

The first line of the input contains one integer n (2 ≤ n ≤ 150 000) — the length of the sequence. The second line contains n integers t1, t2, ..., tn (1 ≤ ti ≤ 150 000) — the initial sequence. It's guaranteed that the given sequence is not nice.

Print the number of ways to swap two elements exactly once in order to get a nice sequence.

NoteIn the first sample, there are two ways to get a nice sequence with one swap:   Swap t2 = 8 with t4 = 7.  Swap t1 = 2 with t5 = 7. In the second sample, there is only one way — Limak should swap t1 = 200 with t4 = 50.

{-
instructions go here...
-}

module Main where
import Data.Array (Array, listArray, bounds, inRange, (!))
import Data.List (group, sort)

solve :: [Int] -> Int
solve ts = if length offenders > 4
             then 0
             else length [swap | swap@(i,j) <- swaps
                               , swapHelps tsArray (i-1:i:j-1:j:offenders) (i,j)]
  where pairs :: [(Int, (Int, Int), Bool)]
        pairs = zipWith3 (\i (a,b) cmp -> (i,(a,b), cmp a b)) [0..] (zip ts (tail ts)) (cycle [(<),(>)])
        offenders = map (\(i,_,_) -> i) $ filter (\(_,_,b) -> not b) pairs
        swaps = distinct $ [(i',j') | i <- offenders
                                    , i' <- [i,i+1]
                                    , 0 <= i' && i' < n-1
                                    , j' <- [i'+1..n-1]]
                           ++
                           [(i',j') | j <- offenders
                                    , j' <- [j,j+1]
                                    , 1 <= j' && j' < n
                                    , i' <- [0..j'-1]]
        n = length ts
        tsArray = listArray (0,n-1) ts

swapHelps :: Array Int Int -> [Int] -> (Int,Int) -> Bool
swapHelps ts offenders swap@(i,j) = all isGoodAt offenders
  where isGoodAt idx = if all ((bounds ts) `inRange`) [idx, idx+1]
                         then let cmp = if even idx then (<) else (>)
                              in valueAt idx `cmp` valueAt (idx+1)
                         else True
        valueAt idx | i == idx  = ts ! j
                    | j == idx  = ts ! i
                    | otherwise = ts ! idx

distinct :: (Ord a) => [a] -> [a]
distinct = map head . group . sort

main :: IO ()
main = do
  line1 <- getLine
  line2 <- getLine
  let ts = map read (words line2) :: [Int]
  putStrLn $ show $ solve ts

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: [Int] -> Int
solve ts = if tooManyOffenders offenders
             then 0
             else length $ filter isNice (zipWith applySwap (repeat ts) swaps)
  where pairs :: [(Int, (Int, Int),Bool)]
        pairs = zipWith3 (\i (a,b) cmp -> (i,(a,b), cmp a b)) [0..] (zip ts (tail ts)) (cycle [(<),(>)])
        offenders = map (\(i,_,_) -> i) $ filter (\(_,_,b) -> b) pairs
        swaps = distinct [(i',j') | i <- offenders
                                  , i' <- [i-1..i+2]
                                  , 0 <= i' && i' < n
                                  , j <- offenders
                                  , j' <- [j-1,j+2]
                                  , 0 <= j' && j' < n
                                  , i' < j']
        n = length ts

applySwap :: [Int] -> (Int, Int) -> [Int]
applySwap ts (i,j) = ts1 ++ [tj] ++ ts2 ++ [ti] ++ ts3
  where (ts1, ti:ts') = splitAt i ts
        (ts2, tj:ts3) = splitAt (j - 1 - length ts1) ts'

isNice :: [Int] -> Bool
isNice ts = and $ zipWith3 (\a b cmp -> cmp a b) ts (tail ts) (cycle [(<),(>)])

tooManyOffenders (_:_:_:_:_:_:_:_:_:xs) = True
tooManyOffenders _ = False

distinct :: (Ord a) => [a] -> [a]
distinct = map head . group . sort

main :: IO ()
main = do
  line1 <- getLine
  line2 <- getLine
  let ts = map read (words line2) :: [Int]
  putStrLn $ show $ solve ts

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: [Int] -> Int
solve ts = if length offenders > 20
             then 0
             else length $ filter isNice (zipWith applySwap (repeat ts) swaps)
  where pairs :: [(Int, (Int, Int),Bool)]
        pairs = zipWith3 (\i (a,b) cmp -> (i,(a,b), cmp a b)) [0..] (zip ts (tail ts)) (cycle [(<),(>)])
        offenders = map (\(i,_,_) -> i) $ filter (\(_,_,b) -> b) pairs
        swaps = distinct $ [(i',j') | i <- offenders
                                    , i' <- [i-2..i+2]
                                    , 0 <= i' && i' < n
                                    , j <- offenders
                                    , j' <- [j-2,j+2]
                                    , 0 <= j' && j' < n
                                    , i' < j']
                           ++
                           [(i',j') | i <- offenders
                                    , i' <- [i-2..i+2]
                                    , 0 <= i' && i' < n
                                    , j' <- [i'+1..i'+3]
                                    , 0 <= j' && j' < n]
        n = length ts

applySwap :: [Int] -> (Int, Int) -> [Int]
applySwap ts (i,j) = ts1 ++ [tj] ++ ts2 ++ [ti] ++ ts3
  where (ts1, ti:ts') = splitAt i ts
        (ts2, tj:ts3) = splitAt (j - 1 - length ts1) ts'

isNice :: [Int] -> Bool
isNice ts = and $ zipWith3 (\a b cmp -> cmp a b) ts (tail ts) (cycle [(<),(>)])

distinct :: (Ord a) => [a] -> [a]
distinct = map head . group . sort

main :: IO ()
main = do
  line1 <- getLine
  line2 <- getLine
  let ts = map read (words line2) :: [Int]
  putStrLn $ show $ solve ts

{-
instructions go here...
-}

module Main where
import Data.List (group, sort)

solve :: [Int] -> Int
solve ts = if length offenders > 20
             then 0
             else length $ filter isNice (zipWith applySwap (repeat ts) swaps)
  where pairs :: [(Int, (Int, Int),Bool)]
        pairs = zipWith3 (\i (a,b) cmp -> (i,(a,b), cmp a b)) [0..] (zip ts (tail ts)) (cycle [(<),(>)])
        offenders = map (\(i,_,_) -> i) $ filter (\(_,_,b) -> b) pairs
        swaps = distinct [(i',j') | i <- offenders
                                  , i' <- [i-1..i+2]
                                  , 0 <= i' && i' < n
                                  , j <- offenders
                                  , j' <- [j-1,j+2]
                                  , 0 <= j' && j' < n
                                  , i' < j']
        n = length ts

applySwap :: [Int] -> (Int, Int) -> [Int]
applySwap ts (i,j) = ts1 ++ [tj] ++ ts2 ++ [ti] ++ ts3
  where (ts1, ti:ts') = splitAt i ts
        (ts2, tj:ts3) = splitAt (j - 1 - length ts1) ts'

isNice :: [Int] -> Bool
isNice ts = and $ zipWith3 (\a b cmp -> cmp a b) ts (tail ts) (cycle [(<),(>)])

distinct :: (Ord a) => [a] -> [a]
distinct = map head . group . sort

main :: IO ()
main = do
  line1 <- getLine
  line2 <- getLine
  let ts = map read (words line2) :: [Int]
  putStrLn $ show $ solve ts


Currently Tiny is learning Computational Geometry. When trying to solve a problem called "The Closest Pair Of Points In The Plane", he found that a code which gave a wrong time complexity got Accepted instead of Time Limit Exceeded.The problem is the follows. Given n points in the plane, find a pair of points between which the distance is minimized. Distance between (x1, y1) and (x2, y2) is .The pseudo code of the unexpected code is as follows:input nfor i from 1 to n    input the i-th point's coordinates into p[i]sort array p[] by increasing of x coordinate first and increasing of y coordinate secondd=INF        //here INF is a number big enoughtot=0for i from 1 to n    for j from (i+1) to n        ++tot        if (p[j].x-p[i].x>=d) then break    //notice that "break" is only to be                                            //out of the loop "for j"        d=min(d,distance(p[i],p[j]))output dHere, tot can be regarded as the running time of the code. Due to the fact that a computer can only run a limited number of operations per second, tot should not be more than k in order not to get Time Limit Exceeded.You are a great hacker. Would you please help Tiny generate a test data and let the code get Time Limit Exceeded?

A single line which contains two space-separated integers n and k (2 ≤ n ≤ 2000, 1 ≤ k ≤ 109).

If there doesn't exist such a data which let the given code get TLE, print "no solution" (without quotes); else print n lines, and the i-th line contains two integers xi, yi (|xi|, |yi| ≤ 109) representing the coordinates of the i-th point. The conditions below must be held:   All the points must be distinct.  |xi|, |yi| ≤ 109.  After running the given code, the value of tot should be larger than k.

main = do
  [n, k] <- (map read . words) `fmap` getLine
  if k >= n*(n-1) `div` 2
  then
    putStrLn "no solution"
  else
    putStr $ unlines $ map (\i -> "0 " ++ (show i)) $ take n $ [0..]

import Data.List
import Control.Monad

main = do [n, k] <- fmap (map read . words) getLine
          if n * (n - 1) <= 2 * k then
            putStrLn "no solution"
            else
            mapM_ (\x -> putStrLn ("0 " ++ show x)) [1..n]

main = interact $ solve . map read . words

solve :: (Integral a, Show a) => [a] -> String
solve [n, k] | n * (n - 1) > 2 * k = unlines $ map (("4 " ++) . show) [1 .. n]
             | otherwise           = "no solution"

main=interact$f.map read.words
f :: [Integer] -> String
f[n,k]
  | k >= sum[n-i|i<-[1..n]] = "no solution"
  | otherwise = unlines.map(("0 "++).show)$take (fromIntegral n) [0..]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readInts = map readInt . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
itof :: Int -> Double
itof = fromIntegral

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readLns
    if k >= n * (n - 1) `div` 2 then
        putStrLn "no solution"
    else
        forM_ [0..n-1] $ \i-> printf "0 %d\n" (i :: Int)

main = do
  [n, k] <- (map read . words) `fmap` getLine
  if k > n*(n-1) `div` 2
  then
    putStrLn "no solution"
  else
    putStr $ unlines $ map (\i -> "0 " ++ (show i)) $ take n $ [0..]

main=interact$f.map read.words
f :: [Integer] -> String
f[n,k]
  | k >= n*(n+1)`div`2-1 = "no solution"
  | otherwise = unlines.map(("0 "++).show)$take (fromIntegral n) [10^9,(10^9)-1..]


Given simple (without self-intersections) n-gon. It is not necessary convex. Also you are given m lines. For each line find the length of common part of the line and the n-gon.The boundary of n-gon belongs to polygon. It is possible that n-gon contains 180-degree angles.

The first line contains integers n and m (3 ≤ n ≤ 1000;1 ≤ m ≤ 100). The following n lines contain coordinates of polygon vertices (in clockwise or counterclockwise direction). All vertices are distinct. The following m lines contain line descriptions. Each of them contains two distict points of a line by their coordinates. All given in the input coordinates are real numbers, given with at most two digits after decimal point. They do not exceed 105 by absolute values.

Print m lines, the i-th line should contain the length of common part of the given n-gon and the i-th line. The answer will be considered correct if the absolute or relative error doesn't exceed 10 - 6.

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico deriving (Show)
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				(zs, cs) = unzip $ sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				(dist lp lq) * (sum $ map (\((z1, z2), _) -> z2 - z1) $ filter (\(_, c) -> c /= 0) $ zip (zip zs (tail zs ++ zs)) cs')
			where
				lv = vect lp lq
				(zs, cs) = unzip $ sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico deriving (Show)
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				is = sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				(zs, cs) = unzip is
				cs' :: [Int]
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				(dist lp lq) * (sum $ map fst $ filter (\(_, c) -> c /= 0) $ zip (zipWith (flip (-)) zs (tail zs ++ zs)) cs')
			where
				lv = vect lp lq
				(zs, cs) = unzip $ sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				(zs, cs) = unzip $ sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

{-# OPTIONS_GHC -O2 #-}
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)
-- import Debug.Trace (trace)

data Point = Point Pico Pico deriving (Show)
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-6

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) = -- trace (show is) $
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				is = sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				(zs, cs) = unzip is
				cs' :: [Int]
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)

data Point = Point Pico Pico
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2

-- TODO how Pico to Double ?
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-7

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) =
				(dist lp lq) * (sum $ map fst $ filter ((/= 0) . snd) $ zip ds cs')
			where
				(zs, cs) = unzip $ sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				ds = zipWith (flip (-)) zs (tail zs ++ zs)
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						lv = vect lp lq
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
-- import Debug.Trace (trace)

data Point = Point Double Double deriving (Show)
data Vector = Vector Double Double

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2

eps = 1e-9

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) = -- trace (show is) $
				((sqrt (lv `dot` lv)) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				is = sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				(zs, cs) = unzip is
				cs' :: [Int]
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

{-# OPTIONS_GHC -O2 #-}
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
-- import Debug.Trace (trace)

data Point = Point Double Double deriving (Show)
data Vector = Vector Double Double

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = sqrt $ (x2-x1)^2 + (y2-y1)^2

eps = 1e-3

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) = -- trace (show is) $
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				is = sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				(zs, cs) = unzip is
				cs' :: [Int]
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls

{-# OPTIONS_GHC -O2 #-}
import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.List (sort)
import Data.Maybe (catMaybes)
import Data.Fixed (Pico)
-- import Debug.Trace (trace)

data Point = Point Pico Pico deriving (Show)
data Vector = Vector Pico Pico

vect (Point x1 y1) (Point x2 y2) = Vector (x2-x1) (y2-y1)
Vector x1 y1 `cross` Vector x2 y2 = x1*y2 - x2*y1
Vector x1 y1 `dot` Vector x2 y2 = x1*x2 + y1*y2
Point x1 y1 `dist` Point x2 y2 = realToFrac $ sqrt $ (read $ show $ (x2-x1)^2 + (y2-y1)^2 :: Double)

eps = 1e-3

main = do
	[n, m] <- map read . words <$> getLine
	ps <- map ((\[x, y] -> Point x y) . map read . words) <$> replicateM n getLine
	ls <- map ((\[x1, y1, x2, y2] -> (Point x1 y1, Point x2 y2)) . map read . words) <$> replicateM m getLine

	let
		solve (lp, lq) = -- trace (show is) $
				((dist lp lq) *) $ sum $ map (\(z1, z2, _) -> z2 - z1) $ filter (\(_, _, c) -> c /= 0) $ zip3 zs (tail zs ++ zs) cs'
			where
				lv = vect lp lq
				is = sort $ catMaybes $ zipWith intersect ps $ tail ps ++ ps
				(zs, cs) = unzip is
				cs' :: [Int]
				cs' = scanl1 (+) cs

				intersect p q
					| s1 == s2 = Nothing
					| otherwise = Just (z, c)
					where
						sgn m = if m <= - eps then -1 else if m >= eps then 1 else 0
						s1 = sgn $ lv `cross` (vect lp p)
						s2 = sgn $ lv `cross` (vect lp q)

						z = ((vect lp p) `cross` pq) / (lv `cross` pq)
							where
								pq = vect p q

						c = (if s1 > s2 then 1 else -1) * (if s1 /= 0 && s2 /= 0 then 2 else 1)

	putStr $ unlines $ map (show . solve) ls


You are given the array $$$a$$$ consisting of $$$n$$$ elements and the integer $$$k \le n$$$.You want to obtain at least $$$k$$$ equal elements in the array $$$a$$$. In one move, you can make one of the following two operations:  Take one of the minimum elements of the array and increase its value by one (more formally, if the minimum value of $$$a$$$ is $$$mn$$$ then you choose such index $$$i$$$ that $$$a_i = mn$$$ and set $$$a_i := a_i + 1$$$);  take one of the maximum elements of the array and decrease its value by one (more formally, if the maximum value of $$$a$$$ is $$$mx$$$ then you choose such index $$$i$$$ that $$$a_i = mx$$$ and set $$$a_i := a_i - 1$$$). Your task is to calculate the minimum number of moves required to obtain at least $$$k$$$ equal elements in the array.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$ and the required number of equal elements. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

Print one integer — the minimum number of moves required to obtain at least $$$k$$$ equal elements in the array.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.List (group, sort)

main :: IO ()
main =
  interact $
    lines >>> map (words >>> map read) >>> solve >>> show >>> (++ "\n")

solve :: [[Integer]] -> Integer
solve [[n, k], a]
  | maximum (map snd groups) >= k = 0
  | otherwise = minimum $ map (get k) [lt, rt, comb]
  where
    groups = getGroups a
    lt = compute groups
    rt = reverse . compute . reverse $ groups
    comb = zip (repeat n) $ zipWith (+) (map snd lt) (map snd rt)

type PII = (Integer, Integer)

-- merge :: [PII] -> [PII] -> [PII]
-- merge = zipWith cadd
--   where
--     cadd (l, c) (l', c') = (l + l', c + c')

getGroups :: [Integer] -> [PII]
getGroups =
  map (\u -> (head u, fromIntegral $ length u))
    . group
    . sort

inf :: Integer
inf = 10 ^ 18

get :: Integer -> [(Integer, Integer)] -> Integer
get k =
  foldl min inf
    . map ((+ k) . uncurry (flip (-)))
    . filter ((>= k) . fst)

--         [(value,   length)]  -> [(length,  cost)]
compute :: [(Integer, Integer)] -> [(Integer, Integer)]
compute [] = []
compute [(_, l)] = [(l, 0)]
compute (x : x' : xs) = (len, cost) : res
  where
    res = compute (x' : xs)
    len = snd x + fst (head res)
    cost = snd (head res) + fst (head res) * abs (fst x - fst x')

import Control.Arrow
import Data.List

main = interact $
  lines >>> map (words >>> map read) >>> solve >>> show >>> (++"\n")

solve :: [[Integer]] -> Integer
solve [[n,k], a]
  | foldl1 max (map snd groups) >= k = 0
  | otherwise = foldl1 min $ map (get k) [lt, rt, comb]
  where
    groups = getgroups a
    lt = compute groups
    rt = reverse $ compute $ reverse groups
    comb = map(\(_, c) -> (n, c)) $ merge lt rt

merge a b = map (\((l, c), (l', c')) -> (l + l', c + c'))
             $ zip a b

getgroups a = map (\u -> (head u, fromIntegral $ length u))
               $ group $ sort a

inf = 1000000000000000000 :: Integer
get k xs = foldl min inf
            $ map (\(l, c) -> c - l + k)
              $ filter (\(l, _) -> l >= k) xs

--         [(value,   length)]  -> [(length,  cost)]
compute :: [(Integer, Integer)] -> [(Integer, Integer)]
compute [] = []
compute [(v, l)] = [(l, 0)]
compute (a:b:rest) = (len, cost) : res
  where
    res = compute (b:rest)
    len = snd a + fst (head res)
    cost = snd (head res) + (fst (head res)) * abs (fst a - fst b)


You are given two arrays of integers a and b. For each element of the second array bj you should find the number of elements in array a that are less than or equal to the value bj.

The first line contains two integers n, m (1 ≤ n, m ≤ 2·105) — the sizes of arrays a and b. The second line contains n integers — the elements of array a ( - 109 ≤ ai ≤ 109). The third line contains m integers — the elements of array b ( - 109 ≤ bj ≤ 109).

Print m integers, separated by spaces: the j-th of which is equal to the number of such elements in array a that are less than or equal to the value bj.

import Control.Applicative ((<$>))
import Data.ByteString.Char8 (getLine, words, readInt)
import Data.Maybe (fromJust)
import Data.List (sort)
import Data.Tuple (swap)
import Prelude hiding (words, getLine)

readInt' = fst . fromJust .readInt

main = do
	_ <- getLine
	as <- map readInt' . words <$> getLine
	bs <- map readInt' . words <$> getLine

	let
		as' = sort as
		bs' = sort $ zip bs [1..]

		solve n _ [] = []
		solve n [] (b:bs) = (n, snd b) : (solve n [] bs)
		solve n (a:as) (b:bs)
			| a > fst b = (n, snd b) : (solve n (a:as) bs)
			| otherwise = solve (n + 1) as (b:bs)

		zs = solve 0 as' bs'
		rs = map snd . sort $ map swap zs

	putStrLn . unwords $ map show rs

import Control.Applicative
import Control.Arrow
import Data.Function
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BS

main = do
	(n : _ : input) <- map fst . mapMaybe BS.readInt . BS.words <$> BS.getContents
	let (as, bs) = (first sort) . (second $ (sort . (flip zip) [0 ..])) $ splitAt n input
	putStrLn $ concatMap (($ " ") . (shows . fst)) $ sortBy (compare `on` snd) $ scanl1 (\(acc, _) (v, i) -> (acc + v, i)) $ f as bs

f _ [] 				= []
f [] bs				= map (first $ const 0) bs
f as ((b, i) : bs)	= let (smaller, larger) = span (<= b) as in (length smaller, i) : f larger bs

{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char (digitToInt)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.List (sort, scanl1, group)
import Data.Maybe (fromMaybe)
import Data.Functor ((<$>))

parseInt :: ByteString -> Int
parseInt s
  | BS.head s == '-' = negate (go 0 (BS.tail s))
  | otherwise = go 0 s
  where
    go i s
      | BS.null s = i
      | otherwise = go (i*10 + digitToInt (BS.head s)) (BS.tail s)

main :: IO ()
main = do
  l0 <- BS.getLine
  let [a, b] = map parseInt . BS.words $ l0
  l1 <- BS.getLine
  let as = group . sort . map parseInt . BS.words $ l1
  let lst = zip (map head as) (scanl1 (+) (map length as))
  let tree = IM.fromAscList lst
  l2 <- BS.getLine
  let bs = map parseInt . BS.words $ l2
  let answers = map (\b -> fromMaybe 0 (snd <$> IM.lookupLE b tree)) bs
  BS.putStrLn (BS.unwords (map (BS.pack . show) answers))

-- B. Queries about less or equal elements

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

compute :: [Int] -> [Int] -> [Int]
compute a b = map snd . sort $ zip (map snd bs) (compute' (sort a) (map fst bs) 0)
    where bs = sort $ zip b [0::Int ..]
          compute' :: [Int] -> [Int] -> Int -> [Int]
          compute' _ [] _ = []
          compute' [] b' x = map (const x) b'
          compute' a'@(ah:at) b'@(bh:bt) x
              | ah <= bh  = compute' at b' (x + 1)
              | otherwise = x : compute' a' bt x

main :: IO()
main =
    do  _ <- C.getLine
        a <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
        b <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
        putStrLn . unwords . map show $ compute a b

import Data.List as L
import qualified Data.Set as Set
import Data.ByteString.Char8 as LC

maxval = 2000000001

readInt :: String -> Int
readInt = read

solve :: Set.Set (Int, Int) -> [Int] -> [Int]
solve aset [] = []
solve aset (x:xs) = ans:(solve aset xs)
  where Just (_, ans) = Set.lookupLT (x, maxval) aset

convert :: [Int] -> [Int]
convert nums =
  let n = nums !! 0
      (alist, blist) = L.splitAt n (L.drop 2 nums)
  in  solve (Set.fromList $ L.zip ((-maxval):(L.sort alist)) [0..]) blist

readIntBs :: LC.ByteString -> Int
readIntBs bs = case LC.readInt bs of
                 Just (x, _) -> x
                 Nothing -> error "may Paul Hudak have mercy on my soul"

main = do
  input <- LC.getContents
  Prelude.putStrLn $ L.intercalate " " . L.map show . convert . (L.map readIntBs) . LC.words $ input


Vasya has a string $$$s$$$ of length $$$n$$$. He decides to make the following modification to the string:   Pick an integer $$$k$$$, ($$$1 \leq k \leq n$$$).  For $$$i$$$ from $$$1$$$ to $$$n-k+1$$$, reverse the substring $$$s[i:i+k-1]$$$ of $$$s$$$. For example, if string $$$s$$$ is qwer and $$$k = 2$$$, below is the series of transformations the string goes through:   qwer (original string)  wqer (after reversing the first substring of length $$$2$$$)  weqr (after reversing the second substring of length $$$2$$$)  werq (after reversing the last substring of length $$$2$$$)  Hence, the resulting string after modifying $$$s$$$ with $$$k = 2$$$ is werq. Vasya wants to choose a $$$k$$$ such that the string obtained after the above-mentioned modification is lexicographically smallest possible among all choices of $$$k$$$. Among all such $$$k$$$, he wants to choose the smallest one. Since he is busy attending Felicity 2020, he asks for your help.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds:   $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$;  in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

Each test contains multiple test cases.  The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 5000$$$). The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 5000$$$) — the length of the string $$$s$$$. The second line of each test case contains the string $$$s$$$ of $$$n$$$ lowercase latin letters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$5000$$$.

For each testcase output two lines: In the first line output the lexicographically smallest string $$$s'$$$ achievable after the above-mentioned modification.  In the second line output the appropriate value of $$$k$$$ ($$$1 \leq k \leq n$$$) that you chose for performing the modification. If there are multiple values of $$$k$$$ that give the lexicographically smallest string, output the smallest value of $$$k$$$ among them.

6
4
abab
6
qwerty
5
aaaaa
6
alaska
9
lfpbavjsm
1
p

abab
1
ertyqw
3
aaaaa
1
aksala
6
avjsmbpfl
5
p
1

NoteIn the first testcase of the first sample, the string modification results for the sample abab are as follows :   for $$$k = 1$$$ : abab  for $$$k = 2$$$ : baba  for $$$k = 3$$$ : abab  for $$$k = 4$$$ : babaThe lexicographically smallest string achievable through modification is abab for $$$k = 1$$$ and $$$3$$$. Smallest value of $$$k$$$ needed to achieve is hence $$$1$$$.

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

main = getLine >>= test.read
test 0 = return ()
test i = do
	n <- read <$> getLine
	s <- getLine
	let (string, number) =  minimum [(f n k s, k) | k <- [1..n]]
	putStrLn string
	print number
	test (i - 1)

f n k s = a ++ b where
	(c, a) = splitAt (k - 1) s
	b = if even (n - k) then reverse c else c

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

main = getLine >>= test.read
test 0 = return ()
test n = do
	n <- read <$> getLine
	s <- getLine
	print $ minimum [f n i s | i <- [1..n]]
	test (n - 1)

f n i s = a ++ b where
	(c, a) = splitAt (i - 1) s
	b = if even (n - i) then reverse c else c