Maxim always goes to the supermarket on Sundays. Today the supermarket has a special offer of discount systems.There are m types of discounts. We assume that the discounts are indexed from 1 to m. To use the discount number i, the customer takes a special basket, where he puts exactly qi items he buys. Under the terms of the discount system, in addition to the items in the cart the customer can receive at most two items from the supermarket for free. The number of the "free items" (0, 1 or 2) to give is selected by the customer. The only condition imposed on the selected "free items" is as follows: each of them mustn't be more expensive than the cheapest item out of the qi items in the cart.Maxim now needs to buy n items in the shop. Count the minimum sum of money that Maxim needs to buy them, if he use the discount system optimally well.Please assume that the supermarket has enough carts for any actions. Maxim can use the same discount multiple times. Of course, Maxim can buy items without any discounts.

The first line contains integer m (1 ≤ m ≤ 105) — the number of discount types. The second line contains m integers: q1, q2, ..., qm (1 ≤ qi ≤ 105).  The third line contains integer n (1 ≤ n ≤ 105) — the number of items Maxim needs. The fourth line contains n integers: a1, a2, ..., an (1 ≤ ai ≤ 104) — the items' prices. The numbers in the lines are separated by single spaces.

In a single line print a single integer — the answer to the problem.

NoteIn the first sample Maxim needs to buy two items that cost 100 and get a discount for two free items that cost 50. In that case, Maxim is going to pay 200.In the second sample the best strategy for Maxim is to buy 3 items and get 2 items for free using the discount. In that case, Maxim is going to pay 150.

import Data.List

minPrice mq prices =
  let (buy, left) = splitAt mq prices
  in case left of
        a:b:rest  -> sum buy + minPrice mq rest
        _         -> sum buy

main :: IO ()
main = do
  _ <- getLine
  qs <- fmap (map read . words) getLine
  _ <- getLine
  as <- fmap (map read . words) getLine
  let mq = minimum qs
      prices = reverse $ sort as
  print $ minPrice mq prices

import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Maybe

solve qs as = sum $ go $ nonIncSort as
  where go [] = []
        go xs = sum (take q xs):go (drop (q + 2) xs)
        q = minimum qs
        nonIncSort = sortBy (\x y -> compare y x)

parseInt = fst . fromJust . BS.readInt

main = do _ <- BS.getLine
          qs <- fmap (map parseInt . BS.words) BS.getLine
          _ <- BS.getLine
          as <- fmap (map parseInt . BS.words) BS.getLine
          putStrLn $ show $ solve qs as

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.List

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

main = do
  _ <- getLine
  minq <- minimum.map readInt.B.words <$> B.getLine
  _ <- getLine
  as <- sortBy(flip compare).map readInt.B.words <$> B.getLine
  print $ solve minq as

solve minq xs = go 0 xs
   where
     go !ans [] = ans
     go !ans xs = go (ans+sum ys) $ drop 2 zs
      where
        (ys,zs) = splitAt minq xs


You've got an n × m matrix. The matrix consists of integers. In one move, you can apply a single transformation to the matrix: choose an arbitrary element of the matrix and increase it by 1. Each element can be increased an arbitrary number of times.You are really curious about prime numbers. Let us remind you that a prime number is a positive integer that has exactly two distinct positive integer divisors: itself and number one. For example, numbers 2, 3, 5 are prime and numbers 1, 4, 6 are not. A matrix is prime if at least one of the two following conditions fulfills:  the matrix has a row with prime numbers only;  the matrix has a column with prime numbers only; Your task is to count the minimum number of moves needed to get a prime matrix from the one you've got.

The first line contains two integers n, m (1 ≤ n, m ≤ 500) — the number of rows and columns in the matrix, correspondingly. Each of the following n lines contains m integers — the initial matrix. All matrix elements are positive integers. All numbers in the initial matrix do not exceed 105. The numbers in the lines are separated by single spaces.

Print a single integer — the minimum number of moves needed to get a prime matrix from the one you've got. If you've got a prime matrix, print 0.

NoteIn the first sample you need to increase number 1 in cell (1, 1). Thus, the first row will consist of prime numbers: 2, 2, 3.In the second sample you need to increase number 8 in cell (1, 2) three times. Thus, the second column will consist of prime numbers: 11, 2.In the third sample you don't have to do anything as the second column already consists of prime numbers: 3, 2.

import Control.Monad (liftM, replicateM)
import Data.Array
import Data.Char (ord)
import Data.List (intercalate)

isPrime :: Int -> Bool
isPrime n  =  all (\x -> mod n x /= 0)
  $ takeWhile (\x -> x * x <= n) primes

primes :: [Int]
primes  =  2 : filter isPrime [3,5..]

arrayDiffToPrime :: Array Int Int
arrayDiffToPrime  =  listArray (1,nextPrime 100000) $ listDiffToPrime 1 primes
  where
    listDiffToPrime i (p:ps)
      | i > p  =  listDiffToPrime i ps
      | otherwise  =  (p - i) : listDiffToPrime (i+1) (p:ps)
    nextPrime n  =  head $ dropWhile (< n) primes

solve :: Array (Int, Int) Int -> Int
solve array  =  min
    (minimum [sum [d ! (a ! (i, j)) | j <- [1..m]] | i <- [1..n]])
    (minimum [sum [d ! (a ! (i, j)) | i <- [1..n]] | j <- [1..m]])
  where
    (n, m)  =  snd $ bounds array
    d  =  arrayDiffToPrime
    a  =  array

main :: IO ()
main  =  do
    [n, m]  <-  reads
    ass  <-  replicateM n reads
    let array  =  Data.Array.array ((1,1), (n,m))
         $ map (\(i, x) -> ((i `div` m + 1, i `mod` m + 1), x))
         $ zip [0..] $ concat ass
    print $ solve array
  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

import qualified Data.IntSet as S
import Data.Array.Unboxed
import Data.List

main = interact (show . answer . map (map read . words) . tail . lines)

answer :: [[Int]] -> Int
answer s = min (ans s) (ans (transpose s))
  where
    ans = minimum . map (sum . map (\x -> nextPrime x - x))

