Polycarp has just attempted to pass the driving test. He ran over the straight road with the signs of four types.  speed limit: this sign comes with a positive integer number — maximal speed of the car after the sign (cancel the action of the previous sign of this type);  overtake is allowed: this sign means that after some car meets it, it can overtake any other car;  no speed limit: this sign cancels speed limit if any (car can move with arbitrary speed after this sign);  no overtake allowed: some car can't overtake any other car after this sign. Polycarp goes past the signs consequentially, each new sign cancels the action of all the previous signs of it's kind (speed limit/overtake). It is possible that two or more "no overtake allowed" signs go one after another with zero "overtake is allowed" signs between them. It works with "no speed limit" and "overtake is allowed" signs as well.In the beginning of the ride overtake is allowed and there is no speed limit.You are given the sequence of events in chronological order — events which happened to Polycarp during the ride. There are events of following types:  Polycarp changes the speed of his car to specified (this event comes with a positive integer number);  Polycarp's car overtakes the other car;  Polycarp's car goes past the "speed limit" sign (this sign comes with a positive integer);  Polycarp's car goes past the "overtake is allowed" sign;  Polycarp's car goes past the "no speed limit";  Polycarp's car goes past the "no overtake allowed"; It is guaranteed that the first event in chronological order is the event of type 1 (Polycarp changed the speed of his car to specified).After the exam Polycarp can justify his rule violations by telling the driving instructor that he just didn't notice some of the signs. What is the minimal number of signs Polycarp should say he didn't notice, so that he would make no rule violations from his point of view?

The first line contains one integer number n (1 ≤ n ≤ 2·105) — number of events. Each of the next n lines starts with integer t (1 ≤ t ≤ 6) — the type of the event. An integer s (1 ≤ s ≤ 300) follows in the query of the first and the third type (if it is the query of first type, then it's new speed of Polycarp's car, if it is the query of third type, then it's new speed limit). It is guaranteed that the first event in chronological order is the event of type 1 (Polycarp changed the speed of his car to specified).

Print the minimal number of road signs Polycarp should say he didn't notice, so that he would make no rule violations from his point of view.

NoteIn the first example Polycarp should say he didn't notice the "speed limit" sign with the limit of 70 and the second "speed limit" sign with the limit of 120.In the second example Polycarp didn't make any rule violation.In the third example Polycarp should say he didn't notice both "no overtake allowed" that came after "overtake is allowed" sign.

-- 845D

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (partition, foldl')

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program = fst . foldl' runEvents (0, (0, [], 0))

runEvents :: (Int, (Int, [Int], Int)) -> [Int] -> (Int, (Int, [Int], Int))
runEvents (prevIgnore, (speed, speedSigns, overtakeSigns)) event =
  let (state', ignoredSigns) = case event of
        [1, s] -> ((s, r, overtakeSigns), length l) where (l, r) = span (<s) speedSigns
        [2]    -> ((speed, speedSigns, 0), overtakeSigns)
        [3, s]
          | s < speed -> ((speed, speedSigns, overtakeSigns), 1)
          | otherwise -> ((speed, s:speedSigns, overtakeSigns), 0)
        [4]    -> ((speed, speedSigns, 0), 0)
        [5]    -> ((speed, [], overtakeSigns), 0)
        [6]    -> ((speed, speedSigns, overtakeSigns + 1), 0)
  in (prevIgnore + ignoredSigns, state')

-- http://codeforces.com/contest/845/problem/D

{-# LANGUAGE CPP #-}

#define eChangeSpeed 1
#define eOvertakeOtherCar 2
#define eSpeedLimit 3
#define eOvertakeAllowed 4
#define eNoSpeedLimit 5
#define eNoOvertakeAllowed 6

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

type CurrentSpeed = Int
type SpeedLimitStack = [Int]
type NoOvertakeCount = Int
type NumIgnored = Int
type State = (CurrentSpeed, SpeedLimitStack, NoOvertakeCount, NumIgnored)

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

main = do
    numEvents <- getInt
    events <- replicateM numEvents getInts
    let (_,_,_,answer) = solve events
    print answer

state0 = (0, [], 0, 0)

solve :: [[Int]] -> State
solve events = foldl f state0 events where
    f (speed, speedLimitStack, noOvertakeCount, answer) event@(t:args) = case t of
        eChangeSpeed ->
            let newSpeed = head args
            in if length speedLimitStack > 0 && newSpeed > head speedLimitStack
                then (newSpeed, dropWhile (< newSpeed) speedLimitStack, noOvertakeCount, answer + length (takeWhile (< newSpeed) speedLimitStack))
                else (newSpeed, speedLimitStack, noOvertakeCount, answer)
        eOvertakeOtherCar -> (speed, speedLimitStack, 0, if noOvertakeCount == 0 then answer else answer + noOvertakeCount)
        eSpeedLimit ->
            let newSpeedLimit = head args
            in if speed > newSpeedLimit
                then (speed, speedLimitStack, noOvertakeCount, answer + 1)
                else (speed, newSpeedLimit : speedLimitStack, noOvertakeCount, answer)
        eOvertakeAllowed -> (speed, speedLimitStack, 0, answer)
        eNoSpeedLimit -> (speed, [], noOvertakeCount, answer)
        eNoOvertakeAllowed -> (speed, speedLimitStack, noOvertakeCount + 1, answer)

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

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

data E = S !Int | O | L !Int | A | I | N deriving Show

app = do
  n <- poi
  es <- replicateM n $ \case { 1 -> fmap S poi; 2 -> return O; 3 -> fmap L poi; 4 -> return A; 5 -> return I; 6 -> return N } =<< poi
  return $ show $ solve es
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = (\(a, _, _, _) -> a) . foldl go (0, 0, [], 0)
  where
    go (!c, !s, !ls, !o) = \case
      S s' -> let (lt, gt) = span (< s') ls in (c + length lt, s', gt, o)
      O -> (c + o, s, ls, 0)
      L l -> if s > l then (c + 1, s, ls, o) else (c, s, l:ls, o)
      A -> (c, s, ls, 0)
      I -> (c, s, [], o)
      N -> (c, s, ls, o + 1)

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, words, lines)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

run (g@[1, spd]:xs) cnt (_:std:sta) ans | std >= spd = run xs cnt (spd:std:sta) ans
                                        | otherwise = run (g:xs) cnt (spd:sta) (succ ans)
run ([1, spd]:xs) cnt [_] ans = run xs cnt [spd] ans
run ([2]:xs) cnt sta ans = run xs 0 sta (ans + cnt)
run ([3, spr]:xs) cnt (spd:sta) ans | spr < spd = run xs cnt (spd:sta) (succ ans)
                                    | otherwise = run xs cnt (spd:spr:sta) ans
run ([4]:xs) _ sta ans = run xs 0 sta ans
run ([5]:xs) cnt (spd:_) ans = run xs cnt [spd] ans
run ([6]:xs) cnt sta ans = run xs (succ cnt) sta ans
run [] _ _ ans = ans

main = do
    _ <- B.getLine
    (map (map readInt . C.words) . C.lines-> xs) <- B.getContents
    putStrLn $ show $ run xs 0 [0] 0

-- 845D

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sort, sortBy)

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], [0], False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],[Int],Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speeds, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s -> (length $ takeWhile (<s) limits, [])
        SpeedSign l
          | maximum speeds > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speeds' = case event of
        SpeedChange s -> s:speeds
        SpeedSign _ -> [0]
        NoSpeedSign -> [0]
        _ -> speeds
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speeds', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

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

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], 0, True, False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],Int,Bool,Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speed, nolimit, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s | not nolimit -> (length l, sort h)
            where (l, h) = span (<s) limits
        SpeedSign l
          | speed > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speed' = case event of
        SpeedChange s -> s
        _ -> speed
      nolimit' = case event of
        NoSpeedSign -> True
        SpeedSign _ -> False
        _ -> nolimit
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speed', nolimit', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sort, sortBy)

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], [0], False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],[Int],Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speeds, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s -> (length $ takeWhile (<s) limits, [])
        SpeedSign l
          | maximum speeds > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speeds' = case event of
        SpeedChange s -> s:speeds
        SpeedSign _ -> take 1 speeds
        NoSpeedSign -> [0]
        _ -> speeds
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speeds', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

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

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], 0, False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],Int,Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speed, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s -> (length $ takeWhile (<s) limits, [])
        SpeedSign l
          | speed > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speed' = case event of
        SpeedChange s -> s
        NoSpeedSign -> 0
        _ -> speed
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speed', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (partition)

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents xs (0, [], 0)

