One day Natalia was walking in the woods when she met a little mushroom gnome. The gnome told her the following story:Everybody knows that the mushroom gnomes' power lies in the magic mushrooms that grow in the native woods of the gnomes. There are n trees and m magic mushrooms in the woods: the i-th tree grows at a point on a straight line with coordinates ai and has the height of hi, the j-th mushroom grows at the point with coordinates bj and has magical powers zj.But one day wild mushroommunchers, the sworn enemies of mushroom gnomes unleashed a terrible storm on their home forest. As a result, some of the trees began to fall and crush the magic mushrooms. The supreme oracle of mushroom gnomes calculated in advance the probability for each tree that it will fall to the left, to the right or will stand on. If the tree with the coordinate x and height h falls to the left, then all the mushrooms that belong to the right-open interval [x - h, x), are destroyed. If a tree falls to the right, then the mushrooms that belong to the left-open interval (x, x + h] are destroyed. Only those mushrooms that are not hit by a single tree survive.Knowing that all the trees fall independently of each other (i.e., all the events are mutually independent, and besides, the trees do not interfere with other trees falling in an arbitrary direction), the supreme oracle was also able to quickly calculate what would be the expectation of the total power of the mushrooms which survived after the storm. His calculations ultimately saved the mushroom gnomes from imminent death.Natalia, as a good Olympiad programmer, got interested in this story, and she decided to come up with a way to quickly calculate the expectation of the sum of the surviving mushrooms' power.

The first line contains two integers n and m (1 ≤ n ≤ 105, 1 ≤ m ≤ 104) — the number of trees and mushrooms, respectively. Each of the next n lines contain four integers — ai, hi, li, ri (|ai| ≤ 109, 1 ≤ hi ≤ 109, 0 ≤ li, ri, li + ri ≤ 100) which represent the coordinate of the i-th tree, its height, the percentage of the probabilities that the tree falls to the left and to the right, respectively (the remaining percentage is the probability that the tree will stand on). Each of next m lines contain two integers bj, zj (|bj| ≤ 109, 1 ≤ zj ≤ 103) which represent the coordinate and the magical power of the j-th mushroom, respectively. An arbitrary number of trees and mushrooms can grow in one point.

Print a real number — the expectation of the total magical power of the surviving mushrooms. The result is accepted with relative or absolute accuracy 10 - 4.

NoteIt is believed that the mushroom with the coordinate x belongs to the right-open interval [l, r) if and only if l ≤ x < r. Similarly, the mushroom with the coordinate x belongs to the left-open interval (l, r] if and only if l < x ≤ r.In the first test the mushroom survives with the probability of 50%, depending on where the single tree falls.In the second test the mushroom survives only if neither of the two trees falls on it. It occurs with the probability of 50%  ×  50% = 25%.Pretest №12 is the large test with 105 trees and one mushroom.

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sort, foldl')
import Data.Function (on)
import qualified Data.Map as M

data Event
  = TreePoint Double Int
  | Mushroom Integer
  deriving (Show, Ord, Eq)

log100 :: Double
log100 = log 100

minusInfinity = log 0
plusInfinity = abs minusInfinity

makeTree prob =
  if abs prob == plusInfinity then
    TreePoint 0 (if prob < 0 then -1 else 1)
  else
    TreePoint prob 0

