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 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

{-# 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 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


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(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"


{-# 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


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 _ _ _ = []


{-# 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 $ 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

{- <ღ> 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'


{-# 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

{-# 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 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


import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.8
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.8
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . maxSum $ xs'
	{-else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as-}
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.0
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.90
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.8
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= {-m `seq` pref `seq`-} maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.75
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.9
	then do
		putStrLn . show . maxSum $ xs'
		{-putStrLn .show . f $ (lo + hi) / 2-}
	{-else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as-}
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = {-xs' `deepseq`-} do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		{-putStrLn . show . maxSum $ xs'-}
		putStrLn .show . f $ (lo + hi) / 2
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as
	{-else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as-}

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Prelude hiding (getLine)
import Data.List (unfoldr)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString, getLine)
import qualified Data.ByteString.Char8 as B

parse :: ByteString -> [Int]
parse = unfoldr $ B.readInt . B.dropWhile (== ' ')

solve :: [Double] -> Double
solve xs = cost . (/ 2) . uncurry (+) . (!! 100) $ iterate step range
    where
    range = (minimum xs, maximum xs)
    step (lo, hi)
        | cost i < cost k = (lo, k)
        | otherwise       = (i, hi)
        where
        i = (hi + 2 * lo) / 3
        k = (2 * hi + lo) / 3

    cost x = foldr go (\_ _ acc -> acc) xs 0 0 0
        where
        go i run a b c = run a' b' . max c $ max a' b'
            where
            a' = max 0 $ a + i - x
            b' = max 0 $ b - i + x

main = getLine >> getLine >>= print . solve . map fromIntegral . parse

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.5
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.8
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = {-xs' `deepseq`-} do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.8
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = {-xs' `deepseq`-} do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . maxSum . map (subtract mid) $ xs
		{-putStrLn .show . f $ (lo + hi) / 2-}
	{-else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as-}
	else do
		if ((<) `on` maxSum) (map (subtract mid) xs) (map (\x -> mid - x) xs)
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		{-xs' = map (subtract mid) xs-}
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.95
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) . map (\x -> r - x) $ xs
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock
import Data.List (foldl')

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` maxSum) xs' $ map negate xs'
		maxSum l = uncurry max . foldl' (\(p, m) v -> (max v (p + v), max m p)) (0, head l) $ l

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock
import Data.List (foldl')

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		{-f r = let xs' = map (subtract r) xs in (max `on` maxSum) xs' $ map negate xs'
		maxSum l = uncurry max . foldl' (\(p, m) v -> (max v (p + v), max m p)) (0, head l) $ l-}
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.5
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.90
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		{-f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)-}
		f r = let xs' = map (subtract r) xs in xs' `seq` (max `on` (maxSum (head xs') 0)) xs' (map negate xs')
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.95
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) . map (\x -> r - x) $ xs
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.85
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) . map (\x -> r - x) $ xs
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.95
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.90
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		{-f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)-}
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' (map negate xs')
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.90
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		{-f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) (map (\x -> r - x) xs)-}
		f r = let xs' = map (subtract r) xs in xs `seq` (max `on` (maxSum (head xs') 0)) xs' (map negate xs')
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock
import Data.List (foldl')

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = (max `on` (maxSum (head xs - r) 0)) (map (subtract r) xs) . map (\x -> r - x) $ xs
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) ((max 0 pref) + a) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock
import Data.List (foldl')

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` maxSum) xs' $ map negate xs'
		maxSum l = uncurry max . foldl (\(p, m) v -> (max v (p + v), max m p)) (0, head l) $ l
		{-f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	if length xs > 2000
	then return ()
	else solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.85
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.7
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function
import Data.Time.Clock

main = do
	tbegin <- getCurrentTime
	input <- fmap words getContents
	let xs = map read . tail $ input
	solve tbegin xs (minimum xs) (maximum xs)
solve tbegin xs lo hi = do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.85
	then do
		putStrLn . show . f . (* 0.5) $ (hi + lo)
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as

{-main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-6	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as-}

import Data.Function

main = interact $ show . solve . map read . words
solve (_:xs) = solve' xs (minimum xs) (maximum xs)
solve' xs lo hi
	| hi - lo < 1e-5	=	f ((hi + lo) / 2)
	| otherwise			=	let
								mid1 = (2 * lo + hi) / 3
								mid2 = (lo + 2 * hi) / 3
							in	if f mid1 > f mid2
								then	solve' xs mid1 hi
								else	solve' xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in (max `on` (maxSum (head xs') 0)) xs' $ map negate xs'
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= maxSum (max m pref) (max a (pref + a)) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe (fromJust)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = xs' `deepseq` do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 0.6
	then do
		putStrLn . show . maxSum $ xs'
	else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as

import Data.Function (on)
import Data.Time.Clock
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Control.DeepSeq

main = do
	tbegin <- getCurrentTime
	input <- ByteString.getContents
	let xs = map (fromIntegral . fst . fromJust . ByteString.readInt) . tail . ByteString.words $ input
	solve tbegin xs (minimum xs) (maximum xs)

solve :: UTCTime -> [Double] -> Double -> Double -> IO ()
solve tbegin xs lo hi = {-xs' `deepseq`-} do
	tcurrent <- getCurrentTime
	if (diffUTCTime tcurrent tbegin) > 1.75
	then do
		{-putStrLn . show . maxSum $ xs'-}
		putStrLn .show . f $ (lo + hi) / 2
	else do
		let mid1 = (2 * lo + hi) / 3
		let mid2 = (lo + 2 * hi) / 3
		if f mid1 > f mid2
		then solve tbegin xs mid1 hi
		else solve tbegin xs lo mid2
	where
		f r = let xs' = map (subtract r) xs in xs' `deepseq` (max `on` (maxSum (head xs') 0)) xs' (map negate xs')
		maxSum m pref []		= max m pref
		maxSum m pref (a:as)	= m `seq` pref `seq` maxSum (max m pref) ((max 0 pref) + a) as
	{-else do
		if ((<) `on` maxSum) xs' (map negate xs')
		then solve tbegin xs lo mid
		else solve tbegin xs mid hi
	where
		mid = (lo + hi) / 2
		xs' = map (subtract mid) xs
		maxSum l = maxSum' (head l) 0 l
		maxSum' m pref []		= max m pref
		maxSum' m pref (a:as)	= m `seq` pref `seq` maxSum' (max m pref) ((max 0 pref) + a) as-}


module Main where
import Data.List (sortBy)
import qualified Data.ByteString.Char8 as BS
import Data.Maybe

rush :: [Integer] -> Integer
rush l = let s = sortBy (\x y -> op (x `compare` y))  l
             op EQ = EQ
             op GT = LT
             op LT = GT
         in binsearch (test s) (head s) (2 * head s)

test :: [Integer] -> Integer -> Ordering
test l x = test' l (x,0)
  where test' [] (t,_)
          | t > 0 = LT
          | otherwise = EQ
        test' (h:rest) (need,found)
          | need <= 0 = EQ
          | otherwise = let r = need - (h - found) in test' rest (need - r,found + r)

binsearch :: (Integer -> Ordering) -> Integer -> Integer -> Integer
binsearch f l u
  | l >= u = l
  | t == EQ && f (m - 1) == LT = m
  | t == LT = binsearch f (m + 1) u
  | otherwise = binsearch f l (m - 1)
    where m = (l + u) `div` 2
          t = f m

main :: IO ()
main = do
  l <- fmap (map (fst . fromJust . BS.readInteger) . tail . BS.words) BS.getContents
  print $ rush l

module Main where

import Control.Applicative
import Data.List
import Data.Int
--import Debug.Trace

main = do
    getLine
    l <- map read <$> words <$> getLine :: IO [Int64]
    print $ solve' l

solve' xs = let m = maximum xs
                l = fromIntegral $ length xs
                s = sum xs
            in max m $ (s -1) `div` (l-1) + 1

--solve [] = 0
--solve [x] = x
solve l = let m1 = minimum l
              l' = delete m1 l
          in f m1 l'
    where f 0 l = maximum l
          f m l = let m' =  minimum l
                      d = m' - m + 1
                  in d + f (m-1) (m : (map (\x -> x - d) $ delete m' l))

getans :: [Integer] -> Integer -> Integer
getans a n =
	let operations = n * (maximum a) - sum a
	    f op n max = op + (n * (div (max - op) (n - 1))) + (if (mod (max - op) (n - 1) > 0) then (mod (max - op) (n - 1) + 1) else 0)
	in (if (operations >= maximum a) then (maximum a) else (f operations n (maximum a)))

main = do
	n <- getLine
	input <- getLine
	putStr $ show $ getans (map read (words input) :: [Integer]) (read n :: Integer)

import Control.Monad
import Data.Int

main = do
  n <- readLn :: IO Int64
  a <- (map (read :: String->Int64) . words) `liftM` getLine
  print $ max (div ((sum a) + (n-2)) (n-1) ) (maximum a)

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

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

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

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

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

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

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

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

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

main = do
    n <- fromIntegral . readInt <$> B.getLine
    l <- readsInt
    print $ solve n $ map fromIntegral $ sort l

solve :: Int64 -> [Int64] -> Int64
solve n l = binarySearch predicate (last l)
    where
    s = sum l
    predicate k = n * k - s >= k

binarySearch p a | p a = a
                 | otherwise = go a $ head $ dropWhile (not . p) [a*2^i | i <- [1..]]
    where
    go a b | b - a <= 1 = b
           | p m        = go a m
           | otherwise  = go m b
        where m = (a+b) `div` 2

module Main where
import System.IO
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Integer -> [Integer] -> Integer
solve n as = max x y
	where x = ceiling $ (fromIntegral $ sum as) / (fromIntegral $ n-1)
	      y = maximum as

main :: IO ()
main = do
	ls <- B.getLine
	let n = readInteger ls
	ls <- B.getLine
	putStrLn . (++ "\n") . show . solve n . map readInteger . C.words $ ls

readInteger :: C.ByteString -> Integer
readInteger = fst . fromJust . C.readInteger

import Data.Int

main = do
	n <- readLn :: IO Int64
	s <- getLine
	let a = map (read :: String -> Int64) $ words s
	print (max (maximum a) $ div (sum a + n - 2) (n-1))

{-# OPTIONS_GHC -O2 #-}

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

main :: IO ()
main = do
  n <- toInteger . maybe 0 fst . B.readInt <$> B.getLine
  print . solve n . sort . map (toInteger . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: Integer -> [Integer] -> Integer
solve n as = f 0 as
  where
  m = last as
  f c (a : as)
    | a <= c = m
    | a == m = q + min 1 r + c
    | otherwise = f (c + m - a) as
    where
    (q, r) = (n * (m - c)) `divMod` (n - 1)

module Main where
import System.IO
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [Int] -> Int
solve n as = max x y
	where x = ceiling $ (fromIntegral $ sum as) / (fromIntegral $ n-1)
	      y = maximum as

main :: IO ()
main = do
	ls <- B.getLine
	let n = readInt ls
	ls <- B.getLine
	putStrLn . (++ "\n") . show . solve n . map readInt . C.words $ ls

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

import Data.Int

main = do
	n <- readLn :: IO Int64
	s <- getLine
	let a = map (read :: String -> Int64) $ words s
	print (min (maximum a) $ div (sum a + n - 2) (n-1))

import Control.Monad

main = do
  n <- readLn :: IO Int
  a <- (map (read :: String->Int) . words) `liftM` getLine
  print $ max (div ((sum a) + (n-2)) (n-1) ) (maximum a)

{-# OPTIONS_GHC -O2 #-}

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

main :: IO ()
main = do
  n <- maybe 0 fst . B.readInt <$> B.getLine
  print . solve n . sort . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: Int -> [Int] -> Int
solve n as = f 0 as
  where
  m = last as
  f c (a : as)
    | a <= c = m
    | a == m = q + min 1 r + c
    | otherwise = f (c + m - a) as
    where
    (q, r) = (n * (m - c)) `divMod` (n - 1)

module Main where

import Control.Applicative
import Data.List
import Data.Int

main = do
    getLine
    l <- map read <$> words <$> getLine :: IO [Int64]
    print $ solve l

solve [] = 0
solve [x] = x
solve l = let m1 = minimum l
              l' = delete m1 l
              m2 = minimum l'
              m3 = maximum $ m1:map (\x -> x - m2) l'
          in m2 + m3

module Main where

import Control.Applicative
import Data.List

main = do
    getLine
    l <- map read <$> words <$> getLine
    let n = length l
        s = sum l
    print $ (s - 1) `div` (n-1) + 1

getans :: [Int] -> Int -> Int
getans a n =
	let operations = n * (maximum a) - sum a
	    f op n max = op + (n * (div (max - op) (n - 1))) + (if (mod (max - op) (n - 1) > 0) then (mod (max - op) (n - 1) + 1) else 0)
	in (if (operations >= maximum a) then (maximum a) else (f operations n (maximum a)))

main = do
	n <- getLine
	input <- getLine
	putStr $ show $ getans (map read (words input) :: [Int]) (read n :: Int)


import Data.List

factors :: Integer -> [Integer]
factors 1 = []
factors n = if b == [] then [n] else (head b) : factors (n`div`(head b))
  where a = takeWhile (\x -> x*x <= n) [2..n]
        b = filter (\x -> n`mod`x==0) a

solve :: Integer -> String
solve n = (show lenAns) ++ "\n" ++ (unwords $ map show $ ans)
  where fact = reverse $ sort $ map (\a -> (length a, head a)) $ group $ factors n
        lenAns = fst $ head fact
        f cur sm (x:xs)
          | cur == fst x = f cur (sm*(snd x)) xs
          | otherwise = sm : (f (cur-1) sm (x:xs))
        f cur sm [] = sm : (f (cur-1) sm [])
        ans = take lenAns $ f lenAns 1 fact

main = interact $ unlines . map (solve . read) . tail . lines

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $ words >>> drop 1 >>> map (read >>> solve >>> showAns) >>> unlines
  where
    showAns xs = show (length xs) ++ "\n" ++ unwords (map show xs)

type I64 = Integer

solve :: I64 -> [I64]
solve n
  | null fs =
    case root 1 n n of
      Nothing -> [n]
      Just r -> [r, r]
  | otherwise =
    foldl1 (zipWith (*)) $
    map (\(p, f) -> replicate (k - f) 1 ++ replicate f p) $ (extra, 1) : fs
  where
    fs = factorize n
    extra = foldl (\v (p, m) -> iterate (`div` p) v !! m) n fs
    k = maximum (map snd fs)

primes :: [I64]
primes = filter prime [2 .. 3120]
  where
    prime p = all ((/= 0) . (p `mod`)) [2 .. p - 1]

factorize :: I64 -> [(I64, Int)]
factorize n = filter ((> 0) . snd) . map f $ primes
  where
    f p = (p, mult n p)
    mult u d
      | u `mod` d == 0 = 1 + mult (u `div` d) d
      | otherwise = 0

root :: I64 -> I64 -> I64 -> Maybe I64
root l r n
  | l > r = Nothing
  | mid * mid == n = Just mid
  | mid * mid > n = root l (mid - 1) n
  | mid * mid < n = root (mid + 1) r n
  where
    mid = (l + r) `div` 2

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Maybe (listToMaybe)
import Data.Function (on)

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = ((isstolines . solve . linetoi) l)  ++  tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Integer -> [[Integer]]
solve n  = [[toInteger $ y], fs] where
  fs =  reverse $ (n `div` (x^(y-1))) : (take (y-1) $ repeat x)
  (x,y) = maximumBy (compare `on` snd) $ primeFac n

primeFac :: Integer -> [(Integer,Int)]
primeFac n = map (\xs -> (head xs, length xs)) $ group $ primeFac' n 2 where
  primeFac' n l = unfoldr  primePow (n,l)
  primePow (m,l) = listToMaybe [(p, (m `div` p, p)) | p<- jumpatsqrt l m, m `mod` p == 0]
  jumpatsqrt a b = takeWhile ((<=b).(^2)) [a..b] ++ (if b>1 then [b] else [])

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Int (Int64)
import Data.List (group, reverse)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

readIntegerB8 :: B8.ByteString -> Maybe Integer
readIntegerB8 = B8.readInteger >>> fmap fst

primeFactors :: Int64 -> [Int64]
primeFactors n = primeFactors' n [2 .. sqrtN]
    where
        sqrtN = floor . sqrt $ realToFrac n

        primeFactors' :: Int64 -> [Int64] -> [Int64]
        primeFactors' n is@(i : otherIs)
            | n `mod` i == 0 = i : primeFactors' (n `div` i) is
            | otherwise      = primeFactors' n otherIs
        primeFactors' n _
            | n == 1         = []
            | otherwise      = [n]

solve :: Int64 -> [Int64]
solve n = reverse result
    where
        result = foldr1 (zipWith (*)) resizedGroups
        resizedGroups = map (\ps -> take k (ps ++ repeat 1)) primeGroups
        k = maximum . map length $ primeGroups
        primeGroups = group $ primeFactors n

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntegerB8 <&> fmap fromInteger
    let answer = solve n
    printf "%d\n" $ length answer
    forM_ answer $ printf "%lld "
    printf "\n"

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $ words >>> drop 1 >>> map (read >>> solve >>> showAns) >>> unlines
  where
    showAns xs = show (length xs) ++ "\n" ++ unwords (map show xs)

type I64 = Integer

solve :: I64 -> [I64]
solve n
  | null fs =
    let r = root 1 n n
     in if r * r == n
          then [r, r]
          else [n]
  | otherwise =
    foldl1 (zipWith (*)) $
    map (\(p, f) -> replicate (k - f) 1 ++ replicate f p) fs
  where
    fs = factorize n
    k = maximum (map snd fs)

primes :: [I64]
primes = filter prime [2 .. 3120]
  where
    prime p = all ((/= 0) . (p `mod`)) [2 .. p - 1]

factorize :: I64 -> [(I64, Int)]
factorize n = filter ((> 0) . snd) . map f $ primes
  where
    f p = (p, mult n p)
    mult u d
      | u `mod` d == 0 = 1 + mult (u `div` d) d
      | otherwise = 0

root :: I64 -> I64 -> I64 -> I64
root l r n
  | l >= r = l
  | mid * mid == n = mid
  | mid * mid > n = root l (mid - 1) n
  | mid * mid < n = root (mid + 1) r n
  where
    mid = (l + r) `div` 2

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $ words >>> drop 1 >>> map (read >>> solve >>> showAns) >>> unlines
  where
    showAns xs = show (length xs) ++ "\n" ++ unwords (map show xs)

type I64 = Integer

solve :: I64 -> [I64]
solve n
  | null fs =
    let r = round . sqrt . fromInteger $ n
     in if r * r == n
          then [r, r]
          else [n]
  | otherwise =
    foldl1 (zipWith (*)) $
    map (\(p, f) -> replicate (k - f) 1 ++ replicate f p) fs
  where
    fs = factorize n
    k = maximum (map snd fs)

primes :: [I64]
primes = filter prime [2 .. 3120]
  where
    prime p = all ((/= 0) . (p `mod`)) [2 .. p - 1]

factorize :: I64 -> [(I64, Int)]
factorize n = filter ((> 0) . snd) . map f $ primes
  where
    f p = (p, mult n p)
    mult u d
      | u `mod` d == 0 = 1 + mult (u `div` d) d
      | otherwise = 0

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Int (Int64)
import Data.List (group, reverse)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

primeFactors :: Int64 -> [Int64]
primeFactors n = primeFactors' n [2 .. sqrtN]
    where
        sqrtN = floor . sqrt $ realToFrac n

        primeFactors' :: Int64 -> [Int64] -> [Int64]
        primeFactors' n is@(i : otherIs)
            | n `mod` i == 0 = i : primeFactors' (n `div` i) is
            | otherwise      = primeFactors' n otherIs
        primeFactors' n _
            | n == 1         = []
            | otherwise      = [n]

solve :: Int64 -> [Int64]
solve n = reverse result
    where
        result = foldr1 (zipWith (*)) resizedGroups
        resizedGroups = map (\ps -> take k (ps ++ repeat 1)) primeGroups
        k = maximum . map length $ primeGroups
        primeGroups = group $ primeFactors n

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntB8 <&> fmap fromIntegral
    let answer = solve n
    printf "%d\n" $ length answer
    forM_ answer $ printf "%lld "
    printf "\n"

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Int (Int64)
import Data.List (group, reverse)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

primeFactors :: Int64 -> [Int64]
primeFactors n = primeFactors' n [2 .. sqrtN]
    where
        sqrtN = floor . sqrt $ realToFrac n

        primeFactors' :: Int64 -> [Int64] -> [Int64]
        primeFactors' n is@(i : otherIs)
            | n `mod` i == 0 = i : primeFactors' (n `div` i) is
            | otherwise      = primeFactors' n otherIs
        primeFactors' n _
            | n == 1         = []
            | otherwise      = [n]

solve :: Int64 -> [Int64]
solve n = reverse result
    where
        result = foldr1 (zipWith (*)) resizedGroups
        resizedGroups = map (\ps -> take k (ps ++ repeat 1)) primeGroups
        k = maximum . map length $ primeGroups
        primeGroups = group $ primeFactors n

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntB8 <&> fmap fromIntegral
    let answer = solve n
    forM_ answer $ printf "%d "
    printf "\n"

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Int (Int64)
import Data.List (group, reverse)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

primeFactors :: Int64 -> [Int64]
primeFactors n = primeFactors' n [2 .. sqrtN]
    where
        sqrtN = floor . sqrt $ realToFrac n

        primeFactors' :: Int64 -> [Int64] -> [Int64]
        primeFactors' n is@(i : otherIs)
            | n `mod` i == 0 = i : primeFactors' (n `div` i) is
            | otherwise      = primeFactors' n otherIs
        primeFactors' n _
            | n == 1         = []
            | otherwise      = [n]

solve :: Int64 -> [Int64]
solve n = reverse result
    where
        result = foldr1 (zipWith (*)) resizedGroups
        resizedGroups = map (\ps -> take k (ps ++ repeat 1)) primeGroups
        k = maximum . map length $ primeGroups
        primeGroups = group $ primeFactors n

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntB8 <&> fmap fromIntegral
    let answer = solve n
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "
    printf "\n"

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Maybe (listToMaybe)
import Data.Function (on)

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (l : rest) = ((isstolines . solve . linetoi) l)  ++  tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: Integer -> [[Integer]]
solve n  = [[toInteger $ length fs], fs] where
  fs = (:) (n `div` (x^(y-1))) $ take (y-1) $ repeat x
  (x,y) = maximumBy (compare `on` snd) $ primeFac n

primeFac :: Integer -> [(Integer,Int)]
primeFac n = map (\xs -> (head xs, length xs)) $ group $ primeFac' n 2 where
  primeFac' n l = unfoldr  primePow (n,l)
  primePow (m,l) = listToMaybe [(p, (m `div` p, p)) | p<- jumpatsqrt l m, m `mod` p == 0]
  jumpatsqrt a b = takeWhile ((<=b).(^2)) [a..b] ++ (if b>1 then [b] else [])


import Control.Arrow
import Data.List(sort, group)

chunksOf :: Int -> [a] -> [[a]]
chunksOf k [] = []
chunksOf k xs = let (g, xs') = splitAt k xs in g : chunksOf k xs'

type LL = Integer

main = interact $
         lines >>> drop 1 >>> chunksOf 2
         >>> map ((!! 1) >>> words >>> map read >>> solve >>> show)
         >>> unlines

solve :: [Int] -> LL
solve = sum . map (choose2 . length) . group . sort . zipWith (-) [0..]

choose2 :: Int -> LL
choose2 n = let n' = toInteger n in (n' * (n' - 1)) `div` 2

import Control.Monad
import Data.List (group, sort)
import Data.Int (Int64)

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- map read . words <$> getLine :: IO [Int]
        let nC2 x = fromIntegral x * (fromIntegral x - 1) `quot` 2 :: Int64
        print $ sum $ map (nC2 . length) $ group $ sort $ zipWith (-) a [1 .. n]

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

main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        a <- map read . words <$> getLine :: IO [Int]
        let nC2 x = x * (x - 1) `quot` 2
        print $ sum $ map (nC2 . length) $ group $ sort $ zipWith (-) a [1 .. n]

import Control.Arrow
import Data.List(sort, group)

chunksOf :: Int -> [a] -> [[a]]
chunksOf k [] = []
chunksOf k xs = let (g, xs') = splitAt k xs in g : chunksOf k xs'

main = interact $
         lines >>> drop 1 >>> chunksOf 2
         >>> map ((!! 1) >>> words >>> map read >>> solve >>> show)
         >>> unlines

solve :: [Int] -> Int
solve = sum . map (choose2 . length) . group . sort . zipWith (-) [0..]

choose2 :: Int -> Int
choose2 n = (n * (n - 1)) `div` 2


module Main where
  import Data.List
  import Control.Monad
  import Data.Array
  import qualified Data.Set as S

  toArray :: [a] -> Array Int a
  toArray xs =
    let ls = length xs - 1
        in array (0, ls) $ zip [0..ls] xs

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

  readMultilineInput :: Int -> (String -> IO a) -> IO [a]
  readMultilineInput n transformer = replicateM n (getLine >>= transformer)

  elemSet :: (Ord a) => a -> S.Set a -> Bool
  elemSet elem sets =
    let found = elem `S.lookupIndex` sets
        in toBool found
        where
          toBool :: Maybe Int -> Bool
          toBool (Just _) = True
          toBool Nothing = False

  minus :: Integer -> Integer -> Integer
  minus m x = m - x

  -- 11 comes before breakfast, leave before breakfast
  solve11 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve11 b s d =
    let m = maximum [b, s, d]
        in Just $ map (minus m) [b, s, d]

  -- comes before breakfast, leave before supper
  -- 1 0 0
  solve12 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve12 b s d
    | b > s && b > d =
      let m = b
          in Just [(m - b), (m - s - 1), (m - d - 1)]
    | otherwise = Nothing

  -- comes before breakfast, leave before dinner
  -- 1 1 0
  solve13 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve13 b s d
    | max b s > d =
      let m = max b s
          in Just [(m - b), (m - s), (m - d - 1)]
    | otherwise = Nothing

  -- comes before supper, leave before breakfast
  -- 0 1 1
  solve21 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve21 b s d
    | max s d > b =
      let m = max s d
          in Just [(m - b - 1), (m - s), (m - d)]
    | otherwise = Nothing

  -- comes before supper, leave before supper
  -- breakfast == super == dinner
  solve22 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve22 = solve11

  -- comes before supper, leave before dinner
  -- 0 1 0
  solve23 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve23 b s d
    | s > d && s > b =
      let m = s
          in Just [(m - b - 1), (m - s), (m - d - 1)]
    | otherwise = Nothing

  -- comes before dinner, leave before breakfast
  -- 0 0 1
  solve31 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve31 b s d
    | d > s && d > b =
      let m = d
          in Just [(m - b - 1), (m - s - 1), (m - d)]
    | otherwise = Nothing

  -- comes before dinner, leave before supper
  -- 1 0 1
  solve32 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve32 b s d
    | max b d > s =
      let m = maximum [b, s, d]
          in Just [(m - b), (m - s - 1), (m - d)]
    | otherwise = Nothing

  solve33 :: Integer -> Integer -> Integer -> Maybe [Integer]
  solve33 = solve11

  getValue :: Maybe a -> a
  getValue (Just x) = x
  getValue Nothing = undefined

  main :: IO()
  main = do
    [b, s, d] <- getLine >>= return . (map (read :: String -> Integer)) . words
    let r11 = solve11 b s d
        r12 = solve12 b s d
        r13 = solve13 b s d
        r21 = solve21 b s d
        r22 = solve22 b s d
        r23 = solve23 b s d
        r31 = solve31 b s d
        r32 = solve32 b s d
        r33 = solve33 b s d
        r = filter (/=Nothing) [r11, r12, r13, r21, r22, r23, r31, r32, r33]
        rr = map (sum . getValue) r
    print $ minimum $ rr

import Data.Functor
import Data.Int

solve :: Int64 -> Int64 -> Int64 -> Int64
solve 0 0 0 = 0
solve x 0 0 = 2 * (x - 1)
solve 0 x 0 = 2 * (x - 1)
solve 0 0 x = 2 * (x - 1)
solve x y 0
    | x == y = x - 1
    | x >  y = 2 * (x - 1) - y
    | x <  y = 2 * (y - 1) - x
solve x 0 y
    | x == y = x - 1
    | x >  y = 2 * (x - 1) - y
    | x <  y = 2 * (y - 1) - x
solve 0 x y
    | x == y = x - 1
    | x >  y = 2 * (x - 1) - y
    | x <  y = 2 * (y - 1) - x
solve x y z = solve (x - w) (y - w) (z - w)
    where w = min x (min y z)

main :: IO()
main = do
    [b, d, s] <- map read . words <$> getLine
    print $ solve b d s

import Data.List( sort)
main = do
    [b,d,s] <- return.map (read::String->Integer).words =<< getLine
    let max = maximum [b,d,s]
	list = map (\e->e-max) [b,d,s]
	[i,j,k] = sort [b,d,s]
    print $ case sort list of
     [0,0,0]	-> 0
     [n,0,0]	-> -1-n
     [n,m,0]	-> 2*k-2-i-j

import Data.List( sort)
main = do
    [b,d,s] <- return.map (read::String->Integer).words =<< getLine
    let max = maximum [b,d,s]
	list = map (\e->e-max) [b,d,s]
    print $ case sort list of
     [0,0,0]	-> 0
     [n,0,0]	-> -1-n
     [n,m,0]	-> maximum [n,m] - minimum [n,m]