You desperately need to build some string t. For that you've got n more strings s1, s2, ..., sn. To build string t, you are allowed to perform exactly |t| (|t| is the length of string t) operations on these strings. Each operation looks like that:  choose any non-empty string from strings s1, s2, ..., sn;  choose an arbitrary character from the chosen string and write it on a piece of paper;  remove the chosen character from the chosen string. Note that after you perform the described operation, the total number of characters in strings s1, s2, ..., sn decreases by 1. We are assumed to build string t, if the characters, written on the piece of paper, in the order of performed operations form string t.There are other limitations, though. For each string si you know number ai — the maximum number of characters you are allowed to delete from string si. You also know that each operation that results in deleting a character from string si, costs i rubles. That is, an operation on string s1 is the cheapest (it costs 1 ruble), and the operation on string sn is the most expensive one (it costs n rubles).Your task is to count the minimum amount of money (in rubles) you will need to build string t by the given rules. Consider the cost of building string t to be the sum of prices of the operations you use.

The first line of the input contains string t — the string that you need to build. The second line contains a single integer n (1 ≤ n ≤ 100) — the number of strings to which you are allowed to apply the described operation. Each of the next n lines contains a string and an integer. The i-th line contains space-separated string si and integer ai (0 ≤ ai ≤ 100). Number ai represents the maximum number of characters that can be deleted from string si. All strings in the input only consist of lowercase English letters. All strings are non-empty. The lengths of all strings do not exceed 100 characters.

Print a single number — the minimum money (in rubles) you need in order to build string t. If there is no solution, print -1.

NoteNotes to the samples:In the first sample from the first string you should take characters "b" and "z" with price 1 ruble, from the second string characters "a", "e" и "b" with price 2 rubles. The price of the string t in this case is 2·1 + 3·2 = 8.In the second sample from the first string you should take two characters "a" with price 1 ruble, from the second string character "c" with price 2 rubles, from the third string two characters "a" with price 3 rubles, from the fourth string two characters "b" with price 4 rubles. The price of the string t in this case is 2·1 + 1·2 + 2·3 + 2·4 = 18.In the third sample the solution doesn't exist because there is no character "y" in given strings.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array (Array)
import Data.Array.Base
import Data.Array.ST (STArray,STUArray)
import Data.Maybe

main = do
  ts <- getLine
  n <- readLn
  let source = 0
      sink = n + 27
      fromChar c = fromEnum c - 96 + n
      gr0 = map (\cs@(c:_)->(source,fromChar c,0,length cs)).group $ sort ts
  gr1 <- fmap concat.forM [1..n] $ \i-> do
    [si,ai] <- words <$> getLine
    return.((i,sink,i,read ai):).map (\cs@(c:_)->(fromChar c,i,0,length cs)).group $ sort si
  print $ maybe (-1) id $ primalDual (n+28) (gr0++gr1) source sink (length ts)

type Vertex = Int
type VV = Vertex
type Cost = Int
type Cap = Int
type Graph = Array Vertex [(Vertex,Cost)]

inf :: Cost
inf = 1000000000

primalDual :: Int -> [(Vertex,Vertex,Cost,Cap)] -> Vertex -> Vertex -> Cap -> Maybe Cost
primalDual vnum vvccs start goal flow0 = runST $ do
  mgr       <- newArray (0,vnum-1) []     :: ST s (STArray s Vertex [(Vertex,Cost)])
  residual  <- newArray (0,vnum*vnum-1) 0 :: ST s (STUArray s VV Cap)
  potential <- newArray (0,vnum-1) 0      :: ST s (STUArray s Vertex Cost)
  dist      <- newArray (0,vnum-1) inf    :: ST s (STUArray s Vertex Cost)
  prev      <- newArray (0,vnum-1) (-1)   :: ST s (STUArray s Vertex Vertex)

  forM_ vvccs $ \(from,to,cost,cap)-> do
    unsafeRead mgr from >>= unsafeWrite mgr from.((to,cost):)
    unsafeRead mgr to >>= unsafeWrite mgr to.((from,-cost):)
    unsafeWrite residual (from*vnum+to) cap

  (gr :: Graph) <- unsafeFreeze mgr

  let dijkstra heap
        | isEmpty heap = unsafeRead dist goal
        | otherwise = do
            let (v, vcost, nheap) = deleteFindMin heap
            dv <- unsafeRead dist v
            if vcost > dv
               then dijkstra nheap
               else (dijkstra.foldr ins nheap.catMaybes=<<).forM (unsafeAt gr v) $ \(nv,v2nv) -> do
                 cap <- unsafeRead residual (v*vnum+nv)
                 hv <- unsafeRead potential v
                 hnv <- unsafeRead potential nv
                 let newdnv = vcost + v2nv + hv - hnv
                 olddnv <- unsafeRead dist nv
                 if cap>0 && newdnv < olddnv
                    then do
                      unsafeWrite dist nv newdnv
                      unsafeWrite prev nv v
                      return $ Just (nv,newdnv)
                    else return Nothing

  let shortestPath vertex = reverse <$> go vertex
         where
           go v
             | v == start = return [v]
             | otherwise = do
                 pv <- unsafeRead prev v
                 vs <- go pv
                 return $ v:vs

  let calcFlow !flow (v:nv:vs) = do
         cap <- unsafeRead residual (v*vnum+nv)
         calcFlow (min flow cap) (nv:vs)
      calcFlow !flow _ = return flow

  let updateResidual newflow (v:nv:vs) = do
         let !i = v*vnum+nv
             !j = nv*vnum+v
         unsafeRead residual i >>= unsafeWrite residual i.(subtract newflow)
         unsafeRead residual j >>= unsafeWrite residual j.(newflow+)
         updateResidual newflow (nv:vs)
      updateResidual _ _ = return ()

  let mainLoop !flow !ans
        | flow == 0 = return $ Just ans
        | otherwise = do
            forM_ [0..vnum-1] $ \v-> unsafeWrite dist v inf
            unsafeWrite dist start 0
            dgoal <- dijkstra $ ins (start,0) Empty
            if dgoal == inf
               then return Nothing
               else do
                 forM_ [0..vnum-1] $ \v-> do
                   dv <- unsafeRead dist v
                   unsafeRead potential v >>= unsafeWrite potential v.(dv+)
                 path <- shortestPath $ goal
                 newflow <- calcFlow flow path
                 updateResidual newflow path
                 mainLoop (flow-newflow).(ans+).(newflow*) =<< unsafeRead potential goal

  mainLoop flow0 0

data Heap  = Empty | Fork !Cost !Vertex [Heap]

isEmpty :: Heap -> Bool
isEmpty Empty = True
isEmpty _ = False

ins :: (Vertex, Cost) -> Heap -> Heap
ins (v,cost) h = merge (Fork v cost []) h