runEvents :: [[Int]] -> (Int, [Int], Int) -> Int
runEvents [] _ = 0
runEvents (event:events) (speed, speedSigns, overtakeSigns) =
  let (speed', speedSigns', overtakeSigns', ignoredSigns) = case event of
        [1, s] -> (speed, r, overtakeSigns, length l)
                     where (l, r) = partition (<s) speedSigns
        [2]    -> (speed, speedSigns, 0, overtakeSigns)
        [3, s] -> (speed, s:speedSigns, overtakeSigns, 0)
        [4]    -> (speed, speedSigns, 0, 0)
        [5]    -> (speed, [], overtakeSigns, 0)
        [6]    -> (speed, speedSigns, overtakeSigns + 1, 0)
  in ignoredSigns + runEvents events (speed', speedSigns', overtakeSigns')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe (fromJust)
import Data.List (sort, sortBy)

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], [0], False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],[Int],Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (futureLimits, futureSpeeds, willOvertake) =
  let (signsIgnored, futureLimits') = case event of
        SpeedChange s -> (length $ takeWhile (<s) $ sort futureLimits, [])
        SpeedSign l
          | maximum futureSpeeds > l -> (1, futureLimits)
          | otherwise -> (0, l:futureLimits)
        NoOvertakeSign | willOvertake -> (1, futureLimits)
        _ -> (0, futureLimits)
      futureSpeeds' = case event of
        SpeedChange s -> s:futureSpeeds
        NoSpeedSign -> [0]
        _ -> futureSpeeds
      willOvertake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> willOvertake
  in
  signsIgnored + runEvents events (futureLimits', futureSpeeds', willOvertake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

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

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], 0, True, False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],Int,Bool,Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speed, nolimit, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s | not nolimit -> (length l, sort h)
            where (l, h) = span (<s) limits
        SpeedSign l
          | speed > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speed' = case event of
        SpeedChange s -> s
        NoSpeedSign -> 0
        _ -> speed
      nolimit' = case event of
        NoSpeedSign -> True
        SpeedSign _ -> False
        _ -> nolimit
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speed', nolimit', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

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

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events (999,0,False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> (Int,Int,Bool) -> Int
runEvents [] (_, _, _) = 0
runEvents (event:events) (limit, speed, overtake) =
  let ignore = case event of
        SpeedChange s | s > limit -> 1
        SpeedSign l | speed > l -> 1
        NoOvertakeSign | overtake -> 1
        _ -> 0
      limit' = case event of
        SpeedChange s | s > limit -> 0
        SpeedSign s | ignore == 0 -> s
        NoSpeedSign -> 999
        _ -> limit
      speed' = case event of
        SpeedChange s -> s
        NoSpeedSign -> 0
        _ -> speed
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limit', speed', overtake')

-- 845D

{-# LANGUAGE OverloadedStrings #-}

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

data Event = SpeedChange Int
           | Overtake
           | SpeedSign Int
           | OvertakeSign
           | NoSpeedSign
           | NoOvertakeSign
           deriving (Show)

toEvent :: [Int] -> Event
toEvent (t:spd) = case t of
  1 -> SpeedChange $ head spd
  2 -> Overtake
  3 -> SpeedSign $ head spd
  4 -> OvertakeSign
  5 -> NoSpeedSign
  6 -> NoOvertakeSign

main = getLine >> (B.interact $ output . program . input)
    where input = (map . map) (fst . fromJust . B.readInt) . map B.words . B.lines
          output = B.pack . show

program :: [[Int]] -> Int
program xs = runEvents events ([], 0, False)
    where events = reverse $ map toEvent xs

runEvents :: [Event] -> ([Int],Int,Bool) -> Int
runEvents [] _ = 0
runEvents (event:events) (limits, speed, overtake) =
  let (ignore, limits') = case event of
        SpeedChange s -> (length l, sort h)
            where (l, h) = span (<s) limits
        SpeedSign l
          | speed > l -> (1, limits)
          | otherwise -> (0, sort (l:limits))
        NoSpeedSign -> (0, [])
        NoOvertakeSign | overtake -> (1, limits)
        _ -> (0, limits)
      speed' = case event of
        SpeedChange s -> s
        NoSpeedSign -> 0
        _ -> speed
      overtake' = case event of
        Overtake -> True
        OvertakeSign -> False
        _ -> overtake
  in
  ignore + runEvents events (limits', speed', overtake')

-- http://codeforces.com/contest/845/problem/D

{-# LANGUAGE CPP #-}

#define eChangeSpeed 1
#define eOvertakeOtherCar 2
#define eSpeedLimit 3
#define eOvertakeAllowed 4
#define eNoSpeedLimit 5
#define eNoOvertakeAllowed 6

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

type CurrentSpeed = Int
type SpeedLimit = Int
type NoOvertakeCount = Int
type NumIgnored = Int
type State = (CurrentSpeed, SpeedLimit, NoOvertakeCount, NumIgnored)

getInt = read `fmap` getLine :: IO Int
getInts = (map parseInt . BS8.words) `fmap` BS8.getLine :: IO [Int]
parseInt = fst . fromJust . BS8.readInt

main = do
    numEvents <- getInt
    events <- replicateM numEvents getInts
    let (_,_,_,answer) = solve events
    print answer

state0 = (0, maxBound :: Int, 0, 0)

solve :: [[Int]] -> State
solve events = foldl f state0 events where
    f (speed, speedLimit, noOvertakeCount, answer) event@(t:args) = case t of
        eChangeSpeed ->
            let newSpeed = head args
            in if newSpeed > speedLimit
                then (newSpeed, speedLimit, noOvertakeCount, answer + 1)
                else (newSpeed, speedLimit, noOvertakeCount, answer)
        eOvertakeOtherCar -> (speed, speedLimit, 0, if noOvertakeCount == 0 then answer else answer + noOvertakeCount)
        eSpeedLimit ->
            let newSpeedLimit = head args
            in if speed > newSpeedLimit
                then (speed, newSpeedLimit, noOvertakeCount, answer + 1)
                else (speed, newSpeedLimit, noOvertakeCount, answer)
        eOvertakeAllowed -> (speed, speedLimit, 0, answer)
        eNoSpeedLimit -> (speed, maxBound :: Int, noOvertakeCount, answer)
        eNoOvertakeAllowed -> (speed, speedLimit, noOvertakeCount + 1, answer)

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

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

data E = S !Int | O | L !Int | A | I | N deriving Show

app = do
  n <- poi
  es <- replicateM n $ \case { 1 -> fmap S poi; 2 -> return O; 3 -> fmap L poi; 4 -> return A; 5 -> return I; 6 -> return N } =<< poi
  return $ show $ solve es
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = (\(a, _, _, _) -> a) . foldl go (0, 0, [], 0)
  where
    go (!c, _, !ls, !o) (S s) = (c + length (takeWhile (< s) ls), s, ls, o)
    go (!c, !s, !ls, !o) O = (c + o, s, ls, 0)
    go (!c, !s, !ls, !o) (L l) = (c + fromEnum (s > l), s, l:ls, o)
    go (!c, !s, !ls, _) A = (c, s, ls, 0)
    go (!c, !s, _, !o) I = (c, s, [], o)
    go (!c, !s, !ls, !o) N = (c, s, ls, o + 1)

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

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

data E = S !Int | O | L !Int | A | I | N

app = do
  n <- poi
  es <- replicateM n $ \case { 1 -> fmap S poi; 2 -> return O; 3 -> fmap L poi; 4 -> return A; 5 -> return I; 6 -> return N } =<< poi
  return $ show $ solve es
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

solve = (\(a, _, _, _) -> a) . foldl go (0, 0, [], 0)
  where
    go (!c, _, !ls, !o) (S s) = (c + length (takeWhile (< s) ls), s, ls, o)
    go (!c, !s, !ls, !o) O = (c + o, s, ls, o)
    go (!c, !s, !ls, !o) (L l) = (c + fromEnum (s > l), s, l:ls, o)
    go (!c, !s, !ls, _) A = (c, s, ls, 0)
    go (!c, !s, _, !o) I = (c, s, [], o)
    go (!c, !s, !ls, !o) N = (c, s, ls, o + 1)


Given an array $$$a$$$ of $$$n$$$ elements, print any value that appears at least three times or print -1 if there is no such value.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2\cdot10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq n$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

For each test case, print any value that appears at least three times or print -1 if there is no such value.

NoteIn the first test case there is just a single element, so it can't occur at least three times and the answer is -1.In the second test case, all three elements of the array are equal to $$$2$$$, so $$$2$$$ occurs three times, and so the answer is $$$2$$$.For the third test case, $$$2$$$ occurs four times, so the answer is $$$2$$$.For the fourth test case, $$$4$$$ occurs three times, so the answer is $$$4$$$.For the fifth test case, $$$1$$$, $$$2$$$ and $$$3$$$ all occur at least three times, so they are all valid outputs.For the sixth test case, all elements are distinct, so none of them occurs at least three times and the answer is -1.

{-# LANGUAGE BangPatterns , BlockArguments ,FlexibleContexts ,FlexibleInstances ,OverloadedStrings ,TypeApplications ,MultiParamTypeClasses ,TupleSections #-}
import Control.Monad (replicateM,forM_,when,(<=<))
import qualified Data.IntMap as IM

main :: IO ()
main = do
  n <- readLn @Int
  query <- replicateM n $ do
    b <- readLn @Int
    a <- map (read @Int) . words <$> getLine
    return (b,a)
  forM_ query \(n,x) -> do
    let mm = IM.toList.IM.filter (>2).IM.fromListWith (+) $ map (\(k,v) -> (k, length[v])) (flip zip(replicate n 1)x)
    print if(null$mm)then (-1)
    else fst(head(mm))


You've got an array a, consisting of n integers. The array elements are indexed from 1 to n. Let's determine a two step operation like that:  First we build by the array a an array s of partial sums, consisting of n elements. Element number i (1 ≤ i ≤ n) of array s equals . The operation x mod y means that we take the remainder of the division of number x by number y.  Then we write the contents of the array s to the array a. Element number i (1 ≤ i ≤ n) of the array s becomes the i-th element of the array a (ai = si). You task is to find array a after exactly k described operations are applied.

The first line contains two space-separated integers n and k (1 ≤ n ≤ 2000, 0 ≤ k ≤ 109). The next line contains n space-separated integers a1, a2, ..., an — elements of the array a (0 ≤ ai ≤ 109).

Print n integers  — elements of the array a after the operations are applied to it. Print the elements in the order of increasing of their indexes in the array a. Separate the printed numbers by spaces.

import Control.Monad (liftM)
import Data.Array
import Data.List (foldl')

m :: Integer
m  =  10^9 + 7

mapMod :: [Integer] -> [Integer]
mapMod  =  map (flip mod m)

getMuls :: Int -> Integer -> Array Int Integer
getMuls n k  =  listArray (1,n) $ mapMod $ scanl (\a i -> a * (i + k - 1) `div` i) 1 [1..]

solve :: Integer -> Array Int Integer -> Array Int Integer
solve 0 a  =  a
solve k a  =  listArray (1,n) $ mapMod $ [foldl' (+) 0 [a ! j * b ! (i - j + 1) | j <- [1..i]] | i <- [1..n]]
  where
    n  =  snd $ bounds a
    b  =  getMuls n k

printA :: Array Int Integer -> IO ()
printA array  =  prints $ elems array
  where
    prints []  =  return ()
    prints [x]  =  print x
    prints (x:xs)  =  putStr (show x ++ " ") >> prints xs

main :: IO ()
main  =  do
    [n, k]  <-  liftM (map read . words) getLine
    array   <-  liftM (listArray (1, n) . map read . words) getLine
    printA $ solve (fromIntegral k) array

import Data.List
pr = 1000000007 :: Integer
par l = [read x :: Int | x <- words l]
invv :: Integer -> Integer -> Integer
invv q 1 = 1
invv q p = ((n * q) + 1) `div` p
    where n = p - invv p (q `mod` p)
inv x = invv pr x

multt :: Integer -> Integer -> Integer
multt x y = (x * y) `mod` pr
mult x y = fromIntegral (multt (fromIntegral x) (fromIntegral y))

solve l1 l2 = intercalate " " [show r | r<-result]
    where n:k:[] = par l1
          a = par l2
          prep 0 = 1
          prep x = (prep (x-1)) `mult` (k + x - 1) `mult` inv (fromIntegral x)
          pp = [prep g | g <- [n-1,n-2..0]]
          result = reverse [(sum u) `mod` pr | u <- [[x `mult` y | (x,y) <- zip a (drop j pp)] | j <- [0..n-1]]]
main = do
    l1 <- getLine
    l2 <- getLine
    putStrLn (solve l1 l2)

import Control.Monad (liftM)
import Data.Array

m :: Integer
m  =  10^9 + 7

solve :: Integer -> Array Int Integer -> Array Int Integer
solve 0 a  =  a
solve k a  =  listArray (1,n) $ solve' 1 0 [1..n]
  where
    n  =  snd $ bounds a
    solve' :: Integer -> Integer -> [Int] -> [Integer]
    solve' _ acc []  =  []
    solve' ckn acc (i:is)  =  acc' : solve' ckn' acc' is
      where
        i'  =  fromIntegral i
        ckn'  =  ckn * (k + i' - 1) `div` i' `mod` m
        acc'  =  (acc + ckn * (a ! i)) `mod` m

printA :: Array Int Integer -> IO ()
printA array  =  prints $ elems array
  where
    prints []  =  return ()
    prints [x]  =  print x
    prints (x:xs)  =  putStr (show x ++ " ") >> prints xs

main :: IO ()
main  =  do
    [n, k]  <-  liftM (map read . words) getLine
    array   <-  liftM (listArray (1, n) . map read . words) getLine
    printA $ solve (fromIntegral k) array


Petya loves lucky numbers very much. Everybody knows that lucky numbers are positive integers whose decimal record contains only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya loves long lucky numbers very much. He is interested in the minimum lucky number d that meets some condition. Let cnt(x) be the number of occurrences of number x in number d as a substring. For example, if d = 747747, then cnt(4) = 2, cnt(7) = 4, cnt(47) = 2, cnt(74) = 2. Petya wants the following condition to fulfil simultaneously: cnt(4) = a1, cnt(7) = a2, cnt(47) = a3, cnt(74) = a4. Petya is not interested in the occurrences of other numbers. Help him cope with this task.

The single line contains four integers a1, a2, a3 and a4 (1 ≤ a1, a2, a3, a4 ≤ 106).

On the single line print without leading zeroes the answer to the problem — the minimum lucky number d such, that cnt(4) = a1, cnt(7) = a2, cnt(47) = a3, cnt(74) = a4. If such number does not exist, print the single number "-1" (without the quotes).

i b f|b=[]|1>0=f
q x=i(abs x>1)$i(x<0)["74"]++i(x>0)["47"]
m c d=map(take(d+c+1).cycle)$q(c-d)
f x m l=i(n<0)[a++replicate n x++b]where(a,b)=break(==x)l;n=m-length(filter(==x)l)
s[a,b,c,d]=f '4'a.reverse=<<f '7'b=<<m c d
main=interact$last.("-1":).s.map read.words

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    cnt4 <- readInt
    cnt7 <- readInt
    cnt47 <- readInt
    cnt74 <- readInt
    return (cnt4, cnt7, cnt47, cnt74)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = putStrLn =<< solve . evalState parseInput <$> BS.getContents

check4 cnt4 cnt7 cnt47 cnt74
    | cnt4 < 0 || cnt7 < 0    = False
    | cnt47 < 0 || cnt74 < 0  = False
    | cnt44 < 0               = False
    | cnt77 < 0               = False
    | cnt77 > 0 && cnt47 == 0 = False
    | delta < 0 || delta > 1  = False
    | otherwise               = True
  where
    cnt44 = cnt4 - cnt74
    cnt77 = cnt7 - cnt47

    delta = cnt47 - cnt74 -- must be either 0 or 1

solve (cnt4, cnt7, cnt47, cnt74)
    | first4    = go (cnt4 - 1) cnt7 cnt47 cnt74 '4' "4"
    | first7    = go (cnt7 - 1) cnt4 cnt74 cnt47 '7' "7"
    | otherwise = "-1"
  where
    first4 = check4 (cnt4 - 1) cnt7 cnt47 cnt74
    first7 = check4 (cnt7 - 1) cnt4 cnt74 cnt47

    op '4' = '7'
    op '7' = '4'

    go 0 0 0 0 x xs = reverse xs
    go cnt4 cnt7 cnt47 cnt74 x xs
        | okay4 && okay7 = if x == '4' then go4 else go7
        | okay4          = go4
        | okay7          = go7
        | otherwise      = error "internal error"
      where
        okay4 = check4 (cnt4 - 1) cnt7 cnt47 cnt74
        okay7 = check4 (cnt7 - 1) cnt4 cnt74 (cnt47 - 1)

        go4 = go (cnt4 - 1) cnt7 cnt47 cnt74 x (x:xs)
        go7 = go (cnt7 - 1) cnt4 cnt74 (cnt47 - 1) (op x) (op x:xs)

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

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

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

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

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

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Control.Applicative

main = do [a1,a2,a3,a4] <- map read . words <$> getLine
          putStrLn $ solve [a1,a2,a3,a4]

solve :: [Int] -> String
solve [a1,a2,a3,a4]
  | a3 == a4 && a1 > a3 && a2 >= a3    = f 1 (a1-a3-1) ++ f 3 a3 ++ f 2 (a2-a3) ++ "4"
  | a3 == a4 && a1 == a3 && a2 > a4    = f 4 a4 ++ f 2 (a2-a4)
  | a3 == a4+1 && a1 >= a3 && a2 >= a3 = f 1 (a1-a3) ++ f 3 a3 ++ f 2 (a2-a3)
  | a3 == a4-1 && a1 >= a4 && a2 >= a4 = "7" ++ f 1 (a1-a4) ++ f 3 a3 ++ f 2 (a2-a4) ++ "4"
  | otherwise                          = "-1"

f 1 n = concatMap show $ replicate n 4
f 2 n = concatMap show $ replicate n 7
f 3 n = concatMap show $ concat $ replicate n [4,7]
f 4 n = concatMap show $ concat $ replicate n [7,4]

i b t f|b=t|1>0=f
q x=i(x<0)[]["74"]++i(x>0)[]["47"]
m c d=i(abs(c-d)>1)[]$map(take(d+c+1).cycle)$q(c-d)
f x m l=i(n<0)[]$[a++replicate n x++b]where(a,b)=break(==x)l;n=m-length(filter(==x)l)
s[a,b,c,d]=f '4'a.reverse=<<f '7'b=<<m c d
main=interact$last.("-1":).s.map read.words

import Control.Applicative

main = do [a1,a2,a3,a4] <- map read . words <$> getLine
          putStrLn $ solve [a1,a2,a3,a4]

solve :: [Int] -> String
solve [a1,a2,a3,a4]
  | a3 == a4 && a1 > a3 && a2 >= a3    = f 1 (a1-a3-1) ++ f 3 a3 ++ f 2 (a2-a3) ++ "4"
  | a3 == a4 && a1 == 1 && a2 >= 2     = "747" ++ f 2 (a2-2)
  | a3 == a4+1 && a1 >= a3 && a2 >= a3 = f 1 (a1-a3) ++ f 3 a3 ++ f 2 (a2-a3)
  | a3 == a4-1 && a1 >= a4 && a2 >= a4 = "7" ++ f 1 (a1-a4) ++ f 3 a3 ++ f 2 (a2-a4) ++ "4"
  | otherwise                          = "-1"

f 1 n = concatMap show $ replicate n 4
f 2 n = concatMap show $ replicate n 7
f 3 n = concatMap show $ concat $ replicate n [4,7]
f 4 n = concatMap show $ concat $ replicate n [7,4]

import Control.Applicative

main = do [a1,a2,a3,a4] <- map read . words <$> getLine
          putStrLn $ solve [a1,a2,a3,a4]

solve :: [Int] -> String
solve [a1,a2,a3,a4]
  | a3 == a4 && a1 > a3 && a2 >= a3    = f 1 (a1-a3-1) ++ f 3 a3 ++ f 2 (a2-a3) ++ "4"
  | a3 == a4 && a1 == a3 && a2 > 2     = f 2 (a2-a3) ++ f 3 a3
  | a3 == a4+1 && a1 >= a3 && a2 >= a3 = f 1 (a1-a3) ++ f 3 a3 ++ f 2 (a2-a3)
  | a3 == a4-1 && a1 >= a4 && a2 >= a4 = "7" ++ f 1 (a1-a4) ++ f 3 a3 ++ f 2 (a2-a4) ++ "4"
  | otherwise                          = "-1"

f 1 n = concatMap show $ replicate n 4
f 2 n = concatMap show $ replicate n 7
f 3 n = concatMap show $ concat $ replicate n [4,7]
f 4 n = concatMap show $ concat $ replicate n [7,4]

import Control.Applicative

main = do [a1,a2,a3,a4] <- map read . words <$> getLine
          putStrLn $ solve [a1,a2,a3,a4]

solve :: [Int] -> String
solve [a1,a2,a3,a4]
  | a3 == a4 && (a1>a4) && (a2>=a4) = concatMap show $ (replicate (a1-a4-1) 4)++((concat.replicate a3) [4,7])++(replicate (a2-a4) 7)++[4]
  | a3 == a4-1 && (a1>=a4) && (a2>=a4) = concatMap show $ [7]++(replicate (a1-a4) 4)++((concat.replicate a3) [4,7])++(replicate (a2-a4) 7)++[4]
  | a3 == a4+1 && (a1>=a3) && (a2>=a3) = concatMap show $ (replicate (a1-a3) 4)++((concat.replicate a3) [4,7])++(replicate (a2-a3) 7)
  | otherwise = "-1"

m c d|abs(c-d)>1=[]|1>0=[take(d+c+1).drop(max(d-c)0)$cycle"47"]
f x m l|n<0=[]|1>0=[a++replicate n x++b]where(a,b)=break(==x)l;n=m-length(filter(==x)l)
s[a,b,c,d]=f '4'a.reverse=<<f '7'b=<<m c d
main=interact$last.("-1":).s.map read.words


You are given a rooted tree with root in vertex 1. Each vertex is coloured in some colour.Let's call colour c dominating in the subtree of vertex v if there are no other colours that appear in the subtree of vertex v more times than colour c. So it's possible that two or more colours will be dominating in the subtree of some vertex.The subtree of vertex v is the vertex v and all other vertices that contains vertex v in each path to the root.For each vertex v find the sum of all dominating colours in the subtree of vertex v.

The first line contains integer n (1 ≤ n ≤ 105) — the number of vertices in the tree. The second line contains n integers ci (1 ≤ ci ≤ n), ci — the colour of the i-th vertex. Each of the next n - 1 lines contains two integers xj, yj (1 ≤ xj, yj ≤ n) — the edge of the tree. The first vertex is the root of the tree.

Print n integers — the sums of dominating colours for each vertex.

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTArray)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
import Data.Maybe (fromJust)
import Prelude hiding (getContents, getLine, lines, words)

data Result = Result { counts :: (Int, IntMap Int), best :: (Int64, Int) }

(+.) :: Result -> Result -> Result
r@(Result (l, m) a) +. r'@(Result (l', m') _)
  | l < l' = r' +. r
  | otherwise = IntMap.foldrWithKey merge r m'
  where
    merge :: Int -> Int -> Result -> Result
    merge color count (Result (l, m) a@(colorsSum, maxCount)) = Result (l', m') b
      where
        c = IntMap.findWithDefault 0 color m
        count' = c + count

        l' = if c == 0 then l + 1 else l
        m' = IntMap.insert color count' m

        b = case count' `compare` maxCount of
          GT -> (fromIntegral color :: Int64, count')
          EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
          LT -> a

readInts = map (fst . fromJust . readInt) . words

main = do
  [n] <- readInts <$> getLine
  cs <- listArray (1, n) . readInts <$> getLine
  es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

  let
    g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

    ps = runSTArray $ do
      a <- newArray (1, n) 0
      let dfs w u = do
          writeArray a u w
          mapM_ (dfs u) . filter (/= w) $ g ! u
      dfs 0 1
      return a

    rs = listArray (1, n) $ map search [1..n]

    search u = foldl (+.) zero . map (rs !) . filter (/= (ps ! u)) $ g ! u
      where
        zero = Result (1, IntMap.singleton c 1) (fromIntegral c, 1)
          where c = cs ! u

  putStrLn . unwords . map show . map (fst . best) $ elems rs

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
import Data.Maybe (fromJust)
import Prelude hiding (getContents, getLine, lines, words)

data Result = Result { counts :: (Int, IntMap Int), best :: (Int64, Int) }

(+.) :: Result -> Result -> Result
r@(Result (l, m) a) +. r'@(Result (l', m') _)
  | l < l' = r' +. r
  | otherwise = IntMap.foldrWithKey merge r m'
  where
    merge :: Int -> Int -> Result -> Result
    merge color count (Result (l, m) a@(colorsSum, maxCount)) = Result (l', m') b
      where
        c = IntMap.findWithDefault 0 color m
        count' = c + count

        l' = if c == 0 then l + 1 else l
        m' = IntMap.insert color count' m

        b = case count' `compare` maxCount of
          GT -> (fromIntegral color :: Int64, count')
          EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
          LT -> a

readInts = map (fst . fromJust . readInt) . words

main = do
  [n] <- readInts <$> getLine
  cs <- listArray (1, n) . readInts <$> getLine
  es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

  let
    g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

    ps = runSTArray $ do
      a <- newArray (1, n) 0
      let dfs w u = do
          writeArray a u w
          mapM_ (dfs u) . filter (/= w) $ g ! u
      dfs 0 1
      return a

    rs = listArray (1, n) $ map search [1..n]

    search u = foldl (+.) zero . map (rs !) . filter (/= (ps ! u)) $ g ! u
      where
        zero = Result (1, IntMap.singleton c 1) (fromIntegral c, 1)
          where c = cs ! u

  putStrLn . unwords . map show . map (fst . best) $ elems rs

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTArray)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Tuple (swap)
import Data.Maybe (fromJust, fromMaybe, isNothing)
import Prelude hiding (getContents, getLine, lines, words)

data Result = Result { counts :: Map Int Int, best :: (Int64, Int) }

(+.) :: Result -> Result -> Result
r@(Result m a) +. r'@(Result m' _)
  | Map.size m < Map.size m' = r' +. r
  | otherwise = Map.foldrWithKey merge r m'
  where
    merge :: Int -> Int -> Result -> Result
    merge color count (Result m a@(colorsSum, maxCount)) = Result m' b
      where
        (old, m') = Map.insertLookupWithKey (\k a b -> a + b) color count m
        count' = fromMaybe 0 old + count

        b = case count' `compare` maxCount of
          GT -> (fromIntegral color :: Int64, count')
          EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
          LT -> a

readInts = map (fst . fromJust . readInt) . words

main = do
  [n] <- readInts <$> getLine
  cs <- listArray (1, n) . readInts <$> getLine
  es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

  let
    g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

    ps = runSTArray $ do
      a <- newArray (1, n) 0
      let dfs w u = do
          writeArray a u w
          mapM_ (dfs u) . filter (/= w) $ g ! u
      dfs 0 1
      return a

    rs = listArray (1, n) $ map search [1..n]

    search u = foldl (+.) zero . map (rs !) . filter (/= (ps ! u)) $ g ! u
      where
        zero = Result (Map.singleton c 1) (fromIntegral c, 1)
          where c = cs ! u

  putStrLn . unwords . map show . map (fst . best) $ elems rs

{- ok -}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, array, listArray, elems, (!))
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.Int (Int64)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Tuple (swap)
import Data.Maybe (fromJust, fromMaybe)
import Prelude hiding (getContents, getLine, lines, words)

data Result = Result { counts :: Map Int Int, best :: (Int64, Int) }

(+.) :: Result -> Result -> Result
r@(Result m a) +. r'@(Result m' _)
  | Map.size m < Map.size m' = r' +. r
  | otherwise = Map.foldrWithKey merge r m'
  where
    merge :: Int -> Int -> Result -> Result
    merge color count (Result m a@(colorsSum, maxCount)) = Result m' b
      where
        (old, m') = Map.insertLookupWithKey (\k a b -> a + b) color count m
        count' = fromMaybe 0 old + count

        b = case count' `compare` maxCount of
          GT -> (fromIntegral color :: Int64, count')
          EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
          LT -> a

readInts = map (fst . fromJust . readInt) . words

main = do
  [n] <- readInts <$> getLine
  cs <- listArray (1, n) . readInts <$> getLine
  es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

  let
    g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

    ps = array (1, n) $ dfs 0 [] 1
      where
        dfs w ps u = (u,w) : (foldl (dfs u) ps . filter (/= w) $ g ! u)

    rs = listArray (1, n) $ map search [1..n]

    search u = foldl (+.) zero . map (rs !) . filter (/= (ps ! u)) $ g ! u
      where
        zero = Result (Map.singleton c 1) (fromIntegral c, 1)
          where c = cs ! u

  putStrLn . unwords . map show . map (fst . best) $ elems rs

{- ok -}
{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)
import Data.Array.ST.Safe (runSTArray)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
import Data.Maybe (fromJust, fromMaybe, isNothing)
import Prelude hiding (getContents, getLine, lines, words)

data Result = Result { counts :: (Int, IntMap Int), best :: (Int64, Int) }

(+.) :: Result -> Result -> Result
r@(Result (l, m) a) +. r'@(Result (l', m') _)
  | l < l' = r' +. r
  | otherwise = IntMap.foldrWithKey merge r m'
  where
    merge :: Int -> Int -> Result -> Result
    merge color count (Result (l, m) a@(colorsSum, maxCount)) = Result (l', m') b
      where
        (old, m') = IntMap.insertLookupWithKey (\k a b -> a + b) color count m
        count' = fromMaybe 0 old + count
        l' = if isNothing old then l + 1 else l

        b = case count' `compare` maxCount of
          GT -> (fromIntegral color :: Int64, count')
          EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
          LT -> a

readInts = map (fst . fromJust . readInt) . words

main = do
  [n] <- readInts <$> getLine
  cs <- listArray (1, n) . readInts <$> getLine
  es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

  let
    g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

    ps = runSTArray $ do
      a <- newArray (1, n) 0
      let dfs w u = do
          writeArray a u w
          mapM_ (dfs u) . filter (/= w) $ g ! u
      dfs 0 1
      return a

    rs = listArray (1, n) $ map search [1..n]

    search u = foldl (+.) zero . map (rs !) . filter (/= (ps ! u)) $ g ! u
      where
        zero = Result (1, IntMap.singleton c 1) (fromIntegral c, 1)
          where c = cs ! u

  putStrLn . unwords . map show . map (fst . best) $ elems rs

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
import Data.Maybe (fromJust, fromMaybe, isNothing)
import Data.Int (Int64)
-- import Debug.Trace (trace)

import Data.Array.ST.Safe (STArray, runSTArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)

import Prelude hiding (getContents, getLine, lines, words)

readInts = map (fst . fromJust . readInt) . words

main = do
	[n] <- readInts <$> getLine
	cs <- readInts <$> getLine
	es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

	let
		cs' = listArray (1, n) cs

		g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

		ps = runSTArray $ do
			ps <- newArray (1, n) 0
			let dfs w u = do
				writeArray ps u w
				mapM_ (dfs u) . filter (/= w) $ g ! u
			dfs 0 1
			return ps

		as = listArray (1, n) $ map search [1..n]

		search :: Int -> ((Int, IntMap Int), (Int64, Int))
		search u = -- trace ("u = " ++ show u ++ " r = " ++ show r ++ " z = " ++ show zero) $
				r
			where
				r = foldl merge zero . filter (/= (ps ! u)) $ g ! u

				zero = ((1, IntMap.singleton c 1), (fromIntegral c :: Int64, 1)) -- (colors sum, max count)
					where c = cs' ! u

				merge state@((l, m), best) v = r
					where
						r = IntMap.foldrWithKey merge' zero m2
						state'@((l', m'), best') = as ! v

						(zero, m2) = if l > l' then (state, m') else (state', m)

						merge' color count ((l, m), best@(colorsSum, maxCount)) = -- trace ("n = " ++ show (color, count) ++ " best' = " ++ show best') $
								((l', m'), best')
							where
								count1 = IntMap.findWithDefault 0 color m

								l' = if count1 == 0 then l + 1 else l
								count' = count1 + count
								m' = IntMap.insert color count' m

								best' = case compare count' maxCount of
									GT -> (fromIntegral color :: Int64, count')
									EQ -> (colorsSum + (fromIntegral color :: Int64), maxCount)
									LT -> best

	putStrLn . unwords . map show . map (fst . snd) $ elems as

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (mapM_)
import Data.Array (accumArray, listArray, elems, (!), array)
import Data.ByteString.Char8 (getContents, getLine, lines, readInt, words)
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
import Data.Maybe (fromJust, fromMaybe, isNothing)
-- import Debug.Trace (trace)

import Data.Array.ST.Safe (STArray, runSTArray)
import Data.Array.MArray.Safe (newArray, readArray, writeArray)

import Prelude hiding (getContents, getLine, lines, words)

readInts = map (fst . fromJust . readInt) . words

main = do
	[n] <- readInts <$> getLine
	cs <- readInts <$> getLine
	es <- map ((\[a, b] -> (a, b)) . readInts) . lines <$> getContents

	let
		cs' = listArray (1, n) cs

		g = accumArray (flip (:)) [] (1, n) $ es ++ map swap es

		ps = runSTArray $ do
			ps <- newArray (1, n) 0
			let dfs w u = do
				writeArray ps u w
				mapM_ (dfs u) . filter (/= w) $ g ! u
			dfs 0 1
			return ps

		as = listArray (1, n) $ map search [1..n]

		search :: Int -> ((Int, IntMap Int), (Int, Int))
		search u = -- trace ("u = " ++ show u ++ " r = " ++ show r ++ " z = " ++ show zero) $
				r
			where
				r = foldl merge zero . filter (/= (ps ! u)) $ g ! u

				zero = ((1, IntMap.singleton c 1), (c, 1)) -- (colors sum, max count)
					where c = cs' ! u

				merge state@((l, m), best) v = r
					where
						r = IntMap.foldrWithKey merge' zero m2
						state'@((l', m'), best') = as ! v

						(zero, m2) =
							if l > l' then (state, m') else (state', m)

						merge' color count ((l, m), best@(colorsSum, maxCount)) = -- trace ("n = " ++ show (color, count) ++ " best' = " ++ show best') $
								((l', m'), best')
							where
								r = IntMap.lookup color m

								l' = if isNothing r then l + 1 else l
								count' = fromMaybe 0 r + count
								m' = IntMap.insert color count' m

								best' = case compare count' maxCount of
									GT -> (color, count')
									EQ -> (colorsSum + color, maxCount)
									LT -> best

	putStrLn . unwords . map show . map (fst . snd) $ elems as

import Control.Applicative ((<$>))
import Data.Array (accumArray, listArray, elems, (!))
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Tuple (swap)
-- import Debug.Trace (trace)

main = do
	[n] <- map read . words <$> getLine :: IO [Int]
	cs <- map read . words <$> getLine
	es <- map ((\[a, b] -> (a, b)) . map read . words) . lines <$> getContents

	let
		cs' = listArray (1, n) cs
		g = accumArray (flip (:)) [] (1, n) $ es -- ++ map swap es

		as = listArray (1, n) $ map search [1..n]

		search :: Int -> (IntMap Int, (Int, Int))
		search u = -- trace ("u = " ++ show u ++ " r = " ++ show r ++ " z = " ++ show zero) $
				r
			where
				r = foldl merge zero $ g ! u

				zero = (IntMap.singleton c 1, (c, 1)) -- (colors sum, max count)
					where c = cs' ! u

				-- m - counts
				merge state@(m, best) v = foldl merge' zero $ IntMap.assocs m2
					where
						state'@(m', best') = as ! v

						(zero, m2) =
							if IntMap.size m > IntMap.size m' then (state, m') else (state', m)

						merge' (m, best@(colorsSum, maxCount)) (color, count) = -- trace ("n = " ++ show (color, count) ++ " best' = " ++ show best') $
								(m', best')
							where
								count' = (IntMap.findWithDefault 0 color m) + count
								m' = IntMap.insert color count' m

								best' = case compare count' maxCount of
									GT -> (color, count')
									EQ -> (colorsSum + color, maxCount)
									LT -> best

	putStrLn . unwords . map show . map (fst . snd) $ elems as


You've been in love with Coronavirus-chan for a long time, but you didn't know where she lived until now. And just now you found out that she lives in a faraway place called Naha. You immediately decided to take a vacation and visit Coronavirus-chan. Your vacation lasts exactly $$$x$$$ days and that's the exact number of days you will spend visiting your friend. You will spend exactly $$$x$$$ consecutive (successive) days visiting Coronavirus-chan.They use a very unusual calendar in Naha: there are $$$n$$$ months in a year, $$$i$$$-th month lasts exactly $$$d_i$$$ days. Days in the $$$i$$$-th month are numbered from $$$1$$$ to $$$d_i$$$. There are no leap years in Naha.The mood of Coronavirus-chan (and, accordingly, her desire to hug you) depends on the number of the day in a month. In particular, you get $$$j$$$ hugs if you visit Coronavirus-chan on the $$$j$$$-th day of the month.You know about this feature of your friend and want to plan your trip to get as many hugs as possible (and then maybe you can win the heart of Coronavirus-chan). Please note that your trip should not necessarily begin and end in the same year.

The first line of input contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of months in the year and the number of days you can spend with your friend. The second line contains $$$n$$$ integers $$$d_1, d_2, \ldots, d_n$$$, $$$d_i$$$ is the number of days in the $$$i$$$-th month ($$$1 \le d_i \le 10^6$$$). It is guaranteed that $$$1 \le x \le d_1 + d_2 + \ldots + d_n$$$.

Print one integer — the maximum number of hugs that you can get from Coronavirus-chan during the best vacation in your life.

NoteIn the first test case, the numbers of the days in a year are (indices of days in a corresponding month) $$$\{1,1,2,3,1\}$$$. Coronavirus-chan will hug you the most if you come on the third day of the year: $$$2+3=5$$$ hugs.In the second test case, the numbers of the days are $$$\{1,2,3,1,2,3,1,2,3\}$$$. You will get the most hugs if you arrive on the third day of the year: $$$3+1+2+3+1+2=12$$$ hugs.In the third test case, the numbers of the days are $$$\{1,2,3,4,1,2, 1,2,3, 1, 1,2,3\}$$$. You will get the most hugs if you come on the twelfth day of the year: your friend will hug you $$$2+3+1+2+3+4=15$$$ times.

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

main = do
    (n:x:_) <- map read . words <$> getLine
    ds <- cycle . reverse . map read . words <$> getLine
    let (total, extra, endds) = initial x ds
    print $ maximum $ take (2 * fromInteger n) $ hugs extra total ds endds

initial x (d:ds)
    | x < d = (triangle d - triangle (d - x), d - x, ds)
    | otherwise = (\(a, b, c) -> (a + triangle (min d x), b, c)) $ initial (x - d) ds

hugs extra total (d:ds) endds = total : hugs extra' total' ds endds'
  where
    dv = triangle d
    (total', extra', endds')
        | d <= extra = (total - dv + triangle extra - triangle (extra - d), extra - d, endds)
        | otherwise =
            let (a, b, c) = initial (d - extra) endds
             in (total - dv + triangle extra + a, b, c)

triangle x = (x * (x + 1)) `div` 2

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

data State =
  State {
    stateLsum :: Integer,
    stateLs :: [Integer],
    stateRsum :: Integer,
    stateRs :: [Integer]
  }

numHugs n = n*(n+1) `div` 2

_solve x acc curr (State lsum ls rsum rs)
  | (rsum - lsum >= x)  =
      let lval:ltail = ls
          excess  = rsum - lsum - x
          actual  = curr - numHugs excess
          ncurr   = curr - numHugs lval
      in _solve x (max actual acc) ncurr $ State (lsum + lval) ltail rsum rs
  | otherwise   =
      case rs of
        []          -> acc
        rval:rtail  -> _solve x acc (curr + numHugs rval) $ State lsum ls (rsum + rval) rtail

solve x days =
  let days2 = (\x -> x ++ x) $ reverse days
  in _solve x 0 0 $ State 0 days2 0 days2

main = do
  input <- getContents
  let (_:xStr:tokens) = split input
      x = read xStr :: Integer
      days = read <$> tokens :: [Integer]
      res = solve x days
  putStrLn $ show res

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

main = do
    (n:x:_) <- map read . words <$> getLine
    ds <- map read . words <$> getLine
    let y = (`mod` sum ds) $ subtract x $ snd $ maximum $ zip ds $ scanl1 (+) ds
    print $ hugs (y + x) (cycle ds) - hugs y (cycle ds)

hugs x (d:ds)
    | x <= 0 = 0
    | otherwise = triangle (min x d) + hugs (x - d) ds

triangle x = (x * (x + 1)) `div` 2

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

main = do
    (n:x:_) <- map read . words <$> getLine
    ds <- cycle . reverse . map read . words <$> getLine
    let (total, extra, endds) = initial x ds
    print $ maximum $ take (2 * n) $ hugs 0 x extra total ds endds

initial x (d:ds)
    | x < d = (triangle d - triangle (d - x), d - x, ds)
    | otherwise = (\(a, b, c) -> (a + triangle (min d x), b, c)) $ initial (x - d) ds

hugs start end extra total (d:ds) endds = total : hugs start' end' extra' total' ds endds'
  where
    start' = start + d
    end' = end + d
    dv = triangle d
    (total', extra', endds')
        | dv <= extra = (total - dv + triangle extra - triangle (extra - d), extra - d, endds)
        | otherwise =
            let (a, b, c) = initial (d - extra) endds
             in (total - dv + triangle extra + a, b, c)

triangle x = (x * (x + 1)) `div` 2

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

main = do
    (n:x:_) <- map read . words <$> getLine
    ds <- cycle . reverse . map read . words <$> getLine
    let (total, extra, endds) = initial x ds
    print $ maximum $ take (2 * fromInteger n) $ hugs 0 x extra total ds endds

initial x (d:ds)
    | x < d = (triangle d - triangle (d - x), d - x, ds)
    | otherwise = (\(a, b, c) -> (a + triangle (min d x), b, c)) $ initial (x - d) ds

hugs start end extra total (d:ds) endds = total : hugs start' end' extra' total' ds endds'
  where
    start' = start + d
    end' = end + d
    dv = triangle d
    (total', extra', endds')
        | dv <= extra = (total - dv + triangle extra - triangle (extra - d), extra - d, endds)
        | otherwise =
            let (a, b, c) = initial (d - extra) endds
             in (total - dv + triangle extra + a, b, c)

triangle x = (x * (x + 1)) `div` 2

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

data State =
  State {
    stateLsum :: Int,
    stateLs :: [Int],
    stateRsum :: Int,
    stateRs :: [Int]
  }

numHugs n = n*(n+1) `div` 2

_solve x acc curr (State lsum ls rsum rs)
  | (rsum - lsum >= x)  =
      let lval:ltail = ls
          excess  = rsum - lsum - x
          actual  = curr - numHugs excess
          ncurr   = curr - numHugs lval
      in _solve x (max actual acc) ncurr $ State (lsum + lval) ltail rsum rs
  | otherwise   =
      case rs of
        []          -> acc
        rval:rtail  -> _solve x acc (curr + numHugs rval) $ State lsum ls (rsum + rval) rtail

solve x days =
  let days2 = (\x -> x ++ x) $ reverse days
  in _solve x 0 0 $ State 0 days2 0 days2

main = do
  input <- getContents
  let (_:xStr:tokens) = split input
      x = read xStr :: Int
      days = read <$> tokens :: [Int]
      res = solve x days
  putStrLn $ show res


For an array $$$a$$$ of integers let's denote its maximal element as $$$\max(a)$$$, and minimal as $$$\min(a)$$$. We will call an array $$$a$$$ of $$$k$$$ integers interesting if $$$\max(a) - \min(a) \ge k$$$. For example, array $$$[1, 3, 4, 3]$$$ isn't interesting as $$$\max(a) - \min(a) = 4 - 1 = 3 < 4$$$ while array $$$[7, 3, 0, 4, 3]$$$ is as $$$\max(a) - \min(a) = 7 - 0 = 7 \ge 5$$$.You are given an array $$$a$$$ of $$$n$$$ integers. Find some interesting nonempty subarray of $$$a$$$, or tell that it doesn't exist.An array $$$b$$$ is a subarray of an array $$$a$$$ if $$$b$$$ can be obtained from $$$a$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end. In particular, an array is a subarray of itself.

The first line contains integer number $$$t$$$ ($$$1 \le t \le 10\,000$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$2\le n \le 2\cdot 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0\le a_i \le 10^9$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output "NO" in a separate line if there is no interesting nonempty subarray in $$$a$$$.  Otherwise, output "YES" in a separate line. In the next line, output two integers $$$l$$$ and $$$r$$$ ($$$1\le l \le r \le n$$$) — bounds of the chosen subarray. If there are multiple answers, print any. You can print each letter in any case (upper or lower).

NoteIn the second test case of the example, one of the interesting subarrays is $$$a = [2, 0, 1, 9]$$$: $$$\max(a) - \min(a) = 9 - 0 = 9 \ge 4$$$.

import Control.Monad
import Data.Maybe

main = getLine >>= flip replicateM_ test . read

test = do
    getLine
    as <- zip [1 ..] . map read . words <$> getLine
    putStrLn $ maybe "NO" (("YES\n" ++) . unwords . map show) $ solve as

solve (a1:a2:as)
    | abs (snd a1 - snd a2) > 1 = Just $ fst <$> [a1, a2]
    | otherwise = solve (a2 : as)
solve _ = Nothing


Pasha loves his phone and also putting his hair up... But the hair is now irrelevant.Pasha has installed a new game to his phone. The goal of the game is following. There is a rectangular field consisting of n row with m pixels in each row. Initially, all the pixels are colored white. In one move, Pasha can choose any pixel and color it black. In particular, he can choose the pixel that is already black, then after the boy's move the pixel does not change, that is, it remains black. Pasha loses the game when a 2 × 2 square consisting of black pixels is formed. Pasha has made a plan of k moves, according to which he will paint pixels. Each turn in his plan is represented as a pair of numbers i and j, denoting respectively the row and the column of the pixel to be colored on the current move.Determine whether Pasha loses if he acts in accordance with his plan, and if he does, on what move the 2 × 2 square consisting of black pixels is formed.

The first line of the input contains three integers n, m, k (1 ≤ n, m ≤ 1000, 1 ≤ k ≤ 105) — the number of rows, the number of columns and the number of moves that Pasha is going to perform.  The next k lines contain Pasha's moves in the order he makes them. Each line contains two integers i and j (1 ≤ i ≤ n, 1 ≤ j ≤ m), representing the row number and column number of the pixel that was painted during a move.

If Pasha loses, print the number of the move when the 2 × 2 square consisting of black pixels is formed. If Pasha doesn't lose, that is, no 2 × 2 square consisting of black pixels is formed during the given k moves, print 0.

import qualified Data.Map as M
import Data.Maybe
import qualified Data.ByteString.Char8 as B
showBI = B.pack . show
readBI = fst . fromJust . B.readInt
main = B.interact $ showBI . f . map (map readBI . B.words) . B.lines
--main = interact $ show . f . map (map read . words) . lines
f (([n,m,k]):q) = ((1+) . length . takeWhile (==False) . reverse . fst $ foldl h ([],M.empty) q)`mod`(k+1)
h (l,m) [i,j] = ((or . map (\l' -> and . map (flip M.member m) $ l') $ cl):l,M.insert (i,j) 1 m)
  where cl = [l1,l2,l3,l4]
        l1 = [(i,j-1),(i-1,j-1),(i-1,j)]
        l2 = [(i-1,j),(i-1,j+1),(i,j+1)]
        l3 = [(i,j+1),(i+1,j+1),(i+1,j)]
        l4 = [(i+1,j),(i+1,j-1),(i,j-1)]

import qualified Data.Map as M
main = interact $ show . f . map (map read . words) . lines
f (([n,m,k]):q) = ((1+) . length . takeWhile (==False) . reverse . fst $ foldl h ([],M.empty) q)`mod`(k+1)
h (l,m) [i,j] = ((or . map (\l' -> and . map (flip M.member m) $ l') $ cl):l,M.insert (i,j) 1 m)
  where cl = [l1,l2,l3,l4]
        l1 = [(i,j-1),(i-1,j-1),(i-1,j)]
        l2 = [(i-1,j),(i-1,j+1),(i,j+1)]
        l3 = [(i,j+1),(i+1,j+1),(i+1,j)]
        l4 = [(i+1,j),(i+1,j-1),(i,j-1)]

import Data.List
import qualified Data.Map as M
main = interact $ show . f . map (map read . words) . lines
f (([n,m,k]):q) = ((1+) . length . takeWhile (==False) . reverse . fst $ foldl' h ([],M.empty) q)`mod`(k+1)
h (l,m) [i,j] = ((or . map (\l' -> and . map (flip M.member m) $ l') $ cl):l,M.insert (i,j) 1 m)
  where cl = [l1,l2,l3,l4]
        l1 = [(i,j-1),(i-1,j-1),(i-1,j)]
        l2 = [(i-1,j),(i-1,j+1),(i,j+1)]
        l3 = [(i,j+1),(i+1,j+1),(i+1,j)]
        l4 = [(i+1,j),(i+1,j-1),(i,j-1)]

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

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

main :: IO ()
main = do
  [n, m, k] <- getIntList
  ps <- replicateM k getIntList
  print $ sol n m k ps

sol :: (Ix a, Ord a, Num a, Enum a) => a -> a -> a -> [[a]] -> a
sol n m k ps = if null rs then 0 else minimum rs
  where
  ts = map (\[p,q] -> (p,q)) ps
  ar = accumArray ac 0 ((1,1),(n,m)) $ zipWith (,) ts [1..k]
  ac e a = if e==0 then a else min e a
  es = [ev ar (p,q) | (p,q)<-ts, p<n, q<m, ar!(p,q)>0]
  rs = map snd $ filter ((0<) . fst) es

ev :: (Ix t, Ord t, Num t) => Array (t, t) t -> (t, t) -> (t, t)
ev ar (p,q) = (minimum a4, maximum a4)
  where a4 = [ar!(p,q), ar!(p+1,q), ar!(p,q+1), ar!(p+1,q+1)]

{-
let ps = [[1,1], [1,2], [2,1], [2,2]]
sol 2 2 4 ps  ==> 4

let ps = [[2,3], [2,2], [1,3], [2,2], [1,2], [1,1]]
sol 2 3 6 ps  ==> 6

let ps = [[2,3], [1,2], [1,1], [4,1], [3,1], [5,3], [3,2]]
sol 5 3 7 ps  ==> 0
-}

import qualified Data.Set as S

main :: IO ()
main = getContents >>= print . solve . map (map read . words) . lines

solve :: [[Int]] -> Int
solve ([_, _, _] : ijs) = go 1 S.empty ijs
  where go t s ([i, j] : ij) | any (all (`S.member`s)) ij' = t
                             | otherwise = go (t + 1) (S.insert (i, j) s) ij
           where ij' = [ [ (i - 1, j), (i - 1, j - 1), (i, j - 1) ] ,
                         [ (i - 1, j), (i - 1, j + 1), (i, j + 1) ] ,
                         [ (i + 1, j), (i + 1, j - 1), (i, j - 1) ] ,
                         [ (i + 1, j), (i + 1, j + 1), (i, j + 1) ] ]
        go _ _ _ = 0
solve _ = undefined

import qualified Data.Set as S

main :: IO ()
main = getContents >>= print . solve . map (map read . words) . lines

solve :: [[Int]] -> Int
solve ([_, _, _] : ijs) = go 1 S.empty ijs
  where go t s ([i, j] : ij) | any (all (`S.member`s))
                                 [ [ (i - 1, j), (i - 1, j - 1), (i, j - 1) ] ,
                                   [ (i - 1, j), (i - 1, j + 1), (i, j + 1) ] ,
                                   [ (i + 1, j), (i + 1, j - 1), (i, j - 1) ] ,
                                   [ (i + 1, j), (i + 1, j + 1), (i, j + 1) ] ]
                                     = t
                             | otherwise = go (t + 1) (S.insert (i, j) s) ij
        go _ _ _ = 0
solve _ = undefined

import qualified Data.Set as S

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

solve :: [[Int]] -> Int
solve = go 1 S.empty
  where go t s ([i, j] : ij) | any (all (`S.member`s)) ij' = t
                             | otherwise = go (t + 1) (S.insert (i, j) s) ij
           where ij' = [ [ (i - 1, j), (i - 1, j - 1), (i, j - 1) ] ,
                         [ (i - 1, j), (i - 1, j + 1), (i, j + 1) ] ,
                         [ (i + 1, j), (i + 1, j - 1), (i, j - 1) ] ,
                         [ (i + 1, j), (i + 1, j + 1), (i, j + 1) ] ]
        go _ _ _ = 0

import Control.Applicative
import qualified Data.IntMap as I

check rr cc r1 c1 a = any (==1) $ [product (map (\z->I.findWithDefault 0 z a) [ r*1000+c, (r+1)*1000+c, r*1000+c+1, (r+1)*1000+c+1])|r<-[max 1 (r1-1).. min rr (r1+1)],c<-[max 1 (c1-1)..min cc (c1+1)]]

process r c [] a co = 0
process r c ([r1,c1]:ss) a co | check r c r1 c1 a1 =  co
                              | otherwise = process r c ss a1 (co+1)
	where a1 = I.insert (r1*1000+c1) (1::Int) a

main= do
	[r,c,n]<-map read. words <$> getLine ::IO [Int]
	s<- map (map read). map words . lines <$> getContents::IO [[Int]]
	let a= I.empty
	print $ process r c s a 1

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

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

main :: IO ()
main = do
  [n, m, k] <- getIntList
  ps <- replicateM n getIntList
  print $ sol n m k ps

sol :: (Ix a, Ord a, Num a, Enum a) => a -> a -> a -> [[a]] -> a
sol n m k ps = if null rs then 0 else minimum rs
  where
  ts = map (\[p,q] -> (p,q)) ps
  ar = accumArray ac 0 ((1,1),(n,m)) $ zipWith (,) ts [1..k]
  ac e a = if e==0 then a else min e a
  es = [ev ar (p,q) | (p,q)<-ts, p<n, q<m, ar!(p,q)>0]
  rs = map snd $ filter ((0<) . fst) es

ev :: (Ix t, Ord t, Num t) => Array (t, t) t -> (t, t) -> (t, t)
ev ar (p,q) = (minimum a4, maximum a4)
  where a4 = [ar!(p,q), ar!(p+1,q), ar!(p,q+1), ar!(p+1,q+1)]

{-
let ps = [[1,1], [1,2], [2,1], [2,2]]
sol 2 2 4 ps  ==> 4

let ps = [[2,3], [2,2], [1,3], [2,2], [1,2], [1,1]]
sol 2 3 6 ps  ==> 6

let ps = [[2,3], [1,2], [1,1], [4,1], [3,1], [5,3], [3,2]]
sol 5 3 7 ps  ==> 0
-}


Today the kindergarten has a new group of $$$n$$$ kids who need to be seated at the dinner table. The chairs at the table are numbered from $$$1$$$ to $$$4n$$$. Two kids can't sit on the same chair. It is known that two kids who sit on chairs with numbers $$$a$$$ and $$$b$$$ ($$$a \neq b$$$) will indulge if:   $$$gcd(a, b) = 1$$$ or,  $$$a$$$ divides $$$b$$$ or $$$b$$$ divides $$$a$$$. $$$gcd(a, b)$$$ — the maximum number $$$x$$$ such that $$$a$$$ is divisible by $$$x$$$ and $$$b$$$ is divisible by $$$x$$$.For example, if $$$n=3$$$ and the kids sit on chairs with numbers $$$2$$$, $$$3$$$, $$$4$$$, then they will indulge since $$$4$$$ is divided by $$$2$$$ and $$$gcd(2, 3) = 1$$$. If kids sit on chairs with numbers $$$4$$$, $$$6$$$, $$$10$$$, then they will not indulge.The teacher really doesn't want the mess at the table, so she wants to seat the kids so there are no $$$2$$$ of the kid that can indulge. More formally, she wants no pair of chairs $$$a$$$ and $$$b$$$ that the kids occupy to fulfill the condition above.Since the teacher is very busy with the entertainment of the kids, she asked you to solve this problem.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case consists of one line containing an integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the number of kids.

Output $$$t$$$ lines, which contain $$$n$$$ distinct integers from $$$1$$$ to $$$4n$$$ — the numbers of chairs that the kids should occupy in the corresponding test case. If there are multiple answers, print any of them. You can print $$$n$$$ numbers in any order.

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
  words >>> drop 1 >>> map (read >>> solve >>> map show >>> unwords) >>> unlines

solve :: Int -> [Int]
solve n = [2 * (i + n) | i <- [1 .. n]]

import Prelude
import Data.List
import Data.Foldable
import Control.Monad (replicateM)

numbers :: [String] -> [Int]
numbers array = (map read array :: [Int])

answers n = [ i | i <- [4*n,4*n-2..2*n+2] ]

convert :: [Int] -> String
convert array = id $ intercalate " " [ id show n | n<-array]

main = do
    n <- getLine
    array <- replicateM (read n) getLine
    mapM_ putStrLn $ map convert (map answers $ numbers array)
    putStrLn $ id ""

main =
    interact $
    unlines . map (unwords . map show . (\n -> [2*(i+n) | i <- [1..n]]) . read) . drop 1 . words


You are given a string $$$s$$$ of length $$$n$$$. Each character is either one of the first $$$k$$$ lowercase Latin letters or a question mark.You are asked to replace every question mark with one of the first $$$k$$$ lowercase Latin letters in such a way that the following value is maximized.Let $$$f_i$$$ be the maximum length substring of string $$$s$$$, which consists entirely of the $$$i$$$-th Latin letter. A substring of a string is a contiguous subsequence of that string. If the $$$i$$$-th letter doesn't appear in a string, then $$$f_i$$$ is equal to $$$0$$$.The value of a string $$$s$$$ is the minimum value among $$$f_i$$$ for all $$$i$$$ from $$$1$$$ to $$$k$$$.What is the maximum value the string can have?

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$; $$$1 \le k \le 17$$$) — the length of the string and the number of first Latin letters used. The second line contains a string $$$s$$$, consisting of $$$n$$$ characters. Each character is either one of the first $$$k$$$ lowercase Latin letters or a question mark.

Print a single integer — the maximum value of the string after every question mark is replaced with one of the first $$$k$$$ lowercase Latin letters.

NoteIn the first example the question marks can be replaced in the following way: "aaaababbbb". $$$f_1 = 4$$$, $$$f_2 = 4$$$, thus the answer is $$$4$$$. Replacing it like this is also possible: "aaaabbbbbb". That way $$$f_1 = 4$$$, $$$f_2 = 6$$$, however, the minimum of them is still $$$4$$$.In the second example one of the possible strings is "aabbccdda".In the third example at least one letter won't appear in the string, thus, the minimum of values $$$f_i$$$ is always $$$0$$$.

{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE NumericUnderscores  #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

import           Control.Arrow              ((>>>))
import           Control.Monad              (MonadPlus (mplus), foldM_, forM_,
                                             guard, join, replicateM, when,
                                             replicateM_)
import qualified Control.Monad.ST.Strict    as ST
import qualified Control.Monad.State.Strict as S
import qualified Data.Array                 as A
import qualified Data.Array.IO.Safe         as IOA
import qualified Data.Array.MArray.Safe     as MA
import qualified Data.Array.ST.Safe         as STA
import qualified Data.Array.Unboxed         as UA
import           Data.Bits
import           Data.Word
import qualified Data.ByteString.Char8      as B8
import           Data.Char
import           Data.Function              (on)
import           Data.Functor               ((<&>))
import           Data.IORef                 (modifyIORef, newIORef, readIORef)
import           Data.Int
import qualified Data.IntMap                as IM
import           Data.List                  (elemIndices, find, findIndices,
                                             foldl', intersect, isPrefixOf, nub,
                                             sort, sortOn)
import qualified Data.Map                   as M
import           Data.Maybe                 (fromJust, fromMaybe, isJust)
import qualified Data.Set                   as S
import           Data.Traversable           (for, forM)
import           System.IO                  (IOMode (ReadMode, WriteMode),
                                             hFlush, openFile, stdin, stdout)
import           Text.Printf                (printf)

import           Debug.Trace                (trace, traceM, traceShowM)
import           GHC.IO.Handle              (hDuplicateTo)

debug :: c -> String -> c
debug = flip trace
traced x = trace (show x) x
withTrace s x = trace (s ++ " -> " ++ show x) x

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

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

readIntegralB8 :: (Integral a) => B8.ByteString -> a
readIntegralB8 = B8.readInteger >>> fst . fromJust >>> fromInteger

solve :: Int -> Int -> B8.ByteString -> Int
solve n k bs = ST.runST $ subSolve 0 n
    where
        cntA :: UA.UArray (Int, Int) Int
        cntA = STA.runSTUArray $ do
            cntM <- MA.newArray ((0, 0), (k - 1, n)) 0 :: ST.ST s (STA.STUArray s (Int, Int) Int )
            forM_ [0 .. k - 1] $ \ci -> do
                forM_ (reverse [0 .. n - 1]) $ \i -> do
                    let currentC = bs `B8.index` i
                    when ((currentC == '?') || (currentC == chr (ci + ord 'a'))) $ do
                        MA.readArray cntM (ci, i + 1) >>= (MA.writeArray cntM (ci, i) . (+1))
            return cntM

        toK :: Int
        toK = 1 `shiftL` k

        subSolve :: Int -> Int -> ST.ST s Int
        subSolve l r | l < r = do
            let c = (l + r + 1) `div` 2
            isSolvable <- canSolve c
            if isSolvable
                then subSolve c r
                else subSolve l (c - 1)
        subSolve l r | l <= r = return l

        canSolve :: Int -> ST.ST s Bool
        canSolve len = do
                dpM <- dpA
                index <- MA.readArray dpM (toK - 1)
                return $ index < n + 1
            where
                nextCntA :: ST.ST s (STA.STUArray s (Int, Int) Int)
                nextCntA = do
                    nextCntM <- MA.newArray ((0, 0), (k - 1, n + 1)) (n + 1) :: ST.ST s (STA.STUArray s (Int, Int) Int)
                    forM_ [0 .. k - 1] $ \ci -> do
                        forM_ (reverse [0 .. n - 1]) $ \i -> do
                            let curLen = cntA UA.! (ci, i)
                            nextValue <- if curLen < len
                                then MA.readArray nextCntM (ci, i + 1)
                                else return $ i + len
                            MA.writeArray nextCntM (ci, i) nextValue
                    return nextCntM

                dpA :: ST.ST s (STA.STUArray s Int Int)
                dpA = do
                    dpM <- MA.newArray (0, toK - 1) 0 :: ST.ST s (STA.STUArray s Int Int)
                    nextCntM <- nextCntA
                    forM_ [1 .. toK - 1] $ \mask -> do
                        connections <- forM [0 .. k - 1] $ \bIndex -> do
                            let bValue = (toK - 1) .&. (1 `shiftL` bIndex)
                            let prevMask = mask `xor` bValue
                            prevValue <- MA.readArray dpM prevMask
                            nextIndex <- MA.readArray nextCntM (bIndex, prevValue)

                            return $ if (mask .&. bValue) /= 0
                                then nextIndex
                                else n + 1

                        MA.writeArray dpM mask $ minimum connections
                    return dpM

main :: IO ()
main = do
    [n, k] <- B8.getLine <&> map readIntB8 . B8.words
    s <- B8.getLine <&> B8.pack . filter (\c -> 'a' <= c && c <= 'z' || c == '?') . B8.unpack

    let answer = solve n k s

    printf "%d\n" answer

{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Bits
import Data.Char

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    s <- getLine
    let full = (1 `shiftL` k) - 1
        sa = listArray (1, n) $ map (subtract 97 . ord) s :: UArray Int Int
        wild = ord '?' - 97
        ans = do
            nxt :: STUArray s (Int, Int) Int <- newArray ((0, 1), (k - 1, n)) 0
            cntLast :: STUArray s Int Int <- newArray (0, 1) 0
            let ok :: Int -> ST s Bool
                ok x = do
                    forM_ [0.. k - 1] $ \j -> do
                        wrA cntLast 0 0
                        wrA cntLast 1 (n + 1)
                        forM_ [n, n - 1 .. 1] $ \i -> do
                            if sa!i == j || sa!i == wild
                                then rdA cntLast 0 >>= (wrA cntLast 0 . (+1))
                                else wrA cntLast 0 0
                            last <- rdA cntLast 0
                            when (last >= x) $ wrA cntLast 1 (i + x - 1)
                            rdA cntLast 1 >>= wrA nxt (j, i)
                    nxtf :: UArray (Int, Int) Int <- unsafeFreeze nxt
                    dp :: STUArray s Int Int <- newArray (0, full) 0
                    forM_ [1..full] $ \i -> do
                        let js = filter (testBit i) [0 .. k - 1]
                        vs <- mapM (rdA dp . clearBit i) js
                        let get j v | v + 1 > n = n + 1
                                    | otherwise = nxtf!(j, v + 1)
                        wrA dp i $ minimum $ zipWith get js vs
                    (<= n) <$> rdA dp full
            subtract 1 <$> lowerBoundM (fmap not . ok) 1 (n + 1)
    print $ runST ans

rdA a = readArray a
wrA a = writeArray a

lowerBoundM :: (Monad m, Integral t) => (t -> m Bool) -> t -> t -> m t
lowerBoundM f l h
    | l >= h    = return l
    | otherwise = do
        v <- f m
        if v then lowerBoundM f l m else lowerBoundM f (m + 1) h
    where m = (l + h) `div` 2

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = solve


Let us define a magic grid to be a square matrix of integers of size $$$n \times n$$$, satisfying the following conditions.   All integers from $$$0$$$ to $$$(n^2 - 1)$$$ inclusive appear in the matrix exactly once.  Bitwise XOR of all elements in a row or a column must be the same for each row and column. You are given an integer $$$n$$$ which is a multiple of $$$4$$$. Construct a magic grid of size $$$n \times n$$$.

The only line of input contains an integer $$$n$$$ ($$$4 \leq n \leq 1000$$$). It is guaranteed that $$$n$$$ is a multiple of $$$4$$$.

Print a magic grid, i.e. $$$n$$$ lines, the $$$i$$$-th of which contains $$$n$$$ space-separated integers, representing the $$$i$$$-th row of the grid. If there are multiple answers, print any. We can show that an answer always exists.

NoteIn the first example, XOR of each row and each column is $$$13$$$.In the second example, XOR of each row and each column is $$$60$$$.

main = interact $ unlines . map unwords . map (map show) . process . read . head . words

process :: Int -> [[Int]]
process n = reshape n $ map (mix n) [0..n^2-1]

reshape _ [] = []
reshape n x = take n x : reshape n (drop n x)

mix n m = i_inner * 4 + k_inner + (i_outer * (div n 4) + k_outer) * 16
  where
    i = div m n
    k = mod m n
    i_inner = mod i 4
    i_outer = div i 4
    k_inner = mod k 4
    k_outer = div k 4

main = interact $ unlines . map unwords . map (map show) . process . read . head . words
process :: Int -> [[Int]]
process n = reshape n [0..n^2-1]
reshape _ [] = []
reshape n x = take n x : reshape n (drop n x)


You wrote down all integers from $$$0$$$ to $$$10^n - 1$$$, padding them with leading zeroes so their lengths are exactly $$$n$$$. For example, if $$$n = 3$$$ then you wrote out 000, 001, ..., 998, 999.A block in an integer $$$x$$$ is a consecutive segment of equal digits that cannot be extended to the left or to the right.For example, in the integer $$$00027734000$$$ there are three blocks of length $$$1$$$, one block of length $$$2$$$ and two blocks of length $$$3$$$.For all integers $$$i$$$ from $$$1$$$ to $$$n$$$ count the number of blocks of length $$$i$$$ among the written down integers.Since these integers may be too large, print them modulo $$$998244353$$$.

The only line contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$).

In the only line print $$$n$$$ integers. The $$$i$$$-th integer is equal to the number of blocks of length $$$i$$$. Since these integers may be too large, print them modulo $$$998244353$$$.

import Control.Arrow ((>>>))

main :: IO ()
main = interact $ read >>> solve >>> map show >>> unwords

solve :: Integer -> [Integer]
solve n = map (solveEach n) [1 .. n]

solveEach :: Integer -> Integer -> Integer
solveEach n i
  | i == n = 10
  | otherwise = 9 *% 10 ^% (n - 1 - i) *% (20 +% 9 *% (n - 1 - i))

modV :: Integer
modV = 998244353

(+%) :: Integer -> Integer -> Integer
a +% b = (a + b) `mod` modV

infixl 6 +%

(*%) :: Integer -> Integer -> Integer
a *% b = (a * b) `mod` modV

infixl 7 *%

(^%) :: Integer -> Integer -> Integer
a ^% n
  | n == 0 = 1
  | odd n = a *% a ^% (n - 1)
  | even n = let u = a ^% (n `div` 2) in u *% u

infixl 8 ^%

import Control.Arrow

main = interact $ read >>> solve >>> map show >>> unwords

solve :: Integer -> [Integer]
solve n = map solveEach $ zip [1..n] $ repeat n

solveEach :: (Integer, Integer) -> Integer
solveEach (i, n)
  | i == n = 10
  | otherwise =
    foldl mulv 1
      [9, pwr 10 (n - 1 - i),
        addv 20 $ mulv 9 (n - 1 - i)]
  where
    modv = 998244353
    addv a b = mod (a + b) modv
    mulv a b = mod (a * b) modv
    pwr :: Integer -> Integer -> Integer
    pwr a 0 = 1
    pwr a n
      | odd n = mulv a $ pwr a (n - 1)
      | even n = let u = pwr a (div n 2) in u * u

f :: Integer -> Integer
f n = n `mod` 998244353

l :: [Integer]
l = 1 : map (f.(*10)) l

l2 :: [Integer]
l2 = zipWith (\x y -> f (x*y)) [0..] l

l3 :: [Integer]
l3 = 0 : zipWith (\x y -> f (x+y)) l3 l4

l4 :: [Integer]
l4 = 10 : tail (zipWith (\x y -> f (x-y)) (tail l2) l5)

l5 :: [Integer]
l5 = 0 :zipWith3 (\a b c -> f(a+b+c)) l4 (tail l3) l5

solve :: Int -> [Integer]
solve n = reverse $ take n l4

main :: IO ()
main = interact (unwords.map show.solve.read)

import Control.Arrow

main = interact $ read >>> solve >>> map show >>> unwords

solve :: Int -> [Int]
solve n = map solveEach $ zip [1..n] $ repeat n

solveEach :: (Int, Int) -> Int
solveEach (i, n)
  | i == n = 10
  | otherwise =
    foldl mulv 1
      [9, pwr 10 (n - 1 - i),
        addv 20 $ mulv 9 (n - 1 - i)]
  where
    modv = 998244353
    addv a b = mod (a + b) modv
    mulv a b = mod (a * b) modv
    pwr :: Int -> Int -> Int
    pwr a 0 = 1
    pwr a n
      | odd n = mulv a $ pwr a (n - 1)
      | even n = let u = pwr a (div n 2) in u * u

f :: Int -> Int
f n = n `mod` 998244353

l :: [Int]
l = iterate (f.(*10)) 1800

l2 :: [Int]
l2 = iterate (f.(*10)) 810

l3 :: [Int]
l3 = zipWith3 (\x y z-> x+y*z) l l2 [1..]

l4 :: [Int]
l4 = 10:180:l3

solve :: Int -> [Int]
solve n = reverse $ take n l4

main :: IO ()
main = interact (unwords.map show.solve.read)

f :: Int -> Int
f n = n `mod` 998244353

l :: [Int]
l = 1 : map (f.(*10)) l

l2 :: [Int]
l2 = zipWith (\x y -> f (x*y)) [0..] l

l3 :: [Int]
l3 = 0 : zipWith (\x y -> f (x+y)) l3 l4

l4 :: [Int]
l4 = 10 : tail (zipWith (\x y -> f (x-y)) (tail l2) l5)

l5 :: [Int]
l5 = 0 :zipWith3 (\a b c -> f(a+b+c)) l4 (tail l3) l5

solve :: Int -> [Int]
solve n = reverse $ take n l4

main :: IO ()
main = interact (unwords.map show.solve.read)


You are given $$$n$$$ sticks with positive integral length $$$a_1, a_2, \ldots, a_n$$$.You can perform the following operation any number of times (possibly zero):   choose one stick, then either increase or decrease its length by $$$1$$$. After each operation, all sticks should have positive lengths. What is the minimum number of operations that you have to perform such that it is possible to select three of the $$$n$$$ sticks and use them without breaking to form an equilateral triangle?An equilateral triangle is a triangle where all of its three sides have the same length.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 300$$$) — the number of sticks. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the lengths of the sticks. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$300$$$.

For each test case, print one integer on a single line — the minimum number of operations to be made.

NoteIn the first test case, you can increase the length of the first stick by $$$1$$$, then decrease the length of the third stick by $$$1$$$. In total, you perform $$$2$$$ operations, such that the three sticks form an equilateral triangle of side length $$$2$$$.In the fourth test case, you can decrease the length of the seventh stick by $$$1$$$. An equilateral triangle of side length $$$1$$$ can be selected and formed by the second, fourth, and seventh sticks.

import Control.Monad(replicateM_)
import Data.List(sort)

selectThree :: [Int] -> Int
selectThree sticks = minimum $
                       zipWith (+) (
                         zipWith (-)
                           (drop 2 sorted) $
                           drop 1 sorted
                         ) $
                         zipWith (-)
                           (drop 1 sorted)
                           sorted
  where
    sorted = sort sticks

solveCase :: IO ()
solveCase = do
    _      <- readLn :: IO Int
    sticks <- fmap (map read . words) getLine :: IO [Int]
    print $ selectThree sticks

main :: IO ()
main = do
    test_case_num <- readLn :: IO Int
    replicateM_ test_case_num solveCase

import Data.List(sort)

selectThree :: [Int] -> Int
selectThree sticks = minimum $
                       zipWith (+) (
                         zipWith (-)
                           (drop 2 sorted) $
                           drop 1 sorted
                         ) $
                         zipWith (-)
                           (drop 1 sorted)
                           sorted
  where
    sorted = sort sticks

solveCase :: Int -> IO ()
solveCase test_case = do
    _      <- readLn :: IO Int
    sticks <- fmap (map read . words) getLine :: IO [Int]
    print $ selectThree sticks

main :: IO ()
main = do
    test_case_num <- readLn :: IO Int
    mapM_ solveCase [1 .. test_case_num]

import Data.List

readInt x = read x :: Int
readInteger x = read x :: Integer
readDouble x = read x :: Double

getTriplets res (x:y:z:lst) = getTriplets ((x,y,z):res) (y:z:lst)
getTriplets res (y:z:[])  = res

min' ((x,y,z):xs) = if a < b then a else b
    where
        a = z-y+y-x
        b = min' xs
min' [(x,y,z)] = z-y+y-x
min' [] = 1000000000

solve 0 = return ()
solve tc = do
    solve (tc-1)

    in_n <- getLine
    in_arr <- getLine

    let n = readInt in_n
    let arr = map readInt $ words in_arr
    let arr2 = sort arr
    let triplets = getTriplets [] arr2

    print(min' triplets)

main = do
    in1 <- getLine
    let tc = readInt in1
    solve tc

--
-- 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],xs] <- replicateM 2 ri
        return xs
    mapM_ (putStrLn.show.solve) tcs

solve xs = minimum $ uncurry (-) <$> zip (tail.tail$ys) ys
  where
    ys = L.sort xs

import Data.List (sort, minimumBy)
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>
        map read . words <$> getLine >>= print . minOps . sort

minOps :: [Int] -> Int
minOps (a1:a2:a3:as) = m (f a1 a2 a3) (a2:a3:as)
  where f a1 a2 a3 = let s = a1+a2+a3 in
          snd $ minimumBy (\x1 x2 -> compare (fst x1) (fst x2))
          (map (\x -> (abs(3*x-s), abs(x-a1)+abs(x-a2)+abs(x-a3))) [a1, a2, a3])
        m acc (a1:a2:a3:as) = if (f a1 a2 a3) < acc
                              then m (f a1 a2 a3) (a2:a3:as)
                              else m acc (a2:a3:as)
        m acc _ = acc