Valery is a PE teacher at a school in Berland. Soon the students are going to take a test in long jumps, and Valery has lost his favorite ruler! However, there is no reason for disappointment, as Valery has found another ruler, its length is l centimeters. The ruler already has n marks, with which he can make measurements. We assume that the marks are numbered from 1 to n in the order they appear from the beginning of the ruler to its end. The first point coincides with the beginning of the ruler and represents the origin. The last mark coincides with the end of the ruler, at distance l from the origin. This ruler can be repesented by an increasing sequence a1, a2, ..., an, where ai denotes the distance of the i-th mark from the origin (a1 = 0, an = l).Valery believes that with a ruler he can measure the distance of d centimeters, if there is a pair of integers i and j (1 ≤ i ≤ j ≤ n), such that the distance between the i-th and the j-th mark is exactly equal to d (in other words, aj - ai = d). Under the rules, the girls should be able to jump at least x centimeters, and the boys should be able to jump at least y (x < y) centimeters. To test the children's abilities, Valery needs a ruler to measure each of the distances x and y. Your task is to determine what is the minimum number of additional marks you need to add on the ruler so that they can be used to measure the distances x and y. Valery can add the marks at any integer non-negative distance from the origin not exceeding the length of the ruler.

The first line contains four positive space-separated integers n, l, x, y (2 ≤ n ≤ 105, 2 ≤ l ≤ 109, 1 ≤ x < y ≤ l) — the number of marks, the length of the ruler and the jump norms for girls and boys, correspondingly. The second line contains a sequence of n integers a1, a2, ..., an (0 = a1 < a2 < ... < an = l), where ai shows the distance from the i-th mark to the origin.

In the first line print a single non-negative integer v — the minimum number of marks that you need to add on the ruler. In the second line print v space-separated integers p1, p2, ..., pv (0 ≤ pi ≤ l). Number pi means that the i-th mark should be at the distance of pi centimeters from the origin. Print the marks in any order. If there are multiple solutions, print any of them.

NoteIn the first sample it is impossible to initially measure the distance of 230 centimeters. For that it is enough to add a 20 centimeter mark or a 230 centimeter mark.In the second sample you already can use the ruler to measure the distances of 185 and 230 centimeters, so you don't have to add new marks.In the third sample the ruler only contains the initial and the final marks. We will need to add two marks to be able to test the children's skills.

import qualified Data.Set as Set
main=interact$solve.map read.words
solve (_:l:x:y:xs)
	| find1<=l && find2<=l = "0"
	| find1<=l = "1\n" ++ show y
	| find2<=l = "1\n" ++ show x
	| find3<=l = "1\n" ++ show (find3+x)
	| find4<=l && find4+y<l = "1\n" ++ show (find4+y)
	| find5<=l && find5>x = "1\n" ++ show (find5-x)
	| otherwise = "2\n"++show x++" "++show y
	where hs=Set.fromList xs
	      find x xs
		| null xs = l+1
		| Set.member (head xs + x) hs = head xs
		| otherwise = find x $ tail xs
	      find1=find x xs
              find2=find y xs
	      find3=find (y+x) xs
	      find4=find (y-x) xs
	      find5=find (y-x) $ reverse xs

import Data.List
import GHC.Exts
solve [[_, ll,x,y], l] = case (can x, can y, can $ x+y, can $ abs $ x-y) of
   (_:_,_:_,_,_) -> [[0]]
   ([],[],[],[]) -> [[2],[x,y]]
   (_:_,_,_,_) -> [[1],[y]]
   (_,_:_,_,_) -> [[1],[x]]
   (_,_,s:_,_) -> [[1],[s+y]]
   (_,_,_,ss) -> case filter (<=ll) [s+max x y | s<-ss] ++ filter (>=0) [s-min x y | s<-ss] of
                h:_ -> [[1],[h]]
                []  -> [[2],[x,y]]
  where can x = map head $ filter ((>1).length) $ group $ sort $ l  ++ map (subtract x) l

main = interact $ unlines . map (unwords . map show) . solve . map (map read . words) . lines

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
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 #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
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
  nlxy <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  case solve nlxy xs of
    ps -> do
      print $ length ps
      putStr.unwords.map show $ ps

solve :: [Int] -> [Int] -> [Int]
solve [n,l,x,y] xs
  | okX && okY = []
  | okX = [y]
  | okY = [x]
  | otherwise = case filter (\k->0<k&&k<l) $ IS.toList cap of
                  [] -> [x,y]
                  (res:_) -> [res]
   where
     !set = IS.fromList xs
     !okX = or [IS.member (v+x) set | v<-xs]
     !okY = or [IS.member (v+y) set | v<-xs]
     !cap = IS.unions
          [IS.intersection (IS.map (subtract x) set) (IS.map (subtract y) set)
          ,IS.intersection (IS.map (subtract x) set) (IS.map (+y) set)
          ,IS.intersection (IS.map (+x) set) (IS.map (subtract y) set)
          ,IS.intersection (IS.map (+x) set) (IS.map (+y) set)
          ]

