NN is an experienced internet user and that means he spends a lot of time on the social media. Once he found the following image on the Net, which asked him to compare the sizes of inner circles:  It turned out that the circles are equal. NN was very surprised by this fact, so he decided to create a similar picture himself.He managed to calculate the number of outer circles $$$n$$$ and the radius of the inner circle $$$r$$$. NN thinks that, using this information, you can exactly determine the radius of the outer circles $$$R$$$ so that the inner circle touches all of the outer ones externally and each pair of neighboring outer circles also touches each other. While NN tried very hard to guess the required radius, he didn't manage to do that. Help NN find the required radius for building the required picture.

The first and the only line of the input file contains two numbers $$$n$$$ and $$$r$$$ ($$$3 \leq n \leq 100$$$, $$$1 \leq r \leq 100$$$) — the number of the outer circles and the radius of the inner circle respectively.

Output a single number $$$R$$$ — the radius of the outer circle required for building the required picture.  Your answer will be accepted if its relative or absolute error does not exceed $$$10^{-6}$$$. Formally, if your answer is $$$a$$$ and the jury's answer is $$$b$$$. Your answer is accepted if and only when $$$\frac{|a-b|}{max(1, |b|)} \le 10^{-6}$$$.

-- Codeforces Round #532 (C), Contest 1100, Problem set ?.
-- UNDONE

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

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