nextPrime :: Int -> Int
nextPrime = (arr !)
  where
    mx = 110000
    primes = go 2 (S.fromDistinctAscList [2..mx])
      where
        go x s | x*x > mx = S.toAscList s
               | x `S.notMember` s = go (x+1) s
               | otherwise =
          go (x+1) (s `S.difference` (S.fromDistinctAscList [x*x, x*x+x..mx]))
    ps = go 1 primes
      where
        go x   []               = []
        go x (d:dp) | x == d    = x : go (x+1) dp
                    | otherwise = d : go (x+1) (d:dp)
    arr :: UArray Int Int
    arr = listArray (1, mx) ps

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

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Array.Base
import Data.Array.ST (runSTUArray)
import Data.Bits

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

main = do
  _ <- getLine
  xss <- map(map readInt.B.words).B.lines <$> B.getContents :: IO [[Int]]
  let yss = transpose xss
  print $ min (solve xss) (solve yss)

solve :: [[Int]] -> Int
solve xss = foldl1' min $ map (sum.map f) xss

f :: Int -> Int
f 1 = 1
f 2 = 0
f x
  | even x = 1 + f(x+1)
  | unsafeAt isPrime (x`unsafeShiftR`1) = 0
  | otherwise = 1 + f (x+1)

primeLimit = 100001
primeLimit2 = primeLimit`quot`2

isPrime :: UArray Int Bool
isPrime = runSTUArray $ do
  isp <- newArray (0,primeLimit`quot`2) True
  forM_ [1..isqrt primeLimit2] $ \i-> do
    flg <- unsafeRead isp i
    when flg $ do
      let !p = 2*i+1
          go !i = when (i<=primeLimit2) $ do
            unsafeWrite isp i False
            go $ i+p
      go $ i*(p+1)
  return isp

isqrt :: Int -> Int
isqrt x = floor.sqrt $ fromIntegral x


A string $$$s$$$ of length $$$n$$$ ($$$1 \le n \le 26$$$) is called alphabetical if it can be obtained using the following algorithm:  first, write an empty string to $$$s$$$ (i.e. perform the assignment $$$s$$$ := "");  then perform the next step $$$n$$$ times;  at the $$$i$$$-th step take $$$i$$$-th lowercase letter of the Latin alphabet and write it either to the left of the string $$$s$$$ or to the right of the string $$$s$$$ (i.e. perform the assignment $$$s$$$ := $$$c+s$$$ or $$$s$$$ := $$$s+c$$$, where $$$c$$$ is the $$$i$$$-th letter of the Latin alphabet). In other words, iterate over the $$$n$$$ first letters of the Latin alphabet starting from 'a' and etc. Each time we prepend a letter to the left of the string $$$s$$$ or append a letter to the right of the string $$$s$$$. Strings that can be obtained in that way are alphabetical.For example, the following strings are alphabetical: "a", "ba", "ab", "bac" and "ihfcbadeg". The following strings are not alphabetical: "z", "aa", "ca", "acb", "xyz" and "ddcba".From the given string, determine if it is alphabetical.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case is written on a separate line that contains one string $$$s$$$. String $$$s$$$ consists of lowercase letters of the Latin alphabet and has a length between $$$1$$$ and $$$26$$$, inclusive.

Output $$$t$$$ lines, each of them must contain the answer to the corresponding test case. Output YES if the given string $$$s$$$ is alphabetical and NO otherwise. You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as a positive answer).

11
a
ba
ab
bac
ihfcbadeg
z
aa
ca
acb
xyz
ddcba

NoteThe example contains test cases from the main part of the condition.

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

stringToArray :: String -> Array Int Int
stringToArray xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx = if (array ! lIdx) == nextChar then "YES" else "NO"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = stringToArray xs
    (lBound, rBound) = bounds array
    firstChar = ord 'a' + length xs -1

main = interact $ unlines . map solve . tail . lines

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

stringToArray :: String -> Array Int Int
stringToArray xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx =
    if ((array ! lIdx) == ordA) && (nextChar == ordA) then "YES" else "NO"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"
  where
    ordA = ord 'a'

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = stringToArray xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ unlines . map solve . tail . lines

import Control.Monad (replicateM_)
import Data.Char (ord, chr)
import Data.Sequence (Seq((:<|),(:|>), Empty))
import qualified Data.Sequence as S

isAlphabetical :: Seq Char -> Bool
isAlphabetical Empty = True
isAlphabetical (h :<| Empty ) = h == 'a'
isAlphabetical (h :<| (xs :|> l))
  | h == c = isAlphabetical (xs :|> l)
  | l == c = isAlphabetical (h :<| xs)
  | otherwise = False
  where
    c = chr $ ord 'a' + S.length xs + 1

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- S.fromList <$> getLine
    putStrLn $ if isAlphabetical s then "YES" else "NO"

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import Data.List
import Data.Maybe
import Data.Bool

-- import Debug.Trace
-- tr s x = trace msg x  where msg = "tr: " ++ s ++ ": " ++ show x ++ "."

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t getLine

    (putStr . unlines . map solve) tcs

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

solve s = bool "NO" "YES" isAlph
  where
    (pref, suff) = span (/='a') s
    isAFound = (not.null) suff && head suff == 'a'
    isAlph = isAFound && check (succ 'a') [tail suff, reverse pref]

check c strings | null ss                 = True
                | filter (==c) hs /= [c]  = False
                | c == 'z'                = True
                | otherwise               = check (succ c) (zipWith joinHT hs ts)
  where
    ss = filter (not.null) strings
    (hs, ts) = unzip . map (fromJust.uncons) $ ss
    joinHT h t | (h == c)  = t
               | otherwise = h:t

module Main where

import Control.Monad
import Data.Char
import Data.List
import qualified Data.Set as S

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

printList :: (Show a) => [a] -> IO ()
printList = putStrLn . list2Str

list2Str :: (Show a) => [a] -> String
list2Str = concat . intersperse " " . fmap show