import qualified Data.Set as Set
main=interact$solve.map read.words
solve (_:l:x:y:xs)
	| find1<=l && find2<=l = "0"
	| find1<=l = "1\n" ++ show (find1+y)
	| find2<=l = "1\n" ++ show (find2+x)
	| find3<=l = "1\n" ++ show (find3+x)
	| find4<=l && find4+y<l = "1\n" ++ show (find4+y)
	| otherwise = "2\n"++show x++" "++show y
	where hs=Set.fromList xs
	      find x xs
		| null xs = l+1
		| Set.member (head xs + x) hs = head xs
		| otherwise = find x $ tail xs
	      find1=find x xs
              find2=find y xs
	      find3=find (y+x) xs
	      find4=find (y-x) xs

import qualified Data.Set as Set
main=interact$solve.map read.words
solve (_:l:x:y:xs)
	| find1<=l && find2<=l = "0"
	| find1<=l = "1\n" ++ show (find1+y)
	| find2<=l = "1\n" ++ show (find2+x)
	| find3<=l = "1\n" ++ show (find3+x)
	| find4<=l && find4+y<l = "1\n" ++ show (find4+y)
	| find5<=l && find5>x = "1\n" ++ show (find5-x)
	| otherwise = "2\n"++show x++" "++show y
	where hs=Set.fromList xs
	      find x xs
		| null xs = l+1
		| Set.member (head xs + x) hs = head xs
		| otherwise = find x $ tail xs
	      find1=find x xs
              find2=find y xs
	      find3=find (y+x) xs
	      find4=find (y-x) xs
	      find5=find (y-x) $ reverse xs

import qualified Data.Set as Set
main=interact$solve.map read.words
solve (_:l:x:y:xs)
	| find1<=l && find2<=l = "0"
	| find1<=l = "1\n" ++ show (find1+x)
	| find2<=l = "1\n" ++ show (find2+y)
	| find3<=l = "1\n" ++ show (find3+x)
	| find4<=l && find4+y<l = "1\n" ++ show (find4+y)
	| otherwise = "2\n"++show x++" "++show y
	where hs=Set.fromList xs
	      find x xs
		| null xs = l+1
		| Set.member (head xs + x) hs = head xs
		| otherwise = find x $ tail xs
	      find1=find x xs
              find2=find y xs
	      find3=find (y+x) xs
	      find4=find (y-x) xs

import Data.List
import GHC.Exts
solve [[_, ll,x,y], l] = case (can x, can y, can $ x+y, can $ abs $ x-y) of
   ([_],[_],_,_) -> [[0]]
   ([],[],[],[]) -> [[2],[x,y]]
   ([_],_,_,_) -> [[1],[y]]
   (_,[_],_,_) -> [[1],[x]]
   (_,_,[s],_) -> [[1],[s+y]]
   (_,_,_,[s]) | s+max x y <= ll -> [[1],[s+max x y]]
               | s-min x y >= 0 -> [[1],[s-min x y]]
               | otherwise       -> [[2],[x,y]]
  where can x = take 1 $ drop 1 $ head $ sortWith (negate.length) $ group $ sort $ l  ++ map (subtract x) l

main = interact $ unlines . map (unwords . map show) . solve . map (map read . words) . lines

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
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 #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
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
  nlxy <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  case solve nlxy xs of
    ps -> do
      print $ length ps
      putStr.unwords.map show $ ps

solve :: [Int] -> [Int] -> [Int]
solve [n,l,x,y] xs
  | IS.member x set && IS.member y set = []
  | otherwise = go xs
   where
     !set = IS.fromList xs
     go (v:vs)
       | IS.member (v+x) set && IS.member y set = []
       | IS.member (v+y) set && IS.member x set = []
       | otherwise = go vs
     go []
       | IS.member x set = [y]
       | IS.member y set = [x]
       | otherwise = [x,y]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
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 #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
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
  nlxy <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  case solve nlxy xs of
    ps -> do
      print $ length ps
      putStr.unwords.map show $ ps

solve :: [Int] -> [Int] -> [Int]
solve [n,l,x,y] xs
  | IS.member x set && IS.member y set = []
  | otherwise = go xs
   where
     !d = y - x
     !set = IS.fromList xs
     go (v:vs)
       | IS.member (v+d) set = []
       | IS.member (v+x) set && IS.member y set = []
       | IS.member (v+y) set && IS.member x set = []
       | otherwise = go vs
     go []
       | IS.member x set = [y]
       | IS.member y set = [x]
       | otherwise = [x,y]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
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 #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
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
  nlxy <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  case solve nlxy xs of
    ps -> do
      print $ length ps
      putStr.unwords.map show $ ps

solve :: [Int] -> [Int] -> [Int]
solve [n,l,x,y] xs
  | okX && okY = []
  | okX = [y]
  | okY = [x]
  | otherwise = case filter (>=0) $ IS.toList cap of
                  [] -> [x,y]
                  (res:_) -> [res]
   where
     !set = IS.fromList xs
     !okX = or [IS.member (v+x) set | v<-0:xs]
     !okY = or [IS.member (v+y) set | v<-0:xs]
     !cap = IS.intersection (IS.map (subtract x) set) (IS.map (subtract y) set)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, 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.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
list :: b -> ([a] -> b) -> [a] -> b
list x f xs=case xs of{[]->x;_->f xs}
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
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 #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
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
  nlxy <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getLine
  case solve nlxy xs of
    ps -> do
      print $ length ps
      putStr.unwords.map show $ ps

solve :: [Int] -> [Int] -> [Int]
solve [n,l,x,y] xs
  | okX && okY = []
  | okX = [y]
  | okY = [x]
  | otherwise = case IS.toList cap of
                  [] -> [x,y]
                  (res:_) -> [res]
   where
     !set = IS.fromList xs
     !okX = or [IS.member (v+x) set | v<-0:xs]
     !okY = or [IS.member (v+y) set | v<-0:xs]
     !cap = IS.intersection (IS.map (subtract x) set) (IS.map (subtract y) set)


