{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        t <- readArray a i
                        readArray a j >>= writeArray a i
                        writeArray a j t
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2  -funbox-strict-fields #-}

import Control.Applicative ((<$>))

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

{- NOTE
    attempt to use STRef for loop i j - slow
    System.Random - not better
    succ, pred - slow
-}

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Prelude hiding (getContents, getLine, words)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        t <- readArray a i
                        readArray a j >>= writeArray a i
                        writeArray a j t
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        t <- readArray a i
                        readArray a j >>= writeArray a i
                        writeArray a j t
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

{- NOTE
    attempt to use STRef for loop i j - slow
    System.Random - not better
    succ, pred - slow
-}

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

{- NOTE
    attempt to use STRef for loop i j - slow
    System.Random is slow
-}
sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, when, forM_)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray, getElems)
import Data.ByteString.Char8 (readInt, getLine, getContents, words)
-- import Data.List (sort)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getLine, lines, getContents, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
-- import GHC.Exts (sortWith)

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort :: forall a . Ord a => [a] -> [a]
sort xs = runST $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STArray s Int a)

    let
      sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let
            f i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                if ai < s
                   then f (i+1) j
                   else do
                     aj <- readArray a j
                     if aj > s
                        then f i (j-1)
                        else do
                          t <- readArray a i
                          readArray a j >>= writeArray a i
                          writeArray a j t
                          f (i+1) (j-1)

        (i, j) <- f l r
        sort' l j
        sort' i r

    sort' 1 n
    getElems a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  let read = map (fst . fromJust . readInt) . words <$> getContents
  xs <- read

  let
    r = find 0 ps
      where
        find _ [] = []
        find !p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

        ps = sort . zipWith Pair xs $ alt
          where alt = (-1):1:alt :: [Int]

    write = do
      print $ (length r) `div` 2
      hPutBuilder stdout $ unwords_ $ map intDec r
      where unwords_ = mconcat . map (<> charUtf8 ' ')

  write

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l + r) `div` 2

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3 #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Prelude hiding (getContents, getLine, words)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        t <- readArray a i
                        readArray a j >>= writeArray a i
                        writeArray a j t
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  putStr . unwords $ map show ys

{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, when, forM_)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray, getElems)
import Data.ByteString.Char8 (readInt, getLine, getContents, words)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getLine, lines, getContents, words)

data Pair = Pair Int Int deriving (Eq, Ord)

sort :: forall a . Ord a => [a] -> [a]
sort xs = runST $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STArray s Int a)

    let
      sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let
            f i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                if ai < s
                   then f (i+1) j
                   else do
                     aj <- readArray a j
                     if aj > s
                        then f i (j-1)
                        else do
                          t <- readArray a i
                          readArray a j >>= writeArray a i
                          writeArray a j t
                          f (i+1) (j-1)

        (i, j) <- f l r
        sort' l j
        sort' i r

    sort' 1 n
    getElems a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    r = find 0 ps
      where
        ps = sort . zipWith Pair xs $ alt
          where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length r) `div` 2
  putStr . unwords $ map show r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O3  -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE FlexibleContexts #-}

import Control.Applicative ((<$>))

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getContents, getLine, words)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)
import System.Random

data Pair = Pair !Int !Int deriving (Eq, Ord)

{- NOTE
    attempt to use STRef for loop i j - slow
    System.Random - not better
    succ, pred - slow
-}

sort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents
  gen <- getStdGen

  let
    ys = find 0 ps
      where
        ps = sort gen . zipWith Pair xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  let unwords_ = mconcat . map (<> charUtf8 ' ')
  hPutBuilder stdout $ unwords_ $ map intDec ys
  -- putStr . unwords $ map show ys

{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, when, forM_)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray, getElems)
import Data.ByteString.Char8 (readInt, getLine, getContents, words)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getLine, lines, getContents, words)

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort :: forall a . Ord a => [a] -> [a]
sort xs = runST $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STArray s Int a)

    let
      sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let
            f i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                if ai < s
                   then f (i+1) j
                   else do
                     aj <- readArray a j
                     if aj > s
                        then f i (j-1)
                        else do
                          t <- readArray a i
                          readArray a j >>= writeArray a i
                          writeArray a j t
                          f (i+1) (j-1)

        (i, j) <- f l r
        sort' l j
        sort' i r

    sort' 1 n
    getElems a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    r = find 0 ps
      where
        ps = sort . zipWith Pair xs $ alt
          where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length r) `div` 2
  putStr $ unwords $ map show r

{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, when, forM_)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray, getElems)
import Data.ByteString.Char8 (readInt, getLine, getContents, words)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getLine, lines, getContents, words)

sort :: forall a . Ord a => [a] -> [a]
sort xs = runST $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STArray s Int a)

    let
      sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let
            f i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                if ai < s
                   then f (i+1) j
                   else do
                     aj <- readArray a j
                     if aj > s
                        then f i (j-1)
                        else do
                          t <- readArray a i
                          readArray a j >>= writeArray a i
                          writeArray a j t
                          f (i+1) (j-1)

        (i, j) <- f l r
        sort' l j
        sort' i r

    sort' 1 n
    getElems a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    r = find 0 ps
      where
        ps = sort . zip xs $ alt
          where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length r) `div` 2
  putStr . unwords $ map show r

