The 2050 volunteers are organizing the "Run! Chase the Rising Sun" activity. Starting on Apr 25 at 7:30 am, runners will complete the 6km trail around the Yunqi town.There are $$$n+1$$$ checkpoints on the trail. They are numbered by $$$0$$$, $$$1$$$, ..., $$$n$$$. A runner must start at checkpoint $$$0$$$ and finish at checkpoint $$$n$$$. No checkpoint is skippable — he must run from checkpoint $$$0$$$ to checkpoint $$$1$$$, then from checkpoint $$$1$$$ to checkpoint $$$2$$$ and so on. Look at the picture in notes section for clarification.Between any two adjacent checkpoints, there are $$$m$$$ different paths to choose. For any $$$1\le i\le n$$$, to run from checkpoint $$$i-1$$$ to checkpoint $$$i$$$, a runner can choose exactly one from the $$$m$$$ possible paths. The length of the $$$j$$$-th path between checkpoint $$$i-1$$$ and $$$i$$$ is $$$b_{i,j}$$$ for any $$$1\le j\le m$$$ and $$$1\le i\le n$$$.To test the trail, we have $$$m$$$ runners. Each runner must run from the checkpoint $$$0$$$ to the checkpoint $$$n$$$ once, visiting all the checkpoints. Every path between every pair of adjacent checkpoints needs to be ran by exactly one runner. If a runner chooses the path of length $$$l_i$$$ between checkpoint $$$i-1$$$ and $$$i$$$ ($$$1\le i\le n$$$), his tiredness is $$$$$$\min_{i=1}^n l_i,$$$$$$ i. e. the minimum length of the paths he takes.Please arrange the paths of the $$$m$$$ runners to minimize the sum of tiredness of them.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10\,000$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \leq n,m \leq 100$$$). The $$$i$$$-th of the next $$$n$$$ lines contains $$$m$$$ integers $$$b_{i,1}$$$, $$$b_{i,2}$$$, ..., $$$b_{i,m}$$$ ($$$1 \le b_{i,j} \le 10^9$$$). It is guaranteed that the sum of $$$n\cdot m$$$ over all test cases does not exceed $$$10^4$$$.

For each test case, output $$$n$$$ lines. The $$$j$$$-th number in the $$$i$$$-th line should contain the length of the path that runner $$$j$$$ chooses to run from checkpoint $$$i-1$$$ to checkpoint $$$i$$$. There should be exactly $$$m$$$ integers in the $$$i$$$-th line and these integers should form a permuatation of $$$b_{i, 1}$$$, ..., $$$b_{i, m}$$$ for all $$$1\le i\le n$$$. If there are multiple answers, print any.

NoteIn the first case, the sum of tiredness is $$$\min(2,5) + \min(3,3) + \min(4,1) = 6$$$.  In the second case, the sum of tiredness is $$$\min(2,4,3) + \min(3,1,5) = 3$$$.

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

putInts :: [Int] -> Builder
putInts xs = (mconcat $ intersperse (charUtf8 ' ') $ map intDec xs) `mappend` (charUtf8 '\n')

translate :: Int -> [(Int, Int)] -> [[Int]]
translate n pairs = elems $ accumArray (flip (:)) [] (1, n) $ map (\(a, b) -> (b, a)) pairs

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n, m] <- getInts
    let getRow i = flip zip (repeat i) <$> getInts
    (targets, rests) <- splitAt m . sort . concat <$> forM [1..n] getRow
    let [ts, rs] = map (translate n) [targets, rests]
        posTargets = flip zip ts $ scanl' (+) 0 $ map length ts
        merge (pos, xs) ys = as ++ xs ++ bs
          where (as, bs) = splitAt pos ys
        results = zipWith merge posTargets rs
    return $ mconcat $ map putInts results
  hPutBuilder stdout output

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

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Array((!))
import Control.Monad(replicateM)

import Data.Maybe

makeOcc (x:xs) = let m = makeOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
makeOcc [] = M.empty

solve :: Integer -> Integer -> [[Integer]] -> [[Integer]]
solve n m b = aux b' where
	b' = fmap makeOcc b

	aux :: [M.Map Integer Integer] -> [[Integer]]
	aux mL | null $ mL !! 0 = []
	aux mL = let (mL', l) = generatePatch mL in l : aux mL'

	generatePatch :: [M.Map Integer Integer] -> ([M.Map Integer Integer], [Integer])
	generatePatch mL = (fmap delete $ zip mL choice, choice) where
		minBy = zip [0..] $ fmap (fst . M.findMin) mL
		maxBy = zip [0..] $ fmap (fst . M.findMax) mL

		iMin = fromJust $ foldr aux Nothing minBy where
			aux (i, v) Nothing = Just (i, v)
			aux (i, v) (Just (i', v'))
				| v > v' = Just (i', v')
				| otherwise = Just (i, v)

		choice = aux maxBy where
			aux ((i, v):l)
				| i == fst iMin = snd iMin : aux l
				| otherwise = v : aux l
			aux [] = []

		delete (set, v) = case M.lookup v set of
			Just 1 -> M.delete v set
			Just i -> M.insert v (i-1) set

showR :: [[Integer]] -> String
showR list | length (head list) == 0 = ""
showR list = foldr (\i l -> show i++" "++l) "\n" (fmap head list) ++ showR (fmap tail list)

main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n, m] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		b <- replicateM (fromInteger n) (getLine >>= return . (fmap read) . words) :: IO [[Integer]]
		putStr $ showR $ solve n m b


In order to write a string, Atilla needs to first learn all letters that are contained in the string.Atilla needs to write a message which can be represented as a string $$$s$$$. He asks you what is the minimum alphabet size required so that one can write this message.The alphabet of size $$$x$$$ ($$$1 \leq x \leq 26$$$) contains only the first $$$x$$$ Latin letters. For example an alphabet of size $$$4$$$ contains only the characters $$$\texttt{a}$$$, $$$\texttt{b}$$$, $$$\texttt{c}$$$ and $$$\texttt{d}$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 100$$$) — the length of the string. The second line of each test case contains a string $$$s$$$ of length $$$n$$$, consisting of lowercase Latin letters.

For each test case, output a single integer — the minimum alphabet size required to so that Atilla can write his message $$$s$$$.

5

1

a

4

down

10

codeforces

3

bcf

5

zzzzz

NoteFor the first test case, Atilla needs to know only the character $$$\texttt{a}$$$, so the alphabet of size $$$1$$$ which only contains $$$\texttt{a}$$$ is enough.For the second test case, Atilla needs to know the characters $$$\texttt{d}$$$, $$$\texttt{o}$$$, $$$\texttt{w}$$$, $$$\texttt{n}$$$. The smallest alphabet size that contains all of them is $$$23$$$ (such alphabet can be represented as the string $$$\texttt{abcdefghijklmnopqrstuvw}$$$).

import Data.List (sort)
import Data.Char (ord)

diff :: [Int] -> Int
diff v = last v - ord 'a' + 1

solve :: String -> Int
solve = diff . sort . map (ord)

everyOther [] = []
everyOther (_ : x : xs) = (x : everyOther xs)

main = interact $
  unlines . map (show . solve) . everyOther . drop 1 . lines


You are given two integers $$$x$$$ and $$$y$$$. You want to choose two strictly positive (greater than zero) integers $$$a$$$ and $$$b$$$, and then apply the following operation to $$$x$$$ exactly $$$a$$$ times: replace $$$x$$$ with $$$b \cdot x$$$.You want to find two positive integers $$$a$$$ and $$$b$$$ such that $$$x$$$ becomes equal to $$$y$$$ after this process. If there are multiple possible pairs, you can choose any of them. If there is no such pair, report it.For example:   if $$$x = 3$$$ and $$$y = 75$$$, you may choose $$$a = 2$$$ and $$$b = 5$$$, so that $$$x$$$ becomes equal to $$$3 \cdot 5 \cdot 5 = 75$$$;  if $$$x = 100$$$ and $$$y = 100$$$, you may choose $$$a = 3$$$ and $$$b = 1$$$, so that $$$x$$$ becomes equal to $$$100 \cdot 1 \cdot 1 \cdot 1 = 100$$$;  if $$$x = 42$$$ and $$$y = 13$$$, there is no answer since you cannot decrease $$$x$$$ with the given operations.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case consists of one line containing two integers $$$x$$$ and $$$y$$$ ($$$1 \le x, y \le 100$$$).

If it is possible to choose a pair of positive integers $$$a$$$ and $$$b$$$ so that $$$x$$$ becomes $$$y$$$ after the aforementioned process, print these two integers. The integers you print should be not less than $$$1$$$ and not greater than $$$10^9$$$ (it can be shown that if the answer exists, there is a pair of integers $$$a$$$ and $$$b$$$ meeting these constraints). If there are multiple such pairs, print any of them. If it is impossible to choose a pair of integers $$$a$$$ and $$$b$$$ so that $$$x$$$ becomes $$$y$$$, print the integer $$$0$$$ twice.

import Control.Monad
import Data.List

solve (x, y) = if y `rem` x == 0 then (1, y `quot` x) else (0, 0)

main = do
  t <- readInt
  lines <- replicateM t getLine
  let cases = map decodeLine lines
  putStrLn $ intercalate "\n" $ map (\x -> encodeLine $ solve x) cases

-- Just IO
readInt = do
  line <- getLine
  return (read line :: Int)

decodeLine line = (read x :: Int, read y :: Int)
  where (x, y) = break (==' ') line

encodeLine (x, y) = show x ++ " " ++ show y

isInt x = x == fromInteger (round x)

test2 :: Double -> Double -> String
test2 n0 n1
  | isInt (n1 / n0) = "1 " ++ (show.floor) (n1 / n0)
  | 0<1 = "0 0"

test :: [Double] -> String
test [] = ""
test ints =
  let n0 = head ints
      n1 = head $ tail ints
    in test2 n0 n1 ++ "\n" ++ (test ((tail.tail) ints))
main = do
  ip <- getContents
  let ints = map read $ tail $ words ip
    in putStrLn $ test ints


Ohana Matsumae is trying to clean a room, which is divided up into an n by n grid of squares. Each square is initially either clean or dirty. Ohana can sweep her broom over columns of the grid. Her broom is very strange: if she sweeps over a clean square, it will become dirty, and if she sweeps over a dirty square, it will become clean. She wants to sweep some columns of the room to maximize the number of rows that are completely clean. It is not allowed to sweep over the part of the column, Ohana can only sweep the whole column.Return the maximum number of rows that she can make completely clean.