Let's call an array $$$a$$$ of $$$m$$$ integers $$$a_1, a_2, \ldots, a_m$$$ Decinc if $$$a$$$ can be made increasing by removing a decreasing subsequence (possibly empty) from it. For example, if $$$a = [3, 2, 4, 1, 5]$$$, we can remove the decreasing subsequence $$$[a_1, a_4]$$$ from $$$a$$$ and obtain $$$a = [2, 4, 5]$$$, which is increasing.You are given a permutation $$$p$$$ of numbers from $$$1$$$ to $$$n$$$. Find the number of pairs of integers $$$(l, r)$$$ with $$$1 \le l \le r \le n$$$ such that $$$p[l \ldots r]$$$ (the subarray of $$$p$$$ from $$$l$$$ to $$$r$$$) is a Decinc array.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$)  — the size of $$$p$$$. The second line contains $$$n$$$ integers $$$p_1, p_2, \ldots, p_n$$$ ($$$1 \le p_i \le n$$$, all $$$p_i$$$ are distinct)  — elements of the permutation.

Output the number of pairs of integers $$$(l, r)$$$ such that $$$p[l \ldots r]$$$ (the subarray of $$$p$$$ from $$$l$$$ to $$$r$$$) is a Decinc array. $$$(1 \le l \le r \le n)$$$

NoteIn the first sample, all subarrays are Decinc.In the second sample, all subarrays except $$$p[1 \ldots 6]$$$ and $$$p[2 \ldots 6]$$$ are Decinc.

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM, foldrM)

-- road map in reverse, and the number of cities, init pen state
type Domain = (Int,IOUArray Int Int, IOUArray Int Int, IOUArray Int Int, IOUArray Int Int)
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

parse :: IO Domain
parse = do
  [number] <- readChar8
  lst <- readChar8
  xs <- newListArray (1, number) lst
  dp <- newArray (1, number) maxBound
  pd <- newArray (1, number) minBound
  ans <- newArray (1, number+1) 0
  return (number, xs, dp, pd, ans)

-- showArray ans = print =<< getElems ans

solve :: Solver
solve (size, lst, dp, pd, ans) = do
  result
  where
    result = foldrM go 0 $ [1.. size]
    go :: Int -> Int -> IO Int
    go index x = do
      sa maxBound minBound index
      s <- readArray ans (index+1)
      writeArray ans index (s+1)
      return (x+s+1)
    sa :: Int -> Int -> Int -> IO ()
    sa a b i
      | a == minBound && b == maxBound = writeArray ans i 0
      | i == size = return ()
      | otherwise = do
            x <- readArray lst i
            y <- readArray lst (i+1)
            let a1 = if (b < y) then x else minBound
            let a2 = if (x < y) then (max a1 a) else a1
            let b1 = if (a > y) then x else maxBound
            let b2 = if (x > y) then (min b1 b) else b1
            a3 <- readArray dp i
            b3 <- readArray pd i
            when (a3 /= a2 || b3 /= b2)
              (do
                writeArray dp i a2
                writeArray pd i b2
                sa a2 b2 (i+1)
                s <- readArray ans (i+1)
                writeArray ans i (s+1))

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)

-- road map in reverse, and the number of cities, init pen state
type Domain = (Int,IOUArray Int Int, IOUArray Int Int, IOUArray Int Int, IOUArray Int Int)
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

parse :: IO Domain
parse = do
  [number] <- readChar8
  lst <- readChar8
  xs <- newListArray (1, number) lst
  dp <- newArray (1, number) maxBound
  pd <- newArray (1, number) minBound
  ans <- newArray (1, number+1) 0
  return (number, xs, dp, pd, ans)

-- showArray ans = print =<< getElems ans

solve :: Solver
solve (size, lst, dp, pd, ans) = do
  result
  where
    result = foldM go 0 $ reverse [1.. size]
    go :: Int -> Int -> IO Int
    go x index = do
      sa maxBound minBound index
      s <- readArray ans (index+1)
      writeArray ans index (s+1)
      return (x+s+1)
    sa :: Int -> Int -> Int -> IO ()
    sa a b i
      | a == minBound && b == maxBound = writeArray ans i 0
      | i == size = return ()
      | otherwise = do
            x <- readArray lst i
            y <- readArray lst (i+1)
            let a1 = if (b < y) then x else minBound
            let a2 = if (x < y) then (max a1 a) else a1
            let b1 = if (a > y) then x else maxBound
            let b2 = if (x > y) then (min b1 b) else b1
            a3 <- readArray dp i
            b3 <- readArray pd i
            when (a3 /= a2 || b3 /= b2)
              (do
                writeArray dp i a2
                writeArray pd i b2
                sa a2 b2 (i+1)
                s <- readArray ans (i+1)
                writeArray ans i (s+1))

main :: IO ()
main = do
  printAns =<< solve =<< parse

