On Bertown's main street n trees are growing, the tree number i has the height of ai meters (1 ≤ i ≤ n). By the arrival of the President of Berland these trees were decided to be changed so that their heights formed a beautiful sequence. This means that the heights of trees on ends (the 1st one and the n-th one) should be equal to each other, the heights of the 2-nd and the (n - 1)-th tree must also be equal to each other, at that the height of the 2-nd tree should be larger than the height of the first tree by 1, and so on. In other words, the heights of the trees, standing at equal distance from the edge (of one end of the sequence) must be equal to each other, and with the increasing of the distance from the edge by 1 the tree height must also increase by 1. For example, the sequences "2 3 4 5 5 4 3 2" and "1 2 3 2 1" are beautiful, and '1 3 3 1" and "1 2 3 1" are not. Changing the height of a tree is a very expensive operation, using advanced technologies invented by Berland scientists. In one operation you can choose any tree and change its height to any number, either increase or decrease. Note that even after the change the height should remain a positive integer, i. e, it can't be less than or equal to zero. Identify the smallest number of changes of the trees' height needed for the sequence of their heights to become beautiful.

The first line contains integer n (1 ≤ n ≤ 105) which is the number of trees. The second line contains integers ai (1 ≤ ai ≤ 105) which are the heights of the trees.

Print a single number which is the minimal number of trees whose heights will have to be changed for the sequence to become beautiful.

import Data.List
main = interact (show.solve.map read.words)
solve (n:vs) = n-(maximum.map length.group.sort.filter(>=0)) differ where
 d = div n 2
 base = if mod n 2==0 then [1..d]++[d,d-1..1] else [1..d]++[d+1]++[d,d-1..1]
 differ = zipWith (-) vs base

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

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

ints :: IO [Int]
ints = map read . words <$> getLine

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = read <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

solve :: Int -> [Int] -> Array Int Int
solve n lst =
  let arr0 = listArray (0, 10^5 - 1) (repeat 0)
      lst0 = zipWith (-) lst (beautiful n 0)
  in  foldl' vote arr0 lst0

solve2 :: Int -> [Int] -> [(Int, Int)]
solve2 n lst =
  let lst0 = zipWith (-) lst (beautiful n 0)
      gps  = map (head &&& length) (group (sort (filter (> 0) lst0)))
  in  gps

vote :: Array Int Int -> Int -> Array Int Int
vote arr vt
  | inRange (bounds arr) vt =
    let nextVal = (arr ! vt) + 1
    in  nextVal `seq` arr // [(vt, nextVal)]
  | otherwise = arr

beautiful n a0
  | odd n = [a0 .. at] ++ reverse [a0 .. at - 1]
  | otherwise  = [a0 .. at-1] ++ reverse [a0 .. at - 1]
  where at = a0 + n `div` 2

difference a b = length (filter id (zipWith (/=) a b))

main = do
  n <- int
  lst <- ints
  let val = fst (maximumBy (compare `on` snd) (assocs (solve n lst)))
      val2 = fst (maximumBy (compare `on` snd) (solve2 n lst))
--  print (solve n lst)
--  print val
--  print (difference (beautiful n val) lst)
--  print val2
  print (difference (beautiful n val2) lst)

import Data.List
buildSeq n = let left = [1..((n + 1) `div` 2)] in
	left ++ ((if n `mod` 2 == 1 then tail else id) $ reverse left)

main = do { nl <- getLine
	; s <- getLine
	; let {n = read nl; ll = map read $ words s}
	; let seq1 = buildSeq n
	; print (n - (head $reverse $ sort $ map length $ filter (\(h:_) -> h >= 0 ) $
		group $ sort $ zipWith (\x y -> x - y) ll seq1))
}

import Debug.Trace
import qualified Data.Map as M
import qualified Data.Foldable as F