The first line of input will be a single integer n (1 ≤ n ≤ 100). The next n lines will describe the state of the room. The i-th line will contain a binary string with n characters denoting the state of the i-th row of the room. The j-th character on this line is '1' if the j-th square in the i-th row is clean, and '0' if it is dirty.

The output should be a single line containing an integer equal to a maximum possible number of rows that are completely clean.

NoteIn the first sample, Ohana can sweep the 1st and 3rd columns. This will make the 1st and 4th row be completely clean.In the second sample, everything is already clean, so Ohana doesn't need to do anything.

import Data.List

main = getContents >>= putStrLn . show . solve . tail . lines

solve :: [String] -> Int
solve = foldl1 max . map length . group . sort

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

main :: IO ()
main = print =<< sol . lines <$> (getLine *> getContents)

sol :: [String] -> Int
sol xs = length $ filter (==mx) xs
  where
  cnt x = length . filter (==True) $ map (==x) xs
  mx = maximumBy (comparing cnt) xs

import Data.List

solve :: [String] -> Int
solve = maximum . map length . group . sort

main = do
    n <- fmap read getLine
    ss <- mapM (\_ -> getLine) [1..n]
    print $ solve ss

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

main = do
  n <- read <$> getLine
  cols <- transpose . map (map (== '1')) <$> replicateM n getLine
  print $ maxClean cols

multiFilter (True:xs) xss = zipWith (:) (map head xss) (multiFilter xs (map tail xss))
multiFilter (False:xs) xss = multiFilter xs (map tail xss)
multiFilter [] _ = repeat []

maxClean ([]:_) = 0
maxClean [xs] = let k = length . filter id $ xs in max k (length xs - k)
maxClean (xs:xss) = max (maxClean (multiFilter xs xss)) (maxClean (multiFilter (map not xs) xss))
maxClean [] = 0

import Data.List
main = interact $ show . solve . tail . lines
solve = maximum . map length . group . sort

import Data.List (group, sort)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)

main = read <$> getLine >>= (flip replicateM) getLine >>= print . f
    where f = (last . sort) . (map length) . (group . sort)

import Data.List (group, sort)
import Control.Applicative ((<$>))
import Control.Monad (replicateM)

main = read <$> getLine >>= (flip replicateM) getLine >>= print . f
    where f = last . sort . map length . group . sort

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

main :: IO ()
main = print =<< sol . lines <$> (getLine *> getContents)

sol :: [String] -> Int
sol xs = length . filter (=='1') $ maximumBy (comparing f) xs
  where
  f x = foldr (\y ac -> ac+if x==y then 1 else 0) 0 xs


You are given an array of n elements, you must make it a co-prime array in as few moves as possible.In each move you can insert any positive integral number you want not greater than 109 in any place in the array.An array is co-prime if any two adjacent numbers of it are co-prime.In the number theory, two integers a and b are said to be co-prime if the only positive integer that divides both of them is 1.

The first line contains integer n (1 ≤ n ≤ 1000) — the number of elements in the given array. The second line contains n integers ai (1 ≤ ai ≤ 109) — the elements of the array a.

Print integer k on the first line — the least number of elements needed to add to the array a to make it co-prime. The second line should contain n + k integers aj — the elements of the array a after adding k elements to it. Note that the new array should be co-prime, so any two adjacent values should be co-prime. Also the new array should be got from the original array a by adding k elements to it. If there are multiple answers you can print any one of them.

main :: IO ()
main = do
  c <- getContents
  let l = (map (read :: String -> Int) . tail . words) c
  let (a,b) = f l
  putStrLn . show $ a
  putStrLn . unwords. map show $ b

f :: [Int] -> (Int, [Int])
f q@([])     = (0,q)
f q@(x:[])   = (0,q)
f (x1:x2:xs) = if gcd x1 x2 == 1 then (a, x1:b) else (a+1, x1:1:b) where (a,b) = f (x2:xs)

import Data.Functor

main :: IO()
main = do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    let b = solve a
    print $ (length b) - n
    putStrLn $ unwords $ map show b

solve :: [Int] -> [Int]
solve [] = []
solve [a] = [a]
solve (a:b:s) | gcd a b > 1 = a:1:solve (b:s)
              | otherwise = a:solve (b:s)

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let ans = solve a
    print $ (length ans - n)
    putStrLn . unwords . map show $ ans

solve :: [Int] -> [Int]
solve [x] = [x]
solve (x:y:xs)
 |gcd x y == 1 = x:solve (y:xs)
 |otherwise = x:1:solve (y:xs)

import Data.Int (Int64)

main = do
  getLine
  as <- fmap (map read . words) getLine :: IO [Int64]

  let
    f [a] = [a]
    f (a:b:as)
      | gcd a b == 1 = a:(f (b:as))
      | otherwise = a:d:(f (b:as))
        where d = head [d | d <- [1..], gcd a d == 1, gcd d b == 1]

    as' = f as

  print $ length as' - length as
  putStrLn $ unwords $ map show as'

import Data.Char

main = do
	line <- getLine
	let (n:xs) = getInts 1 line
	line <- getLine
	let ps = getInts n line
	let answer = ans ps []
	let k = length answer - n
	putStrLn $ show k
	putStrLn $ foldr1 (\ x st -> st ++ " " ++ x) $ map (show) $ answer

getInts :: Int -> String -> [Int]

getInts 0 _ = []
getInts _ [] = []
getInts x str = map stringToInt $ take x $ words str

stringToInt :: String -> Int

stringToInt str = read str :: Int

ans :: (Integral a) => [a] -> [a] -> [a]

ans [] ret = ret
ans (f:fs) [] = ans fs [f]
ans (f:fs) ret@(s:retms)
	| gcd f s == 1 = ans fs (f:ret)
	| otherwise = ans fs (f:1:ret)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE BangPatterns #-}