deleteFindMin :: Heap -> (Vertex, Cost, Heap)
deleteFindMin (Fork v cost hs) = (v, cost, mergePairs hs)

merge :: Heap -> Heap -> Heap
merge Empty hy = hy
merge hx Empty = hx
merge hx@(Fork _ x _) hy@(Fork _ y _)
  | x <= y    = join hx hy
  | otherwise = join hy hx
 where
   join (Fork v cost hs) h = Fork v cost (h:hs)

mergePairs :: [Heap] -> Heap
mergePairs []       = Empty
mergePairs [x]      = x
mergePairs (x:y:hs) = merge (merge x y) (mergePairs hs)


Mad scientist Mike has just finished constructing a new device to search for extraterrestrial intelligence! He was in such a hurry to launch it for the first time that he plugged in the power wires without giving it a proper glance and started experimenting right away. After a while Mike observed that the wires ended up entangled and now have to be untangled again.The device is powered by two wires "plus" and "minus". The wires run along the floor from the wall (on the left) to the device (on the right). Both the wall and the device have two contacts in them on the same level, into which the wires are plugged in some order. The wires are considered entangled if there are one or more places where one wire runs above the other one. For example, the picture below has four such places (top view):  Mike knows the sequence in which the wires run above each other. Mike also noticed that on the left side, the "plus" wire is always plugged into the top contact (as seen on the picture). He would like to untangle the wires without unplugging them and without moving the device. Determine if it is possible to do that. A wire can be freely moved and stretched on the floor, but cannot be cut.To understand the problem better please read the notes to the test samples.

The single line of the input contains a sequence of characters "+" and "-" of length n (1 ≤ n ≤ 100000). The i-th (1 ≤ i ≤ n) position of the sequence contains the character "+", if on the i-th step from the wall the "plus" wire runs above the "minus" wire, and the character "-" otherwise.

Print either "Yes" (without the quotes) if the wires can be untangled or "No" (without the quotes) if the wires cannot be untangled.

NoteThe first testcase corresponds to the picture in the statement. To untangle the wires, one can first move the "plus" wire lower, thus eliminating the two crosses in the middle, and then draw it under the "minus" wire, eliminating also the remaining two crosses.In the second testcase the "plus" wire makes one full revolution around the "minus" wire. Thus the wires cannot be untangled:   In the third testcase the "plus" wire simply runs above the "minus" wire twice in sequence. The wires can be untangled by lifting "plus" and moving it higher:   In the fourth testcase the "minus" wire runs above the "plus" wire once. The wires cannot be untangled without moving the device itself:

solve xs = null $ foldl proc [] xs
    where
        proc [] x = [x]
        proc (y:ys) x = if x == y then ys else x:y:ys

main = putStrLn . (\res -> if res then "Yes" else "No") . solve =<< getLine

solve = null . foldl f []
    where
        f [] x = [x]
        f (y:ys) x = if x == y then ys else x:y:ys

main = putStrLn . (\y -> if y then "Yes" else "No") . solve =<< getLine

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    s <- getLine
    putStrLn $ if solve s then "Yes" else "No"