{-# LANGUAGE LambdaCase #-}
module Main where

import Control.Monad (liftM2, replicateM_, replicateM, foldM, when)
import Data.Char (digitToInt)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.ByteString.Char8 as C
import Data.Map.Strict (Map, insert, alter, empty, (!), (!?), fromList, fromListWith, mapWithKey, findWithDefault, unionWithKey, traverseWithKey, mapKeys, filterWithKey, mapKeysWith)
import Data.List (group, sort)
import Data.Set (Set, deleteFindMin, union)
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import Data.Function (on)
-- import System.Random
import Data.Array.MArray (newArray, readArray, writeArray, newListArray)
import Data.Array.IO (IOUArray, getElems)
import Debug.Trace
import Data.Bool (bool)
import Data.Foldable (foldlM)

-- road map in reverse, and the number of cities, init pen state
type Domain = (Int,IOUArray Int Int, IOUArray Int Int, IOUArray Int Int, IOUArray Int Int)
type CoDomain = Int
type Solver  = Domain -> IO CoDomain

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

printAns :: CoDomain -> IO ()
printAns = print

parse :: IO Domain
parse = do
  [number] <- readChar8
  lst <- readChar8
  xs <- newListArray (1, number) lst
  dp <- newArray (1, number) maxBound
  pd <- newArray (1, number) minBound
  ans <- newArray (1, number+1) 0
  return (number, xs, dp, pd, ans)

-- showArray ans = print =<< getElems ans

solve :: Solver
solve (size, lst, dp, pd, ans) = do
  result
  where
    result = fmap sum $ mapM go $ reverse [1.. size]
    go :: Int -> IO Int
    go index = do
      sa maxBound minBound index
      s <- readArray ans (index+1)
      writeArray ans index (s+1)
      -- showArray ans
      return (s+1)
    sa :: Int -> Int -> Int -> IO ()
    sa a b i
      | a == minBound && b == maxBound = writeArray ans i 0
      | i == size = return ()
      | otherwise = do
            x <- readArray lst i
            y <- readArray lst (i+1)
            let a1 = if (b < y) then x else minBound
            let a2 = if (x < y) then (max a1 a) else a1
            let b1 = if (a > y) then x else maxBound
            let b2 = if (x > y) then (min b1 b) else b1
            a3 <- readArray dp i
            b3 <- readArray pd i
            when (a3 /= a2 || b3 /= b2)
              (do
                writeArray dp i a2
                writeArray pd i b2
                sa a2 b2 (i+1)
                s <- readArray ans (i+1)
                writeArray ans i (s+1))

main :: IO ()
main = do
  printAns =<< solve =<< parse


You are given a string s consisting only of characters 0 and 1. A substring [l, r] of s is a string slsl + 1sl + 2... sr, and its length equals to r - l + 1. A substring is called balanced if the number of zeroes (0) equals to the number of ones in this substring.You have to determine the length of the longest balanced substring of s.

The first line contains n (1 ≤ n ≤ 100000) — the number of characters in s. The second line contains a string s consisting of exactly n characters. Only characters 0 and 1 can appear in s.

If there is no non-empty balanced substring in s, print 0. Otherwise, print the length of the longest balanced substring.

NoteIn the first example you can choose the substring [3, 6]. It is balanced, and its length is 4. Choosing the substring [2, 5] is also possible.In the second example it's impossible to find a non-empty balanced substring.

import Data.IntMap
main = getLine >> fmap (maximum . fmap (uncurry (-)) . elems . fromListWith (\(r, l) (r', l') -> (max r r' :: Int, min l l' :: Int)) . zipWith (\i d -> (d, (i, i))) [0..] . scanl (+) 0 . fmap (\x -> if x == '1' then 1 else -1)) getLine >>= print

import Control.Applicative

main = print =<< liftA2 solve (read <$> getLine) getLine

solve n xs = 2 * search 0 (n `quot` 2 + 1)
  where
  nos = scanl (+) 0 $ map (\x -> fromEnum x - fromEnum '0') xs
  ok h = or (zipWith (\i i' -> i' - i == h) nos $ drop (2 * h) nos)
  search l r
    | r - l <= 1 = l
    | ok m = search m r
    | otherwise = search l m
    where m = l + (r - l) `div` 2

import Control.Applicative

main = print =<< liftA2 solve (read <$> getLine) getLine

solve n xs = 2 * search 0 (n `quot` 2 + 1)
  where
  nos = scanl (+) 0 $ map (\x -> fromEnum x - fromEnum '0') $ takeWhile (\x -> x == '0' || x == '1') xs
  ok h = or (zipWith (\i i' -> i' - i == h) nos $ drop (2 * h) nos)
  search l r
    | r - l <= 1 = l
    | ok m = search m r
    | otherwise = search l m
    where m = l + (r - l) `quot` 2

import Control.Applicative

main = print =<< liftA2 solve (read <$> getLine) getLine

solve n xs = 2 * search 0 (n `quot` 2 + 1)
  where
  nos = scanl (+) 0 $ map (\x -> fromEnum (x == '1')) $ take n xs
  ok h = or (zipWith (\i i' -> i' - i == h) nos $ drop (2 * h) nos)
  search l r
    | r - l <= 1 = l
    | ok m = search m r
    | otherwise = search l m
    where m = l + (r - l) `quot` 2


You are given a permutation $$$a_1,a_2,\ldots,a_n$$$ of integers from $$$0$$$ to $$$n - 1$$$. Your task is to find how many permutations $$$b_1,b_2,\ldots,b_n$$$ are similar to permutation $$$a$$$. Two permutations $$$a$$$ and $$$b$$$ of size $$$n$$$ are considered similar if for all intervals $$$[l,r]$$$ ($$$1 \le l \le r \le n$$$), the following condition is satisfied: $$$$$$\operatorname{MEX}([a_l,a_{l+1},\ldots,a_r])=\operatorname{MEX}([b_l,b_{l+1},\ldots,b_r]),$$$$$$ where the $$$\operatorname{MEX}$$$ of a collection of integers $$$c_1,c_2,\ldots,c_k$$$ is defined as the smallest non-negative integer $$$x$$$ which does not occur in collection $$$c$$$. For example, $$$\operatorname{MEX}([1,2,3,4,5])=0$$$, and $$$\operatorname{MEX}([0,1,2,4,5])=3$$$.Since the total number of such permutations can be very large, you will have to print its remainder modulo $$$10^9+7$$$.In this problem, a permutation of size $$$n$$$ is an array consisting of $$$n$$$ distinct integers from $$$0$$$ to $$$n-1$$$ in arbitrary order. For example, $$$[1,0,2,4,3]$$$ is a permutation, while $$$[0,1,1]$$$ is not, since $$$1$$$ appears twice in the array. $$$[0,1,3]$$$ is also not a permutation, since $$$n=3$$$ and there is a $$$3$$$ in the array.

Each test contains multiple test cases. The first line of input contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. The following lines contain the descriptions of the test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the size of permutation $$$a$$$. The second line of each test case contains $$$n$$$ distinct integers $$$a_1,a_2,\ldots,a_n$$$ ($$$0 \le a_i \lt n$$$) — the elements of permutation $$$a$$$. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$10^5$$$.

For each test case, print a single integer, the number of permutations similar to permutation $$$a$$$, taken modulo $$$10^9+7$$$.

NoteFor the first test case, the only permutations similar to $$$a=[4,0,3,2,1]$$$ are $$$[4,0,3,2,1]$$$ and $$$[4,0,2,3,1]$$$.For the second and third test cases, the given permutations are only similar to themselves.For the fourth test case, there are $$$4$$$ permutations similar to $$$a=[1,2,4,0,5,3]$$$:   $$$[1,2,4,0,5,3]$$$;  $$$[1,2,5,0,4,3]$$$;  $$$[1,4,2,0,5,3]$$$;  $$$[1,5,2,0,4,3]$$$.

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x
--
-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

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

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

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

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

m :: Int64
-- m = 998_244_353
m = 10 ^ 9 + 7

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

mI :: Int -> M
mI = M . fromIntegral

instance Show M where
    show (M v) = "M" ++ show v

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int64
solve n as = unM $ solve' 0 (n + 1, -1) iAs
    where
        iAs = sort $ zip as [1 .. n]

        solve' :: Int -> (Int, Int) -> [(Int, Int)] -> M
        solve' _ _ [] = M 1
        solve' k is@(minI, maxI) iAs@((a, i):otherIas) =
            if minI <= i && i <= maxI
                then cnt * solve' (k + 1) is otherIas
                else solve' (k + 1) (min minI i, max maxI i) otherIas
            where
                cntPlaces = maxI - minI - k + 1
                cnt = M $ fromIntegral cntPlaces

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%lld\n" answer

import           Data.List

modulo :: Int
modulo = 1000000007

data State = State { left :: Int, right :: Int, fix :: Int }
data PermElement = PermElement { el :: Int, pos :: Int } deriving (Ord, Eq)
data TraverseHelperResult = TraverseHelperResult { multiplier :: Int, addfx :: Int }

traversePermutation :: [PermElement] -> State -> Int
traversePermutation [] state = 1
traversePermutation (head:permelements) (State {left = sleft, right = sright, fix = sfix})
    | pos head < sleft || pos head > sright = (let helperRes = (traverseHelper permelements (State (min sleft $ pos head) (max sright $ pos head) $ sfix + 1)) in (multiplier helperRes) * (traversePermutation permelements (State (min sleft $ pos head) (max sright $ pos head) (addfx helperRes))) `mod` modulo)
    | otherwise = traversePermutation permelements $ State sleft sright sfix

traverseHelper :: [PermElement] -> State -> TraverseHelperResult
traverseHelper [] state = TraverseHelperResult 1 $ fix state
traverseHelper (head:permelements) (State {left = sleft, right = sright, fix = sfix})
    | sleft <= (pos head) && (pos head) <= sright = (let subres = (traverseHelper permelements $ State sleft sright (sfix + 1)) in TraverseHelperResult ((sright - sleft + 1 - sfix) * (multiplier subres) `mod` modulo) (addfx subres))
    | otherwise = TraverseHelperResult 1 sfix

solveCase :: IO ()
solveCase = do
--    line_n <- getLine
    n <- fmap read getLine :: IO Int
    arr <- fmap (map read . words) getLine :: IO [Int]
    let sarr = sort [PermElement x i | (x, i) <- zip arr [0..n - 1]] in putStrLn $ show $ traversePermutation (tail sarr) (State (pos (head sarr)) (pos (head sarr)) 1)

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)

