In distant future on Earth day lasts for n hours and that's why there are n timezones. Local times in adjacent timezones differ by one hour. For describing local time, hours numbers from 1 to n are used, i.e. there is no time "0 hours", instead of it "n hours" is used. When local time in the 1-st timezone is 1 hour, local time in the i-th timezone is i hours.Some online programming contests platform wants to conduct a contest that lasts for an hour in such a way that its beginning coincides with beginning of some hour (in all time zones). The platform knows, that there are ai people from i-th timezone who want to participate in the contest. Each person will participate if and only if the contest starts no earlier than s hours 00 minutes local time and ends not later than f hours 00 minutes local time. Values s and f are equal for all time zones. If the contest starts at f hours 00 minutes local time, the person won't participate in it.Help platform select such an hour, that the number of people who will participate in the contest is maximum.

The first line contains a single integer n (2 ≤ n ≤ 100 000) — the number of hours in day. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 10 000), where ai is the number of people in the i-th timezone who want to participate in the contest. The third line contains two space-separated integers s and f (1 ≤ s < f ≤ n).

Output a single integer — the time of the beginning of the contest (in the first timezone local time), such that the number of participants will be maximum possible. If there are many answers, output the smallest among them.

NoteIn the first example, it's optimal to start competition at 3 hours (in first timezone). In this case, it will be 1 hour in the second timezone and 2 hours in the third timezone. Only one person from the first timezone won't participate.In second example only people from the third and the fourth timezones will participate.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words)
import qualified Data.Maybe as M (fromJust)
import Data.Int as I (Int64)

readInt = fst . M.fromJust . C.readInt

main = do
    (map readInt . C.words -> [n]) <- B.getLine
    (map (fromIntegral . readInt) . C.words -> xs :: [I.Int64]) <- B.getLine
    (map readInt . C.words -> [s, f]) <- B.getLine
    let pp = sum $ take (f - s) xs
        ys = reverse (take (f - s) xs) ++ (reverse (drop (f - s) xs))
    let run _ mpi _ [] = mpi
        run mp mpi p ((i, a, b):xs) | p > mp || (p == mp && mpi > pi) = run p pi np xs
                                      | otherwise = run mp mpi np xs where
            pi = (i + s - 1) `mod` n + 1
            np = p - a + b
    putStrLn $ show $ run 0 (n + 1) pp (zip3 [0..] ys (reverse xs))


Allen wants to enter a fan zone that occupies a round square and has $$$n$$$ entrances.There already is a queue of $$$a_i$$$ people in front of the $$$i$$$-th entrance. Each entrance allows one person from its queue to enter the fan zone in one minute.Allen uses the following strategy to enter the fan zone:   Initially he stands in the end of the queue in front of the first entrance.  Each minute, if he is not allowed into the fan zone during the minute (meaning he is not the first in the queue), he leaves the current queue and stands in the end of the queue of the next entrance (or the first entrance if he leaves the last entrance). Determine the entrance through which Allen will finally enter the fan zone.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the number of entrances. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) — the number of people in queues. These numbers do not include Allen.

Print a single integer — the number of entrance that Allen will use.

NoteIn the first example the number of people (not including Allen) changes as follows: $$$[\textbf{2}, 3, 2, 0] \to [1, \textbf{2}, 1, 0] \to [0, 1, \textbf{0}, 0]$$$. The number in bold is the queue Alles stands in. We see that he will enter the fan zone through the third entrance.In the second example the number of people (not including Allen) changes as follows: $$$[\textbf{10}, 10] \to [9, \textbf{9}] \to [\textbf{8}, 8] \to [7, \textbf{7}] \to [\textbf{6}, 6] \to \\ [5, \textbf{5}] \to [\textbf{4}, 4] \to [3, \textbf{3}] \to [\textbf{2}, 2] \to [1, \textbf{1}] \to [\textbf{0}, 0]$$$.In the third example the number of people (not including Allen) changes as follows: $$$[\textbf{5}, 2, 6, 5, 7, 4] \to [4, \textbf{1}, 5, 4, 6, 3] \to [3, 0, \textbf{4}, 3, 5, 2] \to \\ [2, 0, 3, \textbf{2}, 4, 1] \to [1, 0, 2, 1, \textbf{3}, 0] \to [0, 0, 1, 0, 2, \textbf{0}]$$$.

test :: (Integral a) =>  a -> a -> [a] -> a
test i v [] = 0
test i v (x:xs)
  | x <= v = i + 1
  | otherwise = test (i+1) (v+1) xs

test3 :: (Integral a) => [a] -> a
test3 [] = 0
test3 (x:xs) = test3 xs + x

test2 :: (Integral a) => [a] -> a
test2 (_:x) =
  let vv = div (minimum x) (fromIntegral$length x) * (fromIntegral$length x)
      kk = test 0 vv x
  in if kk== 0 then test 0 (vv+(fromIntegral$length x)) x else kk

main=interact$show.test2.map read.words


You are given a range of positive integers from $$$l$$$ to $$$r$$$.Find such a pair of integers $$$(x, y)$$$ that $$$l \le x, y \le r$$$, $$$x \ne y$$$ and $$$x$$$ divides $$$y$$$.If there are multiple answers, print any of them.You are also asked to answer $$$T$$$ independent queries.

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 1000$$$) — the number of queries. Each of the next $$$T$$$ lines contains two integers $$$l$$$ and $$$r$$$ ($$$1 \le l \le r \le 998244353$$$) — inclusive borders of the range. It is guaranteed that testset only includes queries, which have at least one suitable pair.

Print $$$T$$$ lines, each line should contain the answer — two integers $$$x$$$ and $$$y$$$ such that $$$l \le x, y \le r$$$, $$$x \ne y$$$ and $$$x$$$ divides $$$y$$$. The answer in the $$$i$$$-th line should correspond to the $$$i$$$-th query from the input. If there are multiple answers, print any of them.

solve (l, r) = (l, 2 * l)

readInt :: String -> Int
readInt = read

readPair :: [String] -> (Int, Int)
readPair [x, y] = (readInt x, readInt y)

main = do
    contents <- getContents
    let _:xs = lines contents
    let ans = map (solve . readPair . words) xs
    mapM_ (\(x, y) -> (putStrLn ((show x) ++ " " ++ (show y)))) ans

module Main where
import Control.Monad

main = do
    ts <- (readLn :: IO Int) >>= \x -> replicateM x $ map (read :: String -> Integer) . words <$> getLine
    mapM_ (\[a,b] -> putStrLn $ show a ++ " " ++ show (a*2) ) ts

main = getContents >>= putStr . unlines . map (solve . words) . tail . lines
    where solve (x:_) = x ++ (' ' : (show $ 2 * (read x)))

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  replicateM_ n $ do
    [l,r] <- map read . words <$> getLine :: IO [Int]
    putStrLn $ shows l $ ' ' : show (2*l)

import Control.Monad
main = do
  t <- readLn
  replicateM_ t $ do
    [l,r] <- map read . words <$> getLine
    putStrLn $ show l ++ " " ++ show (2*l)

main = getContents >>= putStrLn . unlines . solve . map read . tail . words