count _ [] m = m
--count a b c | trace ("count " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
count n (x:xs) m
  | x >= n = M.insertWith (+) (x-n) 1 $ count (n+1) xs m
  | otherwise = count (n+1) xs m

solve n xs =
  let former = count 1 (take ((n+1)`div`2) xs) M.empty
      all = count 1 (take (n`div`2) $ reverse xs) former
  in if M.null all then 0 else n - (F.maximum all)

main = do
  n <- readLn
  xstr <- getLine
  let xs = map read $ words xstr
  print $ solve n xs

module Main where

import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array.ST
import Data.Array

main = do
    n <- read `liftM` getLine
    tree <- ( map read . words ) `liftM` getLine
    let tree' = map (\(t, c) -> t - c) $ zip tree ( [1 .. n`div`2] ++ reverse [1 .. (n+1)`div`2] )
        countArray = runSTArray $ do
            countArray <- newArray (0, 10^5) 0 :: ST s (STArray s Int Int)
            forM_ tree' $ \t ->
                if t >= 0
                    then readArray countArray t >>= writeArray countArray t . (1+)
                    else return ()
            return countArray
        fixN = maximum $ elems countArray

    putStrLn $ show ( n - fixN )

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

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

ints :: IO [Int]
ints = map read . words <$> getLine

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = read <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

solve :: Int -> [Int] -> Array Int Int
solve n lst =
  let arr0 = listArray (0, 10^5 - 1) (repeat 0)
      lst0 = zipWith (-) lst (beautiful n 0)
  in  foldl' vote arr0 lst0

solve2 :: Int -> [Int] -> [(Int, Int)]
solve2 n lst =
  let lst0 = zipWith (-) lst (beautiful n 0)
      gps  = map (head &&& length) (group (sort (filter (> 0) lst0)))
  in  gps

vote :: Array Int Int -> Int -> Array Int Int
vote arr vt
  | inRange (bounds arr) vt =
    let nextVal = (arr ! vt) + 1
    in  nextVal `seq` arr // [(vt, nextVal)]
  | otherwise = arr

beautiful n a0
  | odd n = [a0 .. at] ++ reverse [a0 .. at - 1]
  | otherwise  = [a0 .. at-1] ++ reverse [a0 .. at - 1]
  where at = a0 + n `div` 2

difference a b = length (filter id (zipWith (/=) a b))

main = do
  n <- int
  lst <- ints
  let val = fst (maximumBy (compare `on` snd) (assocs (solve n lst)))
      val2 = fst (maximumBy (compare `on` snd) (solve2 n lst))
--  print (solve n lst)
--  print val
--  print (difference (beautiful n val) lst)
  print val2
  print (difference (beautiful n val2) lst)

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

import Data.Char
import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

import Numeric

debug = flip trace
-- debug = const

int :: IO Int
int = read <$> getLine

ints :: IO [Int]
ints = map read . words <$> getLine

double :: IO Double
double = read <$> getLine

doubles :: IO [Double]
doubles = read <$> getLine

sum' = foldl' (+) 0
product' = foldl' (*) 1

fi = fromIntegral

solve :: Int -> [Int] -> Array Int Int
solve n lst =
  let arr0 = listArray (0, 10^5 - 1) (repeat 0)
      lst0 = zipWith (-) lst (beautiful n 0)
  in  foldl' vote arr0 lst0

solve2 :: Int -> [Int] -> [(Int, Int)]
solve2 n lst =
  let lst0 = zipWith (-) lst (beautiful n 0)
      gps  = map (head &&& length) (group (sort lst0))
  in  gps

vote :: Array Int Int -> Int -> Array Int Int
vote arr vt
  | inRange (bounds arr) vt =
    let nextVal = (arr ! vt) + 1
    in  nextVal `seq` arr // [(vt, nextVal)]
  | otherwise = arr

beautiful n a0
  | odd n = [a0 .. at] ++ reverse [a0 .. at - 1]
  | otherwise  = [a0 .. at-1] ++ reverse [a0 .. at - 1]
  where at = a0 + n `div` 2

difference a b = length (filter id (zipWith (/=) a b))

main = do
  n <- int
  lst <- ints
  let val = fst (maximumBy (compare `on` snd) (assocs (solve n lst)))
      val2 = fst (maximumBy (compare `on` snd) (solve2 n lst))
--  print (solve n lst)
--  print val
--  print (difference (beautiful n val) lst)
--  print val2
  print (difference (beautiful n val2) lst)

import Debug.Trace
import qualified Data.Map as M
import qualified Data.Foldable as F

count _ [] m = m
--count a b c | trace ("count " ++ show a ++ " " ++ show b ++ " " ++ show c) False = undefined
count n (x:xs) m
  | x >= n = M.insertWith (+) (x-n) 1 $ count (n+1) xs m
  | otherwise = count (n+1) xs m

solve n xs =
  let former = count 1 (take ((n+1)`div`2) xs) M.empty
      all = count 1 (take (n`div`2) xs) former
  in if M.null all then 0 else n - (F.maximum all)

main = do
  n <- readLn
  xstr <- getLine
  let xs = map read $ words xstr
  print $ solve n xs

module Main where

import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array.ST
import Data.Array

main = do
    n <- read `liftM` getLine
    tree <- ( map read . words ) `liftM` getLine
    let tree' = map (\(t, c) -> t - c) $ zip tree ( [1 .. n`div`2] ++ reverse [1 .. (n+1)`div`2] )
        countArray = runSTArray $ do
            countArray <- newArray (-10^5, 10^5) 0 :: ST s (STArray s Int Int)
            forM_ tree' $ \t ->
                readArray countArray t >>= writeArray countArray t . (1+)
            return countArray
        fixN = maximum $ elems countArray

    putStrLn $ show ( n - fixN )


One day Polycarpus got hold of two non-empty strings s and t, consisting of lowercase Latin letters. Polycarpus is quite good with strings, so he immediately wondered, how many different pairs of "x y" are there, such that x is a substring of string s, y is a subsequence of string t, and the content of x and y is the same. Two pairs are considered different, if they contain different substrings of string s or different subsequences of string t. Read the whole statement to understand the definition of different substrings and subsequences.The length of string s is the number of characters in it. If we denote the length of the string s as |s|, we can write the string as s = s1s2... s|s|.A substring of s is a non-empty string x = s[a... b] = sasa + 1... sb (1 ≤ a ≤ b ≤ |s|). For example, "code" and "force" are substrings or "codeforces", while "coders" is not. Two substrings s[a... b] and s[c... d] are considered to be different if a ≠ c or b ≠ d. For example, if s="codeforces", s[2...2] and s[6...6] are different, though their content is the same.A subsequence of s is a non-empty string y = s[p1p2... p|y|] = sp1sp2... sp|y| (1 ≤ p1 < p2 < ... < p|y| ≤ |s|). For example, "coders" is a subsequence of "codeforces". Two subsequences u = s[p1p2... p|u|] and v = s[q1q2... q|v|] are considered different if the sequences p and q are different.

The input consists of two lines. The first of them contains s (1 ≤ |s| ≤ 5000), and the second one contains t (1 ≤ |t| ≤ 5000). Both strings consist of lowercase Latin letters.

Print a single number — the number of different pairs "x y" such that x is a substring of string s, y is a subsequence of string t, and the content of x and y is the same. As the answer can be rather large, print it modulo 1000000007 (109 + 7).

NoteLet's write down all pairs "x y" that form the answer in the first sample: "s[1...1] t[1]", "s[2...2] t[1]", "s[1...1] t[2]","s[2...2] t[2]", "s[1...2] t[1 2]".

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Array.IO
import Control.Monad
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

modulus = 10^(9::Int)+7 :: Int

addm a b = (a+b) `mod` modulus

solve :: ByteString -> ByteString -> IO (Int,IOUArray (Int,Int) Int)
solve s t = do
  let n = BS.length s
      m = BS.length t
  arr <- newArray ((0,0),(n,m)) 0 :: IO (IOUArray (Int,Int) Int)
  -- fill in arr (1..n,m)
  forM_ [m-1,m-2..0] $ \j -> do
    forM_ [n-1,n-2..0] $ \i -> do
      c1 <- readArray arr (i,j+1)
      c2 <- if BS.index s i == BS.index t j
              then do v <- readArray arr (i+1,j+1); return $ 1+v
              else return 0
      writeArray arr (i,j) (addm c1 c2)
  let go !s i = readArray arr (i,0) >>= return . (addm s)
  answer <- foldM go 0 [0..n-1]
  return (answer,arr)

test s t = do
  (answer,arr) <- solve s t
  putStrLn $ "answer: " ++ show answer
  putStrLn $ "arr:"
  forM_ [0..BS.length s] $ \i -> do
    forM_ [0..BS.length t] $ \j -> do
      c <- readArray arr (i,j)
      putStr $ printf "%4d " c
    putStrLn ""

trimRight :: ByteString -> ByteString
trimRight bs = BS.take n bs
  where n = find (BS.length bs-1)
        find k | k < 0 = k+1
               | isSpace (BS.index bs k) = find (k-1)
               | otherwise = (k+1)

main = do
  s <- fmap trimRight BS.getLine
  t <- fmap trimRight BS.getLine
  (answer,arr) <- solve s t
  print answer

{-# LANGUAGE BangPatterns #-}

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Data.Array.IO
import Control.Monad
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

modulus = 10^(9::Int)+7 :: Int

addm a b = (a+b) `mod` modulus

solve :: ByteString -> ByteString -> IO (Int,IOUArray (Int,Int) Int)
solve s t = do
  let n = BS.length s
      m = BS.length t
  arr <- newArray ((0,0),(n,m)) 0 :: IO (IOUArray (Int,Int) Int)
  -- fill in arr (1..n,m)
  forM_ [m-1,m-2..0] $ \j -> do
    forM_ [n-1,n-2..0] $ \i -> do
      c1 <- readArray arr (i,j+1)
      c2 <- if BS.index s i == BS.index t j
              then do v <- readArray arr (i+1,j+1); return $ 1+v
              else return 0
      writeArray arr (i,j) (addm c1 c2)
  let go !s i = readArray arr (i,0) >>= return . (addm s)
  answer <- foldM go 0 [0..n-1]
  return (answer,arr)

test s t = do
  (answer,arr) <- solve s t
  putStrLn $ "answer: " ++ show answer
  putStrLn $ "arr:"
  forM_ [0..BS.length s] $ \i -> do
    forM_ [0..BS.length t] $ \j -> do
      c <- readArray arr (i,j)
      putStr $ printf "%4d " c
    putStrLn ""

main = do
  s <- BS.getLine
  t <- BS.getLine
  (answer,arr) <- solve s t
  print answer


Ivan plays an old action game called Heretic. He's stuck on one of the final levels of this game, so he needs some help with killing the monsters.The main part of the level is a large corridor (so large and narrow that it can be represented as an infinite coordinate line). The corridor is divided into two parts; let's assume that the point $$$x = 0$$$ is where these parts meet.The right part of the corridor is filled with $$$n$$$ monsters — for each monster, its initial coordinate $$$x_i$$$ is given (and since all monsters are in the right part, every $$$x_i$$$ is positive).The left part of the corridor is filled with crusher traps. If some monster enters the left part of the corridor or the origin (so, its current coordinate becomes less than or equal to $$$0$$$), it gets instantly killed by a trap.The main weapon Ivan uses to kill the monsters is the Phoenix Rod. It can launch a missile that explodes upon impact, obliterating every monster caught in the explosion and throwing all other monsters away from the epicenter. Formally, suppose that Ivan launches a missile so that it explodes in the point $$$c$$$. Then every monster is either killed by explosion or pushed away. Let some monster's current coordinate be $$$y$$$, then:  if $$$c = y$$$, then the monster is killed;  if $$$y < c$$$, then the monster is pushed $$$r$$$ units to the left, so its current coordinate becomes $$$y - r$$$;  if $$$y > c$$$, then the monster is pushed $$$r$$$ units to the right, so its current coordinate becomes $$$y + r$$$. Ivan is going to kill the monsters as follows: choose some integer point $$$d$$$ and launch a missile into that point, then wait until it explodes and all the monsters which are pushed to the left part of the corridor are killed by crusher traps, then, if at least one monster is still alive, choose another integer point (probably the one that was already used) and launch a missile there, and so on.What is the minimum number of missiles Ivan has to launch in order to kill all of the monsters? You may assume that every time Ivan fires the Phoenix Rod, he chooses the impact point optimally.You have to answer $$$q$$$ independent queries.

The first line contains one integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of queries. The first line of each query contains two integers $$$n$$$ and $$$r$$$ ($$$1 \le n, r \le 10^5$$$) — the number of enemies and the distance that the enemies are thrown away from the epicenter of the explosion. The second line of each query contains $$$n$$$ integers $$$x_i$$$ ($$$1 \le x_i \le 10^5$$$) — the initial positions of the monsters. It is guaranteed that sum of all $$$n$$$ over all queries does not exceed $$$10^5$$$.

For each query print one integer — the minimum number of shots from the Phoenix Rod required to kill all monsters.

NoteIn the first test case, Ivan acts as follows:   choose the point $$$3$$$, the first monster dies from a crusher trap at the point $$$-1$$$, the second monster dies from the explosion, the third monster is pushed to the point $$$7$$$;  choose the point $$$7$$$, the third monster dies from the explosion. In the second test case, Ivan acts as follows:   choose the point $$$5$$$, the first and fourth monsters die from the explosion, the second monster is pushed to the point $$$1$$$, the third monster is pushed to the point $$$2$$$;  choose the point $$$2$$$, the first monster dies from a crusher trap at the point $$$0$$$, the second monster dies from the explosion.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = readInt >>= flip replicateM solve >>= mapM_ print

solve = do
	[ n, r ] <- readInts
	xs <- reverse . map head . group . sort <$> readInts
	return $ solve' 0 r xs

solve' _ _ [] = 0
solve' d r (x:xs)
	| x <= d * r = 0
	| otherwise = 1 + solve' ( succ d ) r xs

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    line <- words <$> getLine
    let [n,r] = read <$> line :: [Int]
    line <- words <$> getLine
    let pos = Set.toDescList . Set.fromList $ (read :: String -> Int) <$> line
    let solve :: [Int] -> Int -> Int -> Int
        solve [] !_ !acc = acc
        solve (x:xs) dist acc
          | x <= dist = acc
          | otherwise = solve xs (dist + r) (acc + 1)
    print $ solve pos 0 0

import Data.List
import Control.Monad

nubOrd :: Eq a => [a] -> [a]
nubOrd = foldr removeDuplicates []
  where
    removeDuplicates :: Eq a => a -> [a] -> [a]
    removeDuplicates curr acc
      | null acc = curr:acc
      | head acc == curr = acc
      | otherwise = curr:acc

main :: IO ()
main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    [_,r] <- map read . words <$> getLine :: IO [Int]
    monsters <- map read . words <$> getLine :: IO [Int]
    let sorted = nubOrd $ sort monsters
    print $ foldr (minimumShots r) 0 sorted

  where
    minimumShots :: Int -> Int -> Int -> Int
    minimumShots rad curr shots
      | rad * shots < curr = shots + 1
      | otherwise = shots

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = readInt >>= flip replicateM solve >>= mapM_ print

solve = do
	[ n, r ] <- readInts
	xs <- reverse . map head . group . sort <$> readInts
	return $ solve' 0 xs

solve' _ [] = 0
solve' d (x:xs)
	| x <= d = 0
	| otherwise = 1 + solve' ( succ d ) xs


Manao's friends often send him new songs. He never listens to them right away. Instead, he compiles them into a playlist. When he feels that his mind is open to new music, he opens the playlist and starts to listen to the songs.Of course, there are some songs that Manao doesn't particuarly enjoy. To get more pleasure from the received songs, he invented the following procedure of listening to the playlist:  If after listening to some song Manao realizes that he liked it, then he remembers it and starts to listen to the next unlistened song.  If after listening to some song Manao realizes that he did not like it, he listens to all the songs he liked up to this point and then begins to listen to the next unlistened song. For example, if Manao has four songs in the playlist, A, B, C, D (in the corresponding order) and he is going to like songs A and C in the end, then the order of listening is the following:  Manao listens to A, he likes it, he remembers it.  Manao listens to B, he does not like it, so he listens to A, again.  Manao listens to C, he likes the song and he remembers it, too.  Manao listens to D, but does not enjoy it and re-listens to songs A and C. That is, in the end Manao listens to song A three times, to song C twice and songs B and D once. Note that if Manao once liked a song, he will never dislike it on a subsequent listening.Manao has received n songs: the i-th of them is li seconds long and Manao may like it with a probability of pi percents. The songs could get on Manao's playlist in any order, so Manao wants to know the maximum expected value of the number of seconds after which the listening process will be over, for all possible permutations of the songs in the playlist.

The first line contains a single integer n (1 ≤ n ≤ 50000). The i-th of the following n lines contains two integers, separated by a single space — li and pi (15 ≤ li ≤ 1000, 0 ≤ pi ≤ 100) — the length of the i-th song in seconds and the probability that Manao will like the song, in percents.

In a single line print a single real number — the maximum expected listening time over all permutations of songs. The answer will be considered valid if the absolute or relative error does not exceed 10 - 9.

NoteConsider the first test case. If Manao listens to the songs in the order in which they were originally compiled, the mathematical expectation will be equal to 467.5 seconds. The maximum expected value is obtained by putting the first song at the end of the playlist.Consider the second test case. The song which is 360 seconds long should be listened to first. The song 300 seconds long which Manao will dislike for sure should be put in the end.

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

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

main :: IO ()
main = do
  (_:input) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let a = pairs $ map fromIntegral input
      cmp (l1, p1) (l2, p2) = compare (l2 * p2 * (100 - p1)) (l1 * p1 * (100 - p2))
      b = sortBy cmp $ a
      gao (e, s) (l, p) = e `seq` s `seq` (e + l * p, s + l * 10000 + e * (100 - p))
      ans = snd $ foldl' gao (0, 0) b
  print $ (fromIntegral :: Int64 -> Double) ans / 10000

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List

toPairs (x:y:xys) = (x,y) : toPairs xys
toPairs _ = []

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

comp (l1,p1) (l2,p2) = compare (l2*p2*(100-p1)) $  l1*p1*(100-p2)

main :: IO ()
main = do
  _ <- getLine
  lps <- sortBy comp.toPairs.map readInteger.B.words <$> B.getContents
  let ans = 10000 * sum [l|(l,_)<-lps]
          + sum(zipWith (*) [l*p|(l,p)<-lps] (scanr1(+)[100-p|(_,p)<-tail lps]))
  putStrLn $ showAns ans

showAns 0 = "0"
showAns n
  | n>=10000 = let (xs,ys) = splitAt 4.reverse $ show n in reverse ys++"."++reverse xs
  | otherwise = "0."++ reverse(take 4(reverse (show n)++"0000"))

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

main = do
	tmp <- B.getContents
	let
		n:remain = map (fromIntegral.fst.fromJust.B.readInteger) $ B.words tmp
		get_tpl [] = []
		get_tpl (x:y:xs) = (x, 100-y) : (get_tpl xs)
		cmp (a,b) (c,d) = if (100-b)*a*d > (100-d)*c*b then
							LT else
								if (100-b)*a*d < (100-d)*c*b then GT else EQ
		songs = sortBy cmp $ get_tpl remain
		p_sum = sum $ map (\a -> snd a) songs
		ans = foldl (\var song -> ((fst var)+(fst song)+ (100 - (snd song))/100.0*(fst song)*((snd var)-(snd song))/100.0 , (snd var)-(snd song))) (0,p_sum) songs
	print $ fst ans

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
import Data.Ord

toPairs (x:y:xys) = (x,y) : toPairs xys
toPairs _ = []

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

comp = comparing $ uncurry (*)

main :: IO ()
main = do
  n <- readLn :: IO Int
  lps <- sortBy(flip comp).toPairs.map readInteger.B.words <$> B.getContents
  let ans = 10000 * sum [l|(l,_)<-lps]
          + sum(zipWith (*) [l*p|(l,p)<-lps] (scanr1(+)[100-p|(_,p)<-tail lps]))
  putStrLn $ showAns ans

showAns 0 = "0"
showAns n
  | n>=10000 = let (xs,ys) = splitAt 4.reverse $ show n in reverse ys++"."++reverse xs
  | otherwise = "0."++ reverse(take 4(reverse (show n)++"0000"))

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

main = do
	tmp <- B.getContents
	let
		n:remain = map (fromIntegral.fst.fromJust.B.readInteger) $ B.words tmp
		get_tpl [] = []
		get_tpl (x:y:xs) = (x, (100 - y)/100.0) : (get_tpl xs)
		cmp (a,b) (c,d) = if a*d > c*b then
							LT else
								if a*d < c*b then GT else EQ
		songs = sortBy cmp $ get_tpl remain
		p_sum = sum $ map (\a -> snd a) songs
		ans = foldl (\var song -> ((fst var)+(fst song)+(1.0 - (snd song))*(fst song)*((snd var)-(snd song)) , (snd var)-(snd song))) (0,p_sum) songs
	print $ fst ans


Theofanis has a riddle for you and if you manage to solve it, he will give you a Cypriot snack halloumi for free (Cypriot cheese).You are given an integer $$$n$$$. You need to find two integers $$$l$$$ and $$$r$$$ such that $$$-10^{18} \le l < r \le 10^{18}$$$ and $$$l + (l + 1) + \ldots + (r - 1) + r = n$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The first and only line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^{18}$$$).

For each test case, print the two integers $$$l$$$ and $$$r$$$ such that $$$-10^{18} \le l < r \le 10^{18}$$$ and $$$l + (l + 1) + \ldots + (r - 1) + r = n$$$.  It can be proven that an answer always exists. If there are multiple answers, print any.

test [] = []
test ints =
  let n = head ints
    in ((show (1-n)) ++ " " ++ (show n) ++ "\n") : (test $ tail ints)
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in putStr $ concat $ test ints

test [] = ""
test ints =
  let n = head ints
    in (show (1-n)) ++ " " ++ (show n) ++ "\n" ++ (test $ tail ints)
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in putStr $ test ints

test [] = do putStr ""
test ints = do
  let n = head ints
  putStr $ show (1-n)
  putStr " "
  print n
  test $ tail ints
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in test ints

test [] = putStrLn ""
test ints = do
  let n = head ints
    in putStrLn ((show (1-n)) ++ " " ++ (show n))
  test $ tail ints
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in test ints

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -O3 #-}
import           Control.Arrow             ((>>>))
import           Control.Monad             as M (guard, liftM, liftM3,
                                                 replicateM, replicateM_, when)
import qualified Control.Monad.ST          as ST
import qualified Control.Monad.Trans       as MS
import           Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Data.Array                as A (elems)
import qualified Data.Array.IArray         as IA
import qualified Data.Array.MArray         as MA
import qualified Data.Array.ST             as STA
import qualified Data.Array.Unboxed        as UA
import qualified Data.ByteString.Char8     as B8
import qualified Data.Foldable             as F
import           Data.Functor              ((<&>))
import           Data.Int                  (Int64)
import           Data.Ix                   (Ix (range))
import           Data.List                 (sort)
import           Data.Maybe                (fromJust, isJust)
import qualified Data.Traversable          as T
import           Data.Word                 (Word32)
import           Debug.Trace               as D
import           System.IO
import           Text.Printf               (printf)

readInt :: B8.ByteString -> Int
readInt = B8.readInt >>> fromJust >>> fst

readInt64 :: B8.ByteString -> Int64
readInt64 = B8.readInteger >>> fromJust >>> fst >>> fromInteger

updateArray :: (MA.MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
updateArray arr i func =
    MA.readArray arr i >>=
    MA.writeArray arr i <$> func

main :: IO ()
main = do
    test <- B8.getLine <&> readInt
    replicateM_ test $ do
        n <- B8.getLine <&> readInt64
        printf "%lld %lld\n" (-n + 1) n

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn  :: IO [Integer]

    (putStr . unlines . map solve) tcs

----------------------------------------------------------------------

solve n = show (0 - (n-1)) ++ " " ++ show n ++ " "

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative

type Input =  Integer
data Output = Output Integer Integer

solve :: Input -> Output
solve ( x) = Output (-x+1) x

output :: Output -> Bu.Builder
output (Output a b) = Bu.integerDec a <> Bu.string7 " " <> Bu.integerDec b <>  Bu.string7 "\n"

tcio :: StateT [B8.ByteString] Identity Bu.Builder
tcio = do
  ~[n] <- getIntegrals 1
  return $ output $ solve n

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let output = flip evalState bytestrings $ do
        ~[nTc] <- getIntegrals 1
        let answers = replicateM nTc tcio
        fmap mconcat answers
  B8.putStr $ Bu.toLazyByteString output

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> StateT [B8.ByteString] Identity [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext `const` B8.putStrLn

import Control.Monad
import Data.List
import Data.Int

calc :: Int64 -> [Int64]
calc n = [-n+1,n]

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int64
    putStrLn $ intercalate " " $ map show $ calc n

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -O3 #-}
import           Control.Arrow             ((>>>))
import           Control.Monad             as M (guard, liftM, liftM3,
                                                 replicateM, when, replicateM_)
import qualified Control.Monad.ST          as ST
import qualified Control.Monad.Trans       as MS
import           Control.Monad.Trans.Maybe (MaybeT (runMaybeT))
import qualified Data.Array                as A (elems)
import qualified Data.Array.IArray         as IA
import qualified Data.Array.MArray         as MA
import qualified Data.Array.ST             as STA
import qualified Data.Array.Unboxed        as UA
import qualified Data.ByteString.Char8     as B8
import qualified Data.Foldable             as F
import           Data.Functor              ((<&>))
import           Data.Int                  (Int64)
import           Data.Ix                   (Ix (range))
import           Data.List                 (sort)
import           Data.Maybe                (fromJust, isJust)
import qualified Data.Traversable          as T
import           Data.Word                 (Word32)
import           Debug.Trace               as D
import           System.IO
import           Text.Printf               (printf)

readInt :: B8.ByteString -> Int
readInt = B8.readInt >>> fromJust >>> fst

readInt64 :: B8.ByteString -> Int64
readInt64 = B8.readInteger >>> fromJust >>> fst >>> fromInteger

updateArray :: (MA.MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
updateArray arr i func =
    MA.readArray arr i >>=
    MA.writeArray arr i <$> func

main :: IO ()
main = do
    hSetBuffering stdout NoBuffering

    test <- B8.getLine <&> readInt
    replicateM_ test $ do
        n <- B8.getLine <&> readInt64
        printf "%lld %lld\n" (n - 1) n

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

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

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readLn  :: IO [Integer]

    (putStr . unlines . map solve) tcs

----------------------------------------------------------------------

solve n = show n ++ " " ++ show n


Many schoolchildren look for a job for the summer, and one day, when Gerald was still a schoolboy, he also decided to work in the summer. But as Gerald was quite an unusual schoolboy, he found quite unusual work. A certain Company agreed to pay him a certain sum of money if he draws them three identical circles on a plane. The circles must not interfere with each other (but they may touch each other). He can choose the centers of the circles only from the n options granted by the Company. He is free to choose the radius of the circles himself (all three radiuses must be equal), but please note that the larger the radius is, the more he gets paid. Help Gerald earn as much as possible.

The first line contains a single integer n — the number of centers (3 ≤ n ≤ 3000). The following n lines each contain two integers xi, yi ( - 104 ≤ xi, yi ≤ 104) — the coordinates of potential circle centers, provided by the Company. All given points are distinct.

Print a single real number — maximum possible radius of circles. The answer will be accepted if its relative or absolute error doesn't exceed 10 - 6.

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

import Data.List

import Control.Monad
import Control.Applicative

import Numeric

data C = C !Int !Int deriving (Eq, Ord)
data P = P !Int !Double deriving (Eq, Ord)

polar :: C -> P
polar (C x y) = P (x^2 + y^2) (atan2 (fromIntegral y) (fromIntegral x))

fix :: Double -> Double
fix = until (> -pi) (+ 2*pi) . until (<= pi) (subtract $ 2*pi)

(~>) :: C -> C -> C
C x0 y0 ~> C x1 y1 = C (x1 - x0) (y1 - y0)

solve :: [C]  -> Int
solve [] = 0
solve xs0 = maximum $ map solve' xs0
    where
        solve' x = go 0.0 0.0 xs
            where
                P _ α:xs = sortBy (flip compare) $ map (polar . (x ~>)) xs0

                go _ _ [] = 0
                go minA maxA (P r2 β:xs') =
                    let γ = fix $ β - α
                        minA' = min minA γ
                        maxA' = max maxA γ
                    in if maxA' - minA' >= pi / 3 then r2 else go minA' maxA' xs'

main :: IO ()
main = do
    n <- readLn
    xs <- replicateM n $ do { [x, y] <- map read . words <$> getLine; return $ C x y }
    putStrLn $ showFFloat Nothing (sqrt (fromIntegral $ solve xs) / 2) ""

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Data.List

import Control.Monad
import Control.Applicative

import Numeric

data C = C !Int !Int deriving (Eq, Ord)
data P = P !Int !Double deriving (Eq, Ord)

polar :: C -> P
polar (C x y) = P (x^2 + y^2) (atan2 (fromIntegral y) (fromIntegral x))

fix :: Double -> Double
fix = until (> -pi) (+ 2*pi) . until (<= pi) (subtract $ 2*pi)

(~>) :: C -> C -> C
C x0 y0 ~> C x1 y1 = C (x1 - x0) (y1 - y0)

solve :: [C]  -> Int
solve [] = 0
solve xs0 = maximum $ map solve' xs0
    where
        solve' x = go 0.0 0.0 xs
            where
                P _ α:xs = sortBy (flip compare) $ map (polar . (x ~>)) xs0

                go _ _ [] = 0
                go minA maxA (P r2 β:xs') =
                    let γ = fix $ β - α
                        minA' = min minA γ
                        maxA' = max maxA γ
                    in if maxA' - minA' >= pi / 3 then r2 else go minA' maxA' xs'

main :: IO ()
main = do
    n <- readLn
    xs <- replicateM n $ do { [x, y] <- map read . words <$> getLine; return $ C x y }
    putStrLn $ showFFloat Nothing (sqrt (fromIntegral $ solve xs) / 2) ""

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}

import Data.List

import Control.Monad
import Control.Applicative

import Numeric

data Cartesian = Cartesian !Int !Int deriving (Eq, Ord)
data Polar = Polar !Int !Double deriving (Eq, Ord)

polar :: Cartesian -> Polar
polar (Cartesian x y) = Polar (x^2 + y^2) (atan2 (fromIntegral y) (fromIntegral x))

fix :: Double -> Double
fix = until (> -pi) (+ 2*pi) . until (<= pi) (subtract $ 2*pi)

(~>) :: Cartesian -> Cartesian -> Cartesian
(Cartesian x0 y0) ~> (Cartesian x1 y1) = Cartesian (x1 - x0) (y1 - y0)

solve :: [Cartesian]  -> Int
solve [] = 0
solve xs0 = maximum $ map solve' xs0
    where
        solve' x = go 0.0 0.0 xs
            where
                (Polar _ α):xs = sortBy (flip compare) $ map (polar . (x ~>)) xs0

                go _ _ [] = 0
                go minA maxA (Polar r2 β:xs') =
                    let γ = fix $ β - α
                        minA' = min minA γ
                        maxA' = max maxA γ
                    in if maxA' - minA' >= pi / 3 then r2 else go minA' maxA' xs'

main :: IO ()
main = do
    n <- readLn
    xs <- replicateM n $ do { [x, y] <- map read . words <$> getLine; return $ Cartesian x y }
    putStrLn $ showFFloat Nothing (sqrt (fromIntegral $ solve xs) / 2) ""


A Pythagorean triple is a triple of integer numbers $$$(a, b, c)$$$ such that it is possible to form a right triangle with the lengths of the first cathetus, the second cathetus and the hypotenuse equal to $$$a$$$, $$$b$$$ and $$$c$$$, respectively. An example of the Pythagorean triple is $$$(3, 4, 5)$$$.Vasya studies the properties of right triangles, and he uses a formula that determines if some triple of integers is Pythagorean. Unfortunately, he has forgotten the exact formula; he remembers only that the formula was some equation with squares. So, he came up with the following formula: $$$c = a^2 - b$$$.Obviously, this is not the right formula to check if a triple of numbers is Pythagorean. But, to Vasya's surprise, it actually worked on the triple $$$(3, 4, 5)$$$: $$$5 = 3^2 - 4$$$, so, according to Vasya's formula, it is a Pythagorean triple.When Vasya found the right formula (and understood that his formula is wrong), he wondered: how many are there triples of integers $$$(a, b, c)$$$ with $$$1 \le a \le b \le c \le n$$$ such that they are Pythagorean both according to his formula and the real definition? He asked you to count these triples.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case consists of one line containing one integer $$$n$$$ ($$$1 \le n \le 10^9$$$).

For each test case, print one integer — the number of triples of integers $$$(a, b, c)$$$ with $$$1 \le a \le b \le c \le n$$$ such that they are Pythagorean according both to the real definition and to the formula Vasya came up with.

NoteThe only Pythagorean triple satisfying $$$c = a^2 - b$$$ with $$$1 \le a \le b \le c \le 9$$$ is $$$(3, 4, 5)$$$; that's why the answer for $$$n = 3$$$ is $$$0$$$, and the answer for $$$n = 6$$$ (and for $$$n = 9$$$) is $$$1$$$.

-- https://codeforces.com/problemset/problem/1487/D

module Main where

import qualified Data.Map as M

main :: IO ()
main = getInt >>= \numTestCase -> driver numTestCase

driver :: Int -> IO ()
driver 0 = return ()
driver n =
  getInt >>= \x ->
    let ans = solve x
     in print ans >> driver (n - 1)

getInt :: IO Int
getInt = getLine >>= \x -> return (readInt x)

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

perfectSquares :: Int -> [Int]
perfectSquares n = map (^ 2) $ takeWhile (<= n) [1 ..]

solve n = length as
  where
    as = takeWhile lessThan [3, 5 ..]
    lessThan x = ((x ^ 2) + 1) `div` 2 <= n

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = bshow . solve <$> popInt

solve n | cs ! 0 > n = 0
        | cs ! (sz - 1) <= n = sz
        | otherwise = go 0 (sz - 1)
  where
    go lb ub | ub - lb == 1 = ub
             | otherwise = let mid = (lb + ub) `quot` 2 in
                             case cs ! mid <= n of
                               True -> go mid ub
                               False -> go lb mid

cs = let l = takeWhile (\c -> c <= 10 ^ 9) $
             map (\k -> (2 * k + 1) ^ 2 `quot` 2 + 1) [1..] in
       listArray (0, length l - 1) l

sz = snd (bounds cs) + 1

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  t <- popInt
  B.unlines <$> replicateM t run1

run1 = bshow . solve <$> popInt

solve n = length $ takeWhile (\(a, b, c) -> c <= n) triples

triples = map f [3, 5..]
  where
    f a = let b = a ^ 2 `quot` 2 in
            (a, b, b + 1)

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    C.putStrLn $ C.pack $ show $ floor $ 0.5 * (sqrt (2.0 * fromIntegral n - 1) - 1) + 1e-10

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

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

type SIO = StateT P.ByteString IO

intSqrt :: Int -> Int
intSqrt x = let
  w = round (sqrt $ fromIntegral x :: Double)
  in  if  w*w > x  then  w-1  else  w

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    let
      w = intSqrt (2*n - 1)
    putInts [div (w-1) 2]

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n] <- getInts
    C.putStrLn $ C.pack $ show $ floor $ 0.5 * (sqrt (2.0 * fromIntegral n + 1) - 1) + 1e-10


One day n students come to the stadium. They want to play football, and for that they need to split into teams, the teams must have an equal number of people.We know that this group of people has archenemies. Each student has at most two archenemies. Besides, if student A is an archenemy to student B, then student B is an archenemy to student A.The students want to split so as no two archenemies were in one team. If splitting in the required manner is impossible, some students will have to sit on the bench.Determine the minimum number of students you will have to send to the bench in order to form the two teams in the described manner and begin the game at last.

The first line contains two integers n and m (2 ≤ n ≤ 100, 1 ≤ m ≤ 100) — the number of students and the number of pairs of archenemies correspondingly. Next m lines describe enmity between students. Each enmity is described as two numbers ai and bi (1 ≤ ai, bi ≤ n, ai ≠ bi) — the indexes of the students who are enemies to each other. Each enmity occurs in the list exactly once. It is guaranteed that each student has no more than two archenemies. You can consider the students indexed in some manner with distinct integers from 1 to n.

Print a single integer — the minimum number of students you will have to send to the bench in order to start the game.

import Control.Monad
import Control.Monad.ST
import qualified Data.Map as S

newtype State a = State {
    runState :: S.Map Int Int -> (a, S.Map Int Int)
  }

instance Monad State where
  return a = State $ \s -> (a, s)
  m >>= k  = State $ \s -> let (a', s') = runState m s in runState (k a') s'

get = State $ \s -> (s, s)

set i p = State $ \s -> ((), S.insert i p s)

find i
  | i < 0     = do
    r <- find $ -i
    return $ -r
  | otherwise = do
    ds <- get
    case S.lookup i $ ds of
      Nothing -> return i
      Just p  -> do
        r <- find p
        set i p
        return r

union i j = do
  i <- find i
  j <- find j
  if i < 0
    then union (-i) (-j)
    else
      if i + j == 0
        then return False
        else do
          set i j
          return True

withDisjoinSet f = fst $ (runState f) S.empty

gao n e = do
  s <- forM e $ \[i, j] -> do
    b <- union i $ -j
    return $ if b then 0 else 1
  return $ n - (n - sum s) `div` 2 * 2

main = do
  [n, m] <- fmap (map read . words) getLine
  e <- replicateM m $ fmap (map read . words) getLine
  print $ withDisjoinSet $ gao n e


Rudolf is on his way to the castle. Before getting into the castle, the security staff asked him a question:Given two binary numbers $$$a$$$ and $$$b$$$ of length $$$n$$$. How many different ways of swapping two digits in $$$a$$$ (only in $$$a$$$, not $$$b$$$) so that bitwise OR of these two numbers will be changed? In other words, let $$$c$$$ be the bitwise OR of $$$a$$$ and $$$b$$$, you need to find the number of ways of swapping two bits in $$$a$$$ so that bitwise OR will not be equal to $$$c$$$.Note that binary numbers can contain leading zeros so that length of each number is exactly $$$n$$$.Bitwise OR is a binary operation. A result is a binary number which contains a one in each digit if there is a one in at least one of the two numbers. For example, $$$01010_2$$$ OR $$$10011_2$$$ = $$$11011_2$$$.Well, to your surprise, you are not Rudolf, and you don't need to help him$$$\ldots$$$ You are the security staff! Please find the number of ways of swapping two bits in $$$a$$$ so that bitwise OR will be changed.

The first line contains one integer $$$n$$$ ($$$2\leq n\leq 10^5$$$) — the number of bits in each number. The second line contains a binary number $$$a$$$ of length $$$n$$$. The third line contains a binary number $$$b$$$ of length $$$n$$$.

Print the number of ways to swap two bits in $$$a$$$ so that bitwise OR will be changed.

import Control.Monad
import Data.List

main = do
	getLine
	a <- getLine
	b <- getLine
	let c = zip a b
	let cnt00 = fromIntegral . length $ elemIndices ('0', '0') c
	let cnt01 = fromIntegral . length $ elemIndices ('0', '1') c
	let cnt10 = fromIntegral . length $ elemIndices ('1', '0') c
	let cnt11 = fromIntegral . length $ elemIndices ('1', '1') c
	print $ cnt00 * cnt10 + cnt00 * cnt11 + cnt01 * cnt10

{-# LANGUAGE ExistentialQuantification #-}
module Main where
import Control.Applicative
import Data.Int

default (Int64)

main = interact exec
exec = show . (\[xs, ys] -> let (n0, n1) = runFold fc xs; in (\(n0', n1') -> n0' * n1 + n1' * n0 - n0' * n1') $ runFold fc $ map fst $ filter ((== '0') . snd) $ zip xs ys ) . tail . words
  where fc = liftA2 (,) (fcount '0') (fcount '1')

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin

fcount a = Fold (\c x -> c + fromIntegral (fromEnum $ x == a)) 0 id
fsum = Fold (+) 0 id
flength = Fold (flip (const succ)) 0 id

import Control.Monad
import Data.List

main = do
	getLine
	a <- getLine
	b <- getLine
	let c = zip a b
	let cnt00 = length $ elemIndices ('0', '0') c
	let cnt01 = length $ elemIndices ('0', '1') c
	let cnt10 = length $ elemIndices ('1', '0') c
	let cnt11 = length $ elemIndices ('1', '1') c
	print $ cnt00 * cnt10 + cnt00 * cnt11 + cnt01 * cnt10

{-# LANGUAGE ExistentialQuantification #-}
module Main where
import Control.Applicative

default (Int)

main = interact exec
exec = show . (\[xs, ys] -> let (n0, n1) = runFold fc xs; in (\(n0', n1') -> n0' * n1 + n1' * n0 - n0' * n1') $ runFold fc $ map fst $ filter ((== '0') . snd) $ zip xs ys ) . tail . words
  where fc = liftA2 (,) (fcount '0') (fcount '1')

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin

fcount a = Fold (\c x -> c + fromEnum (x == a)) 0 id
fsum = Fold (+) 0 id
flength = Fold (flip (const succ)) 0 id

{-# LANGUAGE ExistentialQuantification #-}
module Main where
import Control.Applicative

default (Int)

main = interact exec
exec = show . (\[xs, ys] -> let (nz, no) = runFold (liftA2 (,) (fcount '0') (fcount '1')) xs; ff = Fold (\c x -> c + if x == '0' then no else nz) 0 id; in runFold (liftA2 (-) ff (fcount '0')) $ map fst $ filter ((== '0') . snd) $ zip xs ys ) . tail . words

data Fold a b = forall x. Fold (x -> a -> x) x (x -> b)
data Pair a b = Pair !a !b
instance Functor (Fold a) where
  fmap f (Fold step begin done) = Fold step begin (f . done)
instance Applicative (Fold a) where
    pure b    = Fold (\() _ -> ()) () (\() -> b)
    (Fold stepL beginL doneL) <*> (Fold stepR beginR doneR) =
        let step (Pair xL xR) a = Pair (stepL xL a) (stepR xR a)
            begin = Pair beginL beginR
            done (Pair xL xR) = doneL xL (doneR xR)
        in  Fold step begin done
runFold (Fold step begin done) as = foldr (\a k x -> k $! step x a) done as begin

fcount a = Fold (\c x -> c + fromEnum (x == a)) 0 id
fsum = Fold (+) 0 id
flength = Fold (flip (const succ)) 0 id


The only difference between easy and hard versions is the size of the input.You are given a string $$$s$$$ consisting of $$$n$$$ characters, each character is 'R', 'G' or 'B'.You are also given an integer $$$k$$$. Your task is to change the minimum number of characters in the initial string $$$s$$$ so that after the changes there will be a string of length $$$k$$$ that is a substring of $$$s$$$, and is also a substring of the infinite string "RGBRGBRGB ...".A string $$$a$$$ is a substring of string $$$b$$$ if there exists a positive integer $$$i$$$ such that $$$a_1 = b_i$$$, $$$a_2 = b_{i + 1}$$$, $$$a_3 = b_{i + 2}$$$, ..., $$$a_{|a|} = b_{i + |a| - 1}$$$. For example, strings "GBRG", "B", "BR" are substrings of the infinite string "RGBRGBRGB ..." while "GR", "RGR" and "GGG" are not.You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 2000$$$) — the number of queries. Then $$$q$$$ queries follow. The first line of the query contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 2000$$$) — the length of the string $$$s$$$ and the length of the substring. The second line of the query contains a string $$$s$$$ consisting of $$$n$$$ characters 'R', 'G' and 'B'. It is guaranteed that the sum of $$$n$$$ over all queries does not exceed $$$2000$$$ ($$$\sum n \le 2000$$$).

For each query print one integer — the minimum number of characters you need to change in the initial string $$$s$$$ so that after changing there will be a substring of length $$$k$$$ in $$$s$$$ that is also a substring of the infinite string "RGBRGBRGB ...".

NoteIn the first example, you can change the first character to 'R' and obtain the substring "RG", or change the second character to 'R' and obtain "BR", or change the third, fourth or fifth character to 'B' and obtain "GB".In the second example, the substring is "BRG".

import Control.Monad
main = do
  q <- readLn
  replicateM_ q $ do
    [n,k] <- map read . words <$> getLine
    s <- getLine
    let f i = minimum $ zipWith (-) =<< drop k $ scanl (+) 0 $ map fromEnum $ zipWith (/=) s $ drop i $ cycle "RGB"
    print $ minimum $ map f [0..2]


Andrewid the Android is a galaxy-famous detective. He is now investigating the case of vandalism at the exhibition of contemporary art.The main exhibit is a construction of n matryoshka dolls that can be nested one into another. The matryoshka dolls are numbered from 1 to n. A matryoshka with a smaller number can be nested in a matryoshka with a higher number, two matryoshkas can not be directly nested in the same doll, but there may be chain nestings, for example, 1 → 2 → 4 → 5. In one second, you can perform one of the two following operations:  Having a matryoshka a that isn't nested in any other matryoshka and a matryoshka b, such that b doesn't contain any other matryoshka and is not nested in any other matryoshka, you may put a in b;  Having a matryoshka a directly contained in matryoshka b, such that b is not nested in any other matryoshka, you may get a out of b. According to the modern aesthetic norms the matryoshka dolls on display were assembled in a specific configuration, i.e. as several separate chains of nested matryoshkas, but the criminal, following the mysterious plan, took out all the dolls and assembled them into a single large chain (1 → 2 → ... → n). In order to continue the investigation Andrewid needs to know in what minimum time it is possible to perform this action.

The first line contains integers n (1 ≤ n ≤ 105) and k (1 ≤ k ≤ 105) — the number of matryoshkas and matryoshka chains in the initial configuration. The next k lines contain the descriptions of the chains: the i-th line first contains number mi (1 ≤ mi ≤ n), and then mi numbers ai1, ai2, ..., aimi — the numbers of matryoshkas in the chain (matryoshka ai1 is nested into matryoshka ai2, that is nested into matryoshka ai3, and so on till the matryoshka aimi that isn't nested into any other matryoshka). It is guaranteed that m1 + m2 + ... + mk = n, the numbers of matryoshkas in all the chains are distinct, in each chain the numbers of matryoshkas follow in the ascending order.

In the single line print the minimum number of seconds needed to assemble one large chain from the initial configuration.

NoteIn the first sample test there are two chains: 1 → 2 and 3. In one second you can nest the first chain into the second one and get 1 → 2 → 3.In the second sample test you need to disassemble all the three chains into individual matryoshkas in 2 + 1 + 1 = 4 seconds and then assemble one big chain in 6 seconds.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
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.Bits
import Data.Maybe
import Data.Monoid
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 = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . 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)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

{-
1 3 7 -> 2 + 2
2 5 -> 1 + 2
4 6 -> 1 + 2
-}

main = do
    (n,k) <- readIntPair
    as <- map (map readInt . B.words) . B.lines <$> B.getContents
    let ms = map tail as
    let m0:ms' = sortBy (\x y -> compare (head x) (head y)) ms
    let go x [] = 0
        go x (y:ys) | x == y - 1 = go y ys
                    | otherwise = 2 * length (y:ys)
    print $ go (head m0) (tail m0) + sum (map ((\x -> 2*x-1). length) ms')

import Data.List
import Control.Applicative
import Debug.Trace

solve :: Int -> [[Int]] -> Int
solve n chains =
  2 * (n - k) - (c - 1)
  where
    c = length chains
    k = length $ head $ group $ zipWith (\a -> \b -> a == b) [1..] $ head $ filter (\x -> head x == 1) $ chains

main = do
  [n, _] <- map read . words <$> getLine
  chains <- map (map read . tail . words) . lines <$> getContents
  putStrLn $ show $ solve n chains

module Main where

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

rl :: Read a => IO [a]
rl = fmap read . words <$> getLine

red i [] = []
red i (x:xs) | i == x = red (i+1) xs
             | otherwise = (x:xs)

main :: IO ()
main = do
  [n, k] <- rl :: IO [Int]
  fmap ((+1).sum) (forM [1..k] (const (fmap ((subtract 1).(* 2).length.red 1.tail) rl)))
    >>= print
  pure ()

import Control.Applicative

count [] _ = 0
count (l:ls) x
    | l == x = 1 + count ls (x+1)
    | otherwise = 0

main = do
    m <- read . head . tail . words <$> getLine :: IO Int
    l <- map (map read . words) . lines <$> getContents :: IO [[Int]]
    let s = sum $ do
        x <- tail <$> l
        let c = count x 1 `max` 1
        return $ length x - c + 1
    print $ (s-m) + (s-1)

start x (y:ys) = if y - x == 1 then 1 + start y ys else 0
start _ _ = 0
solve ([n, k]:xs) = 2 * n - k + 1 - 2 * (sum . map (start 0 . tail) $ xs)
main = interact $ show . solve . map (map (read :: String -> Int) . words) . lines

module Main where
import Prelude hiding (reads)
parse x = (takeWhile (/=' ') x) : if (null rest) then [] else parse (tail $ (dropWhile (/=' ')) x) where
    rest = dropWhile (/=' ') x
read' :: String -> Int
read' = read

reads :: Int -> IO [String]
reads 0 = return []
reads k = do
    x <- getLine
    xs <- reads $ k - 1
    return (x:xs)

arithm [] = 0
arithm [_] = 1
arithm (x:y:z) = if y-x==1 then 1 + arithm (y:z) else 1

main = do
    s <- getLine
    let [n,k] = map read' $ parse s
    ranges <- reads k
    let lists = map (tail . map read' . parse) ranges
    let [st] = filter ((==1) . head) lists
    let rest = filter ((/=1) . head) lists
    print $ (length st - arithm st) + sum (map (\x -> length x - 1) rest) + (n - arithm st)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
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.Bits
import Data.Maybe
import Data.Monoid
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 = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . 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)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

data Matryoshka = Mat { top  :: Int , chain :: [Int] } deriving Show

instance Eq Matryoshka where
    a == b = top a == top b

instance Ord Matryoshka where
    compare a b = compare (top a) (top b)

main = do
    (n,k) <- readIntPair
    as <- map (map readInt . B.words) . B.lines <$> B.getContents
    let ms = [ Mat (head l) (tail l)  | _:l <- as ]
    let go s | S.null s = 0
             | otherwise =
                let (m,s') = S.deleteFindMin s in
                let sub _ [] = if S.null s' then 0 else 1 +go s'
                    sub x (y:ys) | y == x + 1 = sub y ys
                    sub x ys =
                        let ns = map (\x -> Mat x []) ys in
                        1 + length ys + go (foldr S.insert s' ns)
                in sub (top m) (chain m)
    print $ go $ S.fromList ms

import Data.List
import Control.Applicative

solve :: Int -> [[Int]] -> Int
solve n chains =
  2 * (n - lsum) + (length chains) - 1
  where
    lsum = sum $ map l chains
    l (a:rst) = length $ head $ group $ zipWith (\a -> \b -> a == b) (a:rst) [a..]
    l [] = 0

main = do
  [n, _] <- map read . words <$> getLine
  chains <- map (map read . tail . words) . lines <$> getContents
  putStrLn $ show $ solve n chains

start x (y:ys) = if x == y then 1 + start (x + 1) ys else 0
start _ [] = 0
solve ([n, k]:xs) = 2 * n - k - 1 - 2 * (sum . map (start 1) . tail $ xs)
main = interact $ show . solve . map (map (read :: String -> Int) . words) . lines

start x (y:ys) = if y - x == 1 then 1 + start y ys else 0
start _ _ = 0
solve ([n, k]:xs) = 2 * n - k - 1 - 2 * (sum . map (start 0 . tail) $ xs)
main = interact $ show . solve . map (map (read :: String -> Int) . words) . lines

start x (y:ys) = if x == y then 1 + start y ys else 0
start _ [] = 0
solve ([n, k]:xs) = 2 * n - k - 1 - 2 * (sum . map (start 1) . tail $ xs)
main = interact $ show . solve . map (map (read :: String -> Int) . words) . lines