solve :: String -> Bool
solve s = null (go s [])
    where
    go [] st = st
    go (ch:s) [] = go s [ch]
    go (ch:s) (ch':l) | ch == ch' = go s l
                      | otherwise = go s (ch:ch':l)

solve :: String -> Bool
solve s  =  solve' "" s
  where
    solve' "" ""  =  True
    solve' "" (b:bs)  =  solve' [b] bs
    solve' _ ""  =  False
    solve' (a:as) (b:bs)
      | a == b  =  solve' as bs
      | otherwise  =  solve' (b:a:as) bs

print' :: Bool -> IO ()
print' True  =  putStrLn "YES"
print' False  =  putStrLn "NO"

main :: IO ()
main  =  getLine >>= print' . solve

import Data.List
import Data.Array

f::Char->[Char]->[Char]
f c []=[c]
f c (x:xs)  = if x==c then xs else (c:x:xs)

ans xs= if foldr f [] xs==[] then "Yes" else "No"

main = do
    m<-getLine
    putStrLn.ans $ m

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if x==y then ans (z:xs) else if y==z then ans (x:xs) else  "No"

main = do
    m<-getLine
    putStrLn.ans $ m

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if y==z then ans (x:xs) else "No"

main = do
    m<-getLine
    putStrLn.ans $ m

import Data.List

ans (x:[]) = "No"
ans (x:y:[])=if x==y then "Yes" else "No"
ans (x:y:z:xs)=if y==z then ans (x:xs) else "No"

main = do
    m<-getLine
    putStrLn.ans $ words m


There is a sheet of paper that can be represented with a grid of size $$$n \times m$$$: $$$n$$$ rows and $$$m$$$ columns of cells. All cells are colored in white initially.$$$q$$$ operations have been applied to the sheet. The $$$i$$$-th of them can be described as follows:   $$$x_i$$$ $$$y_i$$$ — choose one of $$$k$$$ non-white colors and color the entire row $$$x_i$$$ and the entire column $$$y_i$$$ in it. The new color is applied to each cell, regardless of whether the cell was colored before the operation. The sheet after applying all $$$q$$$ operations is called a coloring. Two colorings are different if there exists at least one cell that is colored in different colors.How many different colorings are there? Print the number modulo $$$998\,244\,353$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. The first line of the testcase contains four integers $$$n, m, k$$$ and $$$q$$$ ($$$1 \le n, m, k, q \le 2 \cdot 10^5$$$) — the size of the sheet, the number of non-white colors and the number of operations. The $$$i$$$-th of the following $$$q$$$ lines contains a description of the $$$i$$$-th operation — two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i \le n$$$; $$$1 \le y_i \le m$$$) — the row and the column the operation is applied to. The sum of $$$q$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print a single integer — the number of different colorings modulo $$$998\,244\,353$$$.

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- replicateM q readInts
    let f (!xs, !ys, !acc) ~[x, y] = (S.insert x xs, S.insert y ys, acc') where
            acc' = if (x `S.notMember` xs && S.size ys < m) || (y `S.notMember` ys && S.size xs < n)
                then acc * k `mod` mm
                else acc
        (_, _, ans) = foldl' f (S.empty, S.empty, 1) $ reverse xys
    print ans

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

data V2 = V2 !Int !Int deriving (Eq, Ord, Show)

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- reverse <$> replicateM q readInts
    let f (!xs, !ys, !acc) ~[x, y] = (xs', ys', acc') where
            acc' = if (x `S.notMember` xs && S.size ys < m) || (y `S.notMember` ys && S.size xs < n)
                then acc * k `mod` mm
                else acc
            xs' = S.insert x xs
            ys' = S.insert y ys
        (_, _, ans) = foldl' f (S.empty, S.empty, 1) xys
    print ans

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

import Data.Array.ST.Safe
import Data.STRef
import Control.Monad.ST.Lazy
import Data.Semigroup

soln :: Int -> Int -> [(Int, Int)] -> [Int]
soln n m ops = runST $ do
  rowArr <- strictToLazyST $ newArray (1, n) False
         :: ST s (STUArray s Int Bool)
  colArr <- strictToLazyST $ newArray (1, m) False
         :: ST s (STUArray s Int Bool)
  cleanRows <- strictToLazyST $ newSTRef n
  cleanCols <- strictToLazyST $ newSTRef m
  forM (reverse ops) $ \(r, c) -> strictToLazyST $ do
    ur <- readArray rowArr r
    uc <- readArray colArr c
    writeArray rowArr r True
    writeArray colArr c True
    fromRow <- if  ur
      then  pure 0
      else  do
      modifySTRef' cleanRows (subtract 1)
      readSTRef cleanCols
    fromCol <- if  uc
      then  pure 0
      else  do
      modifySTRef' cleanCols (subtract 1)
      readSTRef cleanRows
    pure $ fromRow + fromCol

p :: Int
p = 998244353

newtype ModP = ModP { unModP :: Int }
instance  Semigroup ModP  where
  ModP x <> ModP y = ModP (x * y `rem` p)
  stimes = stimesMonoid
instance  Monoid ModP  where
  mempty = ModP 1

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    k <- getInt
    q <- getInt
    acts <- replicateM q $ liftM2 (,) getInt getInt
    let
      nvs = length $ filter (/= 0) $ soln n m acts
      ans = unModP $ stimes nvs $ ModP k
    pure $ putInts [ans]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Set as S

data V2 = V2 !Int !Int deriving (Eq, Ord, Show)

mm :: Int
mm = 998244353

solve :: IO ()
solve = do
    ~[n, m, k, q] <- readInts
    xys <- reverse <$> replicateM q readInts
    let f (!xys, !xs, !ys, !acc) ~[x, y] = (xys', xs', ys', acc') where
            acc' = if S.member (V2 x y) xys || S.size xs == n || S.size ys == m
                then acc
                else acc * k `mod` mm
            xys' = S.insert (V2 x y) xys
            xs' = S.insert x xs
            ys' = S.insert y ys
        (_, _, _, ans) = foldl' f (S.empty, S.empty, S.empty, 1) xys
    print ans

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


For a permutation P[1... N] of integers from 1 to N, function f is defined as follows:  Let g(i) be the minimum positive integer j such that f(i, j) = i. We can show such j always exists.For given N, A, B, find a permutation P of integers from 1 to N such that for 1 ≤ i ≤ N, g(i) equals either A or B.

The only line contains three integers N, A, B (1 ≤ N ≤ 106, 1 ≤ A, B ≤ N).

If no such permutation exists, output -1. Otherwise, output a permutation of integers from 1 to N.

NoteIn the first example, g(1) = g(6) = g(7) = g(9) = 2 and g(2) = g(3) = g(4) = g(5) = g(8) = 5 In the second example, g(1) = g(2) = g(3) = 1

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = getLine >>= putStrLn.unwords.map show.solve.map read.words

solve :: [Int64] -> [Int64]
solve [n, a, b] = case [(x,quot(n-a*x)b)|x<-[0..div n a],rem(n - a * x)b==0] of
    []        -> [-1]
    ((x,y):_) -> gen a x ++ map(+(a*x))(gen b y)

gen :: Int64 -> Int64 -> [Int64]
gen a x = concat[map (\r->a*q+r+1) $ (a-1):[0..a-2] |q<-[0..x-1]]

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.State.Strict
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8      as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import           Data.List
import           Data.List.Split
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set                   as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = getLine >>= putStrLn.unwords.map show.solve.map read.words

solve :: [Int64] -> [Int64]
solve [n, a, b] = case [(x,quot(n-a*x)b)|x<-[0..div n a],rem(n - a * x)b==0] of
    []        -> [-1]
    ((x,y):_) -> gen a x ++ gen b y

gen :: Int64 -> Int64 -> [Int64]
gen a x = concat[map (\r->a*q+r+1) $ (a-1):[0..a-2] |q<-[0..x-1]]


You are given an array $$$a$$$ consisting of $$$n$$$ ($$$n \ge 3$$$) positive integers. It is known that in this array, all the numbers except one are the same (for example, in the array $$$[4, 11, 4, 4]$$$ all numbers except one are equal to $$$4$$$).Print the index of the element that does not equal others. The numbers in the array are numbered from one.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$). Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 100$$$) — the length of the array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 100$$$). It is guaranteed that all the numbers except one in the $$$a$$$ array are the same.