import           Data.List
import qualified Data.Set as Set

modulo :: Int
modulo = 1000000007

data State = State { left :: Int, right :: Int, fix :: Int }
data PermElement = PermElement { el :: Int, pos :: Int } deriving (Ord, Eq)
data TraverseHelperResult = TraverseHelperResult { multiplier :: Int, addfx :: Int }

traversePermutation :: [PermElement] -> State -> Int
traversePermutation [] state = 1
traversePermutation (head:permelements) (State {left = sleft, right = sright, fix = sfix})
    | pos head < sleft || pos head > sright = (let helperRes = (traverseHelper permelements (State (min sleft $ pos head) (max sright $ pos head) $ sfix + 1)) in (multiplier helperRes) * (traversePermutation permelements (State (min sleft $ pos head) (max sright $ pos head) (addfx helperRes))) `mod` modulo)
    | otherwise = traversePermutation permelements $ State sleft sright sfix

traverseHelper :: [PermElement] -> State -> TraverseHelperResult
traverseHelper [] state = TraverseHelperResult 1 $ fix state
traverseHelper (head:permelements) (State {left = sleft, right = sright, fix = sfix})
    | sleft <= (pos head) && (pos head) <= sright = (let subres = (traverseHelper permelements $ State sleft sright (sfix + 1)) in TraverseHelperResult ((sright - sleft + 1 - sfix) * (multiplier subres) `mod` modulo) (addfx subres))
    | otherwise = TraverseHelperResult 1 sfix