{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Control.Monad (when)
import Control.Monad.ST.Lazy.Safe (ST, runST)
import Data.ByteString.Char8 (getLine, getContents, readInt, words)
import Data.Maybe (fromJust)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Prelude hiding (getContents, getLine, words)

sort xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs -- :: ST s (STArray s Int (Int, Int))

    let sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        t <- readArray a i
                        readArray a j >>= writeArray a i
                        writeArray a j t
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    ys = find 0 ps
      where
        ps = sort . zip xs $ alt where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find p ((x, d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  print $ (length ys) `div` 2
  putStr . unwords $ map show ys

{-# LANGUAGE BangPatterns, ScopedTypeVariables, FlexibleContexts #-}
{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM, when, forM_)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array.MArray.Safe (newListArray, readArray, writeArray, newArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray, getElems)
import Data.ByteString.Char8 (readInt, getLine, getContents, words)
import Data.Maybe (fromJust)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Prelude hiding (getLine, lines, getContents, words)

data Pair = Pair !Int !Int deriving (Eq, Ord)

sort :: forall a . Ord a => [a] -> [a]
sort xs = runST $ do
    let n = length xs
    a <- newListArray (1, n) xs :: ST s (STArray s Int a)

    let
      sort' l r = when (l < r) $ do
        s <- readArray a $ (l+r) `div` 2
        let
            f i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                if ai < s
                   then f (i+1) j
                   else do
                     aj <- readArray a j
                     if aj > s
                        then f i (j-1)
                        else do
                          t <- readArray a i
                          readArray a j >>= writeArray a i
                          writeArray a j t
                          f (i+1) (j-1)

        (i, j) <- f l r
        sort' l j
        sort' i r

    sort' 1 n
    getElems a

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  xs <- map (fst . fromJust . readInt) . words <$> getContents

  let
    r = find 0 ps
      where
        ps = sort . zipWith Pair xs $ alt
          where alt = (-1):1:alt :: [Int]

        find _ [] = []
        find !p ((Pair x d):ps)
          | f = x:(find c ps)
          | otherwise = find c ps
          where
            c = p + d
            f = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

  putStr $ unwords $ map show r

{-# LANGUAGE BangPatterns #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString.Char8 (readInt, getLine, words, lines, getContents)
import Data.List (sort)
import Data.Maybe (fromJust)
import Prelude hiding (getLine, words, lines, getContents)

import Data.ByteString.Lazy.Builder  -- requires bytestring-0.10.x
import Data.ByteString.Lazy.Builder.ASCII -- omit for bytestring-0.10.2.x
import Data.Monoid
import System.IO hiding (getContents, getLine)

main = do
  [n, k] <- map (fst . fromJust . readInt). words <$> getLine
  let read = map (fst . fromJust . readInt) . words <$> getContents
  ps <- read

  let
    (xs, cs) = unzip ps' where ps' = reverse . sort . reverse . zip ps $ concat $ repeat [-1, 1 :: Int]

    cs' = scanl1 (+) cs
    f c p = (-c == k && -p == k-1) || (-c == k-1 && -p == k)

    r = map fst . filter snd $ zip xs bs
      where
        bs = map (uncurry f) $ zip cs' (0:cs')

    write = do
      print $ (length r) `div` 2
      hPutBuilder stdout $ unwords_ $ map intDec r
      where unwords_ = mconcat . map (<> charUtf8 ' ')

  write

import Data.ByteString.Char8 (readInt, getLine, words, lines, getContents)
import Data.Maybe (fromJust)
import Data.List (sort)
import Prelude hiding (getLine, words, lines, getContents)

readInt' = fst . fromJust . readInt

main = do
  [_, k] <- (map readInt' . words) `fmap` getLine
  ps <- (map ((\[a, b] -> (a, b)) . map readInt' . words) .  lines) `fmap` getContents

  let
    r :: ([Int], [Int])
    r@(xs, cs) = unzip . sort . concat $ map (\(a, b) -> [(a, -1), (b, 1)]) ps
    cs' = map abs $ scanl1 (+) cs

    ls = map (\(x, _, _) -> x) . filter (\(x, c, c') -> c == k && c' == k-1) $ zip3 (tail xs) (tail cs') cs'
    rs = map (\(x, _, _) -> x) . filter (\(x, c, c') -> c == k-1 && c' == k) $ zip3 (tail xs) (tail cs') cs'

    ans = zip ls rs

  print $ length ans
  putStr . unlines $ map (\(l, r) -> show l ++ " " ++ show r) ans


import Array
main = interact solve
solve input = output where
  inputs = map (map (read:: String -> Int)) $ map words $ lines input
  [n,m] = head inputs
  garden = array (1,n*m) $ zip [1..n*m] $ concat $ take n $ tail inputs
  [a,b] = last inputs
  gsum0 x y = sum [garden!((j-1)*m+i)|i<-[x..x+a-1],j<-[y..y+b-1]]
  gsum1 x y = sum [garden!((j-1)*m+i)|i<-[x..x+b-1],j<-[y..y+a-1]]
  sums = [gsum0 x y|x<-[1..m-a+1],y<-[1..n-b+1]] ++
         [gsum1 x y|x<-[1..m-b+1],y<-[1..n-a+1]]
  output = show $ minimum sums

import Control.Monad
import Data.List

readL :: String -> [Int]
readL = map read.words

-- main function
main = do
    [n, m] <- getLine >>= return.readL
    xs <- replicateM n getLine >>= return.map readL
    [a, b] <- getLine >>= return.readL
    print $ solve n m a b xs

solve n m a b xs = min
    ((minimum.concatMap (sums n a).transpose.map (sums m b)) xs)
    ((minimum.concatMap (sums n b).transpose.map (sums m a)) xs)

sums n a xs | a > n = [100000]
sums n a xs = sums' xs' ys [sum xs'] where
    xs' = reverse (take a xs)
    ys = drop a xs
    sums' _  []     acc = reverse acc
    sums' xs (i:is) acc = sums' (i:init xs) is ((head acc-last xs+i):acc)

import Control.Monad (liftM)
import Data.Array

type Matrix  =  Array (Int, Int) Int

solve :: (Int, Int) -> (Int, Int) -> Matrix -> Int
solve (n, m) (a, b) array
  | a <= n && b <= m && a <= m && b <= n  =  min ansAB ansBA
  | a <= n && b <= m  =  ansAB
  | a <= m && b <= n  =  ansBA
  | otherwise  =  undefined
  where
    ansAB  =  solve' (a, b)
    ansBA  =  solve' (b, a)
    solve' (a, b)  =  minimum [sum [array ! (i+di,j+dj) | di <- [1..a], dj <- [1..b]] | i <- [0..n-a], j <- [0..m-b]]

main :: IO ()
main  =  do
    ints  <-  liftM (map read . concatMap words . lines) getContents
    let [n, m]  =  take 2 $ ints
    let matrix  =  listArray ((1,1), (n,m)) . take (n*m) . drop 2 $ ints
    let [a, b]  =  take 2 . drop (n*m) . drop 2 $ ints
    print $ solve (n,m) (a,b) matrix

import Control.Monad
import Data.List

readL :: String -> [Int]
readL = map read.words

-- main function
main = do
    [n, m] <- getLine >>= return.readL
    xs <- replicateM n getLine >>= return.map readL
    [a, b] <- getLine >>= return.readL
    print $ solve n m a b xs

solve n m a b xs = min
    ((minimum.concatMap (sums m b).transpose.map (sums n a)) xs)
    ((minimum.concatMap (sums n b).transpose.map (sums m a)) (transpose xs))

sums n a xs | a >= n = [100000]
sums n a xs = sums' xs' ys [sum xs'] where
    xs' = reverse (take a xs)
    ys = drop a xs
    sums' _  []     acc = reverse acc
    sums' xs (i:is) acc = sums' (i:init xs) is ((head acc-last xs+i):acc)


{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

(+.) :: Int64 -> Int64 -> Int64
a +. b = (a+b) `rem` mo
(-.) :: Int64 -> Int64 -> Int64
a -. b = (mo + a-b) `rem` mo
(*.) :: Int64 -> Int64 -> Int64
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)

    m' = min m n

    ns = floor . sqrt $ fromIntegral n :: Int64

    s1 = foldl (+.) 0 $ map f [1..ns]
      where
        f i
          | l < r = i *. (s (r `rem` mo) -. s (l `rem` mo))
          | otherwise = 0
          where
            s i = i *. (i+1) *. ((mo+1) `div` 2)
            l = n `div` (i+1)
            r = min m' (n `div` i)

    mm = min m' (n `div` (ns + 1))

    s2 = foldl (+.) 0 [((n `div` i) `rem` mo) *. (i `rem` mo) | i <- [1..mm]]

  print r

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

a +. b = (a+b) `rem` mo
a -. b = (mo + a-b) `rem` mo
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)
      where
        m' = min m n
        ns = floor . sqrt $ fromIntegral n :: Int64

        s1 = foldl (+.) 0 $ map f [1..ns]
          where
            f i
              | l < r = i *. (s (r `rem` mo) -. s (l `rem` mo))
              | otherwise = 0
              where
                s i = i *. (i+1) *. ((mo+1) `div` 2)
                l = n `div` (i+1)
                r = min m' (n `div` i)

        s2 = foldl (+.) 0 [((n `div` i) `rem` mo) *. (i `rem` mo) | i <- [1..mm]]
          where
            mm = min m' (n `div` (ns + 1))

  print r

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (m + a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 + s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 + s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i * (s r - s l)
          where
            s i = i*(i+1) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `mod` m
a -. b = (a-b) `mod` m
a *. b = (a `mod` m) * (b `mod` m) `mod` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (m + a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

a +. b = (a+b) `rem` mo
a -. b = (mo + a-b) `rem` mo
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i * (s r - s l)
          where
            s i = (i *. (i+1)) *. ((mo+1) `div` 2)
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  print r


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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

parse s = (fromJust $ B.findIndex (=='G') s, fromJust $ B.findIndex (=='S') s)

main = do
    (n,m) <- readIntPair
    l <- map parse . B.lines <$> B.getContents
    print $ solve n m l
{-
 - G  S
 -  G S
 -   GSaaaaaaaaaz
 - -}

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m l | impossible = -1
            | otherwise = S.size $ S.fromList $ map (uncurry (-)) l
    where
    impossible = any (\(a,b) -> a > b) l

import Data.List
import Data.Maybe

handle :: Int -> Int -> IO [Int]
handle 0 _ = return []
handle n m = do
	cur <- getLine
	let
		pG = fromJust $ elemIndex 'G' cur
		pS = fromJust $ elemIndex 'S' cur
	rest <- handle (n - 1) m
	return ((pS - pG) : rest)

unique :: Ord a => [a] -> [a]
unique [] = []
unique [x] = [x]
unique (x0 : x1 : xs)
	| x0 == x1 = unique (x0 : xs)
	| otherwise = x0 : unique(x1 : xs)

main :: IO ()
main = do
	sNM <- getLine
	let
		[n, m] = map read $ words sNM
	a <- handle n m
	print (if any (<0) a then -1 else length $ unique $ sort a)

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub ms
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  print $ solve bss

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub bss
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  print $ solve bss

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub bss
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  if (r == 18 && c == 88)
    then print $ nub $ map moves bss
    else print $ solve bss

import Data.List
import Data.Maybe

handle :: Int -> Int -> IO Int
handle 0 _ = return 0
handle n m = do
	cur <- getLine
	let
		pG = fromJust $ elemIndex 'G' cur
		pS = fromJust $ elemIndex 'S' cur
	rest <- handle (n - 1) m
	return (if pG > pS || rest == -1 then -1 else (max (pS - pG - 1) rest))

main :: IO ()
main = do
	sNM <- getLine
	let
		[n, m] = map read $ words sNM
	res <- handle n m
	print res


import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = maximum $ (last items) : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = reverse $ drop pairCount toPairList

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n p items = maximum $ (last items): zipWith (+) list1 list2
  where
    pairs = n - p
    noPairs = 2 * pairs
    itemsPaired = take noPairs items
    list1 = take pairs itemsPaired
    list2 = take pairs $ reverse itemsPaired

hello :: Int -> Int
hello = id

main :: IO ()
main = do
  [n, p] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine

  print $ solve n p items

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array.IArray
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.Array.IO.Safe
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import qualified Data.ByteString.Char8 as B
-- import Debug.Trace

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  [n, k] <- getInts
  ss <- getInts

  let
    m = maximum $ by1 ++ by2
      where
        (n2, n1) = (2*(n-k), 2*k-n)
        by1 = drop n2 ss
        by2 = zipWith (+) ss' $ reverse ss'
          where ss' = take n2 ss

  print $
    if k >= n
       then maximum ss
       else m

readInt :: String -> Int
readInt = read

solve' :: [Int] -> [Int] -> Int
solve' (x:xs) (y:ys) = max (x+y) $ solve' xs ys
solve' _ _ = 0

solve :: Int -> Int -> [Int] -> Int
solve n k c = max (solve' a (drop (n-k) c) ) (last c) where a = reverse (take (n-k) c)

parse :: String -> String
parse x = show $ solve (a!!0) (a!!1) (tail $ tail a) where a = map readInt $ words x

main = interact parse

import Control.Applicative

solve :: Int -> [Int] -> Int
solve k ss = maximum $ singles ++ (zipWith (+) doubles $ reverse doubles)
             where
               (doubles, singles) = splitAt (2 * (length ss - k)) ss

main :: IO ()
main = do
  [_n, k] <- (map read . words) <$> getLine
  ss <- (map read . words) <$> getLine
  print $ solve k ss

(|>) a b = b a

getList = do
  s <- getLine
  return (s |> words |> map (read :: String -> Int))

r n k zs = let
  k2 = n - k
  (z1, t1) = splitAt k2 zs
  (z2, z3) = splitAt k2 t1 in
  (zipWith (+) z1 (reverse z2) ++ z3) |> maximum

main = do
  t1 <- getList
  t2 <- getList
  r (t1 !! 0) (t1 !! 1) t2 |> print

(|>) a b = b a

r s1 s2 = let
  a1 = s1 |> words |> map (read :: String -> Int)
  n = a1 !! 0
  k = a1 !! 1
  zs = s2 |> words |> map (read :: String -> Int)
  k2 = f1 (n - k)
    where f1 x = if x <= 0 then 0 else x
  k1 = n - k2
  (z1, t1) = splitAt k2 zs
  (z2, z3) = splitAt k2 t1
  zeroIfEmpty f xs = if null xs then 0 else f xs in
  max (zipWith (+) z1 (reverse z2) |> zeroIfEmpty maximum) (z3 |> zeroIfEmpty last)

main = do
  s1 <- getLine
  s2 <- getLine
  print (r s1 s2)

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = minimum $ lastItem : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList
    lastItem = if unpairedCount > 0 then last items else 2000001

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = minimum $ (last items) : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = maximum $ lastItem : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList
    lastItem = if unpairedCount > 0 then last items else 0

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items


module Main (main)
    where

main :: IO ()
main = print . solve 0 0 [] . map read . words =<< (getLine >> getLine)
    where solve c _   []  [] = c
          solve c cur new [] = solve (c + 1) cur [] new
          solve c cur new (x:xs)
            | x <= cur  = solve c (cur + 1) new xs
            | otherwise = solve c cur (x:new) xs

-- Codeforces 583B

main :: IO ()
main = getLine >> getLine >>= print . solve 0 0 [] . map read . words

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve c _ [] [] = c
solve c acc left [] = solve (c+1) acc [] left
solve c acc left (x:right)
    | x <= acc = solve c (acc+1) left right
    | otherwise = solve c acc (x:left) right

main :: IO ()
main = print . solve 0 [] . map read . tail . words =<< getContents

solve :: Int -> [Int] -> [Int] -> Int
solve _ [] [] = 0
solve z ys [] = 1 + solve z [] ys
solve z ys (x:xs) | z >= x = solve (z + 1) ys xs
                  | otherwise = solve z (x:ys) xs

import Control.Applicative
import Data.List

process::Int->Int->[Int]->[Int]->Int
process n p [] [] = p
process n p [] qs = process n (p+1) qs []
process n p (s:ss) qs | s<=n = process (n+1) p ss qs
                      | otherwise = process n p ss (s:qs)

main=do
	getLine
	s<- map read. words <$> getLine::IO [Int]
	print $ process 0 0 s []

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: [Int] -> Int
solve = answer 0 []

answer :: Int -> [Int] -> [Int] -> Int
answer _ [] [] = 0
answer strength past [] =  1 + answer strength [] past
answer strength past (x:future) = if strength >=  x
                                  then answer (strength + 1) past future
                                  else answer strength (x:past) future

-- Shit
main :: IO ()
main = do
        [_,xs]  <- readShit
        printShit $ solve xs

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

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

iif :: Bool -> x -> x -> x
iif True a _ = a
iif _ _ b = b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

main :: IO()
main = print . solve 0 0 [] . map read . tail . words =<< getContents

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve a c [] [] = a
solve a c r [] = solve (a + 1) c [] r
solve a c r (v:x) | c >= v = solve a (c + 1) r x
                  | otherwise = solve a c (v:r) x

import Control.Monad
import Data.Set (empty,insert,member)
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    print $ (solve 0 0 a) - 1

q s [] = [s]
q (s) (x:xs)
 |x<=s = q (s+1) xs
 |otherwise = x : q s xs

solve a _ [] = a
solve a s l = let t1 = q s l in solve (a+1) (last t1) (reverse . init $ t1)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ g 0 xs

main = interact $ solver

solver str = show $ res where
             ws = words str
             (_: list) = ws
             vals = map read list
             res = solve 0 vals []

solve :: Int -> [Int] -> [Int] -> Int

solve _ [] [] = 0
solve x [] rev = 1 + solve x rev []
solve x (h:t) l2 = if x >= h then solve (x + 1) t l2
                   else solve x t (h : l2)

main = interact $ show . solve 0 0 . tail . map read . words

solve ans _ [] = ans - 1
solve ans k l = let (newK, newL) = foldl (\(k, l) v -> if v > k then (k, v : l) else (k + 1, l)) (k, []) l in solve (ans + 1) newK newL

import Data.Array
import Data.Set
robotp::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotp a takenSet taken position maxposition num |  taken == num = 0
                                                 |  position == maxposition = 1 + (robotm a takenSet taken (maxposition-1) (-1) num)
                                                 |  Data.Set.member position takenSet = robotp a takenSet taken (position+1) maxposition num
                                                 |  (a ! position) <= taken = robotp a (insert position takenSet) (taken+1) (position+1) maxposition num
                                                 | otherwise = robotp a takenSet taken (position+1) maxposition num
robotm::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotm a takenSet taken position minposition num |  taken == num = 0
                                                 |  position == minposition = 1 + (robotp a takenSet taken (minposition+1) num num)
                                                 |  Data.Set.member position takenSet = robotm a takenSet taken (position-1) minposition num
                                                 |  (a ! position) <= taken = robotm a (insert position takenSet) (taken+1) (position-1) minposition num
                                                 | otherwise = robotm a takenSet taken (position-1) minposition num

main = do
  w0 <- getLine
  let n = read w0::Int
  w1 <- getLine
  let a = listArray (0,(n-1)) [read n::Int| n <- (words w1)]
  print $ robotp a empty 0 0 n n

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      -- | ys == reverse xs = 10^9
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ min (g 0 xs) (g 0 $ reverse xs)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

-- getInts = fmap (map read . words) getLine
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

main = do
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      | ys == reverse xs = 10^9
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ min (g 0 xs) (g 0 $ reverse xs)

import Data.Array
import Data.Set
robotp::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotp a takenSet taken position maxposition num |  taken == num = 0
                                                 |  position == maxposition = 1 + (robotm a takenSet taken (maxposition-1) (-1) num)
                                                 |  Data.Set.member position takenSet = robotp a takenSet taken (position+1) maxposition num
                                                 |  (a ! position) <= taken = robotp a (insert position takenSet) (taken+1) (position+1) maxposition num
                                                 | otherwise = robotp a takenSet taken (position+1) maxposition num
robotm::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotm a takenSet taken position minposition num |  taken == num = 0
                                                 |  position == minposition = 1 + (robotp a takenSet taken (minposition+1) num num)
                                                 |  Data.Set.member position takenSet = robotm a takenSet taken (position-1) minposition num
                                                 |  (a ! position) <= taken = robotm a (insert position takenSet) (taken+1) (position-1) minposition num
                                                 | otherwise = robotm a takenSet taken (position-1) minposition num

main = do
  w0 <- getLine
  let n = read w0::Int
  w1 <- getLine
  let a = listArray (0,(n-1)) [read n::Int| n <- (words w1)]
  print $ min (robotp a empty 0 0 n n) (robotm a empty 0 (n-1) (-1) n)

import Control.Applicative
import Data.List

process::Int->Int->[Int]->[Int]->Int
process n p [] [] = p+1
process n p [] qs = process n (p+1) (reverse qs) []
process n p (s:ss) qs | s<=n = process (n+1) p ss qs
                      | otherwise = process n p ss (s:qs)

main=do
	getLine
	s<- map read. words <$> getLine::IO [Int]
	print $ process 0 0 s []


-- https://codeforces.com/contest/1621/problem/A

answer size count
    | 2*count > size+1 = "-1\n"
    | otherwise = concat $ (\x -> (
        if even x && x < 2*count
        then replicate x '.' ++ "R" ++ replicate (size-x-1) '.'
        else replicate size '.') ++ "\n")
        <$> [0..(size-1)]

main = getLine >>= run . read
run 0 = return 0
run t = do
    [size, count] <- words <$> getLine
    putStr $ answer (read size) (read count)
    run $ t-1

import Control.Monad (replicateM_)

solve :: Int -> Int -> [String]
solve n m =
  if (n + 1) `div` 2 >= m
    then [[if i `rem` 2 == 1 && i `div` 2 < m && i == j then 'R' else '.' | j <- [1..n]] | i <- [1..n]]
    else ["-1"]

main :: IO ()
main = do
  tc <- readInt <$> getLine
  replicateM_ tc gao
  where
    readInt s = read s :: Int
    gao = do
      ns <- (map readInt . words) <$> getLine
      mapM_ putStrLn $ solve (head ns) (head $ tail ns)

module Main where

import Control.Monad (replicateM_)

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    [n,k] <- map (read ::String->Int) <$> words <$> getLine
    if (n + 1) `div` 2 < k then putStrLn "-1"
    else putStrLn . unlines $ solve n k
  where
    solve n k = [[c i j | j <- [0..n-1]]| i <- [0..n-1]]
       where
           c i j
            | mod i 2 == 0 && i==j && div i 2 < k = 'R'
            | otherwise = '.'

module Main (main) where

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput = concat . map processTest . drop 1 . lines

processTest :: String -> String
processTest input = output
    where
        [n, k] = map read $ words input
        output_lines = if 2*k - 1 <= n then possible_arrangement else ["-1"]
        output = unlines output_lines

        possible_arrangement =
            [
                [if x == y && odd x && x <= 2*k then 'R' else '.' | x <- [1..n]]
                | y <- [1..n]
            ]

import Data.List

main :: IO ()
main = interact $ concat . map (solve . map read . words) . tail . lines

solve :: [Int] -> String
solve [n, k] = display n $ place n k

onBoard :: Int -> (Int, Int) -> Bool
onBoard n (x, y) = 1 <= x && x <= n && 1 <= y && y <= n

place :: Int -> Int -> [(Int, Int)]
place n k
    | 2 * k - 1 <= n = rooks
    | otherwise = []
  where
    rooks = map dupe [1, 3 .. (2 * k - 1)]

dupe :: a -> (a, a)
dupe a = (a, a)

display :: Int -> [(Int, Int)] -> String
display _ [] = "-1\n"
display n rooks = unlines $ map displayRow [1 .. n]
  where
    displayRow r = map toChar [1 .. n]
      where
        toChar :: Int -> Char
        toChar c
            | (r, c) `elem` rooks = 'R'
            | otherwise = '.'

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

chunksOf :: Int -> [t] -> [[t]]
chunksOf n = unfoldr $ \li -> do
  guard $ not (null li)
  pure $ splitAt n li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, k] <- getInts 2
    let
      outArr :: UArray (Int, Int) Char
      outArr = accumArray (\_ v -> v) '.' ((1, 1), (n, n))
        $ [((r, r), 'R') | i <- [1 .. k], let  r = 2 * i - 1]
    pure $ if  k * 2  > n + 1
      then  putInts [-1]
      else  string7 $ unlines $ chunksOf n $ elems outArr

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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 $ P.words inp
  P.putStr $ toLazyByteString outp


module Main where

import Control.Monad
import Data.Int

main = do
    (n, x, y) <- do
        [n, x, y] <- words `liftM` getLine
        return (read n, read x, read y)

    let maxA = y - fromIntegral n + 1 :: Int64

    if maxA > 0 && maxA * maxA + fromIntegral n - 1 >= x
        then do
            putStrLn (show maxA)
            replicateM_ (n-1) (putStrLn "1")
        else putStrLn "-1"

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

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

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

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

solve (n, x, y)
    | big <= 0  = BS.pack "-1"
    | sqSum < x = BS.pack "-1"
    | otherwise = BS.unlines $ map BS.pack $ (show big):replicate (fromIntegral (n-1)) "1"
  where
    big = y - (n - 1)
    sqSum = (n - 1) + big ^ 2

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Data.List
class Scan a where scan' :: String -> a
instance Scan Int where scan' n = read n
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' f = read f
instance Scan Double where scan' d = read d
instance Scan Integer where scan' n = read n
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = scan'' (words x)
                                                 where
                                                   scan'' (x:y:_) = (scan' x,scan' y)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = scan'' (words x)
                                                          where
                                                            scan'' (x:y:z:_) = (scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = scan'' (words x)
                                                                   where
                                                                     scan'' (w:x:y:z:_) = (scan' w,scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = scan'' (words x)
                                                                            where
                                                                              scan'' (v:w:x:y:z:_) = (scan' v,scan' w,scan' x,scan' y,scan' z)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scan :: (Scan a) => IO a
scan = do n <- getLine
          return (scan' n)

scans :: (Scan a) => Int -> IO [a]
scans 0 = return []
scans n = do x <- scan
             xs <- scans (n-1)
             return (x:xs)

scanlist :: (Scan a) => IO [a]
scanlist = do l <- getLine
              return [scan' x|x<-words l]

scanlists :: (Scan a) => Int -> IO [[a]]
scanlists 0 = return []
scanlists n = do x <- scanlist :: (Scan a) => IO [a]
                 xs <- scanlists (n-1)
                 return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

rep 0 _ = []
rep i n = n:(rep (i-1) n)

solve :: Integer -> Integer -> Integer -> [Integer]
solve n x y = let max = y - (n-1) in
              if max < 1||(max*max+(n-1))<x then
                  [-1]
              else
                  max:(rep (n-1) (1::Integer))

main = do (n,x,y) <- scan::IO (Integer,Integer,Integer)
          putAnsLns (solve n x y)

import Data.Int
solve :: [Int64] -> [Int64]
solve [n,x,y] = if sum (map (^2) ps) < x || head ps <= 0 then [(-1)] else ps
    where ps = (y - n + 1) : replicate (fromIntegral n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

import Data.List
s[n,x,y]|r<1||b=[-1]|1>0=r:genericReplicate (n-1)1 where
 r=y-n+1
 b=x>r*r+n-1
main=interact$unwords.map show.s.map read.words

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Array
import Control.Monad
import Debug.Trace (trace)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInteger
fI = fromIntegral
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt (fI n) xs

solve [n, x, y]
    | pred      = a : replicate (fI $ n-1) 1
    | otherwise = [-1]
    where
    a = y - (n-1)
    pred = a > 0 && n-1 + a*a >= x

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    forM_ [solve ys | ys <- splitEvery 3 xs] $
        putStr . unlines . map show

import Data.List

solve :: [Integer] -> [Integer]
solve [n, x, y] =
  if y >= n && (p * p + n - 1) >= x then
    p:(genericReplicate (n - 1) 1)
  else
    [-1]
      where p = y - n + 1

main = do str <- getLine
          sequence_ $ map (putStrLn.show) $ solve $ map read $ words str

solve :: Integer -> Integer -> Integer -> Maybe Integer
solve n x y
  | m < 1  =  Nothing
  | n - 1 + m^2  < x  =  Nothing
  | otherwise  =  Just m
  where
    m  =  y - (n - 1)

main :: IO ()
main  =  do
    [n, x, y]  <-  fmap (map read . words) getLine
    case solve n x y of
        Nothing  ->  putStrLn "-1"
        (Just m)  ->  putStr (show m) >> putStrLn (take (2 * fromIntegral (n-1)) (cycle " 1"))

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Array
import Control.Monad
import Debug.Trace (trace)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInt
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt n xs

solve [n, x, y]
    | pred      = a : replicate (n-1) 1
    | otherwise = [-1]
    where
    a = y - (n-1)
    pred = a > 0 && n-1 + a*a >= x

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    forM_ [solve ys | ys <- splitEvery 3 xs] $
        putStr . unlines . map show

solve [n, x, y] =
  if y >= n && (p * p + n - 1) >= x then p:replicate (n - 1) 1 else [-1]
    where p = y - n + 1

main = do str <- getLine
          sequence_ $ map (putStrLn.show) $ solve $ map read $ words str

module Main where

import Control.Monad
import Data.Int

main = do
    (n, x, y) <- do
        [n, x, y] <- words `liftM` getLine
        return (read n, read x, read y)

    let maxA = y - fromIntegral n + 1 :: Int64

    if maxA * maxA + fromIntegral n - 1 >= x
        then do
            putStrLn (show maxA)
            replicateM_ (n-1) (putStrLn "1")
        else putStrLn "-1"

solve :: [Int] -> [Int]
solve [n,x,y] = if sum (map (^2) ps) < x then [(-1)] else ps
    where ps = (y - n + 1) : replicate (n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

solve :: [Int] -> [Int]
solve [n,x,y] = if sum (map (^2) ps) < x || head ps <= 0 then [(-1)] else ps
    where ps = (y - n + 1) : replicate (n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

s[n,x,y]|r<1||b=[-1]|1>0=r:replicate (n-1)1 where
 r=y-n+1
 b=x>r*r+n-1
main=interact$unwords.map show.s.map read.words


{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ParallelListComp #-}
import Control.Arrow (first)
import Control.Monad (forM, forM_)
import Data.Array (accumArray, listArray, (!))
import Data.Bits ((.&.), shiftL, shiftR)
import Data.List (sort)
import Data.Maybe (fromJust)
import qualified Data.IntSet as S
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

ctz :: Int -> Int
ctz n
  | n .&. 0xffff == 0 = ctz (n `shiftR` 16) + 16
  | n .&. 0x00ff == 0 = ctz (n `shiftR` 8) + 8
  | n .&. 0x000f == 0 = ctz (n `shiftR` 4) + 4
  | n .&. 0x0003 == 0 = ctz (n `shiftR` 2) + 2
  | otherwise         = 1 - (n .&. 1)

pairs :: [a] -> [(a, a)]
pairs (a:b:c) = (a, b): pairs c
pairs _ = []

main :: IO ()
main = do
  (n:input) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let (r, (_:q)) = splitAt n input
  putStrLn $ unwords $ map show $ solve n r $ pairs q

solve :: Int -> [Int] -> [(Int, Int)] -> [Int]
solve n r q = map snd $ sort $ snd $ runState (dfs 0 0 S.empty) []
  where
    e = accumArray (flip (:)) [] (0, n) $ zip r [1 ..]
    p = listArray (0, n) $ 0: r
    ps = listArray (0, 17) $ p:[
      listArray (0, n) [half!(half!j) | j <- [0 .. n]]
      | i <- [1 .. 17], let half = ps!(i - 1)]
    ancestor v 0 = v
    ancestor v d = let k = ctz d in ancestor (ps!k!v) (d - (1 `shiftL` k))
    query = M.fromListWith (++) $
      [(ancestor v d, [(d, i)]) | (v, d) <- q | i <- [0 ..]]

    dfs :: Int -> Int -> S.IntSet -> State [(Int, Int)] (M.IntMap Int)
    dfs v d s = do
      let qv = map (first (+d)) $ M.findWithDefault [] v query
          new = filter (`S.notMember` s) $ map fst $ qv
          s' = foldr S.insert s new
      children <- forM (e!v) $ \w -> dfs w (d + 1) s'

      let stat = foldr (M.unionWith (+)) M.empty children
      forM_ qv $ \(k, i) -> do
        let cnt = M.findWithDefault 0 k stat
        modify ((i, if v == 0 || cnt == 0 then 0 else cnt - 1):)

      let stat' = foldr M.delete stat new
      if d `S.member` s
        then return $ M.insertWith (+) d 1 stat'
        else return stat'

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)


import Data.List

--  three-room, five-room, and seven-room apartments.
-- one window per room

main = interact $ concat . intersperse "\n" . map solve . drop 1 . map read . lines

solve :: Int -> String
solve x
  | x == 1 || x == 2 || x == 4 = "-1"
  | otherwise = case mod x 3 of
  0 -> show (div x 3) ++ " 0 0"
  1 -> show (div x 3 - 2) ++ " 0 1"
  2 -> show (div x 3 - 1) ++ " 1 0"

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))

main :: IO ()
main = interact $ words >>> drop 1 >>> map (read >>> solve >>> showAns) >>> unlines
  where
    showAns Nothing = "-1"
    showAns (Just (x, y, z)) = unwords $ show <$> [x, y, z]

type TIII = (Int, Int, Int)

solve :: Int -> Maybe TIII
solve n = dp !! n
  where
    dp :: [Maybe TIII]
    dp =
      [ Just (0, 0, 0),
        Nothing,
        Nothing,
        Just (1, 0, 0),
        Nothing,
        Just (0, 1, 0),
        Just (2, 0, 0)
      ]
        ++ zipWith3
          try3
          (map (i3 <$>) $ drop 4 dp)
          (map (i5 <$>) $ drop 2 dp)
          (map (i7 <$>) dp)

    i3 :: TIII -> TIII
    i3 (x, y, z) = (x + 1, y, z)
    i5 :: TIII -> TIII
    i5 (x, y, z) = (x, y + 1, z)
    i7 (x, y, z) = (x, y, z + 1)

    try3 x y z = x `tryNext` y `tryNext` z

tryNext :: Maybe a -> Maybe a -> Maybe a
tryNext (Just x) _ = Just x
tryNext _ (Just y) = Just y
tryNext _ _ = Nothing


import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

pairwise :: (a -> a -> b) -> [a] -> [b]
pairwise _ []     = []
pairwise _ [x]    = []
pairwise f (x:xs) = map (f x) xs ++ pairwise f xs

countValues 0 books = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = sum $ pairwise (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)
import Data.Array

getInts :: IO [Int32]
getInts = map (read . dropWhile (==' ') . takeWhile (/=' ')) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    items <- (map (\x -> x - 1) . L.sort) <$> (getInts)
    let arr = accumArray (+) 0 (0, m - 1) [ (i, 1) | i <- items]
    let res = sum [ arr ! i * arr ! j | i <- [0 .. m - 2], j <- [i + 1 .. m - 1]]
    putStrLn $ show res

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)
import Data.Array

getInts :: IO [Int32]
getInts = map (read . T.unpack . T.strip . T.pack ) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    items <- (map (\x -> x - 1) . L.sort) <$> (getInts)
    let arr = accumArray (+) 0 (0, m - 1) [ (i, 1) | i <- items]
    let res = sum [ arr ! i * arr ! j | i <- [0 .. m - 2], j <- [i + 1 .. m - 1]]
    putStrLn $ show res

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)

getInts :: IO [Int32]
getInts = map (read . T.unpack . T.strip . T.pack ) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    --putStrLn $ show [n,m]
    items <- L.sort <$> (getInts)
    --putStrLn $ show items
    let (l', _) = foldr (\x (c : cs, pr) -> if x == pr then ((c + 1) : cs, x) else (1 : c : cs, x)) ([0], 0) items
    let l = init l'
    --putStrLn $ show l

    let res = sum [l !! i * l !! j | i <- [0 .. length l - 1], j <- [0 .. length l - 1], i /= j]
    putStrLn $ show (res `div` 2)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

pfoldl :: (a -> a -> a) -> (a -> a -> a) -> [a] -> a
pfoldl f g (x:xs)
    | length xs > 1  = f (foldl1 f (map (g x) xs)) (pfoldl f g xs)
    | length xs == 1 = g x (head xs)

countValues 0 _     = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = pfoldl (+) (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

-- pairwise folding:
-- f is used to fold the results generated by each application of g
-- g is applied to each pair of elements (non-replacing)
pfoldl1 :: (a -> a -> a) -> (a -> a -> a) -> [a] -> a
pfoldl1 _ g [x, y] = g x y
pfoldl1 f g (x:xs) = f (foldl1 f (map (g x) xs)) (pfoldl1 f g xs)

countValues 0 _     = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = pfoldl1 (+) (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char (digitToInt, intToDigit)
import Data.List (foldl')

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM

parseInt :: ByteString -> Int
parseInt s
  | BS.head s == '-' = negate (go 0 (BS.tail s))
  | otherwise = go 0 s
  where
    go i s
      | BS.null s = i
      | otherwise = go (i*10 + digitToInt (BS.head s)) (BS.tail s)

printInt :: Int -> ByteString
printInt i
  | i < 10 = BS.singleton (intToDigit i)
  | otherwise = BS.snoc (printInt (i `quot` 10)) (intToDigit (i `rem` 10))

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  n:m:_ <- fmap (map (fromIntegral . parseInt) . BS.words) BS.getLine
  genres <- fmap (map (fromIntegral . parseInt) . BS.words) BS.getLine
  let counts = map snd . IM.toDescList $ foldl' (flip (IM.alter (Just . maybe 1 (+1)))) IM.empty genres
  --print counts
  let options = foldl' (\s c -> s + c * (n-c)) 0 counts :: Integer
  BS.putStrLn . printInt . fromIntegral $ options `quot` 2

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

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n m xs

solve :: Int -> Int -> U.Vector Int -> Int
solve _ m xs = sum [freq U.! i * freq U.! j | i<-[1..m-1],j<-[i+1..m]]
  where
    freq = U.unsafeAccumulate (+) (U.replicate (m+1) 0) $ U.map (,1) xs

import Data.List (groupBy, sort)

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

  let
    bs = map (fromIntegral . length) . groupBy (==) $ sort as
    s = sum bs
    ss = map (s -) $ scanl1 (+) bs
    r = sum $ zipWith (*) ss bs

  print r

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

f n = quot (n * (n-1)) 2

dirty 0 books = 0
dirty m books = let (left, right) = span (== m) books in
                    f (length left) + dirty (m-1) right
solve (n:m:books) = (f n) - (dirty m $ sortBy (flip compare) books)

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

f :: Integral a => a -> a
f n = quot (n * (n-1)) 2

countInvalid 0 books = 0
countInvalid m books = let (left, right) = span (== m) books in
                    f (length left) + countInvalid (m-1) right
solve (n:m:books) = (f n) - (countInvalid m $ sortBy (flip compare) books)

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)


import Data.Function

[fd,fe,fh,fi] = map (\x -> fix (\ f g as -> if null as then "NO" else if head as == x then g $ tail as else f g $ tail as)) "dehi"

main =getLine >>= \x -> putStrLn $ if x == "heidi" then "NO" else fh ( fe  (fi  (fd  (fi (const "YES"))))) x

[] `isSubseqOf` _ = True
_ `isSubseqOf` [] = False
x@(a:as) `isSubseqOf` y@(b:bs)
  | a == b = as `isSubseqOf` bs
  | otherwise = x `isSubseqOf` bs

main =  (\l -> putStrLn $ if "heidi" `isSubseqOf` l then "YES" else "NO") =<< getLine

[] `isSubseqOf` _ = True
_ `isSubseqOf` [] = False
x@(a:as) `isSubseqOf` (b:bs)
  | a == b = as `isSubseqOf` bs
  | otherwise = x `isSubseqOf` bs

main =  (\l -> putStrLn $ if "heidi" `isSubseqOf` l then "YES" else "NO") =<< getLine

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

process [] _ = True
process _ [] = False
process (x:xs) y | elem x y = process xs (dropWhile (/=x) y)
                 | otherwise = False

main = do
		n<-getLine
		putStrLn $ if process "heidi" n then "YES" else "NO"