yesOrNo :: Bool -> String
yesOrNo True = "YES"
yesOrNo False = "NO"

tCase :: IO () -> IO ()
tCase x = do
    t <- readLn
    replicateM_ t $ x

main :: IO ()
main = tCase process

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

process :: IO ()
process = do
    s <- getLine
    let n = length s
    putStrLn . yesOrNo $ f s n

f :: String -> Int -> Bool
f [x] _ = x == 'a'
f s@(x:xs) n
    | c == x       = f xs (n - 1)
    | c == last xs = f (init s) (n - 1)
    | otherwise    = False
    where c = chr (97 + n - 1)

import qualified Data.Set as Set
import Data.List
import Control.Monad
import Data.Char

readInts = fmap (map read.words) getLine :: IO [Integer]
solve1 [] ys = True
solve1 (x:xs) (y:ys)
    | (x /= y) = False
    | otherwise = solve1 xs ys

solve2 [x] = True
solve2 [x,y] = True
solve2 (x:y:xs)
    | (x < y && z < y) = False
    | otherwise = solve2 (y:xs)
    where z = head xs

printS = do
    s<-getLine
    let a = sort s
        t = sort $ "qwertyuiopasdfghjklzxcvbnm"
    putStrLn $ if ((solve1 a t) && (solve2 s)) then "YES" else "NO"

main = do
    t<-readLn
    replicateM_ t printS

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
--import Data.Char as C
--import Data.IntSet as S

good :: String -> Bool
good [] = True
good s
  | head s == ch = good $ tail s
  | last s == ch = good $ init s
  | otherwise = False
  where ch = ['a'..'z'] !! (length s - 1)

solve :: IO ()
solve = do
  s <- getLine
  putStrLn (if good s then "YES" else "NO")

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

import Control.Arrow ((>>>))
import Data.Bool (bool)
import Data.Char (chr, ord)

main :: IO ()
main = interact $ lines >>> drop 1 >>> map (isAlphabetic >>> bool "No" "Yes") >>> unlines

isAlphabetic :: String -> Bool
isAlphabetic "" = True
isAlphabetic s
  | head s == c = isAlphabetic $ tail s
  | last s == c = isAlphabetic $ init s
  | otherwise = False
  where
    c = chr $ ord 'a' + length s - 1

import Data.Array (Array, bounds, listArray, (!))
import Data.Char
import Data.List (intercalate)

f :: String -> Array Int Int
f xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx && nextChar /= ord 'a' = "NO"
  | lIdx == rIdx && nextChar == ord 'a' = "YES"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = f xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ intercalate "\n" . map solve . tail . lines

import Data.Array (Array, bounds, listArray, (!))
import Data.Char

f :: String -> Array Int Int
f xs = listArray (1, length xs) (map ord xs)

g :: Array Int Int -> Int -> Int -> Int -> String
g array lIdx rIdx nextChar
  | lIdx == rIdx && nextChar /= ord 'a' = "NO"
  | lIdx == rIdx && nextChar == ord 'a' = "YES"
  | nextChar == (array ! lIdx) = g array (lIdx + 1) rIdx (nextChar -1)
  | nextChar == (array ! rIdx) = g array lIdx (rIdx -1) (nextChar -1)
  | otherwise = "NO"

solve :: String -> String
solve xs = g array lBound rBound firstChar
  where
    array = f xs
    (lBound, rBound) = bounds array
    firstChar = max (array ! lBound) (array ! rBound)

main = interact $ unlines . map solve . tail . lines

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

isAlphabetical :: String -> Bool
isAlphabetical s = complete `isPrefixOf` ['a'..'z'] where
  left = reverse $ takeWhile (/= 'a') s
  right = dropWhile (/= 'a') s
  n = length left
  m = length right
  rest = if n > m then drop m left else drop n right
  org x y = [min x y, max x y]
  complete = concat (zipWith org left right) ++ rest

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- getLine
    putStrLn $ if isAlphabetical s then "YES" else "NO"


You are given a permutation $$$a_1, a_2, \ldots, a_n$$$ of size $$$n$$$, where each integer from $$$1$$$ to $$$n$$$ appears exactly once.You can do the following operation any number of times (possibly, zero):  Choose any three indices $$$i, j, k$$$ ($$$1 \le i < j < k \le n$$$).  If $$$a_i > a_k$$$, replace $$$a_i$$$ with $$$a_i + a_j$$$. Otherwise, swap $$$a_j$$$ and $$$a_k$$$. Determine whether you can make the array $$$a$$$ sorted in non-descending order.

Each test consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. The description of test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$3 \le n \le 10$$$) — the length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1,a_2,\dots,a_n$$$ ($$$1 \le a_i \le n$$$, $$$a_i \neq a_j$$$ if $$$i \neq j$$$) — the elements of the array $$$a$$$.

For each test case, output "Yes" (without quotes) if the array can be sorted in non-descending order, and "No" (without quotes) otherwise. You can output "Yes" and "No" in any case (for example, strings "YES", "yEs" and "yes" will be recognized as a positive response).

NoteIn the first test case, $$$[1,2,3]$$$ is already sorted in non-descending order.In the second test case, we can choose $$$i = 1,j = 2,k = 3$$$. Since $$$a_1 \le a_3$$$, swap $$$a_2$$$ and $$$a_3$$$, the array then becomes $$$[1,2,3]$$$, which is sorted in non-descending order.In the seventh test case, we can do the following operations successively:  Choose $$$i = 5,j = 6,k = 7$$$. Since $$$a_5 \le a_7$$$, swap $$$a_6$$$ and $$$a_7$$$, the array then becomes $$$[1,2,6,7,4,5,3]$$$.  Choose $$$i = 5,j = 6,k = 7$$$. Since $$$a_5 > a_7$$$, replace $$$a_5$$$ with $$$a_5+a_6=9$$$, the array then becomes $$$[1,2,6,7,9,5,3]$$$.  Choose $$$i = 2,j = 5,k = 7$$$. Since $$$a_2 \le a_7$$$, swap $$$a_5$$$ and $$$a_7$$$, the array then becomes $$$[1,2,6,7,3,5,9]$$$.  Choose $$$i = 2,j = 4,k = 6$$$. Since $$$a_2 \le a_6$$$, swap $$$a_4$$$ and $$$a_6$$$, the array then becomes $$$[1,2,6,5,3,7,9]$$$.  Choose $$$i = 1,j = 3,k = 5$$$. Since $$$a_1 \le a_5$$$, swap $$$a_3$$$ and $$$a_5$$$, the array then becomes $$$[1,2,3,5,6,7,9]$$$, which is sorted in non-descending order. In the third, the fourth, the fifth and the sixth test cases, it can be shown that the array cannot be sorted in non-descending order.

