Problem:
ブロックの三角形

図a のように積まれたブロックに対し、以下の並べ替え操作を繰り返す。

一番下のブロック全て（図a 中の白のブロック）を右端に新しく積み上げる（残りのブロックは自動的に１段下に落ち、図b のようになる）。

ブロックの間に隙間ができたら、左に詰めて隙間をなくす（図 b から図c のようになる）。

1 以上の整数 k に対して、k×(k＋1)/2 で表される数 (例:1, 3, 6, 10, ...)を三角数という。ブロックの総数が三角数の場合、上記の並べ替えを繰り返すと、左端の高さが1 で右に向かって１つずつ高くなっていくような三角形になると予想されている（図d は総数が15 個の場合）。

ブロックの最初の並びが与えられたとき、あらかじめ決められた回数以下の操作で、上で説明したようなブロックの三角形ができるとき、三角形が得られるまでの最小の操作回数を出力するプログラムを作成してください。

入力

入力は複数のデータセットからなる。入力の終わりはゼロ１つの行で示される。各データセットは以下の形式で与えられる。

N
b1 b2 ... bN

各データセットは２行であり、ブロックの最初の並びを表す。N (1 ≤ N ≤ 100)は、一番下の段にあるブロックの数を示す。bi(1 ≤ bi ≤ 10000) は左から i 番目の位置に積まれているブロックの数を示す。bi と bi+1 は１つの空白で区切られている。ブロックの総数は 3 以上である。

データセットの数は 20 を超えない。

出力

データセットごとに、三角形ができるまでに行った並べ替え操作の回数を１行に出力する。ただし、三角形が作れない場合や、操作回数が 10000 回を超える場合は -1 を出力する。

入力例

6
1 4 1 3 2 4
5
1 2 3 4 5
10
1 1 1 1 1 1 1 1 1 1
9
1 1 1 1 1 1 1 1 1
12
1 4 1 3 2 4 3 3 2 1 2 2
1
5050
3
10000 10000 100
0

出力例

24
0
10
-1
48
5049
-1

最初のデータセットが、図に示した場合に対応する。

４つ目のデータセットが、ブロックの総数が三角数でないため、三角形が作れない場合に対応する。

最後のデータセットが、ブロックの総数は三角数だが、操作回数が 10000 回を超える場合に対応する。

Solution in Haskell (judge verdict: Accepted)

import Control.Applicative
import Control.Monad
import Control.Monad.ST
-- import qualified Data.ByteString as BS
import Data.Functor
import Data.Function
import Data.Monoid
import Data.Maybe
import Data.List
import qualified Data.Foldable as Foldable
import qualified Data.Set as Set
--import qualified Data.Sequence as Sequence
import Data.List.Split
import Data.Bits
import Data.Char
import Data.Ix
import Data.Ratio
import Data.Ord
import Data.Tuple
import Data.Array
--import Data.Array.Unboxed
--import Data.Array.IArray
import Data.Array.MArray
import Data.Array.IO
import Data.Array.ST
import Data.IORef
import Data.STRef
import GHC.ST
-- import System.IO.Unsafe

-- templete
readInt = read :: String -> Int
readInteger = read :: String -> Integer
readDouble = read :: String -> Double
getInt = readLn :: IO Int
getInts = map readInt . words <$> getLine
getInteger = readLn :: IO Integer
getIntegers = map readInteger . words <$> getLine
getDouble = readLn :: IO Double
getDoubles = map readDouble . words <$> getLine
sjoin :: (Show a) => [a] -> String
sjoin = unwords . map show
tjoin :: (Show a, Show b) => (a, b) -> String
tjoin (x, y) = show x ++ (' ' : show y)
cond :: a -> a -> Bool -> a
cond t f c = if c then t else f
apply2 :: (a -> a -> b) -> [a] -> b
apply2 f [x,y] = f x y
apply3 :: (a -> a -> a -> b) -> [a] -> b
apply3 f [x,y,z] = f x y z
apply4 :: (a -> a -> a -> a -> b) -> [a] -> b
apply4 f [x,y,z,w] = f x y z w
fnTuple :: (a -> b, a -> c) -> a -> (b, c)
fnTuple (f,g) a = (f a, g a)
replace :: (Eq a) => a -> a -> [a] -> [a]
replace x y = map (\z -> if z==x then y else z)
binMap :: (a -> a -> b) -> [a] -> [b]
binMap f (x:xs@(y:_)) = f x y : binMap f xs
binMap _ _ = []
splitRec :: Int -> [a] -> [[a]]
splitRec _ [] = []
splitRec n xs = let (y,ys) = splitAt n xs in y : splitRec n ys
infixl 7 `divCeil`
divCeil :: Integral a => a -> a -> a
x `divCeil` y = (x+y-1) `div` y
coverC :: Ord a => (a, a) -> a -> Bool
coverC (l,r) x = l<=x && x<=r
coverH :: Ord a => (a, a) -> a -> Bool
coverH (l,r) x = l<=x && x<r
ibsearch :: (Int -> Bool) -> (Int,Int) -> Int
ibsearch f (ok,ng) = if abs (ok-ng) <= 1 then ok else let mid = (ok + ng) `div` 2 in ibsearch f (if f mid then (mid,ng) else (ok,mid))
-- templete

check s = all (uncurry (==)) $ zip s [1..] -- check' 1 s
  where
    check' _ [] = True
    check' i (x:xs)
      | x==i = check' (i+1) xs
      | otherwise = False

op s = osub 0 s
  where
    osub n [] = [n]
    osub n (1:xs) = osub (n+1) xs
    osub n (x:xs) = (x-1) : osub (n+1) xs

f s = let g i xs = if check xs then i else if i==10000 then (-1) else g (i+1) (op xs) in g 0 s


main = do
    n <- getInt
    unless (n==0) $ getInts >>= print . f >> main