main :: IO ()
main = do
  [n,r] <- map read . words <$> getLine :: IO [Double]
  print $ r * sin(pi/n) / (1 - sin (pi/n))

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import qualified Data.ByteString.Char8 as B8
import Data.Foldable (foldr')
import Data.Bits
import Data.IORef

readInt :: String -> Int
readInt = Prelude.read

readB8Int :: B8.ByteString -> Int
readB8Int = fst . fromJust . B8.readInt

solve :: Double -> Double -> Double
solve n r = r / (1 / sin (2 * pi / (2 * n)) - 1)

main :: IO ()
main = do
    [n, r] <- (map (read :: String -> Double) . words) <$> getLine
    let answer = solve n r
    printf "%.10f" $ answer

main :: IO ()
main = do
  [n, r] <- map (read :: String -> Double) . words <$> getLine
  print $ r / (sqrt (2 / (1 - cos (2 * pi / n))) - 1)


We all know the problem about the number of ways one can tile a 2 × n field by 1 × 2 dominoes. You probably remember that it goes down to Fibonacci numbers. We will talk about some other problem below, there you also are going to deal with tiling a rectangular field with dominoes.You are given a 4 × n rectangular field, that is the field that contains four lines and n columns. You have to find for it any tiling by 1 × 2 dominoes such that each of the n - 1 potential vertical cuts along the grid lines intersects at least one domino, splitting it in two. No two dominoes in the sought tiling should overlap, each square of the field should be covered by exactly one domino. It is allowed to rotate the dominoes, that is, you can use 2 × 1 as well as 1 × 2 dominoes.Write a program that finds an arbitrary sought tiling.

The input contains one positive integer n (1 ≤ n ≤ 100) — the number of the field's columns.

If there's no solution, print "-1" (without the quotes). Otherwise, print four lines containing n characters each — that's the description of tiling, where each vertical cut intersects at least one domino. You should print the tiling, having painted the field in no more than 26 colors. Each domino should be painted a color. Different dominoes can be painted the same color, but dominoes of the same color should not be side-neighbouring. To indicate colors you should use lowercase Latin letters. Print any of the acceptable ways of tiling.

{-# 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 <- readInt
    return n
  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 :: Int -> ByteString
solve n = BS.unlines . map BS.pack $ answer
  where
    answer
      | even n    = [r2 0 False, r121 1 False, r121 2 True, r2 3 False]
      | otherwise = [r21 0 False, r21 1 True, r12 2 False, r12 3 True]

    n2 = n `div` 2

    r2 = color (replicate n2 2)
    r121 = color ([1] ++ replicate (n2 - 1) 2 ++ [1])
    r21 = color (replicate n2 2 ++ [1])
    r12 = color ([1] ++ replicate n2 2)

    color :: [Int] -> Int -> Bool -> String
    color a row bool = concatMap go $ zip (cycle [0..4]) a
      where
        go (id, num) = replicate num (chr $ ord 'a' + row' * 5 + id)
          where
            row' = if num == 1 && bool then row - 1 else row -- vertical

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

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

main = (read `fmap` getLine) >>= \n ->
    (if even n then mapM_ (putStrLn . take n . concat . repeat) ["aabb", "ccdd"] >>
        mapM_ (\x -> putStrLn $ "e" ++ (take (n - 2) $ concat $ repeat x) ++ "h")
            ["ffgg", "aabb"]
    else mapM_ (\x -> putStrLn $ "a" ++ (take (n - 1) $ concat $ repeat x))
            ["bbcc", "ddee"] >>
        mapM_ (\x -> putStrLn $ (take (n - 1) $ concat $ repeat x)++"g")
            ["bbcc", "ddee"])

import Control.Applicative
import Data.Monoid
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.Maybe

type Ending = [IsHorisEnd]

data State s v = State { runState :: (s -> (s, v)) }
type StateMap a b = State (Map a b) b

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

instance Monad (State a) where
    return x = State $ \m -> (m, x)
    a >>= f = joinState $ f <$> a

joinState s = State $ \m -> let (m', s') = runState s m in runState s' m'

get = State $ \m -> (m, m)
put m' = State $ \m -> (m', ())
evalState s m = snd $ (runState s) m

memoizeM :: (Show a, Show b, Ord a) =>
            ((a -> StateMap a b) -> (a -> StateMap a b)) -> (a -> b)
memoizeM t x = evalState (f x) Map.empty where
  g x = do
    y <- t f x
    m <- get
    put $ Map.insert x y m
    newM <- get
    return $ y
  f x = get >>= \m -> maybe (g x) return (Map.lookup x m)

type IsHorisEnd = Bool
type IsVertStart = Bool

getContinuations :: Ending -> [[(IsHorisEnd, IsVertStart)]]
getContinuations = go
    where
        go :: [Bool] -> [[(IsHorisEnd, IsVertStart)]]
        go [] = [[]]
        go (False : False : t) = let aug l = [(True, False) : (True, False) : l, (False, True) : (False, False) : l] in go t >>= aug
        go (b : t) = map ((not b, False) :) $ go t

getHor :: Int -> Int -> Char
getHor n i = toEnum $ fromEnum 'a' + (i `mod` 2) + 2 * (n `mod` 3)
getVert :: Int -> Int -> Char
getVert n i = toEnum $ fromEnum 'p' + (n `mod` 2) + 2 * (i `mod` 3)

solve :: (Functor m, Monad m) => ((Ending, Int) -> m (Maybe [String])) -> (Ending, Int) -> m (Maybe [String])
solve rec (ed, 0) = return $ do
    guard (not $ or ed)
    (return ["","","",""]) :: Maybe [String]
solve rec (ed, n) = getFirst . mconcat . map First <$> (solveAll $ getContinuations ed)
    where
        solveAll = mapM solve
        solve cont | (not $ isGood (map fst cont)) = return Nothing
        solve cont = do
            res <- rec (map fst cont, n-1)
            return (appendThis cont <$> (res :: Maybe [String]) :: Maybe [String])
        isGood | n==1 = not . or
               | n>1 = or
        appendThis :: [(IsHorisEnd, IsVertStart)] -> [String] -> [String]
        appendThis cont res = zipWith (:) (getThis cont) res
        getChar True (False, False) i = getHor (n+1) i
        getChar False (True, False) i = getHor n i
        getChar False (False, True) i = getVert n i
        getChar False (False, False) i = getVert n (i-1)
        getThis cont = zipWith3 getChar ed cont [1..]

main = interact $ unlines . fromMaybe ["-1"] . memoizeM solve . (\n -> (replicate 4 False, n)) . read

module Main where

import Control.Monad

main = do
    n <- read `liftM` getLine
    putStr $ board n

board n =
    if even n
    then
        take n (cycle "aabb") ++ "\n" ++
        "i" ++ take (n-2) (cycle "ccdd") ++ "j\n" ++
        "i" ++ take (n-2) (cycle "eeff") ++ "j\n" ++
        take n (cycle "gghh") ++ "\n"
    else
        take (n-1) (cycle "aabb") ++ "i\n" ++
        take (n-1) (cycle "ccdd") ++ "i\n" ++
        "j" ++ take (n-1) (cycle "eeff") ++ "\n" ++
        "j" ++ take (n-1) (cycle "gghh") ++ "\n"

myPrint :: Int -> Int -> String
myPrint 1 n
    | mod n 2 == 0 = take n (cycle "aabb")
    | otherwise = take (n - 1) (cycle "aabb") ++ "z"
myPrint 2 n
    | mod n 2 == 0 = take n (cycle "ccdd")
    | otherwise = take (n - 1) (cycle "ccdd") ++ "z"
myPrint 3 n
    | mod n 2 == 0 = 'q' : (take (n - 2) (cycle "aabb") ++ "z")
    | otherwise = 'q' : (take (n - 1) (cycle "aabb"))
myPrint 4 n
    | mod n 2 == 0 = 'q' : (take (n - 2) (cycle "ccdd") ++ "z")
    | otherwise = 'q' : (take (n - 1) (cycle "ccdd"))

main = do
    n <- readLn::IO Int
    putStrLn (myPrint 1 n)
    putStrLn (myPrint 2 n)
    putStrLn (myPrint 3 n)
    putStrLn (myPrint 4 n)

main = (read `fmap` getLine) >>= \n ->
    (if even n then mapM_ (putStrLn . take n . concat . repeat) ["aabb", "ccdd"] >>
        mapM_ (\x -> putStrLn $ "e" ++ (take (n - 2) $ concat $ repeat x) ++ "e")
            ["ffgg", "aabb"]
    else mapM_ (\x -> putStrLn $ "a" ++ (take (n - 1) $ concat $ repeat x))
            ["bbcc", "ddee"] >>
        mapM_ (\x -> putStrLn $ (take (n - 1) $ concat $ repeat x)++"a")
            ["bbcc", "ddee"])

main = (read `fmap` getLine) >>= \n ->
    (if even n then mapM_ (putStrLn . take n . concat . repeat) ["aabb", "ccdd"] >>
        mapM_ (\x -> putStrLn $ "e" ++ (take (n - 2) $ concat $ repeat x) ++ "h")
            ["ffgg", "aabb"]
    else mapM_ (\x -> putStrLn $ "a" ++ (take (n - 1) $ concat $ repeat x))
            ["bbcc", "ddee"] >>
        mapM_ (\x -> putStrLn $ (take (n - 1) $ concat $ repeat x)++"a")
            ["bbcc", "ddee"])


The Little Elephant loves to play with color cards.He has n cards, each has exactly two colors (the color of the front side and the color of the back side). Initially, all the cards lay on the table with the front side up. In one move the Little Elephant can turn any card to the other side. The Little Elephant thinks that a set of cards on the table is funny if at least half of the cards have the same color (for each card the color of the upper side is considered).Help the Little Elephant to find the minimum number of moves needed to make the set of n cards funny.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of the cards. The following n lines contain the description of all cards, one card per line. The cards are described by a pair of positive integers not exceeding 109 — colors of both sides. The first number in a line is the color of the front of the card, the second one — of the back. The color of the front of the card may coincide with the color of the back of the card. The numbers in the lines are separated by single spaces.

On a single line print a single integer — the sought minimum number of moves. If it is impossible to make the set funny, print -1.

NoteIn the first sample there initially are three cards lying with colors 4, 4, 7. Since two of the three cards are of the same color 4, you do not need to change anything, so the answer is 0.In the second sample, you can turn the first and the fourth cards. After that three of the five cards will be of color 7.

{-# 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
  n <- readLn
  ps <- replicateM n $ getInts

  let
    a = map (\g -> (head g, length g)) . group . sort $ map (!! 0) ps
    b = map (\g -> (head g, length g)) . group . sort $ map (!! 1) $ filter (\[a, b] -> a /= b) ps

    max' m (c1, c2)
      | c1 + c2 >= (n+1)`div`2 = min m $ max 0 $ (n+1)`div`2 - c1
      | otherwise = m

    merge [] [] m = m
    merge ((_, c1):as) [] m = merge as [] $ max' m (c1, 0)

    merge [] ((_, c2):bs) m = merge [] bs $ max' m (0, c2)

    merge as@((a, c1):as') bs@((b, c2):bs') m
      | a < b = merge as' bs $ max' m (c1, 0)
      | a > b = merge as bs' $ max' m (0, c2)
      | otherwise = merge as' bs' $ max' m (c1, c2)

    r :: Int = merge a b maxBound

  print $ if r == maxBound then -1 else r

import Data.IntMap (elems, empty, insertWith, unionWith)
import Monad (liftM)

solve :: Int -> [(Int, Int)] -> Int
solve n xs
  | res == maxBound  =  -1
  | otherwise  =  res
  where
    res  =  minimum $ map f $ elems $ unionWith add mapA mapB
    halfN  =  div n 2 + mod n 2
    mapA  =  foldl (\map x -> insertWith add x (1,0) map) empty (map fst xs)
    mapB  =  foldl (\map x -> insertWith add x (0,1) map) empty (map snd . filter notEq $ xs)
    notEq (x, y)  =  x /= y
    add (a, b) (c, d)  =  (a+c, b+d)
    f (a,b)
      | a + b >= halfN  =  max 0 (halfN - a)
      | otherwise  =  maxBound

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

main :: IO ()
main  =  do
    n   <-  readLn
    xs  <-  liftM (take n . map parse . lines) getContents
    print $ solve n xs

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

readInt s = let Just (n,_) = B.readInt s in n

toPairs [] = []
toPairs (x:y:xys) = (x,y):toPairs xys

ins imap (x,y)
  | x==y = IM.insertWith (\_ (f,b)->(f+1,b)) x (1,0) imap
  | otherwise = IM.insertWith (\_ (f,b)->(f+1,b)) x (1,0) $
                  IM.insertWith (\_ (f,b)->(f,b+1)) y (0,1) imap

main = do
  n <- readLn
  let m = (n+1)`div`2
  gr <- IM.elems.foldl' ins IM.empty.toPairs.map readInt.B.words<$> B.getContents
  case filter (\(f,b)->f+b>=m) gr of
    [] -> print $ -1
    xs -> print $ minimum $ map (\(f,b)-> max 0 $ m-f) 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
  n <- readLn
  ps <- replicateM n $ getInts

  let
    a = map (\g -> (head g, length g)) . group . sort $ map (!! 0) ps
    b = map (\g -> (head g, length g)) . group . sort $ map (!! 1) $ filter (\[a, b] -> a /= b) ps

    max' m (c1, c2)
      | c1 + c2 > n`div`2 = min m $ max 0 $ n`div`2 + 1 - c1
      | otherwise = maxBound

    merge [] [] m = m
    merge ((_, c1):as) [] m = merge as [] $ max' m (c1, 0)
    merge [] ((_, c2):bs) m = merge [] bs $ max' m (0, c2)
    merge as@((a, c1):as') bs@((b, c2):bs') m
      | a < b = merge as' bs $ max' m (c1, 0)
      | a > b = merge as bs' $ max' m (0, c2)
      | otherwise = merge as' bs' $ max' m (c1, c2)

    r :: Int = merge a b maxBound

  print $ if r == maxBound then -1 else r

{-# 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
  n <- readLn
  ps <- replicateM n $ getInts

  let
    a = map (\g -> (head g, length g)) . group . sort $ map (!! 0) ps
    b = map (\g -> (head g, length g)) . group . sort $ map (!! 1) $ filter (\[a, b] -> a /= b) ps

    merge [] _ m = m
    merge _ [] m = m
    merge as@((a, c1):as') bs@((b, c2):bs') m
      | a < b = merge as' bs m
      | a > b = merge as bs' m
      | c1 + c2 > n `div` 2 = merge as' bs' $ min m $ max 0 $ n`div`2 + 1 - c1
      | otherwise = merge as' bs' m

    r = merge a b maxBound

  print $ if r == maxBound then -1 else r

{-# 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
  n <- readLn
  ps <- replicateM n $ getInts

  let
    a = map (\g -> (head g, length g)) . group . sort $ map (!! 0) ps
    b = map (\g -> (head g, length g)) . group . sort $ map (!! 1) $ filter (\[a, b] -> a /= b) ps

    max' m (c1, c2)
      | c1 + c2 > n`div`2 = min m $ max 0 $ n`div`2 + 1 - c1
      | otherwise = m

    merge [] [] m = m
    merge ((_, c1):as) [] m = merge as [] $ max' m (c1, 0)

    merge [] ((_, c2):bs) m = merge [] bs $ max' m (0, c2)

    merge as@((a, c1):as') bs@((b, c2):bs') m
      | a < b = merge as' bs $ max' m (c1, 0)
      | a > b = merge as bs' $ max' m (0, c2)
      | otherwise = merge as' bs' $ max' m (c1, c2)

    r :: Int = merge a b maxBound

  print $ if r == maxBound then -1 else r


Once upon a time, when the world was more beautiful, the sun shone brighter, the grass was greener and the sausages tasted better Arlandia was the most powerful country. And its capital was the place where our hero DravDe worked. He couldn’t program or make up problems (in fact, few people saw a computer those days) but he was nevertheless happy. He worked in a warehouse where a magical but non-alcoholic drink Ogudar-Olok was kept. We won’t describe his work in detail and take a better look at a simplified version of the warehouse.The warehouse has one set of shelving. It has n shelves, each of which is divided into m sections. The shelves are numbered from top to bottom starting from 1 and the sections of each shelf are numbered from left to right also starting from 1. Each section can contain exactly one box of the drink, and try as he might, DravDe can never put a box in a section that already has one. In the course of his work DravDe frequently notices that he has to put a box in a filled section. In that case his solution is simple. DravDe ignores that section and looks at the next one to the right. If it is empty, he puts the box there. Otherwise he keeps looking for the first empty section to the right. If no empty section is found by the end of the shelf, he looks at the shelf which is under it, then the next one, etc. Also each time he looks at a new shelf he starts from the shelf’s beginning. If DravDe still can’t find an empty section for the box, he immediately drinks it all up and throws the empty bottles away not to be caught.After one great party with a lot of Ogudar-Olok drunk DravDe asked you to help him. Unlike him, you can program and therefore modeling the process of counting the boxes in the warehouse will be easy work for you.The process of counting contains two types of query messages:   «+1 x y id» (where x, y are integers, 1 ≤ x ≤ n, 1 ≤ y ≤ m, and id is a string of lower case Latin letters — from 1 to 10 characters long). That query means that the warehouse got a box identified as id, which should be put in the section y on the shelf x. If the section is full, use the rules described above. It is guaranteed that every moment of the process the identifiers of all the boxes in the warehouse are different. You don’t have to answer this query.  «-1 id» (where id is a string of lower case Latin letters — from 1 to 10 characters long). That query means that a box identified as id is removed from the warehouse. You have to answer this query (see output format).

The first input line contains integers n, m and k (1 ≤ n, m ≤ 30, 1 ≤ k ≤ 2000) — the height, the width of shelving and the amount of the operations in the warehouse that you need to analyze. In the following k lines the queries are given in the order of appearance in the format described above.

For each query of the «-1 id» type output two numbers in a separate line — index of the shelf and index of the section where the box with this identifier lay. If there was no such box in the warehouse when the query was made, output «-1 -1» without quotes.

2 2 9
+1 1 1 cola
+1 1 1 fanta
+1 1 1 sevenup
+1 1 1 whitekey
-1 cola
-1 fanta
-1 sevenup
-1 whitekey
-1 cola

2 2 8
+1 1 1 cola
-1 cola
+1 1 1 fanta
-1 fanta
+1 1 1 sevenup
-1 sevenup
+1 1 1 whitekey
-1 whitekey

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [h, w, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (0, w*h-1) $ zip [0..(w*h-1)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = i*w + j
      loc = locate arr n n
      i = -1 + (read i' :: Int)
      j = -1 + (read j' :: Int)
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 0

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + n `div` w
    j = 1 + n `mod` w

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n n0
--  | n == (n0-1) = -1
--  | n > r = locate arr 0 n0
  | n > r = -1
  | otherwise = if arr!n == "" then n else locate arr (n+1) n0
    where (_, r) = bounds arr

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1"  = case elemIndex (a!!1) b of
                                       Just c -> (toString (c`div`n+1))++" "++
                                                 (toString (c`mod`n+1))++"\n"++
                                                 solve m n xs (ins c "" b)
                                       Nothing ->"-1 -1\n"++
                                                 solve m n xs b
                   | a!!3 `elem` b = "#"
                   | b!!ind == ""  =  solve m n xs (ins ind (a!!3) b)
                   | otherwise     =  case elemIndex "" (drop (ind) b) of
                                        Just c -> solve m n xs (ins (c+ind) (a!!3) b)
                                        Nothing ->solve m n xs b
                                    where
                                      l = length b
                                      ind = (toInt (a!!1) -1)*n + (toInt (a!!2)-1)
solve _ _ [] _ = ""

{-# LANGUAGE ForeignFunctionInterface #-}

import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe
import Data.List (foldl')
import Data.Array
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Debug.Trace

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
{-# INLINE unsafeReadDouble #-}
readDouble = unsafeReadDouble . SB.concat . LB.toChunks
readInt = fst . fromJust . LB.readInt

debug :: Show a => a -> b -> b
--debug = trace . show
debug _ = id

main = readFile "input.txt" >>= (writeFile "output.txt" . output . solve . parse . lines)

output = unlines . map (\(x, y) -> show x ++ " " ++ show y)

parse :: [String] -> (Int, Int, [([Int], String)])
parse (nmk:rest) =
  let [n, m, k] = map read . words $ nmk
      lst = map (f . words) . take k $ rest
      f wds = (rfix (head wds) : map read (tail (init wds)), last wds)
      rfix ('+':s) = 1
      rfix ('-':s) = -1
  in (n, m, lst)

solve (n, m, lst) =
  let (_, _, responses) = foldl' process (startingState, M.empty, []) lst
      startingState = IM.fromDistinctAscList $ zip [1..n]
             (repeat (IM.fromDistinctAscList $ zip [1..m] (repeat "")))

      process (state, idx, responses) (nums, name) =
        case head nums of
            1 -> processAdd state idx responses (tail nums) name
            _ -> processRemove state idx responses name

      processRemove state idx responses name =
        case M.lookup name idx of
          Nothing -> (state, idx, (-1, -1) : responses)
          Just (x,y) -> (newState, newIdx, (x,y) : responses)
            where newIdx = M.delete name idx
                  newState = IM.insert x (IM.insert y "" oldArray) state
                  Just oldArray = IM.lookup x state

      processAdd state idx responses [x,y] name =
        case findFree state x y of
          Nothing -> debug "miss" (state, idx, responses)
          Just (i, j) -> debug (i,j) $ (newState, newIdx, responses)
            where newState = IM.insert i (IM.insert j name oldArray) state
                  Just oldArray = IM.lookup i state
                  newIdx = M.insert name (i,j) idx

      findFree state x y | y == m+1 = findFree state (x+1) 1
                         | x == n+1 = Nothing
      findFree state x y =
        case IM.lookup y arr of
          Just "" -> Just (x,y)
          Just s  -> debug s $ findFree state x (y+1)
        where Just arr = IM.lookup x state

  in reverse responses

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (1, w*h) $ zip [1..(w*h)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = (i-1)*(j-1)+1
      loc = locate arr n
      i = read i' :: Int
      j = read j' :: Int
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 1

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + ((n-1) `div` w)
    j = 1 + ((n-1) `mod` w)

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n
  | n > r = -1
  | otherwise = if arr!n == "" then n else locate arr (n+1)
    where (_, r) = bounds arr

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (0, w*h-1) $ zip [0..(w*h-1)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = i*w + j
      loc = locate arr n n
      i = -1 + (read i' :: Int)
      j = -1 + (read j' :: Int)
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 0

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + n `div` w
    j = 1 + n `mod` w

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n n0
--  | n == (n0-1) = -1
--  | n > r = locate arr 0 n0
  | n > r = -1
  | otherwise = if arr!n == "" then n else locate arr (n+1) n0
    where (_, r) = bounds arr

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (1, w*h) $ zip [1..(w*h)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = (i-1)*w + j
      loc = locate arr n
      i = read i' :: Int
      j = read j' :: Int
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 1

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + ((n-1) `div` w)
    j = 1 + ((n-1) `mod` w)

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n
  | n > r = -1
  | otherwise = if arr!n == "" then n else locate arr (n+1)
    where (_, r) = bounds arr

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (1, w*h) $ zip [1..(w*h)] emptyStrings
  let commands = map words $ tail list
  let result = foldl f (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = (i-1)*(j-1)+1
      loc = locate arr n
      i = read i' :: Int
      j = read j' :: Int
f (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], (("-1 " ++ arr!loc):actions))
    where
      loc = find name arr 1

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n
  | n > r = -1
  | otherwise = if arr!n == "" then n else locate arr (n+1)
    where (_, r) = bounds arr

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (1, w*h) $ zip [1..(w*h)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = (i-1)*(j-1)+1
      loc = locate arr n n
      i = read i' :: Int
      j = read j' :: Int
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 1

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + ((n-1) `div` w)
    j = 1 + ((n-1) `mod` w)

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n0 n
  | n == n0-1 = -1
  | n > r = locate arr n0 1
  | otherwise = if arr!n == "" then n else locate arr n0 (n+1)
    where (_, r) = bounds arr

import System.IO
import Array

emptyStrings = "":emptyStrings

main :: IO()
main = do
  s <- readFile "input.txt"
  let list = lines s
  let [w, h, n] = map (\x -> read x :: Int) $ words $ head list
  let arr = array (1, w*h) $ zip [1..(w*h)] emptyStrings
  let commands = map words $ tail list
  let result = foldl (f w h) (arr, []) commands
--  mapM_ (\s -> putStrLn s) $ reverse $ snd result
  writeFile "output.txt" $ unlines $ foldr (:) [] $ reverse $ snd result

f w h (arr, actions) ["+1", i', j', name]
  | loc < 0 = (arr, actions)
  | otherwise = (arr // [(loc, name)], actions)
    where
      n = (i-1)*w + j
      loc = locate arr n n
      i = read i' :: Int
      j = read j' :: Int
f w h (arr, actions) ["-1", name]
  | loc < 0 = (arr, ("-1 -1":actions))
  | otherwise = (arr // [(loc, "")], ((parse w h loc):actions))
    where
      loc = find name arr 1

parse w h n = show i ++ " " ++ show j
  where
    i = 1 + ((n-1) `div` w)
    j = 1 + ((n-1) `mod` w)

find name arr n
  | n > r = -1
  | otherwise = if arr!n == name then n else find name arr (n+1)
    where (_, r) = bounds arr

locate arr n n0
  | n == (n0-1) = -1
  | n > r = locate arr 1 n0
  | otherwise = if arr!n == "" then n else locate arr (n+1) n0
    where (_, r) = bounds arr

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1" = case elemIndex (a!!1) (reverse b) of
                                      Just c -> (toString ((l-c-1)`div`n+1) )++" "++
                                                (toString ((l-c-1)`mod`n+1))++"\n"++
                                                solve m n xs (ins (l-c-1) "" b)
                                      Nothing ->"-1 -1\n"++
                                                solve m n xs b
                   | b!!(ind (a!!1) (a!!2)) == ""
                                  = solve m n xs (ins (ind (a!!1) (a!!2)) (a!!3) b)
                   | otherwise    = case elemIndex "" b of
                                      Just c -> solve m n xs (ins c (a!!3) b)
                                      Nothing ->"#"
                                    where
                                      l = length b
                                      ind a b = (toInt a -1)*n + (toInt b-1)
solve _ _ [] _ = ""

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1" = case elemIndex (a!!1) (reverse b) of
                                      Just c -> (toString ((l-c-1)`div`n+1) )++" "++
                                                (toString ((l-c-1)`mod`n+1))++"\n"++
                                                solve m n xs (ins (l-c-1) "" b)
                                      Nothing ->"-1 -1\n"++
                                                solve m n xs b
                   | b!!(ind (a!!1) (a!!2)) == ""
                                  = solve m n xs (ins (ind (a!!1) (a!!2)) (a!!3) b)
                   | otherwise    = case elemIndex "" b of
                                      Just c -> solve m n xs (ins c (a!!3) b)
                                      Nothing ->undefined
                                    where
                                      l = length b
                                      ind a b = (toInt a -1)*n + (toInt b-1)
solve _ _ [] _ = ""

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1"  = case elemIndex (a!!1) b of
                                       Just c -> (toString (c`div`n+1))++" "++
                                                 (toString (c`mod`n+1))++"\n"++
                                                 solve m n xs (ins c "" b)
                                       Nothing ->"-1 -1\n"++
                                                 solve m n xs b
                   | a!!3 `elem` b = "#"
                   | b!!ind == ""  =  solve m n xs (ins ind (a!!3) b)
                   | otherwise     =  case elemIndex "" (drop ind b) of
                                        Just c -> solve m n xs (ins c (a!!3) b)
                                        Nothing ->solve m n xs b
                                    where
                                      l = length b
                                      ind = (toInt (a!!1) -1)*n + (toInt (a!!2)-1)
solve _ _ [] _ = ""

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1"  = case elemIndex (a!!1) (reverse b) of
                                       Just c -> (toString ((l-c-1)`div`n+1) )++" "++
                                                 (toString ((l-c-1)`mod`n+1))++"\n"++
                                                 solve m n xs (ins (l-c-1) "" b)
                                       Nothing ->"-1 -1\n"++
                                                 solve m n xs b
                   | a!!3 `elem` b = "#"
                   | b!!ind == ""  =  solve m n xs (ins ind (a!!3) b)
                   | otherwise     =  case elemIndex "" (drop ind b) of
                                      Just c -> solve m n xs (ins c (a!!3) b)
                                      Nothing ->"#"
                                    where
                                      l = length b
                                      ind = (toInt (a!!1) -1)*n + (toInt (a!!2)-1)
solve _ _ [] _ = ""

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1"  = case elemIndex (a!!1) (reverse b) of
                                       Just c -> (toString ((l-c-1)`div`n+1) )++" "++
                                                 (toString ((l-c-1)`mod`n+1))++"\n"++
                                                 solve m n xs (ins (l-c-1) "" b)
                                       Nothing ->"-1 -1\n"++
                                                 solve m n xs b
                   | a!!3 `elem` b = "#"
                   | b!!(ind (a!!1) (a!!2)) == ""
                                   =  solve m n xs (ins (ind (a!!1) (a!!2)) (a!!3) b)
                   | otherwise     =  case elemIndex "" b of
                                      Just c -> solve m n xs (ins c (a!!3) b)
                                      Nothing ->"#"
                                    where
                                      l = length b
                                      ind a b = (toInt a -1)*n + (toInt b-1)
solve _ _ [] _ = ""

import Prelude
import List
import Char

main = fileInteract q "input.txt" "output.txt"

q = func.map words.lines

func::[[String]]->String
func (a:xs) = solve'$solve m n xs (take (m*n)$repeat "")
              where
                b = map toInt a
                m = b!!0
                n = b!!1
func _      = ""

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve' a = case elem '#' a of
             True -> ""
             False->a

ins a b c = (take a c) ++ [b] ++ (drop (a+1) c)

solve m n (a:xs) b | a!!0 == "-1"  = case elemIndex (a!!1) (reverse b) of
                                       Just c -> (toString ((l-c-1)`div`n+1))++" "++
                                                 (toString ((l-c-1)`mod`n+1))++"\n"++
                                                 solve m n xs (ins (l-c-1) "" b)
                                       Nothing ->"-1 -1\n"++
                                                 solve m n xs b
                   | a!!3 `elem` b = "#"
                   | b!!ind == ""  =  solve m n xs (ins ind (a!!3) b)
                   | otherwise     =  case elemIndex "" (drop ind b) of
                                        Just c -> solve m n xs (ins c (a!!3) b)
                                        Nothing ->solve m n xs b
                                    where
                                      l = length b
                                      ind = (toInt (a!!1) -1)*n + (toInt (a!!2)-1)
solve _ _ [] _ = ""


You are given a non-decreasing array of non-negative integers $$$a_1, a_2, \ldots, a_n$$$. Also you are given a positive integer $$$k$$$.You want to find $$$m$$$ non-decreasing arrays of non-negative integers $$$b_1, b_2, \ldots, b_m$$$, such that:  The size of $$$b_i$$$ is equal to $$$n$$$ for all $$$1 \leq i \leq m$$$.  For all $$$1 \leq j \leq n$$$, $$$a_j = b_{1, j} + b_{2, j} + \ldots + b_{m, j}$$$. In the other word, array $$$a$$$ is the sum of arrays $$$b_i$$$.  The number of different elements in the array $$$b_i$$$ is at most $$$k$$$ for all $$$1 \leq i \leq m$$$. Find the minimum possible value of $$$m$$$, or report that there is no possible $$$m$$$.

The first line contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$): the number of test cases. The first line of each test case contains two integers $$$n$$$, $$$k$$$ ($$$1 \leq n \leq 100$$$, $$$1 \leq k \leq n$$$). The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \leq a_1 \leq a_2 \leq \ldots \leq a_n \leq 100$$$, $$$a_n > 0$$$).

For each test case print a single integer: the minimum possible value of $$$m$$$. If there is no such $$$m$$$, print $$$-1$$$.

NoteIn the first test case, there is no possible $$$m$$$, because all elements of all arrays should be equal to $$$0$$$. But in this case, it is impossible to get $$$a_4 = 1$$$ as the sum of zeros.In the second test case, we can take $$$b_1 = [3, 3, 3]$$$. $$$1$$$ is the smallest possible value of $$$m$$$.In the third test case, we can take $$$b_1 = [0, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2]$$$ and $$$b_2 = [0, 0, 1, 1, 1, 1, 1, 2, 2, 2, 2]$$$. It's easy to see, that $$$a_i = b_{1, i} + b_{2, i}$$$ for all $$$i$$$ and the number of different elements in $$$b_1$$$ and in $$$b_2$$$ is equal to $$$3$$$ (so it is at most $$$3$$$). It can be proven that $$$2$$$ is the smallest possible value of $$$m$$$.

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve k as

solve :: Integer -> [Integer] -> Integer
solve 1 as
  | all (== head as) as = 1
  | otherwise = -1
solve k as = max 1 $ (fromIntegral (length $ filter (/= 0) $ zipWith (-) (tail as) as) - 1) `div` (k - 1) + 1

import Control.Monad
import Data.List

solve :: Int -> [Int] -> Int
solve k li = let
  tar = length . map head . group $ li
  in  if  tar == 1
  then  1
  else  if  k == 1
  then  -1
  else  div (tar - 1 + k - 2) (k - 1)

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

import Control.Monad (forM_)
import Data.Set (fromList, size)

solve :: Int -> [Int] -> Int
solve k as = if s < 1 then 1 else rez
  where s = fromIntegral . subtract k . size $ fromList as
        k' = fromIntegral $ k - 1
        rez = if k' < 1 then -1 else 1 + (ceiling $ s / k')

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] $ \_ -> do
    [n, k] <- pure . map read . words =<< getLine
    getLine >>= pure . map read . words >>= putStrLn . show . solve k

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve k as

solve :: Integer -> [Integer] -> Integer
solve 1 as
  | all (== head as) as = 1
  | otherwise = -1
solve k as = max 1 $ (fromIntegral (length $ filter (/= 0) $ zipWith (-) (tail as) as) - 1) `div` k + 1

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad

main :: IO ()
main = getLine >>= flip replicateM_ test . read

test :: IO ()
test = do
  [_, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  print $ solve k as

solve :: Integer -> [Integer] -> Integer
solve 1 as
  | all (== head as) as = 1
  | otherwise = -1
solve k as = (fromIntegral (length $ filter (/= 0) $ zipWith (-) (tail as) as) - 1) `div` k + 1

import Control.Monad (forM_)
import Data.Set (fromList, size)

solve :: Int -> [Int] -> Int
solve k as = if k == 1 && s > 1 then -1 else ceiling $ s / (fromIntegral k)
  where s = fromIntegral . size $ fromList as

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] $ \_ -> do
         [n, k] <- pure . map read . words =<< getLine
         getLine >>= pure . map read . words >>= putStrLn . show . solve k

import Control.Monad (forM_)
import Data.Set (fromList, size)

solve :: Int -> [Int] -> Int
solve k as = if s > 0 && k == 1 then -1 else 1 + (ceiling $ s / k')
  where s = fromIntegral . subtract k . size $ fromList as
        k' = fromIntegral $ k - 1

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] $ \_ -> do
    [n, k] <- pure . map read . words =<< getLine
    getLine >>= pure . map read . words >>= putStrLn . show . solve k

import Control.Monad (forM_)
import Data.Set (fromList, size)

solve :: Int -> [Int] -> Int
solve k as = if s > 0 && k == 1 then -1 else 1 + (ceiling (s / k'))
  where s = fromIntegral . subtract k . size $ fromList as
        k' = fromIntegral $ k - 1

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] $ \_ -> do
    [n, k] <- pure . map read . words =<< getLine
    getLine >>= pure . map read . words >>= putStrLn . show . solve k


As Famil Door’s birthday is coming, some of his friends (like Gabi) decided to buy a present for him. His friends are going to buy a string consisted of round brackets since Famil Door loves string of brackets of length n more than any other strings!The sequence of round brackets is called valid if and only if:   the total number of opening brackets is equal to the total number of closing brackets;  for any prefix of the sequence, the number of opening brackets is greater or equal than the number of closing brackets. Gabi bought a string s of length m (m ≤ n) and want to complete it to obtain a valid sequence of brackets of length n. He is going to pick some strings p and q consisting of round brackets and merge them in a string p + s + q, that is add the string p at the beginning of the string s and string q at the end of the string s.Now he wonders, how many pairs of strings p and q exists, such that the string p + s + q is a valid sequence of round brackets. As this number may be pretty large, he wants to calculate it modulo 109 + 7.

First line contains n and m (1 ≤ m ≤ n ≤ 100 000, n - m ≤ 2000) — the desired length of the string and the length of the string bought by Gabi, respectively. The second line contains string s of length m consisting of characters '(' and ')' only.

Print the number of pairs of string p and q such that p + s + q is a valid sequence of round brackets modulo 109 + 7.

NoteIn the first sample there are four different valid pairs:   p = "(", q = "))"  p = "()", q = ")"  p = "", q = "())"  p = "", q = ")()" In the second sample the only way to obtain a desired string is choose empty p and q.In the third sample there is no way to get a valid sequence of brackets.

import           Data.Array
import           Data.Int
import           Data.List
import           Control.Monad

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ if mod n' 2 == 0 then solve n' s else 0

solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        n'' = n - min l r
        mm  = 10 ^ 9 + 7 :: Int64
        arr = array ((0, 0), (n'', n''))
                    [ ((i, j), f i j) | i <- [0 .. n''], j <- [0 .. n''] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal = minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. x + l - r]
          , x + minVal >= y
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = (length s) - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | i == n && j == n
            = 1
            | j > i
            = 0
            | otherwise
            = let right = if i + 1 <= n then arr ! (i + 1, j) else 0
                  up    = if j + 1 <= n then arr ! (i, j + 1) else 0
              in  (right + up) `mod` mm
    -- mapM_ print . groupBy ((==) `on` fst . fst) . assocs $ arr
    print
        . (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Control.Monad

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ if mod n' 2 == 0 then solve n' s else 0

solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Int32
        arr = array ((0, 0), (n, n)) [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal = minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. x + l - r]
          , x + minVal >= y
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function
import           Control.Monad

main :: IO ()
-- main = mapM_ print . take 1 . filter (\(_, _, x, y) -> x /= y) $ liftM2
--     (\x y -> (x, y, solve x y, solve' x y))
--     [2, 4 .. 10]
--     (concatMap (\n -> mapM (const "()") [0 .. n]) [0 .. 7])
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ solve n' s

solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal =
            minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [-minVal .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

solve' n s =
    (`mod` (10 ^ 9 + 7))
        . fromIntegral
        . sum
        . map cnt
        . filter (s `isInfixOf`)
        . filter valid
        $ mapM (const "()") [0 .. n - 1]
  where
    valid = go 0
    go k [] = k == 0
    go k (x : xs) | x == '(' = go (k + 1) xs
                  | x == ')' = (k > 0) && go (k - 1) xs
    cnt [] = 0
    cnt x'@(_ : xs)
        | length x' < length s = 0
        | otherwise = (if and (zipWith (==) x' s) then 1 else 0) + cnt xs

import           Data.Array
import           Data.Int

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways x y =
            (arr ! (x + y, x)) * fromIntegral (x + 1 - y) `div` fromIntegral
                (x + 1)
        f :: Int -> Int -> Int64
        f i j
            | j == 0    = 1
            | j > i     = 0
            | otherwise = fromIntegral $ arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  mod (leftWays * rightWays) (10 ^ 9 + 7)
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
    print
        . (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Control.Monad

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ if mod n' 2 == 0 then solve n' s else 0

solve :: Int -> String -> Int
solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Int
        arr = array ((0, 0), (n, n)) [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal = minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. x + l - r]
          , x + minVal >= y
          ]

import           Data.Array

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways x y = (arr ! (x + y, x)) * (x + 1 - y) `div` (x + 1)
        f i j | j == 0    = 1
              | j > i     = 0
              | otherwise = arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . (`mod` (10 ^ 9 + 7))
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  leftWays * rightWays
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function
import           Control.Monad

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

solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Int64
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal =
            minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [0 .. n - l]
          , y <- [0 .. x + l - r]
          , x + minVal >= y
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function
import           Control.Monad

main :: IO ()
-- main = mapM_ print . take 1 . filter (\(_, _, x, y) -> x /= y) $ liftM2
--     (\x y -> (x, y, solve x y, solve' x y))
--     [2, 4 .. 10]
--     (concatMap (\n -> mapM (const "()") [0 .. n]) [0 .. 7])
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ solve n' s

solve n' s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal =
            minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [max 0 (-minVal) .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

solve' n s =
    (`mod` (10 ^ 9 + 7))
        . fromIntegral
        . sum
        . map cnt
        . filter (s `isInfixOf`)
        . filter valid
        $ mapM (const "()") [0 .. n - 1]
  where
    valid = go 0
    go k [] = k == 0
    go k (x : xs) | x == '(' = go (k + 1) xs
                  | x == ')' = (k > 0) && go (k - 1) xs
    cnt [] = 0
    cnt x'@(_ : xs)
        | length x' < length s = 0
        | otherwise = (if and (zipWith (==) x' s) then 1 else 0) + cnt xs

import           Data.Array
import           Data.Int

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n  = n' `div` 2
        l  = length $ filter (== '(') s
        r  = length s - l
        mm = 10 ^ 9 + 7 :: Int64
        arr :: Array (Int, Int) Int64
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways :: Int -> Int -> Int64
        ways x y =
            (arr ! (x + y, x))
                *     (fromIntegral $ x + 1 - y)
                `div` (fromIntegral $ x + 1)
        f i j | j == 0    = 1
              | j > i     = 0
              | otherwise = arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . (`mod` mm)
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = (length s) - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array ((0, 0), (n, n))
                    [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
    -- mapM_ print . groupBy ((==) `on` fst . fst) . assocs $ arr
    print
        . (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays)
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways x y = (arr ! (x + y, x)) * (x + 1 - y) `div` (x + 1)
        f i j | j == 0    = 1
              | j > i     = 0
              | otherwise = arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  leftWays * rightWays
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7 :: Integer
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways x y =
            (arr ! (x + y, x)) * fromIntegral (x + 1 - y) `div` fromIntegral
                (x + 1)
        f i j | j == 0    = 1
              | j > i     = 0
              | otherwise = arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . (`mod` mm)
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]

import           Data.Array
import           Data.Int
import           Data.List
import           Data.Function
import           Control.Monad

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    print $ if mod n' 2 == 0 then solve n' m s else 0

solve :: Int -> Int -> String -> Int
solve n' m s =
    let
        n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        mm  = 10 ^ 9 + 7
        arr = array ((0, 0), (n, n)) [ ((i, j), f i j) | i <- [0 .. n], j <- [0 .. n] ]
        f i j
            | j == 0
            = 1
            | j > i
            = 0
            | otherwise
            = let left = if i > 0 then arr ! (i - 1, j) else 0
                  down = if j > 0 then arr ! (i, j - 1) else 0
              in  (left + down) `mod` mm
        minVal = minimum $ scanl (\v c -> if c == '(' then v + 1 else v - 1) 0 s
    in
        (`mod` mm)
        . sum
        $ [ let leftWays  = arr ! (x, y)
                rightWays = arr ! (n - y - r, n - x - l)
            in  (leftWays * rightWays) `mod` mm
          | x <- [0 .. n - l]
          , y <- [0 .. x + l - r]
          , x + minVal >= y
          ]

import           Data.Array

main :: IO ()
main = do
    [n', m] <- map read . words <$> getLine
    s       <- getLine
    let n   = n' `div` 2
        l   = length $ filter (== '(') s
        r   = length s - l
        arr = array
            ((0, 0), (2 * n, 2 * n))
            [ ((i, j), f i j) | i <- [0 .. 2 * n], j <- [0 .. 2 * n] ]
        ways x y = (arr ! (x + y, x)) * (x + 1 - y) `div` (x + 1)
        f i j | j == 0    = 1
              | j > i     = 0
              | otherwise = arr ! (i - 1, j - 1) + arr ! (i - 1, j)
    print
        . sum
        $ [ let leftWays  = ways x y
                rightWays = ways (n - y - r) (n - x - l)
            in  mod (leftWays * rightWays) (10 ^ 9 + 7)
          | x <- [0 .. n - l]
          , y <- [0 .. min x (x + l - r)]
          ]


Petya works as a PR manager for a successful Berland company BerSoft. He needs to prepare a presentation on the company income growth since 2001 (the year of its founding) till now. Petya knows that in 2001 the company income amounted to a1 billion bourles, in 2002 — to a2 billion, ..., and in the current (2000 + n)-th year — an billion bourles. On the base of the information Petya decided to show in his presentation the linear progress history which is in his opinion perfect. According to a graph Petya has already made, in the first year BerSoft company income must amount to 1 billion bourles, in the second year — 2 billion bourles etc., each following year the income increases by 1 billion bourles. Unfortunately, the real numbers are different from the perfect ones. Among the numbers ai can even occur negative ones that are a sign of the company’s losses in some years. That is why Petya wants to ignore some data, in other words, cross some numbers ai from the sequence and leave only some subsequence that has perfect growth.Thus Petya has to choose a sequence of years y1, y2, ..., yk,so that in the year y1 the company income amounted to 1 billion bourles, in the year y2 — 2 billion bourles etc., in accordance with the perfect growth dynamics. Help him to choose the longest such sequence.

The first line contains an integer n (1 ≤ n ≤ 100). The next line contains n integers ai ( - 100 ≤ ai ≤ 100). The number ai determines the income of BerSoft company in the (2000 + i)-th year. The numbers in the line are separated by spaces.

Output k — the maximum possible length of a perfect sequence. In the next line output the sequence of years y1, y2, ..., yk. Separate the numbers by spaces. If the answer is not unique, output any. If no solution exist, output one number 0.

main = interact solve

solve s = unlines [show $ length g, unwords g]
  where
    g = map show $ map snd $ reverse $ init r
    r = foldl (\xs (k,y)->if k==1+(fst $ head xs) then (k,y):xs else xs) [(0,0)] $ zip (map (\s -> read s :: Int) $ words $ last $ lines s) [2001..]

solve :: [Int] -> [Int]
solve as  =  solve' 1 (zip as [2001..])
  where
    solve' _ []  =  []
    solve' k ((x,y):xs)
      | k == x  =  y : solve' (k+1) xs
      | otherwise  =  solve' k xs

prints :: Show a => [a] -> IO ()
prints xs  =  print (length xs) >> prints' xs
  where
    prints' []  =  return ()
    prints' [x]  =  print x
    prints' (x:xs)  =  putStr (show x ++ " ") >> prints' xs

main :: IO ()
main  =  do
    getLine
    as  <-  fmap (map read . words) getLine
    prints $ solve as

import Data.List
solve a n = case findIndex (==n) a of
  Just i -> i:(map (+(i+1)) $ solve (drop (i+1) a) (n+1))
  Nothing -> []

main = do
  n <- fmap read getLine
  a <- fmap (map read . take n . words) getLine
  let res = solve a 1
  print (length res)
  putStrLn . unwords . map (show . (+2001)) $ res


Let $$$n$$$ be an integer. Consider all permutations on integers $$$1$$$ to $$$n$$$ in lexicographic order, and concatenate them into one big sequence $$$p$$$. For example, if $$$n = 3$$$, then $$$p = [1, 2, 3, 1, 3, 2, 2, 1, 3, 2, 3, 1, 3, 1, 2, 3, 2, 1]$$$. The length of this sequence will be $$$n \cdot n!$$$.Let $$$1 \leq i \leq j \leq n \cdot n!$$$ be a pair of indices. We call the sequence $$$(p_i, p_{i+1}, \dots, p_{j-1}, p_j)$$$ a subarray of $$$p$$$. Its length is defined as the number of its elements, i.e., $$$j - i + 1$$$. Its sum is the sum of all its elements, i.e., $$$\sum_{k=i}^j p_k$$$. You are given $$$n$$$. Find the number of subarrays of $$$p$$$ of length $$$n$$$ having sum $$$\frac{n(n+1)}{2}$$$. Since this number may be large, output it modulo $$$998244353$$$ (a prime number).

The only line contains one integer $$$n$$$ ($$$1 \leq n \leq 10^6$$$), as described in the problem statement.

Output a single integer — the number of subarrays of length $$$n$$$ having sum $$$\frac{n(n+1)}{2}$$$, modulo $$$998244353$$$.

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

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

main :: IO ()
main =
  do letters <- read <$> getLine :: IO Word32
     print $ query letters

query :: Word32 -> Word32
query letters = fromMon $ go 1 rep1 0 1
  where
    rep1 = monRep 1
    go :: Word32 -> Montgomery -> Montgomery -> Montgomery -> Montgomery
    go !k !kRep !acc !fact
      | k > letters = acc + fact
      | otherwise = go (k+1) (kRep + rep1)
                       ((acc+fact-rep1) * kRep) (fact * kRep)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y)
  | xpy >= n  = Mon $ xpy - n
  | otherwise = Mon $ xpy
  where
    xpy = x+y

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = fromIntegral $ if t >= n then t - n else t
  where t = (x + ((x*nprime) .&. mask32) * n) `shiftR` 32

{-# INLINE mask32 #-}
mask32 :: Word64
mask32 = bit 32 - 1

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

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

main :: IO ()
main =
  do letters <- read <$> getLine :: IO Word32
     print $ query letters

query :: Word32 -> Word32
query letters = fromMon $ go 1 0 1
  where
    go :: Word32 -> Montgomery -> Montgomery -> Montgomery
    go !k !acc !fact
      | k > letters = acc + fact
      | otherwise = go (k+1) ((acc+fact-1) * kRep) newFact
      where
        kRep = monRep k
        newFact = kRep * fact

n :: (Integral i) => i
n = 998244353

nprime :: Word64
nprime = 998244351

rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  (+) = monAdd
  (*) = monMult
  negate (Mon x) = Mon (n - x)
  fromInteger = monRep . fromInteger
  signum x | x == Mon 0 = Mon 0
           | otherwise  = 1
  abs = id

monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y)
  | xpy >= n  = Mon $ xpy - n
  | otherwise = Mon $ xpy
  where
    xpy = x+y

monRep :: Word32 -> Montgomery
monRep = Mon . monRed . (rsq*) . fromIntegral

fromMon :: Montgomery -> Word32
fromMon = monRed . fromIntegral . unMon

monRed :: Word64 -> Word32
monRed x = fromIntegral $ if t >= n then t - n else t
  where t = (x + ((x*nprime) .&. mask32) * n) `shiftR` 32

mask32 :: Word64
mask32 = bit 32 - 1

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

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

main :: IO ()
main =
  do letters <- read <$> getLine :: IO Word32
     print $ query letters

query :: Word32 -> Word32
query letters = fromMon $ go 1 rep1 0 1
  where
    rep1 = monRep 1
    go :: Word32 -> Montgomery -> Montgomery -> Montgomery -> Montgomery
    go !k !kRep !acc !fact
      | k > letters = acc + fact
      | otherwise = go (k+1) (kRep + rep1)
                       ((acc+fact-rep1) * kRep) (fact * kRep)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y - if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (x + ((x*nprime) .&. mask32) * n) `shiftR` 32

{-# INLINE mask32 #-}
mask32 :: Word64
mask32 = bit 32 - 1

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

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

main :: IO ()
main =
  do letters <- read <$> getLine :: IO Word64
     print $ query letters

query :: Word64 -> Word64
query letters = go 1 0 1
  where
    go :: Word64 -> Word64 -> Word64 -> Word64
    go !k !acc !fact
      | k > letters = if acc + fact >= n then acc + fact - n else acc + fact
      | otherwise = go (k+1)
                       (mod ((acc+fact-1) * k) n)
                       (mod (fact * k) n)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

import Data.Int
import Data.Ratio
import Data.Ix

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

data ModInt = ModInt Int64 deriving (Eq, Ord, Read)

modulo = 998244353 :: Int64
toModInt n = ModInt (n `mod` modulo)
emi = error "ModInt"
unaryOp f (ModInt x) = ModInt (f x)
binaryOp f (ModInt x) (ModInt y) = ModInt (f x y)
binaryOp' f (ModInt x) (ModInt y) = toModInt (f x y)

instance Bounded ModInt where
    maxBound = ModInt modulo
    minBound = ModInt (-modulo)
instance Enum ModInt where
    succ x
        | x /= maxBound = x + 1
        | otherwise = emi
    pred x
        | x /= minBound = x - 1
        | otherwise = emi
    toEnum i = toModInt (fromIntegral i)
    fromEnum (ModInt x) = (fromIntegral x)
instance Integral ModInt where
    quot = binaryOp quot
    rem = binaryOp rem
    div = binaryOp div
    mod = binaryOp mod
    quotRem (ModInt x) (ModInt y) = let  (q, r) = x `quotRem` y in (ModInt q, ModInt r)
    divMod (ModInt x) (ModInt y) = let  (d, m) = x `divMod` y in (ModInt d, ModInt m)
    toInteger (ModInt x) = toInteger x
instance Num ModInt where
    (+) = binaryOp' (+)
    (-) = binaryOp' (-)
    (*) = binaryOp' (*)
    negate = unaryOp negate
    abs = unaryOp abs
    signum = unaryOp signum
    fromInteger i = toModInt (fromInteger i)
instance Real ModInt where
    toRational (ModInt x) = toInteger x % 1
instance Show ModInt where
    show (ModInt x) = show x
instance Ix ModInt where
    range (ModInt m, ModInt n) = map ModInt [m..n]
    index (ModInt m, _) (ModInt i) = fromIntegral i - fromIntegral m
    inRange (ModInt m, ModInt n) (ModInt i) = m <= i && i <= n

---- Answer Code Section ----

process :: Int -> Int
process (fromIntegral -> n :: ModInt) = if n == 1 then 1 else fromIntegral answer where
    facScans = scanl (*) n [ n-1, n-2 .. ]     -- f(n) = [n, n(n-1), n(n-1)(n-2)..]
    foldFn s (k, fn, fn1) = s + k * (fn - fn1) -- S(n+1) = S(n) + k(f(n) - f(n-1))
    answer = foldl' foldFn 0 $ zip3 [1..n-1] facScans (0 : facScans)

main = do
    n <- getInt
    print $ process n

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Integer] -> IO ()
printInts = putStrLn . intercalate " " . map show

m :: Integer
m = 998244353

facto :: Integer -> Integer
facto n = foldl (\acc x -> (acc * x) `mod` m) 1 [1..n]

rfacto :: Integer -> [Integer]
rfacto n = scanl (\acc x -> (acc * x) `mod` m) n [n-1,n-2..1]

solve n = (f * (n-1) `mod` m + m - msum) `mod` m
    where f = facto n
          r = rfacto n
          msum = foldl (\acc x -> (acc + x) `mod` m) 0 $ take (fromIntegral $ n-2) r

main = do
    [n] <- getIntegers
    if n == 1
    then print 1
    else print $ solve n

solve n = m $ (n+1) * last p - sum p
  where m = (`mod` 998244353)
        p = scanl1 ((.) m . (*)) [n, n-1..1]
main = interact $ show . solve . read

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

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

main :: IO ()
main =
  do letters <- read <$> getLine :: IO Word64
     print $ query letters

query :: Word64 -> Word64
query letters = go 1 0 1
  where
    go :: Word64 -> Word64 -> Word64 -> Word64
    go !k !acc !fact
      | k > letters = acc + fact
      | otherwise = go (k+1)
                       (mod ((acc+fact-1) * k) n)
                       (mod (fact * k) n)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

import Data.Int
import Data.Ratio
import Data.Ix

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

data ModInt = ModInt Int64 deriving (Eq, Ord, Read)

modulo = 998244353 :: Int64
toModInt n = ModInt (n `rem` modulo)
emi = error "ModInt"
unaryOp f (ModInt x) = ModInt (f x)
binaryOp f (ModInt x) (ModInt y) = ModInt (f x y)
binaryOp' f (ModInt x) (ModInt y) = toModInt (f x y)

instance Bounded ModInt where
    maxBound = ModInt modulo
    minBound = ModInt (-modulo)
instance Enum ModInt where
    succ x
        | x /= maxBound = x + 1
        | otherwise = emi
    pred x
        | x /= minBound = x - 1
        | otherwise = emi
    toEnum i = toModInt (fromIntegral i)
    fromEnum (ModInt x) = (fromIntegral x)
instance Integral ModInt where
    quot = binaryOp quot
    rem = binaryOp rem
    div = binaryOp div
    mod = binaryOp mod
    quotRem (ModInt x) (ModInt y) = let  (q, r) = x `quotRem` y in (ModInt q, ModInt r)
    divMod (ModInt x) (ModInt y) = let  (d, m) = x `divMod` y in (ModInt d, ModInt m)
    toInteger (ModInt x) = toInteger x
instance Num ModInt where
    (+) = binaryOp' (+)
    (-) = binaryOp' (-)
    (*) = binaryOp' (*)
    negate = unaryOp negate
    abs = unaryOp abs
    signum = unaryOp signum
    fromInteger i = toModInt (fromInteger i)
instance Real ModInt where
    toRational (ModInt x) = toInteger x % 1
instance Show ModInt where
    show (ModInt x) = show x
instance Ix ModInt where
    range (ModInt m, ModInt n) = map ModInt [m..n]
    index (ModInt m, _) (ModInt i) = fromIntegral i - fromIntegral m
    inRange (ModInt m, ModInt n) (ModInt i) = m <= i && i <= n

---- Answer Code Section ----

process :: Int -> Int
process (fromIntegral -> n :: ModInt) = if n == 1 then 1 else fromIntegral answer where
    facScans = scanl (*) n [ n-1, n-2 .. ]     -- f(n) = [n, n(n-1), n(n-1)(n-2)..]
    foldFn s (k, fn, fn1) = s + k * (fn - fn1) -- S(n+1) = S(n) + k(f(n) - f(n-1))
    answer = foldl foldFn 0 $ zip3 [1..n-1] facScans (0 : facScans)

main = do
    n <- getInt
    print $ process n