solve [] = []
solve (l:_:ls) = ((show l) ++ " " ++ (show (2 * l))) : solve ls

ipt :: Int -> IO ()
ipt t
 | t == 0 = return ()
 | otherwise = do
  z <- getLine
  let x = words z
  putStrLn (show (read (x !! 0) :: Integer) ++ " " ++ show ((read (x !! 0) :: Integer) * 2))
  ipt (t - 1)

main = do
 x <- getLine
 ipt (read x :: Int)

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

process = do
		[a,b]<-map read <$> words <$> getLine :: IO [Int]
		putStrLn $ intercalate " " $ map show $ head [[x,y]|x<-[a..b],y<-[x+x..b], mod y x ==0]
main = do
		n<- read <$> getLine:: IO Int
		replicateM_ n process

process :: Int -> Int -> (Int, Int)
process l r = (l, 2*l)

readInt :: String -> Int
readInt = read

showPair :: (Int, Int) -> String
showPair (x,y) = show x ++ " " ++ show y

main :: IO ()
main = do
    t <- fmap readInt getLine
    ts <- fmap (map (map readInt.words).lines) getContents
    mapM_ (putStrLn.showPair) $ map (\[l,r] -> process l r) ts

ipt :: Int -> IO ()
ipt t
 | t == 0 = return ()
 | otherwise = do
  z <- getLine
  let x = words z
  print (show (read (x !! 0) :: Integer) ++ " " ++ show ((read (x !! 0) :: Integer) * 2))
  ipt (t - 1)

main = do
 x <- getLine
 ipt (read x :: Int)

ipt :: Int -> IO ()
ipt t
 | t == 0 = print ""
 | otherwise = do
  z <- getLine
  let x = words z
  print (show (read (x !! 0) :: Integer) ++ " " ++ show ((read (x !! 0) :: Integer) * 2))
  ipt (t - 1)

main = do
 x <- getLine
 ipt (read x :: Int)


One day, at the "Russian Code Cup" event it was decided to play football as an out of competition event. All participants was divided into n teams and played several matches, two teams could not play against each other more than once.The appointed Judge was the most experienced member — Pavel. But since he was the wisest of all, he soon got bored of the game and fell asleep. Waking up, he discovered that the tournament is over and the teams want to know the results of all the matches.Pavel didn't want anyone to discover about him sleeping and not keeping an eye on the results, so he decided to recover the results of all games. To do this, he asked all the teams and learned that the real winner was friendship, that is, each team beat the other teams exactly k times. Help Pavel come up with chronology of the tournir that meets all the conditions, or otherwise report that there is no such table.

The first line contains two integers — n and k (1 ≤ n, k ≤ 1000).

In the first line print an integer m — number of the played games. The following m lines should contain the information about all the matches, one match per line. The i-th line should contain two integers ai and bi (1 ≤ ai, bi ≤ n; ai ≠ bi). The numbers ai and bi mean, that in the i-th match the team with number ai won against the team with number bi. You can assume, that the teams are numbered from 1 to n. If a tournir that meets the conditions of the problem does not exist, then print -1.

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  if n < k * 2 + 1
    then print (-1)
    else do
    print (n*k)
    forM_ [0..n-1] $ \i -> do
      forM_ [1..k] $ \j -> do
        putStrLn $ unwords $ map show [i+1, (i+j)`mod`n+1]

  return ()

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

main :: IO ()
main = do
	[n, k] <- inputInts
	if (2*k > n-1) then print (-1) else do
		print $ n*k
		printMatrix [[(i+1),((i+j+1)`rem`n + 1)] | i <- [0..n-1], j <- [0..k-1]]

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]
-- }}}

main :: IO ()
main = do
	[n, k] <- inputInts
	if (2*k > n-1) then print (-1) else do
		print $ n*k
		sequence_ [printf "%d %d\n" (i+1) ((i+j+1)`rem`n + 1) | i <- [0..n-1], j <- [0..k-1]]

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn . unwords $ map show xs
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr . unlines $ map (unwords . map show) xs
-- }}}

main :: IO ()
main = do
	[n, k] <- inputInts
	if (2*k > n-1) then print (-1) else do
		print $ n*k
		printMatrix [[(i+1),((i+j+1)`rem`n + 1)] | i <- [0..n-1], j <- [0..k-1]]

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad
import Control.Monad.ST

import Data.Bits
import Data.Char
import Data.Either
import Data.Function
import Data.IORef
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
-- }}}
-- silly utilities {{{
(#) = flip ($)
infixl 0 #

glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)

(!>) :: Seq a -> Int -> a
(!>) = Seq.index
-- }}}
-- input and output {{{
inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = mapM_ (putStrLn . showMany) xs
-- }}}

main :: IO ()
main = do
	[n, k] <- inputInts
	if (2*k > n-1) then print (-1) else do
		print $ n*k
		printMatrix [[(i+1),((i+j+1)`rem`n + 1)] | i <- [0..n-1], j <- [0..k-1]]

import Control.Monad
import Control.Applicative
import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Array

readInt :: IO Integer
readInt = read <$> getLine
readIntList :: IO [Integer]
readIntList = fmap read . words <$> getLine
readIntArray :: Integer -> IO (Array Integer Integer)
readIntArray n = listArray (0, n-1) <$> readIntList
readSortedIntArray :: Integer -> IO (Array Integer Integer)
readSortedIntArray n = listArray (0, n-1) . sort <$> readIntList

main :: IO ()
main = do
  [n, k] <- readIntList
  if 2 * k <= n-1
    then do
      putStrLn $ show $ n*k
      forM [1..n] $ \i ->
        forM [1..k] $ \j ->
          putStrLn $ show i ++ " " ++ show ((i + j - 1) `mod` n + 1)
      return ()
    else putStrLn $ show (-1)

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  if n <= k
    then print (-1)
    else do
    print (n*k)
    forM_ [0..n-1] $ \i -> do
      forM_ [1..k] $ \j -> do
        putStrLn $ unwords $ map show [i+1, (i+j)`mod`n+1]

  return ()

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  if n == 1
    then print (-1)
    else do
    print (n*k)
    forM_ [0..n-1] $ \i -> do
      forM_ [1..k] $ \j -> do
        putStrLn $ unwords $ map show [i+1, (i+1)`mod`n+1]

  return ()

import Control.Applicative
import Control.Monad

main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  if n == 1
    then print (-1)
    else do
    print (n*k)
    forM_ [0..n-1] $ \i -> do
      forM_ [1..k] $ \j -> do
        putStrLn $ unwords $ map show [i+1, (i+j)`mod`n+1]

  return ()


You have a long stick, consisting of $$$m$$$ segments enumerated from $$$1$$$ to $$$m$$$. Each segment is $$$1$$$ centimeter long. Sadly, some segments are broken and need to be repaired.You have an infinitely long repair tape. You want to cut some pieces from the tape and use them to cover all of the broken segments. To be precise, a piece of tape of integer length $$$t$$$ placed at some position $$$s$$$ will cover segments $$$s, s+1, \ldots, s+t-1$$$.You are allowed to cover non-broken segments; it is also possible that some pieces of tape will overlap.Time is money, so you want to cut at most $$$k$$$ continuous pieces of tape to cover all the broken segments. What is the minimum total length of these pieces?

