Jeevan has two arrays $$$a$$$ and $$$b$$$ of size $$$n$$$. He is fond of performing weird operations on arrays. This time, he comes up with two types of operations:  Choose any $$$i$$$ ($$$1 \le i \le n$$$) and increment $$$a_j$$$ by $$$1$$$ for every $$$j$$$ which is a multiple of $$$i$$$ and $$$1 \le j \le n$$$.  Choose any $$$i$$$ ($$$1 \le i \le n$$$) and decrement $$$a_j$$$ by $$$1$$$ for every $$$j$$$ which is a multiple of $$$i$$$ and $$$1 \le j \le n$$$. He wants to convert array $$$a$$$ into an array $$$b$$$ using the minimum total number of operations. However, Jeevan seems to have forgotten the value of $$$b_1$$$. So he makes some guesses. He will ask you $$$q$$$ questions corresponding to his $$$q$$$ guesses, the $$$i$$$-th of which is of the form:   If $$$b_1 = x_i$$$, what is the minimum number of operations required to convert $$$a$$$ to $$$b$$$? Help him by answering each question.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 2 \cdot 10^{5})$$$  — the size of arrays $$$a$$$ and $$$b$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, ..., a_n$$$ $$$(1 \le a_i \le 10^6)$$$. The third line contains $$$n$$$ integers $$$b_1, b_2, ..., b_n$$$ $$$(1 \le b_i \le 10^6$$$ for $$$i \neq 1$$$; $$$b_1 = -1$$$, representing that the value of $$$b_1$$$ is unknown$$$)$$$. The fourth line contains a single integer $$$q$$$ $$$(1 \le q \le 2 \cdot 10^{5})$$$  — the number of questions. Each of the following $$$q$$$ lines contains a single integer $$$x_i$$$ $$$(1 \le x_i \le 10^6)$$$  — representing the $$$i$$$-th question.

Output $$$q$$$ integers  — the answers to each of his $$$q$$$ questions.

NoteConsider the first test case.  $$$b_1 = 1$$$: We need to convert $$$[3, 7] \rightarrow [1, 5]$$$. We can perform the following operations:$$$[3, 7]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 1}}$$$ $$$[2, 6]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 1}}$$$ $$$[1, 5]$$$Hence the answer is $$$2$$$. $$$b_1 = 4$$$: We need to convert $$$[3, 7] \rightarrow [4, 5]$$$. We can perform the following operations: $$$[3, 7]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 2}}$$$ $$$[3, 6]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 2}}$$$ $$$[3, 5]$$$ $$$\xrightarrow[\text{increase}]{\text{i = 1}}$$$ $$$[4, 6]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 2}}$$$ $$$[4, 5]$$$Hence the answer is $$$4$$$. $$$b_1 = 3$$$: We need to convert $$$[3, 7] \rightarrow [3, 5]$$$. We can perform the following operations:$$$[3, 7]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 2}}$$$ $$$[3, 6]$$$ $$$\xrightarrow[\text{decrease}]{\text{i = 2}}$$$ $$$[3, 5]$$$Hence the answer is $$$2$$$.