-- 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           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

data Result = Yes | No deriving Show

solve :: [Int] -> Result
solve xs = bool No Yes $ head xs == 1

doCase :: IO ()
doCase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

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

import Control.Monad (replicateM_)

answer :: [Int] -> String
answer (1 : xs) = "YES"
answer _ = "NO"

solve = do
  l1 <- getLine
  let n = read l1 :: Int
  l2 <- getLine
  let arr = map (\x -> read x :: Int) (words l2)
  putStrLn (answer arr)

main = do
  input <- getLine
  let t = read input :: Int
  replicateM_ t solve

-- 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           Data.Ix                  (Ix)
import           Debug.Trace              (trace)

data Result = Yes | No deriving Show

solve :: [Int] -> Result
solve xs = bool No Yes $ first <= second
  where
  first = head xs
  second = xs !! 1

doCase :: IO ()
doCase = do
  _ <- getInt
  xs <- getInts
  print $ solve xs

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


This is the easy version of the problem. The only difference is that in this version $$$q = 1$$$. You can make hacks only if both versions of the problem are solved.There is a process that takes place on arrays $$$a$$$ and $$$b$$$ of length $$$n$$$ and length $$$n-1$$$ respectively. The process is an infinite sequence of operations. Each operation is as follows:   First, choose a random integer $$$i$$$ ($$$1 \le i \le n-1$$$).  Then, simultaneously set $$$a_i = \min\left(a_i, \frac{a_i+a_{i+1}-b_i}{2}\right)$$$ and $$$a_{i+1} = \max\left(a_{i+1}, \frac{a_i+a_{i+1}+b_i}{2}\right)$$$ without any rounding (so values may become non-integer).  See notes for an example of an operation.It can be proven that array $$$a$$$ converges, i. e. for each $$$i$$$ there exists a limit $$$a_i$$$ converges to. Let function $$$F(a, b)$$$ return the value $$$a_1$$$ converges to after a process on $$$a$$$ and $$$b$$$.You are given array $$$b$$$, but not array $$$a$$$. However, you are given a third array $$$c$$$. Array $$$a$$$ is good if it contains only integers and satisfies $$$0 \leq a_i \leq c_i$$$ for $$$1 \leq i \leq n$$$.Your task is to count the number of good arrays $$$a$$$ where $$$F(a, b) \geq x$$$ for $$$q$$$ values of $$$x$$$. Since the number of arrays can be very large, print it modulo $$$10^9+7$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 100$$$). The second line contains $$$n$$$ integers $$$c_1, c_2 \ldots, c_n$$$ ($$$0 \le c_i \le 100$$$). The third line contains $$$n-1$$$ integers $$$b_1, b_2, \ldots, b_{n-1}$$$ ($$$0 \le b_i \le 100$$$). The fourth line contains a single integer $$$q$$$ ($$$q=1$$$). The fifth line contains $$$q$$$ space separated integers $$$x_1, x_2, \ldots, x_q$$$ ($$$-10^5 \le x_i \le 10^5$$$).

Output $$$q$$$ integers, where the $$$i$$$-th integer is the answer to the $$$i$$$-th query, i. e. the number of good arrays $$$a$$$ where $$$F(a, b) \geq x_i$$$ modulo $$$10^9+7$$$.

NoteThe following explanation assumes $$$b = [2, 1]$$$ and $$$c=[2, 3, 4]$$$ (as in the sample).Examples of arrays $$$a$$$ that are not good:   $$$a = [3, 2, 3]$$$ is not good because $$$a_1 > c_1$$$;  $$$a = [0, -1, 3]$$$ is not good because $$$a_2 < 0$$$. One possible good array $$$a$$$ is $$$[0, 2, 4]$$$. We can show that no operation has any effect on this array, so $$$F(a, b) = a_1 = 0$$$.Another possible good array $$$a$$$ is $$$[0, 1, 4]$$$. In a single operation with $$$i = 1$$$, we set $$$a_1 = \min(\frac{0+1-2}{2}, 0)$$$ and $$$a_2 = \max(\frac{0+1+2}{2}, 1)$$$. So, after a single operation with $$$i = 1$$$, $$$a$$$ becomes equal to $$$[-\frac{1}{2}, \frac{3}{2}, 4]$$$. We can show that no operation has any effect on this array, so $$$F(a, b) = -\frac{1}{2}$$$.

import Data.Array ( Ix(range), Array, (!), array, listArray )
import Data.Int ( Int64 )

m :: Int64
m = 1000000007

newtype MInt = MInt Int64 deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

toInt64 :: MInt -> Int64
toInt64 (MInt a) = a

solve :: IO()
solve = do
    n <- readLn :: IO Int
    c <- readMany :: IO [Int]
    b <- readMany :: IO [Int]
    q <- readLn :: IO Int
    x <- readMany :: IO [Int]
    let ans = fArray (-10^5, 10^5) getAns
        getAns :: Int -> MInt
        getAns x
            | chk <= 0   = allPoss
            | chk > sumC = 0
            | otherwise  = calc x
            where
                chk     = x * n + bss!n
                allPoss = product $ map ((1+) . fromIntegral) c
        sumC = sum c
        bss = listArray (1, n) $ scanl1 (+) $ scanl (+) 0 b
        calc x =
            sum [dp!(n, i) | i <- [0..sumC]]
            where
                dp :: Array (Int, Int) MInt
                dp = fArray ((1, 0), (n, sumC)) fillDp
                fillDp (i, j)
                    | j < i * x + bss!i  = 0
                    | i == 1 && j > ca!i = 0
                    | i == 1             = 1
                    | otherwise          = dpSum!(i - 1, j) - dpSum!(i - 1, max 0 (j - ca!i) - 1)
                ca = listArray (1, n) c
                dpSum = fArray ((1, -1), (n - 1, sumC)) fillDpSum
                fillDpSum (i, j)
                    | j < 0     = 0
                    | otherwise = dpSum!(i, j - 1) + dp!(i, j)
    putStr $ unlines $ map (show . toInt64 . (ans!)) x