The first line contains three integers $$$n$$$, $$$m$$$ and $$$k$$$ ($$$1 \le n \le 10^5$$$, $$$n \le m \le 10^9$$$, $$$1 \le k \le n$$$) — the number of broken segments, the length of the stick and the maximum number of pieces you can use. The second line contains $$$n$$$ integers $$$b_1, b_2, \ldots, b_n$$$ ($$$1 \le b_i \le m$$$) — the positions of the broken segments. These integers are given in increasing order, that is, $$$b_1 < b_2 < \ldots < b_n$$$.

Print the minimum total length of the pieces.

NoteIn the first example, you can use a piece of length $$$11$$$ to cover the broken segments $$$20$$$ and $$$30$$$, and another piece of length $$$6$$$ to cover $$$75$$$ and $$$80$$$, for a total length of $$$17$$$.In the second example, you can use a piece of length $$$4$$$ to cover broken segments $$$1$$$, $$$2$$$ and $$$4$$$, and two pieces of length $$$1$$$ to cover broken segments $$$60$$$ and $$$87$$$.

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

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

main :: IO ()
main = do
  [n,m,k] <- map read . words <$> getLine
  bs <- take n . unfoldr (BS.readInt . BS.dropWhile (<'!')) <$> BS.getLine
  let diffs = sort $ map (+(-1)) $ zipWith (-) (tail bs) bs
  print $ (n +) $! sum $ take (n-k) diffs

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

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

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

import Text.Printf
import Control.Monad
import Data.List

glwr = fmap (map read . words) getLine

main = do
  [n, l, r] <- glwr
  ls <- glwr
  putStrLn . show $ solve n l r ls

solve n l r ls = fst $ foldl sumSub (0, ls) splitIndices'
  where
    interval = zipWith (-) (tail ls) ls
    breakIndices = sort . map snd . take (r-1) . sortBy (flip compare)
      $ zip interval [1..]
    splitIndices = breakIndices ++ [n]
    splitIndices' = zipWith (-) splitIndices (0:splitIndices)

sumSub (n, ls) x = (n', ls')
  where
    (sub, ls') = splitAt x ls
    n' = last sub - head sub + n + 1

import Data.List
main = interact $ show . process . map read . words
process :: [Int] -> Int
process (n:m:k:a) = n + sum ( drop (k-1) $ reverse $ sort $ map pred $ zipWith (-) (tail a) a)

import Text.Printf
import Control.Monad
import qualified Data.IntMap as IM
import Data.List

glwr = fmap (map read . words) getLine

main = do
  [n, l, r] <- glwr
  ls@(_:xs) <- glwr
  let interval = zipWith (-) xs ls
      breakIndices = sort . map snd . take (r-1)
        $ IM.toDescList . IM.fromList $ zip interval [1..]
      newIndices = breakIndices ++ [n]
      takeAt = zipWith (-) newIndices (0:newIndices)
      minLen = addSub 0 ls takeAt
  putStrLn $ show minLen

addSub n _ [] = n
addSub n ls (s:ss)
  | s == 1 = addSub (n+1) ls' ss
  | otherwise = addSub n' ls' ss
  where
    (a, ls') = splitAt s ls
    n' = last a - head a + 1 + n

import Text.Printf
import Control.Monad
import qualified Data.IntMap as IM
import Data.List

glwr = fmap (map read . words) getLine

main = do
  [n, l, r] <- glwr
  ls <- glwr
  let interval = zipWith (-) (tail ls) ls
      breakIndices = sort . map snd . take (r-1)
        $ IM.toDescList . IM.fromList $ zip interval [1..]
      newIndices = breakIndices ++ [n]
      takeAt = zipWith (-) newIndices (0:newIndices)
      minLen = if n == 0 then 0 else addSub 0 ls takeAt
  putStrLn $ show minLen

addSub n _ [] = n
addSub n ls (s:ss)
  | s == 1 = addSub (n+1) ls' ss
  | otherwise = addSub n' ls' ss
  where
    (a, ls') = splitAt s ls
    n' = last a - head a + 1 + n


This problem is different from the hard version. In this version Ujan makes exactly one exchange. You can hack this problem only if you solve both problems.After struggling and failing many times, Ujan decided to try to clean up his house again. He decided to get his strings in order first.Ujan has two distinct strings $$$s$$$ and $$$t$$$ of length $$$n$$$ consisting of only of lowercase English characters. He wants to make them equal. Since Ujan is lazy, he will perform the following operation exactly once: he takes two positions $$$i$$$ and $$$j$$$ ($$$1 \le i,j \le n$$$, the values $$$i$$$ and $$$j$$$ can be equal or different), and swaps the characters $$$s_i$$$ and $$$t_j$$$. Can he succeed?Note that he has to perform this operation exactly once. He has to perform this operation.

The first line contains a single integer $$$k$$$ ($$$1 \leq k \leq 10$$$), the number of test cases. For each of the test cases, the first line contains a single integer $$$n$$$ ($$$2 \leq n \leq 10^4$$$), the length of the strings $$$s$$$ and $$$t$$$.  Each of the next two lines contains the strings $$$s$$$ and $$$t$$$, each having length exactly $$$n$$$. The strings consist only of lowercase English letters. It is guaranteed that strings are different.

For each test case, output "Yes" if Ujan can make the two strings equal and "No" otherwise. You can print each letter in any case (upper or lower).

4
5
souse
houhe
3
cat
dog
2
aa
az
3
abc
bca

NoteIn the first test case, Ujan can swap characters $$$s_1$$$ and $$$t_4$$$, obtaining the word "house".In the second test case, it is not possible to make the strings equal using exactly one swap of $$$s_i$$$ and $$$t_j$$$.

main=interact$unlines.l.lines
l=g.tail where g[]=[];g(_:n:m:x)=s n m:g x
s n=e.filter(uncurry(/=)).zip n
e(x:y:[])=if x==y then"Yes"else"No"
e x="No"

main=interact$unlines.g.tail.lines
g[]=[]
g(_:n:m:x)=s n m:g x
s n=e.filter(uncurry(/=)).zip n
e(x:y:[])=if x==y then"Yes"else"No"
e x="No"

main=interact$unlines.l.lines
l=g.tail where g[]=[];g(_:n:m:x)=s n m:g x
s n=e.filter(uncurry(/=)).zip n
e((a,b):(c,d):[])=if a==c&&b==d then"Yes"else"No"
e x="No"

module Main where

import Control.Monad

main :: IO ()
main = do
    cas <- readLn
    replicateM_ cas $ do
        _ <- getLine
        s <- getLine
        t <- getLine
        putStrLn $ f s t

f :: String -> String -> String
f s t
    | s == t = "Yes"
    | otherwise = if length dif == 2 && fi == se then "Yes" else "No"
        where dif = g s t
              fi = dif !! 0
              se = dif !! 1

g :: String -> String -> [(Char, Char)]
g [] _ = []
g _ [] = []
g (x:xs) (y:ys)
    | x == y = g xs ys
    | otherwise = (x, y) : g xs ys

import Data.List as L

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n strings = (L.take n strings):(groupByNLines n (L.drop n strings))

stringToIntegerArray :: String -> [Integer]
stringToIntegerArray = L.map (\x -> read x :: Integer) . words

main :: IO ()
main = interact (unlines . map parse . groupByNLines 3 . tail . lines)

parse :: [String] -> String
parse [_, s', t']
  | ans = "YES"
  | otherwise = "NO"
  where ans = solve s' t'

diff :: (String, String) -> (String, String)
diff ("", "") = ("", "")
diff ((a:as), (b:bs))
  | a == b = (x, y)
  | otherwise = (a:x, b:y)
  where (x, y) = diff (as, bs)

solve :: String -> String -> Bool
solve s t
  | length ds /= 2 = False
  | otherwise = (ds !! 0) == (ds !! 1) && (dt !! 0) == (dt !! 1)
  where (ds, dt) = diff (s, t)

main=interact$unlines.l.lines
l=g.tail where g[]=[];g(_:n:m:x)=s n m:g x
s n=e.filter(uncurry(/=)).zip n
e((a,b):(c,d):_)=if a==c&&b==d then"Yes"else"No"
e x="No"


You are given an array $$$a$$$ with $$$n$$$ integers. You can perform the following operation at most $$$k$$$ times:  Choose two indices $$$i$$$ and $$$j$$$, in which $$$i \,\bmod\, k = j \,\bmod\, k$$$ ($$$1 \le i < j \le n$$$).  Swap $$$a_i$$$ and $$$a_j$$$. After performing all operations, you have to select $$$k$$$ consecutive elements, and the sum of the $$$k$$$ elements becomes your score. Find the maximum score you can get.Here $$$x \bmod y$$$ denotes the remainder from dividing $$$x$$$ by $$$y$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 600$$$) — the number of test cases. Each test case consists of two lines.  The first line of each test case contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le k \le n \le 100$$$) — the length of the array and the number in the statement above. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$)  — the array itself.