import Control.Monad
import Data.Array
import Data.Array.ST
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    as <- readInts
    bs <- readInts
    ~[q] <- readInts
    xs <- concat <$> replicateM q readInts
    let a1 = head as
        diffs = tail $ zipWith (-) bs as
        mcs = runSTArray $ do
            la <- newArray (1, n) (Pair (-1) 0)
            writeArray la 1 (Pair 1 0)
            forM_ (zip [2..] diffs) $ \(i, d) -> do
                modifyArray' la i $ ladd (Pair 0 d)
                l <- readArray la i
                forM_ [2*i, 3*i .. n] $ \j -> do
                    modifyArray' la j (`lsub` l)
            pure la

        ladd (Pair m1 c1) (Pair m2 c2) = Pair (m1 + m2) (c1 + c2)
        lsub (Pair m1 c1) (Pair m2 c2) = Pair (m1 - m2) (c1 - c2)
        leval x (Pair m c) = m * x + c
        lzero ~(Pair 1 c) = -c

        (sum0, ls) = (s, ls') where
            s = sum [abs c | Pair m c <- elems mcs, m == 0]
            ls' = sortOn lzero [if m > 0 then Pair m c else Pair (-m) (-c) | Pair m c <- elems mcs, m /= 0]
        lsn = length ls
        lsa = listArray (1, lsn) ls
        pref = listArray (0, lsn) $ scanl ladd (Pair 0 0) ls
        doQry x = sum0 + r0 - r1 where
            i = binSearchA ((<0) . leval x) lsa
            r0 = leval x (pref!(i - 1))
            r1 = leval x (pref!lsn) - r0
    mapM_ (print . doQry . subtract a1) xs

data Pair = Pair {-# UNPACK #-} !Int {-# UNPACK #-} !Int deriving Show

modifyArray' :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray' a i f = do
    x <- readArray a i
    let x' = f x
    x' `seq` writeArray a i x'
{-# INLINE modifyArray' #-}

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

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

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

main :: IO ()
main = solve

{-# LANGUAGE TupleSections #-}
import Control.Monad
import Data.Array
import Data.Array.ST
import Data.Int
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    as <- readInts
    bs <- readInts
    ~[q] <- readInts
    xs <- concat <$> replicateM q readInts
    let a1 = head as
        diffs = tail $ zipWith (-) bs as
        add, mul :: Array Int Int64
        add = accumArray (+) 0 (1, n) $ do
            (i, d) <- zip [2..] diffs
            let d' = fromIntegral d
            (i, d') : map (,-d') [2*i, 3*i .. n]
        mul = runSTArray $ do -- Mobius function
            m <- newArray (1, n) (-1)
            writeArray m 1 1
            forM_ [2..n] $ \i -> do
                mi <- readArray m i
                forM_ [2*i, 3*i .. n] $ \j -> do
                    modifyArray' m j $ subtract mi
            pure m

        lzero (m, c) = -fromIntegral c / fromIntegral m :: Double
        ladd (m1, c1) (m2, c2) = (m1 + m2, c1 + c2)
        leval (m, c) x = m * x + c

        (sum0, ls) = (s, ls') where
            mcs = zip (elems mul) (elems add)
            s = sum [abs c | (m, c) <- mcs, m == 0]
            ls' = sortOn lzero [if m > 0 then (m, c) else (-m, -c) | (m, c) <- mcs, m /= 0]
        lsn = length ls
        lsa = listArray (1, lsn) ls
        pref = listArray (0, lsn) $ scanl ladd (0, 0) ls
        doQry x = sum0 + r0 - r1 where
            i = binSearchA ((> fromIntegral x) . lzero) lsa
            r0 = leval (pref!(i - 1)) x
            r1 = leval (pref!lsn) x - r0
    mapM_ (print . doQry . fromIntegral . subtract a1) xs

modifyArray' :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray' a i f = do
    x <- readArray a i
    let x' = f x
    x' `seq` writeArray a i x'
{-# INLINE modifyArray' #-}

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

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

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

main :: IO ()
main = solve

{-# LANGUAGE TupleSections #-}
import Control.Monad
import Data.Array
import Data.Array.ST
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    ~[n] <- readInts
    as <- readInts
    bs <- readInts
    ~[q] <- readInts
    xs <- concat <$> replicateM q readInts
    let a1 = head as
        diffs = tail $ zipWith (-) bs as
        add = accumArray (+) 0 (1, n) $ do
            (i, d) <- zip [2..] diffs
            (i, d) : map (,-d) [2*i, 3*i .. n]
        mul = runSTArray $ do -- Mobius function
            m <- newArray (1, n) (-1)
            writeArray m 1 1
            forM_ [2..n] $ \i -> do
                mi <- readArray m i
                forM_ [2*i, 3*i .. n] $ \j -> do
                    modifyArray' m j $ subtract mi
            pure m

        lzero (m, c) = -fromIntegral c / fromIntegral m :: Double
        ladd (m1, c1) (m2, c2) = (m1 + m2, c1 + c2)
        leval (m, c) x = m * x + c

        (sum0, ls) = (s, ls') where
            mcs = zip (elems mul) (elems add)
            s = sum [abs c | (m, c) <- mcs, m == 0]
            ls' = sortOn lzero [if m > 0 then (m, c) else (-m, -c) | (m, c) <- mcs, m /= 0]
        lsn = length ls
        lsa = listArray (1, lsn) ls
        pref = listArray (0, lsn) $ scanl ladd (0, 0) ls
        doQry x = sum0 + r0 - r1 where
            i = binSearchA ((> fromIntegral x) . lzero) lsa
            r0 = leval (pref!(i - 1)) x
            r1 = leval (pref!lsn) x - r0
    mapM_ (print . doQry . subtract a1) xs

modifyArray' :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray' a i f = do
    x <- readArray a i
    let x' = f x
    x' `seq` writeArray a i x'
{-# INLINE modifyArray' #-}

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

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

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

main :: IO ()
main = solve


Petya and Vasya are brothers. Today is a special day for them as their parents left them home alone and commissioned them to do n chores. Each chore is characterized by a single parameter — its complexity. The complexity of the i-th chore equals hi.As Petya is older, he wants to take the chores with complexity larger than some value x (hi > x) to leave to Vasya the chores with complexity less than or equal to x (hi ≤ x). The brothers have already decided that Petya will do exactly a chores and Vasya will do exactly b chores (a + b = n).In how many ways can they choose an integer x so that Petya got exactly a chores and Vasya got exactly b chores?

The first input line contains three integers n, a and b (2 ≤ n ≤ 2000; a, b ≥ 1; a + b = n) — the total number of chores, the number of Petya's chores and the number of Vasya's chores. The next line contains a sequence of integers h1, h2, ..., hn (1 ≤ hi ≤ 109), hi is the complexity of the i-th chore. The numbers in the given sequence are not necessarily different. All numbers on the lines are separated by single spaces.

Print the required number of ways to choose an integer value of x. If there are no such ways, print 0.

NoteIn the first sample the possible values of x are 3, 4 or 5.In the second sample it is impossible to find such x, that Petya got 3 chores and Vasya got 4.

import Data.List
import Control.Applicative

main = do
  [_, _, b] <- map read <$> (words <$> getLine)
  h         <- sort <$> map read <$> (words <$> getLine)
  print $ h !! b - h !! (b - 1)

import Data.List

main = do
    [n,a,b] <- return . map (read :: String->Int) . words =<< getLine
    hs <- return . sort . map (read :: String->Int) . words =<< getLine
    let p = take b hs
        q = drop b hs
        r = if head q /= last p
            then head q - last p
            else 0
    print r

import List

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

solve :: (Int, Int) -> [Int] -> Int
solve (a, b) hs  =  hb' - hb
  where
    hs'  =  sort hs
    hb   =  hs' !! (b - 1)
    hb'  =  hs' !! b

main :: IO ()
main  =  do
    [n, a, b] <- Main.reads
    hs <- Main.reads
    print $ solve (a, b) hs

import Data.List

solve :: (Int, Int) -> [Int] -> Int
solve (a, b) sp  = x2 - x1
	where
	   sp' = sort sp
	   x2 = sp' !! b
	   x1 = sp' !! (b - 1)

main :: IO ()
main  =  do
    [n, a, b] <- (getLine >>= (return . map (read::String->Int) . words))
    sp <- (getLine >>= (return . map (read::String->Int) . words))
    print $ solve (a, b) sp

import List
s(n:a:b:t)=(\(x:y:_)->y-x).drop(b-1).sort$t
main=interact$show.s.map read.words

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

main = do
		[n,x,y]<- map read <$> words <$> getLine ::IO [Int]
		a<-reverse <$> sort <$> map read <$> words <$> getLine ::IO [Int]
		let x1 = last $ take x a
		let x2 = head $ drop x a
		print $ x1-x2

import Data.List

main::IO ()
main = do
  cs <- getContents
  (putStr .show.solve.parseIn) cs

parseIn::String->(Int,[Int])
parseIn s =  (a, reverse $ sort $ map read (words hs))
    where
      [ss,hs] = lines s
      [_,a,_] = map read (words ss)

solve::(Int,[Int])->Int
solve (a,hs) = he!!(a-1)-tt
    where
    (he,(tt:_)) = splitAt a hs

import Data.List
main=putStrLn.show.slv.(map (\x -> map read $ words x)).(take 2).lines=<<getContents
slv [al,bl] = s!!(a-1) - s!!(a)
    where
        n = head al :: Int
        a = head.tail $ al
        b = head.tail.tail $ al
        s = reverse.sort $ bl

import Data.List
solve chores a _ =
      let (v, p) = splitAt a (reverse $ sort chores)
      in (last v) - (head p)

main = do
  [n, a, b] <- (getLine >>= (return . map (read::String->Int) . words))
  chores <- (getLine >>= (return . map (read::String->Int) . words))
  print $ solve chores a b

import Data.List

main = do
    [n,a,b] <- return . map (read :: String->Int) . words =<< getLine
    hs <- return . group . sort . map (read :: String->Int) . words =<< getLine
    let p = concat $ take b hs
        q = concat $ drop b hs
        r = if length p == b
            then head q - last p
            else 0
    print r


Given an array $$$a$$$ of length $$$n$$$, find another array, $$$b$$$, of length $$$n$$$ such that:  for each $$$i$$$ $$$(1 \le i \le n)$$$ $$$MEX(\{b_1$$$, $$$b_2$$$, $$$\ldots$$$, $$$b_i\})=a_i$$$. The $$$MEX$$$ of a set of integers is the smallest non-negative integer that doesn't belong to this set.If such array doesn't exist, determine this.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_n$$$ ($$$0 \le a_i \le i$$$) — the elements of the array $$$a$$$. It's guaranteed that $$$a_i \le a_{i+1}$$$ for $$$1\le i < n$$$.

If there's no such array, print a single line containing $$$-1$$$. Otherwise, print a single line containing $$$n$$$ integers $$$b_1$$$, $$$b_2$$$, $$$\ldots$$$, $$$b_n$$$ ($$$0 \le b_i \le 10^6$$$) If there are multiple answers, print any.

NoteIn the second test case, other answers like $$$[1,1,1,0]$$$, for example, are valid.

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

main = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ unwords . map show $ reverse $ solve (repeat (10 ^ 6)) $ reverse as

solve (q : qs) [0] = [q]
solve (q : qs) [_] = [0]
solve (q : qs) (a : a' : as)
  | a == a' = q : solve qs (a' : as)
  | otherwise = a' : solve ([a' + 1 .. a - 1] ++ q : qs) (a' : as)

import Data.Function
import Data.List

main :: IO ()
main = do
  n <- readLn
  xs <- (map read.words) <$> getLine
  putStrLn $ (unwords.map show) $ solve n xs

solve :: Int -> [Int] -> [Int]
solve n xs
  | ok xs = f n xs
  | otherwise = [-1]

ok :: [Int] -> Bool
ok xs = not $ any (\(a,b) -> a>b) z
  where
    z = zip xs [1..]

f :: Int -> [Int] -> [Int]
f n xs = g n 0 zzzs rest
  where
    (vals,inds) = unzip $ map head $ groupBy ((==) `on` fst) $ zip xs [0..]
    zzzs = zip vals (tail inds)
    rest = h xs [0..]
    g m c [] (r:rs)
      | m == c = []
      | otherwise = r : g n (c+1) [] rs
    g m c ((v,i):vis) (r:rs)
      | i == c = v : g m (c+1) vis (r:rs)
      | otherwise = r :g m (c+1) ((v,i):vis) rs
    g _ _ _ [] = undefined

h :: [Int] -> [Int] -> [Int]
h (l:ls) (x:xss)
  | l == x = h ls xss
  | l > x = x : h (l:ls) xss
  | l < x = h ls (x:xss)
h [] xss = xss
h _ [] = undefined
h (_:_) (_:_) = undefined

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

main = do
  getLine
  as <- map read . words <$> getLine
  putStrLn $ unwords . map show $ reverse $ solve (repeat (10 ^ 6)) $ reverse as

solve (q : qs) [0] = [q]
solve (q : qs) [_] = [0]
solve (q : qs) (a : a' : as)
  | a == a' = q : solve qs (a' : as)
  | otherwise = a' : solve ([a' + 1 .. a - 1] ++ qs) (a' : as)


Harry Potter is on a mission to destroy You-Know-Who's Horcruxes. The first Horcrux that he encountered in the Chamber of Secrets is Tom Riddle's diary. The diary was with Ginny and it forced her to open the Chamber of Secrets. Harry wants to know the different people who had ever possessed the diary to make sure they are not under its influence.He has names of n people who possessed the diary in order. You need to tell, for each person, if he/she possessed the diary at some point before or not.Formally, for a name si in the i-th line, output "YES" (without quotes) if there exists an index j such that si = sj and j < i, otherwise, output "NO" (without quotes).

First line of input contains an integer n (1 ≤ n ≤ 100) — the number of names in the list. Next n lines each contain a string si, consisting of lowercase English letters. The length of each string is between 1 and 100.

Output n lines each containing either "YES" or "NO" (without quotes), depending on whether this string was already present in the stream or not. You can print each letter in any case (upper or lower).

NoteIn test case 1, for i = 5 there exists j = 3 such that si = sj and j < i, which means that answer for i = 5 is "YES".

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

main = putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n pop
  return $ unlines $ map (bool "NO" "YES") $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve = ap (zipWith elem) inits

solve2 :: [String] -> [String] -> [String]
solve2 _ [] = []
solve2 seen words@(w:ws) =
  if elem w seen
  then "YES" : (solve2 seen ws)
  else "NO" : (solve2 (w:seen) ws)

solve words = solve2 [] words

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

main = do
  (n:_) <- readInts
  c <- getContents
  putStrLn (unlines $ solve (take n $ lines c))

f ::String-> [String]->String
f str []="NO"
f str (x:xs)
    |str==x="YES"
    |otherwise=f str xs

f2::[String]->[String]->[String]
f2 _ []=[]
f2 xs (y:ys)=(f y xs):(f2 (y:xs) ys)

main = do
       e<-getLine
       es<-getContents
       let xs=lines es
       mapM_ putStrLn $ f2 [] xs

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

main = sol . lines <$> (getLine *> getContents) >>= mapM_ putStrLn

sol = snd . foldl' f (S.empty,[])

f (a,ss) s = if S.member s a
    then (a,ss++["YES"])
    else (S.insert s a, ss++["NO"])

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

possessedDiaryBefore :: [String] -> [String]
possessedDiaryBefore = fst . foldl (\(a, b) c -> if elem c b
                                                 then (a ++ ["YES"], b)
                                                 else (a ++ ["NO"],  b ++ [c])) ([], [])

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    mapM_ putStrLn $ possessedDiaryBefore xs

import Control.Monad( replicateM)

main = do
    n_ <- readLn::IO Int
    names_ <- replicateM n_ getLine
    let
	proc []		    = []
	proc (n:ames)
	  | n `elem` ames   = True:(proc ames)
	  | otherwise	    = False:(proc ames)

	putStrLn' True = putStrLn "Yes"
	putStrLn' False = putStrLn "No"

    mapM_ putStrLn' . reverse . proc $ reverse names_

import Data.Set
run set ans (x:xs) | x `member` set = run set ("YES":ans) xs
                   | otherwise = run (x `insert` set) ("NO":ans) xs
run _ ans [] = reverse ans
main = getLine >> getContents >>= putStr . unlines . run empty [] . lines

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

process _ [] = putStr ""
process x (a:as) | elem a x = do
				putStrLn "YES"
				process x as
		 | otherwise = do
				putStrLn "NO"
				process (a:x) as

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

import Data.Set (empty,insert,member)

presence :: (Ord a) => [a] -> [Bool]
presence = tail.fst.unzip.scanl (\(_,set) x -> (member x set, insert x set)) (False,empty)

readInt :: String -> Int
readInt = read

showBool :: Bool -> String
showBool False = "NO"
showBool True = "YES"

main = do
    n <- fmap readInt getLine
    s <- fmap words getContents
    putStrLn.unlines.map showBool.presence $ s


Bob wants to put a new bargaining table in his office. To do so he measured the office room thoroughly and drew its plan: Bob's office room is a rectangular room n × m meters. Each square meter of the room is either occupied by some furniture, or free. A bargaining table is rectangular, and should be placed so, that its sides are parallel to the office walls. Bob doesn't want to change or rearrange anything, that's why all the squares that will be occupied by the table should be initially free. Bob wants the new table to sit as many people as possible, thus its perimeter should be maximal. Help Bob find out the maximum possible perimeter of a bargaining table for his office.

The first line contains 2 space-separated numbers n and m (1 ≤ n, m ≤ 25) — the office room dimensions. Then there follow n lines with m characters 0 or 1 each. 0 stands for a free square meter of the office room. 1 stands for an occupied square meter. It's guaranteed that at least one square meter in the room is free.

Output one number — the maximum possible perimeter of a bargaining table for Bob's office room.

import Control.Monad (liftM, replicateM)
import Data.Array (Array, (!), array, bounds)
import Data.List (intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

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

type Map  =  Array (Int, Int) Char

solve :: Map -> Int
solve map  =  maximum
  [2 * (c-a+1 + d-b+1) | a <- [1..n], b <- [1..m], c <- [a..n], d <- [b..m], empty a b c d]
  where
    (n, m)  =  snd $ bounds map
    empty a b c d  =  and ['0' == map ! (i, j) | i <- [a..c], j <- [b..d]]

readMap :: Int -> Int -> IO Map
readMap n m  =  do
    lines  <-  replicateM n getLine
    return $ array ((1, 1), (n, m)) [((i+1, j+1), lines !! i !! j) | i <- [0..n-1], j <- [0..m-1]]

main :: IO ()
main  =  do
    [n, m]  <-  reads
    map  <-  readMap n m
    print $ solve map

module Main where

import List
import Numeric
import Array
import Monad

--readSeq readSpec 0 str = ([], str)
{-
readSeq readSpec n str = (x:xs, s)
                 where
                   (x,stail) = head (readSigned readSpec str)
                   (xs, s) = readSeq readSpec (n-1) stail
-}
--readDecs = readSeq readDec
--readFloats = readSeq readFloat

readSeqAll readSpec str = map (fst . head . readSigned readSpec) (words str)
readDecsAll = readSeqAll readDec
--readFloatsAll = readSeqAll readFloat

readStrings::Int -> IO [String]
readStrings 0 =
    do
      return([])
readStrings n =
    do
      l <- getLine
      tail <- readStrings (n-1)
      return(l : tail)

findMax arr = maximum [ 2*((i2-i+1)+(j2-j+1))
                        | i <- range(1,n),
                        j <- range(1,m),
                        i2 <- range(i,n),
                        j2 <- range(j,m),
                        sum [arr!(ii,jj) | ii <- range(i,i2), jj <- range(j,j2)] == 0]
              where
                ((1,1),(n,m)) = bounds arr

charToInt x =
    case x of
      '0' -> 0
      '1' -> 1

map2 f l = map (\x-> map f x) l

makeArray (n,m) lst = array ((1,1),(n,m))
                      [ ((i,j), (lst !! (i-1)) !! (j-1))
                        | i <- range(1,n), j <- range(1,m)]

main =
    do
      sz <- getLine
      let [n,m] = readDecsAll sz
      strs <- readStrings n
      putStrLn (show (findMax (makeArray (n,m) (map2 charToInt strs))))


Vanya has a table consisting of 100 rows, each row contains 100 cells. The rows are numbered by integers from 1 to 100 from bottom to top, the columns are numbered from 1 to 100 from left to right. In this table, Vanya chose n rectangles with sides that go along borders of squares (some rectangles probably occur multiple times). After that for each cell of the table he counted the number of rectangles it belongs to and wrote this number into it. Now he wants to find the sum of values in all cells of the table and as the table is too large, he asks you to help him find the result.

The first line contains integer n (1 ≤ n ≤ 100) — the number of rectangles. Each of the following n lines contains four integers x1, y1, x2, y2 (1 ≤ x1 ≤ x2 ≤ 100, 1 ≤ y1 ≤ y2 ≤ 100), where x1 and y1 are the number of the column and row of the lower left cell and x2 and y2 are the number of the column and row of the upper right cell of a rectangle.

In a single line print the sum of all values in the cells of the table.

NoteNote to the first sample test:Values of the table in the first three rows and columns will be as follows:121121110So, the sum of values will be equal to 10.Note to the second sample test:Values of the table in the first three rows and columns will be as follows:222222222So, the sum of values will be equal to 18.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	n <- readInt
	res <- replicateM n $ do
		[ x1, y1, x2, y2 ] <- readInts
		return $ ( x2 - x1 + 1 ) * ( y2 - y1 + 1 )
	print $ sum res

-- http://codeforces.com/problemset/problem/552/A

getLines :: Int -> IO [String]
getLines 0 = return []
getLines n = do
	x <- getLine
	xs <- getLines (n-1)
	return (x:xs)

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

type Coord = (Int, Int)
type Rect = (Coord, Coord)

toRect :: [Int] -> Rect
toRect (x1:y1:x2:y2:[]) = ((x1, y1), (x2, y2))

getArea :: Rect -> Int
getArea ((x1, y1), (x2, y2)) = (x2 - x1 + 1) * (y2 - y1 + 1)

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

main :: IO()
main = do

	n <- fmap read $ getLine :: IO Int
	rects <-
		fmap (map toRect) $
		fmap (map . map $ read) $
		fmap (map words) $
		getLines n :: IO [Rect]

	let
		result = sum $ map getArea rects

	putStrLn $ show result

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  n <- readLn
  rs <- replicateM n getInts

  print $ sum $ map (\[x1, y1, x2, y2] -> (x2-x1+1)*(y2-y1+1)) rs

import Control.Exception.Base
import Data.Functor

readInts :: IO [Int]
readInts = map read <$> words <$> getContents

main = readInts >>= putStrLn . show . solve

solve :: [Int] -> Int
solve xs = assert (length xs `mod` 4 == 1) $ solve' $ tail xs

solve' :: [Int] -> Int
solve' [] = 0
solve' (x1:y1:x2:y2:ps) = (x2-x1+1) * (y2-y1+1) + solve' ps

main = interact $ show . f . map read . tail . words
f [] = 0
f (x:y:xx:yy:s) = (xx-x+1)*(yy-y+1) + f s

module Main where

import Control.Applicative

parseRect :: String -> [Int]
parseRect = map read . words

area :: [Int] -> Int
area [l, b, r, t] = (r - l + 1) * (t - b + 1)
area _ = 0

main :: IO ()
main = do
  _ <- getLine
  rects <- lines <$> getContents
  let areas = map (area . parseRect) rects
  print (sum areas)

import Data.Char (ord)
import Data.List

main :: IO ()
main = print . solve . parse =<< getContents

parse = map parseLine . tail . lines
        where parseLine l = let [x1, y1, x2, y2] = map read . words $ l
                            in  (x1, y1, x2, y2)

solve :: [(Int, Int, Int, Int)] -> Int
solve = sum . map (\(x1,y1,x2,y2) -> (x2-x1+1)*(y2-y1+1))

answer::[[Int]] -> Int
answer a = sum (map rectsize a)
rectsize::[Int] -> Int
rectsize a = ((a !! 2)-(a !! 0)+1)* ((a !! 3)-(a !! 1)+1)
readInput::Int -> IO [[Int]]
readInput 0 = return []
readInput n = do
  w <- getLine
  let a = [read c::Int|c <- (words w)]
  next <- readInput(n-1)
  return ([a] ++ next)
main = do
  w <- getLine
  let n = read w::Int
  a <- readInput n
  print $ answer a

-- Codeforces 552A

import qualified Data.Map.Strict as Map

-- use Data.Map to storage the matrix

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    getContents >>= print . sum . Map.elems . solve Map.empty . map read . words

solve :: Map.Map (Int, Int) Int -> [Int] -> Map.Map (Int, Int) Int
solve m [] = m
solve m (x1:y1:x2:y2:xs) = solve newm xs where
    newm = foldl (\mm loc -> Map.insertWith (+) loc 1 mm) m [(i, j) | i <- [x1..x2], j <- [y1..y2]]

main = interact solve

solve input = show answer
    where
        numbers = (map read . words) input
        n = head numbers
        rects = (four_by_four.tail) numbers
        answer = foldr folder 0 rects
        folder (x1,y1,x2,y2) ccount = ccount + ((y2-y1+1)*(x2-x1+1))

four_by_four [] = []
four_by_four (x1:y1:x2:y2:xs) = (x1,y1,x2,y2):(four_by_four xs)

import Data.Functor ((<$>))

main :: IO ()
main = print =<< solve <$> (map (map read <$> words) <$> tail <$> lines <$> getContents)

solve :: [[Int]] -> Int
solve = sum . map area

area :: [Int] -> Int
area [x1, y1, x2, y2] = (x2 - x1 + 1) * (y2 - y1 + 1)
area _ = undefined

import Control.Applicative

main = do
    getLine
    inp <- lines <$> getContents
    print $ sum $ do
        x <- inp
        let l = map read . words $ x :: [Int]
        return $ (l!!2 - l!!0 + 1) * (l!!3 - l!!1 + 1)

import Control.Applicative

process [] n = n
process ([a,b,c,d]:as) n = process as (n+(c-a+1)*(d-b+1))

main=do
	getLine
	a<- map (map read). map words . lines <$> getContents ::IO [[Int]]
	print $ process a 0

main :: IO()
main = print . solve . parse =<< getContents

parse = map parseLine . tail . lines
	where parseLine l = let [x1,y1,x2,y2] = map read . words $ l
			    in (x1,y1,x2,y2)

solve = sum . map area
	where area (x1,y1,x2,y2) = (x2 - x1 + 1) * (y2 - y1 +1)

main :: IO ()
main = print . solve . parse =<< getContents

parse = map parseLine . tail . lines
        where parseLine l = let [x1, y1, x2, y2] = map read . words $ l
                            in  (x1, y1, x2, y2)

solve = sum . map area
        where area (x1, y1, x2, y2) = (x2 - x1 + 1) * (y2 - y1 + 1)

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Array.ST
import Data.STRef
import Control.Monad.ST
import Control.Monad
import Control.Applicative
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.Function as F
import Debug.Trace

import qualified Numeric as N

readInt :: String -> Int
readInt ('-':s) = case N.readDec s of [(n, "")] -> -n
readInt s = case N.readDec s of [(n, "")] -> n

readFloat :: String -> Double
readFloat ('-':s) = case N.readFloat s of [(x, "")] -> -x
readFloat s = case N.readFloat s of [(x, "")] -> x

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

main = do
  [n] <- getInts
  res <- sum <$> (forM [1..n] $ \_ -> do
    [a, b, c, d] <- getInts
    return $ ((c - a + 1) * (d - b + 1)))
  print res

parseInput input = zs where
    xs = tail $ lines input
    ys = map words xs
    zs = [map read y :: [Int] | y <- ys]

area [a, b, c, d] = (c - a + 1) * (d - b + 1)
solve xs = sum $ map area xs

main = do
    input <- getContents
    let xs = parseInput input
    print $ solve xs


Define the score of some binary string $$$T$$$ as the absolute difference between the number of zeroes and ones in it. (for example, $$$T=$$$ 010001 contains $$$4$$$ zeroes and $$$2$$$ ones, so the score of $$$T$$$ is $$$|4-2| = 2$$$).Define the creepiness of some binary string $$$S$$$ as the maximum score among all of its prefixes (for example, the creepiness of $$$S=$$$ 01001 is equal to $$$2$$$ because the score of the prefix $$$S[1 \ldots 4]$$$ is $$$2$$$ and the rest of the prefixes have a score of $$$2$$$ or less).Given two integers $$$a$$$ and $$$b$$$, construct a binary string consisting of $$$a$$$ zeroes and $$$b$$$ ones with the minimum possible creepiness.

The first line contains a single integer $$$t$$$ $$$(1\le t\le 1000)$$$  — the number of test cases. The description of the test cases follows. The only line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$ 1 \le a, b \le 100$$$)  — the numbers of zeroes and ones correspondingly.

For each test case, print a binary string consisting of $$$a$$$ zeroes and $$$b$$$ ones with the minimum possible creepiness. If there are multiple answers, print any of them.

NoteIn the first test case, the score of $$$S[1 \ldots 1]$$$ is $$$1$$$, and the score of $$$S[1 \ldots 2]$$$ is $$$0$$$.In the second test case, the minimum possible creepiness is $$$1$$$ and one of the other answers is 101.In the third test case, the minimum possible creepiness is $$$3$$$ and one of the other answers is 0001100.

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ solve
solve = map read . words <$> getLine >>= \[a,b]->
    putStrLn $ take (2 * min a b) (cycle "01") ++
        if a < b then replicate (b - a) '1' else replicate (a - b) '0'

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

solve (a,b) = ans
  where
    ans | (a < b)    = rr a "01" ++ r (b-a) '1'
        | otherwise  = rr b "01" ++ r (a-b) '0'

    r = replicate
    rr n = concat . r n

import Control.Monad (forM_, join)
import Data.Functor.Compose

main :: IO ()
main = do
    t <- readLn :: IO Integer
    forM_ [1..t] $ const solve

readArray :: Read a => IO [a]
readArray =
    fmap read <$> (words <$> getLine)

solve :: IO ()
solve = do
    [x, y] <- readArray :: IO [Int]
    putStrLn $ str x y '0'
    return ()

str :: Int -> Int -> Char -> String
str x y c
    | x + y == 0        = ""
    | c == '0' && y > 0 = "1" ++ str x (y-1) '1'
    | c == '0'          = "0" ++ str (x-1) y '1'
    | c == '1' && x > 0 = "0" ++ str (x-1) y '0'
    | c == '1'          = "1" ++ str x (y-1) '0'
    | otherwise = undefined

module Main where

import Control.Monad (forM_, liftM2)
import qualified Data.ByteString.Char8 as C
import Data.Foldable (toList)
import Data.List (sort, transpose)
import Data.Maybe (fromJust)
import Data.Sequence (chunksOf, fromList)

solve :: Int -> C.ByteString -> String
solve i xs = concat (replicate mini "01") ++ replicate left more
  where
    [x, y] = map (fst . fromJust . C.readInt) (C.words xs)
    mini = min x y
    left = abs $ x - y
    more = if x > y then '0' else '1'

main :: IO ()
main = do
  n <- read <$> getLine
  mapM_ (\x -> putStrLn . solve x =<< C.getLine) [1 .. n]

import Control.Monad (replicateM_)
import Data.List (sort)
main = read <$> getLine >>= flip replicateM_ solve
solve = sort . map read . words <$> getLine >>= \[a',b']->
    let [(a,aa),(b,bb)] = sort [(a','0'),(b','1')] in
        let (d,m) = b `divMod` a in
            putStrLn . (++(replicate m bb)) . take (d*a+a) . cycle $
                replicate d bb ++ [aa]

import Control.Monad (replicateM_)
import Data.Tuple
data Unordered a = Unordered a
instance Eq (Unordered a) where
    (==) _ _ = True
instance Ord (Unordered a) where
    compare _ _ = EQ
deunorder (Unordered x) = x
main = read <$> getLine >>= flip replicateM_ solve
solve = map (read::String->Int) . words <$> getLine >>= \ [a,b] ->
    putStrLn . deunorder . snd . minimum . map (key creep) $ create a b
key f x = (f x, Unordered x)
creep :: String -> Int
creep = maximum . map (abs . uncurry (-)) . scanr (\c (a, b) -> if c == '0' then (a+1,b) else (a, b+1)) (0,0)
create :: Int -> Int -> [String]
create 0 b = [replicate b '1']
create a 0 = [replicate a '0']
create a b = (map ('0':) $ create (a - 1) b) ++ (map ('1':) . create a $ b - 1)

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

solve (a,b) = ans
  where
    ans | (a < b)    = rr a "01" ++ r (b-a) '0'
        | otherwise  = rr b "01" ++ r (a-b) '1'

    r = replicate
    rr n = concat . r n

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [a,b] <- ri
        return (a,b)
    mapM_ (putStrLn.show.solve) tcs

solve (a,b) = (a,b,ans)
  where
    ans | (a < b)    = r a "01" ++ r (b-a) "1"
        | otherwise  = r b "01" ++ r (a-b) "0"

    r n = concat . replicate n

import Control.Monad (forM_, join)
import Data.Functor.Compose

main :: IO ()
main = do
    t <- readLn :: IO Integer
    forM_ [1..t] $ const solve

readArray :: Read a => IO [a]
readArray =
    fmap read <$> (words <$> getLine)

solve :: IO ()
solve = do
    [x, y] <- readArray :: IO [Int]
    putStrLn $ str x y '0'
    return ()

str :: Int -> Int -> Char -> String
str x y c
    | x + y == 0        = ""
    | c == '0' && y > 0 = "1" ++ str x (y-1) '1'
    | c == '0'          = "0" ++ str (x-1) y '1'
    | c == '1' && x > 0 = "0" ++ str (x-1) y '0'
    | c == '1'          = "0" ++ str x (y-1) '0'
    | otherwise = undefined

import Control.Monad (forM_, join)
import Data.Functor.Compose

main :: IO ()
main = do
    t <- readLn :: IO Integer
    forM_ [1..t] $ const solve

readArray :: Read a => IO [a]
readArray =
    fmap read <$> (words <$> getLine)

solve :: IO ()
solve = do
    [x, y] <- readArray :: IO [Int]
    print $ str x y '0'
    return ()

str :: Int -> Int -> Char -> String
str x y c
    | x + y == 0        = ""
    | c == '0' && y > 0 = "1" ++ str x (y-1) '1'
    | c == '0'          = "0" ++ str (x-1) y '1'
    | c == '1' && x > 0 = "0" ++ str (x-1) y '0'
    | c == '1'          = "0" ++ str x (y-1) '0'
    | otherwise = undefined

module Main where

import Control.Monad (forM_, liftM2)
import qualified Data.ByteString.Char8 as C
import Data.Foldable (toList)
import Data.List (sort, transpose)
import Data.Maybe (fromJust)
import Data.Sequence (chunksOf, fromList)

solve :: Int -> C.ByteString -> String
solve i xs = concat (replicate common "01") ++ replicate mini more
  where
    [x, y] = map (fst . fromJust . C.readInt) (C.words xs)
    common = abs $ x - y
    mini = min x y
    more = if x > y then '0' else '1'

main :: IO ()
main = do
  n <- read <$> getLine
  mapM_ (\x -> putStrLn . solve x =<< C.getLine) [1 .. n]


Mainak has an array $$$a_1, a_2, \ldots, a_n$$$ of $$$n$$$ positive integers. He will do the following operation to this array exactly once:  Pick a subsegment of this array and cyclically rotate it by any amount.  Formally, he can do the following exactly once:  Pick two integers $$$l$$$ and $$$r$$$, such that $$$1 \le l \le r \le n$$$, and any positive integer $$$k$$$.  Repeat this $$$k$$$ times: set $$$a_l=a_{l+1}, a_{l+1}=a_{l+2}, \ldots, a_{r-1}=a_r, a_r=a_l$$$ (all changes happen at the same time). Mainak wants to maximize the value of $$$(a_n - a_1)$$$ after exactly one such operation. Determine the maximum value of $$$(a_n - a_1)$$$ that he can obtain.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 50$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 2000$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 999$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case, output a single integer — the maximum value of $$$(a_n - a_1)$$$ that Mainak can obtain by doing the operation exactly once.

Note In the first test case, we can rotate the subarray from index $$$3$$$ to index $$$6$$$ by an amount of $$$2$$$ (i.e. choose $$$l = 3$$$, $$$r = 6$$$ and $$$k = 2$$$) to get the optimal array: $$$$$$[1, 3, \underline{9, 11, 5, 7}] \longrightarrow [1, 3, \underline{5, 7, 9, 11}]$$$$$$ So the answer is $$$a_n - a_1 = 11 - 1 = 10$$$. In the second testcase, it is optimal to rotate the subarray starting and ending at index $$$1$$$ and rotating it by an amount of $$$2$$$. In the fourth testcase, it is optimal to rotate the subarray starting from index $$$1$$$ to index $$$4$$$ and rotating it by an amount of $$$3$$$. So the answer is $$$8 - 1 = 7$$$.

{-# LANGUAGE
  ScopedTypeVariables,
  BangPatterns
#-}

import qualified Data.ByteString.Char8 as C
import Data.List
import Data.Maybe
import Control.Monad
import Control.Monad.Writer
import Data.Semigroup
import Data.Coerce

tryall :: [Int] -> Writer (Max Int) ()
tryall as = do
  let a1 = head as
      an = last as
      apply = tell . coerce
  mapM_ (apply . (an -)) as
  mapM_ (apply . (subtract a1)) as
  mapM_ apply $ zipWith (-) as (tail as)

solve :: [Int] -> Int
solve = coerce . execWriter . tryall

main = do
  [!t] <- readInts
  replicateM_ t $ do
    _ <- readInts
    readInts >>= print . solve

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

import Data.Array
import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>=
        \n -> map read . words <$> getLine >>=
        print . maxVal . listArray (1, n)

maxVal :: Array Int Int -> Int
maxVal a = maximum [rotateWhole a, rotateStart a, rotateEnd a]

rotateWhole a = let (1, n) = bounds a
                    f a m i = if (m > (a!i - a!(i+1))) then m else  a!i - a!(i+1)
                in
                  foldl (f a) (a!n - a!1) [1..(n-1)]

rotateStart a = let (1, n) = bounds a in
                  (foldl max (a!1) (elems a)) - (a!1)

rotateEnd a = let (1, n) = bounds a in
                (a!n) - (foldl min (a!n) (elems a))


There are two sisters Alice and Betty. You have $$$n$$$ candies. You want to distribute these $$$n$$$ candies between two sisters in such a way that:  Alice will get $$$a$$$ ($$$a > 0$$$) candies;  Betty will get $$$b$$$ ($$$b > 0$$$) candies;  each sister will get some integer number of candies;  Alice will get a greater amount of candies than Betty (i.e. $$$a > b$$$);  all the candies will be given to one of two sisters (i.e. $$$a+b=n$$$). Your task is to calculate the number of ways to distribute exactly $$$n$$$ candies between sisters in a way described above. Candies are indistinguishable.Formally, find the number of ways to represent $$$n$$$ as the sum of $$$n=a+b$$$, where $$$a$$$ and $$$b$$$ are positive integers and $$$a>b$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of a test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^9$$$) — the number of candies you have.

For each test case, print the answer — the number of ways to distribute exactly $$$n$$$ candies between two sisters in a way described in the problem statement. If there is no way to satisfy all the conditions, print $$$0$$$.

NoteFor the test case of the example, the $$$3$$$ possible ways to distribute candies are:  $$$a=6$$$, $$$b=1$$$;  $$$a=5$$$, $$$b=2$$$;  $$$a=4$$$, $$$b=3$$$.

process :: Int -> Int
process n = (n-1) `div` 2

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    t <- fmap readInt getLine
    ns <- fmap (map readInt.words) getContents
    mapM_ (print.process) ns

main :: IO ()
main = do
    getLine
    answers <- map (solve . read) <$> lines <$> getContents
    mapM_ print answers

solve :: Int -> Int
solve x = (x - 1) `div` 2

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        x <- readLn
        print $ (x - 1) `div` 2

import Control.Monad (replicateM_)

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

solve :: Int -> Int
solve = flip div 2 . subtract 1

solve :: Int -> Int
solve n = (n-1) `div` 2

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

import Control.Monad (forM_)

main = do
	n <- fmap read getLine
	forM_ [1..n] $ \i -> do
		k <- fmap read getLine
		print ((k-1) `div` 2)

testCases :: Integer -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readInts
    print $ if odd n then n `div` 2 else n `div` 2 - 1
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

readInts :: IO [Integer]
readInts = map read . words <$> getLine

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

onecase= do
		a<- read <$>  getLine ::IO Int
		print $ div (a-1)  2

main = do
		n<-read <$> getLine :: IO Int
		replicateM_ n onecase


Iahub is very proud of his recent discovery, propagating trees. Right now, he invented a new tree, called xor-tree. After this new revolutionary discovery, he invented a game for kids which uses xor-trees.The game is played on a tree having n nodes, numbered from 1 to n. Each node i has an initial value initi, which is either 0 or 1. The root of the tree is node 1.One can perform several (possibly, zero) operations on the tree during the game. The only available type of operation is to pick a node x. Right after someone has picked node x, the value of node x flips, the values of sons of x remain the same, the values of sons of sons of x flips, the values of sons of sons of sons of x remain the same and so on.The goal of the game is to get each node i to have value goali, which can also be only 0 or 1. You need to reach the goal of the game by using minimum number of operations.

The first line contains an integer n (1 ≤ n ≤ 105). Each of the next n - 1 lines contains two integers ui and vi (1 ≤ ui, vi ≤ n; ui ≠ vi) meaning there is an edge between nodes ui and vi.  The next line contains n integer numbers, the i-th of them corresponds to initi (initi is either 0 or 1). The following line also contains n integer numbers, the i-th number corresponds to goali (goali is either 0 or 1).

In the first line output an integer number cnt, representing the minimal number of operations you perform. Each of the next cnt lines should contain an integer xi, representing that you pick a node xi.

{-# 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.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 = 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 ()
inf = maxBound `div` 2 :: Int

newtype State s a = State { runState :: s -> (a,s) }

instance Functor (State s) where
    fmap f m = State $ runState m >>> first f

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

instance Applicative (State s) where
    pure = return
    (<*>) = ap

get :: State s s
get = State $ id &&& id
put :: s -> State s ()
put = State . const . ((),)
modify :: (s -> s) -> State s ()
modify = State . (.) ((,) ())
evalState :: State s a -> s -> a
evalState = (.) fst . runState
execState :: State s a -> s -> s
execState = (.) snd . runState

main = do
    n <- readLn
    (_es,_init:_goal:_) <- splitAt (n-1) . B.lines <$> B.getContents
    let es = map (B.words >>> map readInt >>> l2p) _es
        init = map readInt $ B.words _init
        goal = map readInt $ B.words _goal
    let l = solve n es init goal
    print $ length l
    putStr $ unlines $ map show l

i2b 0 = False
i2b 1 = True
xor False False = False
xor False True = True
xor True False = True
xor True True = False

solve :: Int -> [(Int,Int)] -> [Int] -> [Int] -> [Int]
solve n es init goal = execState (go True False False (-1) 1) []
    where
    g :: Array Int [Int]
    g = accumArray (flip (:)) [] (1,n) $ es ++ map swap es
    ia :: UArray Int Bool
    ia = listArray (1,n) (map i2b init)
    ga :: UArray Int Bool
    ga = listArray (1,n) (map i2b goal)
    go :: Bool -> Bool -> Bool -> Int -> Int -> State [Int] ()
    go True ep op prev v = do
        let ns = [ u | u <- g ! v, u /= prev ]
        let b = (ia ! v) `xor` ep
        if b == ga ! v then
            forM_ ns $ go False ep op v
        else do
            modify (v:)
            forM_ ns $ go False (not ep) op v
    go False ep op prev v = do
        let ns = [ u | u <- g ! v, u /= prev ]
        let b = (ia ! v) `xor` op
        if b == ga ! v then
            forM_ ns $ go True ep op v
        else do
            modify (v:)
            forM_ ns $ go True ep (not op) v

import Data.Array.IO
import Control.Monad
import Data.IORef
import Data.Tuple
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

parse :: B.ByteString -> [Int]
parse s = do
    q <- B.splitWith (\x-> x == 13 || x == 10 || x == 32) s
    if B.length q == 0 then
        []
    else
        return $ foldl' (\a b-> a * 10 + (fromIntegral b) - (ord '0')) 0 (B.unpack q)

readNum :: IORef [a] -> IO a
readNum nums = do
    x:xs <- readIORef nums
    writeIORef nums xs
    return x

traverse :: IOArray Int (Bool, [Int]) -> IORef [Int] -> Int -> Int -> Bool -> Bool -> IO ()
traverse g res current parent prevFlag prevPrevFlag = do
    (flag, edges) <- readArray g current
    let shouldChange = flag /= prevPrevFlag
    if shouldChange then do
        resc <- readIORef res
        writeIORef res (current:resc)
    else return ()
    forM_ edges $ \next -> do
        if next == parent then return ()
        else traverse g res next current flag prevFlag

main :: IO ()
main = do
    nums0 <- B.getContents
    nums <- newIORef $ parse nums0
    n <- readNum nums
    g <- newListArray (1, n) (replicate n (False, []))
    forM_ [1..(n-1)] $ \i-> do
        a <- readNum nums
        b <- readNum nums
        (af, aa) <- readArray g a
        writeArray g a (af, (b:aa))
        (bf, bb) <- readArray g b
        writeArray g b (bf, (a:bb))
    forM_ [1..n] $ \i-> do
        a <- readNum nums
        (af, aa) <- readArray g i
        writeArray g i (a > 0, aa)
    forM_ [1..n] $ \i-> do
        a <- readNum nums
        (af, aa) <- readArray g i
        writeArray g i (af /= (a > 0), aa)
    z <- readIORef nums
    res <- newIORef []
    traverse g res 1 (-1) False False
    resc <- readIORef res
    putStrLn $ show $ length resc
    forM_ resc $ putStrLn.show

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  n <- readLn
  (uvs, rest) <- splitAt(2*(n-1)).map readInt.B.words <$> B.getContents
  let (start, goal) = splitAt n $ map (1==) rest
  let nodes = solve n (mkTree . mkGraph (0,n-1) $ parse uvs)
                      (listArray (0,n-1) start)
                      (listArray (0,n-1) goal)
  print $ length nodes
  putStr.unlines $ map (show.(1+)) nodes

type Vertex = Int
type Edge = (Vertex, Vertex)
type Graph = Array Vertex [Vertex]
type Path = [Vertex]

mkGraph :: (Int, Int) -> [Edge] -> Graph
mkGraph bnd edges = unsafeAccumArray (flip (:)) [] bnd edges

mkTree :: Graph -> Graph
mkTree gr = runSTArray $ do
  vis  <- newArray (bounds gr) False :: ST s (STUArray s Vertex Bool)
  tree <- newArray (bounds gr) []    :: ST s (STArray s Vertex [Vertex])
  let visit v = do
        forM_ (unsafeAt gr v) $ \nv -> do
          visited <- unsafeRead vis nv
          unless visited $ do
            unsafeWrite vis nv True
            unsafeModify tree v (nv:)
            visit nv
  unsafeWrite vis 0 True
  visit 0
  return tree

parse (u:v:uvs) = (u-1,v-1) : (v-1,u-1) : parse uvs
parse _ = []

solve :: Int -> Graph -> UArray Int Bool -> UArray Int Bool -> [Vertex]
solve n gr start goal = runST $ do
  res <- newSTRef [] :: ST s (STRef s [Vertex])
  let go0 !flip0 !flip1 v
        | (flip0 /= unsafeAt start v) == unsafeAt goal v = mapM_ (go1 flip0 flip1) $ unsafeAt gr v
        | otherwise = do
            modifySTRef res (v:)
            mapM_ (go1 (not flip0) flip1) $ unsafeAt gr v
      go1 !flip0 !flip1 v
        | (flip1 /= unsafeAt start v) == unsafeAt goal v = mapM_ (go0 flip0 flip1) $ unsafeAt gr v
        | otherwise =  do
            modifySTRef res (v:)
            mapM_ (go0 flip0 (not flip1)) $ unsafeAt gr v
  go0 False False 0
  reverse <$> readSTRef res


In the snake exhibition, there are $$$n$$$ rooms (numbered $$$0$$$ to $$$n - 1$$$) arranged in a circle, with a snake in each room. The rooms are connected by $$$n$$$ conveyor belts, and the $$$i$$$-th conveyor belt connects the rooms $$$i$$$ and $$$(i+1) \bmod n$$$. In the other words, rooms $$$0$$$ and $$$1$$$, $$$1$$$ and $$$2$$$, $$$\ldots$$$, $$$n-2$$$ and $$$n-1$$$, $$$n-1$$$ and $$$0$$$ are connected with conveyor belts.The $$$i$$$-th conveyor belt is in one of three states:  If it is clockwise, snakes can only go from room $$$i$$$ to $$$(i+1) \bmod n$$$.  If it is anticlockwise, snakes can only go from room $$$(i+1) \bmod n$$$ to $$$i$$$.  If it is off, snakes can travel in either direction.   Above is an example with $$$4$$$ rooms, where belts $$$0$$$ and $$$3$$$ are off, $$$1$$$ is clockwise, and $$$2$$$ is anticlockwise.Each snake wants to leave its room and come back to it later. A room is returnable if the snake there can leave the room, and later come back to it using the conveyor belts. How many such returnable rooms are there?

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$): the number of test cases. The description of the test cases follows.   The first line of each test case description contains a single integer $$$n$$$ ($$$2 \le n \le 300\,000$$$): the number of rooms.  The next line of each test case description contains a string $$$s$$$ of length $$$n$$$, consisting of only '<', '>' and '-'.   If $$$s_{i} = $$$ '>', the $$$i$$$-th conveyor belt goes clockwise.  If $$$s_{i} = $$$ '<', the $$$i$$$-th conveyor belt goes anticlockwise.  If $$$s_{i} = $$$ '-', the $$$i$$$-th conveyor belt is off.  It is guaranteed that the sum of $$$n$$$ among all test cases does not exceed $$$300\,000$$$.

For each test case, output the number of returnable rooms.

NoteIn the first test case, all rooms are returnable except room $$$2$$$. The snake in the room $$$2$$$ is trapped and cannot exit. This test case corresponds to the picture from the problem statement. In the second test case, all rooms are returnable by traveling on the series of clockwise belts.

import Control.Monad

main = do
  numTests <- read <$> getLine
  replicateM numTests $ do
    _ <- getLine
    str <- getLine
    putStrLn $ show $ solve str

solve :: String -> Int
solve str =
  if elem '<' str && elem '>' str
    then countLines str
    else length str

countLines :: String -> Int
countLines str = countLines' str False - (if hs == '-' && ls == '-' then 1 else 0)
  where
    hs = head str
    ls = last str
    countLines' [] _ = 0
    countLines' (x:xs) streak =
      if x == '-'
        then if streak
               then 1 + countLines' xs True
               else 2 + countLines' xs True
        else 0 + countLines' xs False

data Belt = Clockwise | AntiClockwise | Off deriving (Eq)

nNonReturnableRooms :: Bool -> Bool -> [Belt] -> Int
nNonReturnableRooms _ _ [] = 0
nNonReturnableRooms _ _ (h:[]) = 0
nNonReturnableRooms clockPath counterPath (a:b:t)
  | a == Clockwise && b == AntiClockwise = 1 + nNonReturnableRooms clockPath counterPath rest
  | a == AntiClockwise && b == Clockwise = 1 + nNonReturnableRooms clockPath counterPath rest
  | a == Clockwise && b == Clockwise && (not clockPath) = 1 + nNonReturnableRooms clockPath counterPath rest
  | a == AntiClockwise && b == AntiClockwise && (not counterPath) = 1 + nNonReturnableRooms clockPath counterPath rest
  | otherwise = nNonReturnableRooms clockPath counterPath rest
  where rest = (b:t)

nReturnableRooms :: [Belt] -> Int
nReturnableRooms belts = l - (nNonReturnableRooms clockPath counterPath ((belts !! (l-1)):belts))
    where clockPath = all (\belt -> belt == Clockwise || belt == Off) belts
          counterPath = all (\belt -> belt == AntiClockwise || belt == Off) belts
          l = (length belts)

readBelts :: String -> [Belt]
readBelts "" = []
readBelts (n:t)
  | n == '>' = (Clockwise:readBelts t)
  | n == '<' = (AntiClockwise:readBelts t)
  | n == '-' = (Off:readBelts t)

dropEven :: [a] -> [a]
dropEven [] = []
dropEven (a:b:t) = (b:(dropEven t))

main :: IO()
main = do
    interact $ unlines . map (show . nReturnableRooms . readBelts) . dropEven . tail . lines

import Control.Monad

solve :: [Char] -> Int
solve str = let
  w = [p | p <- str, p /= '-']
  canRot = case  w  of
    [] -> True
    (p : ps) -> all (== p) ps
  in  case  str  of
  _ | canRot  -> length str
  [] -> error "n < 2"
  (p : ps) -> length [() | (x, y) <- zip str $ ps ++ [p], x == '-' || y == '-']

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    s <- getLine
    print $ solve s

import Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        s <- getLine
        print $ solve n s

solve :: Int -> String -> Int
solve n s
        | ('>' `notElem` s) || ('<' `notElem` s) = n
        | otherwise = snd $ foldl (\(p, c) x -> (x, fromEnum ('-' `elem` [p, x]) + c)) (last s, 0) s

import Control.Monad

solve :: [Char] -> Int
solve str = case  str  of
  [] -> 0
  (p:_) | all (== p) str  -> length str
  (p:ps) -> length [() | (x, y) <- zip str $ ps ++ [p], x == '-' || y == '-']

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _n <- getLine
    s <- getLine
    print $ solve s


One day, as Sherlock Holmes was tracking down one very important criminal, he found a wonderful painting on the wall. This wall could be represented as a plane. The painting had several concentric circles that divided the wall into several parts. Some parts were painted red and all the other were painted blue. Besides, any two neighboring parts were painted different colors, that is, the red and the blue color were alternating, i. e. followed one after the other. The outer area of the wall (the area that lied outside all circles) was painted blue. Help Sherlock Holmes determine the total area of red parts of the wall.Let us remind you that two circles are called concentric if their centers coincide. Several circles are called concentric if any two of them are concentric.

The first line contains the single integer n (1 ≤ n ≤ 100). The second line contains n space-separated integers ri (1 ≤ ri ≤ 1000) — the circles' radii. It is guaranteed that all circles are different.

Print the single real number — total area of the part of the wall that is painted red. The answer is accepted if absolute or relative error doesn't exceed 10 - 4.

NoteIn the first sample the picture is just one circle of radius 1. Inner part of the circle is painted red. The area of the red part equals π × 12 = π.In the second sample there are three circles of radii 1, 4 and 2. Outside part of the second circle is painted blue. Part between the second and the third circles is painted red. Part between the first and the third is painted blue. And, finally, the inner part of the first circle is painted red. Overall there are two red parts: the ring between the second and the third circles and the inner part of the first circle. Total area of the red parts is equal (π × 42 - π × 22) + π × 12 = π × 12 + π = 13π

import List
main = do getLine; getLine >>= print . (pi*) . foldl1 subtract . sort . map ((**2) . read) . words

import Data.List
fu xs = reverse $ sort xs
fun xs x i | null xs = x*3.141592653589793 | i `mod` 2 == 0 = fun (tail xs) (x+y*y) (i+1)| otherwise = fun (tail xs) (x-y*y ) (i+1)
 where y = head xs
solve s = fun (fu $ tail s) 0 2
main = interact $ show . solve . map read . words

import Data.List
solve :: Int -> [Int] -> Double
solve n xs = pi * fromIntegral (square_sum xs')
    where xs' | even (length xs) = sort xs
              | otherwise = 0 : (sort xs)
          square_sum [] = 0
          square_sum (x:y:ys) = (x + y) * (y - x) + square_sum ys

main = do
  n <- readLn
  getLine >>=
       (\str -> putStrLn $
                (show . solve n . map read . words) str)

import Control.Applicative
import Data.List

solve [] = 0
solve a = pi*(last a)^2 - solve (init a)

main = getLine >> do
    rs <- map read . words <$> getLine
    print $ solve (sort rs)

import List

readWords :: IO [String]
readWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = readWords >>= return . (map read)

solve :: [Double] -> Double
solve xs  =  sum $ zipWith (\r sgn -> sgn * r * r * pi) (reverse $ sort xs) (cycle [1, -1])

main :: IO ()
main  =  getLine >> Main.reads >>= print . solve

module Main where
import Data.List
main :: IO ()
main = do
    _ <- readLn :: IO Int
    l <- getLine
    let radii = reverse (sort (map (read :: String -> Int) (words l)))
        radiiSquared = map (^2) radii
        radiiSquaredWithIndex = zipWith (,) [0..] radiiSquared
        evenRadii = [r | (i,r) <- radiiSquaredWithIndex, even i]
        oddRadii = [r | (i,r) <- radiiSquaredWithIndex, odd i]
        piCoeff = sum evenRadii - sum oddRadii
        redArea = (fromIntegral piCoeff :: Float) * pi
    putStrLn (show redArea)

import Data.List
main = getLine >> getLine >>= print . (*pi) . foldr1 (-) . reverse . sort . map ((^2) . read) . words

import Data.List
import Control.Applicative
import Text.Printf

main = getLine >> do
  rs <- map read . words <$> getLine
  printf "%.5f" $ solve $ sortBy (flip compare) rs

solve :: [Int] -> Double
solve rs = (pi*) $ fromIntegral $ sum $ zipWith (#) rs $ cycle [1,-1]
   where r#n=r*r*n

import List
s(_:r)=pi*sum(zipWith(*)(cycle[1,-1])$reverse$sort r)
main=interact$show.s.map((^2).read).words

import Data.List
main = do
  n <- readLn
  a <- getLine >>= return. Data.List.sort. map read. words
  let nth = ((0:a) !!)
  print. (*pi). sum $ [(nth i)^2 - (nth (i - 1))^2 | i <- [n, n - 2..1]]

import           Data.List

neg x = if even x then 1 else -1

enumerate :: Integral a => [a] -> [(a, a)]
enumerate = zip [0..]

main :: IO ()
main = do
  n <- (read :: String -> Int) <$> getLine
  let folder a (i, r) = a + neg i * r^2
  print =<< (*pi) . fromIntegral . foldl folder 0 . enumerate . sortBy (flip compare) . map (read :: String -> Int) . words <$> getLine

import Prelude hiding (readList)

import System.IO

import Data.Word
import Data.List
import Data.ByteString.Lazy       as B  hiding (map, reverse)
import Data.ByteString.Lazy.Char8 as BC hiding (map, reverse)

main = do
    hSetBuffering stdin LineBuffering
    first           <- fmap BC.pack System.IO.getLine
    second          <- fmap BC.pack System.IO.getLine
    let Just ( n,_) =  readNum                   first
    let Just (rs,_) =  readList (fromIntegral n) second
    print $ sum $ map (uncurry square) $ toPairs $ reverse $ sort $ 0:rs

toPairs :: [a] -> [(a,a)]
toPairs      []  = []
toPairs   (_:[]) = []
toPairs (a:b:ts) = (a,b):(toPairs ts)

square  :: Word16 -> Word16 -> Float
square a b = if a < b -- на всякий случай
             then square' b a
             else square' a b
    where
        square' a b = pi * ab1 * ab2
        ab1 = fromIntegral $ a - b
        ab2 = fromIntegral $ a + b

readList :: Word8 -> ByteString -> Maybe ([Word16], ByteString)
readList n source = readList' n [] source
    where
        readList' 0 acc source = return (acc, source)
        readList' i acc source = do
            (curr, source) <- readNum  source
            readList' (i-1) (curr:acc) source

readNum  ::          ByteString -> Maybe ( Word16  , ByteString)
readNum  source = fmap convert $ readInt source
    where
        convert (a,b) = (fromIntegral a, trim b)
        trim source = case BC.uncons source of
            Just (c, trimmed) | c == '\n' || c == '\r' || c == ' '
                -> trim trimmed
            _   -> source

import Data.List
import Control.Monad

solve :: [Double] -> Double
solve [] = 0
solve [red] = red ^ 2
solve (red:blue:rest) = red ^ 2 - blue ^ 2 + solve rest

main = do
  _ <- getLine
  rows <- getLine >>= (return . map (read::String->Double) . words)
  print . (* pi) . solve . reverse . sort $ rows

import Data.List
main = getLine >> getLine >>= print . (*pi) . foldr1 (-) . sort . map ((^2) . read) . words

import List
s(_:r)=pi*sum(zipWith(*)(cycle[1,-1])r)
main=interact$show.s.reverse.sort.map((^2).read).words

import           Data.List

neg x = if even x then 1 else -1

enumerate :: Integral a => [a] -> [(a, a)]
enumerate = zip [0..]

main :: IO ()
main = do
  n <- (read :: String -> Int) <$> getLine
  let folder a (i, r) = a + neg i * r^2
  print =<< (*pi) . fromIntegral . foldl folder 0 . enumerate . sort . map (read :: String -> Int) . words <$> getLine


Colossal! — exclaimed Hawk-nose. — A programmer! That's exactly what we are looking for.Arkadi and Boris Strugatsky. Monday starts on SaturdayReading the book "Equations of Mathematical Magic" Roman Oira-Oira and Cristobal Junta found an interesting equation: $$$a - (a \oplus x) - x = 0$$$ for some given $$$a$$$, where $$$\oplus$$$ stands for a bitwise exclusive or (XOR) of two integers (this operation is denoted as ^ or xor in many modern programming languages). Oira-Oira quickly found some $$$x$$$, which is the solution of the equation, but Cristobal Junta decided that Oira-Oira's result is not interesting enough, so he asked his colleague how many non-negative solutions of this equation exist. This task turned out to be too difficult for Oira-Oira, so he asks you to help.

Each test contains several possible values of $$$a$$$ and your task is to find the number of equation's solution for each of them. The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of these values. The following $$$t$$$ lines contain the values of parameter $$$a$$$, each value is an integer from $$$0$$$ to $$$2^{30} - 1$$$ inclusive.

For each value of $$$a$$$ print exactly one integer — the number of non-negative solutions of the equation for the given value of the parameter. Print answers in the same order as values of $$$a$$$ appear in the input. One can show that the number of solutions is always finite.

NoteLet's define the bitwise exclusive OR (XOR) operation. Given two integers $$$x$$$ and $$$y$$$, consider their binary representations (possibly with leading zeroes): $$$x_k \dots x_2 x_1 x_0$$$ and $$$y_k \dots y_2 y_1 y_0$$$. Here, $$$x_i$$$ is the $$$i$$$-th bit of the number $$$x$$$ and $$$y_i$$$ is the $$$i$$$-th bit of the number $$$y$$$. Let $$$r = x \oplus y$$$ be the result of the XOR operation of $$$x$$$ and $$$y$$$. Then $$$r$$$ is defined as $$$r_k \dots r_2 r_1 r_0$$$ where:$$$$$$ r_i = \left\{ \begin{aligned} 1, ~ \text{if} ~ x_i \ne y_i \\ 0, ~ \text{if} ~ x_i = y_i \end{aligned} \right. $$$$$$For the first value of the parameter, only $$$x = 0$$$ is a solution of the equation.For the second value of the parameter, solutions are $$$x = 0$$$ and $$$x = 2$$$.

import Data.Bits
import Control.Applicative
import Control.Monad

main = do
  t <- readLn :: IO Int

  replicateM_ t $ do
    a <- readLn :: IO Int
    print $ 2 ^ (popCount a)

-- Codeforces 1064B
import Data.Bits
import Data.List

counter :: Integer -> Integer
counter 0 = 1
counter 1 = 2
counter x = if x `mod` 2 == 0
            then 1 * counter (x `div` 2)
            else 2 * counter (x `div` 2)

main :: IO ()
main = do
    input <- getLine
    let n = read input :: Int
    inputs <- getContents
    let numbers = map (read :: String -> Integer) (lines inputs)
    mapM_ (print . counter) (take n numbers)


This is the easy version of the problem. The difference between the versions is the constraints on $$$a_i$$$. You can make hacks only if all versions of the problem are solved.Little Dormi has recently received a puzzle from his friend and needs your help to solve it. The puzzle consists of an upright board with $$$n$$$ rows and $$$m$$$ columns of cells, some empty and some filled with blocks of sand, and $$$m$$$ non-negative integers $$$a_1,a_2,\ldots,a_m$$$ ($$$0 \leq a_i \leq n$$$). In this version of the problem, $$$a_i$$$ will be equal to the number of blocks of sand in column $$$i$$$.When a cell filled with a block of sand is disturbed, the block of sand will fall from its cell to the sand counter at the bottom of the column (each column has a sand counter). While a block of sand is falling, other blocks of sand that are adjacent at any point to the falling block of sand will also be disturbed and start to fall. Specifically, a block of sand disturbed at a cell $$$(i,j)$$$ will pass through all cells below and including the cell $$$(i,j)$$$ within the column, disturbing all adjacent cells along the way. Here, the cells adjacent to a cell $$$(i,j)$$$ are defined as $$$(i-1,j)$$$, $$$(i,j-1)$$$, $$$(i+1,j)$$$, and $$$(i,j+1)$$$ (if they are within the grid). Note that the newly falling blocks can disturb other blocks.In one operation you are able to disturb any piece of sand. The puzzle is solved when there are at least $$$a_i$$$ blocks of sand counted in the $$$i$$$-th sand counter for each column from $$$1$$$ to $$$m$$$.You are now tasked with finding the minimum amount of operations in order to solve the puzzle. Note that Little Dormi will never give you a puzzle that is impossible to solve.

The first line consists of two space-separated positive integers $$$n$$$ and $$$m$$$ ($$$1 \leq n \cdot m \leq 400\,000$$$). Each of the next $$$n$$$ lines contains $$$m$$$ characters, describing each row of the board. If a character on a line is '.', the corresponding cell is empty. If it is '#', the cell contains a block of sand. The final line contains $$$m$$$ non-negative integers $$$a_1,a_2,\ldots,a_m$$$ ($$$0 \leq a_i \leq n$$$) — the minimum amount of blocks of sand that needs to fall below the board in each column. In this version of the problem, $$$a_i$$$ will be equal to the number of blocks of sand in column $$$i$$$.

Print one non-negative integer, the minimum amount of operations needed to solve the puzzle.

NoteFor example $$$1$$$, by disturbing both blocks of sand on the first row from the top at the first and sixth columns from the left, and the block of sand on the second row from the top and the fourth column from the left, it is possible to have all the required amounts of sand fall in each column. It can be proved that this is not possible with fewer than $$$3$$$ operations, and as such the answer is $$$3$$$. Here is the puzzle from the first example.  For example $$$2$$$, by disturbing the cell on the top row and rightmost column, one can cause all of the blocks of sand in the board to fall into the counters at the bottom. Thus, the answer is $$$1$$$. Here is the puzzle from the second example.

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

scc :: Graph -> (Int, UArray Int Int)  -- number of scc, scc id for each node in [0,#scc)
scc g = runST $ do
    let bs = bounds g
        intArray val = (newArray bs val :: ST s (STUArray s Int Int))
    lw <- intArray 0
    idx <- intArray 0
    cmp <- intArray (-1)
    qidx <- newSTRef 0
    qcmp <- newSTRef 0
    st <- newSTRef []

    let
        dfs x = do
            modifySTRef' qidx (+1)
            readSTRef qidx >>= \v -> writeArray lw x v >> writeArray idx x v
            modifySTRef' st (x:)
            writeArray cmp x (-2)
            forM_ (g ! x) $ \y -> do
                idxy <- readArray idx y
                cmpy <- readArray cmp y
                when (idxy == 0) (dfs y)
                when (idxy == 0 || cmpy == -2) $ do
                    readArray lw y >>= \val -> modifyArray (min val) lw x
            lwx <- readArray lw x
            idxx <- readArray idx x
            when (lwx == idxx) $ do
                cc <- readSTRef qcmp
                let loop = do
                    y <- head <$> readSTRef st
                    modifySTRef' st tail
                    writeArray cmp y cc
                    when (y /= x) loop
                loop
                modifySTRef' qcmp (+1)

    forM_ (indices g) $ \i -> readArray idx i >>= \v -> when (v == 0) (dfs i)
    r0 <- readSTRef qcmp
    r1 <- unsafeFreezeSTUArray cmp
    return (r0, r1)

getEdges :: Int -> Int -> UArray (Int,Int) Char -> [(Int, Int)]
getEdges n m b = runST $ do
    r <- newSTRef []
    let add v = modifySTRef r (v:)
    w <- newArray (-1,m) (-1) :: ST s (STUArray s Int Int)
    forM_ [n-1,n-2..0] $ \i -> do
        forM_ [0..m-1] $ \j -> when (oc i j) $ do
            forM_ [j-1..j+1] $ \k -> do
                t <- readArray w k
                when (t >= 0) $ add (pos i j, pos t k)
            when (j > 0 && oc i (j-1)) $ add (pos i j, pos i (j-1))
            when (j < m-1 && oc i (j+1)) $ add (pos i j, pos i (j+1))
            when (i > 0 && oc (i-1) j) $ add (pos i j, pos (i-1) j)
        forM_ [0..m-1] $ \j -> when (oc i j) $ writeArray w j i
    readSTRef r
    where
        oc i j = b ! (i,j) == '#'
        pos i j = i * m + j

main = do
    [n,m] <- map parseInt . BS.words <$> BS.getLine
    rs <- replicateM n $ dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    as <- map parseInt . BS.words <$> BS.getLine
    let b = listArray ((0,0),(n-1,m-1)) $ concat rs :: UArray (Int,Int) Char
        es  = getEdges n m b
        g = buildG (0,n*m-1) es
        (nc, c) = scc g
        r = runST $ do
            ok <- newArray (0,nc-1) True :: ST s (STUArray s Int Bool)
            forM_ (indices b) $ \(i,j) -> when (b ! (i,j) == '.') $ writeArray ok (c ! (i*m+j)) False
            forM_ es $ \(x,y) -> when (c ! x /= c ! y) $ writeArray ok (c ! y) False
            return . length . filter id =<< getElems ok
    print r

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

scc :: Graph -> (Int, UArray Int Int)  -- number of scc, scc id for each node in [0,#scc)
scc g = runST $ do
    let bs = bounds g
        intArray val = (newArray bs val :: ST s (STUArray s Int Int))
    lw <- intArray 0
    idx <- intArray 0
    cmp <- intArray (-1)
    qidx <- newSTRef 0
    qcmp <- newSTRef 0
    st <- newSTRef []

    let
        dfs x = do
            modifySTRef' qidx (+1)
            readSTRef qidx >>= \v -> writeArray lw x v >> writeArray idx x v
            modifySTRef' st (x:)
            writeArray cmp x (-2)
            forM_ (g ! x) $ \y -> do
                idxy <- readArray idx y
                cmpy <- readArray cmp y
                when (idxy == 0) (dfs y)
                when (idxy == 0 || cmpy == -2) $ do
                    readArray lw y >>= \val -> modifyArray (min val) lw x
            lwx <- readArray lw x
            idxx <- readArray idx x
            when (lwx == idxx) $ do
                cc <- readSTRef qcmp
                let loop = do
                    y <- head <$> readSTRef st
                    modifySTRef' st tail
                    writeArray cmp y cc
                    when (y /= x) loop
                loop
                modifySTRef' qcmp (+1)

    forM_ (indices g) $ \i -> readArray idx i >>= \v -> when (v == 0) (dfs i)
    r0 <- readSTRef qcmp
    r1 <- unsafeFreezeSTUArray cmp
    return (r0, r1)

getEdges :: Int -> Int -> UArray (Int,Int) Char -> [(Int, Int)]
getEdges n m b = runST $ do
    r <- newSTRef []
    let add v = modifySTRef r (v:)
    w <- newArray (-1,m) (-1) :: ST s (STUArray s Int Int)
    forM_ [n-1,n-2..0] $ \i -> do
        forM_ [0..m-1] $ \j -> when (oc i j) $ do
            forM_ [j-1..j+1] $ \k -> do
                t <- readArray w k
                when (t >= 0) $ add (pos i j, pos t k)
            when (j > 0 && oc i (j-1)) $ add (pos i j, pos i (j-1))
            when (j < m-1 && oc i (j+1)) $ add (pos i j, pos i (j+1))
            when (i > 0 && oc (i-1) j) $ add (pos i j, pos (i-1) j)
        forM_ [0..m-1] $ \j -> when (oc i j) $ writeArray w j i
    readSTRef r
    where
        oc i j = b ! (i,j) == '#'
        pos i j = i * m + j

main = do
    [n,m] <- map parseInt . BS.words <$> BS.getLine
    rs <- replicateM n $ dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    as <- map parseInt . BS.words <$> BS.getLine
    let b = listArray ((0,0),(n-1,m-1)) $ concat rs :: UArray (Int,Int) Char
        es  = getEdges n m b
        g = buildG (0,n*m-1) es
        (nc, c) = scc g
        r = runST $ do
            ok <- newArray (0,nc-1) True :: ST s (STUArray s Int Bool)
            forM_ (indices b) $ \(i,j) -> when (b ! (i,j) == '.') $ writeArray ok (c ! (i*m+j)) False
            forM_ es $ \(_,y) -> writeArray ok (c ! y) False
            return . length . filter id =<< getElems ok
    print r

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

scc :: Graph -> (Int, UArray Int Int)  -- number of scc, scc id for each node in [0,#scc)
scc g = runST $ do
    let bs = bounds g
        intArray val = (newArray bs val :: ST s (STUArray s Int Int))
    lw <- intArray 0
    idx <- intArray 0
    cmp <- intArray (-1)
    qidx <- newSTRef 0
    qcmp <- newSTRef 0
    st <- newSTRef []

    let
        dfs x = do
            modifySTRef' qidx (+1)
            readSTRef qidx >>= \v -> writeArray lw x v >> writeArray idx x v
            modifySTRef' st (x:)
            writeArray cmp x (-2)
            forM_ (g ! x) $ \y -> do
                idxy <- readArray idx y
                cmpy <- readArray cmp y
                when (idxy == 0) (dfs y)
                when (idxy == 0 || cmpy == -2) $ do
                    readArray lw y >>= \val -> modifyArray (min val) lw x
            lwx <- readArray lw x
            idxx <- readArray idx x
            when (lwx == idxx) $ do
                cc <- readSTRef qcmp
                let loop = do
                    y <- head <$> readSTRef st
                    modifySTRef' st tail
                    writeArray cmp y cc
                    when (y /= x) loop
                loop
                modifySTRef' qcmp (+1)

    forM_ (indices g) $ \i -> readArray idx i >>= \v -> when (v == 0) (dfs i)
    r0 <- readSTRef qcmp
    r1 <- unsafeFreezeSTUArray cmp
    return (r0, r1)

getEdges :: Int -> Int -> UArray (Int,Int) Char -> [(Int, Int)]
getEdges n m b = runST $ do
    r <- newSTRef []
    let add v = modifySTRef r (v:)
    w <- newArray (-1,m) (-1) :: ST s (STUArray s Int Int)
    forM_ [n-1,n-2..0] $ \i -> do
        forM_ [0..m-1] $ \j -> when (oc i j) $ do
            forM_ [j-1..j+1] $ \k -> do
                t <- readArray w k
                when (t >= 0) $ add (pos i j, pos t k)
            when (j > 0 && oc i (j-1)) $ add (pos i j, pos i (j-1))
            when (j < m-1 && oc i (j+1)) $ add (pos i j, pos i (j+1))
            when (i > 0 && oc (i-1) j) $ add (pos i j, pos (i-1) j)
        forM_ [0..m-1] $ \j -> when (oc i j) $ writeArray w j i
    readSTRef r
    where
        oc i j = b ! (i,j) == '#'
        pos i j = i * m + j

main = do
    [n,m] <- map parseInt . BS.words <$> BS.getLine
    rs <- replicateM n $ dropWhile isSpace . BS.unpack <$> BS.getLine
    as <- map parseInt . BS.words <$> BS.getLine
    let b = listArray ((0,0),(n-1,m-1)) $ concat rs :: UArray (Int,Int) Char
        es  = getEdges n m b
        g = buildG (0,n*m-1) es
        (nc, c) = scc g
        r = runST $ do
            ok <- newArray (0,nc-1) True :: ST s (STUArray s Int Bool)
            forM_ (indices b) $ \(i,j) -> when (b ! (i,j) == '.') $ writeArray ok (c ! (i*m+j)) False
            forM_ es $ \(_,y) -> writeArray ok (c ! y) False
            return . length . filter id =<< getElems ok
    print r


Pak Chanek has $$$n$$$ blank heart-shaped cards. Card $$$1$$$ is attached directly to the wall while each of the other cards is hanging onto exactly one other card by a piece of string. Specifically, card $$$i$$$ ($$$i > 1$$$) is hanging onto card $$$p_i$$$ ($$$p_i < i$$$).In the very beginning, Pak Chanek must write one integer number on each card. He does this by choosing any permutation $$$a$$$ of $$$[1, 2, \dots, n]$$$. Then, the number written on card $$$i$$$ is $$$a_i$$$.After that, Pak Chanek must do the following operation $$$n$$$ times while maintaining a sequence $$$s$$$ (which is initially empty):  Choose a card $$$x$$$ such that no other cards are hanging onto it.  Append the number written on card $$$x$$$ to the end of $$$s$$$.  If $$$x \neq 1$$$ and the number on card $$$p_x$$$ is larger than the number on card $$$x$$$, replace the number on card $$$p_x$$$ with the number on card $$$x$$$.  Remove card $$$x$$$. After that, Pak Chanek will have a sequence $$$s$$$ with $$$n$$$ elements. What is the maximum length of the longest non-decreasing subsequence$$$^\dagger$$$ of $$$s$$$ at the end if Pak Chanek does all the steps optimally?$$$^\dagger$$$ A sequence $$$b$$$ is a subsequence of a sequence $$$c$$$ if $$$b$$$ can be obtained from $$$c$$$ by deletion of several (possibly, zero or all) elements. For example, $$$[3,1]$$$ is a subsequence of $$$[3,2,1]$$$, $$$[4,3,1]$$$ and $$$[3,1]$$$, but not $$$[1,3,3,7]$$$ and $$$[3,10,4]$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of heart-shaped cards. The second line contains $$$n - 1$$$ integers $$$p_2, p_3, \dots, p_n$$$ ($$$1 \le p_i < i$$$) describing which card that each card hangs onto.

Print a single integer — the maximum length of the longest non-decreasing subsequence of $$$s$$$ at the end if Pak Chanek does all the steps optimally.

NoteThe following is the structure of the cards in the first example.Pak Chanek can choose the permutation $$$a = [1, 5, 4, 3, 2, 6]$$$.Let $$$w_i$$$ be the number written on card $$$i$$$. Initially, $$$w_i = a_i$$$. Pak Chanek can do the following operations in order:  Select card $$$5$$$. Append $$$w_5 = 2$$$ to the end of $$$s$$$. As $$$w_4 > w_5$$$, the value of $$$w_4$$$ becomes $$$2$$$. Remove card $$$5$$$. After this operation, $$$s = [2]$$$.  Select card $$$6$$$. Append $$$w_6 = 6$$$ to the end of $$$s$$$. As $$$w_2 \leq w_6$$$, the value of $$$w_2$$$ is left unchanged. Remove card $$$6$$$. After this operation, $$$s = [2, 6]$$$.  Select card $$$4$$$. Append $$$w_4 = 2$$$ to the end of $$$s$$$. As $$$w_1 \leq w_4$$$, the value of $$$w_1$$$ is left unchanged. Remove card $$$4$$$. After this operation, $$$s = [2, 6, 2]$$$.  Select card $$$3$$$. Append $$$w_3 = 4$$$ to the end of $$$s$$$. As $$$w_2 > w_3$$$, the value of $$$w_2$$$ becomes $$$4$$$. Remove card $$$3$$$. After this operation, $$$s = [2, 6, 2, 4]$$$.  Select card $$$2$$$. Append $$$w_2 = 4$$$ to the end of $$$s$$$. As $$$w_1 \leq w_2$$$, the value of $$$w_1$$$ is left unchanged. Remove card $$$2$$$. After this operation, $$$s = [2, 6, 2, 4, 4]$$$.  Select card $$$1$$$. Append $$$w_1 = 1$$$ to the end of $$$s$$$. Remove card $$$1$$$. After this operation, $$$s = [2, 6, 2, 4, 4, 1]$$$. One of the longest non-decreasing subsequences of $$$s = [2, 6, 2, 4, 4, 1]$$$ is $$$[2, 2, 4, 4]$$$. Thus, the length of the longest non-decreasing subsequence of $$$s$$$ is $$$4$$$. It can be proven that this is indeed the maximum possible length.

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve' :: [(Int, Int)] -> Int
solve' xs = runST $ do
  let n = length xs + 5
  dp <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
  h <- newArray (0, n) 1 :: ST s (STUArray s Int Int)
  forM_ xs $ \(p, i) -> do
    idp <- readArray dp i
    ih <- readArray h i
    writeArray dp i $ max idp ih
    pdp <- readArray dp p
    ph <- readArray h p
    writeArray h p $ max ph (ih + 1)
    writeArray dp p $ pdp + max ih idp
  readArray dp 1

solve xs = solve' (reverse $ zip (0:xs) [1..])

main = do
  _ <- getInts
  xs <- getInts
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve' ((p, i):xs) dp h = if i == 1 then idp else solve' xs dp' h'
  where ih = h Map.! i
        idp = max (dp Map.! i) ih
        dp' = Map.adjust (+idp) p dp
        h' = Map.adjust (\ph -> max ph $ ih + 1) p h

solve xs = solve' (reverse $ zip (0:xs) [1..]) dp h
  where dp = Map.fromList (zip [0..length xs + 1] $ repeat 0)
        h = Map.fromList (zip [0..length xs + 1] $ repeat 1)

main = do
  _ <- getInts
  xs <- getInts
  print $ solve xs

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve' :: [(Int, Int)] -> Int
solve' xs = runST $ do
  let n = length xs + 5
  dp <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
  h <- newArray (0, n) 1 :: ST s (STUArray s Int Int)
  forM_ xs $ \(p, i) -> do
    idp <- readArray dp i
    ih <- readArray h i
    pdp <- readArray dp p
    ph <- readArray h p
    writeArray h p $ max ph (ih + 1)
    writeArray dp p $ pdp + max ih idp
  readArray dp 1

solve xs = solve' (reverse $ zip (0:xs) [1..])

main = do
  _ <- getInts
  xs <- getInts
  print $ solve xs