-- 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)

-- 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')

{-# 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

{-# 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)

-- 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)


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


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


{-# 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 #-}

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.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


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 <- 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

{- 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


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 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 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
-}


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

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 ""


{-# 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

{-# 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


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 :: 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

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 :: 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)


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

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 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