For each test case, print the maximum score you can get, one per line.

NoteIn the first test case, we can get a score of $$$11$$$ if we select $$$a_1, a_2$$$ without performing any operations.In the third test case, we can get a score of $$$15$$$ if we first swap $$$a_1$$$ with $$$a_4$$$ and then select $$$a_3, a_4, a_5$$$.

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import Data.Function (on)
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int -> [Int64] -> Int64
solve n k as = L.sum . L.map (L.maximum . L.map snd).  L.groupBy ((==) `on` fst) . L.sort . L.map (\(i, a) -> (i `mod` k, a)) . L.zip [0 ..] $ as

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, k] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntegerB8s <&> L.map fromInteger
        let answer = solve n k as
        printf "%lld\n" answer

import Data.Array
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[n, k] -> map read . words <$> getLine >>=
        print . maxScore n k

maxScore :: Int -> Int -> [Int] -> Int
maxScore n k as = let a = listArray (0, n-1) as
                      q = div n k
                      r = rem n k
                      is = [[i+a*k | a <- [0..q+1], i+a*k < n] | i <- [0 .. k-1]]
                  in
                    sum . map (maximum . map (a!)) . filter (/= [])  $ is

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [[n,k], xs] <- replicateM 2 ri
        return (n,k,xs)
    mapM_ (putStrLn.show.solve) tcs

solve (_n,k,xs) = rp
  where
    rp = sum . map (maximum . map snd) . sortGroupOn fst . (`zip`xs) . map (`mod`k) $ inds

inds = [0..] :: [Int]

sortGroupOn f = L.groupBy ((==)`on`f) . L.sortOn f

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

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import Data.Function (on)
import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

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

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int -> [Int64] -> Int64
solve n k as = L.sum . L.map (L.maximum . L.map snd).  L.groupBy ((==) `on` fst) . L.map (\(i, a) -> (i `mod` k, a)) . L.zip [0 ..] $ as

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, k] <- B8.getLine <&> readIntB8s
        as <- B8.getLine <&> readIntegerB8s <&> L.map fromInteger
        let answer = solve n k as
        printf "%lld\n" answer


General Payne has a battalion of n soldiers. The soldiers' beauty contest is coming up, it will last for k days. Payne decided that his battalion will participate in the pageant. Now he has choose the participants.All soldiers in the battalion have different beauty that is represented by a positive integer. The value ai represents the beauty of the i-th soldier.On each of k days Generals has to send a detachment of soldiers to the pageant. The beauty of the detachment is the sum of the beauties of the soldiers, who are part of this detachment. Payne wants to surprise the jury of the beauty pageant, so each of k days the beauty of the sent detachment should be unique. In other words, all k beauties of the sent detachments must be distinct numbers.Help Payne choose k detachments of different beauties for the pageant. Please note that Payne cannot just forget to send soldiers on one day, that is, the detachment of soldiers he sends to the pageant should never be empty.

The first line contains two integers n, k (1 ≤ n ≤ 50; 1 ≤ k ≤  ) — the number of soldiers and the number of days in the pageant, correspondingly. The second line contains space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 107) — the beauties of the battalion soldiers. It is guaranteed that Payne's battalion doesn't have two soldiers with the same beauty.

Print k lines: in the i-th line print the description of the detachment that will participate in the pageant on the i-th day. The description consists of integer ci (1 ≤ ci ≤ n) — the number of soldiers in the detachment on the i-th day of the pageant and ci distinct integers p1, i, p2, i, ..., pci, i — the beauties of the soldiers in the detachment on the i-th day of the pageant. The beauties of the soldiers are allowed to print in any order. Separate numbers on the lines by spaces. It is guaranteed that there is the solution that meets the problem conditions. If there are multiple solutions, print any of them.

import Control.Arrow
import Control.Monad
import Data.Function
import Data.List

main = do
  [n, m] <- fmap (map read . words) getLine
  a <- fmap (sort . map read . words) getLine
  forM_ (foldl (gao (m + 1)) [(0, [])] a) $ \(_, i) ->
    when (not $ null i) $
      putStrLn $ unwords $ map show $ length i: i
  where
    gao n b a = take n $ map head $ groupBy ((==) `on` fst) $ sort $
      b ++ map ((a+) *** (a:)) b

import Data.List
main=interact$unlines.f.map read.words
f(_:k:xs)|ys<-sort xs = take k $ g 1 (reverse ys) $ map (:[]) ys
g i (x:xs) yss = map(unwords.map show.(i:))yss ++ g (i+1) xs (map (x:) $ init yss)
g _ _ _ = []