-- {-# LANGUAGE ViewPatterns #-}
-- {-# LANGUAGE TupleSections #-}

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Array.ST
-- import           Data.Array.Unsafe
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntMap.Strict (IntMap)
-- import qualified Data.IntMap.Strict as IntMap
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S

out = stdout

main = do
  _ <- readInt1 <$> BS.getLine
  ns <- readIntN <$> BS.getLine
  putAns out . makeTable $ solve ns

solve :: [Int] -> (Int,[Int])
solve ns = go 0 [] ns where
  go :: Int -> [Int] -> [Int] -> (Int,[Int])
  go c ms [y] = (c,reverse (y:ms))
  go c ms (x:y:ns) = if coPrime x y
    then go c (x:ms) (y:ns)
    else go (c+1) (1:x:ms) (y:ns)

coPrime :: Int -> Int -> Bool
coPrime m n = if m >= n then coprime m n else coprime n m where
  coprime m 0 = m == 1
  coprime m n = coprime n (m`mod`n)

makeTable :: (Int,[Int]) -> Table
makeTable (c,ns) = [OneR (IntC c), ListR (map (\s -> IntC s) ns)]

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

toTriple :: [a] -> (a, a, a)
toTriple [x, y, z] =(x, y, z)

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

fromTriple :: (a, a, a) -> [a]
fromTriple (x, y, z) = [x, y, z]

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

-- output functions

data Cell  = ByteStringC BL.ByteString
           | IntC Int
           | Int64C Int64
           deriving( Eq, Ord, Show )

data Row   = ListR [Cell]
           | OneR Cell
           | TupleR (Cell,Cell)
           | TripleR (Cell,Cell,Cell)
           deriving( Eq, Ord, Show )

type Table = [Row]

infixr 4 <>
(<>) :: Monoid m => m -> m -> m
(<>) = mappend

putAns :: Handle -> Table -> IO ()
putAns o = hPutBuilder o . renderTable

renderTable :: Table -> Builder
renderTable rs = mconcat [renderRow r <> char8 '\n' | r <- rs]

renderRow :: Row -> Builder
renderRow (ListR []) = mempty
renderRow (ListR (c:cs)) = renderCell c <> mconcat [ char8 ' ' <> renderCell c' | c' <- cs ]
renderRow (OneR x) = renderCell x
renderRow (TupleR (x,y)) = renderCell x <> char8 ' ' <> renderCell y
renderRow (TripleR (x,y,z)) = renderCell x <> char8 ' ' <> renderCell y <> char8 ' ' <> renderCell z

renderCell :: Cell -> Builder
renderCell (ByteStringC cs) = lazyByteString cs
renderCell (IntC i) = intDec i
renderCell (Int64C i) = int64Dec i

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b >1 = a:1:(process (b:c))
		| otherwise = a:(process (b:c))

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x - (length n)
	putStrLn $ intercalate " " $ map show x

import Data.List

make_prime::[Int] -> [Int]
make_prime (x:y:xy) =
    if (gcd x y) /= 1
        then x:1:(make_prime (y:xy))
        else x:(make_prime (y:xy))

make_prime [] = []
make_prime (x:[]) = [x]

main = do
    n <- readInt
    numbers <- (map (\x -> (read x)::Int)) <$> (words) <$> (getLine)
    let ans = map show (make_prime numbers)
    print (length ans - n)
    putStrLn (unwords ans)

readToken :: IO String
readToken = do
    x <- getChar
    if x == ' ' || x == '\n'
        then return ""
        else (x:) <$> readToken

readInt :: IO Int
readInt = do
    x <- readToken
    return ((read x)::Int)

main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let ans = solve a
    print . length $ a
    putStrLn . unwords . map show $ ans

solve :: [Int] -> [Int]
solve [x] = [x]
solve (x:y:xs)
 |gcd x y == 1 = x:solve (y:xs)
 |otherwise = x:1:solve (y:xs)

main = do
  getLine
  as <- fmap (map read . words) getLine

  let
    f [a] = [a]
    f (a:b:as)
      | gcd a b == 1 = a:(f (b:as))
      | otherwise = a:d:(f (b:as))
      where d = head [d | d <- [1..], a `mod` d /= 0, b `mod` d /= 0]

    as' = f as

  print $ length as' - length as
  putStrLn $ unwords $ map show as'

import Data.Char

main = do
	line <- getLine
	let (n:xs) = getInts 1 line
	line <- getLine
	let ps = getInts n line
	putStrLn $ foldr1 (\ x st -> st ++ " " ++ x) $ map (show) $ ans ps []

getInts :: Int -> String -> [Int]

getInts 0 _ = []
getInts _ [] = []
getInts x str = map stringToInt $ take x $ words str

stringToInt :: String -> Int

stringToInt str = read str :: Int

ans :: (Integral a) => [a] -> [a] -> [a]

ans [] ret = ret
ans (f:fs) [] = ans fs [f]
ans (f:fs) ret@(s:retms)
	| gcd f s == 1 = ans fs (f:ret)
	| otherwise = ans fs (f:1:ret)

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I
import qualified Data.Map as M

main=do
	getLine
	n<-    map read.words <$>getLine ::IO [Int]
	print 1
	putStrLn $ intercalate " "$ map show $ [head n , ((head n)+1)] ++ (tail n)

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b ==1 = a:1:(process (b:c))
		| otherwise = process (b:c)

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x
	putStrLn $ intercalate " " $ map show x

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

process [] = []
process [a] = [a]
process (a:b:c) | gcd a b ==1 = a:1:(process (b:c))
		| otherwise = a:(process (b:c))

main=do
	getLine
	n<-    map read <$> words <$>getLine ::IO [Int]
	let x=	process n
	print $ length x - (length n)
	putStrLn $ intercalate " " $ map show x

import Data.List

make_prime::[Int] -> [Int]
make_prime (x:y:xy) =
    if (gcd x y) /= 1
        then x:1:(make_prime (y:xy))
        else x:(make_prime (y:xy))

make_prime [] = []
make_prime (x:[]) = [x]

main = do
    n <- readInt
    numbers <- (map (\x -> (read x)::Int)) <$> (words) <$> (getLine)
    let ans = map show (make_prime numbers)
    print (length ans - n)
    print (unwords ans)

readToken :: IO String
readToken = do
    x <- getChar
    if x == ' ' || x == '\n'
        then return ""
        else (x:) <$> readToken

readInt :: IO Int
readInt = do
    x <- readToken
    return ((read x)::Int)


Yaroslav has an array that consists of n integers. In one second Yaroslav can swap two neighboring array elements. Now Yaroslav is wondering if he can obtain an array where any two neighboring elements would be distinct in a finite time.Help Yaroslav.

The first line contains integer n (1 ≤ n ≤ 100) — the number of elements in the array. The second line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 1000) — the array elements.

In the single line print "YES" (without the quotes) if Yaroslav can obtain the array he needs, and "NO" (without the quotes) otherwise.

NoteIn the first sample the initial array fits well.In the second sample Yaroslav can get array: 1, 2, 1. He can swap the last and the second last elements to obtain it.In the third sample Yarosav can't get the array he needs.

import Control.Applicative
import Control.Arrow
import Data.List

main = do
    n <- read <$> getLine
    let m = if even n then n `div` 2 else n `div` 2 + 1
    b <- (words >>> sort >>> group >>> map ((<=m).length) >>> and ) <$> getLine
    let s = (if b then "YES" else "NO")
    putStrLn s

import Data.List

main = do
    x <- getLine
    x <- getLine
    putStrLn $ f $ sort $ words $ x

f :: [String] -> String
f ws =  if (val <= (div len 2) + (mod len 2)) then "YES" else "NO"
        where
            len = length ws
            val = maximum $ map length $ group ws

import Data.Ord (comparing)
import Data.List
import Data.Tuple (fst)

main = do
    x <- getLine
    x <- getLine
    putStrLn $ f x

f :: String -> String
f x =   if (val <= (div len 2) + (mod len 2))
        then "YES"
        else "NO"
        where
            ws = sort $ words $ x
            len = length ws
            val = fst $ maximumBy (comparing fst) $ map (\x -> (length x, head x)) $ group ws

main = interact $ go . (map read) . concat . (map words) . lines
go (n:s) | maximum cnt > (div n 2)+(mod n 2) = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

main = interact $ go . (map read) . concat . (map words) . lines
go (n:s) | maximum cnt > div (n+1) 2 = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

import Control.Monad (liftM, unless, when)
import Data.List (group, sort)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> Bool
solve xs  =  (<= m) $ maximum $ map length $ group $ sort xs
  where
    n  =  length xs
    m  =  n `div` 2 + n `mod` 2

main :: IO ()
main  =  do
    getLine
    xs  <-  reads
    when (solve xs) $
        putStrLn "YES"
    unless (solve xs) $
        putStrLn "NO"

import Data.List

main = do
    _ <- getLine
    ns <- (return.map read.words =<< getLine :: IO [Int])
    putStrLn.judge $ answer ns where
        judge True = "YES"
        judge False = "NO"

answer :: [Int] -> Bool
answer ns = maxN <= (length ns - maxN+1) where
    maxN = maxLength ns

maxLength = foldl max 0.map length.group.qsort

qsort :: [Int] -> [Int]
qsort [] = []
qsort (x:xs) = qsort small ++ [x] ++ qsort big where
    small = [z| z <- xs, z <= x ]
    big = [z | z <- xs , z > x]

import Data.List

main =
  interact $ f . solve . map (map read . words) . lines
  where f True = "YES"
        f False = "NO"

solve :: [[Int]] -> Bool
solve (_:nums:_) =
  let maxLen = maximum $ map length $ group $ sort nums
      n = length nums
  in case n `mod` 2 of
      0 -> maxLen <= n `quot` 2
      1 -> maxLen <= (n `quot` 2) + 1

import Data.List
main=interact$f.map read.words
f[_,_]="YES"
f[_,x,y]|x==y="NO"|0<1="YES"
f(n:x)|l<-maximum.map length.group$sort x,l<=div(n+1)2="YES"|0<1="NO"

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ reverse $ sort $ map length $ group $ sort s
	putStrLn $ if odd ls then (if  (2*k-2<=ls) then "YES" else "NO") else (if (2*k-1<=ls) then "YES" else "NO")

main = interact $ go . (map read) . words . concat . lines
go (n:s) | maximum cnt > (div n 2)+(mod n 2) = "NO"
         | otherwise = "YES"
         where cnt = map (\x -> length $ filter (==x) s) [1..1000]

import Control.Monad (liftM, unless, when)
import Data.List (group)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> Bool
solve xs  =  (<= m) $ maximum $ map length $ group xs
  where
    n  =  length xs
    m  =  n `div` 2 + n `mod` 2

main :: IO ()
main  =  do
    getLine
    xs  <-  reads
    when (solve xs) $
        putStrLn "YES"
    unless (solve xs) $
        putStrLn "NO"

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ reverse $ sort $ map length $ group $ sort s
	putStrLn $ if (2*k-2<=ls) then "YES" else "NO"

import Control.Applicative
import Data.Char
import Data.List

main= do
	getLine
 	s<-map read . words <$> getContents ::IO [Int]
	let ls =length s
	let k = head $ sort $ map length $ group $ sort s
	putStrLn $ if (2*k-2<=ls) then "YES" else "NO"


The great hero guards the country where Homer lives. The hero has attack power $$$A$$$ and initial health value $$$B$$$. There are $$$n$$$ monsters in front of the hero. The $$$i$$$-th monster has attack power $$$a_i$$$ and initial health value $$$b_i$$$. The hero or a monster is said to be living, if his or its health value is positive (greater than or equal to $$$1$$$); and he or it is said to be dead, if his or its health value is non-positive (less than or equal to $$$0$$$).In order to protect people in the country, the hero will fight with monsters until either the hero is dead or all the monsters are dead.  In each fight, the hero can select an arbitrary living monster and fight with it. Suppose the $$$i$$$-th monster is selected, and the health values of the hero and the $$$i$$$-th monster are $$$x$$$ and $$$y$$$ before the fight, respectively. After the fight, the health values of the hero and the $$$i$$$-th monster become $$$x-a_i$$$ and $$$y-A$$$, respectively. Note that the hero can fight the same monster more than once.For the safety of the people in the country, please tell them whether the great hero can kill all the monsters (even if the great hero himself is dead after killing the last monster).

Each test contains multiple test cases. The first line contains $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains three integers $$$A$$$ ($$$1 \leq A \leq 10^6$$$), $$$B$$$ ($$$1 \leq B \leq 10^6$$$) and $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the attack power of the great hero, the initial health value of the great hero, and the number of monsters. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \leq a_i \leq 10^6$$$), where $$$a_i$$$ denotes the attack power of the $$$i$$$-th monster. The third line of each test case contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \leq b_i \leq 10^6$$$), where $$$b_i$$$ denotes the initial health value of the $$$i$$$-th monster. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print the answer: "YES" (without quotes) if the great hero can kill all the monsters. Otherwise, print "NO" (without quotes).

NoteIn the first example: There will be $$$6$$$ fights between the hero and the only monster. After that, the monster is dead and the health value of the hero becomes $$$17 - 6 \times 2 = 5 > 0$$$. So the answer is "YES", and moreover, the hero is still living.In the second example: After all monsters are dead, the health value of the hero will become $$$709$$$, regardless of the order of all fights. So the answer is "YES".In the third example: A possible order is to fight with the $$$1$$$-st, $$$2$$$-nd, $$$3$$$-rd and $$$4$$$-th monsters. After all fights, the health value of the hero becomes $$$-400$$$. Unfortunately, the hero is dead, but all monsters are also dead. So the answer is "YES".In the fourth example: The hero becomes dead but the monster is still living with health value $$$1000 - 999 = 1$$$. So the answer is "NO".

chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

showBool True  = "YES"
showBool False = "NO"

uncurry5 f (a,b,c,d,e) = f a b c d e

getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read
          [a,b,n] =  map toInteger (words abn)

teto n d = 1 + (n - 1) `div` d

process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

showBool True  = "YES"
showBool False = "NO"

uncurry5 f (a,b,c,d,e) = f a b c d e

getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read :: String -> Integer
          [a,b,n] =  map toInteger (words abn)

teto n d = 1 + (n - 1) `div` d

process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

chunksOf3 :: [a] -> [[a]]
chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Integer, Integer, Integer, [Integer], [Integer])
getInput [abn, as, bs] = (a, b, n, map toInteger (words as), map toInteger (words bs))
    where toInteger = read :: String -> Integer
          [a,b,n] =  map toInteger (words abn)

