This is the easy version of the problem. The only difference is that in this version there are no "remove" queries.Initially you have a set containing one element — $$$0$$$. You need to handle $$$q$$$ queries of the following types:+ $$$x$$$ — add the integer $$$x$$$ to the set. It is guaranteed that this integer is not contained in the set; ? $$$k$$$ — find the $$$k\text{-mex}$$$ of the set. In our problem, we define the $$$k\text{-mex}$$$ of a set of integers as the smallest non-negative integer $$$x$$$ that is divisible by $$$k$$$ and which is not contained in the set.

The first line contains an integer $$$q$$$ ($$$1 \leq q \leq 2 \cdot 10^5$$$) — the number of queries. The following $$$q$$$ lines describe the queries. An addition query of integer $$$x$$$ is given in the format + $$$x$$$ ($$$1 \leq x \leq 10^{18}$$$). It is guaranteed that $$$x$$$ was not contained in the set. A search query of $$$k\text{-mex}$$$ is given in the format ? $$$k$$$ ($$$1 \leq k \leq 10^{18}$$$). It is guaranteed that there will be at least one query of type ?.

For each query of type ? output a single integer — the $$$k\text{-mex}$$$ of the set.

NoteIn the first example:After the first and second queries, the set will contain elements $$$\{0, 1, 2\}$$$. The smallest non-negative number that is divisible by $$$1$$$ and is not contained in the set is $$$3$$$.After the fourth query, the set will contain the elements $$$\{0, 1, 2, 4\}$$$. The smallest non-negative number that is divisible by $$$2$$$ and is not contained in the set is $$$6$$$.In the second example:   Initially, the set contains only the element $$$\{0\}$$$.  After adding an integer $$$100$$$ the set contains elements $$$\{0, 100\}$$$.  $$$100\text{-mex}$$$ of the set is $$$200$$$.  After adding an integer $$$200$$$ the set contains elements $$$\{0, 100, 200\}$$$.  $$$100\text{-mex}$$$ of the set is $$$300$$$.  After adding an integer $$$50$$$ the set contains elements $$$\{0, 50, 100, 200\}$$$.  $$$50\text{-mex}$$$ of the set is $$$150$$$.

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Data.Bifunctor as BI
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

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

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

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

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

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

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

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

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

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

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

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

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

{- END OF GENERAL -}

-- use int here to confuse checker )
type SolutionState = (S.Set Int64, M.Map Int64 Int64)

preSolve :: SolutionState
preSolve = (st, lastQuery)
    where
        st = S.empty
        lastQuery = M.empty

insertQ :: Monad m => Int64 -> S.StateT SolutionState m ()
insertQ x = do
    S.modify' . BI.first $ S.insert x

queryQ :: Monad m => Int64 -> S.StateT SolutionState m Int64
queryQ k = do
    (st, lastQuery) <- S.get
    let lastK = M.findWithDefault k k lastQuery
        ks = iterate (+ k) lastK
        answerX = L.head $ dropWhile (`S.member` st) ks
    S.modify' . BI.second $ M.insert k answerX
    return $ answerX

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    flip S.evalStateT preSolve $ do
        replicateM_ t $ do
            [qS, xS] <- S.liftIO $ B8.getLine <&> B8.words
            let q = B8.unpack qS
                x = fromInteger . readIntegerB8 $ xS
            case q of
                "+" -> do
                    insertQ x
                "?" -> do
                    answer <- queryQ x
                    S.liftIO $ printf "%lld\n" answer


Let's assume that   v(n) is the largest prime number, that does not exceed n; u(n) is the smallest prime number strictly greater than n. Find .

The first line contains integer t (1 ≤ t ≤ 500) — the number of testscases.  Each of the following t lines of the input contains integer n (2 ≤ n ≤ 109).

Print t lines: the i-th of them must contain the answer to the i-th test as an irreducible fraction "p/q", where p, q are integers, q > 0.

{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad
import Data.Int

{-
u x = head [ p | p <- [x,x-1..], P.isPrime p ]
v x = head [ p | p <- [x+1..], P.isPrime p ]
solve = scanl (+) 0 [ 1 % (u(x)*v(x)) | x <- [2..] ]
-}

isPrime primes n = all (\p -> n `mod` p /= 0) $ takeWhile (<n) primes

u primes x = head [ p | p <- [x,x-1..], isPrime primes p ]
v primes x = head [ p | p <- [x+1..],   isPrime primes p ]

solve' primes n = let x = fromIntegral $ u primes n :: Int64
                      y = fromIntegral $ v primes n
                      n' = fromIntegral n
                      a = 2*n' - 2*x - 2*y + 2 + x*y
                      b = 2*x*y
                      g = gcd a b
                  in (div a g, div b g)

isqrt :: Integral a => a -> Int
isqrt n = floor $ sqrt ((fromIntegral n) :: Double)

sieve arr = do
  (_,hi) <- getBounds arr
  let maxi = isqrt hi
  forM_ [2..maxi] $ \i -> do
    v <- readArray arr i
    if v == 0
      then let v = i*i in forM_ [v,v+i..hi] $ \j -> writeArray arr j (fromIntegral i)
      else return ()

genPrimes :: Integral a => Int -> IO [a]
genPrimes n = do
  parr' <- newArray (2,n) 0 :: IO (IOUArray Int Int)
  sieve parr'
  parr <- M.freeze parr' :: IO (UArray Int Int)
  let primes = map (fromIntegral.fst) $ filter (\(i,v) -> v == 0) $ I.assocs parr
  return primes

test = do
  primes <- genPrimes 100 :: IO [Int]
  return $ all (isPrime primes) [2,3,5,7,11,13]

main = do
  primes <- genPrimes 32000 :: IO [Int]
  n <- fmap  read getLine
  replicateM_ n $ do
    x <- fmap read getLine
    let (a,b) = solve' primes x
    putStrLn $ show a ++ "/" ++ show b

f::Integer->Integer->Bool
f d n
  |n<d*d=True
  |n `mod` d==0=False
  |otherwise=f (d+1) n

f2::[Integer]->[String]
f2 []=[]
f2 (2:xs)="1/6":f2 xs
f2 (3:xs)="7/30":f2 xs
f2 (4:xs)="3/10":f2 xs
f2 (x:xs)=let p1=head $ [t0|t0<-[x,(x-1)..1],f 2 t0]
              p2=head $ [t1|t1<-[(x+1)..],f 2 t1]
              u1=p1-2
              d1=p1*2
              u2=x-p1+1
              d2=p1*p2
              u3=u1*d2+u2*d1
              d3=d1*d2
              t=(gcd u3 d3)
          in ((show (u3 `div` t))++"/"++(show (d3 `div` t))):(f2 xs)

main = do
       e<-getLine
       es<-getContents
       let xs=map read (lines es)::[Integer]
       mapM_ putStrLn $ f2 xs

{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import qualified Data.Array.MArray as M
import qualified Data.Array.IArray as I
import Data.Array.Unboxed
import Control.Monad

{-
u x = head [ p | p <- [x,x-1..], P.isPrime p ]
v x = head [ p | p <- [x+1..], P.isPrime p ]
solve = scanl (+) 0 [ 1 % (u(x)*v(x)) | x <- [2..] ]
-}

isPrime primes n = all (\p -> n `mod` p /= 0) $ takeWhile (<n) primes

u primes x = head [ p | p <- [x,x-1..], isPrime primes p ]
v primes x = head [ p | p <- [x+1..],   isPrime primes p ]

solve' primes n = let x = u primes n
                      y = v primes n
                      a = 2*n - 2*x - 2*y + 2 + x*y
                      b = 2*x*y
                      g = gcd a b
                  in (div a g, div b g)

isqrt :: Integral a => a -> Int
isqrt n = floor $ sqrt ((fromIntegral n) :: Double)

sieve arr = do
  (_,hi) <- getBounds arr
  let maxi = isqrt hi
  forM_ [2..maxi] $ \i -> do
    v <- readArray arr i
    if v == 0
      then let v = i*i in forM_ [v,v+i..hi] $ \j -> writeArray arr j (fromIntegral i)
      else return ()

genPrimes :: Integral a => Int -> IO [a]
genPrimes n = do
  parr' <- newArray (2,n) 0 :: IO (IOUArray Int Int)
  sieve parr'
  parr <- M.freeze parr' :: IO (UArray Int Int)
  let primes = map (fromIntegral.fst) $ filter (\(i,v) -> v == 0) $ I.assocs parr
  return primes

test = do
  primes <- genPrimes 100 :: IO [Int]
  return $ all (isPrime primes) [2,3,5,7,11,13]

main = do
  primes <- genPrimes 32000 :: IO [Int]
  n <- fmap  read getLine
  replicateM_ n $ do
    x <- fmap read getLine
    let (a,b) = solve' primes x
    putStrLn $ show a ++ "/" ++ show b


Ela loves reading a lot, just like her new co-workers in DTL! On her first day after becoming an engineer in DTL, she is challenged by a co-worker to sort a heap of books into different compartments on the shelf.$$$n$$$ books must be split into $$$k$$$ compartments on the bookshelf ($$$n$$$ is divisible by $$$k$$$). Each book is represented by a lowercase Latin letter from 'a' to 'y' inclusively, which is the beginning letter in the title of the book.Ela must stack exactly $$$\frac{n}{k}$$$ books in each compartment. After the books are stacked, for each compartment indexed from $$$1$$$ to $$$k$$$, she takes the minimum excluded (MEX) letter of the multiset of letters formed by letters representing all books in that compartment, then combines the resulting letters into a string. The first letter of the resulting string is the MEX letter of the multiset of letters formed by the first compartment, the second letter of the resulting string is the MEX letter of the multiset of letters formed by the second compartment, ... and so on. Please note, under the constraint of this problem, MEX letter can always be determined for any multiset found in this problem because 'z' is not used.What is the lexicographically greatest resulting string possible that Ela can create?A string $$$a$$$ is lexicographically greater than a string $$$b$$$ if and only if one of the following holds:  $$$b$$$ is a prefix of $$$a$$$, but $$$b \ne a$$$;  in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears later in the alphabet than the corresponding letter in $$$b$$$. The minimum excluded (MEX) letter of a multiset of letters is the letter that appears earliest in the alphabet and is not contained in the multiset. For example, if a multiset of letters contains $$$7$$$ letters 'b', 'a', 'b', 'c', 'e', 'c', 'f' respectively, then the MEX letter of this compartment is 'd', because 'd' is not included in the multiset, and all letters comes before 'd' in the alphabet, namely 'a', 'b' and 'c', are included in the multiset.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 200$$$; $$$1 \le k \le n$$$). It is guaranteed that $$$n$$$ is divisible by $$$k$$$. The second line of each test case contains a string of $$$n$$$ lowercase Latin letters from 'a' to 'y' inclusively. Each letter represents the starting letter of the title of a book in the initial heap. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$.

For each test case, output a string of $$$k$$$ letters which is the most optimal string that Ela can find.

5

12 3

cabccadabaac

12 6

cabccadabaac

12 12

cabccadabaac

25 1

abcdefghijklmnopqrstuvwxy

10 5

bcdxedbcfg

NoteIn the first test case, the books can be divided into $$$3$$$ compartments as below:  the first compartment contains the books with indices $$$1, 2, 3, 7$$$: $$$multiset_1 = \{$$$'c', 'a', 'b', 'd'$$$\}$$$ $$$\rightarrow$$$ $$$MEX(multiset_1) =$$$ 'e'  the second compartment contains the books with indices $$$4, 5, 6, 9$$$ : $$$multiset_2 = \{$$$'c', 'c', 'a', 'b'$$$\}$$$ $$$\rightarrow$$$ $$$MEX(multiset_2) =$$$ 'd'  the third compartment contains the remaining books $$$8, 10, 11, 12$$$ : $$$multiset_3 = \{$$$ 'a', 'a', 'a', 'c'$$$\}$$$ $$$\rightarrow$$$ $$$MEX(multiset_3) =$$$ 'b' Therefore, the answer is 'edb'. It can be proven that there is no way that Ela can arrange the books so that it results in a lexicographically greater string.

--
-- 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 System.IO             qualified as IO
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map

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,k] <- ri
        s    <- IO.getLine
        return (n,k,s)
    mapM_ (putStrLn.solve) tcs