Polycarp likes arithmetic progressions. A sequence $$$[a_1, a_2, \dots, a_n]$$$ is called an arithmetic progression if for each $$$i$$$ ($$$1 \le i < n$$$) the value $$$a_{i+1} - a_i$$$ is the same. For example, the sequences $$$[42]$$$, $$$[5, 5, 5]$$$, $$$[2, 11, 20, 29]$$$ and $$$[3, 2, 1, 0]$$$ are arithmetic progressions, but $$$[1, 0, 1]$$$, $$$[1, 3, 9]$$$ and $$$[2, 3, 1]$$$ are not.It follows from the definition that any sequence of length one or two is an arithmetic progression.Polycarp found some sequence of positive integers $$$[b_1, b_2, \dots, b_n]$$$. He agrees to change each element by at most one. In the other words, for each element there are exactly three options: an element can be decreased by $$$1$$$, an element can be increased by $$$1$$$, an element can be left unchanged.Determine a minimum possible number of elements in $$$b$$$ which can be changed (by exactly one), so that the sequence $$$b$$$ becomes an arithmetic progression, or report that it is impossible.It is possible that the resulting sequence contains element equals $$$0$$$.

The first line contains a single integer $$$n$$$ $$$(1 \le n \le 100\,000)$$$ — the number of elements in $$$b$$$. The second line contains a sequence $$$b_1, b_2, \dots, b_n$$$ $$$(1 \le b_i \le 10^{9})$$$.

If it is impossible to make an arithmetic progression with described operations, print -1. In the other case, print non-negative integer — the minimum number of elements to change to make the given sequence becomes an arithmetic progression. The only allowed operation is to add/to subtract one from an element (can't use operation twice to the same position).

NoteIn the first example Polycarp should increase the first number on $$$1$$$, decrease the second number on $$$1$$$, increase the third number on $$$1$$$, and the fourth number should left unchanged. So, after Polycarp changed three elements by one, his sequence became equals to $$$[25, 20, 15, 10]$$$, which is an arithmetic progression.In the second example Polycarp should not change anything, because his sequence is an arithmetic progression.In the third example it is impossible to make an arithmetic progression.In the fourth example Polycarp should change only the first element, he should decrease it on one. After that his sequence will looks like $$$[0, 3, 6, 9, 12]$$$, which is an arithmetic progression.

import qualified Data.ByteString.Lazy.Char8 as B

main = do
  inp <- B.getContents
  let (n:bs) = map readI $ B.words inp
  print (solve bs)

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

solve :: [Int] -> Int
solve [x] = 0
solve [x1,x2] = 0
solve (x1:x2:xs) =
  case map fst $ foldl f init xs of
    [] -> -1
    ys -> minimum ys
  where
    init :: [(Int,(Int,Int))]
    init = [(abs d1 + abs d2, (x2+d2-x1-d1, x2+d2)) | d1<-[-1,0,1], d2<-[-1,0,1]]

    f :: [(Int,(Int,Int))] -> Int -> [(Int,(Int,Int))]
    f rs a = [(s+abs da, (d,b))| (s,(d,r))<-rs, da<-[-1,0,1], let b=a+da, b-r== d]


You are given an array $$$d_1, d_2, \dots, d_n$$$ consisting of $$$n$$$ integer numbers.Your task is to split this array into three parts (some of which may be empty) in such a way that each element of the array belongs to exactly one of the three parts, and each of the parts forms a consecutive contiguous subsegment (possibly, empty) of the original array. Let the sum of elements of the first part be $$$sum_1$$$, the sum of elements of the second part be $$$sum_2$$$ and the sum of elements of the third part be $$$sum_3$$$. Among all possible ways to split the array you have to choose a way such that $$$sum_1 = sum_3$$$ and $$$sum_1$$$ is maximum possible.More formally, if the first part of the array contains $$$a$$$ elements, the second part of the array contains $$$b$$$ elements and the third part contains $$$c$$$ elements, then:$$$$$$sum_1 = \sum\limits_{1 \le i \le a}d_i,$$$$$$ $$$$$$sum_2 = \sum\limits_{a + 1 \le i \le a + b}d_i,$$$$$$ $$$$$$sum_3 = \sum\limits_{a + b + 1 \le i \le a + b + c}d_i.$$$$$$The sum of an empty array is $$$0$$$.Your task is to find a way to split the array such that $$$sum_1 = sum_3$$$ and $$$sum_1$$$ is maximum possible.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in the array $$$d$$$. The second line of the input contains $$$n$$$ integers $$$d_1, d_2, \dots, d_n$$$ ($$$1 \le d_i \le 10^9$$$) — the elements of the array $$$d$$$.

Print a single integer — the maximum possible value of $$$sum_1$$$, considering that the condition $$$sum_1 = sum_3$$$ must be met. Obviously, at least one valid way to split the array exists (use $$$a=c=0$$$ and $$$b=n$$$).

NoteIn the first example there is only one possible splitting which maximizes $$$sum_1$$$: $$$[1, 3, 1], [~], [1, 4]$$$.In the second example the only way to have $$$sum_1=4$$$ is: $$$[1, 3], [2, 1], [4]$$$.In the third example there is only one way to split the array: $$$[~], [4, 1, 2], [~]$$$.

{- <ღ> Haskell -}
module Main where
import Data.Sequence as S

main :: IO ()
main = interact $ solve

toInt :: String -> Integer
toInt s = read s :: Integer

solve :: String -> String
solve s = show $ check (fromList (map toInt (tail (words s)))) 0 0 0

check :: Seq Integer -> Integer -> Integer -> Integer -> Integer
check xs ls rs ss =
    if S.null xs then if ls == rs then ls else ss else
    let l :< xl = viewl xs
        xr :> r = viewr xs
        in  if ls == rs
                then check xl (ls + l) rs ls
            else if ls > rs
                then check xr ls (rs + r) ss
            else check xl (ls + l) rs ss

{- <ღ> Haskell -}
module Main where
import Data.Sequence as S

main :: IO ()
main = interact $ solve

toInt :: String -> Integer
toInt s = read s :: Integer

solve :: String -> String
solve s = show $! check (fromList (map toInt (tail (words s)))) 0 0 0

check :: Seq Integer -> Integer -> Integer -> Integer -> Integer
check xs ls rs ss =
    if S.null xs then if ls == rs then ls else ss else
    let l :< xl = viewl xs
        xr :> r = viewr xs
        in  if ls == rs
                then check xl (ls + l) rs ls
            else if ls > rs
                then check xr ls (rs + r) ss
            else check xl (ls + l) rs ss

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Functor
import Data.Char (ord)
import qualified Data.ByteString.Char8 as B8

prefixSums _ [] = []
prefixSums !acc (x:xs) = let r = acc + x in r : prefixSums r xs

parseInt :: B8.ByteString -> Integer
parseInt str = parseInt' str 0 where
        parseInt' str !acc
             | B8.null str  = acc
             | otherwise = parseInt' (B8.tail str) $ (fromIntegral $ ord (B8.head str)) - 48 + acc * 10

solve s a b = solve' a b
        where
                solve' [] _ = 0
                solve' _ [] = 0
                solve' (x:xs) (y:ys) = if (s - y) < x
                                       then solve' xs (y:ys)
                                       else if (s - y) > x
                                            then solve' (x:xs) ys
                                            else x

main = do
        _ <- B8.getLine
        xs <- map parseInt . B8.words <$> B8.getLine :: IO [Integer]
        let prefixes = prefixSums 0 xs
            lasts = last prefixes
            (as, bs) = span ((>=) (lasts `div` 2)) prefixes
            as' = reverse as
            bs' = if as == [] then [] else [head as'] ++ bs
        print $ solve lasts as' bs'