fArray :: Ix i => (i, i) -> (i -> e) -> Array i e
fArray b f = array b [(i, f i) | i <- range b]

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

main :: IO ()
main = solve

import Data.Array ( Ix(range), Array, (!), array, listArray )
import Data.Int ( Int64 )

m :: Int64
m = 1000000007

newtype MInt = MInt Int64 deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

toInt64 :: MInt -> Int64
toInt64 (MInt a) = a

solve :: IO()
solve = do
    n <- readLn :: IO Int
    c <- readMany :: IO [Int]
    b <- readMany :: IO [Int]
    q <- readLn :: IO Int
    x <- readMany :: IO [Int]
    let ans = fArray (-10^5, 10^5) getAns
        getAns :: Int -> MInt
        getAns x
            | chk <= 0    = allPoss
            | chk >= sumC = 0
            | otherwise   = calc x
            where
                chk     = x * n + bss!n
                allPoss = product $ map ((1+) . fromIntegral) c
        sumC = sum c
        bss = listArray (1, n) $ scanl1 (+) $ scanl (+) 0 b
        calc x =
            sum [dp!(n, i) | i <- [0..sumC]]
            where
                dp :: Array (Int, Int) MInt
                dp = fArray ((1, 0), (n, sumC)) fillDp
                fillDp (i, j)
                    | j < i * x + bss!i  = 0
                    | i == 1 && j > ca!i = 0
                    | i == 1             = 1
                    | otherwise          = rowSum (i - 1) (max 0 (j - ca!i)) j
                ca = listArray (1, n) c
                rowSum i l r = dpSum!(i, r) - dpSum!(i, l - 1)
                dpSum = fArray ((1, -1), (n - 1, sumC)) fillDpSum
                fillDpSum (i, j)
                    | j == -1   = 0
                    | otherwise = dpSum!(i, j - 1) + dp!(i, j)
    putStr $ unlines $ map (show . toInt64 . (ans!)) x

fArray :: Ix i => (i, i) -> (i -> e) -> Array i e
fArray b f = array b [(i, f i) | i <- range b]

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

main :: IO ()
main = solve


You are given four positive integers $$$n$$$, $$$m$$$, $$$a$$$, $$$b$$$ ($$$1 \le b \le n \le 50$$$; $$$1 \le a \le m \le 50$$$). Find any such rectangular matrix of size $$$n \times m$$$ that satisfies all of the following conditions:  each row of the matrix contains exactly $$$a$$$ ones;  each column of the matrix contains exactly $$$b$$$ ones;  all other elements are zeros. If the desired matrix does not exist, indicate this.For example, for $$$n=3$$$, $$$m=6$$$, $$$a=2$$$, $$$b=1$$$, there exists a matrix satisfying the conditions above:$$$$$$ \begin{vmatrix} 0 & 1 & 0 & 0 & 0 & 1 \\ 1 & 0 & 0 & 1 & 0 & 0 \\ 0 & 0 & 1 & 0 & 1 & 0 \end{vmatrix} $$$$$$

The first line contains an integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case is described by four positive integers $$$n$$$, $$$m$$$, $$$a$$$, $$$b$$$ ($$$1 \le b \le n \le 50$$$; $$$1 \le a \le m \le 50$$$), where $$$n$$$ and $$$m$$$ are the sizes of the matrix, and $$$a$$$ and $$$b$$$ are the number of ones for rows and columns, respectively.

For each test case print:   "YES" (without quotes) and the required matrix (if there are several answers, print any) if it exists, or  "NO" (without quotes) if it does not exist.  To print the matrix $$$n \times m$$$, print $$$n$$$ rows, each of which consists of $$$m$$$ numbers $$$0$$$ or $$$1$$$ describing a row of the matrix. Numbers must be printed without spaces.

import           Data.List
import           Data.Array
import           Control.Monad
-- import           Debug.Trace

-- debug = flip trace

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c
        | length idxs /= b = Nothing
        | c == m = if all (== a) (elems rowcnts') then Just mat' else Nothing
        | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1 --`debug` show (elems rowcnts)
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List
main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [n, m, a, b] <- map read . words <$> getLine
        mapM putStrLn $ case solve n m b of
            (rowcnts, mats) | all (== a) rowcnts ->
                "YES" : map (concatMap show) (transpose mats)
            _ -> ["NO"]

solve :: Int -> Int -> Int -> ([Int], [[Int]])
solve n m b = mapAccumL go (replicate n 0) [1 .. m]  where
    go rowcnts c = (zipWith (+) row rowcnts, row)      where
        row =
            map fst
                $ sortOn snd
                $ zip (replicate b 1 ++ repeat 0)
                $ map fst
                $ sortOn snd
                $ zip [1 ..] rowcnts

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:a:b:_) <- map read . words <$> getLine
    if n * a == m * b
        then putStr $
             unlines $
             ("YES" :) $
             take n $ map (take m . (`drop` (cycle $ replicate a '1' ++ replicate (m - a) '0')) . (* a)) [0 ..]
        else putStrLn "NO"

import Control.Monad (replicateM_)
import Data.Char (intToDigit)
import qualified Data.Set as Set

readLine :: IO [Int]
readLine = (map read) . words <$> getLine

isPossible :: [Int] -> Bool
isPossible [n, m, a, b] = n * a == m * b