solve (n,k,s) = ans
  where
    cnts = Map.fromList . map (head&&&length) . L.group . L.sort $ s
    w = n `div` k

    getCnt c = Map.findWithDefault 0 c cnts

    lcnts = map getCnt . take w $ ['a'..'y']

    limCnts = scanl min (head lcnts) (tail lcnts)

    ans1 = take k . concat . map snd . scanl f (0,"") . reverse . (['b'..]`zip`) $ limCnts
      where
        f (prev,_) (c,cnt) = (cnt, replicate (cnt-prev) c)

    ans = ans1 ++ replicate (k - length ans1) 'a'


The string $$$s$$$ is given, the string length is odd number. The string consists of lowercase letters of the Latin alphabet.As long as the string length is greater than $$$1$$$, the following operation can be performed on it: select any two adjacent letters in the string $$$s$$$ and delete them from the string. For example, from the string "lemma" in one operation, you can get any of the four strings: "mma", "lma", "lea" or "lem" In particular, in one operation, the length of the string reduces by $$$2$$$.Formally, let the string $$$s$$$ have the form $$$s=s_1s_2 \dots s_n$$$ ($$$n>1$$$). During one operation, you choose an arbitrary index $$$i$$$ ($$$1 \le i < n$$$) and replace $$$s=s_1s_2 \dots s_{i-1}s_{i+2} \dots s_n$$$.For the given string $$$s$$$ and the letter $$$c$$$, determine whether it is possible to make such a sequence of operations that in the end the equality $$$s=c$$$ will be true? In other words, is there such a sequence of operations that the process will end with a string of length $$$1$$$, which consists of the letter $$$c$$$?

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 10^3$$$) — the number of input test cases. The descriptions of the $$$t$$$ cases follow. Each test case is represented by two lines:   string $$$s$$$, which has an odd length from $$$1$$$ to $$$49$$$ inclusive and consists of lowercase letters of the Latin alphabet;  is a string containing one letter $$$c$$$, where $$$c$$$ is a lowercase letter of the Latin alphabet.

For each test case in a separate line output:  YES, if the string $$$s$$$ can be converted so that $$$s=c$$$ is true; NO otherwise.  You can output YES and NO in any case (for example, the strings yEs, yes, Yes and YES will be recognized as a positive response).

5

abcde

c

abcde

b

x

y

aaaaaaaaaaaaaaa

a

contest

t

NoteIn the first test case, $$$s$$$="abcde". You need to get $$$s$$$="c". For the first operation, delete the first two letters, we get $$$s$$$="cde". In the second operation, we delete the last two letters, so we get the expected value of $$$s$$$="c".In the third test case, $$$s$$$="x", it is required to get $$$s$$$="y". Obviously, this cannot be done.

main=interact$unlines.map f.t.tail.lines
f[s,[c]]=b$elem c$map head$t s
t[]=[]
t(a:b:s)=[a,b]:t s
t x=[x]
b x|x="YES"
b _="NO"

module Main (f, main) where

import Control.Arrow ((>>>))
import Data.Function (on, (&))
import Data.List (groupBy)

f [s, [c]] | length s & odd = c `elem` (takeEvenIndices s)
f _ = False

takeEvenIndices = takeIndicesWhich even
takeIndicesWhich predicate = enumerate >>> filter (fst >>> predicate) >>> unenumerate

main = interact $ lines >>> drop 1 >>> chunksOf 2 >>> map (f >>> boolToYesNo) >>> unlines

boolToYesNo p = if p then "YES" else "NO"

groupByKey = ((==) `on`) >>> groupBy
chunksOf n = enumerate >>> groupByKey (fst >>> (`div` n)) >>> map unenumerate

enumerate = zip [0..]
unenumerate = map snd

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (y:z:xs) =  func y z : solve xs

func :: String -> String -> String
func y z = if poss y z then "YES" else "NO"

poss :: String -> String -> Bool
poss xs y
    | length xs == 1 = head xs == head y
    | head xs == head y = True
    | otherwise = poss (tail (tail xs)) y

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

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = (Char, String)
type OutType = Bool

solve :: InType -> OutType
solve (c, s) = c `elem` oddPos s
  where oddPos [] = []
        oddPos [a] = [a]
        oddPos (a : b : t) = a : oddPos t

receive :: [String] -> InType
receive [s, c] = (head c, s)
receive _      = error "input error"

main :: IO ()
main = interact $ unlines . map (showB . solve . receive) . chunksOf 2 . tail . lines
  where showB False = "No"
        showB True  = "Yes"


To satisfy his love of matching socks, Phoenix has brought his $$$n$$$ socks ($$$n$$$ is even) to the sock store. Each of his socks has a color $$$c_i$$$ and is either a left sock or right sock. Phoenix can pay one dollar to the sock store to either:   recolor a sock to any color $$$c'$$$ $$$(1 \le c' \le n)$$$  turn a left sock into a right sock  turn a right sock into a left sock  The sock store may perform each of these changes any number of times. Note that the color of a left sock doesn't change when it turns into a right sock, and vice versa. A matching pair of socks is a left and right sock with the same color. What is the minimum cost for Phoenix to make $$$n/2$$$ matching pairs? Each sock must be included in exactly one matching pair.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains three integers $$$n$$$, $$$l$$$, and $$$r$$$ ($$$2 \le n \le 2 \cdot 10^5$$$; $$$n$$$ is even; $$$0 \le l, r \le n$$$; $$$l+r=n$$$) — the total number of socks, and the number of left and right socks, respectively. The next line contains $$$n$$$ integers $$$c_i$$$ ($$$1 \le c_i \le n$$$) — the colors of the socks. The first $$$l$$$ socks are left socks, while the next $$$r$$$ socks are right socks. It is guaranteed that the sum of $$$n$$$ across all the test cases will not exceed $$$2 \cdot 10^5$$$.