{- <ღ> Haskell -}
module Main where
import Data.Sequence as S

main :: IO ()
main = interact $ sol

toInt :: String -> Int
toInt s = read s :: Int

sol :: String -> String
sol s = show $ ch (fromList (map toInt (tail (words s)))) 0 0 0

ch :: Seq Int -> Int -> Int -> Int -> Int
ch xs ls rs ss =
    if S.null xs then if ls == rs then ls else ss else
    let l :< xl = viewl xs
        xr :> r = viewr xs
        in  if ls == rs
                then ch xl (ls + l) rs ls
            else if ls > rs
                then ch xr ls (rs + r) ss
            else ch xl (ls + l) rs ss

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Functor

pss [] _ = []
pss (!x:xs) acc = let y = x + acc in y : pss xs y

main = do
        n <- read <$> getLine :: IO Int
        ns <- map read . words <$> getLine :: IO [Int]
        let prefixes = pss ns 0
            lasts = last prefixes
            s = lasts `div` 2
            (xs, ys) = span ((>=) s) prefixes
            xs' = reverse xs
            ys' = if n `mod` 2 == 1 then (head xs):ys else ys
        let ans = takeWhile (\(x, y) -> (lasts - y) /= x) $ zip xs' ys'
        print $ case ans of
                        [] -> 0
                        (xoro:_) -> fst xoro

{-# LANGUAGE BangPatterns #-}

import Data.List
import Data.Functor
import Data.Char (ord)
import qualified Data.ByteString.Char8 as B8

prefixSums _ [] = []
prefixSums !acc (x:xs) = let r = acc + x in r : prefixSums r xs

parseInt :: B8.ByteString -> Int
parseInt str = parseInt' str 0 where
        parseInt' str !acc
             | B8.null str  = acc
             | otherwise = parseInt' (B8.tail str) $ ord (B8.head str) - 48 + acc * 10

solve s a b = solve' a b
        where
                solve' [] _ = 0
                solve' _ [] = 0
                solve' (x:xs) (y:ys) = if (s - y) < x
                                       then solve' xs (y:ys)
                                       else if (s - y) > x
                                            then solve' (x:xs) ys
                                            else x

main = do
        _ <- B8.getLine
        xs <- map parseInt . B8.words <$> B8.getLine :: IO [Int]
        let prefixes = prefixSums 0 xs
            lasts = last prefixes
            (as, bs) = span ((>=) (lasts `div` 2)) prefixes
            as' = reverse as
            bs' = if as == [] then [] else [head as'] ++ bs
        print $ solve lasts as' bs'


Alexander is a well-known programmer. Today he decided to finally go out and play football, but with the first hit he left a dent on the new Rolls-Royce of the wealthy businessman Big Vova. Vladimir has recently opened a store on the popular online marketplace "Zmey-Gorynych", and offers Alex a job: if he shows his programming skills by solving a task, he'll work as a cybersecurity specialist. Otherwise, he'll be delivering some doubtful products for the next two years.You're given $$$n$$$ positive integers $$$a_1, a_2, \dots, a_n$$$. Using each of them exactly at once, you're to make such sequence $$$b_1, b_2, \dots, b_n$$$ that sequence $$$c_1, c_2, \dots, c_n$$$ is lexicographically maximal, where $$$c_i=GCD(b_1,\dots,b_i)$$$ - the greatest common divisor of the first $$$i$$$ elements of $$$b$$$. Alexander is really afraid of the conditions of this simple task, so he asks you to solve it.A sequence $$$a$$$ is lexicographically smaller than a sequence $$$b$$$ if and only if one of the following holds: $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$; in the first position where $$$a$$$ and $$$b$$$ differ, the sequence $$$a$$$ has a smaller element than the corresponding element in $$$b$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^3$$$)  — the length of the sequence $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1,\dots,a_n$$$ ($$$1 \le a_i \le 10^3$$$)  — the sequence $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^3$$$.

For each test case output the answer in a single line  — the desired sequence $$$b$$$. If there are multiple answers, print any.

NoteIn the first test case of the example, there are only two possible permutations $$$b$$$  — $$$[2, 5]$$$ and $$$[5, 2]$$$: for the first one $$$c=[2, 1]$$$, for the second one $$$c=[5, 1]$$$.In the third test case of the example, number $$$9$$$ should be the first in $$$b$$$, and $$$GCD(9, 3)=3$$$, $$$GCD(9, 8)=1$$$, so the second number of $$$b$$$ should be $$$3$$$.In the seventh test case of the example, first four numbers pairwise have a common divisor (a power of two), but none of them can be the first in the optimal permutation $$$b$$$.