teto :: Integer -> Integer -> Integer
teto n d = 1 + (n - 1) `div` d

process :: Integer -> Integer -> Integer -> [Integer] -> [Integer] -> Bool
process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

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

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

myDiv :: Int -> Int -> Int
myDiv x y = (x + y - 1) `quot` y

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [a, b, _] <- getInts
    as <- getInts
    bs <- getInts
    let result = foldl' acc (Just (a, b)) $ sort $ zip as bs
        acc Nothing _ = Nothing
        acc (Just (a1, b1)) (a2, b2)
          | b1 <= 0 = Nothing
          | otherwise = if k1 < k2 then Nothing else Just (a1, b1 - k2 * a2)
          where
          k1 = myDiv b1 a2
          k2 = myDiv b2 a1
    C.putStrLn $ C.pack $ if isJust result then "YES" else "NO"

import qualified Data.ByteString.Lazy.Char8 as P

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

ceilDiv :: Integral t => t -> t -> t
ceilDiv n k = div (n + k - 1) k

cost :: Integer -> (Integer, Integer) -> Integer
cost ax (a, b) = let
  rounds = ceilDiv b ax
  in  rounds * a

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [ax, bx, _n] <- readInts
    a <- readInts
    b <- readInts
    let
      vs = sortOn fst $ zip a b
      totCost = sum $ map (cost ax) vs
      isOK = totCost - fst (last vs) < bx
    lift $ P.putStrLn $ if  isOK
      then  P.pack "YES"
      else  P.pack "NO"

type SIO = StateT P.ByteString IO

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

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

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts #-}

import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Traversable

------

mapFst :: (a -> c) -> (a, b) -> (c, b)
mapFst f (x, y) = (f x, y)

mapSnd :: (b -> c) -> (a, b) -> (a, c)
mapSnd f (x, y) = (x, f y)

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

pop :: MonadState [r] m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadState [r] m => m r
popJust = fromJust <$> pop

------

popInt :: MonadState [B.ByteString] m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadState [B.ByteString] m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadState [B.ByteString] m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadState [B.ByteString] m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

dropBackWhile :: (Char -> Bool) -> B.ByteString -> B.ByteString
dropBackWhile p = B.reverse . B.dropWhile p . B.reverse

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map (dropBackWhile isSpace) . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  n <- popInt
  B.unlines <$> replicateM n run1

run1 :: Hopper B.ByteString B.ByteString
run1 = do
  ~[attack, health, n] <- popIntegers
  a <- popIntegers
  b <- popIntegers
  return $ fmt $ solve attack health (zip a b)

  where
    fmt True = "YES"
    fmt False = "NO"

solve :: Integer -> Integer -> [(Integer, Integer)] -> Bool
solve attack health ms =
  let damagef (mattack, mhealth) =
        mattack * ((mhealth + attack - 1) `div` attack)
      totalDamage = sum $ map damagef ms
      lastDamage = maximum $ map fst ms in
    health - totalDamage + lastDamage > 0

chunksOf3 :: [a] -> [[a]]
chunksOf3 [] = []
chunksOf3 (a : b : c : t) = [a,b,c] : chunksOf3 t

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Int, Int, Int, [Int], [Int])
getInput [abn, as, bs] = (a, b, n, map toInt (words as), map toInt (words bs))
    where toInt = read :: String -> Int
          [a,b,n] =  map toInt (words abn)

teto :: Int -> Int -> Int
teto n d = 1 + (n - 1) `div` d

process :: Int -> Int -> Int -> [Int] -> [Int] -> Bool
process a b n as bs = damage - maximum as < b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf3 . tail . lines)

import Data.List

build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

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

uncurry5 :: (a -> b -> c -> d -> e -> f) -> (a,b,c,d,e) -> f
uncurry5 f (a,b,c,d,e) = f a b c d e

getInput :: [String] -> (Int, Int, Int, [Int], [Int])
getInput [abn, as, bs] = (a, b, n, map toInt (words as), map toInt (words bs))
    where toInt = read :: String -> Int
          [a,b,n] =  map toInt (words abn)

teto :: Int -> Int -> Int
teto n d = 1 + (n - 1) `div` d

process :: Int -> Int -> Int -> [Int] -> [Int] -> Bool
process a b n as bs = damage - maximum as <= b
    where f (a', b') = teto b' a * a'
          info = zip as bs
          damage = foldr (\p t -> f p + t) 0 info

main :: IO ()
main = interact (unlines . map (showBool . uncurry5 process . getInput) . chunksOf 3 . tail . lines)

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

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

myDiv :: Int -> Int -> Int
myDiv x y = (x + y - 1) `quot` y

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [b, a, _] <- getInts
    bs <- getInts
    as <- getInts
    let result = foldl' acc (Just (a, b)) $ sort $ zip as bs
        acc Nothing _ = Nothing
        acc (Just (a1, b1)) (a2, b2)
          | a1 <= 0 = Nothing
          | otherwise = if k1 < k2 then Nothing else Just (a1 - k2 * b2, b1)
          where
          k1 = myDiv a1 b2
          k2 = myDiv a2 b1
    C.putStrLn $ C.pack $ if isJust result then "YES" else "NO"


Madoka decided to participate in an underground sports programming competition. And there was exactly one task in it:A square table of size $$$n \times n$$$, where $$$n$$$ is a multiple of $$$k$$$, is called good if only the characters '.' and 'X' are written in it, as well as in any subtable of size $$$1 \times k$$$ or $$$k \times 1$$$, there is at least one character 'X'. In other words, among any $$$k$$$ consecutive vertical or horizontal cells, there must be at least one containing the character 'X'.Output any good table that has the minimum possible number of characters 'X', and also the symbol 'X' is written in the cell $$$(r, c)$$$. Rows are numbered from $$$1$$$ to $$$n$$$ from top to bottom, columns are numbered from $$$1$$$ to $$$n$$$ from left to right.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Description of the test cases follows. The first and the only line of each test case contains four integers $$$n$$$, $$$k$$$, $$$r$$$, $$$c$$$ ($$$1 \le n \le 500, 1 \le k \le n, 1 \le r, c \le n$$$) — the size of the table, the integer $$$k$$$ and the coordinates of the cell, which must contain the character 'X'. It is guaranteed that $$$n$$$ is a multiple of $$$k$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$500$$$.

For each test case, output $$$n$$$ lines, each consisting of $$$n$$$ characters '.' and 'X', — the desired table. If there are several answers, then you can output anyone.

NoteLet's analyze the first test case.The following tables can be printed as the correct answer: X....X.X. or ..XX...X.  It can be proved that there cannot be less than $$$3$$$ characters 'X' in the answer.Note that the following table is invalid because cell $$$(3, 2)$$$ does not contain the character 'X':  X...X...X In the second test case, the only correct table is:  XXXX  Each subtable of size $$$1 \times 1$$$ must contain a 'X' character, so all characters in the table must be equal to 'X'.

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  printf '%s\n' 3 '3 3 3 2' '2 1 1 2' '6 3 4 2' | ./a.out  &&  cat -- gridx.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import System.IO
import Control.Monad
import Data.Function

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

main = do
    [t]   <- ri
    tcs <- replicateM t ri
    mapM_ (putStr.unlines.solve) tcs

solve [n,k,r,c] = chunksOf n . map f $ coords
  where
    coords = [(y,x) | y <- [1..n],
                      x <- [1..n]]
    f (y,x) | ((y+x) `mod` k == (r+c) `mod` k)  = 'X'
            | otherwise                         = '.'

-- Judgement protocol
-- ...
-- Can't compile file:
-- ...
-- Could not find module `Data.List.Split'
-- ...
-- import Data.List.Split
-- ^^^^^^^^^^^^^^^^^^^^^^
--
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#chunksOf
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#build
--
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

  build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
  build g = g (:) []

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  printf '%s\n' 3 '3 3 3 2' '2 1 1 2' '6 3 4 2' | ./a.out  &&  cat -- gridx.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import System.IO
import Control.Monad
import Data.Function

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

main = do
    [t]   <- ri
    tcs <- replicateM t ri
    mapM_ (putStrLn.unlines.solve) tcs

solve [n,k,r,c] = chunksOf n . map f $ coords
  where
    coords = [(y,x) | y <- [1..n],
                      x <- [1..n]]
    f (y,x) | ((y+x) `mod` k == (r+c) `mod` k)  = 'X'
            | otherwise                         = '.'

-- Judgement protocol
-- ...
-- Can't compile file:
-- ...
-- Could not find module `Data.List.Split'
-- ...
-- import Data.List.Split
-- ^^^^^^^^^^^^^^^^^^^^^^
--
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#chunksOf
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#build
--
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

  build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
  build g = g (:) []

-- (ghc -O1 -no-keep-o-files -no-keep-hi-files -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  printf '%s\n' 3 '3 3 3 2' '2 1 1 2' '6 3 4 2' | ./a.out  &&  cat -- gridx.hs | xclip -selection clipboard  &&  echo COPIED  ||  echo ERROR)

import System.IO
import Control.Monad
import Data.Function

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

main = do
    [t]   <- ri
    tcs <- replicateM t ri
    mapM_ (putStrLn.unlines.solve) tcs

solve [n,k,r,c] = chunksOf n . map f $ coords
  where
    coords = [(y,x) | y <- [1..n],
                      x <- [1..n]]
    f (y,x) | (y `mod` k == r `mod` k) || (x `mod` k == c `mod` k)  = 'X'
            | otherwise                                             = '.'