For each test case, print one integer — the minimum cost for Phoenix to make $$$n/2$$$ matching pairs. Each sock must be included in exactly one matching pair.

NoteIn the first test case, Phoenix can pay $$$2$$$ dollars to:   recolor sock $$$1$$$ to color $$$2$$$  recolor sock $$$3$$$ to color $$$2$$$  There are now $$$3$$$ matching pairs. For example, pairs $$$(1, 4)$$$, $$$(2, 5)$$$, and $$$(3, 6)$$$ are matching.In the second test case, Phoenix can pay $$$3$$$ dollars to:   turn sock $$$6$$$ from a right sock to a left sock  recolor sock $$$3$$$ to color $$$1$$$  recolor sock $$$4$$$ to color $$$1$$$  There are now $$$3$$$ matching pairs. For example, pairs $$$(1, 3)$$$, $$$(2, 4)$$$, and $$$(5, 6)$$$ are matching.

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

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

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

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

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

solve2 :: [Int] -> [Int] -> Int -> Int -> Int
solve2 ls rs ln rn =
    let t = min ((rn-ln) `div` 2) $ sum (map (`div` 2) rs)
    in
        ln + (rn-ln) - t

solve :: [Int] -> [Int] -> Int
solve ls rs =
    let ln = sum ls
        rn = sum rs
    in
        if ln < rn then
            solve2 ls rs ln rn
        else
            solve2 rs ls rn ln

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        [n,ln,rn] <- map parseInt . BS.words <$> BS.getLine
        cs <- map parseInt . BS.words <$> BS.getLine
        let (ls,rs) = splitAt ln cs
            qa = accumArray (+) 0 (1,n) $ map (,1) ls ++ map(,-1) rs :: UArray Int Int
            qs = elems qa
            l = filter (>0) qs
            r = map abs $ filter (<0) qs
        print $ solve l r

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed

ctArr :: Int -> [Int] -> UArray Int Int
ctArr n vs = accumArray (\v _ -> v+1) 0 (1, n) $ zip vs $ repeat ()

step :: (Int, Int, Int) -> (Int, Int) -> (Int, Int, Int)
step (!psave, !lsave, !rsave) (lct, rct)
  = (psave + min lct rct,
     lsave + div (max 0 $ lct - rct) 2,
     rsave + div (max 0 $ rct - lct) 2)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, lc, rc] <- readInts
    (lvs, rvs) <- splitAt lc <$> readInts
    let
      lcts = ctArr n lvs
      rcts = ctArr n rvs
      (psave, lsave, rsave) = foldl' step (0, 0, 0)
        $ zip (elems lcts) (elems rcts)
      qsave = if  lc >= rc
        then  min lsave $ div (lc - rc) 2
        else  min rsave $ div (rc - lc) 2
    -- Worst case, we need n spent (2 for each pair)
    -- but we save one orientation-change for each less-common sock existing
    -- one color change for each already-matching pair
    -- and one more color change for each color-matching pair left over
    -- among the more common orientation
    putInts [n - psave - qsave - min lc rc]

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


One day Alice was cleaning up her basement when she noticed something very curious: an infinite set of wooden pieces! Each piece was made of five square tiles, with four tiles adjacent to the fifth center tile:    By the pieces lay a large square wooden board. The board is divided into $$$n^2$$$ cells arranged into $$$n$$$ rows and $$$n$$$ columns. Some of the cells are already occupied by single tiles stuck to it. The remaining cells are free.Alice started wondering whether she could fill the board completely using the pieces she had found. Of course, each piece has to cover exactly five distinct cells of the board, no two pieces can overlap and every piece should fit in the board entirely, without some parts laying outside the board borders. The board however was too large for Alice to do the tiling by hand. Can you help determine if it's possible to fully tile the board?

The first line of the input contains a single integer $$$n$$$ ($$$3 \leq n \leq 50$$$) — the size of the board. The following $$$n$$$ lines describe the board. The $$$i$$$-th line ($$$1 \leq i \leq n$$$) contains a single string of length $$$n$$$. Its $$$j$$$-th character ($$$1 \leq j \leq n$$$) is equal to "." if the cell in the $$$i$$$-th row and the $$$j$$$-th column is free; it is equal to "#" if it's occupied. You can assume that the board contains at least one free cell.

Output YES if the board can be tiled by Alice's pieces, or NO otherwise. You can print each letter in any case (upper or lower).

NoteThe following sketches show the example boards and their tilings if such tilings exist:

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = readInt >>= flip replicateM getLine >>= putStrLn . which "YES" "NO" . solve

solve rows = runST $ do
	let
		n = length rows
	board <- newListArray ( ( 0, 0 ), ( n - 1, n - 1 ) ) ( concat rows ) :: ST s ( STUArray s ( Int, Int ) Char )
	res <- newSTRef True
	cnt <- newSTRef 0
	forM_ [ 0 .. n - 1 ] $ \y -> do
		forM_ [ 0 .. n - 1 ] $ \x -> do
			found <- ( '.' == ) <$> readArray board ( y, x )
			when found $ do
				forM_ ( zip [ 0, 1, 1, 1, 2 ] [ 0, -1, 0, 1, 0 ] ) $ \( dy, dx ) -> do
					let
						ny = y + dy
						nx = x + dx
						outside = not ( 0 <= ny && ny < n && 0 <= nx && nx < n )
					when outside $ do
						writeSTRef res False
						modifySTRef cnt succ
					when ( not outside ) $ do
						failed <- ( '#' == ) <$> readArray board ( ny, nx )
						if failed
							then writeSTRef res False
							else writeArray board ( ny, nx ) '#'
	readSTRef res

import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe

type Field = M.Map (Int, Int) Char

newState :: Int -> Maybe Field -> Maybe Field
newState n mf = mf >>= newState' n

newState' :: Int -> Field -> Maybe Field
newState' n f
  | null free
  = Nothing
  | x == 0 || x == n - 1 || y == n - 2 || y == n - 1
  = Nothing
  | elem '#'
    $ map (f M.!) [(y + 1, x - 1), (y + 1, x), (y + 1, x + 1), (y + 2, x)]
  = Nothing
  | otherwise
  = Just
    $ M.insert (y    , x)     '#'
    $ M.insert (y + 1, x - 1) '#'
    $ M.insert (y + 1, x)     '#'
    $ M.insert (y + 1, x + 1) '#'
    $ M.insert (y + 2, x) '#' f
 where
  free          = M.toList $ M.filter (== '.') f
  ((y, x), _):_ = free