solveCase :: IO ()
solveCase = do
    line_n <- getLine
    let n = read line_n :: Int
    line_arr <- getLine
    let arr = map (\x -> (read x :: Int)) $ words line_arr
    let sarr = sort [PermElement x i | (x, i) <- zip arr [0..n - 1]] in putStrLn $ show $ traversePermutation (tail sarr) (State (pos (head sarr)) (pos (head sarr)) 1)

solve :: Int -> IO ()
solve 0 = do
    return ()
solve cases_left = do
    solveCase
    solve $ cases_left - 1

main = do
    s_testcases <- getLine
    solve $ (read s_testcases :: Int)


The construction of subway in Bertown is almost finished! The President of Berland will visit this city soon to look at the new subway himself.There are n stations in the subway. It was built according to the Bertown Transport Law:  For each station i there exists exactly one train that goes from this station. Its destination station is pi, possibly pi = i;  For each station i there exists exactly one station j such that pj = i. The President will consider the convenience of subway after visiting it. The convenience is the number of ordered pairs (x, y) such that person can start at station x and, after taking some subway trains (possibly zero), arrive at station y (1 ≤ x, y ≤ n).The mayor of Bertown thinks that if the subway is not convenient enough, then the President might consider installing a new mayor (and, of course, the current mayor doesn't want it to happen). Before President visits the city mayor has enough time to rebuild some paths of subway, thus changing the values of pi for not more than two subway stations. Of course, breaking the Bertown Transport Law is really bad, so the subway must be built according to the Law even after changes.The mayor wants to do these changes in such a way that the convenience of the subway is maximized. Help him to calculate the maximum possible convenience he can get!

The first line contains one integer number n (1 ≤ n ≤ 100000) — the number of stations. The second line contains n integer numbers p1, p2, ..., pn (1 ≤ pi ≤ n) — the current structure of the subway. All these numbers are distinct.

Print one number — the maximum possible value of convenience.

NoteIn the first example the mayor can change p2 to 3 and p3 to 1, so there will be 9 pairs: (1, 1), (1, 2), (1, 3), (2, 1), (2, 2), (2, 3), (3, 1), (3, 2), (3, 3).In the second example the mayor can change p2 to 4 and p3 to 5.

module Main where

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Graph
import Data.List (sort)
import Data.Tree
import qualified Data.ByteString.Lazy.Char8 as L

data Metro = Metro { next :: [Int] } deriving (Show, Eq)

treeSize :: Tree a -> Int
treeSize node = succ . sum $ map treeSize (subForest node)

getCirclesSizes :: Metro -> [Int]
getCirclesSizes (Metro ps) = map treeSize $ dfs graph [0 .. n - 1]
    where n = length (ps)
          edges = zip [0 ..] (map pred ps)
          graph = buildG (0, n - 1) edges

solve :: Metro -> Integer
solve m = case sizes of
            [x] -> sqr x
            (x:y:zs) -> sum $ map sqr (x + y:zs)
    where sizes = map fromIntegral . reverse . sort $ getCirclesSizes m
          sqr x = x * x

test0 = Metro [2, 1, 3]
test1 = Metro [1, 5, 4, 3, 2]

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                               Just (x, _) -> (x, ss)
                               Nothing -> error $ "Can't parse Int:" ++ (L.unpack s)

go :: Tokenizer Integer
go = do
  n <- nextInt
  ps <- replicateM n nextInt
  return . solve $ Metro ps

main :: IO ()
main = do
  input <- L.words <$> L.getContents
  let result = evalState go input
  print result

module Main where

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Graph
import Data.List (sort)
import Data.Tree
import qualified Data.ByteString.Lazy.Char8 as L

data Metro = Metro { next :: [Int] } deriving (Show, Eq)

treeSize :: Tree a -> Int
treeSize = length . flatten

getCirclesSizes :: Metro -> [Int]
getCirclesSizes (Metro ps) = map treeSize $ dfs graph [0 .. n - 1]
    where n = length (ps)
          edges = zip [0 ..] (map pred ps)
          graph = buildG (0, n - 1) edges

solve :: Metro -> Integer
solve m = case sizes of
            [x] -> sqr x
            (x:y:zs) -> sum $ map sqr (x + y:zs)
    where sizes = map fromIntegral . reverse . sort $ getCirclesSizes m
          sqr x = x * x

test0 = Metro [2, 1, 3]
test1 = Metro [1, 5, 4, 3, 2]

type Tokenizer = State [L.ByteString]

nextInt :: Tokenizer Int
nextInt = state $ \(s:ss) -> case L.readInt s of
                               Just (x, _) -> (x, ss)
                               Nothing -> error $ "Can't parse Int:" ++ (L.unpack s)

go :: Tokenizer Integer
go = do
  n <- nextInt
  ps <- replicateM n nextInt
  return . solve $ Metro ps

main :: IO ()
main = do
  input <- L.words <$> L.getContents
  let result = evalState go input
  print result

import Data.Graph
import Data.Foldable(Foldable(foldl'))
import Data.Int
import Data.List(sortBy)
main = getContents >>= print . exec
exec = solve . map read . words
solve (n:xs) = case sortBy (flip compare) $ map (foldl' (\l _ -> l + 1) 0) $ scc $ buildG (1, n) $ zip [1..] xs of
  (a:b:as) -> sum $ map (\x -> fromIntegral x ^ 2 :: Int64) $ (a + b):as
  [a] -> fromIntegral $ a^2

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = do
    n:_ <- readInts
    input <- readInts
    let list = map (\x -> fromIntegral . length . flatten $ x ::Int64) . components $ buildG (1,n) $ zip [1..n] input
    if null $ tail list
        then print $ (head list)^2
        else
            let max1 = maximum list
                list1= list\\[max1]
                max2 = maximum list1
                in print $ (max1+max2)^2 - max2^2 + (foldl' (+) 0 . map (^2) $ list1)

{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = do
    n:_ <- readInts
    input <- readInts
    let list = map (length.flatten) . components $ buildG (1,n) $ zip [1..n] input
    if null $ tail list
        then print $ n*n
        else
            let max1 = maximum list ::Int
                list1= list\\[max1]
                max2 = maximum list1 ::Int
                in print $ (max1+max2)^2 - max2^2 + (foldl' (+) 0 . map (^2) $ list1)

{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
--import qualified Data.HashTable.IO as B
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = do
    n:_ <- readInts
    input <- readInts
    let list = map (length.flatten) . components $ buildG (1,n) $ zip [1..n] input
    if null $ tail list
        then print $ n*n
        else
            let max1 = maximum list
                list1= list\\[max1]
                max2 = maximum list1
                in print $ (max1+max2)^2 - max2^2 + (foldl' (+) 0 . map (^2) $ list1)

{-main :: IO ()
main = do
    print 3
    where gg=H.fromList-}


Alice has a cute cat. To keep her cat fit, Alice wants to design an exercising walk for her cat! Initially, Alice's cat is located in a cell $$$(x,y)$$$ of an infinite grid. According to Alice's theory, cat needs to move:   exactly $$$a$$$ steps left: from $$$(u,v)$$$ to $$$(u-1,v)$$$;  exactly $$$b$$$ steps right: from $$$(u,v)$$$ to $$$(u+1,v)$$$;  exactly $$$c$$$ steps down: from $$$(u,v)$$$ to $$$(u,v-1)$$$;  exactly $$$d$$$ steps up: from $$$(u,v)$$$ to $$$(u,v+1)$$$. Note that the moves can be performed in an arbitrary order. For example, if the cat has to move $$$1$$$ step left, $$$3$$$ steps right and $$$2$$$ steps down, then the walk right, down, left, right, right, down is valid.Alice, however, is worrying that her cat might get lost if it moves far away from her. So she hopes that her cat is always in the area $$$[x_1,x_2]\times [y_1,y_2]$$$, i.e. for every cat's position $$$(u,v)$$$ of a walk $$$x_1 \le u \le x_2$$$ and $$$y_1 \le v \le y_2$$$ holds.Also, note that the cat can visit the same cell multiple times.Can you help Alice find out if there exists a walk satisfying her wishes?Formally, the walk should contain exactly $$$a+b+c+d$$$ unit moves ($$$a$$$ to the left, $$$b$$$ to the right, $$$c$$$ to the down, $$$d$$$ to the up). Alice can do the moves in any order. Her current position $$$(u, v)$$$ should always satisfy the constraints: $$$x_1 \le u \le x_2$$$, $$$y_1 \le v \le y_2$$$. The staring point is $$$(x, y)$$$.You are required to answer $$$t$$$ test cases independently.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of testcases.  The first line of each test case contains four integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$ ($$$0 \le a,b,c,d \le 10^8$$$, $$$a+b+c+d \ge 1$$$). The second line of the test case contains six integers $$$x$$$, $$$y$$$, $$$x_1$$$, $$$y_1$$$, $$$x_2$$$, $$$y_2$$$ ($$$-10^8 \le x_1\le x \le x_2 \le 10^8$$$, $$$-10^8 \le y_1 \le y \le y_2 \le 10^8$$$).

For each test case, output "YES" in a separate line, if there exists a walk satisfying her wishes. Otherwise, output "NO" in a separate line.  You can print each letter in any case (upper or lower).

NoteIn the first test case, one valid exercising walk is $$$$$$(0,0)\rightarrow (-1,0) \rightarrow (-2,0)\rightarrow (-2,1) \rightarrow (-2,2)\rightarrow (-1,2)\rightarrow(0,2)\rightarrow (0,1)\rightarrow (0,0) \rightarrow (-1,0)$$$$$$

main = getLine >>= test.read
test 0 = return ()
test t = do
  (a:b:c:d:_) <- map read.words <$> getLine
  (x:y:x1:y1:x2:y2:_) <- map read.words <$> getLine
  let x' = x + b - a
      y' = y + d - c
  if x1 <= x' && x' <= x2 && y1 <= y' && y' <= y2 && (x1 /= x2 || (a == 0 && b == 0)) && (y1 /= y2 || (c == 0 && d == 0))
    then putStrLn "YES"
    else putStrLn "NO"
  test $ pred t

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        [a,b,c,d] <- map read . words <$> getLine
        [x,y,x1,y1,x2,y2] <- map read . words <$> getLine
        if b - a > x2 - x ||
           b - a < x1 - x ||
           d - c > y2 - y ||
           d - c < y1 - y ||
           (a > 0 || b > 0) && x2 - x1 == 0 ||
           (c > 0 || d > 0) && y2 - y1 == 0 then
            putStrLn "No"
        else
            putStrLn "Yes"

type Point = (Int, Int)

solve :: Point -> Point -> Point -> Int -> Int -> Int -> Int -> Bool
solve (inix, iniy) (lbx, lby) (rtx, rty) a b c d = x >= lbx && x <= rtx && lby <= y && y <= rty &&
                                                   cornerCase (inix, iniy) (lbx, lby) (rtx, rty) a b c d
  where x = inix - a + b
        y = iniy - c + d

cornerCase :: Point -> Point -> Point -> Int -> Int -> Int -> Int -> Bool
cornerCase (inix, iniy) (lbx, lby) (rtx, rty) a b c d
  | inix == lbx && inix == rtx = a == 0 && b == 0 && if iniy == lby && iniy == rty then c == 0 && d == 0 else True
  | iniy == lby && iniy == rty = c == 0 && d == 0 && if inix == lbx && inix == rtx then a == 0 && b == 0 else True
  | otherwise = True

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (take n arr):(groupByNLines n (drop n arr))

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

parse :: [String] -> String
parse [fstLine, sndLine]
  | solve (x, y) (x1, y1) (x2, y2) a b c d = "YES"
  | otherwise = "NO"
  where [a, b, c, d] = map readInt $ words fstLine
        [x, y, x1, y1, x2, y2] = map readInt $ words sndLine

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)

type Point = (Int, Int)

solve :: Point -> Point -> Point -> Int -> Int -> Int -> Int -> Bool
solve (inix, iniy) (lbx, lby) (rtx, rty) a b c d
  | inix == lbx && inix == rtx = a == 0 && b == 0 && if iniy == lby && iniy == rty then c == 0 && d == 0 else lby <= y && y <= rty
  | iniy == lby && iniy == rty = c == 0 && d == 0 && if inix == lbx && inix == rtx then a == 0 && b == 0 else x >= lbx && x <= rtx
  | otherwise = x >= lbx && x <= rtx && lby <= y && y <= rty
  where x = inix - a + b
        y = iniy - c + d

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (take n arr):(groupByNLines n (drop n arr))

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

parse :: [String] -> String
parse [fstLine, sndLine]
  | solve (x, y) (x1, y1) (x2, y2) a b c d = "YES"
  | otherwise = "NO"
  where [a, b, c, d] = map readInt $ words fstLine
        [x, y, x1, y1, x2, y2] = map readInt $ words sndLine

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)

type Point = (Int, Int)

-- solve :: Point -> Point -> Point -> Int -> Int -> Int -> Int -> Bool
solve (iniX, iniY) (lbX, lbY) (rtX, rtY) a b c d
  | iniX == lbX && iniX == rtX = a == 0 && b == 0 && if iniY == lbY && iniY == rtY then c == 0 && d == 0 else True
  | iniY == lbY && iniY == rtY = c == 0 && d == 0 && if iniX == lbX && iniX == rtX then a == 0 && b == 0 else True
  | otherwise = x >= lbX && x <= rtX && lbY <= y && y <= rtY
  where x = iniX - a + b
        y = iniY - c + d

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (take n arr):(groupByNLines n (drop n arr))

parse :: [String] -> String
parse [fstLine, sndLine]
  | solve (x, y) (x1, y1) (x2, y2) a b c d = "YES"
  | otherwise = "NO"
  where [a, b, c, d] = map (\x -> read x :: Int) $ words fstLine
        [x, y, x1, y1, x2, y2] = map (\x -> read x :: Int) $ words sndLine

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)

type Point = (Int, Int)

solve :: Point -> Point -> Point -> Int -> Int -> Int -> Int -> Bool
solve (iniX, iniY) (lbX, lbY) (rtX, rtY) a b c d
  | iniX == lbX && iniX == rtX = a == 0 && b == 0
  | iniY == lbY && iniY == rtY = c == 0 && d == 0
  | otherwise = x >= lbX && x <= rtX && lbY <= y && y <= rtY
  where x = iniX - a + b
        y = iniY - c + d

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n arr = (take n arr):(groupByNLines n (drop n arr))

parse :: [String] -> String
parse [fstLine, sndLine]
  | solve (x, y) (x1, y1) (x2, y2) a b c d = "YES"
  | otherwise = "NO"
  where [a, b, c, d] = map (\x -> read x :: Int) $ words fstLine
        [x, y, x1, y1, x2, y2] = map (\x -> read x :: Int) $ words sndLine

main :: IO ()
main = interact (unlines . map parse . groupByNLines 2 . tail . lines)