{-# LANGUAGE BlockArguments #-}

import Control.Monad
import Data.List
import qualified Data.Set as S
import Control.Arrow
import Data.Ord

solve xs = unwords $ fmap show $ go (sortD $ map (id &&& id) xs) []
  where
    go [] l = reverse l
    go ((mg, mv):s') l = go (sortD $ map (gcd mg *** id) s') (mv:l)
    sortD = sortBy (comparing Down)

main = mkMain solve

mkMain f = do
  n <- readLn
  replicateM_ n do
    void $ getLine
    a <- map read . words <$> getLine
    putStrLn $ f a

{-# LANGUAGE BlockArguments #-}

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

solve xs = unwords $ fmap show $ go (S.map (id &&& id) $ S.fromList xs) []
  where
    go s l
      | S.null s = reverse l
      | otherwise = go (S.map (gcd mg *** id) s') (mv:l)
      where
        ((mg, mv), s') = S.deleteFindMax s

main = mkMain solve

mkMain f = do
  n <- readLn
  replicateM_ n do
    void $ getLine
    a <- map read . words <$> getLine
    putStrLn $ f a

{-# LANGUAGE BlockArguments #-}

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

solve xs = unwords $ fmap show $ go (sort $ map (id &&& id) xs) []
  where
    go [] l = reverse l
    go ((mg, mv):s') l = go (sort $ map (gcd mg *** id) s') (mv:l)

main = mkMain solve

mkMain f = do
  n <- readLn
  replicateM_ n do
    void $ getLine
    a <- map read . words <$> getLine
    putStrLn $ f a


You found a painting on a canvas of size $$$n \times m$$$. The canvas can be represented as a grid with $$$n$$$ rows and $$$m$$$ columns. Each cell has some color. Cell $$$(i, j)$$$ has color $$$c_{i,j}$$$.Near the painting you also found a brush in the shape of a $$$2 \times 2$$$ square, so the canvas was surely painted in the following way: initially, no cell was painted. Then, the following painting operation has been performed some number of times:  Choose two integers $$$i$$$ and $$$j$$$ ($$$1 \le i < n$$$, $$$1 \le j < m$$$) and some color $$$k$$$ ($$$1 \le k \le nm$$$).  Paint cells $$$(i, j)$$$, $$$(i + 1, j)$$$, $$$(i, j + 1)$$$, $$$(i + 1, j + 1)$$$ in color $$$k$$$. All cells must be painted at least once. A cell can be painted multiple times. In this case, its final color will be the last one.Find any sequence of at most $$$nm$$$ operations that could have led to the painting you found or state that it's impossible.

The first line of input contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n, m \le 1000$$$) — the dimensions of the canvas. On the $$$i$$$-th of the next $$$n$$$ lines of input, there will be $$$m$$$ integers. The $$$j$$$-th of them is $$$a_{i,j}$$$ ($$$1 \le a_{i,j} \le nm$$$) — the color of cell $$$(i, j)$$$.

If there is no solution, print a single integer $$$-1$$$. Otherwise, on the first line, print one integer $$$q$$$ ($$$1 \le q \le nm$$$) — the number of operations. Next, print the operations in order. On the $$$k$$$-th of the next $$$q$$$ lines, print three integers $$$i$$$, $$$j$$$, $$$c$$$ ($$$1 \le i < n$$$, $$$1 \le j < m$$$, $$$1 \le c \le nm$$$) — the description of the $$$k$$$-th operation. If there are multiple solutions, print any.

NoteIn the first test case, the solution is not unique. Here's one of them:  In the second test case, there is no way one could obtain the given painting, thus the answer is $$$-1$$$.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE LambdaCase, TypeApplications #-}
import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Maybe
import qualified Data.ByteString.Char8 as C

data V2 = !Int :+ !Int deriving (Eq, Ord) -- Curse you, (Int, Int)!

instance Ix V2 where
    range   (li :+ ri, lj :+ rj)            = [i :+ j | i <- [li..ri], j <- [lj..rj]]
    inRange (li :+ ri, lj :+ rj) (lk :+ rk) = li <= lk && lk <= lj && ri <= rk && rk <= rj
    index   (li :+ ri, _  :+ rj) (lk :+ rk) = (lk - li) * (rj - ri + 1) + rk - ri

main :: IO ()
main = do
    ~[n, m] <- readInts
    ba <- unsafeThaw @_ @UArray @_ @IOUArray . listArray (1 :+ 1, n :+ m) . concat =<< replicateM n readInts
    let neighbors (i :+ j) =
            filter (/=(i :+ j)) $
            (:+) <$> [max 1 (i-1) .. min (n-1) (i+1)] <*> [max 1 (j-1) .. min (m-1) (j+1)]
        readBox (i :+ j) = do
            c0 <- readArray ba (i     :+ j)
            c1 <- readArray ba (i     :+ (j+1))
            c2 <- readArray ba ((i+1) :+ j)
            c3 <- readArray ba ((i+1) :+ (j+1))
            pure [c0, c1, c2, c3] :: IO [Int]
        writeBox0 (i :+ j) = do
            writeArray ba (i     :+ j)     0
            writeArray ba (i     :+ (j+1)) 0
            writeArray ba ((i+1) :+ j)     0
            writeArray ba ((i+1) :+ (j+1)) 0 :: IO ()
        add qvs@(q, vs) v = filter (/=0) <$> readBox v >>= \case
            (c:cs) | all (==c) cs -> (v:q, (v, c):vs) <$ writeBox0 v
            _                     -> pure qvs
        dfs ([],  vs) = pure vs
        dfs (u:q, vs) = foldM add (q, vs) (neighbors u) >>= dfs
    ans <- dfs =<< foldM add ([], []) ((:+) <$> [1 .. n-1] <*> [1 .. m-1])
    done <- all (==0) <$> getElems ba
    mapM_ (putStrLn . unwords . map show) $ if done
        then [length ans] : map (\(i :+ j, c) -> [i, j, c]) ans
        else [[-1]]

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

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

import Data.Array.ST.Safe
import Control.Monad.ST

data Act = Act !Int !Int !Int

solve :: UArray (Int, Int) Int -> Maybe [Act]
solve inArr = runST $ do
  arr :: STUArray s (Int, Int) Int
      <- thaw inArr :: ST s (STUArray s (Int, Int) Int)
  let  ((rmin, cmin), (rmax, cmax)) = bounds inArr
       cutBnds = ((rmin, cmin), (rmax - 1, cmax - 1))
  stack :: STArray s Int (Int, Int)
        <- newListArray (1, rangeSize cutBnds) (range cutBnds)
  inStack :: STUArray s (Int, Int) Bool
          <- newArray cutBnds True
  let
    tryPush :: Int -> (Int, Int) -> ST s Int
    tryPush stackSize p = if  not $ inRange cutBnds p
      then  pure stackSize
      else  do
      pInStack <- readArray inStack p
      if  pInStack
        then  pure stackSize
        else  do
        let  nStackSize = stackSize + 1
        writeArray stack nStackSize p
        writeArray inStack p True
        pure nStackSize

    go :: [Act] -> Int -> ST s [Act]
    go acts 0 = pure acts
    go acts top = do
      (i, j) <- readArray stack top
      let  nbrs = liftM2 (,) [i - 1 .. i + 1] [j - 1 .. j + 1]
           sqr  = liftM2 (,) [i     .. i + 1] [j     .. j + 1]
      vs <- mapM (readArray arr) sqr
      case  filter (/= 0) vs  of
        nz : nzs | all (== nz) nzs -> do
                     forM_ sqr $ \p -> writeArray arr p 0
                     ntop <- foldM tryPush (top - 1) nbrs
                     --writeArray inStack (i, j) False --no need to check again
                     go (Act i j nz : acts) ntop
        _ -> writeArray inStack (i, j) False >> go acts (top - 1)
  acts <- go [] (rangeSize cutBnds)
  solved <- all (<= 0) <$> getElems arr
  pure $ if  solved
    then  Just acts
    else  Nothing

mainFun :: SP Builder
mainFun = do
  n <- getInt
  m <- getInt
  arr <- listArray ((1, 1), (n, m)) <$> replicateM (n * m) getInt
  pure $ case  solve arr  of
    Just li
      -> putInts [length li] <> foldMap (\(Act i j c) -> putInts [i, j, c]) li
    Nothing -> string7 "-1\n"

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

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

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

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

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

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

{-# LANGUAGE TypeApplications #-}
import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Maybe
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    ~[n, m] <- readInts
    ba' <- listArray @UArray ((1, 1), (n, m)) . concat <$> replicateM n readInts
    ba <- unsafeThaw @_ @_ @_ @IOUArray ba'
    let neighbors (i, j) =
            filter (/=(i, j)) $
            (,) <$> [max 1 (i-1) .. min (n-1) (i+1)] <*> [max 1 (j-1) .. min (m-1) (j+1)]
        box (i, j) = (,) <$> [i, i+1] <*> [j, j+1]
        add qvs@(q, vs) v = do
            cs <- filter (/=0) <$> mapM (readArray ba) (box v)
            case cs of
                (c:_) | all (==c) cs -> (v:q, (v, c):vs) <$ mapM_ (flip (writeArray ba) 0) (box v)
                _                    -> pure @IO qvs
        dfs ([],  vs) = pure vs
        dfs (u:q, vs) = foldM add (q, vs) (neighbors u) >>= dfs
    ans <- dfs =<< foldM add ([], []) ((,) <$> [1 .. n-1] <*> [1 .. m-1])
    if length ans < (n - 1) * (m - 1)
        then print (-1)
        else mapM_ (putStrLn . unwords . map show) $
            ((:) <$> (:[]) . length <*> map (\((i, j), c) -> [i, j, c])) ans

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

{-# LANGUAGE TypeApplications #-}
import Control.Monad
import Data.Array.IO
import Data.Array.Unboxed
import Data.Array.Unsafe
import Data.Maybe
import qualified Data.ByteString.Char8 as C

main :: IO ()
main = do
    ~[n, m] <- readInts
    ba' <- listArray @UArray ((1, 1), (n, m)) . concat <$> replicateM n readInts
    ba <- unsafeThaw @_ @_ @_ @IOUArray ba'
    let neighbors (i, j) =
            filter (/=(i, j)) $
            (,) <$> [max 1 (i-1) .. min (n-1) (i+1)] <*> [max 1 (j-1) .. min (m-1) (j+1)]
        box (i, j) = (,) <$> [i, i+1] <*> [j, j+1]
        add qvs@(q, vs) v = do
            cs <- filter (/=0) <$> mapM (readArray ba) (box v)
            case cs of
                (c:_) | all (==c) cs -> (v:q, (v, c):vs) <$ mapM_ (flip (writeArray ba) 0) (box v)
                _                    -> pure @IO qvs
        dfs ([],  vs) = pure vs
        dfs (u:q, vs) = foldM add (q, vs) (neighbors u) >>= dfs
    ans <- dfs =<< foldM add ([], []) ((,) <$> [1 .. n-1] <*> [1 .. m-1])
    if length ans < (n - 1) * (m - 1)
        then print (-1)
        else forM_ ans $ \((i, j), c) -> putStrLn $ unwords $ map show [i, j, c]

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

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

import Data.Array.ST.Safe
import Control.Monad.ST

data Act = Act !Int !Int !Int

solve :: UArray (Int, Int) Int -> Maybe [Act]
solve inArr = runST $ do
  arr :: STUArray s (Int, Int) Int
      <- thaw inArr :: ST s (STUArray s (Int, Int) Int)
  par :: STArray s (Int, Int) (Int, Int) <- newArray (bounds inArr) (0, 0)
  let
    okIx = inRange (bounds inArr)

    needsWork :: (Int, Int) -> ST s (Maybe Int)
    needsWork (i, j) | okIx (i, j) && okIx (i + 1, j + 1) = do
      let  ns = [(i, j), (i, j + 1), (i + 1, j), (i + 1, j + 1)]
      vs <- mapM (readArray arr) ns
      pure $ case  filter (> 0) vs  of
        nz : nzs | all (== nz) nzs  -> Just nz
        _ -> Nothing
    needsWork _ = pure Nothing

    go :: [Act] -> (Int, Int) -> ST s [Act]
    go acts (i, j) = do
      ok <- needsWork (i, j)
      let  rect = liftM2 (,) [i, i + 1] [j, j + 1]
           nbrs = liftM2 (,) [i - 1 .. i + 1] [j - 1 .. j + 1]
      case  ok  of
        Just c -> do
          let  nacts = Act i j c : acts
          forM_ rect $ \p -> writeArray arr p 0
          findNext nacts (i, j) $ filter okIx nbrs
        Nothing -> do
          v <- readArray par (i, j)
          if  not (okIx v) || v == (i, j)
            then  pure acts
            else  go acts v

    findNext :: [Act] -> (Int, Int) -> [(Int, Int)] -> ST s [Act]
    findNext acts _cpar [] = pure acts
    findNext acts cpar (p : ps) = do
      ok <- needsWork p
      case  ok  of
        Nothing -> findNext acts cpar ps
        Just _  -> writeArray par p cpar >> go acts p
  acts <- foldM go [] (indices inArr)
  solved <- all (<= 0) <$> getElems arr
  pure $ if  solved
    then  Just acts
    else  Nothing

mainFun :: SP Builder
mainFun = do
  n <- getInt
  m <- getInt
  arr <- listArray ((1, 1), (n, m)) <$> replicateM (n * m) getInt
  pure $ case  solve arr  of
    Just li
      -> putInts [length li] <> foldMap (\(Act i j c) -> putInts [i, j, c]) li
    Nothing -> string7 "-1\n"

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

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

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

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

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

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

{-# LANGUAGE ScopedTypeVariables #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

import Data.Array.ST.Safe
import Control.Monad.ST

data Act = Act !Int !Int !Int

solve :: UArray (Int, Int) Int -> Maybe [Act]
solve inArr = runST $ do
  arr :: STUArray s (Int, Int) Int
      <- thaw inArr :: ST s (STUArray s (Int, Int) Int)
  let
    okIx = inRange (bounds inArr)
    needsWork :: (Int, Int) -> ST s (Maybe Int)
    needsWork (i, j) | okIx (i, j) && okIx (i + 1, j + 1) = do
      let  ns = [(i, j), (i, j + 1), (i + 1, j), (i + 1, j + 1)]
      vs <- mapM (readArray arr) ns
      pure $ case  filter (> 0) vs  of
        nz : nzs | all (== nz) nzs  -> Just nz
        _ -> Nothing
    needsWork _ = pure Nothing

    go :: (Int, [Act]) -> (Int, Int) -> ST s (Int, [Act])
    go (iter, acts) (i, j) = do
      ok <- needsWork (i, j)
      case  ok  of
        Just c -> do
          let  nacts = Act i j c : acts
          writeArray arr (i, j) iter
          forM_ [(i, j+1), (i+1, j), (i+1, j+1)] $ \p -> do
            v <- readArray arr p
            when (v > 0) $ writeArray arr p 0
          lookNext nacts
        Nothing -> do
          v <- readArray arr (i, j)
          if  v >= 0
            then  pure (iter, acts)
            else  backtrack acts
        where
        nbrs = filter okIx [(i', j') | i' <- [i-1 .. i+1], j' <- [j-1 .. j+1]]
        lookNext nacts = do
          next <- filterM (fmap isJust . needsWork) nbrs
          case  next  of
            p : _ -> go (iter - 1, nacts) p
            [] -> backtrack nacts
        backtrack nacts = do
          currPosIter <- readArray arr (i, j)
          nvs <- mapM (readArray arr) nbrs
          case  sort $ filter (\v -> v < 0 && currPosIter < v) nvs  of
            [] -> pure (iter, nacts)
            tarv : _ -> do
              p : _ <- filterM (fmap (== tarv) . readArray arr) nbrs
              go (iter - 1, nacts) p
  (_, acts) <- foldM go (negate 1, []) (indices inArr)
  solved <- all (<= 0) <$> getElems arr
  pure $ if  solved
    then  Just acts
    else  Nothing

mainFun :: SP Builder
mainFun = do
  n <- getInt
  m <- getInt
  arr <- listArray ((1, 1), (n, m)) <$> replicateM (n * m) getInt
  pure $ case  solve arr  of
    Just li -> foldMap (\(Act i j c) -> putInts [i, j, c]) li
    Nothing -> string7 "-1\n"

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

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

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

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

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

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