For each test case, output a single integer — the index of the element that is not equal to others.

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> (+4) . fromMaybe (error "no spy detected") $ findIndex (/= n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left 3
  | b == c = Left 1
  | a == c = Left 2

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

import Control.Monad
import Data.List (sort, group, elemIndex)
import Data.Maybe

readInts str = map (read :: String -> Int) (words str)

solve = do
  n <- readLn :: IO Int
  input <- getLine

  let a = map (read :: String -> Int) (words input)
  let x = head $ head $ filter (\x -> length x == 1) (group $ sort a)

  let ans = (fromJust $ elemIndex x a) + 1

  print ans

main = do
  t <- readLn :: IO Int

  replicateM_ t solve

import Control.Monad
import Data.List (sort, group, elemIndex)
import Data.Maybe

readInts str = map (read :: String -> Int) (words str)

solve = do
  n <- readLn :: IO Int
  input <- getLine

  let a = map (read :: String -> Int) (words input)
  let x = head $ head $ filter (\x -> length x == 1) (group $ sort a)

  let ans = fromJust $ elemIndex x a

  print (ans + 1)

main = do
  t <- readLn :: IO Int

  replicateM_ t solve

module Main where
   import Data.List

   solve :: IO ()
   solve = do
       n <- getLine
       s <- getLine
       let a = map (\x -> read x :: Integer) $ words s
           b = sort a
       print $ head [i + 1 | i <- [0..(read n :: Int) - 1], a !! i /= b !! 1]

   iter :: Integer -> IO ()
   iter 1 = solve
   iter x = do
       solve
       iter $ x - 1

   main :: IO ()
   main = do
       q <- getLine
       iter (read q :: Integer)

import Control.Monad
readInts = fmap (map read.words) getLine :: IO [Int]

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    let
        b = dropWhile (==head a) a
        c = takeWhile (==head b) b
        nb = n - length b
        nc = length c
    print $ if nc == 1 then nb + 1 else nb

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Data.List
import Data.Maybe
import Control.Monad

finddiff :: [Int] -> Int
finddiff lst =
  if (== 1) $ length $ head grouped
  then head $ head grouped
  else head $ last grouped
  where
    grouped = group $ sort lst

solve str =
  (1 +) $ fromJust $ (`elemIndex` intList) $ finddiff intList
  where intList = map read $ words str

main = do
  n <- read <$> getLine
  replicateM_  n (getLine >> solve <$> getLine >>= print)

import qualified Data.Map as M
import Data.Map((!))

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

main = do
	t <- getLine >>= return . read :: IO Int
	let loop t = if t==0 then return () else do
		n <- getLine >>= return . read :: IO Int
		l <- getLine >>= return  . (fmap read) . words :: IO [Int]
		let a
			| l!!0 == l!!1 = l !! 0
			| l!!0 == l!!2 = l !! 0
			| l!!1 == l!!2 = l !! 1
		print $ [i+1 | (i, x) <- zip [0..] l, x /= a] !! 0
		loop $ t - 1
	loop t

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  chunksOf 2 >>>
  map (tail >>> head >>> words >>> map read >>> solve >>> show) >>> unlines
  where
    chunksOf k [] = []
    chunksOf k xs =
      let (g, gs) = splitAt k xs
       in g : chunksOf k gs

solve :: [Int] -> Int
solve (x:y:z:xs)
  | x /= y && x == z = 2
  | x /= y && y == z = 1
  | x /= z = 3
  | otherwise = head [i | (v, i) <- zip xs [4 ..], v /= x]

{-# LANGUAGE TypeApplications #-}
import Control.Monad (replicateM_)
main :: IO ()
main = do
    i <- read @Int <$> getLine
    replicateM_ i solve

solve :: IO ()
solve = do
    i <- read @Int <$> getLine
    xs <- (read @Int <$>) . words <$> getLine
    print $ solveIter Nothing Nothing (zip [1..] xs)

solveIter :: Maybe (Int, Int) -> Maybe (Int, Int) -> [(Int, Int)] -> Int
solveIter Nothing Nothing (x@(i, v):xs) = solveIter (Just x) Nothing xs

solveIter (Just y@(iy, vy)) Nothing (x@(ix, vx):xs)
  | vx == vy = fst . head . dropWhile ((== vx) . snd) $ xs
  | otherwise = solveIter (Just y) (Just x) xs

solveIter (Just y@(iy, vy)) (Just (iz, vz)) ((x@(ix, vx):xs))
  | vx == vy = iz
  | otherwise = iy

solveIter a b c = error $ show a ++ show b ++ show c

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  print inputs
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> (+4) . fromMaybe (error "no spy detected") $ findIndex (/= n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left 3
  | b == c = Left 1
  | a == c = Left 2

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

{-# LANGUAGE BlockArguments #-}

module Main where

import System.IO
import Data.Traversable
import Data.Foldable
import Data.Maybe
import Data.List
import Data.Monoid
import Data.Semigroup

main :: IO ()
main = do
  contents <- getContents
  let inputs :: [[Int]]
      inputs = map (map read . words) . filterEvens . tail . lines $ contents
  traverse_ (print . f) inputs

f :: [Int] -> Int
f (a:b:c:rest) = case commonElement (a, b, c) of
  Left n -> n
  Right n -> fromMaybe (error "no spy detected") $ find (== n) rest
f _ = error "input less than 3 elements"

commonElement :: (Int, Int, Int) -> Either Int Int
commonElement (a, b, c)
  | a == b && b == c = Right a
  | a == b = Left c
  | b == c = Left a
  | a == c = Left b

filterEvens :: [a] -> [a]
filterEvens (a : b : rest) = b : filterEvens rest
filterEvens _ = []

module Main where
   import Data.List

   solve :: IO ()
   solve = do
       n <- getLine
       s <- getLine
       let a = map (\x -> read x :: Integer) $ words s
           b = sort a
       print $ length [i + 1 | i <- [0..(read n :: Int) - 1], a !! i /= b !! 1]

   iter :: Integer -> IO ()
   iter 1 = solve
   iter x = do
       solve
       iter $ x - 1

   main :: IO ()
   main = do
       q <- getLine
       iter (read q :: Integer)


We saw the little game Marmot made for Mole's lunch. Now it's Marmot's dinner time and, as we all know, Marmot eats flowers. At every dinner he eats some red and white flowers. Therefore a dinner can be represented as a sequence of several flowers, some of them white and some of them red.But, for a dinner to be tasty, there is a rule: Marmot wants to eat white flowers only in groups of size k.Now Marmot wonders in how many ways he can eat between a and b flowers. As the number of ways could be very large, print it modulo 1000000007 (109 + 7).

Input contains several test cases. The first line contains two integers t and k (1 ≤ t, k ≤ 105), where t represents the number of test cases. The next t lines contain two integers ai and bi (1 ≤ ai ≤ bi ≤ 105), describing the i-th test.

Print t lines to the standard output. The i-th line should contain the number of ways in which Marmot can eat between ai and bi flowers at dinner modulo 1000000007 (109 + 7).

Note  For K = 2 and length 1 Marmot can eat (R).  For K = 2 and length 2 Marmot can eat (RR) and (WW).  For K = 2 and length 3 Marmot can eat (RRR), (RWW) and (WWR).  For K = 2 and length 4 Marmot can eat, for example, (WWWW) or (RWWR), but for example he can't eat (WWWR).

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = (pr!b - pr!(a-1)) `mod` m
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+!) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, STArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.Set as S
import Data.STRef
import GHC.Arr (Array, Ix, range, unsafeIndex)
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
rev !n f=go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rep #-}
{-# INLINE rev #-}
for :: Monad m => Int -> (Int -> Bool) -> (Int -> Int) -> (Int -> m ()) -> m ()
for !i0 p next f=go i0 where go !i=when(p i)$f i>>go(next i)
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

type IntMod = Int64

infixl 6 +%

modulus :: IntMod
modulus = 1000000007

(+%) :: IntMod -> IntMod -> IntMod
x +% y = case x + y of xy -> if xy < modulus then xy else xy - modulus
{-# INLINE (+%) #-}

main :: IO ()
main = do
  [_,k] <- map read.words <$> getLine
  xs <- map readInt.B.words <$> B.getContents
  putStr.unlines.map show $ solve k xs

lim :: Int
lim = 100000

solve :: Int -> [Int] -> [IntMod]
solve k xs = map (`mod` modulus) $ go xs
   where
     go (a:b:rest) = query a b : go rest
     go _ = []
     query a b
       | a<b = unsafeAt res b - unsafeAt res (a-1)
       | otherwise = unsafeAt dp a
     res :: UArray Int IntMod
     !res = listArray (0,lim) .scanl1(+%)$map (unsafeAt dp)[0..lim]
     !dp = runSTUArray $ do
       dp <- newArray_ (0,lim) :: ST s (STUArray s Int Int64)
       unsafeWrite dp 0 1
       for 1 (<=lim) (1+) $ \i -> do
         if k<=i then do
           (+%) <$> unsafeRead dp (i-1) <*> unsafeRead dp (i-k) >>= unsafeWrite dp i
         else do
           unsafeRead dp (i-1) >>= unsafeWrite dp i
       return dp

import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
main = do
  [t,k] <- map read . words <$> getLine
  replicateM_ t $ do
    [a,b] <- map read . words <$> getLine
    print (solve k a b)
m = 10^9 + 7
solve k a b = runST $ do
  dp <- newArray (0,b) 0 :: ST s (STUArray s Int Int)
  writeArray dp 0 1
  forM_ [1..b] $ \i -> do
    white <- if i >= k then readArray dp (i-k) else pure 0
    red <- readArray dp (i-1)
    writeArray dp i (red + white)
  sum <$> mapM (readArray dp) [a..b]

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl (+) 0 r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b

import Data.List
import Data.Array
import Control.Monad
import qualified Data.ByteString.Char8 as B
parse s = (k,pairs xs) where
  (k:xs) = map readI $ tail $ B.words s
  pairs (a:b:xs) = (a,b) : pairs xs
  pairs [] = []
solve k = map (uncurry go) where
  go a b = pr!b - pr!(a-1)
  r = 1 : zipWith (+!) r (replicate (k-1) 0 ++ r)
  pr = listArray (0,100000) $ scanl1 (+!) r
main = mapM_ print . uncurry solve . parse =<< B.getContents
m = 10^9 + 7 :: Int
a +! b | s > m = s - m | otherwise = s where s = a + b
readI b = i where Just (i,_) = B.readInt b


You are given two arrays $$$a$$$ and $$$b$$$ of $$$n$$$ elements, each element is either $$$0$$$ or $$$1$$$.You can make operations of $$$2$$$ kinds.   Pick an index $$$i$$$ and change $$$a_i$$$ to $$$1-a_i$$$.  Rearrange the array $$$a$$$ however you want. Find the minimum number of operations required to make $$$a$$$ equal to $$$b$$$.

Each test contains multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 400$$$) — 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 100$$$) — the length of the arrays $$$a$$$ and $$$b$$$. The second line of each test case contains $$$n$$$ space-separated integers $$$a_1,a_2,\ldots,a_n$$$ ($$$a_i$$$ is $$$0$$$ or $$$1$$$), representing the array $$$a$$$. The third line of each test case contains $$$n$$$ space-separated integers $$$b_1,b_2,\ldots,b_n$$$ ($$$b_i$$$ is $$$0$$$ or $$$1$$$), representing the array $$$b$$$.

For each test case, print the minimum number of operations required to make $$$a$$$ equal to $$$b$$$.

NoteIn the first case, we need only one operation: change $$$a_1$$$ to $$$1-a_i$$$. Now $$$a = [0, 0]$$$ which is equal to $$$b$$$.In the second case, the optimal way is to rearrange $$$a$$$ to get the array $$$[0, 1, 11$$$. Now $$$a = [0, 0, 1]$$$ which is equal to $$$b$$$.In the second case, one of optimal ways would be to first change $$$a_3$$$ to $$$1 - a_3$$$, then rearrange $$$a$$$.In the third case, no operation is needed.In the fourth case, the optimal way is to rearrange $$$a$$$ to get the array $$$[0, 1, 1, 0]$$$.

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[_n],as,bs] <- replicateM 3 ri
        return (as,bs)
    mapM_ (putStrLn.show.solve) tcs

solve (as,bs) = min numDiff (1+numChg)
  where
    numDiff = length . filter (uncurry (/=)) $ zip as bs
    cnt1A = length . filter (==1) $ as
    cnt1B = length . filter (==1) $ bs
    numChg = abs (cnt1A - cnt1B)

import Control.Monad (forM_)

readInts :: IO [Int]
readInts = do
  s <- getLine
  return $ map read $ words s

diff :: [Int] -> [Int] -> Int
diff a b = sum $ zipWith (\x y -> if x /= y then 1 else 0) a b

count :: (a -> Bool) -> [a] -> Int
count p = length . filter p

countOnes :: [Int] -> Int
countOnes = count $ \x -> x == 1

solve :: IO ()
solve = do
  _ <- readInts
  a <- readInts
  b <- readInts
  let ca = countOnes a
  let cb = countOnes b
  let ans = if a == b then 0
            else (1 + abs (ca - cb)) `min` (diff a b)
  print ans

main :: IO ()
main = do
  [cnt] <- readInts
  forM_ (replicate cnt 0) $ \_ -> solve

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

main :: IO ()
main = do
    [t] <- getInts
    replicateM_ t $ do
        _ <- getInts
        as <- getInts
        bs <- getInts
        let diff xs ys = sum $ map fromEnum $ zipWith (/=) xs ys
        print $ min (diff as bs) (diff (sort as) (sort bs) + 1)

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


You talked to Polycarp and asked him a question. You know that when he wants to answer "yes", he repeats Yes many times in a row.Because of the noise, you only heard part of the answer — some substring of it. That is, if he answered YesYes, then you could hear esY, YesYes, sYes, e, but you couldn't Yess, YES or se.Determine if it is true that the given string $$$s$$$ is a substring of YesYesYes... (Yes repeated many times in a row).

The first line of input data contains the singular $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases in the test. Each test case is described by a single string of Latin letters $$$s$$$ ($$$1 \le |s| \le 50$$$) — the part of Polycarp's answer that you heard, where $$$|s|$$$ — is the length of the string $$$s$$$.

Output $$$t$$$ lines, each of which is the answer to the corresponding test case. As an answer, output "YES" if the specified string $$$s$$$ is a substring of the string YesYesYes...Yes (the number of words Yes is arbitrary), and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

12

YES

esYes

codeforces

es

se

YesY

esYesYesYesYesYesYe

seY

Yess

sY

o

Yes

NO
YES
NO
YES
NO
YES
YES
NO
NO
YES
NO
YES

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

dfa :: String -> Bool
dfa = (/= '?') . foldl' f '$' where
  f '$' 'Y' = 'Y'
  f '$' 'e' = 'e'
  f '$' 's' = 's'
  f 'Y' 'e' = 'e'
  f 'e' 's' = 's'
  f 's' 'Y' = 'Y'
  f  _   _  = '?'

main = do
  [n] <- readInts
  replicateM_ n $ getLine >>= putStrLn . (["NO","YES"] !!) . fromEnum . dfa

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

-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import           Data.Bool                (bool)
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import qualified Data.IntMap              as IntMap
import           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

solve :: String -> Bool
solve str = firstCondition && all (uncurry (==)) (zip alpha str)
  where
  first = head str
  alpha = dropWhile (/=first) (cycle "Yes")
  firstCondition = first == 'Y' || first == 'e' || first == 's'

doCase :: IO ()
doCase = do
  str <- getLine
  putStrLn $ bool "No" "Yes" $ solve str

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

getInt :: IO Int
getInt  = readInt <$> C.getLine

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

getInts :: IO [Int]
getInts = readInts <$> C.getLine


You are asked to watch your nephew who likes to play with toy blocks in a strange way.He has $$$n$$$ boxes and the $$$i$$$-th box has $$$a_i$$$ blocks. His game consists of two steps:   he chooses an arbitrary box $$$i$$$;  he tries to move all blocks from the $$$i$$$-th box to other boxes.  If he can make the same number of blocks in each of $$$n - 1$$$ other boxes then he will be happy, otherwise, will be sad. Note that your nephew can only move the blocks from the chosen box to the other boxes; he cannot move blocks from the other boxes.You don't want to make your nephew sad, so you decided to put several extra blocks into some boxes in such a way that no matter which box $$$i$$$ he chooses he won't be sad. What is the minimum number of extra blocks you need to put?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains the integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of boxes. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — the number of blocks in each box. It's guaranteed that the sum of $$$n$$$ over test cases doesn't exceed $$$10^5$$$.

For each test case, print a single integer — the minimum number of blocks you need to put. It can be proved that the answer always exists, i. e. the number of blocks is finite.

NoteIn the first test case, you can, for example, put one extra block into the first box and make $$$a = [4, 2, 2]$$$. If your nephew chooses the box with $$$4$$$ blocks, then we will move two blocks to the second box and two blocks to the third box. If he chooses the box with $$$2$$$ blocks then he will move these two blocks to the other box with $$$2$$$ blocks.In the second test case, you don't need to put any extra blocks, since no matter which box your nephew chooses, he can always make other boxes equal.In the third test case, you should put $$$3$$$ extra blocks. For example, you can put $$$2$$$ blocks in the first box and $$$1$$$ block in the third box. You'll get array $$$a = [2, 3, 1]$$$.

import Data.Int

readCases :: [String] -> [[Int64]]
readCases [] = []
readCases (x:xs) = map read a : readCases rs
  where (a, rs) = splitAt (read x) xs

solveCase :: [Int64] -> Int64
solveCase a = g * (n-1) - s
  where n = fromIntegral $ length a
        s = sum a
        m = (s+n-2) `div` (n-1)
        g = maximum (m : a)

solve :: String -> String
solve = unlines . map show . map solveCase . readCases . tail . words

main = interact solve


Overall there are m actors in Berland. Each actor has a personal identifier — an integer from 1 to m (distinct actors have distinct identifiers). Vasya likes to watch Berland movies with Berland actors, and he has k favorite actors. He watched the movie trailers for the next month and wrote the following information for every movie: the movie title, the number of actors who starred in it, and the identifiers of these actors. Besides, he managed to copy the movie titles and how many actors starred there, but he didn't manage to write down the identifiers of some actors. Vasya looks at his records and wonders which movies may be his favourite, and which ones may not be. Once Vasya learns the exact cast of all movies, his favorite movies will be determined as follows: a movie becomes favorite movie, if no other movie from Vasya's list has more favorite actors.Help the boy to determine the following for each movie: whether it surely will be his favourite movie; whether it surely won't be his favourite movie;  can either be favourite or not.

The first line of the input contains two integers m and k (1 ≤ m ≤ 100, 1 ≤ k ≤ m) — the number of actors in Berland and the number of Vasya's favourite actors.  The second line contains k distinct integers ai (1 ≤ ai ≤ m) — the identifiers of Vasya's favourite actors. The third line contains a single integer n (1 ≤ n ≤ 100) — the number of movies in Vasya's list. Then follow n blocks of lines, each block contains a movie's description. The i-th movie's description contains three lines:    the first line contains string si (si consists of lowercase English letters and can have the length of from 1 to 10 characters, inclusive) — the movie's title,  the second line contains a non-negative integer di (1 ≤ di ≤ m) — the number of actors who starred in this movie, the third line has di integers bi, j (0 ≤ bi, j ≤ m) — the identifiers of the actors who star in this movie. If bi, j = 0, than Vasya doesn't remember the identifier of the j-th actor. It is guaranteed that the list of actors for a movie doesn't contain the same actors.  All movies have distinct names. The numbers on the lines are separated by single spaces.

Print n lines in the output. In the i-th line print:    0, if the i-th movie will surely be the favourite;  1, if the i-th movie won't surely be the favourite;  2, if the i-th movie can either be favourite, or not favourite.

5 3
1 2 3
6
firstfilm
3
0 0 0
secondfilm
4
0 0 4 5
thirdfilm
1
2
fourthfilm
1
5
fifthfilm
1
4
sixthfilm
2
1 0

5 3
1 3 5
4
jumanji
3
0 0 0
theeagle
5
1 2 3 4 0
matrix
3
2 4 0
sourcecode
2
2 4

NoteNote to the second sample:   Movie jumanji can theoretically have from 1 to 3 Vasya's favourite actors.  Movie theeagle has all three favourite actors, as the actor Vasya failed to remember, can only have identifier 5.  Movie matrix can have exactly one favourite actor.  Movie sourcecode doesn't have any favourite actors. Thus, movie theeagle will surely be favourite, movies matrix and sourcecode won't surely be favourite, and movie jumanji can be either favourite (if it has all three favourite actors), or not favourite.

import Array
import Data.List
import Monad (liftM)

type Film  =  [Int]

parseFilms :: [String] -> [Film]
parseFilms []  =  []
parseFilms (_ : _ : s : xs)  =  map read (words s) : parseFilms xs

solve :: Int -> Int -> Array Int Bool -> [Film] -> [Int]
solve m k loves films
  | length films == 1  =  [0]
  | otherwise  =  map solve' minMax
  where
    minMax  =  map getMinMax films
    getMinMax film  =  (l1 + t2 - min t2 (m - k - u1), l1 + min t2 (k - l1))
      where
        t1  =  filter (/= 0) film
        t2  =  length $ filter (== 0) film
        l1  =  length $ filter (loves !) t1
        u1  =  length t1 - l1
    solve' (mn, mx)
      | mn >= mx'  =  0
      | mx < mx''  =  1
      | otherwise  =  2
      where
        minMax'  =  delete (mn, mx) minMax
        mx'   =  maximum (map snd minMax')
        mx''  =  maximum (map fst minMax')

main :: IO ()
main  =  do
    ls  <-  liftM lines $ readFile "input.txt"
    let [m, k]  =  map read . words . (!! 0) $ ls
    let loves  =  accumArray (flip const) False (1, m) [(x, True) | x <- map read . words . (!! 1) $ ls]
    let films  =  parseFilms $ drop 3 ls
    writeFile "output.txt" $ unlines $ map show $ solve m k loves films


Arkady wants to water his only flower. Unfortunately, he has a very poor watering system that was designed for $$$n$$$ flowers and so it looks like a pipe with $$$n$$$ holes. Arkady can only use the water that flows from the first hole.Arkady can block some of the holes, and then pour $$$A$$$ liters of water into the pipe. After that, the water will flow out from the non-blocked holes proportionally to their sizes $$$s_1, s_2, \ldots, s_n$$$. In other words, if the sum of sizes of non-blocked holes is $$$S$$$, and the $$$i$$$-th hole is not blocked, $$$\frac{s_i \cdot A}{S}$$$ liters of water will flow out of it.What is the minimum number of holes Arkady should block to make at least $$$B$$$ liters of water flow out of the first hole?

The first line contains three integers $$$n$$$, $$$A$$$, $$$B$$$ ($$$1 \le n \le 100\,000$$$, $$$1 \le B \le A \le 10^4$$$) — the number of holes, the volume of water Arkady will pour into the system, and the volume he wants to get out of the first hole. The second line contains $$$n$$$ integers $$$s_1, s_2, \ldots, s_n$$$ ($$$1 \le s_i \le 10^4$$$) — the sizes of the holes.

Print a single integer — the number of holes Arkady should block.

NoteIn the first example Arkady should block at least one hole. After that, $$$\frac{10 \cdot 2}{6} \approx 3.333$$$ liters of water will flow out of the first hole, and that suits Arkady.In the second example even without blocking any hole, $$$\frac{80 \cdot 3}{10} = 24$$$ liters will flow out of the first hole, that is not less than $$$20$$$.In the third example Arkady has to block all holes except the first to make all water flow out of the first hole.

import Control.Applicative
import Data.List (sort)

main = do
  [_, a, b] <- map read . words <$> getLine :: IO [Int]
  (h:hs) <- map read . words <$> getLine :: IO [Int]

  let hs' = reverse $ sort hs
      s = h + sum hs'
      sa = h * a

  print $ fst $ foldl (\(res, s') x -> if div sa s' >= b then (res, s') else (res + 1, s' - x)) (0, s) hs'


Vasya's house is situated in a forest, and there is a mushroom glade near it. The glade consists of two rows, each of which can be divided into n consecutive cells. For each cell Vasya knows how fast the mushrooms grow in this cell (more formally, how many grams of mushrooms grow in this cell each minute). Vasya spends exactly one minute to move to some adjacent cell. Vasya cannot leave the glade. Two cells are considered adjacent if they share a common side. When Vasya enters some cell, he instantly collects all the mushrooms growing there.Vasya begins his journey in the left upper cell. Every minute Vasya must move to some adjacent cell, he cannot wait for the mushrooms to grow. He wants to visit all the cells exactly once and maximize the total weight of the collected mushrooms. Initially, all mushrooms have a weight of 0. Note that Vasya doesn't need to return to the starting cell.Help Vasya! Calculate the maximum total weight of mushrooms he can collect.

The first line contains the number n (1 ≤ n ≤ 3·105) — the length of the glade. The second line contains n numbers a1, a2, ..., an (1 ≤ ai ≤ 106) — the growth rate of mushrooms in the first row of the glade. The third line contains n numbers b1, b2, ..., bn (1 ≤ bi ≤ 106) is the growth rate of mushrooms in the second row of the glade.

Output one number — the maximum total weight of mushrooms that Vasya can collect by choosing the optimal route. Pay attention that Vasya must visit every cell of the glade exactly once.

NoteIn the first test case, the optimal route is as follows:    Thus, the collected weight of mushrooms will be 0·1 + 1·2 + 2·3 + 3·4 + 4·5 + 5·6 = 70.In the second test case, the optimal route is as follows:    Thus, the collected weight of mushrooms will be 0·1 + 1·10 + 2·100 + 3·1000 + 4·10000 + 5·100000 = 543210.

{-# LANGUAGE BangPatterns #-}

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Int
import qualified Data.List             as L

main :: IO ()
main = do
    n <- readLn
    xs <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    ys <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n xs ys

solve :: Int64 -> [Int64] -> [Int64] -> Int64
solve n xs ys = go 0 0 0 0 upperWeightedSum lowerWeightedSum $ zip xs ys
  where
    !totalSum = sum xs + sum ys
    ixs = zipWith (*) [0..] xs
    iys = zipWith (*) [0..] ys
    irxs = zipWith (*) [n..] $ reverse xs
    irys = zipWith (*) [n..] $ reverse ys
    upperWeightedSum = reverse . scanl1 (+) . map (uncurry(+)) $ zip (reverse ixs) irys
    lowerWeightedSum = reverse . scanl1 (+) . map (uncurry(+)) $ zip (reverse iys) irxs
    go !res !t !acc !s (u:us) (l:ls) ((x, y):xys) =
        go (res `max` res') (t + 2) acc' (s + x + y) us ls xys
      where
        acc'
            | rem t 4 == 0 = acc + t * x + (t + 1) * y
            | otherwise = acc + t * y + (t + 1) * x
        res'
            | rem t 4 == 0 = acc + u + (totalSum - s) * div (t + 1) 2
            | otherwise = acc + l + (totalSum - s) * div (t + 1) 2
    go !res _ acc _ _ _ [] = max acc res

{-# LANGUAGE BangPatterns #-}

import           Control.Applicative
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Int
import qualified Data.List             as L

main :: IO ()
main = do
    n <- readLn
    xs <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    ys <- map fromIntegral.L.unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n xs ys

solve :: Int64 -> [Int64] -> [Int64] -> Int64
solve n xs ys = go 0 0 0 upperWeightedSum lowerWeightedSum unweightedSum $ zip xs ys
  where
    ixs = zipWith (*) [0..] xs
    iys = zipWith (*) [0..] ys
    irxs = zipWith (*) [n..] $ reverse xs
    irys = zipWith (*) [n..] $ reverse ys
    upperWeightedSum = reverse . scanl1 (+) . map (uncurry(+)) $ zip (reverse ixs) irys
    lowerWeightedSum = reverse . scanl1 (+) . map (uncurry(+)) $ zip (reverse iys) irxs
    unweightedSum = reverse . scanl1 (+) . map (uncurry(+)) $ zip (reverse xs) ys
    go !res !t !acc (u:us) (l:ls) (s:ss) ((x, y):xys) =
        go (res `max` res' `max` acc') (t + 2) acc' us ls ss xys
      where
        acc'
            | rem t 4 == 0 = acc + t * x + (t + 1) * y
            | otherwise = acc + t * y + (t + 1) * x
        res'
            | rem t 4 == 0 = acc + u + s * div t 2
            | otherwise = acc + l + s * div t 2
    go !res _ _ _ _ _ [] = res


A permutation of length $$$n$$$ is an array consisting of $$$n$$$ distinct integers from $$$1$$$ to $$$n$$$ in arbitrary order. For example, $$$[2,3,1,5,4]$$$ is a permutation, but $$$[1,2,2]$$$ is not a permutation ($$$2$$$ appears twice in the array) and $$$[1,3,4]$$$ is also not a permutation ($$$n=3$$$ but there is $$$4$$$ in the array).For a positive integer $$$n$$$, we call a permutation $$$p$$$ of length $$$n$$$ good if the following condition holds for every pair $$$i$$$ and $$$j$$$ ($$$1 \le i \le j \le n$$$) —   $$$(p_i \text{ OR } p_{i+1} \text{ OR } \ldots \text{ OR } p_{j-1} \text{ OR } p_{j}) \ge j-i+1$$$, where $$$\text{OR}$$$ denotes the bitwise OR operation. In other words, a permutation $$$p$$$ is good if for every subarray of $$$p$$$, the $$$\text{OR}$$$ of all elements in it is not less than the number of elements in that subarray. Given a positive integer $$$n$$$, output any good permutation of length $$$n$$$. We can show that for the given constraints such a permutation always exists.

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 and only line of every test case contains a single integer $$$n$$$ ($$$1 \le n \le 100$$$).

For every test, output any good permutation of length $$$n$$$ on a separate line.

import Control.Monad
import Control.Applicative
import Data.List

readInts :: IO [Int]
readInts = map read . words <$> getLine

f :: Int -> [String]
f cnt = if cnt == 0 then [] else f (cnt - 1) ++ [show cnt]

main :: IO ()
main = do
    t <- readLn
    a <- replicateM t $ readLn
    let b = (map f a)
    putStrLn $ unwords (map unwords b)

import Control.Monad
import Control.Applicative
import Data.List

readInts :: IO [Int]
readInts = map read . words <$> getLine

f :: Int -> [String]
f cnt = if cnt == 0 then ["\n"] else f (cnt - 1) ++ [show cnt]

main :: IO ()
main = do
    t <- readLn
    a <- replicateM t $ readLn
    let b = (map f a)
    putStrLn $ unwords (map unwords b)

prettier :: [Int] -> String
prettier [] = ""
prettier (x:xs) = (show x) ++ " " ++ (prettier xs)

readInt :: IO Int
readInt = do
    line <- getLine
    return $ read line

main :: IO ()
main = do
    t <- readInt
    for t where
        for 0 = return ()
        for i = do
            n <- readInt
            putStrLn $ prettier $ [n,(n-1)..1]
            for (i-1)

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  putStrLn $ unwords $ map show [1 .. n]

readInt x = read x :: Int

mPrint [] = putStrLn ""
mPrint (x:xs) = do
  putStr (show x)
  putStr " "
  mPrint xs

task = do
  kL <- getLine
  let k = readInt kL
  mPrint (take k [1..])

allTasks 0 = putStrLn ""
allTasks n = do
  task
  allTasks (n - 1)

main = do
  nL <- getLine
  let n = readInt nL
  allTasks n

module Main where

    solve :: IO ()
    solve = do
        s <- getLine
        let n = read s :: Integer
        putStrLn $ concat $ map (\x -> show x ++ " ") [1..n]

    iter :: Integer -> IO ()
    iter 1 = solve
    iter n = do
        solve
        iter $ n - 1

    main :: IO ()
    main = do
        s <- getLine
        iter (read s :: Integer)

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

onecase = do
		x<- read <$> getLine ::IO Int
		putStrLn $ intercalate " " $ map show [1..x]
main= do
		a<- read <$> getLine ::IO Int
		replicateM_ a onecase

solve :: Int -> [Int]
solve = enumFromTo 1

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


Consider an n × m grid. Initially all the cells of the grid are colored white. Lenny has painted some of the cells (at least one) black. We call a painted grid convex if one can walk from any black cell to any another black cell using a path of side-adjacent black cells changing his direction at most once during the path. In the figure below, the left grid is convex while the right one is not convex, because there exist two cells which need more than one time to change direction in their path.  You're given a painted grid in the input. Tell Lenny if the grid is convex or not.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 50) — the size of the grid. Each of the next n lines contains m characters "B" or "W". Character "B" denotes a black cell of the grid and "W" denotes a white cell of the grid. It's guaranteed that the grid has at least one black cell.

On the only line of the output print "YES" if the grid is convex, otherwise print "NO". Do not print quotes.

import Control.Applicative
import Data.Array

main :: IO ()
main = do
  size <- map read . words <$> getLine
  grid <- lines <$> getContents
  putStrLn $ solve size grid

solve :: [Int] -> [[Char]] -> String
solve [n, m] grid
  | and [withinOne a b | a <- edges, b <- edges] = "YES"
  | otherwise = "NO"
  where
  array = listArray (0, n-1) $ map (listArray (0, m-1)) grid
  isBlack i j = array ! i ! j == 'B'
  edges = [(i, j) | i <- [0..n-1],
    let js = [j | j <- [0..m-1], isBlack i j],
    j <- if null js then [] else [minimum js, maximum js]]
  withinOne (x, y) (z, w) =
    and [isBlack x j | j <- [y..w]] && and [isBlack i w | i <- [x..z]] ||
    and [isBlack z j | j <- [y..w]] && and [isBlack i y | i <- [x..z]]

import Control.Applicative
import Data.Array

main :: IO ()
main = do
  size <- map read . words <$> getLine
  grid <- lines <$> getContents
  putStrLn $ solve size grid

solve :: [Int] -> [[Char]] -> String
solve [n, m] grid
  | and [withinOne a b | a <- edges, b <- edges] = "YES"
  | otherwise = "NO"
  where
  array = listArray (0, n-1) $ map (listArray (0, m-1)) grid
  isBlack i j = array ! i ! j == 'B'
  edges = [(i, j) | i <- [0..n-1], j <- [0..m-1], isBlack i j,
    i == 0 || i == n-1 || j == 0 || j == m-1 ||
    or [not $ isBlack x y | (x, y) <- [(i-1, j), (i+1, j), (i, j-1), (i, j+1)]]]
  withinOne (x, y) (z, w) =
    and [isBlack x j | j <- [y..w]] && and [isBlack i w | i <- [x..z]] ||
    and [isBlack z j | j <- [y..w]] && and [isBlack i y | i <- [x..z]]