buildRow :: Int -> (Int, Int) -> [Int]
buildRow m (lo, hi) = [if inRange idx then 0 else 1 | idx <- [0..m-1]] where
    zeroIndices = Set.fromList [idx `mod` m | idx <- [lo..hi]]
    inRange idx = Set.member idx zeroIndices

buildMatrix :: [Int] -> [[Int]]
buildMatrix [n, m, a, b] =
    snd $ foldr (\ idx (range, matrix) -> (newRange range, newMatrix idx range matrix)) ((0, m - a - 1), [[]]) [0..n-1] where
        newMatrix idx range matrix = buildRow m range : matrix
        newRange (lo, hi) = (hi + 1, hi + m - a)

printMatrix :: [[Int]] -> IO ()
printMatrix (xs: [[]]) = putStrLn (map intToDigit xs)
printMatrix (xs: xss) = putStrLn (map intToDigit xs) >> printMatrix xss

printAns :: [Int] -> IO ()
printAns sizes =
    if not $ isPossible sizes then putStrLn "NO"
    else putStrLn "YES" >> printMatrix (buildMatrix sizes)

main =
    read <$> getLine >>= \t ->
    replicateM_ t (readLine >>= printAns)

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

readInput = map read . words <$> getLine

abMatrix :: [Int] -> [String]
abMatrix [n, m, a, b]
    | n * a /= m * b = ["NO"]
    | otherwise =
        "YES" : take n (iterate (offset m a) firstRow)
    where
        firstRow = replicate a '1' ++ replicate (m-a) '0'
        offset n k list = suf ++ pre where (pre, suf) = splitAt (n-k) list

main = do
    t <- read <$> getLine
    replicateM_ t (abMatrix <$> readInput >>= putStr.unlines)

--- frederick99, 6/2020
--- https://codeforces.com/contest/1360/problem/G

import Control.Monad ( replicateM_ )

abMatrix :: [Int] -> [String]
abMatrix [n, m, a, b]
    | n * a /= m * b = ["NO"]
    | otherwise =
        "YES" : take n (iterate (rotate a) firstRow)
    where
        firstRow = replicate a '1' ++ replicate (m-a) '0'
        rotate = drop <> take

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

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t (abMatrix <$> readInput >>= putStr.unlines)

import Data.Array (accumArray, Ix, Array, (!))

indicator :: (Ix a) => (a,a) -> [a] -> Array a Char
indicator bnds li = accumArray (\_ _ -> '1') '0' bnds (li `zip` repeat ())

soln :: Int -> Int -> Int -> Int -> String
soln n m a b
  | minimum [n, m, a, b] < 0  = "NO\n"
  | n * a /= m * b    = "NO\n"
  | a > m             = "NO\n"
  | n == 0 || m == 0  = "YES\n"
  | otherwise = "YES\n" ++ result  where
    baseLine = ((0,0) :) . takeWhile (/= (0,0)) . tail $ iterate stepD (0,0)
    stepD (x,y) = (rem (x+1) n, rem (y+1) m)
    k = quot (n*a) (length baseLine)
    bnds = ((0,0), (n-1,m-1))
    arr = indicator bnds [(rem (x+i) n, y)
                          | (x,y) <- baseLine, i <- [1..k]]
    result = unlines [[arr ! (i, j) | j <- [0..(m-1)]] | i <- [0..(n-1)]]

solveLine :: String -> String
solveLine line = case  map read $ words line  of
  [n, m, a, b] -> soln n m a b
  _ -> "bad format\n"

main :: IO ()
main = interact (concatMap solveLine . tail . lines)

import           Data.List
import           Data.Array
import           Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c | c > m = if all (== a) rowcnts' then Just mat else Nothing
                     | length idxs < b = Nothing
                     | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List
main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        [n, m, a, b] <- map read . words <$> getLine
        mapM putStrLn $ case solve n m b of
            (rowcnts, mats) | all (== a) rowcnts ->
                "YES" : map (concatMap show) mats
            _ -> ["NO"]

solve :: Int -> Int -> Int -> ([Int], [[Int]])
solve n m b = mapAccumL go (replicate n 0) [1 .. m]  where
    go rowcnts c = (zipWith (+) row rowcnts, row)      where
        row =
            map fst
                $ sortOn snd
                $ zip (replicate b 1 ++ repeat 0)
                $ map fst
                $ sortOn snd
                $ zip [1 ..] rowcnts

import           Data.List
import           Data.Array
import           Control.Monad

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c | c > m = if all (== a) rowcnts' then Just mat else Nothing
                     | length idxs /= b = Nothing
                     | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Data.List
import           Data.Array
import           Control.Monad
-- import           Debug.Trace

-- debug = flip trace

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- (map read . words <$> getLine) :: IO [Int]
        mapM putStrLn $ case solve n m a b of
            Just mat ->
                "YES"
                    : [ concatMap show [ mat ! (i, j) | j <- [1 .. m] ]
                      | i <- [1 .. n]
                      ]
            Nothing -> ["NO"]