treeToPoints [pos', height', leftProb', rightProb'] =
  let
    pos = pos' * 2
    height = height' * 2 + 1
    leftProb = log (100 - fromIntegral leftProb') - log100
    rightProb = log (100 - fromIntegral rightProb') - log100
  in
    leftProb `seq` rightProb `seq` pos `seq` height `seq`
    [ (pos - height, makeTree leftProb)
    , (pos - 1, makeTree (-leftProb))
    , (pos + 1, makeTree rightProb)
    , (pos + height, makeTree (-rightProb))
    ]
treeToPoints x = error $ "malformed tree " ++ show x

mushroomToPoint [pos', power] =
  let
    pos = pos' * 2
  in
    pos `seq` power `seq`
    (pos, Mushroom power)
mushroomToPoint x = error $ "malformed mushroom " ++ show x

folder :: (Double, Int, Double) -> (Integer, Event) -> (Double, Int, Double)
folder whole@(currentProb, destruction, magic) (_, Mushroom power) =
  if destruction == 0 then
    currentProb `seq` magic `seq`
      ( currentProb
      , destruction
      , magic + fromIntegral power * exp currentProb
      )
  else
    whole
folder (currentProb, destruction, magic) (_, TreePoint prob destr) =
  currentProb `seq` destruction `seq`
  ( currentProb + prob
  , destruction + destr
  , magic
  )

combiner :: Event -> Event -> Event
combiner (TreePoint prob1 destr1) (TreePoint prob2 destr2) =
  TreePoint (prob1 + prob2) (destr1 + destr2)
combiner (Mushroom power1) (Mushroom power2) =
  Mushroom (power1 + power2)

readInt :: B.ByteString -> Integer
readInt = fromIntegral . fst . fromJust . B.readInteger

readLine = B.getLine >>= return . map readInt . B.words

main = do
  [treesNumber, mushroomsNumber] <- readLine
  trees <- sequence . take (fromIntegral treesNumber) . repeat $ readLine
  mushrooms <- sequence . take (fromIntegral mushroomsNumber) . repeat $ readLine
  B.putStrLn . B.pack . show . (\(_,_,x)->x) . foldl' folder (0, 0, 0) . M.toAscList . foldl' (flip . uncurry $ (M.insertWith combiner)) M.empty $
    concatMap treeToPoints trees ++ map mushroomToPoint mushrooms

import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sortBy)
import Data.Function (on)

data PositionKind
  = Before
  | Here
  | After
  deriving (Show, Ord, Eq)

data Event
  = TreePoint Int
  | Mushroom Int
  deriving (Show)

treeToPoints [pos, height, leftProb, rightProb] =
  filter
    (\(_, TreePoint x) -> x /= 0)
    [ ((pos - height, Before), TreePoint leftProb)
    , ((pos, Before), TreePoint (-leftProb))
    , ((pos, After), TreePoint rightProb)
    , ((pos + height, After), TreePoint (-rightProb))
    ]
treeToPoints _ = error "malformed tree"

mushroomToPoint [pos, power] =
  ((pos, Here), Mushroom power)
mushroomToPoint _ = error "malformed mushroom"

folder :: (Int, Int, [Bool], Float) -> ((Int, PositionKind), Event) -> (Int, Int, [Bool], Float)
folder whole@(currentProb, denom, destruction, magic) (_, Mushroom power) =
  if destruction == [] then
    ( currentProb
    , denom
    , destruction
    , magic +
        fromIntegral power
          * fromIntegral currentProb
          / fromIntegral denom
    )
  else
    whole
folder (currentProb, denom, destruction, magic) (_, TreePoint prob) =
  if abs prob == 100 then
    ( currentProb
    , denom
    , if prob > 0 then
        True : destruction
      else
        drop 1 destruction
    , magic
    )
  else
    if prob > 0 then
      (currentProb * (100 - prob), denom * 100, destruction, magic)
    else
      (currentProb `div` (100 + prob), denom `div` 100, destruction, magic)

readInt = fromIntegral . fst . fromJust . B.readInteger

readLine = B.getLine >>= return . map readInt . B.words

main = do
  [treesNumber, mushroomsNumber] <- readLine
  trees <- sequence . take treesNumber . repeat $ readLine
  mushrooms <- sequence . take mushroomsNumber . repeat $ readLine
  B.putStrLn . B.pack . show . (\(_,_,_,x)->x) . foldl folder (1, 1, [], 0) . sortBy (compare `on` fst) $
    concatMap treeToPoints trees ++ map mushroomToPoint mushrooms


I guess there's not much point in reminding you that Nvodsk winters aren't exactly hot. That increased the popularity of the public transport dramatically. The route of bus 62 has exactly n stops (stop 1 goes first on its way and stop n goes last). The stops are positioned on a straight line and their coordinates are 0 = x1 < x2 < ... < xn. Each day exactly m people use bus 62. For each person we know the number of the stop where he gets on the bus and the number of the stop where he gets off the bus. A ticket from stop a to stop b (a < b) costs xb - xa rubles. However, the conductor can choose no more than one segment NOT TO SELL a ticket for. We mean that conductor should choose C and D (С <= D) and sell a ticket for the segments [A, C] and [D, B], or not sell the ticket at all. The conductor and the passenger divide the saved money between themselves equally. The conductor's "untaxed income" is sometimes interrupted by inspections that take place as the bus drives on some segment of the route located between two consecutive stops. The inspector fines the conductor by c rubles for each passenger who doesn't have the ticket for this route's segment.You know the coordinated of all stops xi; the numbers of stops where the i-th passenger gets on and off, ai and bi (ai < bi); the fine c; and also pi — the probability of inspection on segment between the i-th and the i + 1-th stop. The conductor asked you to help him make a plan of selling tickets that maximizes the mathematical expectation of his profit.

The first line contains three integers n, m and c (2 ≤ n ≤ 150 000, 1 ≤ m ≤ 300 000, 1 ≤ c ≤ 10 000). The next line contains n integers xi (0 ≤ xi ≤ 109, x1 = 0, xi < xi + 1) — the coordinates of the stops on the bus's route. The third line contains n - 1 integer pi (0 ≤ pi ≤ 100) — the probability of inspection in percents on the segment between stop i and stop i + 1. Then follow m lines that describe the bus's passengers. Each line contains exactly two integers ai and bi (1 ≤ ai < bi ≤ n) — the numbers of stops where the i-th passenger gets on and off.

Print the single real number — the maximum expectation of the conductor's profit. Your answer will be considered correct if its absolute or relative error does not exceed 10 - 6.  Namely: let's assume that your answer is a, and the answer of the jury is b. The checker program will consider your answer correct, if .

NoteA comment to the first sample:The first and third passengers get tickets from stop 1 to stop 2. The second passenger doesn't get a ticket. There always is inspection on the segment 1-2 but both passengers have the ticket for it. There never is an inspection on the segment 2-3, that's why the second passenger gets away with the cheating. Our total profit is (0 + 90 / 2 + 90 / 2) = 90.

import Control.Applicative
import Control.Monad
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Monoid
import Data.Int
import Text.Printf

data Item = Item { itemSum :: Int64, itemLeft :: Int64, itemRight :: Int64, itemMax :: Int64 } deriving (Show)

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build l = a
	where
		n = length l
		a = listArray (1, 2*n - 1) $ map f [1..n-1] ++ map g l
		f i = (a ! (2*i)) <> (a ! (2*i + 1))
		g a = Item a b b b
			where b = max 0 a

query tree l r = itemMax $ query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1
		query' l r | l > r = mempty
		query' l r | odd l = (tree ! l) <> query' (l + 1) r
		query' l r | even r = query' l (r - 1) <> (tree ! r)
		query' l r = query' (l `div` 2) (r `div` 2)

{- getWords = map read . words <$> getLine  -}

toInt :: B.ByteString -> Int
toInt = fst . fromJust . C.readInt

toInt64 :: B.ByteString -> Int64
toInt64 s = fromIntegral $ toInt s

main = do
	[n, m, c] <- map toInt . B.split 32 <$> B.getLine
	[xs, ps] <- replicateM 2 $ map toInt64 . B.split 32 <$> B.getLine
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (* fromIntegral c) ps)
	let tree = build as
	ranges <- replicateM m $ (\[l, r] -> (l - 1, r - 2)) . map toInt . B.split 32 <$> B.getLine
	let rs = map (\(l, r) -> query tree l r) ranges
	printf "%f" $ (fromIntegral (sum rs) :: Double) / 100

{-# OPTIONS_GHC -O3 -optc-O3 #-}

import Control.Applicative
import Control.Monad
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Monoid
import Data.Int
import Text.Printf

data Item = Item { itemSum :: Int64, itemLeftMax :: Int64, itemRightMax :: Int64, itemMax :: Int64 } deriving (Show)

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

getInts = map (fst . fromJust . C.readInt) . C.words <$> B.getLine

main = do
	[n, m, c] <- getInts
	[xs, ps] <- replicateM 2 $ map fromIntegral <$> getInts
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (* fromIntegral c) ps)
	let tree = build $ map (\a -> let b = max 0 a in Item a b b b) as

	ranges <- replicateM m $ (\[l, r] -> (l - 1, r - 2)) <$> getInts
	let maxs = map (itemMax . uncurry (query tree)) ranges
	printf "%f" $ (fromIntegral $ sum maxs) / (100 :: Double)

{-# OPTIONS_GHC -O3 -optc-O3 #-}
{-# LANGUAGE UnicodeSyntax, MagicHash #-}

import Control.Applicative
import Control.Monad
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Monoid
import Data.Int
import Text.Printf

data Item = Item { itemSum :: {-# UNPACK #-} !Int64, itemLeftMax :: {-# UNPACK #-} !Int64, itemRightMax :: {-# UNPACK #-} !Int64, itemMax :: {-# UNPACK #-} !Int64 }

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

getInts = map (fst . fromJust . C.readInt) . C.words <$> B.getLine

main = do
	[n, m, c] ← getInts
	[xs, ps] ← replicateM 2 $ map fromIntegral <$> getInts
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (* fromIntegral c) ps)
	let tree = build $ map (\a → let b = max 0 a in Item a b b b) as

	ranges ← replicateM m $ (\[l, r] → (l - 1, r - 2)) <$> getInts
	let maxs = map (itemMax . uncurry (query tree)) ranges
	printf "%f" $ (fromIntegral $ sum maxs) / (100 :: Double)

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
{-# LANGUAGE UnicodeSyntax #-}

import Control.Applicative
import Control.Monad
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Monoid
import Data.Int
import Text.Printf

data Item = Item { itemSum :: !Int64, itemLeftMax :: !Int64, itemRightMax :: !Int64, itemMax :: !Int64 }

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

getInts = map (fst . fromJust . C.readInt) . C.words <$> B.getLine

main = do
	[n, m, c] ← getInts
	[xs, ps] ← replicateM 2 $ map fromIntegral <$> getInts
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (* fromIntegral c) ps)
	let tree = build $ map (\a → let b = max 0 a in Item a b b b) as

	ranges ← replicateM m $ (\[l, r] → (l - 1, r - 2)) <$> getInts
	let maxs = map (itemMax . uncurry (query tree)) ranges
	printf "%f" $ (fromIntegral $ sum maxs) / (100 :: Double)

{-# OPTIONS_GHC -O3 -optc-O3 #-}
{-# LANGUAGE UnicodeSyntax, MagicHash #-}

import Control.Applicative
import Control.Monad
import Data.Array
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Monoid
import Data.Int
import Text.Printf
import GHC.Prim

data Item = Item { itemSum :: !Int64, itemLeftMax :: !Int64, itemRightMax :: !Int64, itemMax :: !Int64 }

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build list = tree
	where
		n = length list
		tree = listArray (1, 2*n - 1) $ map value [1..n-1] ++ list
		value i = tree ! (2*i) <> tree ! (2*i + 1)

query tree l r = query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1

		query' l r
			| l > r = mempty
			| odd l = (tree ! l) <> query' (l + 1) r
			| even r = query' l (r - 1) <> (tree ! r)
			| otherwise = query' (l `div` 2) (r `div` 2)

getInts = map (fst . fromJust . C.readInt) . C.words <$> B.getLine

main = do
	[n, m, c] ← getInts
	[xs, ps] ← replicateM 2 $ map fromIntegral <$> getInts
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (* fromIntegral c) ps)
	let tree = build $ map (\a → let b = max 0 a in Item a b b b) as

	ranges ← replicateM m $ (\[l, r] → (l - 1, r - 2)) <$> getInts
	let maxs = map (itemMax . uncurry (query tree)) ranges
	printf "%f" $ (fromIntegral $ sum maxs) / (100 :: Double)

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Monoid

data Item = Item { itemSum :: Int, itemLeft :: Int, itemRight :: Int, itemMax :: Int } deriving (Show)

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build l = a
	where
		n = length l
		a = listArray (1, 2*n - 1) $ map f [1..n-1] ++ map g l
		f i = (a ! (2*i)) <> (a ! (2*i + 1))
		g a = Item a b b b
			where b = max 0 a

query tree l r = itemMax $ query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1
		query' l r | l > r = mempty
		query' l r | odd l = (tree ! l) <> query' (l + 1) r
		query' l r | even r = query' l (r - 1) <> (tree ! r)
		query' l r = query' (l `div` 2) (r `div` 2)

getWords = map read . words <$> getLine

main = do
	[n, m, c] <- getWords
	xs <- getWords
	ps <- getWords
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (*c) ps)
	let tree = build as
	ranges <- replicateM m $ (\[l, r] -> (l - 1, r - 2)) . map read . words <$> getLine
	let rs = map (\(l, r) -> query tree l r) ranges
	print $ fromIntegral (sum rs) / 100

import Control.Applicative
import Control.Monad
import Data.Array
import Data.Monoid
import Text.Printf

data Item = Item { itemSum :: Int, itemLeft :: Int, itemRight :: Int, itemMax :: Int } deriving (Show)

instance Monoid Item where
	mempty = Item 0 0 0 0
	mappend (Item as al ar am) (Item bs bl br bm) =
		Item (as + bs) (max al $ as + bl) (max br $ bs + ar) (max (ar + bl) $ max am bm)

build l = a
	where
		n = length l
		a = listArray (1, 2*n - 1) $ map f [1..n-1] ++ map g l
		f i = (a ! (2*i)) <> (a ! (2*i + 1))
		g a = Item a b b b
			where b = max 0 a

query tree l r = itemMax $ query' (l + n) (r + n)
	where
		n = snd (bounds tree) `div` 2 + 1
		query' l r | l > r = mempty
		query' l r | odd l = (tree ! l) <> query' (l + 1) r
		query' l r | even r = query' l (r - 1) <> (tree ! r)
		query' l r = query' (l `div` 2) (r `div` 2)

getWords = map read . words <$> getLine

main = do
	[n, m, c] <- getWords
	xs <- getWords
	ps <- getWords
	let as = zipWith (-) (map (*50) $ zipWith (-) (tail xs) xs) (map (*c) ps)
	let tree = build as
	ranges <- replicateM m $ (\[l, r] -> (l - 1, r - 2)) . map read . words <$> getLine
	let rs = map (\(l, r) -> query tree l r) ranges
	printf "%f" $ (fromIntegral (sum rs) :: Double) / 100


Recently Max has got himself into popular CCG "BrainStone". As "BrainStone" is a pretty intellectual game, Max has to solve numerous hard problems during the gameplay. Here is one of them:Max owns n creatures, i-th of them can be described with two numbers — its health hpi and its damage dmgi. Max also has two types of spells in stock:  Doubles health of the creature (hpi := hpi·2);  Assigns value of health of the creature to its damage (dmgi := hpi). Spell of first type can be used no more than a times in total, of the second type — no more than b times in total. Spell can be used on a certain creature multiple times. Spells can be used in arbitrary order. It isn't necessary to use all the spells.Max is really busy preparing for his final exams, so he asks you to determine what is the maximal total damage of all creatures he can achieve if he uses spells in most optimal way.

The first line contains three integers n, a, b (1 ≤ n ≤ 2·105, 0 ≤ a ≤ 20, 0 ≤ b ≤ 2·105) — the number of creatures, spells of the first type and spells of the second type, respectively. The i-th of the next n lines contain two number hpi and dmgi (1 ≤ hpi, dmgi ≤ 109) — description of the i-th creature.

Print single integer — maximum total damage creatures can deal.

NoteIn the first example Max should use the spell of the first type on the second creature, then the spell of the second type on the same creature. Then total damage will be equal to 15 + 6·2 = 27.In the second example Max should use the spell of the second type on the first creature, then the spell of the second type on the third creature. Total damage will be equal to 10 + 11 + 5 = 26.

import Control.Monad.Trans.State (State, execState, get, put)
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Int
import Data.List (sortBy, foldl')
import Data.Ord

data LeftHeavyHeap a = Empty | Node {
    value :: a,
    leftChild :: LeftHeavyHeap a,
    rightChild :: LeftHeavyHeap a,
    size :: Int
  } deriving (Show)

getSize Empty = 0
getSize (Node {size = s}) = s
makeEmptyHeap = Empty

merge :: (Ord a) => LeftHeavyHeap a -> LeftHeavyHeap a -> LeftHeavyHeap a
merge h1 Empty = h1
merge Empty h2 = h2
merge h1 h2
  = if (getSize mergedChild) > (getSize l1)
    then newParent {
        leftChild = mergedChild,
        rightChild  = l1,
        size = s
      }
    else newParent {
        leftChild = l1,
        rightChild = mergedChild,
        size = s
      }
  where
    (newParent, newChild) = if (value h1) < (value h2)
      then (h1, h2) else (h2, h1)
    (Node {
      value = v1,
      leftChild = l1,
      rightChild = r1,
      size = s1
    }) = newParent
    (Node {
      value = v2,
      leftChild = l2,
      rightChild = r2,
      size = s2
    }) = newChild
    mergedChild = merge newChild r1
    s = s1 + s2

peek Empty = Nothing
peek (Node {value = v}) = Just v

pop Empty = (Nothing, Empty)
pop (Node {
    value = v,
    leftChild = l,
    rightChild = r
  }) = (Just v, merge l r)

insert :: (Ord a) => a -> LeftHeavyHeap a -> LeftHeavyHeap a
insert x h =
  merge newNode h
  where
    newNode = Node {
      value = x,
      leftChild = Empty,
      rightChild = Empty,
      size = 1
    }

type ItSt = (LeftHeavyHeap Int, Int64, Int64)
type S = State ItSt

solve a b creatures
  | b == 0 = originalTotalDamage
  | otherwise = originalTotalDamage + bestGain
  where
    originalTotalDamage = sum $ map (fromIntegral . snd) creatures :: Int64
    creaturesByHp = sortBy (comparing fst) creatures
    enlarge x = shiftL (fromIntegral x) a :: Int64

    oneIt :: (Int, Int) -> S ()
    oneIt (hp, damage) = do
      (heap, total, bestGain) <- get
      let d = hp - damage
      let y = total - (fromIntegral damage) + (enlarge hp)
      let (h', t') = adjustHeap heap total d
      put (h' , t', max bestGain y)

    adjustHeap h t d
      | d < 0 = (h, t)
      | otherwise = limitHeapSize h' t'
      where
        h' = insert d h
        t' = t + (fromIntegral d)

    limitHeapSize h t
      | (getSize h) <= b - 1 = (h, t)
      | otherwise = (h', t - (fromIntegral top))
      where (Just top, h') = pop h

    runIt c = execState (oneIt c)
    (_, _, bestGain) = foldl' (flip runIt) (makeEmptyHeap, 0, 0) creaturesByHp

main :: IO()
main = do
  (l1:descs) <- readLines
  let [n, a, b] = map readInt (BS.split ' ' l1)
  let creatures = map readPair (take n descs)
  putStrLn $ show $ solve a b creatures

readPair =
  (\[x, y] -> (x, y))
  . map readInt
  . (BS.split ' ')

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

import Control.Monad.Trans.State (State, execState, get, put)
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Int
import Data.List (sortBy, foldl')
import Data.Ord

data LeftHeavyHeap a = Empty | Node {
    value :: a,
    leftChild :: LeftHeavyHeap a,
    rightChild :: LeftHeavyHeap a,
    size :: Int
  } deriving (Show)

getSize Empty = 0
getSize (Node {size = s}) = s
makeEmptyHeap = Empty

merge :: (Ord a) => LeftHeavyHeap a -> LeftHeavyHeap a -> LeftHeavyHeap a
merge h1 Empty = h1
merge Empty h2 = h2
merge h1 h2
  = if (getSize mergedChild) > (getSize l1)
    then newParent {
        leftChild = mergedChild,
        rightChild  = l1,
        size = s
      }
    else newParent {
        leftChild = l1,
        rightChild = mergedChild,
        size = s
      }
  where
    (newParent, newChild) = if (value h1) < (value h2)
      then (h1, h2) else (h2, h1)
    (Node {
      value = v1,
      leftChild = l1,
      rightChild = r1,
      size = s1
    }) = newParent
    (Node {
      value = v2,
      leftChild = l2,
      rightChild = r2,
      size = s2
    }) = newChild
    mergedChild = merge newChild r1
    s = s1 + s2

peek Empty = Nothing
peek (Node {value = v}) = Just v

pop Empty = (Nothing, Empty)
pop (Node {
    value = v,
    leftChild = l,
    rightChild = r
  }) = (Just v, merge l r)

insert :: (Ord a) => a -> LeftHeavyHeap a -> LeftHeavyHeap a
insert x h =
  merge newNode h
  where
    newNode = Node {
      value = x,
      leftChild = Empty,
      rightChild = Empty,
      size = 1
    }

type ItSt = (LeftHeavyHeap Int, Int64, Int64)
type S = State ItSt

solve a b creatures
  | b == 0 = originalTotalDamage
  | otherwise = originalTotalDamage + bestGain
  where
    originalTotalDamage = sum $ map (fromIntegral . snd) creatures :: Int64
    creaturesByHp = sortBy (comparing fst) creatures
    enlarge x = shiftL (fromIntegral x) a :: Int64

    oneIt :: (Int, Int) -> S ()
    oneIt (hp, damage) = do
      (heap, total, bestGain) <- get
      let d = hp - damage
      let y = total - (fromIntegral damage) + (enlarge hp)
      let (h', t') = adjustHeap heap total d
      put (h' , t', max bestGain y)

    adjustHeap h t d
      | d < 0 = (h, t)
      | otherwise = limitHeapSize h' t'
      where
        h' = insert d h
        t' = t + (fromIntegral d)

    limitHeapSize h t
      | (getSize h) <= b - 1 = (h, t)
      | otherwise = (h', t - (fromIntegral top))
      where (Just top, h') = pop h

    runIt c = execState (oneIt c)
    (_, _, bestGain) = foldl' (flip runIt) (makeEmptyHeap, 0, 0) creatures

main :: IO()
main = do
  (l1:descs) <- readLines
  let [n, a, b] = map readInt (BS.split ' ' l1)
  let creatures = map readPair (take n descs)
  putStrLn $ show $ solve a b creatures

readPair =
  (\[x, y] -> (x, y))
  . map readInt
  . (BS.split ' ')

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents


There are n games in a football tournament. Three teams are participating in it. Currently k games had already been played. You are an avid football fan, but recently you missed the whole k games. Fortunately, you remember a guess of your friend for these k games. Your friend did not tell exact number of wins of each team, instead he thought that absolute difference between number of wins of first and second team will be d1 and that of between second and third team will be d2.You don't want any of team win the tournament, that is each team should have the same number of wins after n games. That's why you want to know: does there exist a valid tournament satisfying the friend's guess such that no team will win this tournament?Note that outcome of a match can not be a draw, it has to be either win or loss.

The first line of the input contains a single integer corresponding to number of test cases t (1 ≤ t ≤ 105). Each of the next t lines will contain four space-separated integers n, k, d1, d2 (1 ≤ n ≤ 1012; 0 ≤ k ≤ n; 0 ≤ d1, d2 ≤ k) — data for the current test case.

For each test case, output a single line containing either "yes" if it is possible to have no winner of tournament, or "no" otherwise (without quotes).

NoteSample 1. There has not been any match up to now (k = 0, d1 = 0, d2 = 0). If there will be three matches (1-2, 2-3, 3-1) and each team wins once, then at the end each team will have 1 win.Sample 2. You missed all the games (k = 3). As d1 = 0 and d2 = 0, and there is a way to play three games with no winner of tournament (described in the previous sample), the answer is "yes".Sample 3. You missed 4 matches, and d1 = 1, d2 = 0. These four matches can be: 1-2 (win 2), 1-3 (win 3), 1-2 (win 1), 1-3 (win 1). Currently the first team has 2 wins, the second team has 1 win, the third team has 1 win. Two remaining matches can be: 1-2 (win 2), 1-3 (win 3). In the end all the teams have equal number of wins (2 wins).

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO

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

solve = do
  [n, k, d1, d2] :: [Int64] <- map read . words <$> getLine

  let
    os = try <$> [-1, 1] <*> [-1, 1]
      where

        try s1 s2
          | all (\x -> x`mod`3 == 0 && x >= 0 && x <= n) [x1, x2, x3] = Just (x1`div`3, x2`div`3, x3`div`3)
          | otherwise = Nothing
          where
            x1 = k - s1*d2 - s2*2*d1
            x2 = k - s1*d2 + s2*d1
            x3 = k + s1*2*d2 + s2*d1

  putStrLn $
    if n`mod`3 == 0 && not (null $ catMaybes os)
      then "yes"
      else "no"

main = do
  t <- readLn
  replicateM t solve

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger 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
  n <- readLn :: IO Int
  xs <- map readInteger.B.words <$> B.getContents
  putStr.unlines $ solve xs

solve :: [Integer] -> [String]
solve (n:k:d1:d2:rest)
  | any ok [(d1,d2),(d1,-d2),(-d1,d2),(-d1,-d2)] = "yes" : solve rest
  | otherwise = "no" : solve rest
   where
     ok (d1, d2) = and [ w1' >= 0, w2' >= 0, w3' >= 0
                       , w1' `mod` 3 == 0, w2' `mod` 3 == 0, w3' `mod` 3 == 0
                       , d + k <= n
                       , (n - d - k) `mod` 3 == 0
                       ]
      where
        w1' = k - 2*d1 -   d2
        w2' = k +   d1 -   d2
        w3' = k +   d1 + 2*d2
        w1 = w1' `div` 3
        w2 = w2' `div` 3
        w3 = w3' `div` 3
        d = 3 * maximum [w1,w2,w3] - sum [w1,w2,w3]

solve _ = []

import Control.Monad
ans :: [Integer] -> String
ans [n, k, d1, d2] = if g then "yes" else "no"
 where g = (n `mod` 3 == 0) && (any good [(d1,d2),(abs(d1 - d2), max d1 d2), (d1,d1+d2), (d2,d1+d2)])
       good (a,b) = dd >= 0 && dd `mod` 3 == 0 && max (ee+a) (ee+b) <= n `div` 3
         where dd = k - a - b
               ee = dd `div` 3

solve :: IO String
solve = do
    s <- getLine
    return $ ans $ map read $ words s

main = do
  l1 <- getLine
  let nn = (read l1) :: Int
  replicateM nn solve >>= putStrLn . unlines

{-# LANGUAGE BangPatterns #-}

import Data.Int
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as BS
import Text.Printf (printf)
import Control.Monad
import Control.Applicative

solve :: [Integer] -> Bool
solve [!n, !k, !d1, !d2] =
  n `rem` 3 == 0 && or [check a1 a2 | a1 <- [d1, -d1], a2 <- [d2, -d2]]
  where
    check !a1 !a2 = m `rem` 3 == 0 && x >= 0 && y >= 0 && z >= 0 && x + y + z == k && n - k >= r
      where
        m = k - 2*a1 - a2
        x = m `div` 3
        y = x + a1
        z = y + a2
        w = x `max` y `max` z
        r = w - x + w - y + w - z

main :: IO ()
main = do
  t <- readLn :: IO Int
  ts <- replicateM t $ (map (fst . fromJust . BS.readInteger) . BS.words) <$> BS.getLine :: IO [[Integer]]
  forM_ ts $ \t ->
    putStrLn $ if solve t then "yes" else "no"

{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.Int
import Data.Bits
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

solveEach as@[a, b, c] rest
  | need > rest = False
  | remain `mod` 3 == 0 = True
  | otherwise = False
  where mx = maximum as
        need = sum . map (\x -> mx - x) $ as
        remain = rest - need

solve [] _ = False
solve (a:as) rest
  | res1 == True = True
  | otherwise    = solve as rest
  where res1 = solveEach a rest

main = do
  testcase <- getint
  replicateM testcase $ do
    [n, k, d1, d2] <- map fst . mapMaybe BS.readInteger . BS.words <$> BS.getLine
    let rest = n - k
        as = filter filt [f x y | x <- [(0, d1), (d1, 0)], y <- [(0, d2), (d2, 0)]]
        f (d1, 0) (d2, 0) = [d1 + d2, d2, 0]
        f (d1, 0) (0, d2) = [d1, 0, d2]
        f (0, d1) (d2, 0) = if d1 >= d2
                              then [0, d1, d1 - d2]
                              else [d2 - d1, d2, 0]
        f (0, d1) (0, d2) = [0, d1, d1 + d2]
        filt [a, b, c]
          | played > k = False
          | remain `mod` 3 == 0 = True
          | otherwise = False
          where played = a + b + c
                remain = k - played
        res = solve as rest
--    putStrLn (show as)
    if res then putStrLn "yes" else putStrLn "no"

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO

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

solve = do
  [n, k, d1, d2] <- getInts

  let
    os = try <$> [-1, 1] <*> [-1, 1]
      where

        try s1 s2
          | all (\x -> x`mod`3 == 0 && x >= 0 && x <= n) [x1, x2, x3] = Just (x1`div`3, x2`div`3, x3`div`3)
          | otherwise = Nothing
          where
            x1 = k - s1*d2 - s2*2*d1
            x2 = k - s1*d2 + s2*d1
            x3 = k + s1*2*d2 + s2*d1

  putStrLn $
    if n`mod`3 == 0 && not (null $ catMaybes os)
      then "yes"
      else "no"

main = do
  t <- readLn
  replicateM t solve

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO

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

solve = do
  [n, k, d1, d2] <- getInts

  let
    os = try <$> [-1, 1] <*> [-1, 1]
      where
        try s1 s2
          | all (\x -> x`mod`3 == 0 && x >= 0 && x <= n) [x1, x2, x3] = Just (x1`div`3, x2`div`3, x3`div`3)
          | otherwise = Nothing
          where
            x1 = k - s1*2*d1 - s2*d2
            x2 = k + s1*d1 - s2*d2
            x3 = k + s1*d1 - s2*2*d2

  putStrLn $
    if n`mod`3 == 0 && not (null $ catMaybes os)
      then "yes"
      else "no"

main = do
  t <- readLn
  replicateM t solve

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

import Control.Applicative
import Control.DeepSeq (deepseq)
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.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
-- import Debug.Trace
import System.IO

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

solve = do
  [n, k, d1, d2] <- getInts

  let
    os = try <$> [-1, 1] <*> [-1, 1]
      where

        try s1 s2
          | all (\x -> x`mod`3 == 0 && x >= 0) [x1, x2, x3] = Just (x1`div`3, x2`div`3, x3`div`3)
          | otherwise = Nothing
          where
            x1 = k - s1*d2 - s2*2*d1
            x2 = k - s1*d2 + s2*d1
            x3 = k + s1*2*d2 + s2*d1

  putStrLn $
    if n`mod`3 == 0 && not (null $ catMaybes os)
      then "yes"
      else "no"

main = do
  t <- readLn
  replicateM t solve

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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;_->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
  n <- readLn :: IO Int
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  putStr.unlines $ solve xs

solve :: [Int64] -> [String]
solve (n:k:d1:d2:rest)
  | any ok [(d1,d2),(d1,-d2),(-d1,d2),(-d1,-d2)] = "yes" : solve rest
  | otherwise = "no" : solve rest
   where
     ok (d1, d2) = and [w1>=0, w2>=0, w3>=0
                       , w1' `mod` 3==0, w3' `mod` 3 == 0
                       , d + k <= n
                       , (n-(d+k)) `mod` 3 == 0
                       ]
      where
        w1' = k - 2*d1 - d2
        w3' = k + d1 + 2*d2
        w1 = w1' `div` 3
        w3 = w3' `div` 3
        w2 = k - w1 - w3
        d = sum $ map (wmax-)[w1,w2,w3]
        wmax = maximum [w1,w2,w3]

solve _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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;_->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
  n <- readLn :: IO Int
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  putStr.unlines $ solve xs

solve :: [Int64] -> [String]
solve (n:k:d1:d2:rest)
  | any ok [(d1,d2),(d1,-d2),(-d1,d2),(-d1,-d2)] = "yes" : solve rest
  | otherwise = "no" : solve rest
   where
     ok (d1, d2) = and [ w1' >= 0, w2' >= 0, w3' >= 0
                       , w1' `mod` 3 == 0, w2' `mod` 3 == 0, w3' `mod` 3 == 0
                       , d + k <= n
                       , (n - d - k) `mod` 3 == 0
                       ]
      where
        w1' = k - 2*d1 -   d2
        w2' = k +   d1 -   d2
        w3' = k +   d1 + 2*d2
        w1 = w1' `div` 3
        w2 = w2' `div` 3
        w3 = w3' `div` 3
        d = 3 * maximum [w1,w2,w3] - sum [w1,w2,w3]

solve _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray)
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;_->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
  n <- readLn :: IO Int
  xs <- map (fromIntegral.readInt).B.words <$> B.getContents
  putStr.unlines $ solve xs

solve :: [Int64] -> [String]
solve (n:k:d1:d2:rest)
  | any ok [(d1,d2),(d1,-d2),(-d1,d2),(-d1,-d2)] = "yes" : solve rest
  | otherwise = "no" : solve rest
   where
     ok (d1, d2) = and [w1'>=0, w3'>=0
                       , w1' `mod` 3 == 0, w3' `mod` 3 == 0
                       , w2>=0
                       , d + k <= n
                       , (n-(d+k)) `mod` 3 == 0
                       ]
      where
        w1' = k - 2*d1 - d2
        w3' = k + d1 + 2*d2
        w1 = w1' `div` 3
        w3 = w3' `div` 3
        w2 = k - w1 - w3
        d = sum $ map (wmax-)[w1,w2,w3]
        wmax = maximum [w1,w2,w3]

solve _ = []

import Control.Monad
ans :: [Integer] -> String
ans [n, k, d1, d2] = if g then "yes" else "no"
 where g = (n `mod` 3 == 0) && (any good [(d1,d2),(abs(d1 - d2), max d1 d2)])
       good (a,b) = dd >= 0 && dd `mod` 3 == 0 && max (ee+a) (ee+b) <= n `div` 3
         where dd = k - a - b
               ee = dd `div` 3

solve :: IO String
solve = do
    s <- getLine
    return $ ans $ map read $ words s

main = do
  l1 <- getLine
  let nn = (read l1) :: Int
  replicateM nn solve >>= putStrLn . unlines

import Control.Monad
ans [n, k, d1, d2] = if g then "yes" else "no"
 where g = (n `mod` 3 == 0) && (any good [(d1,d2),(abs(d1 - d2), max d1 d2)])
       good (a,b) = a + b <= k && max a b <= n `div` 3

solve :: IO String
solve = do
    s <- getLine
    return $ ans $ map read $ words s

main = do
  l1 <- getLine
  let nn = (read l1) :: Int
  replicateM nn solve >>= putStrLn . unlines

import Control.Monad
ans :: [Integer] -> String
ans [n, k, d1, d2] = if g then "yes" else "no"
 where g = (n `mod` 3 == 0) && (any good [(d1,d2),(abs(d1 - d2), max d1 d2)])
       good (a,b) = a + b <= k && max a b <= n `div` 3

solve :: IO String
solve = do
    s <- getLine
    return $ ans $ map read $ words s

main = do
  l1 <- getLine
  let nn = (read l1) :: Int
  replicateM nn solve >>= putStrLn . unlines

{-# LANGUAGE BangPatterns #-}

import Data.Int
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as BS
import Text.Printf (printf)
import Control.Monad
import Control.Applicative

solve :: [Integer] -> Bool
solve [!n, !k, !d1, !d2] =
  n `rem` 3 == 0 &&
  (check d1 d2 || check (2 * d1) d2 || check d1 (2 * d2))
  where
    !r = n - k
    check !a !b = r >= a + b && n >= (max a b) * 3

main :: IO ()
main = do
  t <- readLn :: IO Int
  ts <- replicateM t $ (map (fst . fromJust . BS.readInteger) . BS.words) <$> BS.getLine :: IO [[Integer]]
  forM_ ts $ \t ->
    putStrLn $ if solve t then "yes" else "no"

{-# LANGUAGE BangPatterns #-}

import Data.Int
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as BS
import Text.Printf (printf)
import Control.Monad
import Control.Applicative

solve :: [Integer] -> Bool
solve [!n, !k, !d1, !d2] =
  check (k + 2*d1 + d2) ||
  check (k + 2*d1 - d2) ||
  check (k - 2*d1 - d2) ||
  check (k - 2*d1 + d2)
  where
    check !m = m >= 0 && m <= n && m `rem` 3 == 0 && (n - m) `rem` 3 == 0

main :: IO ()
main = do
  t <- readLn :: IO Int
  ts <- replicateM t $ (map (fst . fromJust . BS.readInteger) . BS.words) <$> BS.getLine :: IO [[Integer]]
  forM_ ts $ \t ->
    putStrLn $ if solve t then "yes" else "no"

{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.Int
import Data.Bits
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

solveEach as@[a, b, c] rest
  | need > rest = False
  | remain `mod` 3 == 0 = True
  | otherwise = False
  where mx = maximum as
        need = sum . map (\x -> mx - x) $ as
        remain = rest - need

solve [] _ = False
solve (a:as) rest
  | res1 == True = True
  | otherwise    = solve as rest
  where res1 = solveEach a rest

main = do
  testcase <- getint
  replicateM testcase $ do
    [n, k, d1, d2] <- map fst . mapMaybe BS.readInteger . BS.words <$> BS.getLine
    let rest = n - k
        as = [f x y | x <- [(0, d1), (d1, 0)], y <- [(0, d2), (d2, 0)]]
        f (d1, 0) (d2, 0) = [d1 + d2, d2, 0]
        f (d1, 0) (0, d2) = [d1, 0, d2]
        f (0, d1) (d2, 0) = if d1 >= d2
                              then [0, d1, d1 - (d1 - d2)]
                              else [d2 - (d2 - d1), d2, 0]
        f (0, d1) (0, d2) = [0, d1, d1 + d2]
        res = solve as rest
    if res then putStrLn "yes" else putStrLn "no"

{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import Data.Char
import Data.List
import Data.Int
import Data.Bits
import Data.IORef
import Data.Array.IO
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map              as Map
import qualified Data.Set              as Set
import Text.Printf

getint :: IO Int
getint  = head <$> getints

getints :: IO [Int]
getints = map fst . mapMaybe BS.readInt . BS.words <$> BS.getLine

solveEach as@[a, b, c] rest
  | need > rest = False
  | remain `mod` 3 == 0 = True
  | otherwise = False
  where mx = maximum as
        need = sum . map (\x -> mx - x) $ as
        remain = rest - need

solve [] _ = False
solve (a:as) rest
  | res1 == True = True
  | otherwise    = solve as rest
  where res1 = solveEach a rest

main = do
  testcase <- getint
  replicateM testcase $ do
    [n, k, d1, d2] <- map fst . mapMaybe BS.readInteger . BS.words <$> BS.getLine
    let rest = n - k
        as = filter filt [f x y | x <- [(0, d1), (d1, 0)], y <- [(0, d2), (d2, 0)]]
        f (d1, 0) (d2, 0) = [d1 + d2, d2, 0]
        f (d1, 0) (0, d2) = [d1, 0, d2]
        f (0, d1) (d2, 0) = if d1 >= d2
                              then [0, d1, d1 - d2]
                              else [d2 - d1, d2, 0]
        f (0, d1) (0, d2) = [0, d1, d1 + d2]
        filt [a, b, c] = a + b + c <= k
        res = solve as rest
--    putStrLn (show as)
    if res then putStrLn "yes" else putStrLn "no"


You are given an array $$$a$$$ that contains $$$n$$$ integers. You can choose any proper subsegment $$$a_l, a_{l + 1}, \ldots, a_r$$$ of this array, meaning you can choose any two integers $$$1 \le l \le r \le n$$$, where $$$r - l + 1 < n$$$. We define the beauty of a given subsegment as the value of the following expression:$$$$$$\max(a_{1}, a_{2}, \ldots, a_{l-1}, a_{r+1}, a_{r+2}, \ldots, a_{n}) - \min(a_{1}, a_{2}, \ldots, a_{l-1}, a_{r+1}, a_{r+2}, \ldots, a_{n}) + \max(a_{l}, \ldots, a_{r}) - \min(a_{l}, \ldots, a_{r}).$$$$$$Please find the maximum beauty among all proper subsegments.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. Then follow the descriptions of each test case. The first line of each test case contains a single integer $$$n$$$ $$$(4 \leq n \leq 10^5)$$$ — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_{i} \leq 10^9$$$) — the elements of the given array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each testcase print a single integer — the maximum beauty of a proper subsegment.

NoteIn the first test case, the optimal segment is $$$l = 7$$$, $$$r = 8$$$. The beauty of this segment equals to $$$(6 - 1) + (5 - 1) = 9$$$.In the second test case, the optimal segment is $$$l = 2$$$, $$$r = 4$$$. The beauty of this segment equals $$$(100 - 2) + (200 - 1) = 297$$$.

--
-- 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
        [_n] <- ri
        ri
    mapM_ (putStrLn.show.solve) tcs

solve xs = a+b-x-y
  where
    sasc  = L.sort  xs
    sdesc = reverse sasc
    a = sdesc!!0
    b = sdesc!!1
    x = sasc !!0
    y = sasc !!1


Nicholas, a painter is going to paint several new canvases. Nicholas is sure that the canvases will turn out so great that each one will need framing and being hung on the wall. Frames are what Nicholas decided to begin with. Nicholas has n sticks whose lengths equal a1, a2, ... an. Nicholas does not want to break the sticks or glue them together. To make a h × w-sized frame, he needs two sticks whose lengths equal h and two sticks whose lengths equal w. Specifically, to make a square frame (when h = w), he needs four sticks of the same length.Now Nicholas wants to make from the sticks that he has as many frames as possible; to be able to paint as many canvases as possible to fill the frames. Help him in this uneasy task. Note that it is not necessary to use all the sticks Nicholas has.

The first line contains an integer n (1 ≤ n ≤ 100) — the number of sticks. The second line contains n space-separated integers. The i-th integer equals the length of the i-th stick ai (1 ≤ ai ≤ 100).

Print the single number — the maximum number of frames Nicholas can make for his future canvases.

import Data.List
import IO

solve :: [Int] -> Int
solve = (`div`2) . sum . map ((`div`2) . length) . group . sort

main = print . solve . map read . words . head . tail . lines =<< hGetContents stdin

-- vim: set expandtab:

import qualified Data.Map as Map
solve :: [Int] -> Int
solve xs = halfsticks `div` 2
    where sticks = foldr step Map.empty xs
              where step x acc = Map.insertWith (+) x 1 acc
          halfsticks = foldl (\acc x -> acc + x `div` 2) 0 (map snd (Map.toList sticks))

main = interact $ show . solve . map read . words . last . lines

import Data.List

main = do
	getLine
	xs <- fmap (map read . words) getContents :: IO [Int]
	print $ (sum $ map ((`div` 2) . length) $ group $ sort xs) `div` 2

import Data.List

main = do
	getLine
	a <- fmap (map (read::String->Int) . words) getLine
	print $ (flip div 2) .sum . map ((flip div 2).length) . group . sort $ a

import Data.List

main = do
	n <- fmap (fromInteger.read) getLine
	a <- fmap ((map (fromInteger.read)) . words) getLine
	let b = map length $ group . sort $ a
	let c = sum $ map (flip div 2) b
	print $ c `div` 2

import Data.List

main = do
	n <- fmap (fromInteger.read) getLine
	a <- fmap (map (fromInteger.read) . words) getLine
	let b = map length . group . sort $ a
	let c = sum $ map (flip div 2) b
	print $ c `div` 2

import Control.Applicative
import Data.List

solve a = let arr = [(length $ elemIndices i a) `div` 2 | i <- [1..100]]
          in sum arr `div` 2

main = do
  n <- getLine
  a <- map read <$> (words <$> getLine)
  print $ solve a

module Main where

    -- Java-крестьяне должны страдать!

    import Data.List (sort, foldl', genericLength, group)

    main :: IO ()
    main = do
        n <- fmap read getLine :: IO Int
        sticks <- fmap (map read . words) getLine :: IO [Int]
        putStrLn . show $ flip div 2 $
            foldl' summate 0 (group . sort $ sticks)
            where summate s xs = s + (genericLength xs `div` 2)

import List

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

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

solve :: [Int] -> Int
solve xs = div (countPairs (sort xs)) 2
  where
    countPairs (x:y:xs)
      | x == y     =  1 + countPairs xs
      | otherwise  =  countPairs (y:xs)
    countPairs _ = 0

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

import List

pairs :: [Int] -> Int
pairs xs = sum $ map (\xs -> div (length xs) 2) $ group $ sort xs
main = interact $ show.(\x -> x `div` 2).pairs.map read.tail.words

import Data.List
main = do line <- getLine
          line <- getLine
          print $ ((\x -> x `div` 2) . sum . (map (\x -> (length x) `div` 2)) . group . sort . (map (\x -> read x::Int)) . words) line

import Data.List
main = print . (`div` 2) . sum . map ((`div` 2) . length) . group . sort . map (read :: String -> Int) . tail . words =<< getContents

module Main where

import Data.List

main = do
  getLine
  cs <- (map read . words) `fmap` getLine
  print (answer cs)

answer :: [Int] -> Int
answer cs = (pr (sort cs)) `div` 2
  where
    pr (a:b:sp) | a == b = 1 + pr sp
                | True   = pr (b:sp)
    pr _ = 0

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

import Control.Applicative
import Data.List

readNums :: (Num a, Read a) => IO [a]
readNums = map read . words <$> getLine

main :: IO ()
main = do
  n <- readLn
  xs :: [Int] <- take n <$> readNums
  let ys = parse $ sort xs
  print $ length ys `quot` 2
 where
  parse (x : y : zs)
    | x == y    = x : parse zs
    | otherwise = parse (y : zs)
  parse _       = []

main = do
    input <- getContents
    let process = putStrLn . show . maxFrames
    mapM_ process $ cases $ lines input

cases :: [String] -> [[Int]]
cases [] = []
cases (_:x:xs) = list:cases xs
    where
        list = (map read $ words x)::[Int]

maxFrames :: [Int] -> Int
maxFrames list = (maxFrames' list) `div` 2

maxFrames' :: [Int] -> Int
maxFrames' [] = 0
maxFrames' list@(x:_) = ((counter `div` 2) + maxFrames' rest)
    where
        (counter, rest) = countAndClean x list 0

countAndClean :: Int -> [Int] -> Int -> (Int, [Int])
countAndClean _ [] counter = (counter, [])
countAndClean x (y:ys) counter
    | x == y    = countAndClean x ys (counter+1)
    | otherwise = (newCounter, y:list)
    where
        (newCounter, list) = countAndClean x ys counter

import System.IO
import Data.List

parse :: Read a => Num a => String -> [a]
parse stuff =
    map read $ words $ dropWhile (/= '\n') stuff

calc :: [Int] -> Int
calc nums =
    let groups = (map length $ group $ sort nums :: [Int])
        edges = (map (\x -> div x 2) groups)
        res = (sum edges) `div` 2
    in res

main = do
    stuff <- getContents
    putStrLn (show $ calc $ parse stuff)

import List

pairs :: [Int] -> Int
pairs xs = pairs' $ sort xs
    where pairs' (a:b:xs) | a == b = 1 + pairs' xs
                          | otherwise = pairs' xs
          pairs' _ = 0

main = interact $ show.(\x -> x `div` 2).pairs.map read.tail.words

import Data.List
main = do line <- getLine
          line <- getLine
          print $ ((\x -> x `div` 2) . sum . (map (\x -> (length x) `div` 2)) . group . sort . concat . words) line


You are given $$$n$$$ numbers $$$a_1, a_2, \dots, a_n$$$. With a cost of one coin you can perform the following operation:Choose one of these numbers and add or subtract $$$1$$$ from it.In particular, we can apply this operation to the same number several times.We want to make the product of all these numbers equal to $$$1$$$, in other words, we want $$$a_1 \cdot a_2$$$ $$$\dots$$$ $$$\cdot a_n = 1$$$. For example, for $$$n = 3$$$ and numbers $$$[1, -3, 0]$$$ we can make product equal to $$$1$$$ in $$$3$$$ coins: add $$$1$$$ to second element, add $$$1$$$ to second element again, subtract $$$1$$$ from third element, so that array becomes $$$[1, -1, -1]$$$. And $$$1\cdot (-1) \cdot (-1) = 1$$$.What is the minimum cost we will have to pay to do that?

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of numbers. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \le a_i \le 10^9$$$) — the numbers.

Output a single number — the minimal number of coins you need to pay to make the product equal to $$$1$$$.

NoteIn the first example, you can change $$$1$$$ to $$$-1$$$ or $$$-1$$$ to $$$1$$$ in $$$2$$$ coins.In the second example, you have to apply at least $$$4$$$ operations for the product not to be $$$0$$$.In the third example, you can change $$$-5$$$ to $$$-1$$$ in $$$4$$$ coins, $$$-3$$$ to $$$-1$$$ in $$$2$$$ coins, $$$5$$$ to $$$1$$$ in $$$4$$$ coins, $$$3$$$ to $$$1$$$ in $$$2$$$ coins, $$$0$$$ to $$$1$$$ in $$$1$$$ coin.

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

process d = do
		let e = sum $ map (\z-> if z >0 then z-1 else if z<0 then (-1-z) else 1) d
		let e1 = if elem 0 d then 0
			    		else
						if even (length ( filter (<0) d)) then 0
								  			else 2
		print $ e+e1

main = do
		getLine
		d<-map read <$> words <$> getLine ::IO [Integer]
		process d

import Control.Monad
import Data.String
import Data.Maybe
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Integer]
parseLineToInt data_s = do
  (read::String->Integer) <$> (words data_s)

createLists :: Int -> ([Int], [Int])
createLists 0  = ([],[])
createLists n = let
                    (l, r) = createLists (n - 1)
                in ((2 * n) : r, (2 * n - 1) : l)

main = do
  _ <- getLine
  aS <- getLine
  let (a,b) = foldr f (0, Just 0) $ parseLineToInt aS where
      f x (y, Nothing) = (y + abs(1 - abs x),Nothing)
      f 0 (y, _) = (y + 1, Nothing)
      f x (y, Just z) = (y + abs(1 - abs x), Just (if x > 0 then z else (z + 1)))
  putStrLn $ show $ a + 2 * (mod (fromMaybe 0 b) 2)

main = do
    n <- getLine
    a <- getLine
    print (solve (read n) (map read $ words a))

count :: [Integer] -> (Integer, Integer, Integer, Integer)
count [] = (0, 0, 0, 0)
count (x:xs)
    | x < 0 = (cn+1, c0, cp, cst + (-1 - x))
    | x == 0 = (cn, c0+1, cp, cst + 1)
    | x > 0 = (cn, c0, cp+1, cst + (x - 1))
    where (cn,c0,cp,cst) = count xs

solve :: Integer -> [Integer] -> Integer
solve n a =
    let (cn, c0, cp, cst) = count a in
    if even cn
        then cst
    else if (c0 > 0)
        then cst
    else (cst + 2)

import Control.Monad
import Data.String
import Data.Maybe
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Int]
parseLineToInt data_s = do
  (read::String->Int) <$> (words data_s)

createLists :: Int -> ([Int], [Int])
createLists 0  = ([],[])
createLists n = let
                    (l, r) = createLists (n - 1)
                in ((2 * n) : r, (2 * n - 1) : l)

main = do
  _ <- getLine
  aS <- getLine
  let (a,b) = foldr f (0, Just 0) $ parseLineToInt aS where
      f x (y, Nothing) = (y + abs(1 - abs x),Nothing)
      f 0 (y, _) = (y + 1, Nothing)
      f x (y, Just z) = (y + abs(1 - abs x), Just (if x > 0 then z else (z + 1)))
  putStrLn $ show $ a + mod (fromMaybe 0 b) 2

import Control.Monad
import Data.String
import Data.Maybe
readListRec :: Int -> IO [String]
readListRec lineNumber =
  if (lineNumber == 0)
  then return []
  else
    getLine >>= \newLine ->
    (newLine :) <$> readListRec(lineNumber - 1)

parseLineToInt :: String -> [Int]
parseLineToInt data_s = do
  (read::String->Int) <$> (words data_s)

createLists :: Int -> ([Int], [Int])
createLists 0  = ([],[])
createLists n = let
                    (l, r) = createLists (n - 1)
                in ((2 * n) : r, (2 * n - 1) : l)

main = do
  _ <- getLine
  aS <- getLine
  let (a,b) = foldr f (0, Just 0) $ parseLineToInt aS where
      f x (y, Nothing) = (y + abs(1 - abs x),Nothing)
      f 0 (y, _) = (y + 1, Nothing)
      f x (y, Just z) = (y + abs(1 - abs x), Just (if x > 0 then z else (z + 1)))
  putStrLn $ show $ a + 2 * (mod (fromMaybe 0 b) 2)

main = do
    n <- getLine
    a <- getLine
    print (solve (read n) (map read $ words a))

count :: [Int] -> (Int, Int, Int, Int)
count [] = (0, 0, 0, 0)
count (x:xs)
    | x < 0 = (cn+1, c0, cp, cst + (-1 - x))
    | x == 0 = (cn, c0+1, cp, cst + 1)
    | x > 0 = (cn, c0, cp+1, cst + (x - 1))
    where (cn,c0,cp,cst) = count xs

solve :: Int -> [Int] -> Int
solve n a =
    let (cn, c0, cp, cst) = count a in
    if even cn
        then cst
    else if (c0 > 0)
        then cst
    else (cst + 2)

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

process d = do
		let e = sum $ map (\z-> if z >0 then z-1 else if z<0 then (-1-z) else 1) d
		let e1 = if elem 0 d then 0
			    		else
						if even (length ( filter (<0) d)) then 0
								  			else 2
		print $ e+e1

main = do
		getLine
		d<-map read <$> words <$> getLine ::IO [Int]
		process d


This is an interactive taskWilliam has a certain sequence of integers $$$a_1, a_2, \dots, a_n$$$ in his mind, but due to security concerns, he does not want to reveal it to you completely. William is ready to respond to no more than $$$2 \cdot n$$$ of the following questions:  What is the result of a bitwise AND of two items with indices $$$i$$$ and $$$j$$$ ($$$i \neq j$$$)  What is the result of a bitwise OR of two items with indices $$$i$$$ and $$$j$$$ ($$$i \neq j$$$) You can ask William these questions and you need to find the $$$k$$$-th smallest number of the sequence.Formally the $$$k$$$-th smallest number is equal to the number at the $$$k$$$-th place in a 1-indexed array sorted in non-decreasing order. For example in array $$$[5, 3, 3, 10, 1]$$$ $$$4$$$th smallest number is equal to $$$5$$$, and $$$2$$$nd and $$$3$$$rd are $$$3$$$.

It is guaranteed that for each element in a sequence the condition $$$0 \le a_i \le 10^9$$$ is satisfied.

NoteIn the example, the hidden sequence is $$$[1, 6, 4, 2, 3, 5, 4]$$$.Below is the interaction in the example.Query (contestant's program)Response (interactor)Notesand 2 52$$$a_2=6$$$, $$$a_5=3$$$. Interactor returns bitwise AND of the given numbers.or 5 67$$$a_5=3$$$, $$$a_6=5$$$. Interactor returns bitwise OR of the given numbers.finish 5$$$5$$$ is the correct answer. Note that you must find the value and not the index of the kth smallest number.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L
import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import System.IO

solve3 :: (Int,Int,Int) -> (Int,Int,Int)
solve3 (ab,bc,ca) = (a,b,c) where
  a_c=ab-bc
  a2 = ca+a_c
  a = a2`div`2
  b = ab-a
  c = ca-a

askAll :: Int -> Bu.Builder
askAll n = ask3 <> askRestOr <> askRestAnd where
  ask s i j = Bu.string7 (s ++ " " ++ show i ++ " " ++ show j ++ "\n") <> flush
  ask3 = mconcat [ask s i j | i<-[1,2,3],j<-[i+1..3],s<-["or","and"]]
  askRestOr = mconcat [ask "or" 1 j | j<-[4..n]]
  askRestAnd = mconcat [ask "and" 1 j | j<-[4..n]]

tell :: Int -> Bu.Builder
tell x = Bu.string7 ("finish " ++ show x ++ "\n") <> flush

solve :: St Bu.Builder
solve = do
  ~[n,k] <- getIntegrals 2
  ~[aorb,aandb,aorc,aandc,borc,bandc] <- getIntegrals 6
  let (a,b,c) = solve3 ((aorb+aandb), (borc+bandc), (aorc+aandc))
  restOr <- getIntegrals (n-3)
  restAnd <- getIntegrals (n-3)
  let xs = a:b:c: zipWith (\x y->x+y-a) restOr restAnd
  return $ askAll n <> tell (L.sort xs !! (k-1))

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  bytestrings <- B8.words <$> B8.getContents
  B8.putStrLn $ Bu.toLazyByteString $ evalState solve bytestrings

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
--import Data.Semigroup

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

import Data.Bits -- only for bucket sort

class  Put t  where
  putit :: BoundedPrim t
instance  Put Int  where
  putit = intDec
instance  Put Char  where
  putit = liftFixedToBounded char7
instance  (Put x, Put y) => Put (x, y)  where
  putit = putit >*< putit

querySum :: BoundedPrim (Int, Int)
-- This is a stupid way to do things
querySum = let
  orp = ('o', ('r', ' '))
  andp = ('a', ('n', ('d', ' ')))
  in
  (\(i, j) ->
    (((((((((orp, i), ' '), j), '\n'), andp), i), ' '), j), '\n')) >$< putit

stableBucketSortOn3 :: (Int -> Int) -> (Int, Int) -> [Int] -> UArray Int Int
stableBucketSortOn3 fun bnds li = runSTUArray $ do
  counts <- newArray bnds 0 :: ST s (STUArray s Int Int)
  forM_ li $ \v -> do
    let  bucket = fun v
    ct <- (+ 1) <$> readArray counts bucket
    writeArray counts bucket ct
  totSz <- (\fun -> foldM fun 0 $ range bnds) $ \prevTot bucket -> do
    cct <- readArray counts bucket
    prevTot + cct <$ writeArray counts bucket prevTot
  ansArr <- newArray_ (1, totSz) :: ST s (STUArray s Int Int)
  forM_ li $ \v -> do
    let  bucket = fun v
    ct <- (+ 1) <$> readArray counts bucket
    writeArray counts bucket ct
    writeArray ansArr ct v
  pure ansArr

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n, k] <- getInts 2
  let  queries = (2, 3) : map ((,) 1) [2 .. n]
  lift $ P.putStr $ B.toLazyByteString $ primMapListBounded querySum queries
  lift $ hFlush stdout
  s23 : s1ks <- liftPure $ replicateM n $ do
    ~[ov, av] <- getInts 2
    pure $ fromIntegral $  ov + av
  let
    v1 = div (sum (take 2 s1ks) - s23) 2
    vs = v1 : map (subtract v1) s1ks
    mask = bit 15 - 1
    lvs = stableBucketSortOn3 (.&. mask) (0, mask) vs
    svs = stableBucketSortOn3 (`shiftR` 15) (0, mask) $ elems lvs
  lift $ putStr "finish " >> print (svs ! k)

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
--import Data.Semigroup

import Data.List
import Data.Int
-- no Data.Bits needed

class  Put t  where
  putit :: BoundedPrim t
instance  Put Int  where
  putit = intDec
instance  Put Char  where
  putit = liftFixedToBounded char7
instance  (Put x, Put y) => Put (x, y)  where
  putit = putit >*< putit

querySum :: BoundedPrim (Int, Int)
-- This is a stupid way to do things
querySum = let
  orp = ('o', ('r', ' '))
  andp = ('a', ('n', ('d', ' ')))
  in
  (\(i, j) ->
    (((((((((orp, i), ' '), j), '\n'), andp), i), ' '), j), '\n')) >$< putit

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n, k] <- getInts 2
  let  queries = (1, 2) : (1, 3) : (2, 3) : map ((,) 1) [4 .. n]
  lift $ B.hPutBuilder stdout $ primMapListBounded querySum queries
  lift $ hFlush stdout
  s12 : s13 : s23 : s1ks <- liftPure $ replicateM n $ do
    ~[ov, av] <- getInts 2
    pure $ fromIntegral $  ov + av
  let
    s123 = div (s12 + s13 + s23) 2
    s123 :: Int64
    v1 = s123 - s23
    v2 = s123 - s13
    v3 = s123 - s12
    vs = v1 : v2 : v3 : map (subtract v1) s1ks
  lift $ putStr "finish "
  lift $ print $ sort vs !! (k - 1)

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

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

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
-- no Data.Bits needed

class  Put t  where
  putit :: BoundedPrim t
instance  Put Int  where
  putit = intDec
instance  Put Char  where
  putit = liftFixedToBounded char7
instance  (Put x, Put y) => Put (x, y)  where
  putit = putit >*< putit

querySum :: BoundedPrim (Int, Int)
querySum = let
  orp = ('o', ('r', ' '))
  andp = ('a', ('n', ('d', ' ')))
  in
  (\(i, j) ->
    (((((((((orp, i), ' '), j), '\n'), andp), i), ' '), j), '\n')) >$< putit

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [n, k] <- getInts 2
  let  queries = (1, 2) : (1, 3) : (2, 3) : map ((,) 1) [4 .. n]
  lift $ B.hPutBuilder stdout $ primMapListBounded querySum queries
  lift $ hFlush stdout
  s12 : s13 : s23 : s1ks <- liftPure $ replicateM n $ do
    ~[ov, av] <- getInts 2
    pure $ ov + av
  let
    s123 = div (s12 + s13 + s23) 2
    v1 = s123 - s23
    v2 = s123 - s13
    v3 = s123 - s12
    vs = v1 : v2 : v3 : map (subtract v1) s1ks
  lift $ putStr "finish "
  lift $ print $ sort vs !! (k - 1)

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

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


After a long party Petya decided to return home, but he turned out to be at the opposite end of the town from his home. There are $$$n$$$ crossroads in the line in the town, and there is either the bus or the tram station at each crossroad.The crossroads are represented as a string $$$s$$$ of length $$$n$$$, where $$$s_i = \texttt{A}$$$, if there is a bus station at $$$i$$$-th crossroad, and $$$s_i = \texttt{B}$$$, if there is a tram station at $$$i$$$-th crossroad. Currently Petya is at the first crossroad (which corresponds to $$$s_1$$$) and his goal is to get to the last crossroad (which corresponds to $$$s_n$$$).If for two crossroads $$$i$$$ and $$$j$$$ for all crossroads $$$i, i+1, \ldots, j-1$$$ there is a bus station, one can pay $$$a$$$ roubles for the bus ticket, and go from $$$i$$$-th crossroad to the $$$j$$$-th crossroad by the bus (it is not necessary to have a bus station at the $$$j$$$-th crossroad). Formally, paying $$$a$$$ roubles Petya can go from $$$i$$$ to $$$j$$$ if $$$s_t = \texttt{A}$$$ for all $$$i \le t < j$$$. If for two crossroads $$$i$$$ and $$$j$$$ for all crossroads $$$i, i+1, \ldots, j-1$$$ there is a tram station, one can pay $$$b$$$ roubles for the tram ticket, and go from $$$i$$$-th crossroad to the $$$j$$$-th crossroad by the tram (it is not necessary to have a tram station at the $$$j$$$-th crossroad). Formally, paying $$$b$$$ roubles Petya can go from $$$i$$$ to $$$j$$$ if $$$s_t = \texttt{B}$$$ for all $$$i \le t < j$$$.For example, if $$$s$$$="AABBBAB", $$$a=4$$$ and $$$b=3$$$ then Petya needs:  buy one bus ticket to get from $$$1$$$ to $$$3$$$,  buy one tram ticket to get from $$$3$$$ to $$$6$$$,  buy one bus ticket to get from $$$6$$$ to $$$7$$$. Thus, in total he needs to spend $$$4+3+4=11$$$ roubles. Please note that the type of the stop at the last crossroad (i.e. the character $$$s_n$$$) does not affect the final expense.Now Petya is at the first crossroad, and he wants to get to the $$$n$$$-th crossroad. After the party he has left with $$$p$$$ roubles. He's decided to go to some station on foot, and then go to home using only public transport.Help him to choose the closest crossroad $$$i$$$ to go on foot the first, so he has enough money to get from the $$$i$$$-th crossroad to the $$$n$$$-th, using only tram and bus tickets.

Each test contains one or more test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). The first line of each test case consists of three integers $$$a, b, p$$$ ($$$1 \le a, b, p \le 10^5$$$) — the cost of bus ticket, the cost of tram ticket and the amount of money Petya has. The second line of each test case consists of one string $$$s$$$, where $$$s_i = \texttt{A}$$$, if there is a bus station at $$$i$$$-th crossroad, and $$$s_i = \texttt{B}$$$, if there is a tram station at $$$i$$$-th crossroad ($$$2 \le |s| \le 10^5$$$). It is guaranteed, that the sum of the length of strings $$$s$$$ by all test cases in one test doesn't exceed $$$10^5$$$.

For each test case print one number — the minimal index $$$i$$$ of a crossroad Petya should go on foot. The rest of the path (i.e. from $$$i$$$ to $$$n$$$ he should use public transport).

5
2 2 1
BB
1 1 1
AB
3 2 8
AABBBBAABB
5 3 4
BBBBB
2 1 1
ABABAB

import Control.Arrow
import Data.List

main = interact $
  lines >>> drop 1
  >>> process
  >>> map show >>> unlines

process :: [String] -> [Integer]
process [] = []
process (abp:s:rest) = solve a b p s : process rest
  where [a,b,p] = map read (words abp)

solve :: Integer -> Integer -> Integer -> String -> Integer
solve a b p s = find p $ build s
  where
    find _ [] = 0
    find lim (top:rest)
      | top <= lim = 1
      | otherwise = 1 + find lim rest
    get c
      | c == 'A' = a
      | c == 'B' = b
    build :: String -> [Integer]
    build [c] = [0]
    build (c:cc:rest) = top : right
      where
        right = build (cc:rest)
        top = (if c /= cc || null rest then (get c) else 0) + (head right)


There is a programming language in which every program is a non-empty sequence of "<" and ">" signs and digits. Let's explain how the interpreter of this programming language works. A program is interpreted using movement of instruction pointer (IP) which consists of two parts.  Current character pointer (CP);  Direction pointer (DP) which can point left or right; Initially CP points to the leftmost character of the sequence and DP points to the right.We repeat the following steps until the first moment that CP points to somewhere outside the sequence.  If CP is pointing to a digit the interpreter prints that digit then CP moves one step according to the direction of DP. After that the value of the printed digit in the sequence decreases by one. If the printed digit was 0 then it cannot be decreased therefore it's erased from the sequence and the length of the sequence decreases by one.  If CP is pointing to "<" or ">" then the direction of DP changes to "left" or "right" correspondingly. Then CP moves one step according to DP. If the new character that CP is pointing to is "<" or ">" then the previous character will be erased from the sequence. If at any moment the CP goes outside of the sequence the execution is terminated.It's obvious the every program in this language terminates after some steps.We have a sequence s1, s2, ..., sn of "<", ">" and digits. You should answer q queries. Each query gives you l and r and asks how many of each digit will be printed if we run the sequence sl, sl + 1, ..., sr as an independent program in this language.

The first line of input contains two integers n and q (1 ≤ n, q ≤ 105) — represents the length of the sequence s and the number of queries.  The second line contains s, a sequence of "<", ">" and digits (0..9) written from left to right. Note, that the characters of s are not separated with spaces.  The next q lines each contains two integers li and ri (1 ≤ li ≤ ri ≤ n) — the i-th query.

For each query print 10 space separated integers: x0, x1, ..., x9 where xi equals the number of times the interpreter prints i while running the corresponding program. Print answers to the queries in the order they are given in input.

main = interact $ unlines . (\(_:s:qs) -> map (unwords . map show . solve s . map read . words) qs) . lines

solve seq [l, r] = step (replicate 10 0) '>' ("", drop (l-1) $ take r seq)

step ans _ (x, '>':'>':y) = step ans '>' (x, '>':y)
step ans _ (x, '>':'<':y) = step ans '<' (x, '<':y)
step ans _ ('>':x, '<':y) = step ans '>' (x, '>':y)
step ans _ ('<':x, '<':y) = step ans '<' (x, '<':y)
step ans _ (x, '>':c:y) = step ans '>' ('>':x, c:y)
step ans _ (c:x, '<':y) = step ans '<' (x, c:'<':y)
step ans _ (x, ">") = ans
step ans _ ([], '<':y) = ans
step ans '>' (x, '0':y) = step (inc 0 ans) '>' (x, y)
step ans '>' (x, c:y) = step (inc (read [c]) ans) '>' (pred c:x, y)
step ans '>' (x, []) = ans
step ans '<' (c:x, '0':y) = step (inc 0 ans) '<' (x, c:y)
step ans '<' (d:x, c:y) = step (inc (read [c]) ans) '<' (x, d:pred c:y)
step ans '<' ([], c:y) = inc (read [c]) ans

inc i ans = take i ans ++ (ans!!i + 1) : drop (i+1) ans

{-# LANGUAGE BangPatterns #-}

import Data.Array.Base

main = do
  _ <- getLine
  tape <- getLine
  let query [l,r] = run $ take(r-l+1) $ drop(l-1) tape
  interact $ unlines.map(show.query.map read.words).lines

data Dir = L | R deriving Eq
data M = M String Dir String String

instance Show M where
  show (M ns _ _ _) = unwords $ map (show.unsafeAt arr.fromEnum) ['0'..'9']
   where
     !arr = unsafeAccumArray (+) 0 (0,fromEnum '9') $ map(\c->(fromEnum c,1)) ns :: UArray Int Int

run tape = go $ M [] R [] tape
go (M ns _ ('<':ls) ('<':rs)) = go $ M ns       L ls ('<':rs)
go (M ns _ ('>':ls) ('<':rs)) = go $ M ns       L ls ('>':rs)
go (M ns _ ls ('>':'>':rs))   = go $ M ns       R ls ('>':rs)
go (M ns _ ls ('>':'<':rs))   = go $ M ns       R ls ('<':rs)
go (M ns _ (l:ls) ('<':rs))   = go $ M ns       L ls (l:'<':rs)
go (M ns _ ls ('>':rs))       = go $ M ns       R ('>':ls) rs
go (M ns L (l:ls) ('0':rs))   = go $ M ('0':ns) L ls (l:rs)
go (M ns R ls ('0':rs))       = go $ M ('0':ns) R ls rs
go (M ns L (l:ls) (n:rs))|'0'<=n && n<='9' = go $ M (n:ns) L ls (l:pred n:rs)
go (M ns R ls (n:rs))    |'0'<=n && n<='9' = go $ M (n:ns) R (pred n:ls) rs
go (M ns L [] (n:_))     |'0'<=n && n<='9' = M (n:ns) L [] []
go m = m

main = interact $ unlines . (\(_:s:qs) -> map (unwords . map show . solve s . map read . words) qs) . lines

solve seq [l, r] = step (replicate 10 0) '>' ("", drop (l-1) $ take r seq)

step ans _ (x, '>':'>':y) = step ans '>' (x, '>':y)
step ans _ (x, '>':'<':y) = step ans '<' (x, '<':y)
step ans _ ('>':x, '<':y) = step ans '>' (x, '>':y)
step ans _ ('<':x, '<':y) = step ans '<' (x, '<':y)
step ans _ (x, '>':c:y) = step ans '>' ('>':x, c:y)
step ans _ (c:x, '<':y) = step ans '<' (x, c:'<':y)
step ans _ (x, ">") = ans
step ans _ ("", '<':y) = ans
step ans '>' (x, '0':y) = step (inc 0 ans) '>' (x, y)
step ans '>' (x, c:y) = step (inc (read [c]) ans) '>' (pred c:x, y)
step ans '<' (c:x, '0':y) = step (inc 0 ans) '<' (x, c:y)
step ans '<' (d:x, c:y) = step (inc (read [c]) ans) '<' (x, d:pred c:y)
step ans _ _ = ans

inc i ans = take i ans ++ (ans!!i + 1) : drop (i+1) ans

main = interact $ unlines . (\(_:s:qs) -> map (unwords . map show . solve s . map read . words) qs) . lines

solve seq [l, r] = step (replicate 10 0) '>' ("", drop (l-1) $ take r seq)

step ans _ (_, []) = ans
step ans '<' ([], _) = ans
step ans _ (x, '>':'>':y) = step ans '>' (x, '>':y)
step ans _ (x, '>':'<':y) = step ans '<' (x, '<':y)
step ans _ ('>':x, '<':y) = step ans '>' (x, '>':y)
step ans _ ('<':x, '<':y) = step ans '<' (x, '<':y)
step ans _ (x, '>':y) = step ans '>' ('>':x, y)
step ans _ (c:x, '<':y) = step ans '<' (x, c:'<':y)
step ans _ (x, '<':y) = ans
step ans '>' (x, '0':y) = step (inc 0 ans) '>' (x, y)
step ans '>' (x, c:y) = step (inc (read [c]) ans) '>' (pred c:x, y)
step ans '<' (c:x, '0':y) = step (inc 0 ans) '<' (x, c:y)
step ans '<' (d:x, c:y) = step (inc (read [c]) ans) '<' (x, d:pred c:y)

inc i ans = take i ans ++ (ans!!i + 1) : drop (i+1) ans

main = interact $ unlines . (\(_:s:qs) -> map (unwords . map show . solve s . map read . words) qs) . lines

solve seq [l, r] = step (replicate 10 0) '>' ("", drop (l-1) $ take r seq)

step ans _ (x, '>':'>':y) = step ans '>' (x, '>':y)
step ans _ (x, '>':'<':y) = step ans '<' (x, '<':y)
step ans _ ('>':x, '<':y) = step ans '>' (x, '>':y)
step ans _ ('<':x, '<':y) = step ans '<' (x, '<':y)
step ans _ (x, '>':y) = step ans '>' ('>':x, y)
step ans _ (c:x, '<':y) = step ans '<' (x, c:'<':y)
step ans _ ([], '<':y) = ans
step ans '>' (x, '0':y) = step (inc 0 ans) '>' (x, y)
step ans '>' (x, c:y) = step (inc (read [c]) ans) '>' (pred c:x, y)
step ans '<' (c:x, '0':y) = step (inc 0 ans) '<' (x, c:y)
step ans '<' (d:x, c:y) = step (inc (read [c]) ans) '<' (x, d:pred c:y)
step ans _ _ = ans

inc i ans = take i ans ++ (ans!!i + 1) : drop (i+1) ans

{-# LANGUAGE BangPatterns #-}

import Data.Array.Base

main = do
  _ <- getLine
  tape <- getLine
  let query [l,r] = run $ take(r-l+1) $ drop(l-1) tape
  interact $ unlines.map(show.query.map read.words).lines

data Dir = L | R deriving Eq
data M = M String Dir String String

instance Show M where
  show (M ns _ _ _) = unwords $ map (show.unsafeAt arr.fromEnum) ['0'..'9']
   where
     !arr = unsafeAccumArray (+) 0 (0,fromEnum '9') $ map(\c->(fromEnum c,1)) ns :: UArray Int Int

run tape = go $ M [] R [] tape
go (M ns _ ('<':ls) ('<':rs)) = go $ M ns       L ls ('<':rs)
go (M ns _ ('>':ls) ('<':rs)) = go $ M ns       L ls ('>':rs)
go (M ns _ ls ('>':'>':rs))   = go $ M ns       R ls ('>':rs)
go (M ns _ ls ('>':'<':rs))   = go $ M ns       R ls ('<':rs)
go (M ns _ (l:ls) ('<':rs))   = go $ M ns       L ls (l:'<':rs)
go (M ns _ ls ('>':rs))       = go $ M ns       R ('>':ls) rs
go (M ns L (l:ls) ('0':rs))   = go $ M ('0':ns) L ls (l:rs)
go (M ns R ls ('0':rs))       = go $ M ('0':ns) R ls rs
go (M ns L (l:ls) (n:rs))     = go $ M (n:ns)   L ls (l:pred n:rs)
go (M ns R ls (n:rs))         = go $ M (n:ns)   R (pred n:ls) rs
go (M ns L [] (n:_)) = M (n:ns) L [] []
go m = m


Returning back to problem solving, Gildong is now studying about palindromes. He learned that a palindrome is a string that is the same as its reverse. For example, strings "pop", "noon", "x", and "kkkkkk" are palindromes, while strings "moon", "tv", and "abab" are not. An empty string is also a palindrome.Gildong loves this concept so much, so he wants to play with it. He has $$$n$$$ distinct strings of equal length $$$m$$$. He wants to discard some of the strings (possibly none or all) and reorder the remaining strings so that the concatenation becomes a palindrome. He also wants the palindrome to be as long as possible. Please help him find one.

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n \le 100$$$, $$$1 \le m \le 50$$$) — the number of strings and the length of each string. Next $$$n$$$ lines contain a string of length $$$m$$$ each, consisting of lowercase Latin letters only. All strings are distinct.

In the first line, print the length of the longest palindrome string you made. In the second line, print that palindrome. If there are multiple answers, print any one of them. If the palindrome is empty, print an empty line or don't print this line at all.

9 4
abab
baba
abcd
bcde
cdef
defg
wxyz
zyxw
ijji

NoteIn the first example, "battab" is also a valid answer.In the second example, there can be 4 different valid answers including the sample output. We are not going to provide any hints for what the others are.In the third example, the empty string is the only valid palindrome string.

import Control.Monad
import qualified Data.Set as ST

type Info = (ST.Set String, String, String, String)

solve :: [String] -> IO ()
solve xss = do
  print (length left + length middle + length right)
  putStrLn (left ++ middle ++ right)
  where
    st = foldl (flip ST.insert) ST.empty xss
    (_,left,middle,right) = foldl step (st, [], [], []) xss
    step :: Info -> String -> Info
    step (st, ls, ms, rs) xs
      | xs == rev = (st, ls, xs, rs)
      | ST.member rev st = (st', ls++xs, ms, rev++rs)
      | otherwise = (st, ls, ms, rs)
        where
          rev = reverse xs
          st' = ST.delete rev $ (ST.delete xs st)

main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  xss <- replicateM n $ do
    getLine >>= return
  solve xss

solve :: [String] -> [String]
solve ws = [(show $ length result),  result]
  where result = concatAll $ rearange $ findPairs ws

rearange :: [(String, String)] -> [(String, String)]
rearange pairs
  | null singles = withoutSingles
  | otherwise = withoutSingles ++ [(head singles)]
  where singles = filter (\(x, y) -> y == "") pairs
        withoutSingles = filter (\(x, y) -> y /= "") pairs

isReversed :: String -> String -> Bool
isReversed a b = a == reverse b

isPalindrome :: String -> Bool
isPalindrome w = w == reverse w

findPairs :: [String] -> [(String, String)]
findPairs [] = []
findPairs [a] = if isPalindrome a then [(a, "")] else []
findPairs (w:ws)
  | null pairs = if isPalindrome w then [(w, "")] ++ findPairs ws else findPairs ws
  | otherwise  = [(w, head pairs)] ++ findPairs ws
  where pairs = (filter (\x -> isReversed w x) ws)

concatAll :: [(String, String)] -> String
concatAll [] = ""
concatAll [(a, b)] = a++b
concatAll ((a, b):xs) = a ++ (concatAll xs) ++ b

main :: IO ()
main = interact (unlines . solve . tail . lines)


Everool has a binary string $$$s$$$ of length $$$2n$$$. Note that a binary string is a string consisting of only characters $$$0$$$ and $$$1$$$. He wants to partition $$$s$$$ into two disjoint equal subsequences. He needs your help to do it.You are allowed to do the following operation exactly once.   You can choose any subsequence (possibly empty) of $$$s$$$ and rotate it right by one position. In other words, you can select a sequence of indices $$$b_1, b_2, \ldots, b_m$$$, where $$$1 \le b_1 < b_2 < \ldots < b_m \le 2n$$$. After that you simultaneously set $$$$$$s_{b_1} := s_{b_m},$$$$$$ $$$$$$s_{b_2} := s_{b_1},$$$$$$ $$$$$$\ldots,$$$$$$ $$$$$$s_{b_m} := s_{b_{m-1}}.$$$$$$Can you partition $$$s$$$ into two disjoint equal subsequences after performing the allowed operation exactly once?A partition of $$$s$$$ into two disjoint equal subsequences $$$s^p$$$ and $$$s^q$$$ is two increasing arrays of indices $$$p_1, p_2, \ldots, p_n$$$ and $$$q_1, q_2, \ldots, q_n$$$, such that each integer from $$$1$$$ to $$$2n$$$ is encountered in either $$$p$$$ or $$$q$$$ exactly once, $$$s^p = s_{p_1} s_{p_2} \ldots s_{p_n}$$$, $$$s^q = s_{q_1} s_{q_2} \ldots s_{q_n}$$$, and $$$s^p = s^q$$$.If it is not possible to partition after performing any kind of operation, report $$$-1$$$. If it is possible to do the operation and partition $$$s$$$ into two disjoint subsequences $$$s^p$$$ and $$$s^q$$$, such that $$$s^p = s^q$$$, print elements of $$$b$$$ and indices of $$$s^p$$$, i. e. the values $$$p_1, p_2, \ldots, p_n$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^5$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$), where $$$2n$$$ is the length of the binary string. The second line of each test case contains the binary string $$$s$$$ of length $$$2n$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case, follow the following output format. If there is no solution, print $$$-1$$$.  Otherwise,   In the first line, print an integer $$$m$$$ ($$$0 \leq m \leq 2n$$$), followed by $$$m$$$ distinct indices $$$b_1$$$, $$$b_2$$$, ..., $$$b_m$$$(in increasing order).  In the second line, print $$$n$$$ distinct indices $$$p_1$$$, $$$p_2$$$, ..., $$$p_n$$$ (in increasing order).  If there are multiple solutions, print any.

NoteIn the first test case, $$$b$$$ is empty. So string $$$s$$$ is not changed. Now $$$s^p = s_1 s_2 = \mathtt{10}$$$, and $$$s^q = s_3s_4 = \mathtt{10}$$$.In the second test case, $$$b=[3,5]$$$. Initially $$$s_3=\mathtt{0}$$$, and $$$s_5=\mathtt{1}$$$. On performing the operation, we simultaneously set $$$s_3=\mathtt{1}$$$, and $$$s_5=\mathtt{0}$$$.So $$$s$$$ is updated to 101000 on performing the operation.Now if we take characters at indices $$$[1,2,5]$$$ in $$$s^p$$$, we get $$$s_1=\mathtt{100}$$$. Also characters at indices $$$[3,4,6]$$$ are in $$$s^q$$$. Thus $$$s^q=100$$$. We are done as $$$s^p=s^q$$$.In fourth test case, it can be proved that it is not possible to partition the string after performing any operation.

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

main :: IO ()
main = do
    [t] <- getInts
    replicateM_ t $ do
        [n] <- getInts
        s <- C.getLine
        let at = (=='1') . C.index s
            go i k prv
                | c == c'   = k prv
                | otherwise = (2 * i + fromEnum (c == prv)) : k (not prv)
              where
                c = at (2 * i)
                c' = at (2 * i + 1)
            rot = (+1) <$> foldr go (const []) [0 .. n-1] True
        if odd (length rot)
            then putStrLn "-1"
            else mapM_ (putStrLn . unwords . map show) [length rot : rot, [2,4..2*n]]

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