main :: IO ()
main = do
  n     <- read <$> getLine :: IO Int
  field <-
    M.fromList
    .   concatMap (\(i, xs) -> zip (map ((,) i) [0 ..]) xs)
    .   zip [0 ..]
    <$> replicateM n getLine :: IO (M.Map (Int, Int) Char)
  let Just f = last $ takeWhile isJust $ iterate (newState n) (Just field)
  putStrLn $ if M.null (M.filter (== '.') f) then "YES" else "NO"

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  ans_Mid <- foldr
    (\ !x contx -> do
        vx1n <- liftA2 (&&) (rdA var (x,1)) (rdA var (x,n))
        if not vx1n then return False else do
        foldr
          (\ !y conty -> do
              vxy <- rdA var (x,y)
              if vxy then conty else do
              rest <- or . map fst <$> mapM (mdA' var (const True))
                [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
              if rest then return False else conty)
          contx
          [2..n-1])
    (return True)
    [1..n-2]
  if not ans_Mid then putStrLn "NO" else do
  ans <- foldr (\ !xy cont -> do
                   vxy <- rdA var xy
                   if vxy  then cont else return False)
    (return True)
    [(x,y) | x<-[n-1,n], y <- [1..n]]
  putStrLn $ if ans then "YES" else "NO"

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  forM_ [1..n-2] $ \ !x -> do
    vx1n <- and <$> mapM (rdA var) [(x,1),(x,n)]
    unless vx1n $ reply False
    forM_ [2..n-1] $ \ !y -> do
      vxy <- rdA var (x,y)
      unless vxy $ do
        vrest <- or . map fst <$> mapM (mdA' var $ const True)
          [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
        when vrest $ reply False
  forM_ [(x,y) | x<-[n-1,n], y <- [1..n]] $ \ !xy -> do
    vxy <- rdA var xy
    unless vxy $ reply False
  reply True
  where
    reply !b = do putStrLn $ if b then "YES" else "NO"
                  exitSuccess

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

import Control.Monad
import qualified Data.Map.Strict as M
import Data.Maybe

type Field = M.Map (Int, Int) Char

newState :: Int -> Maybe Field -> Maybe Field
newState n mf = mf >>= newState' n

newState' :: Int -> Field -> Maybe Field
newState' n f
  | null free
  = Nothing
  | x == 0 || x == n - 1 || y == n - 2 || y == n - 1
  = Nothing
  | otherwise
  = Just
    $ M.insert (y    , x)     '#'
    $ M.insert (y + 1, x - 1) '#'
    $ M.insert (y + 1, x)     '#'
    $ M.insert (y + 1, x + 1) '#'
    $ M.insert (y + 2, x) '#' f
 where
  free          = M.toList $ M.filter (== '.') f
  ((y, x), _):_ = free

main :: IO ()
main = do
  n     <- read <$> getLine :: IO Int
  field <-
    M.fromList
    .   concatMap (\(i, xs) -> zip (map ((,) i) [0 ..]) xs)
    .   zip [0 ..]
    <$> replicateM n getLine :: IO (M.Map (Int, Int) Char)
  let Just f = last $ takeWhile isJust $ iterate (newState n) (Just field)
  putStrLn $ if M.null (M.filter (== '.') f) then "YES" else "NO"

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit
import Data.Char

main :: IO ()
main = do
  n <- readInt <$> getLine
  var <- A.newListArray ((1,1),(n,n)) =<< map (=='#') . concat
         <$> replicateM n getLine :: IO (IOUArray (Int,Int) Bool)
  ans_Mid <- foldr
    (\ !x contx -> do
        vx1n <- liftA2 (&&) (rdA var (x,1)) (rdA var (x,n))
        if not vx1n then return False else do
        foldr
          (\ !y conty -> do
              vxy <- rdA var (x,y)
              if vxy then conty else do
              rest <- or . map fst <$> mapM (mdA' var (const True))
                [(x+1,y-1),(x+1,y),(x+1,y+1),(x+2,y)]
              if rest then return False else conty)
          contx
          [2..n-1])
    (return True)
    [1..n-2]
  if not ans_Mid then putStrLn "NO" else do
  ans <- foldr (\ !xy cont -> do
                   vxy <- rdA var xy
                   if vxy  then cont else return False)
    (return True)
    [(x,y) | x<-[n-1,n], y <- [1..n-1]]
  putStrLn $ if ans then "YES" else "NO"

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


You are given an array $$$a$$$ of $$$n$$$ positive integers. Let $$$\text{LIS}(a)$$$ denote the length of longest strictly increasing subsequence of $$$a$$$. For example,  $$$\text{LIS}([2, \underline{1}, 1, \underline{3}])$$$ = $$$2$$$.  $$$\text{LIS}([\underline{3}, \underline{5}, \underline{10}, \underline{20}])$$$ = $$$4$$$.  $$$\text{LIS}([3, \underline{1}, \underline{2}, \underline{4}])$$$ = $$$3$$$.  We define array $$$a'$$$ as the array obtained after reversing the array $$$a$$$ i.e. $$$a' = [a_n, a_{n-1}, \ldots , a_1]$$$.The beauty of array $$$a$$$ is defined as $$$min(\text{LIS}(a),\text{LIS}(a'))$$$.Your task is to determine the maximum possible beauty of the array $$$a$$$ if you can rearrange the array $$$a$$$ arbitrarily.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ $$$(1 \leq t \leq 10^4)$$$  — the number of test cases. Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ $$$(1 \leq n \leq 2\cdot 10^5)$$$  — the length of array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1,a_2, \ldots ,a_n$$$ $$$(1 \leq a_i \leq 10^9)$$$  — the elements of the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, output a single integer  — the maximum possible beauty of $$$a$$$ after rearranging its elements arbitrarily.

NoteIn the first test case, $$$a$$$ = $$$[6, 6, 6]$$$ and $$$a'$$$ = $$$[6, 6, 6]$$$. $$$\text{LIS}(a) = \text{LIS}(a')$$$ = $$$1$$$. Hence the beauty is $$$min(1, 1) = 1$$$.In the second test case, $$$a$$$ can be rearranged to $$$[2, 5, 4, 5, 4, 2]$$$. Then $$$a'$$$ = $$$[2, 4, 5, 4, 5, 2]$$$. $$$\text{LIS}(a) = \text{LIS}(a') = 3$$$. Hence the beauty is $$$3$$$ and it can be shown that this is the maximum possible beauty.In the third test case, $$$a$$$ can be rearranged to $$$[1, 2, 3, 2]$$$. Then $$$a'$$$ = $$$[2, 3, 2, 1]$$$. $$$\text{LIS}(a) = 3$$$, $$$\text{LIS}(a') = 2$$$. Hence the beauty is $$$min(3, 2) = 2$$$ and it can be shown that $$$2$$$ is the maximum possible beauty.

-- https://codeforces.com/contest/1679/problem/D
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int
solve n as = doubleCnt + (singleCnt + 1) `div` 2
    where
        aCnts = IM.elems $ flip S.execState IM.empty do
            forM_ as $ \a -> do
                S.modify $ IM.insertWith (+) a 1
        (singleACnts, doubleACnts) = L.partition (== 1) aCnts
        doubleCnt = L.length doubleACnts
        singleCnt = L.length singleACnts

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

-- https://codeforces.com/contest/1679/problem/D
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

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

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

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

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Maybe (fromJust, fromMaybe, isJust)

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> [Int] -> Int
solve n as = doubleCnt + (singleCnt + 1) `div` 2
    where
        aCnts = IM.elems $ flip S.execState IM.empty do
            forM_ as $ \a -> do
                S.modify $ IM.insertWith (+) a 1
        doubleCnt = L.length . L.filter even $ aCnts
        singleCnt = L.length . L.filter odd $ aCnts

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


Lena is the most economical girl in Moscow. So, when her dad asks her to buy some food for a trip to the country, she goes to the best store  — "PriceFixed". Here are some rules of that store:  The store has an infinite number of items of every product.  All products have the same price: $$$2$$$ rubles per item.  For every product $$$i$$$ there is a discount for experienced buyers: if you buy $$$b_i$$$ items of products (of any type, not necessarily type $$$i$$$), then for all future purchases of the $$$i$$$-th product there is a $$$50\%$$$ discount (so you can buy an item of the $$$i$$$-th product for $$$1$$$ ruble!). Lena needs to buy $$$n$$$ products: she must purchase at least $$$a_i$$$ items of the $$$i$$$-th product. Help Lena to calculate the minimum amount of money she needs to spend if she optimally chooses the order of purchasing. Note that if she wants, she can buy more items of some product than needed.

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 100\,000$$$) — the number of products. Each of next $$$n$$$ lines contains a product description. Each description consists of two integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i \leq 10^{14}$$$, $$$1 \leq b_i \leq 10^{14}$$$) — the required number of the $$$i$$$-th product and how many products you need to buy to get the discount on the $$$i$$$-th product.  The sum of all $$$a_i$$$ does not exceed $$$10^{14}$$$.

Output the minimum sum that Lena needs to make all purchases.

NoteIn the first example, Lena can purchase the products in the following way:  one item of product $$$3$$$ for $$$2$$$ rubles,  one item of product $$$1$$$ for $$$2$$$ rubles,  one item of product $$$1$$$ for $$$2$$$ rubles,  one item of product $$$2$$$ for $$$1$$$ ruble (she can use the discount because $$$3$$$ items are already purchased),  one item of product $$$1$$$ for $$$1$$$ ruble (she can use the discount because $$$4$$$ items are already purchased). In total, she spends $$$8$$$ rubles. It can be proved that it is impossible to spend less.In the second example Lena can purchase the products in the following way:  one item of product $$$1$$$ for $$$2$$$ rubles,  two items of product $$$2$$$ for $$$2$$$ rubles for each,  one item of product $$$5$$$ for $$$2$$$ rubles,  one item of product $$$3$$$ for $$$1$$$ ruble,  two items of product $$$4$$$ for $$$1$$$ ruble for each,  one item of product $$$1$$$ for $$$1$$$ ruble. In total, she spends $$$12$$$ rubles.

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

import Data.List as L
import qualified Data.Set as Set
import qualified Data.Map as Map

import qualified Data.ByteString as Bs
import qualified System.IO as Io
--import Data.IntSet

iter l@((la, lb, lq):xl) r@((ra, rb, rq):xr) acc cost
  | lq == rq && acc < lb = if lb - acc >= min_a then cost + 2*min_a else cost + 2*(lb-acc) + (min_a-lb+acc)
  | lq == rq = cost + min_a
  | acc < lb && ra <= lb - acc = iter l xr (acc+ra) (cost+2*ra)
  | acc < lb = iter l ((ra-lb+acc, rb, rq):xr) lb (cost+2*(lb-acc))
  | otherwise = iter xl r (acc+la) (cost+la)
  where min_a = min la ra

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  xss <- readrows n
  let xs = zipWith (\[x, y] z -> (x, y, z)) xss [1..n]
      q = sortBy (\(_, x, _) (_, y, _) -> compare x y) xs
      cost = iter q (reverse q) 0 0
    in print cost

main = do
  let t = 1
  replicateM_ t $ solve

----------------------------------------------------------------------------------------
readrows :: (Integral a, Integral b) => b -> IO [[a]]
readrows 0 = return []
readrows n = do
  row <- readInts
  l <- readrows $ n-1
  return (row : l)

parseInt :: (Integral a) => Bs.ByteString -> a
parseInt xs = snd $ Bs.foldr (\y (pow, acc) -> (pow*10, acc + pow*(fromIntegral (y-48)))) (1, 0) xs

readInts :: (Integral a) => IO [a]
readInts =  map parseInt . filter (/=Bs.empty) . Bs.splitWith (==32) . fuckingWindowsCRLF <$> Bs.getLine
  where fuckingWindowsCRLF bs = if Bs.last bs == 13 then Bs.init bs else bs


Little Mishka is a great traveller and she visited many countries. After thinking about where to travel this time, she chose XXX — beautiful, but little-known northern country.Here are some interesting facts about XXX:  XXX consists of n cities, k of whose (just imagine!) are capital cities.  All of cities in the country are beautiful, but each is beautiful in its own way. Beauty value of i-th city equals to ci.  All the cities are consecutively connected by the roads, including 1-st and n-th city, forming a cyclic route 1 — 2 — ... — n — 1. Formally, for every 1 ≤ i < n there is a road between i-th and i + 1-th city, and another one between 1-st and n-th city.  Each capital city is connected with each other city directly by the roads. Formally, if city x is a capital city, then for every 1 ≤ i ≤ n,  i ≠ x, there is a road between cities x and i.  There is at most one road between any two cities.  Price of passing a road directly depends on beauty values of cities it connects. Thus if there is a road between cities i and j, price of passing it equals ci·cj.Mishka started to gather her things for a trip, but didn't still decide which route to follow and thus she asked you to help her determine summary price of passing each of the roads in XXX. Formally, for every pair of cities a and b (a < b), such that there is a road between a and b you are to find sum of products ca·cb. Will you help her?

The first line of the input contains two integers n and k (3 ≤ n ≤ 100 000, 1 ≤ k ≤ n) — the number of cities in XXX and the number of capital cities among them. The second line of the input contains n integers c1, c2, ..., cn (1 ≤ ci ≤ 10 000) — beauty values of the cities. The third line of the input contains k distinct integers id1, id2, ..., idk (1 ≤ idi ≤ n) — indices of capital cities. Indices are given in ascending order.

Print the only integer — summary price of passing each of the roads in XXX.

NoteThis image describes first sample case:It is easy to see that summary price is equal to 17.This image describes second sample case:It is easy to see that summary price is equal to 71.

module Main where

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as L

type Tokenizer = State [L.ByteString]

data City = City { charm :: Integer
                 , capital :: Bool
                 } deriving (Show, Eq)

mkCities :: [Int] -> [Int] -> [City]
mkCities cs is = go 1 cs is
    where go _ [] [] = []
          go i (c:cs) [] = (City (fromIntegral c) False) : go (i + 1) cs []
          go i (c:cs) jss@(j:js) | i == j = (City c' True) : go (i + 1) cs js
                                 | otherwise = (City c' False) : go (i + 1) cs jss
                                 where c' = fromIntegral c

getWeight :: City -> City -> City -> Integer -> Integer -> Integer
getWeight (City c True) _ _ all _ = (all - c) * c
getWeight (City c False) (City lw lc) (City rw rc) _ capitals | lc && rc = c * capitals
                                                              | lc && (not rc) = c * (capitals + rw)
                                                              | (not lc) && rc = c * (capitals + lw)
                                                              | otherwise = c * (capitals + lw + rw)

solve :: [Int] -> [Int] -> Integer
solve cs is = (go cities (last cities : cities) (tail cities ++ [head cities]) 0) `div` 2
    where cities = mkCities cs is
          all = sum $ map charm cities
          capitals = sum . map charm $ filter capital cities

          go [] _ _ result = result
          go (c:cs) (p:ps) (n:ns) result = go cs ps ns (result + getWeight c p n all capitals)

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

go :: Tokenizer Integer
go = do
  n <- nextInt
  k <- nextInt
  cs <- replicateM n nextInt
  is <- replicateM k nextInt
  return $ solve cs is

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

import Data.Maybe
import Data.Array
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

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

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum (map fromIntegral costs) :: Integer
    let capitalTotalCost = sum (map (\i -> fromIntegral (costs' ! i)) capitals) :: Integer
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] (0::Integer)) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + (ci * (totalCost - ci)))
        | otherwise = f is acc'
        where
            acc' = acc + fromIntegral (ci * (cnext + cprev + capitals'))
            ci = fromIntegral (costs ! i) :: Integer
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = fromIntegral (costs ! i_next) :: Integer
            cprev = fromIntegral (costs ! i_prev) :: Integer
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

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

main = do
  [n, k] <- getInts
  cs <- fmap (map read . words) getLine :: IO [Int64]
  ids <- getInts

  let
    a = listArray (1, length cs) cs :: Array Int Int64
    s = sum cs

    b = accumArray (flip const) True (1, length cs) $ zip ids (repeat False) :: Array Int Bool

    cs' = map (a!) ids
    s1 = sum $ zipWith (*) cs' $ map (s-) $ scanl1 (+) cs'
    s2 = sum $ map (\(i, j) -> a!i * a!j) $ filter (\(i,j) -> b!i && b!j) $ [(i, i`mod`n + 1) | i <- [1..n]]

  print $ s1 + s2

import Data.Array
import qualified Data.IntSet as S
solve :: [Integer] -> [Int] -> Integer
solve cvs ids = cproads + circroute
    where n = length cvs
          cv = listArray (1, n) cvs
          idset = S.fromList ids
          cproads = let cp = map (cv !) ids in sum $ zipWith (*) cp (tail $ scanl (-) (sum cvs) cp)
          circroute = sum $ zipWith (\x y -> if (S.notMember x idset && S.notMember y idset) then cv ! x * cv ! y else 0) (n : [1..n-1]) [1..n]
main = do _ <- getLine
          x <- getLine
          y <- getLine
          putStrLn (show $ solve (map read $ words x) (map read $ words y))

import Data.Maybe
import Data.Array
import Data.Int
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

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

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum costs
    let capitalTotalCost = sum (map (\i -> costs' ! i) capitals)
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] (0::Int64)) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + fromIntegral (ci * (totalCost - ci)))
        | otherwise = f is acc'
        where
            acc' = acc + fromIntegral (ci * (cnext + cprev + capitals'))
            ci = costs ! i
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = costs ! i_next
            cprev = costs ! i_prev
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0