-- Judgement protocol
-- ...
-- Can't compile file:
-- ...
-- Could not find module `Data.List.Split'
-- ...
-- import Data.List.Split
-- ^^^^^^^^^^^^^^^^^^^^^^
--
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#chunksOf
-- https://hackage.haskell.org/package/split-0.2.3.5/docs/src/Data.List.Split.Internals.html#build
--
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

  build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
  build g = g (:) []


Summer is coming! It's time for Iahub and Iahubina to work out, as they both want to look hot at the beach. The gym where they go is a matrix a with n lines and m columns. Let number a[i][j] represents the calories burned by performing workout at the cell of gym in the i-th line and the j-th column.Iahub starts with workout located at line 1 and column 1. He needs to finish with workout a[n][m]. After finishing workout a[i][j], he can go to workout a[i + 1][j] or a[i][j + 1]. Similarly, Iahubina starts with workout a[n][1] and she needs to finish with workout a[1][m]. After finishing workout from cell a[i][j], she goes to either a[i][j + 1] or a[i - 1][j]. There is one additional condition for their training. They have to meet in exactly one cell of gym. At that cell, none of them will work out. They will talk about fast exponentiation (pretty odd small talk) and then both of them will move to the next workout.If a workout was done by either Iahub or Iahubina, it counts as total gain. Please plan a workout for Iahub and Iahubina such as total gain to be as big as possible. Note, that Iahub and Iahubina can perform workouts with different speed, so the number of cells that they use to reach meet cell may differs.

The first line of the input contains two integers n and m (3 ≤ n, m ≤ 1000). Each of the next n lines contains m integers: j-th number from i-th line denotes element a[i][j] (0 ≤ a[i][j] ≤ 105).

The output contains a single number — the maximum total gain possible.

NoteIahub will choose exercises a[1][1] → a[1][2] → a[2][2] → a[3][2] → a[3][3]. Iahubina will choose exercises a[3][1] → a[2][1] → a[2][2] → a[2][3] → a[1][3].

import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray ((!),bounds,listArray)
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStrLn $ label ++ ":"
  let ((ilo,jlo),(ihi,jhi)) = bounds arr
  forM_ [ilo..ihi] $ \i -> do
    putStr "    "
    forM_ [jlo..jhi] $ \j -> do
      putStr $ printf "%6d " (arr ! (i,j))
    putStrLn ""

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (UArray (Int,Int) Int)

  let bnds = ((1,1),(n,m))
      bnds' = ((0,0),(n+1,m+1))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      g11' r (i,j) = do x <- r (i-1,j); y <- r (i,j-1); return $ a!(i,j) + max x y
      gn1' r (i,j) = do x <- r (i+1,j); y <- r (i,j-1); return $ a!(i,j) + max x y
      g1m' r (i,j) = do x <- r (i-1,j); y <- r (i,j+1); return $ a!(i,j) + max x y
      gnm' r (i,j) = do x <- r (i+1,j); y <- r (i,j+1); return $ a!(i,j) + max x y

      tabulate' f ijs = do
        arr <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
        forM_ ijs $ \ij -> f (readArray arr) ij >>=  writeArray arr ij
        M.freeze arr :: IO (UArray (Int,Int) Int)

{-
  a11 <- tabulate' g11' [ (i,j) | i <- [1..n], j <- [1..m] ]
  an1 <- tabulate' gn1' [ (i,j) | i <- [n,n-1..1], j <- [1..m] ]
  a1m <- tabulate' g1m' [ (i,j) | i <- [1..n], j <- [m,m-1..1] ]
  anm <- tabulate' gnm' [ (i,j) | i <- [n,n-1..1], j <- [m,m-1..1] ]
-}
  a11' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> forM_ [1..m] $ \j -> do
    x <- readArray a11' (i-1,j)
    y <- readArray a11' (i,j-1)
    writeArray a11' (i,j) $ a!(i,j) + max x y
  a11 <- M.freeze a11' :: IO (UArray (Int,Int) Int)

  an1' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [n,n-1..1] $ \i -> forM_ [1..m] $ \j -> do
    x <- readArray an1' (i+1,j)
    y <- readArray an1' (i,j-1)
    writeArray an1' (i,j) $ a!(i,j) + max x y
  an1 <- M.freeze an1' :: IO (UArray (Int,Int) Int)

  a1m' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> forM_ [m,m-1..1] $ \j -> do
    x <- readArray a1m' (i-1,j)
    y <- readArray a1m' (i,j+1)
    writeArray a1m' (i,j) $ a!(i,j) + max x y
  a1m <- M.freeze a1m' :: IO (UArray (Int,Int) Int)

  anm' <- newArray bnds' 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [n,n-1..1] $ \i -> forM_ [m,m-1..1] $ \j -> do
    x <- readArray anm' (i+1,j)
    y <- readArray anm' (i,j+1)
    writeArray anm' (i,j) $ a!(i,j) + max x y
  anm <- M.freeze anm' :: IO (UArray (Int,Int) Int)

  let g (i,j) = max top side
        where top  = a11!(i-1,j) + anm!(i+1,j) + an1!(i,j-1) + a1m!(i,j+1)
              side = a11!(i,j-1) + anm!(i,j+1) + an1!(i+1,j) + a1m!(i-1,j)
      -- b = listArray ((2,2),(n-1,m-1)) [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ] :: Array (Int,Int) Int
      best = maximum [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ]
  print best

{-
  showArray "a11" a11
  showArray "an1" an1
  showArray "a1m" a1m
  showArray "anm" anm
-}

import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

showArray label arr = do
  putStrLn $ label ++ ":"
  let ((ilo,jlo),(ihi,jhi)) = bounds arr
  forM_ [ilo..ihi] $ \i -> do
    putStr "    "
    forM_ [jlo..jhi] $ \j -> do
      putStr $ printf "%6d " (arr ! (i,j))
    putStrLn ""

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (Array (Int,Int) Int)

  let bnds = ((1,1),(n,m))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      a11 = tabulate g11
      a1m = tabulate g1m
      an1 = tabulate gn1
      anm = tabulate gnm

      g (i,j) = max top side
        where top  = a11!(i-1,j) + anm!(i+1,j) + an1!(i,j-1) + a1m!(i,j+1)
              side = a11!(i,j-1) + anm!(i,j+1) + an1!(i+1,j) + a1m!(i-1,j)
      b = listArray ((2,2),(n-1,m-1)) [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ] :: Array (Int,Int) Int
      best = maximum [ g (i,j) | i <- [2..n-1], j <- [2..m-1] ]
{-
  showArray "a11" a11
  showArray "anm" anm
  showArray "a1m" a1m
  showArray "an1" an1
  showArray "a" a
  showArray "best" b
-}
  print best

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
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 = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = 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)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    as <- replicateM n readInts
    print $ solve n m as

solve :: Int -> Int -> [[Int]] -> Int64
solve n m as = maximum $ do
        i <- [2..n-1]
        j <- [2..m-1]
        let c1 = cost11 ! (i,j-1)
               + cost12 ! (i,j+1)
               + cost21 ! (i+1,j)
               + cost22 ! (i-1,j)
        let c2 = cost11 ! (i-1,j)
               + cost12 ! (i+1,j)
               + cost21 ! (i,j-1)
               + cost22 ! (i,j+1)
        return $ max c1 c2
    where
    bb = ((1,1),(n,m))
    a :: UArray (Int,Int) Int64
    a = listArray bb $ map fromIntegral $ concat as
    cost11 :: UArray (Int,Int) Int64
    cost11 = f 1 (<=n) succ pred 1 (<=m) succ pred
    cost12 = f n (>=1) pred succ m (>=1) pred succ
    cost21 = f n (>=1) pred succ 1 (<=m) succ pred
    cost22 = f 1 (<=n) succ pred m (>=1) pred succ
    f i0 ip si pi j0 jp sj pj = runSTUArray $ do
        cost <- newArray bb 0
        stepM_ i0 ip si $ \i -> stepM_ j0 jp sj $ \j -> do
            v <- if i == i0 && j == j0 then return 0
                 else if i == i0 then
                     readArray cost (i,pj j)
                 else if j == j0 then
                     readArray cost (pi i,j)
                 else
                     max <$> readArray cost (i,pj j)
                         <*> readArray cost (pi i,j)
            writeArray cost (i,j) (v+a!(i,j))
        return cost

import Data.Array.IO
import Data.Ix
import Control.Monad
import Data.IORef
import Data.Tuple
import Data.List
import Data.Char
import qualified Data.ByteString.Lazy as B

parse :: B.ByteString -> [Int]
parse s = do
    q <- B.splitWith (\x-> x == 13 || x == 10 || x == 32) s
    if B.length q == 0 then
        []
    else
        return $ foldl' (\a b-> a * 10 + (fromIntegral b) - (ord '0')) 0 (B.unpack q)

readNum :: IORef [a] -> IO a
readNum nums = do
    x:xs <- readIORef nums
    writeIORef nums xs
    return x

dyn :: IOUArray (Int, Int) Int -> Int -> Int -> IO (IOUArray (Int, Int) Int)
dyn g di dj = do
    bounds <- getBounds g
    let ((i1, j1), (i2, j2)) = bounds
    let newBounds = ((i1 + min di 0, j1 + min dj 0), (i2 + max di 0, j2 + max dj 0))
    q <- newArray newBounds 0
    let startI = if di > 0 then i2 else i1
    let endI = if di > 0 then i1 else i2
    let startJ = if dj > 0 then j2 else j1
    let endJ = if dj > 0 then j1 else j2
    forM_ [startI, (startI - di)..endI] $ \i -> do
        forM_ [startJ, (startJ - dj)..endJ] $ \j -> do
            a <- readArray g (i, j)
            ai <- readArray q ((i + di), j)
            aj <- readArray q (i, (j + dj))
            writeArray q (i, j) (a + max ai aj)
    return q

main :: IO ()
main = do
    nums0 <- B.getContents
    nums <- newIORef $ parse nums0
    n <- readNum nums
    m <- readNum nums
    g <- newArray ((1, 1), (n, m)) 0
    forM_ (range ((1, 1), (n, m))) $ \p -> do
        a <- readNum nums
        writeArray g p a
    dpp <- dyn g 1 1
    dpn <- dyn g 1 (-1)
    dnp <- dyn g (-1) 1
    dnn <- dyn g (-1) (-1)
    maxRes <- newIORef 0
    forM_ (range ((2, 2), (n - 1, m - 1))) $ \(i, j) -> do
        a1Up <- readArray dnn (i - 1, j)
        a1Left <- readArray dnn (i, j - 1)
        a2Right <- readArray dpp (i, j + 1)
        a2Down <- readArray dpp (i + 1, j)
        b1Left <- readArray dpn (i, j - 1)
        b1Down <- readArray dpn (i + 1, j)
        b2Right <- readArray dnp (i, j + 1)
        b2Up <- readArray dnp (i - 1, j)
        let r = max (a1Up + b1Left + a2Down + b2Right) (a1Left + b1Down + a2Right + b2Up)
        curMaxRes <- readIORef maxRes
        writeIORef maxRes $! (max curMaxRes r)
    r <- readIORef maxRes
    putStrLn $ show r

import Control.Monad
import Data.Array.IO
import qualified Data.Array.MArray as M
import Data.Array
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

main = do
  (n:m:_) <- fmap (map read . words) getLine
  arr <- newArray ((0,0),(n+1,m+1)) 0 :: IO (IOUArray (Int,Int) Int)
  forM_ [1..n] $ \i -> do
    xs <- fmap (parseInts m) BS.getLine
    forM_ (zip [1..] xs) $ \(j,x) -> writeArray arr (i,j) x
  a <- M.freeze arr :: IO (Array (Int,Int) Int)

  let bnds = ((1,1),(n,m))

  let g11 r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j-1))
      gn1 r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j-1))
      g1m r (i,j) = a!(i,j) + max (r (i-1,j)) (r (i,j+1))
      gnm r (i,j) = a!(i,j) + max (r (i+1,j)) (r (i,j+1))

      tabulate f = let z = listArray bnds [ f r ij | ij <- range bnds ] :: Array (Int,Int) Int
                       r ij = if inRange bnds ij then z!ij else 0
                   in z :: Array (Int,Int) Int

      a11 = tabulate g11
      a1m = tabulate g1m
      an1 = tabulate gn1
      anm = tabulate gnm

      g ij = (a11!ij) + (a1m!ij) + (an1!ij) + (anm!ij) - 4*(a!ij)
      best = maximum [ g ij | ij <- range bnds ]
  print best

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
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 = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = 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)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    as <- replicateM n readInts
    print $ solve n m as

solve :: Int -> Int -> [[Int]] -> Int64
solve n m as = maximum $ do
        i <- [1..n]
        j <- [1..m]
        return $ cost11 ! (i,j) + cost12 ! (i,j) + cost21 ! (i,j) + cost22 ! (i,j)
    where
    bb = ((1,1),(n,m))
    a :: UArray (Int,Int) Int64
    a = listArray bb $ map fromIntegral $ concat as
    cost11 :: UArray (Int,Int) Int64
    cost11 = f 1 (<=n) succ pred 1 (<=m) succ pred
    cost12 = f n (>=1) pred succ m (>=1) pred succ
    cost21 = f n (>=1) pred succ 1 (<=m) succ pred
    cost22 = f 1 (<=n) succ pred m (>=1) pred succ
    f i0 ip si pi j0 jp sj pj = runSTUArray $ do
        cost <- newArray bb 0
        stepM_ i0 ip si $ \i -> stepM_ j0 jp sj $ \j -> do
            v <- if i == i0 && j == j0 then return 0
                 else if i == i0 then
                     ((a ! (i,pj j))+) <$> readArray cost (i,pj j)
                 else if j == j0 then
                     ((a ! (pi i,j))+) <$> readArray cost (pi i,j)
                 else
                     max <$> (((a ! (i,pj j))+) <$> readArray cost (i,pj j))
                         <*> (((a ! (pi i,j))+) <$> readArray cost (pi i,j))
            writeArray cost (i,j) v
        return cost


Bob is playing with $$$6$$$-sided dice. A net of such standard cube is shown below.He has an unlimited supply of these dice and wants to build a tower by stacking multiple dice on top of each other, while choosing the orientation of each dice. Then he counts the number of visible pips on the faces of the dice.For example, the number of visible pips on the tower below is $$$29$$$ — the number visible on the top is $$$1$$$, from the south $$$5$$$ and $$$3$$$, from the west $$$4$$$ and $$$2$$$, from the north $$$2$$$ and $$$4$$$ and from the east $$$3$$$ and $$$5$$$.The one at the bottom and the two sixes by which the dice are touching are not visible, so they are not counted towards total.Bob also has $$$t$$$ favourite integers $$$x_i$$$, and for every such integer his goal is to build such a tower that the number of visible pips is exactly $$$x_i$$$. For each of Bob's favourite integers determine whether it is possible to build a tower that has exactly that many visible pips.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of favourite integers of Bob.  The second line contains $$$t$$$ space-separated integers $$$x_i$$$ ($$$1 \leq x_i \leq 10^{18}$$$) — Bob's favourite integers.

For each of Bob's favourite integers, output "YES" if it is possible to build the tower, or "NO" otherwise (quotes for clarity).

NoteThe first example is mentioned in the problem statement.In the second example, one can build the tower by flipping the top dice from the previous tower.In the third example, one can use a single die that has $$$5$$$ on top.The fourth example is impossible.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
main=interact$unlines.map(p.read).tail.words
p x|x<14="NO"|mod(x-1)14<6="YES"|1>0="NO"

module Main where
    import Data.Array

    solve :: Integer -> Bool
    solve x = (d >= 1) && (1 <= t) && (t <= 6) where
        t = x `mod` 14
        d = x `div` 14

    main = do
        n <- getLine
        l <- getLine
        let a = map(\x -> read x :: Integer) $ words l
            res = map(\x -> if solve x == True then "YES" else "NO") a
        mapM_ putStrLn res

main=interact$unlines.map p.tail.words
p x|mod(read x-1)14<6="YES"|1>0="NO"


A string is called diverse if it contains consecutive (adjacent) letters of the Latin alphabet and each letter occurs exactly once. For example, the following strings are diverse: "fced", "xyz", "r" and "dabcef". The following string are not diverse: "az", "aa", "bad" and "babc". Note that the letters 'a' and 'z' are not adjacent.Formally, consider positions of all letters in the string in the alphabet. These positions should form contiguous segment, i.e. they should come one by one without any gaps. And all letters in the string should be distinct (duplicates are not allowed).You are given a sequence of strings. For each string, if it is diverse, print "Yes". Otherwise, print "No".

The first line contains integer $$$n$$$ ($$$1 \le n \le 100$$$), denoting the number of strings to process. The following $$$n$$$ lines contains strings, one string per line. Each string contains only lowercase Latin letters, its length is between $$$1$$$ and $$$100$$$, inclusive.

Print $$$n$$$ lines, one line per a string in the input. The line should contain "Yes" if the corresponding string is diverse and "No" if the corresponding string is not diverse. You can print each letter in any case (upper or lower). For example, "YeS", "no" and "yES" are all acceptable.

import Data.List (sort)

isVarious str = all (\(a, b) -> succ a == b) $ zip (init sorted_str) (tail sorted_str) where
    sorted_str = sort str

test = if isVarious "asd" then "Yes" else "No"

iterSolve 0 = return ()
iterSolve n = do
    str <- getLine
    putStrLn $ if isVarious str then "Yes" else "No"
    iterSolve (n - 1)

main = do
    line <- getLine
    iterSolve $ read line

import Data.List
works (y:[]) = True
works (x:y:xs) = case (succ x) == y of
  True -> works (y:xs)
  False -> False

process [] = putStr ""
process (x:xs) = case works (sort x) of
  True -> putStrLn "Yes" >> process xs
  False -> putStrLn "No" >> process xs
main = getContents >>= process . tail . words

import Data.List

main = getLine >> (interact $ unlines . map solve . lines)

solve xs
    | build ss == ss = "Yes"
    | otherwise = "No"
    where build all@(x:_) = take (length all) $ iterate succ x
          ss = sort xs

import Data.List
import System.IO

readInteger :: IO Int
readInteger = do
   z <- readLn
   return z

readString = do
   z <- getLine
   return z

readStrings 0 = return []
readStrings n = do
   line <- readString
   rest <- readStrings (n - 1)
   return (line : rest)

takeInput = do
   z <- readInteger
   readStrings z

ok (ch: []) = True
ok (ch : rest) = (ok rest) && ((fromEnum ch) + 1 == fromEnum (head rest))

answer True = "Yes"
answer False = "No"

process = map (answer . ok . sort)

display [] = return ()
display (x:xs) = do
   putStrLn x
   display xs

main = do
   input <- takeInput
   display (process input)

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

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

diverse :: String -> String
diverse s
    | m == l && m == (d + 1) = "Yes"
    | otherwise              = "No"
        where l = length s
              t = sort s
              m = length $ group t
              d = ord (last t) - ord (head t)

main :: IO ()
main = do
    n <- readInt
    xs <- replicateM n $ getLine
    mapM_ putStrLn $ map diverse xs

import Data.List
main = interact $ unlines . map solve . tail . lines
solve s | fromEnum (maximum s) - fromEnum (minimum s) == length s - 1
          && nub s == s = "Yes"
        | otherwise = "No"

import Data.List ( sort, nub )
import Data.Bool ( bool )

main :: IO ()
main = interact $ unlines . fmap (toYesNo . isDiverse) . tail . words
  where
    toYesNo = bool "No" "Yes"

isDiverse :: String -> Bool
isDiverse s = isAdj s && isDistinct s

isAdj :: String -> Bool
isAdj = and . (zipWith (\a b -> succ a == b) <*> tail) . sort

isDistinct :: String -> Bool
isDistinct s = nub s == s

import Data.List
consecCheck s =  (== 1) . length . filter id . map head . group $ map (`elem` s) ['a'..'z']
allDiff [] = True
allDiff (x:xs) = not (x `elem` xs) && allDiff xs
solve s = allDiff s && consecCheck s
p b = if b then "Yes" else "No"
main = interact $ unlines . map (p . solve) . tail . lines

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
import Data.Array.Unboxed
import Data.Int
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

rstrip = C.takeWhile isPrint
sYes = byteString $ C.pack "Yes\n"
sNo = byteString $ C.pack "No\n"

test s = if res then sYes else sNo
  where
    c = runSTUArray $ do
      x <- newArray (0, 25) 0 :: ST s (STUArray s Int Int32)
      forM (C.unpack s) $ \i -> do
        let !j = ord i - 97
        readArray x j >>= ((writeArray x j) . succ)
      return x
    lst = filter (\ l -> head l /= 0) $ group $ elems c
    !res = length lst == 1 && (head $ head lst) == 1

solve (sn:a) = mconcat $ map test b
  where
    !n = ru sn
    b = take n a

main :: IO ()
main = hPutBuilder stdout . solve . map rstrip . C.lines =<< C.getContents

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M

m1 =M.fromList $   zip ['a'..'z'] [1..]

process1 x 	| d+1== length x = "Yes"
	  	| otherwise = "No"
	where mi = minimum x
              ma = maximum x
	      d =fromJust ( M.lookup ma m1) - fromJust (M.lookup mi m1)

onecase = do
		x<-getLine
		putStrLn $ 	if length (group (sort x)) <length x then "No" else process1 x

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

-- Codeforces Round #550 (Div. 3) - Problem A: Diverse Strings (https://codeforces.com/problemset/problem/1144/A)
import Data.List
import Data.Char

isDiverse s | s == nub s && (ord . head) s + n - 1 == (ord . last) s  = "Yes"
            | otherwise                                 = "No"
            where
                n = length s

solve = map (isDiverse . sort)

main = do
    input <- getContents
    let xs = tail . lines $ input
    putStr . unlines $ solve xs

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import Data.Array
import qualified Data.Map as M

m1 =M.fromList $   zip ['a'..'y'] ['b'..'z']

process [_] = "No"

process (a:b) 	| elem (fromJust(M.lookup a m1)) b = "Yes"
		| otherwise = process b
process1 x | length x == 1 = "Yes"
	   | otherwise = process   x

onecase = do
		x<-getLine
		putStrLn $ 	if length (group (sort x)) <length x then "No" else process1 x

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

-- Codeforces Round #550 (Div. 3) - Problem A: Diverse Strings (https://codeforces.com/problemset/problem/1144/A)
import Data.List
import Data.Char

isDiverse s | (ord . head) s + n - 1 == (ord . last) s  = "Yes"
            | otherwise                                 = "No"
            where
                n = length s

solve = map (isDiverse . sort)

main = do
    input <- getContents
    let xs = tail . lines $ input
    putStr . unlines $ solve xs


An identity permutation of length $$$n$$$ is an array $$$[1, 2, 3, \dots, n]$$$.We performed the following operations to an identity permutation of length $$$n$$$:  firstly, we cyclically shifted it to the right by $$$k$$$ positions, where $$$k$$$ is unknown to you (the only thing you know is that $$$0 \le k \le n - 1$$$). When an array is cyclically shifted to the right by $$$k$$$ positions, the resulting array is formed by taking $$$k$$$ last elements of the original array (without changing their relative order), and then appending $$$n - k$$$ first elements to the right of them (without changing relative order of the first $$$n - k$$$ elements as well). For example, if we cyclically shift the identity permutation of length $$$6$$$ by $$$2$$$ positions, we get the array $$$[5, 6, 1, 2, 3, 4]$$$;  secondly, we performed the following operation at most $$$m$$$ times: pick any two elements of the array and swap them. You are given the values of $$$n$$$ and $$$m$$$, and the resulting array. Your task is to find all possible values of $$$k$$$ in the cyclic shift operation.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Each test case consists of two lines. The first line contains two integers $$$n$$$ and $$$m$$$ ($$$3 \le n \le 3 \cdot 10^5$$$; $$$0 \le m \le \frac{n}{3}$$$). The second line contains $$$n$$$ integers $$$p_1, p_2, \dots, p_n$$$ ($$$1 \le p_i \le n$$$, each integer from $$$1$$$ to $$$n$$$ appears in this sequence exactly once) — the resulting array. The sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$.

For each test case, print the answer in the following way:   firstly, print one integer $$$r$$$ ($$$0 \le r \le n$$$) — the number of possible values of $$$k$$$ for the cyclic shift operation;  secondly, print $$$r$$$ integers $$$k_1, k_2, \dots, k_r$$$ ($$$0 \le k_i \le n - 1$$$) — all possible values of $$$k$$$ in increasing order.

NoteConsider the example:   in the first test case, the only possible value for the cyclic shift is $$$3$$$. If we shift $$$[1, 2, 3, 4]$$$ by $$$3$$$ positions, we get $$$[2, 3, 4, 1]$$$. Then we can swap the $$$3$$$-rd and the $$$4$$$-th elements to get the array $$$[2, 3, 1, 4]$$$;  in the second test case, the only possible value for the cyclic shift is $$$0$$$. If we shift $$$[1, 2, 3]$$$ by $$$0$$$ positions, we get $$$[1, 2, 3]$$$. Then we don't change the array at all (we stated that we made at most $$$1$$$ swap), so the resulting array stays $$$[1, 2, 3]$$$;  in the third test case, all values from $$$0$$$ to $$$2$$$ are possible for the cyclic shift:   if we shift $$$[1, 2, 3]$$$ by $$$0$$$ positions, we get $$$[1, 2, 3]$$$. Then we can swap the $$$1$$$-st and the $$$3$$$-rd elements to get $$$[3, 2, 1]$$$;  if we shift $$$[1, 2, 3]$$$ by $$$1$$$ position, we get $$$[3, 1, 2]$$$. Then we can swap the $$$2$$$-nd and the $$$3$$$-rd elements to get $$$[3, 2, 1]$$$;  if we shift $$$[1, 2, 3]$$$ by $$$2$$$ positions, we get $$$[2, 3, 1]$$$. Then we can swap the $$$1$$$-st and the $$$2$$$-nd elements to get $$$[3, 2, 1]$$$;   in the fourth test case, we stated that we didn't do any swaps after the cyclic shift, but no value of cyclic shift could produce the array $$$[1, 2, 3, 4, 6, 5]$$$.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Arrow
import Control.Monad (replicateM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Base
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort)
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  (n, m) <- pair int int
  ps <- n >< int
  let ks = solve m ps
  return . unwords . map show $ length ks : ks

solve :: Int -> [Int] -> [Int]
solve m ps =
  filter check
    . map head -- ks
    . filter ((>= n - 2 * m) . length) -- cnt_k >= n - 2m
    . group
    . sort
    $ [(n + i - x) `mod` n | i <- [1 ..] | x <- ps] -- k values for each fixpoint
  where
    n = length ps
    check k = let (hs, ts) = splitAt k ps in numCycles (ts ++ hs) >= n - m

-- Number of cycles in a 1-indexed permutation
numCycles :: [Int] -> Int
numCycles = rangeSize . bounds . cycleLen . permToCycles . fromList

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

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

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

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

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

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

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

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

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

(><) = times

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

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

--- https://github.com/byorgey/comprog-hs/blob/master/Perm.hs

-- | 'Perm' represents a /1-indexed/ permutation.  It can also be
--   thought of as an endofunction on the set @{1 .. n}@.
type Perm = UArray Int Int

-- | Construct a 'Perm' from a list containing a permutation of the
--   numbers 1..n.  The resulting 'Perm' sends @i@ to whatever number
--   is at index @i-1@ in the list.
fromList :: [Int] -> Perm
fromList xs = listArray (1, length xs) xs

-- | Compose two permutations (corresponds to backwards function
--   composition).  Only defined if the permutations have the same
--   size.
andThen :: Perm -> Perm -> Perm
andThen p1 p2 = listArray (bounds p1) (map ((p1 !) >>> (p2 !)) (range (bounds p1)))

-- | Compute the inverse of a permutation.
inverse :: Perm -> Perm
inverse p = array (bounds p) [(p ! k, k) | k <- range (bounds p)]

data CycleDecomp = CD
  { -- | Each number maps to the ID #
    --   of the cycle it is part of
    cycleID :: UArray Int Int,
    -- | Each cycle ID maps to the length of that cycle
    cycleLen :: UArray Int Int,
    -- | Each element maps to its (0-based) index in its cycle
    cycleIndex :: UArray Int Int,
    -- | Each size maps to the number of cycles of that size
    cycleCounts :: UArray Int Int
  }
  deriving (Show)

-- | Cycle decomposition of a permutation in O(n), using mutable arrays.
permToCycles :: Perm -> CycleDecomp
permToCycles p = cd
  where
    (_, n) = bounds p

    cd = runST $ do
      cid <- newArray (1, n) 0
      cix <- newArray (1, n) 0
      ccs <- newArray (1, n) 0

      lens <- findCycles cid cix ccs 1 1
      cid' <- freeze cid
      cix' <- freeze cix
      ccs' <- freeze ccs
      return $ CD cid' (listArray (1, length lens) lens) cix' ccs'

    findCycles ::
      STUArray s Int Int ->
      STUArray s Int Int ->
      STUArray s Int Int ->
      Int ->
      Int ->
      ST s [Int]
    findCycles cid cix ccs l !k -- l = next available cycle ID; k = cur element
      | k > n = return []
      | otherwise = do
        -- check if k is already marked as part of a cycle
        id <- readArray cid k
        case id of
          0 -> do
            -- k is unvisited.  Explore its cycle and label it as l.
            len <- labelCycle cid cix l k 0

            -- Remember that we have one more cycle of this size.
            count <- readArray ccs len
            writeArray ccs len (count + 1)

            -- Continue with the next label and the next element, and
            -- remember the size of this cycle
            (len :) <$> findCycles cid cix ccs (l + 1) (k + 1)

          -- k is already visited: just go on to the next element
          _ -> findCycles cid cix ccs l (k + 1)

    -- Explore a single cycle, label all its elements and return its size.
    labelCycle cid cix l k !i = do
      -- Keep going as long as the next element is unlabelled.
      id <- readArray cid k
      case id of
        0 -> do
          -- Label the current element with l.
          writeArray cid k l
          -- The index of the current element is i.
          writeArray cix k i

          -- Look up the next element in the permutation and continue.
          (1 +) <$> labelCycle cid cix l (p ! k) (i + 1)
        _ -> return 0

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

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

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST.Lazy

seenBefore :: (Int, Int) -> [Int] -> [Bool]
seenBefore bnds li = runST $ do
  arr <- strictToLazyST $ newArray bnds False :: ST s (STUArray s Int Bool)
  (\fun -> mapM fun li) $ \x -> strictToLazyST $ do
    ans <- readArray arr x
    ans <$ writeArray arr x True

getCycles :: UArray Int Int -> [[Int]]
getCycles arr = let
  go qrs x = let
    (ansTail, remQs) = case  qrs  of
      False : qrst -> go qrst (arr ! x)
      True  : qrst -> ([], qrst)
      [] -> error "unanswered query"
    in  (x : ansTail, remQs)
  queryResponses = seenBefore (bounds arr) queries
  queries = concat untrimmed
  untrimmed = map fst
    $ scanl (\(_, qrs) x -> go qrs x) ([], queryResponses) (indices arr)
  in  [ts | _ : ts <- untrimmed, not $ null ts]

check :: UArray Int Int -> Int -> Int
check p k = let
  (1, n) = bounds p
  pk = listArray (1, n) $ [1 + mod (pj + k - 1) n | pj <- elems p]
  in  n - length (getCycles pk)

solve :: UArray Int Int -> Int -> [Int]
solve p m = let
  (1, n) = bounds p
  ncorrect :: UArray Int Int
  ncorrect = accumArray (+) 0 (0, n-1)
    $ [(mod (i - pj) n, 1) | (i, pj) <- assocs p]
  isOK k = if  ncorrect ! k + 2 * m < n
    then  False  -- at most 3 values of k can skip this per testcase
    else  check p k <= m
  in  filter isOK [0 .. n-1]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    p <- listArray (1, n) <$>readInts
    let  ans = solve p m
    putInts $ length ans : ans

type SIO = StateT P.ByteString IO

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

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

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

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Arrow
import Control.Monad (replicateM)
import Control.Monad.ST
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Array.Base
import Data.Array.MArray
import Data.Array.ST
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group, sort)
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  (n, m) <- pair int int
  ps <- n >< int
  let ks = solve m ps
  return . unwords . map show $ length ks : ks

solve :: Int -> [Int] -> [Int]
solve m ps =
  id
  -- filter (\k -> numCycles ([n - k + 1 .. n] ++ [1 .. n - k]) >= n - m) -- check swaps
    . map head -- ks
    . filter ((>= n - 2 * m) . length) -- cnt_k >= n - 2m
    . group
    . sort
    $ [(n + i - x) `mod` n | i <- [1 ..] | x <- ps] -- k values for each fixpoint
  where
    n = length ps

-- Number of cycles in a 1-indexed permutation
numCycles :: [Int] -> Int
numCycles = rangeSize . bounds . cycleLen . permToCycles . fromList

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

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

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

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

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

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

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

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

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

(><) = times

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

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

--- https://github.com/byorgey/comprog-hs/blob/master/Perm.hs

-- | 'Perm' represents a /1-indexed/ permutation.  It can also be
--   thought of as an endofunction on the set @{1 .. n}@.
type Perm = UArray Int Int

-- | Construct a 'Perm' from a list containing a permutation of the
--   numbers 1..n.  The resulting 'Perm' sends @i@ to whatever number
--   is at index @i-1@ in the list.
fromList :: [Int] -> Perm
fromList xs = listArray (1, length xs) xs

-- | Compose two permutations (corresponds to backwards function
--   composition).  Only defined if the permutations have the same
--   size.
andThen :: Perm -> Perm -> Perm
andThen p1 p2 = listArray (bounds p1) (map ((p1 !) >>> (p2 !)) (range (bounds p1)))

-- | Compute the inverse of a permutation.
inverse :: Perm -> Perm
inverse p = array (bounds p) [(p ! k, k) | k <- range (bounds p)]

data CycleDecomp = CD
  { -- | Each number maps to the ID #
    --   of the cycle it is part of
    cycleID :: UArray Int Int,
    -- | Each cycle ID maps to the length of that cycle
    cycleLen :: UArray Int Int,
    -- | Each element maps to its (0-based) index in its cycle
    cycleIndex :: UArray Int Int,
    -- | Each size maps to the number of cycles of that size
    cycleCounts :: UArray Int Int
  }
  deriving (Show)

-- | Cycle decomposition of a permutation in O(n), using mutable arrays.
permToCycles :: Perm -> CycleDecomp
permToCycles p = cd
  where
    (_, n) = bounds p

    cd = runST $ do
      cid <- newArray (1, n) 0
      cix <- newArray (1, n) 0
      ccs <- newArray (1, n) 0

      lens <- findCycles cid cix ccs 1 1
      cid' <- freeze cid
      cix' <- freeze cix
      ccs' <- freeze ccs
      return $ CD cid' (listArray (1, length lens) lens) cix' ccs'

    findCycles ::
      STUArray s Int Int ->
      STUArray s Int Int ->
      STUArray s Int Int ->
      Int ->
      Int ->
      ST s [Int]
    findCycles cid cix ccs l !k -- l = next available cycle ID; k = cur element
      | k > n = return []
      | otherwise = do
        -- check if k is already marked as part of a cycle
        id <- readArray cid k
        case id of
          0 -> do
            -- k is unvisited.  Explore its cycle and label it as l.
            len <- labelCycle cid cix l k 0

            -- Remember that we have one more cycle of this size.
            count <- readArray ccs len
            writeArray ccs len (count + 1)

            -- Continue with the next label and the next element, and
            -- remember the size of this cycle
            (len :) <$> findCycles cid cix ccs (l + 1) (k + 1)

          -- k is already visited: just go on to the next element
          _ -> findCycles cid cix ccs l (k + 1)

    -- Explore a single cycle, label all its elements and return its size.
    labelCycle cid cix l k !i = do
      -- Keep going as long as the next element is unlabelled.
      id <- readArray cid k
      case id of
        0 -> do
          -- Label the current element with l.
          writeArray cid k l
          -- The index of the current element is i.
          writeArray cix k i

          -- Look up the next element in the permutation and continue.
          (1 +) <$> labelCycle cid cix l (p ! k) (i + 1)
        _ -> return 0

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

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

import Data.Array.Unboxed
import Data.Array.ST
import Control.Monad.ST.Lazy

seenBefore :: (Int, Int) -> [Int] -> [Bool]
seenBefore bnds li = runST $ do
  arr <- strictToLazyST $ newArray bnds False :: ST s (STUArray s Int Bool)
  (\fun -> mapM fun li) $ \x -> strictToLazyST $ do
    ans <- readArray arr x
    ans <$ writeArray arr x True

getCycles :: UArray Int Int -> [[Int]]
getCycles arr = let
  go qrs x = let
    (ansTail, remQs) = case  qrs  of
      True  : qrst -> go qrst (arr ! x)
      False : qrst -> ([], qrst)
      [] -> error "unanswered query"
    in  (x : ansTail, remQs)
  queryResponses = seenBefore (bounds arr) queries
  queries = concat untrimmed
  untrimmed = map fst
    $ scanl (\(_, qrs) x -> go qrs x) ([], queryResponses) (indices arr)
  in  [ts | _ : ts <- untrimmed]

check :: UArray Int Int -> Int -> Int
check p k = let
  (1, n) = bounds p
  pk = listArray (1, n) $ [1 + mod (pj - k - 1) n | pj <- elems p]
  in  n - length (getCycles pk)

solve :: UArray Int Int -> Int -> [Int]
solve p m = let
  (1, n) = bounds p
  ncorrect :: UArray Int Int
  ncorrect = accumArray (+) 0 (0, n-1)
    $ [(mod (i - pj) n, 1) | (i, pj) <- assocs p]
  isOK k = if  ncorrect ! k + 2 * m < n
    then  False  -- at most 3 values of k can skip this per testcase
    else  check p k < m
  in  filter isOK [0 .. n-1]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n, m] <- readInts
    p <- listArray (1, n) <$>readInts
    let  ans = solve p m
    putInts $ length ans : ans

type SIO = StateT P.ByteString IO

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

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

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


A car number in Berland consists of exactly n digits. A number is called beautiful if it has at least k equal digits. Vasya wants to change the digits in his car's number so that the number became beautiful. To replace one of n digits Vasya has to pay the sum of money, equal to the absolute difference between the old digit and the new one.Help Vasya: find the minimum sum of money he should pay to make the number of his car beautiful. You should also find the resulting beautiful number. If there are several such numbers, then print the lexicographically minimum one.

The first line contains two space-separated integers n and k (2 ≤ n ≤ 104, 2 ≤ k ≤ n) which represent how many digits the number has and how many equal digits a beautiful number should have. The second line consists of n digits. It describes the old number of Vasya's car. It is guaranteed that the number contains no spaces and only contains digits.

On the first line print the minimum sum of money Vasya needs to change the number. On the second line print the car's new number. If there are several solutions, print the lexicographically minimum one.

NoteIn the first sample replacing the second digit with an "8" costs |9 - 8| = 1. Replacing the fifth digit with an "8" costs the same. Replacing the sixth digit costs |6 - 8| = 2. As a result, Vasya will pay 1 + 1 + 2 = 4 for a beautiful number "888188".The lexicographical comparison of strings is performed by the < operator in modern programming languages. The string x is lexicographically smaller than the string y, if there exists such i (1 ≤ i ≤ n), that xi < yi, and for any j (1 ≤ j < i) xj = yj. The strings compared in this problem will always have the length n.

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

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

import Debug.Trace

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

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

mergeAdd :: [Int] -> [Int] -> [Int]
mergeAdd [] xs = xs
mergeAdd xs [] = xs
mergeAdd (x:xs) (y:ys) = (x+y) : mergeAdd xs ys

getNum :: [Int] -> [Int] -> Int -> Int
getNum as xs limit | sum xs + maximum as < limit = maxBound
getNum as xs limit = minimum [ sum $ zipWith (*) lst [0..]
                             | (i, ai, xi) <- zip3 [0..] as xs
                             , let ys = (ai + xi) : mergeAdd (reverse $ take i xs) (drop (i + 1) xs)
                             , sum ys >= limit
                             , let zs = takeWhile (<limit) $ scanl (+) 0 ys
                             , let lst = zipWith (\y z -> min limit (y + z) - z) ys zs
                             ]

solve (n, k, str) = BS.unlines [ BS.pack (show cost)
                               , BS.pack (go 0 cost (replicate 10 0) lst "")
                               ]
  where
    len = BS.length str
    lst = [BS.count digit str | digit <- ['0'..'9']]

    cost = getNum (replicate 10 0) lst k

    go pos c prev next ans | pos == len = reverse ans
    go pos c prev next ans = head lst
      where
        ch = digitToInt $ BS.index str pos
        nnext = [if i == ch then xi - 1 else xi | (i, xi) <- zip [0..] next]

        lst = [ go (pos + 1) nc nprev nnext (intToDigit ch' : ans)
              | ch' <- [0..9]
              , let nprev = [if i == ch' then xi + 1 else xi | (i, xi) <- zip [0..] prev]
              , let nc = getNum nprev nnext k
              , nc + abs (ch - ch') == c
              ]

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State