-- solve :: Int -> Int -> Int -> Int -> Maybe (Array (Int, Int) Int)
solve n m a b = go
    (array (1, n) . zip [1 .. n] $ repeat 0)
    (array ((1, 1), (n, m)) [ ((i, j), 0) | i <- [1 .. n], j <- [1 .. m] ])
    1
  where
    go rowcnts mat c
        | c == m = if all (== a) (elems rowcnts') then Just mat' else Nothing
        | length idxs /= b = Nothing
        | otherwise = go rowcnts' mat' (c + 1)
      where
        idxs = take b . filter (\i -> (rowcnts ! i) < a) $ sortOn
            (rowcnts !)
            [1 .. n]
        rowcnts' = accum (+) rowcnts . zip idxs $ repeat 1 --`debug` show (elems rowcnts)
        mat'     = mat // [ ((idx, c), 1) | idx <- idxs ]

import           Control.Monad
import           Data.List

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n : m : a : b : _ <- map read . words <$> getLine
        let mat =
                [ [ if div i b == div j a then 1 else 0 | j <- [0 .. m - 1] ]
                | i <- [0 .. n - 1]
                ]
        mapM putStrLn
            $ if all ((== a) . sum) mat && all ((== b) . sum) (transpose mat)
                  then "YES" : map (concatMap show) mat
                  else ["NO"]

import Data.Array (accumArray, Ix, Array, (!))
import Data.List (intersperse)

indicator :: (Ix a) => (a,a) -> [a] -> Array a Char
indicator bnds li = accumArray (\_ _ -> '1') '0' bnds (li `zip` repeat ())

soln :: Int -> Int -> Int -> Int -> String
soln n m a b
  | minimum [n, m, a, b] < 0  = "NO\n"
  | n * a /= m * b    = "NO\n"
  | a > m             = "NO\n"
  | n == 0 || m == 0  = "YES\n"
  | otherwise = "YES\n" ++ unlines results  where
    baseLine = ((0,0) :) . takeWhile (/= (0,0)) . tail $ iterate stepD (0,0)
    stepD (x,y) = (rem (x+1) n, rem (y+1) m)
    k = quot (n*a) (length baseLine)
    bnds = ((0,0), (n-1,m-1))
    arr = indicator bnds [(rem (x+i) n, y)
                          | (x,y) <- baseLine, i <- [1..k]]
    results = [intersperse ' ' [arr ! (i, j) | j <- [0..(m-1)]]
                                             | i <- [0..(n-1)]]

solveLine :: String -> String
solveLine line = case  map read $ words line  of
  [n, m, a, b] -> soln n m a b
  _ -> "bad format\n"

main :: IO ()
main = interact (concatMap solveLine . tail . lines)


Timur has $$$n$$$ candies. The $$$i$$$-th candy has a quantity of sugar equal to $$$a_i$$$. So, by eating the $$$i$$$-th candy, Timur consumes a quantity of sugar equal to $$$a_i$$$.Timur will ask you $$$q$$$ queries regarding his candies. For the $$$j$$$-th query you have to answer what is the minimum number of candies he needs to eat in order to reach a quantity of sugar greater than or equal to $$$x_j$$$ or print -1 if it's not possible to obtain such a quantity. In other words, you should print the minimum possible $$$k$$$ such that after eating $$$k$$$ candies, Timur consumes a quantity of sugar of at least $$$x_j$$$ or say that no possible $$$k$$$ exists.Note that he can't eat the same candy twice and queries are independent of each other (Timur can use the same candy in different queries).

The first line of input contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$)  — the number of test cases. The description of test cases follows. The first line contains $$$2$$$ integers $$$n$$$ and $$$q$$$ ($$$1 \leq n, q \leq 1.5\cdot10^5$$$) — the number of candies Timur has and the number of queries you have to print an answer for respectively. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^4$$$) — the quantity of sugar in each of the candies respectively. Then $$$q$$$ lines follow.  Each of the next $$$q$$$ lines contains a single integer $$$x_j$$$ ($$$1 \leq x_j \leq 2 \cdot 10^9$$$) – the quantity Timur wants to reach for the given query. It is guaranteed that the sum of $$$n$$$ and the sum of $$$q$$$ over all test cases do not exceed $$$1.5 \cdot 10^5$$$.

For each test case output $$$q$$$ lines. For the $$$j$$$-th line output the number of candies Timur needs to eat in order to reach a quantity of sugar greater than or equal to $$$x_j$$$ or print -1 if it's not possible to obtain such a quantity.

NoteFor the first test case:For the first query, Timur can eat any candy, and he will reach the desired quantity.For the second query, Timur can reach a quantity of at least $$$10$$$ by eating the $$$7$$$-th and the $$$8$$$-th candies, thus consuming a quantity of sugar equal to $$$14$$$.For the third query, there is no possible answer.For the fourth query, Timur can reach a quantity of at least $$$14$$$ by eating the $$$7$$$-th and the $$$8$$$-th candies, thus consuming a quantity of sugar equal to $$$14$$$.For the second test case:For the only query of the second test case, we can choose the third candy from which Timur receives exactly $$$3$$$ sugar. It's also possible to obtain the same answer by choosing the fourth candy.

import Data.List (sortBy, findIndex)
import Data.Array
import Control.Monad (replicateM_, replicateM)

main :: IO ()
main = read <$> getLine >>= flip replicateM_ singleCase

singleCase :: IO ()
singleCase = map read . words <$> getLine >>=
             \([n, q]) -> map read . words <$> getLine >>=
             \as -> let pc = precompute n as in
                      replicateM_ q (read <$> getLine >>= print . ansQuery pc)

ansQuery :: Array Int Int -> Int -> Int
ansQuery xs n = case binSearch xs n of
                  Just i -> i
                  Nothing -> -1

invOrd :: (Ord a) => a -> a -> Ordering
invOrd x y = case compare x y of
               EQ -> EQ
               LT -> GT
               GT -> LT

precompute :: Int -> [Int] -> Array Int Int
precompute n as = let (s:ss) = sortBy invOrd as in
                    listArray (1, n) $ scanl (+) s ss