import Data.Maybe
import Data.Array
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import qualified Data.IntSet as Set
--import Debug.Trace

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

main = do
    [n,k] <- getInts
    costs <- getInts
    capitals <- getInts
    let costs' = listArray (1,n) costs
    let totalCost = sum costs
    let capitalTotalCost = sum (map (\i -> costs' ! i) capitals)
    let capitalSet = foldl addCapital Set.empty capitals
    print $ solve n k costs' capitalSet totalCost capitalTotalCost

addCapital set capital = Set.insert capital set

solve n k costs capitals totalCost capitalTotalCost = (f [1..n] 0) `div` 2 where
    f [] acc = acc
    f (i:is) acc
        | Set.member i capitals = f is (acc + ci * (totalCost - ci))
        | otherwise = f is acc'
        where
            acc' = acc + ci * (cnext + cprev + capitals')
            ci = costs ! i
            capitals' = capitalTotalCost - nextSub - prevSub
            i_next = if i == n then 1 else i + 1
            i_prev = if i == 1 then n else i - 1
            cnext = costs ! i_next
            cprev = costs ! i_prev
            nextSub = if Set.member i_next capitals then cnext else 0
            prevSub = if Set.member i_prev capitals then cprev else 0


PMP is getting a warrior. He is practicing a lot, but the results are not acceptable yet. This time instead of programming contests, he decided to compete in a car racing to increase the spirit of victory. He decides to choose a competition that also exhibits algorithmic features.AlgoRace is a special league of car racing where different teams compete in a country of n cities. Cities are numbered 1 through n. Every two distinct cities in the country are connected with one bidirectional road. Each competing team should introduce one driver and a set of cars.The competition is held in r rounds. In i-th round, drivers will start at city si and finish at city ti. Drivers are allowed to change their cars at most ki times. Changing cars can take place in any city in no time. One car can be used multiple times in one round, but total number of changes should not exceed ki. Drivers can freely choose their path to destination.PMP has prepared m type of purpose-built cars. Beside for PMP’s driving skills, depending on properties of the car and the road, a car traverses each road in each direction in different times. PMP Warriors wants to devise best strategies of choosing car and roads in each round to maximize the chance of winning the cup. For each round they want to find the minimum time required to finish it.

The first line contains three space-separated integers n, m, r (2 ≤ n ≤ 60, 1 ≤ m ≤ 60, 1 ≤ r ≤ 105) — the number of cities, the number of different types of cars and the number of rounds in the competition, correspondingly. Next m sets of n × n matrices of integers between 0 to 106 (inclusive) will follow — describing the time one car requires to traverse different roads. The k-th integer in j-th line of the i-th set is the time that i-th car requires to traverse the road from j-th city to k-th city. These matrices are not necessarily symmetric, but their diagonal is always zero. Next r lines contain description of the rounds. The i-th of these lines contains space-separated integers si, ti, ki (1 ≤ si, ti ≤ n, si ≠ ti, 0 ≤ ki ≤ 1000) — the number of starting city, finishing city and the number of possible car changes in i-th round, correspondingly.

For each round you should print the minimum required time to complete the round in a single line.

NoteIn the first sample, in all rounds PMP goes from city #1 to city #2, then city #3 and finally city #4. But the sequences of types of the cars he uses are (1, 2, 1) in the first round and (1, 2, 2) in the second round. In the third round, although he can change his car three times, he uses the same strategy as the first round which only needs two car changes.

{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Base(unsafeRead,unsafeWrite,unsafeAt)
import qualified Data.ByteString.Char8 as B
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f = go 0
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !n !m f = go n
   where
     go !i
       | i<m = f i >> go (i+1)
       | otherwise = return ()

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray (0,m*n*n-1) dists :: IO (IOUArray Int Int)

  rep m $ \i->
    rep n $ \x->
      rep n $ \s->
        rep n $ \t-> do
          dst <- unsafeRead d $ i*n*n+s*n+t
          dsx <- unsafeRead d $ i*n*n+s*n+x
          dxt <- unsafeRead d $ i*n*n+x*n+t
          unsafeWrite d (i*n*n+s*n+t) $ min dst $ dsx+dxt

  dist <- unsafeFreeze d :: IO (UArray Int Int)

  dp <- newArray (0,(n+1)*n*n-1) 60000000 :: IO (IOUArray Int Int)

  rep n $ \s->
    rep n $ \t-> do
      unsafeWrite dp (s*n+t) $! minimum [unsafeAt dist (car*n*n+s*n+t)|car<-[0..m-1]]

  for 1 (n+1) $ \k->
    rep n $ \s->
      rep n $ \t->
        rep n $ \x-> do
           dst <- unsafeRead dp $ (k*n*n+s*n+t)
           dsx <- unsafeRead dp $ ((k-1)*n*n+s*n+x)
           dxt <- unsafeRead dp $ (x*n+t)
           unsafeWrite dp (k*n*n+s*n+t) $ min dst $ dsx+dxt

  ans <- unsafeFreeze dp :: IO (UArray Int Int)

  let solve :: [Int] -> String
      solve [] = []
      solve (s:t:k:stks) = shows(unsafeAt ans(min n k*n*n+(s-1)*n+t-1))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 -fvia-C -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Base(unsafeRead,unsafeWrite,unsafeAt)
import qualified Data.ByteString.Char8 as B
import Control.Applicative

readInt s = case B.readInt s of
              Just (n,_) -> n

main = do
  [n,m,_] <- map read.words <$> getLine
  (disList,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray (0,m*n*n-1)  disList  :: IO (IOUArray Int Int)

  let runFloyd :: Int -> Int -> Int -> Int -> IO ()
      runFloyd !i !x !s !t
        | t<=n-1 = step >> runFloyd i x s (t+1)
        | s<n-1 = runFloyd i x (s+1) 0
        | x<n-1 = runFloyd i (x+1) 0 0
        | i<m-1 = runFloyd (i+1) 0 0 0
        | otherwise = return ()
       where
         step :: IO ()
         step = do
           dst <- unsafeRead d $! i*n*n+s*n+t
           dsx <- unsafeRead d $! i*n*n+s*n+x
           dxt <- unsafeRead d $! i*n*n+x*n+t
           unsafeWrite d (i*n*n+s*n+t) $! min dst $! dsx+dxt

  runFloyd 0 0 0 0
  dist <- unsafeFreeze d :: IO (UArray Int Int)
  dp <- newArray (0,(n+1)*n*n-1) 60000000 :: IO (IOUArray Int Int)

  let runInit :: Int -> Int -> IO ()
      runInit !s !t
        | t<=n-1 = step >> runInit s (t+1)
        | s<n-1  = runInit (s+1) 0
        | otherwise = return ()
       where
         step :: IO ()
         step = unsafeWrite dp (s*n+t) $! minimum $! [unsafeAt dist (car*n*n+s*n+t)|car<-[0..m-1]]

  let runDP ::  Int -> Int -> Int -> Int -> IO ()
      runDP !k !s !t !x
        | x<=n-1 = step >> runDP k s t (x+1)
        | t<n-1 = runDP k s (t+1) 0
        | s<n-1 = runDP k (s+1) 0 0
        | k<n   = runDP (k+1) 0 0 0
        | otherwise = return ()
       where
         step :: IO ()
         step = do
           dst <- unsafeRead dp $! (k*n*n+s*n+t)
           dsx <- unsafeRead dp $! ((k-1)*n*n+s*n+x)
           dxt <- unsafeRead dp $! (x*n+t)
           unsafeWrite dp (k*n*n+s*n+t) $! min dst $! dsx+dxt

  runInit 0 0
  runDP 1 0 0 0
  ans <- unsafeFreeze dp :: IO (UArray Int Int)

  let solve :: [Int] -> String
      solve [] = []
      solve (s:t:k:stks) = shows(unsafeAt ans(min n k*n*n+(s-1)*n+t-1))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Ix
import GHC.Arr (unsafeIndex)

(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=case bounds a of lr->unsafeAt a$unsafeIndex lr i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}

readInt s = case B.readInt s of Just (n,_) -> n

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  forM_ [1..m] $ \i->
    forM_ [1..n] $ \x->
      forM_ [1..n] $ \s->
        forM_ [1..n] $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  forM_ [1..n] $ \s->
    forM_ [1..n] $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  forM_ [1..n] $ \k->
    forM_ [1..n] $ \s->
      forM_ [1..n] $ \t->
        forM_ [1..n] $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Ix
import GHC.Arr (unsafeIndex)

(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=case bounds a of lr->unsafeAt a$unsafeIndex lr i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep !s !t f=go s where go !i=when(i<=t)$f i>>go(i+1)
{-# INLINE rep #-}

readInt s = case B.readInt s of Just (n,_) -> n

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  rep 1 m $ \i->
    rep 1 n $ \x->
      rep 1 n $ \s->
        rep 1 n $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  rep 1 n $ \s->
    rep 1 n $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  rep 1 n $ \k->
    rep 1 n $ \s->
      rep 1 n $ \t->
        rep 1 n $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f=go 1 where go !i=when(i<=n)$f i>>go(i+1)

readInt s = case B.readInt s of Just (n,_) -> n

main = do
  [n,m,_] <- map read.words <$> getLine
  (dists,stks) <- splitAt (m*n*n).map readInt.B.words <$> B.getContents

  d <- newListArray ((1,1,1),(m,n,n)) dists  :: IO (IOUArray (Int,Int,Int) Int)

  rep m $ \i->
    rep n $ \x->
      rep n $ \s->
        rep n $ \t-> do
          dst <- readArray d (i,s,t)
          dsx <- readArray d (i,s,x)
          dxt <- readArray d (i,x,t)
          writeArray d (i,s,t) $ min dst (dsx+dxt)

  dist <- unsafeFreeze d :: IO (UArray (Int,Int,Int) Int)

  dp <- newArray ((0,1,1),(n,n,n)) 60000000 :: IO (IOUArray (Int,Int,Int) Int)

  rep n $ \s->
    rep n $ \t->
      writeArray dp (0,s,t) $ minimum [dist!(car,s,t)|car<-[1..m]]

  rep n $ \k->
    rep n $ \s->
      rep n $ \t->
        rep n $ \x-> do
          dst <- readArray dp (k,s,t)
          dsx <- readArray dp (k-1,s,x)
          dxt <- readArray dp (0,x,t)
          writeArray dp (k,s,t) $ min dst (dsx+dxt)

  ans <- unsafeFreeze dp :: IO (UArray (Int,Int,Int) Int)

  let solve [] = []
      solve (s:t:k:stks) = shows(ans!(min n k,s,t))"\n" ++ solve stks

  putStr $ solve stks

{-# OPTIONS_GHC -O2 #-}

import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Monad

readInt s = let Just (n,_) = B.readInt s in n

parse :: [[Int]] -> ([Int],[[Int]],[[Int]])
parse ([n,m,r]:xss) = let (disList,stks) = splitAt (m*n) xss
                      in ([n,m,r],disList,stks)

rep :: (Monad m) => Int -> (Int -> m ()) -> m ()
rep n f = rep' 1
   where rep' i
           | i <= n = f i >> rep' (i+1)
           | otherwise = return ()

main = do

  ([n,m,r],disList,stks) <- parse.map (map readInt.B.words).B.lines <$> B.getContents

  let dis :: UArray (Int,Int,Int) Int
      dis = runSTUArray $ do
        d <- newListArray ((1,1,1),(m,n,n)) $ concat disList
        rep m $ \i->
          rep n $ \x->
            rep n $ \s->
              rep n $ \t-> do
                dst <- readArray d (i,s,t)
                dsx <- readArray d (i,s,x)
                dxt <- readArray d (i,x,t)
                let tmp = dst+dxt
                when (tmp < dst) $
                  writeArray d (i,s,t) tmp
        return d

  let dp :: Array (Int,Int,Int) Int
      dp = array ((1,1,0),(n,n,n)) $ map (\x->(x,f x)) $ [(s,t,k)|s<-[1..n],t<-[1..n],k<-[0..n]]
      f (s,t,0) = minimum [dis!(i,s,t)|i<-[1..m]]
      f (s,t,k) = minimum [dp!(s,x,k-1)+dp!(x,t,0)|x<-[1..n]]

  putStr.unlines.map (\[s,t,k]->show $ dp!(s,t,min n k)) $ stks

{-# OPTIONS_GHC -O2 #-}

import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import Data.Word
import Control.Applicative
import Control.Monad

readInt s = let Just (n,_) = B.readInt s in n

parse :: [[Int]] -> ([Word8],[[Int]],[[Word8]])
parse ([n,m,r]:xss) = let (disList,stks) = splitAt (m*n) xss
                      in (map fromIntegral [n,m,r],disList,map (map fromIntegral) stks)

rep :: (Monad m) => Word8 -> (Word8 -> m ()) -> m ()
rep n f = rep' 1
   where rep' i
           | i <= n = f i >> rep' (i+1)
           | otherwise = return ()

main = do
  ([n,m,r],disList,stks) <- parse.map (map readInt.B.words).B.lines <$> B.getContents

  let dis :: UArray (Word8,Word8,Word8) Int
      dis = runSTUArray $ do
        d <- newListArray ((1,1,1),(m,n,n)) $ concat disList
        rep m $ \car->
          rep n $ \x->
            rep n $ \s->
              rep n $ \t-> do
                dst <- readArray d (car,s,t)
                dsx <- readArray d (car,s,x)
                dxt <- readArray d (car,x,t)
                writeArray d (car,s,t) $ min dst (dsx + dxt)
        return d

  let solve :: UArray (Word8,Word8,Word8) Int
      inf = 60000000
      solve = runSTUArray $ do
        dp <- newArray ((1,1,0),(n,n,n)) inf
        rep n $ \s->
          rep n $ \t->
            writeArray dp (s,t,0) $ minimum [dis!(car,s,t)|car<-[1..m]]
        rep n $ \k->
          rep n $ \s->
            rep n $ \t->
              rep n $ \x-> do
                dst <- readArray dp (s,t,k)
                dsx <- readArray dp (s,x,k-1)
                dxt <- readArray dp (x,t,0)
                writeArray dp (s,t,k) $ min dst (dsx+dxt)
        return dp

  putStr.unlines.map (\[s,t,k]->show $ solve!(s,t,min n k)) $ stks


A new cottage village called «Flatville» is being built in Flatland. By now they have already built in «Flatville» n square houses with the centres on the Оx-axis. The houses' sides are parallel to the coordinate axes. It's known that no two houses overlap, but they can touch each other.The architect bureau, where Peter works, was commissioned to build a new house in «Flatville». The customer wants his future house to be on the Оx-axis, to be square in shape, have a side t, and touch at least one of the already built houses. For sure, its sides should be parallel to the coordinate axes, its centre should be on the Ox-axis and it shouldn't overlap any of the houses in the village.Peter was given a list of all the houses in «Flatville». Would you help him find the amount of possible positions of the new house?

The first line of the input data contains numbers n and t (1 ≤ n, t ≤ 1000). Then there follow n lines, each of them contains two space-separated integer numbers: xi ai, where xi — x-coordinate of the centre of the i-th house, and ai — length of its side ( - 1000 ≤ xi ≤ 1000, 1 ≤ ai ≤ 1000).

Output the amount of possible positions of the new house.

NoteIt is possible for the x-coordinate of the new house to have non-integer value.

-- 15A

import List (sortBy)
import Monad (liftM)

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

solve :: Int -> [(Int, Int)] -> Int
solve t xs  =  2 + sum (zipWith f xs' (tail xs'))
  where
    xs'  =  sortBy (\a b -> compare (fst a) (fst b)) xs
    f (x1, a1) (x2, a2)
      | d < 2 * t  =  0
      | d > 2 * t  =  2
      | otherwise  =  1
      where
        d  =  (2 * x2 - a2) - (2 * x1 + a1)

main :: IO ()
main  =  do
    (_, t)  <-  liftM parse getLine
    xs      <-  liftM (map parse . lines) getContents
    print $ solve t xs

import List
import Control.Monad

solve t hs = show.(+2). sum $ [fits a b | (a,b) <- zip hs (tail hs)]
    where fits (x1, t1) (x2, t2) | 2*(x2-x1) - (t1+t2) == 2*t = 1
                                 | 2*(x2-x1) - (t1+t2) > 2*t  = 2
                                 | otherwise = 0

ints = fmap (map read . words) getLine

main = do
    [n, t] <- ints
    replicateM n ints >>= putStrLn . solve t . sort . (map (\[a,b]->(a,b)))

import Data.List( sort)
main = do
    n:[t] <- return . map read . words =<< getLine
    let packDataLine = do
	    [x,a] <- return . map read . words =<< getLine
	    return (x,a)
	packDataLine::IO (Int,Int)
    address <- sequence . take n $ repeat packDataLine
    let sAdd = sort address
	widths = [2*(fst b - fst a) - snd b - snd a | (a,b) <- zip sAdd (tail sAdd)]
	list = map (\w -> if 2*t<w then 2 else if 2*t == w then 1 else 0) widths
    print $ 2+sum list

import Data.List( sort)
main = do
    n:[t] <- return . map read . words =<< getLine
    let packDataLine = do
	    [x,a] <- return . map read . words =<< getLine
	    return (x,a)
	packDataLine::IO (Int,Int)
    address <- sequence . take n $ repeat packDataLine
    let sAdd = sort address
	widths = [fst b - fst a - (snd b + snd a)`div`2 | a<-sAdd, b<- tail sAdd]
	list = map (\w -> if t<w then 2 else if t == w then 1 else 0) widths
    print $ 2+sum list


Piet is one of the most known visual esoteric programming languages. The programs in Piet are constructed from colorful blocks of pixels and interpreted using pretty complicated rules. In this problem we will use a subset of Piet language with simplified rules.The program will be a rectangular image consisting of colored and black pixels. The color of each pixel will be given by an integer number between 0 and 9, inclusive, with 0 denoting black. A block of pixels is defined as a rectangle of pixels of the same color (not black). It is guaranteed that all connected groups of colored pixels of the same color will form rectangular blocks. Groups of black pixels can form arbitrary shapes.The program is interpreted using movement of instruction pointer (IP) which consists of three parts: current block pointer (BP); note that there is no concept of current pixel within the block; direction pointer (DP) which can point left, right, up or down; block chooser (CP) which can point to the left or to the right from the direction given by DP; in absolute values CP can differ from DP by 90 degrees counterclockwise or clockwise, respectively.Initially BP points to the block which contains the top-left corner of the program, DP points to the right, and CP points to the left (see the orange square on the image below).One step of program interpretation changes the state of IP in a following way. The interpreter finds the furthest edge of the current color block in the direction of the DP. From all pixels that form this edge, the interpreter selects the furthest one in the direction of CP. After this, BP attempts to move from this pixel into the next one in the direction of DP. If the next pixel belongs to a colored block, this block becomes the current one, and two other parts of IP stay the same. It the next pixel is black or outside of the program, BP stays the same but two other parts of IP change. If CP was pointing to the left, now it points to the right, and DP stays the same. If CP was pointing to the right, now it points to the left, and DP is rotated 90 degrees clockwise.This way BP will never point to a black block (it is guaranteed that top-left pixel of the program will not be black).You are given a Piet program. You have to figure out which block of the program will be current after n steps.

The first line of the input contains two integer numbers m (1 ≤ m ≤ 50) and n (1 ≤ n ≤ 5·107). Next m lines contain the rows of the program. All the lines have the same length between 1 and 50 pixels, and consist of characters 0-9. The first character of the first line will not be equal to 0.

Output the color of the block which will be current after n steps of program interpretation.

NoteIn the first example IP changes in the following way. After step 1 block 2 becomes current one and stays it after two more steps. After step 4 BP moves to block 3, after step 7 — to block 4, and finally after step 10 BP returns to block 1.  The sequence of states of IP is shown on the image: the arrows are traversed clockwise, the main arrow shows direction of DP, the side one — the direction of CP.

module Main where

import Control.Applicative
import Data.Map (Map)
import Data.Sequence (Seq, (|>))
import qualified Data.Map as Map
import qualified Data.Sequence as Seq
import Data.List

type BlockId = Int
data LRUD = L | R | U | D deriving(Ord,Eq, Show)

type State = (BlockId, LRUD, Bool)
type BlockInfo = ((Int, Int), (Int, Int))

changeSegment a 0 f l = l
changeSegment 0 i f [] = error "wtfff"
changeSegment 0 i f (h:t) = f h : changeSegment 0 (i-1) f t
changeSegment a i f (h:t) = h : changeSegment (a-1) i f t

find' :: (a -> Maybe b) -> [a] -> Maybe (a, b)
find' f [] = Nothing
find' f (h:t) = case f h of
  Nothing -> find' f t
  Just b -> Just (h, b)

-- qwe = qwe

nextBlock :: [String] -> Maybe (BlockInfo, [String])
nextBlock ss = case find' (\(i,l) -> (find (\(j,c) -> c /= '0') (zip [0..] l))) (zip [0..] ss) of
                    Nothing -> Nothing
                    Just ((i,_),(j,c)) -> Just (found c i j)
 where
  found c y x = (((y,x),(h,w)),changeSegment y h (changeSegment x w (const '0')) ss) where
    w = length $ takeWhile (==c) (drop x (ss !! y))
    h = length $ takeWhile (==c) (drop y ((transpose ss) !! x))

updR (s, m) b = (s |> b, foldr (\i -> Map.insert i (Seq.length s)) m ((,) <$> [xs..xe]<*>[ys..ye])) where
                    ((xs,ys),(w,h)) = b
                    ye = ys+h-1
                    xe = xs+w-1

findBlocks :: [String] -> (Seq BlockInfo, Map (Int, Int) BlockId)
findBlocks = go (Seq.empty, Map.empty) where
  go r s = case nextBlock s of
    Nothing -> r
    Just (newBlock, newS) -> go (updR r newBlock) newS

a !!! (i,j) = (a !! i) !! j

rod L = U
rod U = R
rod R = D
rod D = L

rot dp False = (dp, True)
rot dp True = (rod dp, False)
rotate (bp, dp, cp) = (bp, dp', cp') where (dp', cp') = rot dp cp

getDir (_, L, _) = (0, -1)
getDir (_, R, _) = (0, 1)
getDir (_, U, _) = (-1, 0)
getDir (_, D, _) = (1, 0)

getCorF L = (True,False)
getCorF U = (False,False)
getCorF R = (False,True)
getCorF D = (True,True)

getCor :: LRUD -> Bool -> (Bool, Bool)
getCor dp True = getCorF (rod dp)
getCor dp False = getCorF dp

s :: [String] -> Int
s(_:ns:t)= getColor (simulate (0,R,False) (Map.empty) 0 n) where
  n = read ns

  getColor :: State -> Int
  getColor (bp,_,_) = read [t !!! fst (getBlockInfo bp)]

  fastForward :: Int -> Int -> Int -> State -> State
  fastForward loop now term s = iterate step s !! ((term - now) `mod` loop)

  simulate :: State -> Map State Int -> Int -> Int -> State
  simulate state history now term | term == now = state
    | otherwise = case Map.lookup state history of
      Nothing -> simulate (step state) (Map.insert state now history) (now+1) term
      Just oldTime -> fastForward (now-oldTime) now term state

  m :: Seq BlockInfo
  mb :: Map (Int, Int) BlockId
  (m, mb) = findBlocks t

  getBlockInfo :: BlockId -> BlockInfo
  getBlockInfo bp = Seq.index m bp

  getBlock :: Int -> Int -> Maybe BlockId
  getBlock i j = Map.lookup (i,j) mb

  getCorner' bp isR isD = (x, y) where
    ((x0,y0),(w, h)) = getBlockInfo bp
    x | isR = x0 + w - 1
     | otherwise = x0
    y | isD = y0 + h - 1
      | otherwise = y0

  getCorner :: State -> (Int, Int)
  getCorner (b, dp, cp) = getCorner' b h v where
    (h,v) = getCor dp cp

  addP (x1, y1) (x2, y2) = (x1+x2, y1+y2)

  getDest :: State -> (Int, Int)
  getDest = addP <$> getCorner <*> getDir

  gogo :: State -> Maybe State
  gogo (bp, dp, cp) = (\b -> (b, dp, cp)) <$> uncurry getBlock (getDest (bp,dp,cp))

  step :: State -> State
  step st = maybe (rotate st) id (gogo st)
main=interact$show.s.words


Recently in Divanovo, a huge river locks system was built. There are now $$$n$$$ locks, the $$$i$$$-th of them has the volume of $$$v_i$$$ liters, so that it can contain any amount of water between $$$0$$$ and $$$v_i$$$ liters. Each lock has a pipe attached to it. When the pipe is open, $$$1$$$ liter of water enters the lock every second.The locks system is built in a way to immediately transfer all water exceeding the volume of the lock $$$i$$$ to the lock $$$i + 1$$$. If the lock $$$i + 1$$$ is also full, water will be transferred further. Water exceeding the volume of the last lock pours out to the river.   The picture illustrates $$$5$$$ locks with two open pipes at locks $$$1$$$ and $$$3$$$. Because locks $$$1$$$, $$$3$$$, and $$$4$$$ are already filled, effectively the water goes to locks $$$2$$$ and $$$5$$$. Note that the volume of the $$$i$$$-th lock may be greater than the volume of the $$$i + 1$$$-th lock.To make all locks work, you need to completely fill each one of them. The mayor of Divanovo is interested in $$$q$$$ independent queries. For each query, suppose that initially all locks are empty and all pipes are closed. Then, some pipes are opened simultaneously. For the $$$j$$$-th query the mayor asks you to calculate the minimum number of pipes to open so that all locks are filled no later than after $$$t_j$$$ seconds.Please help the mayor to solve this tricky problem and answer his queries.

The first lines contains one integer $$$n$$$ ($$$1 \le n \le 200\,000$$$) — the number of locks.  The second lines contains $$$n$$$ integers $$$v_1, v_2, \dots, v_n$$$ ($$$1 \le v_i \le 10^9$$$)) — volumes of the locks.  The third line contains one integer $$$q$$$ ($$$1 \le q \le 200\,000$$$) — the number of queries.  Each of the next $$$q$$$ lines contains one integer $$$t_j$$$ ($$$1 \le t_j \le 10^9$$$) — the number of seconds you have to fill all the locks in the query $$$j$$$.

Print $$$q$$$ integers. The $$$j$$$-th of them should be equal to the minimum number of pipes to turn on so that after $$$t_j$$$ seconds all of the locks are filled. If it is impossible to fill all of the locks in given time, print $$$-1$$$.

NoteThere are $$$6$$$ queries in the first example test. In the queries $$$1, 3, 4$$$ the answer is $$$-1$$$. We need to wait $$$4$$$ seconds to fill the first lock even if we open all the pipes. In the sixth query we can open pipes in locks $$$1$$$, $$$3$$$, and $$$4$$$. After $$$4$$$ seconds the locks $$$1$$$ and $$$4$$$ are full. In the following $$$1$$$ second $$$1$$$ liter of water is transferred to the locks $$$2$$$ and $$$5$$$. The lock $$$3$$$ is filled by its own pipe. Similarly, in the second query one can open pipes in locks $$$1$$$, $$$3$$$, and $$$4$$$.In the fifth query one can open pipes $$$1, 2, 3, 4$$$.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Main where

import qualified Data.ByteString.Lazy.Char8 as C
import Control.Monad.State (State, evalState, gets, MonadState (get, put))
import Data.Maybe (fromJust)
import Control.Monad (replicateM)
import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Debug.Trace (traceShowId, traceShow)

data TC = TC { v::[Int], qs::[Int] }

solve TC{..} = map query qs
  where
    pref = scanl1 (+) v
    min_t = foldr (\(x, i) acc -> max acc ((x + i) `div` (i + 1))) 0 $ zip pref [0..]
    lst = last pref

    query t
      | t < min_t = -1
      | otherwise = (lst + t - 1) `div` t

main :: IO ()
main = C.interact $ runScanner tc >>> solve >>> map (C.pack . show) >>> C.unlines

tc::Scanner TC
tc =
  TC <$> numberOf int <*> numberOf int

type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

str :: Scanner C.ByteString
str = get >>= \case { s:ss -> put ss >> return s }

int :: Scanner Int
int = fst . fromJust . C.readInt <$> str

integer :: Scanner Integer
integer = read . C.unpack <$> str

double :: Scanner Double
double = read . C.unpack <$> str

decimal :: Int -> Scanner Int
decimal p = round . ((10^p)*) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case { [] -> return []; _ -> (:) <$> s <*> many s }

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t then return [] else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2..4]

pair :: Scanner a -> Scanner b -> Scanner (a,b)
pair = liftA2 (,)