binSearch :: Array Int Int -> Int -> Maybe Int
binSearch a e = uncurry (binSearch' a e) (bounds a)

binSearch' :: Array Int Int -> Int -> Int -> Int -> Maybe Int
binSearch' a e i j | (e <= (a!i)) = Just i
                   | (e > (a!j))  = Nothing
                   | (j <= i+1)   = Just j
                   | otherwise = let middle = div (i+j) 2 in
                                   case compare e (a!middle) of
                                     EQ -> Just middle
                                     GT -> binSearch' a e (1+middle) j
                                     LT -> binSearch' a e i middle

import Data.List (sort)
import Data.Array ((!), listArray, Array)

readArr :: IO [Int]
readArr = (map (\s -> read s :: Int)) <$> (words <$> getLine)

pref :: Int -> [Int] -> [Int]
pref _ [] = []
pref s (x: xs) = (s + x: pref (s + x) xs)

findH :: Array Int Int -> Int -> Int -> Int -> Int
findH arr a l r = if l + 1 == r
  then r
  else let m = (l + r) `div` 2 in if arr ! m < a then findH arr a m r else findH arr a l m

find :: Array Int Int -> Int -> Int -> Int
find arr a n = let ans = findH arr a (-1) n in if ans == n then -1 else ans + 1

que :: Array Int Int -> Int -> Int-> IO ()
que _ _ 0 = pure ()
que arr n i = do
  a <- readLn :: IO Int
  print $ find arr a n
  que arr n (i - 1)

for :: Int -> IO ()
for 0 = pure ()
for i = do
  (n: q: _) <- readArr
  arr <- readArr
  que (listArray (0, n) (pref 0 (reverse $ (3000000000: sort arr)))) n q
  for $ i - 1

main :: IO ()
main = do
  t <- readLn :: IO Int
  for t


Oh, New Year. The time to gather all your friends and reflect on the heartwarming events of the past year...$$$n$$$ friends live in a city which can be represented as a number line. The $$$i$$$-th friend lives in a house with an integer coordinate $$$x_i$$$. The $$$i$$$-th friend can come celebrate the New Year to the house with coordinate $$$x_i-1$$$, $$$x_i+1$$$ or stay at $$$x_i$$$. Each friend is allowed to move no more than once.For all friends $$$1 \le x_i \le n$$$ holds, however, they can come to houses with coordinates $$$0$$$ and $$$n+1$$$ (if their houses are at $$$1$$$ or $$$n$$$, respectively).For example, let the initial positions be $$$x = [1, 2, 4, 4]$$$. The final ones then can be $$$[1, 3, 3, 4]$$$, $$$[0, 2, 3, 3]$$$, $$$[2, 2, 5, 5]$$$, $$$[2, 1, 3, 5]$$$ and so on. The number of occupied houses is the number of distinct positions among the final ones.So all friends choose the moves they want to perform. After that the number of occupied houses is calculated. What is the minimum and the maximum number of occupied houses can there be?

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of friends. The second line contains $$$n$$$ integers $$$x_1, x_2, \dots, x_n$$$ ($$$1 \le x_i \le n$$$) — the coordinates of the houses of the friends.

Print two integers — the minimum and the maximum possible number of occupied houses after all moves are performed.

NoteIn the first example friends can go to $$$[2, 2, 3, 3]$$$. So friend $$$1$$$ goes to $$$x_1+1$$$, friend $$$2$$$ stays at his house $$$x_2$$$, friend $$$3$$$ goes to $$$x_3-1$$$ and friend $$$4$$$ goes to $$$x_4-1$$$. $$$[1, 1, 3, 3]$$$, $$$[2, 2, 3, 3]$$$ or $$$[2, 2, 4, 4]$$$ are also all valid options to obtain $$$2$$$ occupied houses.For the maximum number of occupied houses friends can go to $$$[1, 2, 3, 4]$$$ or to $$$[0, 2, 4, 5]$$$, for example.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.List
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

countMoves :: [Int] -> (Int, Int)
countMoves xs = let (mn, mx) = foldl' (\(mn, mx) x -> (min' mn x, max' mx x)) (mempty, mempty) xs
                in (IntSet.size mn, IntSet.size mx)
  where
    min' m x | any (`IntSet.member` m) [x - 1, x, x + 1] = m -- Move to occupied house, if possible
             | otherwise = IntSet.insert (x + 1) m
    max' m x | Just x' <- find (`IntSet.notMember` m) [x - 1, x, x + 1] = IntSet.insert x' m  -- Move to unoccupied house
             | otherwise = m  -- Must move to occupied house

main = do
    n :: Int <- fmap read getLine
    xs <- fmap (sort . fmap read . words) getLine
    let (mn, mx) = countMoves xs
    putStr (show mn)
    putChar ' '
    putStrLn (show mx)

import Data.List

solvem []     last acc = acc
solvem (x:xs) last acc = solvem xs last' acc'
  where (last', acc') = if abs (x - last) <= 1 then (last, acc) else (x+1, acc+1)

solveM []     last acc = acc
solveM (x:xs) last acc = solveM xs last' acc'
  where (last', acc') = if last+1 > x+1 then (last, acc) else (nxt, acc+1)
        nxt = max (last+1) (x-1)

main :: IO ()
main = do
  getLine
  xs <- sort . map read . words <$> getLine
  putStrLn $ show (solvem xs 1000000 0) ++ " " ++ show (solveM xs (-1000000) 0)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.List
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

countMoves :: [Int] -> (Int, Int)
countMoves xs = let (mn, mx) = foldl' (\(mn, mx) x -> (min' mn x, max' mx x)) (mempty, mempty) xs
                in (IntSet.size mn, IntSet.size mx)
  where
    min' m x | any (`IntSet.member` m) [x - 1, x, x + 1] = m -- Move to occupied house, if possible
             | otherwise = IntSet.insert x m
    max' m x | Just x' <- find (`IntSet.notMember` m) [x - 1, x, x + 1] = IntSet.insert x' m  -- Move to unoccupied house
             | otherwise = m  -- Must move to occupied house

main = do
    n :: Int <- fmap read getLine
    xs <- fmap (sort . fmap read . words) getLine
    let (mn, mx) = countMoves xs
    putStr (show mn)
    putChar ' '
    putStrLn (show mx)

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Data.List
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

countMoves :: [Int] -> (Int, Int)
countMoves xs = let (mn, mx) = foldl' (\(mn, mx) x -> (min' mn x, max' mx x)) (mempty, mempty) xs
                in (length mn, length mx)
  where
    min' m x | any (`elem` m) [x - 1, x, x + 1] = m -- Move to occupied house, if possible
             | otherwise = insert x m
    max' m x | Just x' <- find (`notElem` m) [x - 1, x, x + 1] = insert x' m  -- Move to unoccupied house
             | otherwise = m

main = do
    n :: Int <- fmap read getLine
    xs <- fmap (fmap read . words) getLine
    let (mn, mx) = countMoves xs
    putStr (show mn)
    putChar ' '
    putStrLn (show mx)