{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM_)
import Data.List (elemIndices)

main :: IO ()
main = do
  n <- readLn

  replicateM_ n $ do
    amount <- readLn
    str <- getLine
    print $ func amount str & unlines

func :: Int -> String -> [String]
func len str =
  if  | twoIndList & length == 0 || twoIndList & length > 2 -> "YES" : finalArr
      | 6<9 -> ["NO"]
  where
    indStr = [0..] `zip` str

    twoIndList =
      [0..] `zip` ('2' `elemIndices` str)

    [firstTwoInd, lastTwoInd] = [twoIndList & head, twoIndList & last] >>& snd

    finalArr =
      [[getItem a b | b <- indStr] | a <- indStr]

    getItem (ind, a) (jnd, b) =
      if  | ind == jnd -> 'X'
          | a == '1' || b == '1' -> '='
          | ind == lastTwoInd && jnd == firstTwoInd -> '-'
          | ind == firstTwoInd && jnd == lastTwoInd || ind > jnd -> '+'
          | 6<9 -> '-'

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    ~[s] <- getNext 1
    let
      greedy = [i | (i, si) <- zip [1..] $ P.unpack s, si == '2']
      wins = zip greedy $ tail $ cycle greedy
      ansArr :: UArray (Int, Int) Char
      ansArr = accumArray (\_ v -> v) '=' ((1, 1), (n, n))
        $ [((i, i), 'X') | i <- [1 .. n]] ++ do
        (i, j) <- wins
        [((i, j), '+'), ((j, i), '-')]
    pure $ if  length greedy `elem` [1, 2]
      then  string7 "NO\n"
      else  mconcat $ string7 "YES\n" : do
        i <- [1..n]
        pure $ string7 [ansArr ! (i, j) | j <- [1..n]] <> char7 '\n'

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int str

-- output :: Output -> C.ByteString
output Nothing = C.pack "NO"
output (Just s) = C.pack . unlines $ "YES" : s

-- solve :: Input -> Output
solve (n, s) = do
  guard $ length type2 /= 1
  guard $ length type2 /= 2
  return
    [ [ compute i j | j <- [1 .. n]
      ]
      | i <- [1 .. n]
    ]
  where
    type2 = [i | (c, i) <- zip s [1 .. n], c == '2']
    wins = case type2 of
      [] -> []
      (i : is) -> zip type2 (is ++ [i])

    compute i j
      | i == j = 'X'
      | (i, j) `elem` wins = '+'
      | (j, i) `elem` wins = '-'
      | otherwise = '='

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

-- ID  : 1569B (B. Chess Tournament)
-- URL : https://codeforces.com/contest/1569/problem/B

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

readInt = read `fmap` getLine :: IO Int

main = readInt >>= \t -> replicateM_ t solve

-- For those who don't wanna lose any game, assign draw for their every matches.
-- For those who wanna win at lesat one game, they can form a cycle
--   s.t. each former wins against its latter (must be n >= 3)
solve = do
    n <- readInt
    desires <- zip [1..n] `fmap` getLine
    let (winners,noLosers) = partition (\(i,x) -> x == '2') desires
    let winCycle = zip xs (tail xs ++ [head xs]) where xs = map fst winners
    let drawCycle = map (\(i,x) -> (i,0)) noLosers
    let strat = array (1,n) (winCycle ++ drawCycle)
    let numWinners = length winners
    let numNoLosers = n - numWinners
    if numWinners == 1 || numWinners == 2 then putStrLn "NO"
    else do
        --print strat
        let m = array ((1,1),(n,n)) [((i,j),f (strat ! i) i j) | i <- [1..n], j <- [1..n]] where
            f strat i j
                | i == j      = 'X'
                | strat == 0  = '='
                | strat == i  = '-'
                | strat == j  = '+'
                | otherwise   = '='
        let m2 = array ((1,1),(n,n)) [((i,j),f i j (m ! (i,j))) | i <- [1..n], j <- [1..n]] where
            f i j x
                | x /= '='  = x
                | otherwise = invert (m ! (j,i))
            invert x
                | x == '-'  = '+'
                | x == '+'  = '-'
                | otherwise = x
        putStrLn "YES"
        forM_ [1..n] $ \i -> do
            forM_ [1..n] $ \j -> do
                putChar (m2 ! (i,j))
            putChar '\n'

{-# LANGUAGE LambdaCase #-}

import Control.Monad
import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.List (intercalate)
import Data.Map (Map)
import qualified Data.Map as M
import Data.STRef

data PlayerType = NoLoss | WinOne deriving (Show, Eq)

data Solution = Solution
  { winCycle :: [Int],
    numPlayers :: Int
  }
  deriving (Eq)

data MatchResult = Lose | Win | Draw | Invalid deriving (Eq, Enum)

instance Show MatchResult where
  show Invalid = "X"
  show Lose = "-"
  show Win = "+"
  show Draw = "="

instance Show Solution where
  show (Solution w n) = str
    where
      pairs arr = zip arr $ tail arr
      arr = runSTArray $ do
        arr <- newArray ((1, 1), (n, n)) Draw
        -- fill in diagonals
        forM_ [1 .. n] $ \i -> do
          writeArray arr (i, i) Invalid
        -- fill in win cycle
        unless (null w) $
          forM_ (pairs $ w ++ [head w]) $ \(i, j) -> do
            writeArray arr (i, j) Win
            writeArray arr (j, i) Lose
        return arr
      str =
        intercalate
          "\n"
          [ concat
              [ show $ arr ! (y, x)
                | x <- [1 .. n]
              ]
            | y <- [1 .. n]
          ]

solution :: [PlayerType] -> Maybe Solution
solution players =
  if length winonePlayers > 2 || null winonePlayers
    then
      Just
        Solution
          { winCycle = fst <$> winonePlayers,
            numPlayers = length players
          }
    else Nothing
  where
    winonePlayers = filter ((== WinOne) . snd) $ zip [1 ..] players

main :: IO ()
main = do
  t <- read <$> getLine
  forM_ [1 .. t] $ \_ -> do
    getLine
    str <- getLine
    let players =
          ( \case
              '1' -> NoLoss
              '2' -> WinOne
              _ -> error "undefined"
          )
            <$> str
    case solution players of
      Just x -> do
        putStrLn "YES"
        print x
      Nothing -> putStrLn "NO"

import Control.Monad

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    s <- zip [1 :: Int ..] <$> getLine
    let xs = filter ((=='2') . snd) s
        [f, l] = map fst [head xs, last xs]
        get (i, x) (j, y)
            | i == j               = 'X'
            | x == '1' || y == '1' = '='
            | i == f && j == l     = '+'
            | i == l && j == f     = '-'
            | i > j                = '+'
            | otherwise            = '-'
        res = [get x y | x <- s, y <- s]
    putStr $ if null xs || length xs > 2
        then "YES\n" ++ unlines (chunksOf n res)
        else "NO\n"

chunksOf :: Int -> [a] -> [[a]]
chunksOf n = go where
    go [] = []
    go xs = xs' : go xs'' where (xs', xs'') = splitAt n xs

main :: IO ()
main = readLn >>= flip replicateM_ solve

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM_)
import Data.List (elemIndices)

main :: IO ()
main = do
  n <- readLn

  replicateM_ n $ do
    amount <- readLn
    str <- getLine
    print $ func amount str & unlines

func :: Int -> String -> [String]
func len str =
  if  | twoIndList & length == 0 || twoIndList & length > 2 -> "YES" : finalArr
      | 6<9 -> ["NO"]
  where
    indStr = [0..] `zip` str

    twoIndList =
      '2' `elemIndices` str

    [firstTwoInd, lastTwoInd] = [twoIndList & head, twoIndList & last]

    finalArr =
      [[getItem a b | b <- indStr] | a <- indStr]

    getItem (ind, a) (jnd, b) =
      if  | ind == jnd -> 'X'
          | a == '1' || b == '1' -> '='
          | ind == lastTwoInd && jnd == firstTwoInd -> '-'
          | ind == firstTwoInd && jnd == lastTwoInd || ind > jnd -> '+'
          | 6<9 -> '-'

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort, elemIndices, elemIndex)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    amount <- readLn
    str <- getLine
    return (amount, str)

  say $ arr >>& func & concat & unlines

func :: (Int, String) -> [String]
func (len, str) =
  -- finalArr
  if  | expectation -> "YES" : finalArr
      | 6<9 -> ["NO"]
  where
    twoIndList =
      '2' `elemIndices` str

    finalArr =
      [
        [
          (if
            | i == j -> 'X'
            | item == '1' || (item == '2' && str !! j == '1') -> '='
            | twoIndList !! ((((i `elemIndex` twoIndList) & sum) + 1) `mod` (twoIndList & length)) == j -> '+'
            | 6<9 -> '-'
          ) | (j, jtem) <- [0..] `zip` str
        ]
        | (i, item) <- [0..] `zip` str
      ]

    expectation =
      (str `zip` finalArr) & all (
        \(char, item) ->
          (char == '1' && '-' `notElem` item) ||
          (char == '2' && '+' `elem` item)
      )

    symbolSum =
      finalArr & concat & foldl (\acc x -> if | x == '+' -> acc + 1 | x == '-' -> acc - 1 | 6<9 -> acc) 0

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort, elemIndices, elemIndex)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    amount <- readLn
    str <- getLine
    return (amount, str)

  say $ arr >>& func & concat & unlines

func :: (Int, String) -> [String]
func (len, str) =
  if  | expectation && symbolSum == 0 -> "YES" : finalArr
      | 6<9 -> ["NO"]
  where
    twoIndList =
      '2' `elemIndices` str

    finalArr =
      [
        [
          (if
            | i == j -> 'X'
            | item == '1' || (item == '2' && str !! j == '1') -> '='
            | twoIndList !! ((((i `elemIndex` twoIndList) & sum) + 1) `mod` (twoIndList & length)) == j -> '+'
            | 6<9 -> '-'
          ) | (j, jtem) <- [0..] `zip` str
        ]
        | (i, item) <- [0..] `zip` str
      ]

    expectation =
      (str `zip` finalArr) & all (
        \(char, item) ->
          (char == '1' && '-' `notElem` item) ||
          (char == '2' && '+' `elem` item)
      )

    symbolSum =
      finalArr & concat & foldl (\acc x -> if | x == '+' -> acc + 1 | x == '-' -> acc - 1 | 6<9 -> acc) 0

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort, elemIndex)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    getLine
    getLine >>= return

  say $ arr >>& func & concat & unlines

func :: String -> [String]
func str =
  if  | expectation -> "YES" : finalArr
      | 6<9 -> ["NO"]
  where
    len = str & length
    baseCase =
      [[final | (j, jtem) <- [0..] `zip` str, let final = if | i == j -> 'X' | 6<9 -> '='] | (i, item) <- [0..] `zip` str]

    twoIndList =
      ([0..] `zip` str) & filter (\(i, item) -> item == '2') >>. fst

    finalArr =
      [
        [
          (if
            | i == j -> 'X'
            | item == '1' || (item == '2' && str !! j == '1') -> '='
            | twoIndList !! ((((i `elemIndex` twoIndList) & sum) + 1) `mod` (twoIndList & length)) == j -> '+'
            | 6<9 -> '-'
          ) | (j, jtem) <- [0..] `zip` str
        ]
        | (i, item) <- [0..] `zip` str
      ]

    expectation =
      (str `zip` finalArr) & all (
        \(char, item) ->
          (char == '1' && '-' `notElem` item) ||
          (char == '2' && '+' `elem` item)
      )

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort, elemIndex)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    getLine
    getLine >>= return

  say $ arr & map func . concat . unlines

func :: String -> [String]
func str =
  if  | str & nub == "1" -> "YES" : baseCase
      | str == "22" || str & sort == "12" -> ["NO"]
      | 6<9 -> "YES" : regularCase
  where
    len = str & length
    baseCase =
      [[final | (j, jtem) <- [0..] `zip` str, let final = if | i == j -> 'X' | 6<9 -> '='] | (i, item) <- [0..] `zip` str]

    twoIndList =
      ([0..] `zip` str) & filter (\(i, item) -> item == '2') >>. fst

    regularCase =
      [
        [
          (if
            | i == j -> 'X'
            | item == '1' || (item == '2' && str !! j == '1') -> '='
            | twoIndList !! ((((i `elemIndex` twoIndList) & sum) + 1) `mod` (twoIndList & length)) == j -> '+'
            | 6<9 -> '-'
          ) | (j, jtem) <- [0..] `zip` str
        ]
        | (i, item) <- [0..] `zip` str
      ]

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    getLine
    getLine >>= return

  say $ arr & map func . concat . unlines

func :: String -> [String]
func str =
  if  | str & nub == "1" -> "YES" : baseCase
      | str == "22" || str & sort == "12" -> ["NO"]
      | 6<9 -> "YES" : regularCase
  where
    len = str & length
    baseCase =
      [[final | (j, jtem) <- [0..] `zip` str, let final = if | i == j -> 'X' | 6<9 -> '='] | (i, item) <- [0..] `zip` str]

    regularCase =
      [[(if | i == j -> 'X' | item == '1' || (item == '2' && str !! j == '1') -> '=' | (i + 1) `mod` len == j -> '+' | 6<9 -> '-') | (j, jtem) <- [0..] `zip` str] | (i, item) <- [0..] `zip` str]

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

{-#LANGUAGE TypeApplications,TupleSections,NegativeLiterals,MultiWayIf,PostfixOperators,LambdaCase,NumDecimals,FlexibleInstances,UndecidableInstances#-}

import Prelude hiding ((.), interact, print)
import Debug.Trace (traceShow)
import Control.Monad (replicateM)
import Data.List (nub, sort)

main :: IO ()
main = do
  n <- readLn

  arr <- replicateM n $ do
    getLine
    getLine >>= return

  say $ arr & map func . concat . unlines

func :: String -> [String]
func str =
  if  | str & nub == "1" -> "YES" : baseCase
      | str == "22" || str & sort == "12" -> ["NO"]
      | 6<9 -> "YES" : regularCase
  where
    len = str & length
    baseCase =
      [[final | (j, jtem) <- [0..] `zip` str, let final = if | i == j -> 'X' | 6<9 -> '='] | (i, item) <- [0..] `zip` str]

    regularCase =
      [[(if | i == j -> 'X' | (i + 1) `mod` len == j -> '+' | 6<9 -> '-') | (j, jtem) <- [0..] `zip` str] | (i, item) <- [0..] `zip` str]

-- don't read the stuff below

(.)a b x=b$a x
a>>.b=a.fmap b

infixl 8 &
a&b=b a

infixl 8 >>&
a>>&b=b<$>a

say x=putStrLn$x&toStr
print x=putStr$x&toStr
interact f=getContents>>=f.print

class ToStr a where toStr::a->String
instance{-#OVERLAPS#-}Show a=>ToStr a where toStr=show
instance{-#OVERLAPS#-}ToStr String where toStr=id

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    ~[s] <- getNext 1
    let
      greedy = [i | (i, si) <- zip [1..] $ P.unpack s, si == '2']
      wins = zip greedy $ tail $ cycle greedy
      ansArr :: UArray (Int, Int) Char
      ansArr = accumArray (\_ v -> v) '=' ((1, 1), (n, n))
        $ [((i, i), 'X') | i <- [1 .. n]] ++ do
        (i, j) <- wins
        [((i, j), '+'), ((j, i), '-')]
    pure $ case  greedy  of
      [_] -> string7 "NO\n"
      _ -> mconcat $ string7 "YES\n" : do
        i <- [1..n]
        pure $ string7 [ansArr ! (i, j) | j <- [1..n]] <> char7 '\n'

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int str

-- output :: Output -> C.ByteString
output Nothing = C.pack "No"
output (Just s) = C.pack . unlines $ "Yes" : s

-- solve :: Input -> Output
solve (n, s) = do
  guard $ length type2 /= 1
  return
    [ [ compute i j | j <- [1 .. n]
      ]
      | i <- [1 .. n]
    ]
  where
    type2 = [i | (c, i) <- zip s [1 .. n], c == '2']
    wins = case type2 of
      [] -> []
      (i : is) -> zip type2 (is ++ [i])

    compute i j
      | i == j = 'X'
      | (i, j) `elem` wins = '+'
      | (j, i) `elem` wins = '-'
      | otherwise = '='

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


module Main where

import Control.Monad
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Char

toIntList :: String -> [Int]
toIntList  = map (\x -> ord x - ord '0')

fromIntList :: [Int] -> String
fromIntList  = concatMap show

lastOccurence :: [a] -> (a -> Bool) -> Maybe Int
lastOccurence [] pred = Nothing
lastOccurence (x:xs) pred =
    case lastOccurence xs pred of
        Nothing -> if pred x then Just 0 else Nothing
        (Just x) -> Just (x + 1)

contr :: [Int] -> [Int]
contr [] = error "Bad news"
contr xss@(x:xs) =
    let sums = zipWith (+) xs xss in
        if any (>= 10) sums then
            let t = fromJust $ lastOccurence sums (>= 10) in
                take t xss ++ [sums !! t] ++ drop (t + 2) xss
        else
            case xs of
                (y:ys) -> (x + y) : ys
                [] -> error "Bad news"

main = do
    t <- fmap read getLine
    forM_ [1..t] $ \_ -> do
        str <- getLine
        putStrLn $ fromIntList $ contr $ toIntList str

-- |

-- module nil where
import Data.List
import Data.Char
import Control.Monad

main = do
  times <- fmap read getLine
  forM_ [1..times] $ \_ -> do
    input <- getLine
    putStrLn $ concatMap show $ replacePairs' $ map digitToInt input

-- Problem B
replacePairs inp =
  -- maximum $ map (\k -> shower (inserter inp k)) [1..(length inp - 1)]
  read (foldr comparing "0" $ map converter [(el-1),(el-2)..1]) :: Integer
  where converter k = shower $ inserter inp k
        shower xs = (foldr (++) "" $ map show xs)
        inserter a k = (let (front, back) = splitAt (k-1) a in front ++ [head back + head (drop 1 back)] ++ (drop 2 back))
        el = length inp
        intread x = (read x) :: Integer
        comparing temp acc = if (ltemp == el) then temp else
                                 show (max (intread acc) (intread temp))
          where ltemp = length temp

-- Taken from divanik's solution
replacePairs' inp@(x:xs) = let sums = zipWith (+) xs inp in
                             let t = lastOcc sums (>= 10) in
                                 if t >= 0 then
                                   take t inp ++ [sums !! t] ++ drop (t+2) inp
                                 else
                                   case xs of
                                     (y:ys) -> (x+y):ys
                                     [] -> [0]
  where
    lastOcc [] _ = -1
    lastOcc (x:xs) pred = (if pred x || later >= 0 then (1+) else id) $ later
      where later = lastOcc xs pred

-- Notes:
    -- Thought of zipWith, though didn't know of the function itself
    -- Didn't think of making a lazy list to access from (though didn't know of !!)
    -- Didn't think of using any and direct access to replace the foldr expression
    -- Thought of lastOcc (after checking tutorial for problem)
    -- Thought of insertion method (though didn't know of !!)
    -- Didn't think of the else/case section (if not >=10, maximize the greatest-order digit)
    -- Forgot to keep considering [Integer] after I switched to using the String representations
    -- Didn't think of using >=10 instead of direct length-checking
            -- May have been thought of via laziness? "As little dependency as possible" would likely entail minimizing checks to only where the diff was
    -- THE ABOVE IS LIKELY INSUFFICIENT TO DEVELOP THE SOLUTION, but I'm not sure what else I didn't think of

-- |

-- module nil where
import Data.List
import Data.Char
import Control.Monad

main = do
  times <- fmap read getLine
  forM_ [1..times] $ \_ -> do
    input <- getLine
    putStrLn $ concatMap show $ replacePairs' $ map digitToInt input

replacePairs inp =
  -- maximum $ map (\k -> shower (inserter inp k)) [1..(length inp - 1)]
  read (foldr comparing "0" $ map converter [(el-1),(el-2)..1]) :: Integer
  where converter k = shower $ inserter inp k
        shower xs = (foldr (++) "" $ map show xs)
        inserter a k = (let (front, back) = splitAt (k-1) a in front ++ [head back + head (drop 1 back)] ++ (drop 2 back))
        el = length inp
        intread x = (read x) :: Integer
        comparing temp acc = if (ltemp == el) then temp else
                                 show (max (intread acc) (intread temp))
          where ltemp = length temp

-- Taken from divanik's solution
replacePairs' inp@(x:xs) = let sums = zipWith (+) xs inp in
                             if any (>= 10) sums then
                               let t = lastOcc sums (>= 10) in
                                 take t inp ++ [sums !! t] ++ drop (t+2) inp
                             else
                               case xs of
                                 (y:ys) -> (x+y):ys
                                 [] -> [0]
  where
    lastOcc [] _ = -1
    lastOcc (x:xs) pred = (if pred x || later >= 0 then (1+) else id) $ later
      where later = lastOcc xs pred

import Data.List
import Data.Char
import Control.Monad

for list action = mapM_ action list

main = do
  inp <- getLine
  let times = read inp in do
                        for [1..times] (\i -> do
                                           input <- getLine
                                           putStrLn $ show (replacePairs (map digitToInt input))
                             )
  return ""

replacePairs :: [Int] -> Int
replacePairs inp = if (1 >= length inp)
                   then (shower inp)
                   else foldl (\acc k -> max acc (shower (inserter inp k))) (shower (inserter inp 1)) [2..((length inp) - 1)]

  where shower xs = read (foldr (++) "" $ map show xs) :: Int
        inserter a k = (let (front, back) = splitAt (k-1) a in front ++ [head back + head (drop 1 back)] ++ (drop 2 back))

import Data.List
import Data.Char

main = do
    input <- getLine
    putStrLn $ show (replacePairs (map digitToInt input))

replacePairs :: [Int] -> Int
replacePairs inp = if (1 >= length inp)
                   then (shower inp)
                   else foldl (\acc k -> max acc (shower (inserter inp k))) (shower (inserter inp 1)) [2..((length inp) - 1)]

  where shower xs = read (foldr (++) "" $ map show xs) :: Int
        inserter a k = (let (front, back) = splitAt (k-1) a in front ++ [head back + head (drop 1 back)] ++ (drop 2 back))

import Data.Char

main = do
    input <- getLine
    putStrLn (replacePairs input)

replacePairs :: String -> String
replacePairs inp = if (1 >= length (inp))
                   then inp
                   else foldr (++) "" $ replacePairs''' (map digitToInt (inp)) (map digitToInt (inp))
  where -- replacePairs' st = foldl (++) "" $ replacePairs'' st []
        -- replacePairs'' [] acc = reverse (map show acc)
        -- replacePairs'' (a:b:xs) [] = replacePairs'' xs [a + b]
        -- replacePairs'' (x:xs) acc = replacePairs'' xs (x+(head acc) : acc)
    replacePairs''' (x:y:xs) (a:b:acc) = (show (a+b) : replacePairs''' (y:xs) (b:acc))
    replacePairs''' (x:xs) acc = []


import Control.Monad (replicateM_)

canGenerate :: String -> String -> Bool
canGenerate s t = go (reverse s) (reverse t) where
  go _ [] = True
  go (x : xs) (y : ys)
    | x == y = go xs ys
    | not $ null xs = go (tail xs) (y : ys)
    | otherwise = False
  go _ _ = False

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- getLine
    t <- getLine
    putStrLn $ if s `canGenerate` t then "YES" else "NO"

import Data.List
import Data.Maybe
import Control.Monad

splitInTuples [] = []
splitInTuples (x:y:ys) = [(x,y)] ++ (splitInTuples ys)

process (a, b) = if _process (reverse a) (reverse b) == False then "NO" else "YES"

_process _ [] = True
_process a (b:bs)
  | bIndexOnA == -1  = False
  | otherwise        = if bIndexOnA `mod` 2 == 0 then _process (drop (bIndexOnA + 1) a) bs else _process (drop (bIndexOnA + 1) a) (b:bs)
  where
    bIndexOnA = fromMaybe (-1) (elemIndex b a)
    k = drop (bIndexOnA + 1) a

main = do
  input <- getLine
  inputs <- replicateM ((read input) * 2) getLine
  mapM_ putStrLn (map process (splitInTuples inputs))

{-# Language TypeApplications #-}

module Main where
import Control.Monad (forM, forM_)

main :: IO ()
main = do
  numTests <- read @Int <$> getLine

  tests <- forM [1 .. numTests] (\_ -> do
    input <- getLine
    output <- getLine
    pure (input, output))

  forM_ tests (\(i, o) -> putStrLn (if tryTest (reverse i) (reverse o) then "YES" else "NO"))

-- From the end
tryTest :: String -> String -> Bool
tryTest _  [] = True
tryTest [] v  = null v
tryTest (u:us) (v:vs) =
  if u == v then
    tryTest us vs
  else
    tryTest (drop 1 us) (v:vs)

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
    words
      >>> drop 1
      >>> chunksOf 2
      >>> map (solve >>> bool "No" "Yes")
      >>> unlines

solve :: [String] -> Bool
solve [s, t] = canType (reverse s) (reverse t)

canType _ [] = True
canType (c:cs) (t:ts) | c == t = canType cs ts
canType (c:c':cs) ts = canType cs ts
canType _ _ = False

-- Template --
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

solve :: P.ByteString -> P.ByteString -> Bool
solve s t = case  (P.uncons s, P.uncons t)  of
  (_, Nothing) -> True
  (Just (p, s'), Just (q, t')) | p == q -> solve s' t'
  (Just (_, s'), _) -> case  P.uncons s'  of
    Just (_, s'') -> solve s'' t
    Nothing -> False
  _ -> False

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [q] <- readInts
  replicateM_ q $ do
    s <- P.reverse <$> readLine
    t <- P.reverse <$> readLine
    lift $ B.hPutBuilder stdout $ if  solve s t
      then  B.string7 "YES\n"
      else  B.string7 "NO\n"

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad (replicateM_)

canGenerate :: String -> String -> Bool
canGenerate s t = go (reverse s) (reverse t) where
  go (x : xs) [y] = y == x
  go [x] (y : ys) = False
  go (x : [x']) (y : ys) = False
  go (x : x' : xs) (y : ys)
    | y == x = go (x' : xs) ys
    | otherwise = go xs (y : ys)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    s <- getLine
    t <- getLine
    putStrLn $ if s `canGenerate` t then "YES" else "NO"

import Data.List
import Data.Maybe
import Control.Monad

splitInTuples [] = []
splitInTuples (x:y:ys) = [(x,y)] ++ (splitInTuples ys)

process (a, b) = if _process (reverse a) (reverse b) == False then "NO" else "YES"

_process _ [] = True
_process a (b:bs)
  | bIndexOnA == -1  = False
  | otherwise        = if bIndexOnA `mod` 2 == 0 then _process (drop (bIndexOnA + 1) a) bs else _process (drop (bIndexOnA) a) (b:bs)
  where
    bIndexOnA = fromMaybe (-1) (elemIndex b a)
    k = drop (bIndexOnA + 1) a

main = do
  input <- getLine
  inputs <- replicateM ((read input) * 2) getLine
  mapM_ putStrLn (map process (splitInTuples inputs))

import Data.List
import Data.Maybe
import Control.Monad

splitInTuples [] = []
splitInTuples (x:y:ys) = [(x,y)] ++ (splitInTuples ys)

process (a, b) = if _process (reverse a) (reverse b) == False then "NO" else "YES"

_process _ [] = True
_process a (b:bs)
  | bIndexOnA == -1  = False
  | otherwise        = if bIndexOnA `mod` 2 == 0 then _process (drop (bIndexOnA + 1) a) bs else False
  where
    bIndexOnA = fromMaybe (-1) (elemIndex b a)
    k = drop (bIndexOnA + 1) a

main = do
  input <- getLine
  inputs <- replicateM ((read input) * 2) getLine
  mapM_ putStrLn (map process (splitInTuples inputs))


import Control.Arrow ((>>>))
import qualified Data.Set as S

type SetInt = S.Set Int

main :: IO ()
main =
  interact $
    lines >>> drop 1 >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (ns : xs) = let n = read ns in solve n (take n xs) : process (drop n xs)

solve :: Int -> [String] -> String
solve n ls
  | S.null unmatched = "OPTIMAL"
  | otherwise =
    let lv = S.findMin unmatched
        rv = head $ filter (\u -> not $ S.member u picked) [1 .. n]
     in "IMPROVE\n" ++ show lv ++ " " ++ show rv
  where
    (picked, unmatched) =
      foldl pick (S.empty, S.empty) $
        zip [1 .. n] $ map (map read . drop 1 . words) ls
    pick :: (SetInt, SetInt) -> (Int, [Int]) -> (SetInt, SetInt)
    pick (used, unmatched) (p, cs) =
      case filter (\u -> not $ S.member u used) cs of
        [] -> (used, S.insert p unmatched)
        (c : _) -> (S.insert c used, unmatched)

import Control.Arrow ((>>>))
import qualified Data.Set as S

type SetInt = S.Set Int

main :: IO ()
main =
  interact $
    lines >>> drop 1 >>> process >>> unlines

process :: [String] -> [String]
process [] = []
process (ns : xs) = solve n (take n xs) : process (drop n xs)
  where
    n = read ns

solve :: Int -> [String] -> String
solve n ls
  | S.null unmatched = "OPTIMAL"
  | otherwise =
    let lv = S.findMin unmatched
        rv = head $ filter (\u -> not $ S.member u picked) [1 .. n]
     in "IMPROVE\n" ++ show lv ++ " " ++ show rv
  where
    (picked, unmatched) =
      foldl pick (S.empty, S.empty) $
        zip [1 .. n] $ map (map read . drop 1 . words) ls
    pick :: (SetInt, SetInt) -> (Int, [Int]) -> (SetInt, SetInt)
    pick (used, unmatched) (p, cs) =
      case filter (\u -> not $ S.member u used) cs of
        [] -> (used, S.insert p unmatched)
        (c : _) -> (S.insert c used, unmatched)

import Control.Arrow
import qualified Data.Set as S
type SetInt = S.Set Int

main = interact $
  lines >>> drop 1 >>> process >>> unlines

process :: [String] -> [String]
process [] = [""]
process (ns:xs) = solve n (take n xs) : process (drop n xs)
  where n = read ns

solve :: Int -> [String] -> String
solve n ls
  | S.null unmatched = "OPTIMAL"
  | otherwise =
    let
      lv = S.findMin unmatched
      rv = [ u | u <- [1..n], not $ S.member u picked ] !! 0
    in "IMPROVE\n" ++ (show lv) ++ " " ++ (show rv)
  where
    (picked, unmatched) =
      foldl pick (S.empty, S.empty) $
        zip [1..n] $ map ((map read) . (drop 1) . words) ls
    pick :: (SetInt, SetInt) -> (Int, [Int]) -> (SetInt, SetInt)
    pick (used, unmatched) (p, []) = (used, S.insert p unmatched)
    pick (used, unmatched) (p, (c:rest))
      | S.member c used = pick (used, unmatched) (p, rest)
      | otherwise = (S.insert c used, unmatched)

import Control.Arrow
import qualified Data.Set as S
type SetInt = S.Set Int

main = interact $
  lines >>> drop 1 >>> process >>> unlines

process :: [String] -> [String]
process [] = [""]
process (ns:xs) = solve n (take n xs) : process (drop n xs)
  where n = read ns

solve :: Int -> [String] -> String
solve n ls
  | S.null unmatched = "OPTIMAL"
  | otherwise =
    let
      lv = S.findMin unmatched
      rv = [ u | u <- [1..n], not $ S.member u picked ] !! 0
    in "IMPROVE\n" ++ (show lv) ++ " " ++ (show rv)
  where
    (picked, unmatched) =
      foldl pick (S.empty, S.empty) $
        zip [1..n] $ map ((map read) . words) ls
    pick :: (SetInt, SetInt) -> (Int, [Int]) -> (SetInt, SetInt)
    pick (used, unmatched) (p, []) = (used, S.insert p unmatched)
    pick (used, unmatched) (p, (c:rest))
      | S.member c used = pick (used, unmatched) (p, rest)
      | otherwise = (S.insert c used, unmatched)


import Control.Monad
import Data.List
import Data.Array
readInts = fmap (map read.words) getLine :: IO [Int]

scoreA sa n x = sa ! ((n+x) - div (n+x) 4 - x) + 100 * x
scoreB sb n x = sb ! min ((n+x) - div (n+x) 4) n

solve sa sb n x
            | scoreA sa n x < scoreB sb n x = solve sa sb n (x+1)
            | otherwise = x;

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    b <- readInts
    let sa = listArray (1,n) $ scanl1 (+) $ sortOn negate a
        sb = listArray (1,n) $ scanl1 (+) $ sortOn negate b
    print $ solve sa sb n 0

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Monad
import Data.List
import Data.Array
readInts = fmap (map read.words) getLine :: IO [Int]

scoreA sa n x = sa ! ((n+x) - div (n+x) 4 - 1 - x) + 100 * x
scoreB sb n x = sb ! min ((n+x) - div (n+x) 4 - 1) (n-1)

solve sa sb n x
            | scoreA sa n x < scoreB sb n x = solve sa sb n (x+1)
            | otherwise = x;

printResult = do
    n <- readLn :: IO Int
    a <- readInts
    b <- readInts
    let sa = listArray (0,n-1) $ scanl1 (+) $ sortOn negate a
        sb = listArray (0,n-1) $ scanl1 (+) $ sortOn negate b
    print $ solve sa sb n 0

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: Int -> [Int] -> [Int] -> Int -> Int -> Int
cnt le a b l r
  | l == r = l
  | mid_good = cnt le a b l mid
  | otherwise = cnt le a b (mid+1) r
  where mid = div (l+r) 2
        n = le + mid
        k = div n 4
        suma = sum (drop k a) + (mid - (max 0 (k - le))) * 100
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt n a b 0 n
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where mid = div (l+r) 2
        n = length a + mid
        k = div n 4
        suma = sum (drop k a) + (mid - (max 0 (k - length a))) * 100
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt a b 0 (2*n)
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import qualified Data.Array as A
import qualified Data.Sequence as S
import           Control.Monad (replicateM_)
import           Data.Maybe (fromJust)
import           Data.List (sort, sortOn)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      a_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      b_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      print $ solve n a_i b_i

solve :: Int -> [Int] -> [Int] -> Int
solve n me him
  | scoreMe n meArr >= scoreHim n himArr = 0
  | otherwise = binarySearch (n + 1, 2 * n) meArr himArr - n
  where
    meArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort me ++ repeat 100))

    himArr =
      A.array (1, 2 * n) (zip [1 .. 2 * n] (sortOn negate him ++ repeat 0))

scoreMe :: Int -> A.Array Int Int -> Int
scoreMe k arr = sum (map (arr A.!) [(minIndex + 1) .. k])
  where
    minIndex = k `div` 4

scoreHim :: (A.Ix i, Num a, Integral i) => i -> A.Array i a -> a
scoreHim k arr = sum (map (arr A.!) [1 .. (k - minIndex)])
  where
    minIndex = k `div` 4

{->>> scoreHim 20 (A.array (1,50) (zip [1..50] (sort [100,100,100,100]++repeat 0)))
400
-}
binarySearch :: (Int, Int) -> A.Array Int Int -> A.Array Int Int -> Int
binarySearch (lower, upper) me him
  | lower == upper = lower
  | scoreMe mid me >= scoreHim mid him = binarySearch (lower, mid) me him
  | otherwise = binarySearch (mid + 1, upper) me him
  where
    mid = (lower + upper) `div` 2
{-
>>>solve 7 [7 ,59 ,62 ,52 ,27 ,31 ,55] [33 ,35 ,50 ,98, 83, 80 ,64]
2

>>>

>>>solve 4 [4 ,10 ,20 ,30 ,40] [100 ,100, 100 ,100]
4

>>>solve 4 [20 ,30 ,40, 50] [100, 100, 100, 100]
3
>>>solve 2 [40 ,78] [82 ,67]
1
-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE Strict #-}

import Control.Applicative (liftA2)
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)

main :: IO ()
-- main = C.interact $ runScanner (C.pack <$> testCase)
main = C.interact $ runScanner (C.unlines <$> numberOf (C.pack <$> testCase))

testCase :: Scanner String
testCase = do
  n <- int
  as <- sort <$> n >< int
  bs <- sort <$> n >< int
  return . show $ solve as bs

solve :: [Int] -> [Int] -> Int
solve as bs = go 0 (4 * n)
  where
    n = length as
    gap = sum bs - sum as
    go l r
      | l == r = l
      | otherwise =
        let mid = (l + r) `div` 2
         in if check mid then go l mid else go (mid + 1) r
    check k =
      let d = (n + k) `div` 4
       in gap - sum (take (d - k) bs) <= 100 * (k - max 0 (d - n)) - sum (take d as)

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad hiding (ap)
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    ap <- scanl' (+) 0 . sort <$> readInts
    bp <- scanl' (+) 0 . sort <$> readInts
    let
      lap = last ap
      lbp = last bp
      res k = let
        ct = n + k
        toRem = div ct 4
        as = lap + k * 100 - ap !! toRem
        bs = lbp - bp !! max 0 (toRem - k)
        in  as - bs
      go x y
        | x == y  = x
        | otherwise = let
            w = x + div (y - x) 2
            in  if  res w >= 0
                then  go x w
                else  go (w+1) y
    putInts [go 0 n]

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where k = div (length a) 4
        mid = div (l+r) 2
        suma = sum (drop k a) + 100 * mid
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      res = cnt a b 0 (2*n)
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.Int (Int64)
import Data.List as L
import qualified Data.Bits as Bits
import qualified Data.Char as Char
import qualified System.IO as Io

import Data.Word (Word8)
import qualified Data.ByteString as B
--import Data.IntSet

cnt :: [Int] -> [Int] -> Int -> Int -> Int
cnt a b l r
  | l == r = l
  | mid_good = cnt a b l mid
  | otherwise = cnt a b (mid+1) r
  where k = div (length a) 4
        mid = div (l+r) 2
        suma = sum (drop k a) + 100 * mid
        sumb = sum $ drop (k-mid) b
        mid_good = suma >= sumb

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  [sa, sb] <- sequence [getLine, getLine]
  let a = sort $ map read $ words sa :: [Int]
      b = sort $ map read $ words sb :: [Int]
      maxrnd = max 0 $ (sum b - sum a) `div` 100 + 1
      res = cnt a b 0 maxrnd
    in print res

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

{-# LANGUAGE BangPatterns #-}

module Main where

import qualified Data.ByteString.Char8 as C8
import qualified Data.Array as A
import qualified Data.Sequence as S
import           Control.Monad (replicateM_)
import           Data.Maybe (fromJust)
import           Data.List (sort)

readInput :: C8.ByteString -> [[Int]]
readInput = map
  (map
     (\str -> let (Just (i, _)) = C8.readInt str
              in i)
   . C8.words)
  . C8.lines

main :: IO ()
main = do
  t <- readLn :: IO Int
  replicateM_ t
    $ do
      n <- readLn :: IO Int
      a_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      b_i <- map (fst . fromJust . C8.readInt) . C8.words <$> C8.getLine
      print $ solve n a_i b_i

solve :: Int -> [Int] -> [Int] -> Int
solve n me him
  | scoreMe n meArr >= scoreHim n himArr = 0
  | otherwise = binarySearch (n + 1, 2 * n) meArr himArr - n
  where
    meArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort me ++ repeat 100))

    himArr = A.array (1, 2 * n) (zip [1 .. 2 * n] (sort him ++ repeat 0))

scoreMe :: Int -> A.Array Int Int -> Int
scoreMe k arr = sum (map (arr A.!) [minIndex + 1 .. k])
  where
    minIndex = k `div` 4

scoreHim :: (A.Ix i, Num a, Integral i) => i -> A.Array i a -> a
scoreHim k arr = sum (map (arr A.!) [1 .. (k - minIndex)])
  where
    minIndex = k `div` 4

{->>> score 4 (A.array (1,18) (zip [1..18] (sort [100,100,100,100])))
300
-}
binarySearch :: (Int, Int) -> A.Array Int Int -> A.Array Int Int -> Int
binarySearch (lower, upper) me him
  | lower + 1 >= upper = upper
  | scoreMe mid me >= scoreHim mid him = binarySearch (lower, mid) me him
  | otherwise = binarySearch (mid + 1, upper) me him
  where
    mid = (lower + upper + 1) `div` 2
{-
>>>solve 7 [7 ,59 ,62 ,52 ,27 ,31 ,55] [33 ,35 ,50 ,98, 83, 80 ,64]
ProgressCancelledException

>>>solve 4 [4 ,10 ,20 ,30 ,40] [100 ,100, 100 ,100]
4

>>>solve 4 [20 ,30 ,40, 50] [100, 100, 100, 100]
3

-}


import Control.Applicative ((<$>))
import Control.Monad (replicateM)

readNums :: IO [Int]
readNums = ((map read) . words) <$> getLine

dot2Space :: Char -> Char
dot2Space c = case c of
    '.' -> ' '
    x -> x

main = do
    [r, c] <- readNums
    ground <- last <$> (replicateM r getLine)
    let numSegments = length $ words $ (map dot2Space) ground
    putStrLn $ show  numSegments

import Control.Monad
import Data.List

solve :: [[Char]] -> Int
solve fld = length $ filter (\a -> any (\b -> b /= '.') a) pairs
  where
    bottom = last fld
    pairs = groupBy (\a b -> a == b) bottom

main :: IO ()
main = do
  r <- liftM words getLine
  mat <- replicateM (read $ head r) getLine
  print $ solve mat


{-# LANGUAGE BangPatterns, TupleSections #-}

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

main = do
  n <- readLn
  ijs <- sortBy(comparing$uncurry (+)).concat.zipWith(\i ci->map(i,)[1..ci])[1..].map read.words <$> getLine
  tblSet <- fmap(S.fromList.concat).forM [1..n] $ \i->
    zipWith(\j x->(x,i,j))[1..].map read.words <$> getLine
  let ans = solve ijs tblSet
  print $ length ans
  putStrLn.unlines.map(unwords.map show) $ ans

solve :: [(Int,Int)] -> S.Set (Int,Int,Int) -> [[Int]]
solve [] _ = []
solve ((i,j):ijs) set
  | (i,j) == (x,y) = solve ijs rest
  | otherwise = [i,j,x,y]:solve ijs (S.insert (v2,x,y) rest2)
   where
     ((_,x,y),rest) = S.deleteFindMin set
     (rest1,rest2)=S.partition(\(_,x,y)->x==i && y==j)rest
     (v2,_,_) = S.findMin rest1

import Data.List
import Data.Maybe

main :: IO ()
main = do n  <- getLine >>= return . read
          lc <- getLine >>= return . map read . words
          l  <- sequence $ replicate n (getLine >>= return . map read . words)
          let ans = solve n lc l
          putStrLn $ show $ length ans
          sequence_ $ map (putStrLn . unwords . map show) ans

solve :: Int -> [Int] -> [[Int]] -> [[Int]]
solve n lc l = map g . filter (\ (x,y) -> x/=y) $(fromJust (f sorted list 0))
    where
        list = concat l
        sorted = sort list
        f [] _ _ = Just []
        f (x:xs) (y:ys) idx = do i  <- elemIndex x (y:ys)
                                 let ys' = tail (set i y (y:ys))
                                 l  <- f xs ys' (idx+1)
                                 return ((idx,idx+i):l)
        set 0 e (x:xs) = e:xs
        set n e (x:xs) = x:set (n-1) e xs
        lc' = scanl (+) 0 lc
        g (x,y) = let (i,j) = convert x
                      (k,l) = convert y
                  in [i,j,k,l]
        convert idx = (i,j+1)
            where i = fromJust $ findIndex (>idx) lc'
                  j = idx - lc' !! (i-1)

import Control.Monad (liftM)
import Data.Array
--import Data.Map (Map, empty, fromList, insert)

type Size   =  Array Int Int
type Table  =  Array (Int, Int) Int
type Swap   =  ((Int, Int), (Int, Int))

parseTable :: Size -> [Int] -> Table
parseTable cs xs  =  accum (flip const) zeroArray $ getList (1, 1) xs
  where
    zeroArray  =  accumArray undefined 0 ((1,1), (n, cs ! 1)) []
    n  =  snd $ bounds cs
    getList (i, j) []  =  []
    getList (i, j) (x:xs)
      | j > cs ! i  =  getList (i+1, 1) (x:xs)
      | otherwise  =  ((i, j), x) : getList (i, j+1) xs

solve :: Size -> Table -> [Swap]
solve cs table  =  solve' (1,1) 1 table
  where
    n  =  sum $ elems cs
    solve' (i,j) m table
      | m == n  =  []
      | j > cs ! i  =  solve' (i+1,1) m table
      | table ! (i,j) == m  =  solve' (i,j+1) (m+1) table
      | otherwise  =  ((iM,jM), (i,j)) : solve' (i,j+1) (m+1) (table // [((iM,jM), table ! (i,j)), ((i,j), m)])
        where
          (iM,jM)  =  fst $ head $ dropWhile ((/= m) . snd) $ assocs table

prints :: [Swap] -> IO ()
prints swaps  =  print (length swaps) >> mapM_ print' swaps
  where
    print' ((i1,j1), (i2,j2))  =  putStrLn $
        concat [show i1, " ", show j1, " ", show i2, " ", show j2]

main :: IO ()
main  =  do
    n  <-  readLn
    cs  <-  liftM (listArray (1,n) . fmap read . words) getLine :: IO (Array Int Int)
    xs  <-  liftM (parseTable cs . fmap read . words) getContents :: IO Table
    prints $ solve cs xs

import Data.List
import Data.Maybe

main :: IO ()
main = do n  <- getLine >>= return . read
          lc <- getLine >>= return . map read . words
          l  <- sequence $ replicate n (getLine >>= return . map read . words)
          let ans = solve n lc l
          putStrLn $ show $ length ans
          sequence_ $ map (putStrLn . unwords . map show) ans

solve :: Int -> [Int] -> [[Int]] -> [[Int]]
solve n lc l = map g (fromJust (f sorted list 0))
    where
        list = concat l
        sorted = sort list
        f [] _ _ = Just []
        f (x:xs) (y:ys) idx = do i  <- elemIndex x (y:ys)
                                 let ys' = tail (set i y (y:ys))
                                 l  <- f xs ys' (idx+1)
                                 return ((idx,idx+i):l)
        set 0 e (x:xs) = e:xs
        set n e (x:xs) = x:set (n-1) e xs
        lc' = scanl (+) 0 lc
        g (x,y) = let (i,j) = convert x
                      (k,l) = convert y
                  in [i,j,k,l]
        convert idx = (i,j+1)
            where i = fromJust $ findIndex (>idx) lc'
                  j = idx - lc' !! (i-1)


import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.Array.ST(runSTArray, STArray)

import Data.Array((!))
import Control.Monad(replicateM, foldM, mapM, filterM) -- foldM est un foldl
import Data.Maybe

numOcc :: Ord a => [a] -> M.Map a Integer
numOcc (x:xs) = let m = numOcc xs in case M.lookup x m of
	Just i -> M.insert x (i+1) m
	Nothing -> M.insert x 1 m
numOcc [] = M.empty

numOcc' :: A.Ix a => (a, a) -> [a] -> A.Array a Integer
numOcc' size list = runSTArray $ do
	array <- MA.newArray size 0
	foldM (addElem array) () list
	return array

	where
		addElem :: A.Ix a=> STArray s a Integer -> () -> a -> ST s ()
		addElem array action a = do
			i <- MA.readArray array a
			MA.writeArray array a (i+1)

insertWithList :: Ord a => a -> b -> M.Map a [b] -> M.Map a [b]
insertWithList a b m = case M.lookup a m of
	Just l -> M.insert a (b:l) m
	Nothing -> M.insert a [b] m

deleteWithList :: Ord a => a -> M.Map a [b] -> M.Map a [b]
deleteWithList a m = case M.lookup a m of
	Just (x:y:xs) -> M.insert a (y:xs) m
	Just [x] -> M.delete a m

solve :: Integer -> Integer -> [Integer] -> Integer
solve n k a = result k occM where
	occM = numOcc a

	result k occ
		| num >= k = k `parmi` num
		| k > num = result (k-num) occ'
		where
			(key, num) = M.findMax occ
			occ' = M.delete key occ

	parmi k num
		| k == 0 = 1
		| num == 0 = 1
		| otherwise = (num * parmi (k-1) (num-1)) `div` k

plotResult n = print $ mod n 1000000007

main = do
	t <- getLine >>= return . read :: IO Integer
	replicateM (fromInteger t) $ do
		[n, k] <- fmap ((fmap read) . words) getLine :: IO [Integer]
		a <- fmap ((fmap read) . words) getLine :: IO [Integer]
		plotResult $ solve n k a

-- Trying to use only ByteString I/O with a state monad this contest

import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.ByteString.Lazy.Char8 as P

import Data.List
import Data.Semigroup
import Data.Int

getSLine :: Monad m => StateT P.ByteString m P.ByteString
getSLine = do
  (out, next) <- P.break (== '\n') <$> get
  put $ P.tail next
  pure out

readInts :: Monad m => StateT P.ByteString m [Int]
readInts = do
  currLine <- getSLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

-- There has to be a combinator for this. But where?
outLine :: P.ByteString -> StateT P.ByteString IO ()
outLine v = StateT $ \s -> ((), s) <$ P.putStrLn v

p :: Int
p = 10^(9 :: Int) + 7

mul :: Int -> Int -> Int
mul x y = let
  p' :: Int64
  [x', y', p'] = map fromIntegral [x, y, p]
  in  fromIntegral $ mod (x' * y') p'

newtype W = W { unw :: Int }

instance  Semigroup W  where
  W x <> W y = W $ mul x y

inv :: Int -> Int
inv = unw . stimes (p-2) . W

choose :: Int -> Int -> Int
choose n k = let
  step v i = mul v . mul (n+1-i) $ inv i
  in  foldl' step 1 [1..k]

main :: IO ()
main = (P.getContents >>=) $ evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, k] <- readInts
    a <- readInts
    let
      sa = reverse $ sort a
      tarV = sa !! (k-1)
      ct1 = length [x | x <- sa, x == tarV]
      ct2 = length [x | x <- take k sa, x == tarV]
    outLine . P.pack . show $ ct1 `choose` ct2


import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import qualified Data.Set as S
import Data.Function
import Data.Int

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

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    a <- getInts (n * m)
    let
      aips = sort $ zip a [1..]
      unsrows = chunksOf m aips
      soln row = do
        w <- groupBy ((==) `on` fst) row
        reverse $ map snd w
      rows = map soln unsrows
      cost :: [Int] -> Int64
      cost row = let
        incls = scanl' (flip S.insert) S.empty row
        in  foldl' (+) 0 $ do
        (i, s) <- zip row incls
        pure $ fromIntegral $ S.size $ fst $ S.split i s
    pure $ putInt64s [foldl' (\x y -> x + cost y) 0 rows]

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

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

import Control.Monad
import Data.List

solve :: IO ()
solve = do
    [1, m] <- readMany :: IO [Int]
    as <- readMany :: IO [Int]
    let xs = map snd $ sortOn (negate . fst) $ zip as [1 :: Int ..]
    print $ sum [length $ filter (<i) xs' | (i:xs') <- tails xs]

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ solve

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function (on)
import Data.List (groupBy, sort)
import Data.Maybe (fromJust)

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> showB) >>> C.unlines

data TC = TC {n :: Int, m :: Int, as :: [Int]}

input :: Scanner TC
input = do
  n <- int
  m <- int
  as <- (n * m) >< int
  return TC {..}

solve :: TC -> Int
solve TC {..} =
  fst
    . foldl update (0, [])
    . map (sort . map snd)
    . groupOn fst
    . sort
    $ zip as [1 ..]
  where
    update (acc, row) ixs = (acc + cost, tetris $ row ++ ixs)
      where
        cixs = take (m - length row) ixs
        cost = sum [countBy (< i) row | i <- cixs]

    tetris xs = let l = length xs in drop (l - l `mod` m) xs

-------------------------- Template ------------------------------------------
-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show


import Data.List
import qualified Data.Set as Set

f::Integer->[Integer]->Integer
f _ (x:[])=2
f k (x:y:zs)
   |x+k<y-k=2+(f k (y:zs))
   |x+k==y-k=1+(f k (y:zs))
   |otherwise=f k (y:zs)

main = do
       e1<-getLine
       es<-getLine
       let (n:k:[])=map read (words e1)::[Integer]
           xs=map read (words es)::[Integer]
       print $ f k xs

import Data.List.Split as Split

stringToInt s = read s :: Int

possible n_d x_n =
  let [_n, d] = map stringToInt $ Split.splitOn " " n_d
      x = map stringToInt $ Split.splitOn " " x_n
  in show (2 + (behind d x))

behind d (x1:[]) = 0
behind d (x1:x2:xs) =
  case compare (2*d) (x2 - x1) of
    EQ -> 1 + behind d (x2:xs)
    GT -> behind d (x2:xs)
    LT -> 2 + behind d (x2:xs)

main = do
  n_d <- getLine
  x_n <- getLine
  putStrLn (possible n_d x_n)


f::[Int]->[Int]
f (x:[])=[x]
f (x:y:xs)
   |x<y=f (y:xs)
   |otherwise=x:f (y:xs)

main = do
       e<-getLine
       e2<-getLine
       let xs=map read (words e2)::[Int]
           ys=f xs
       putStrLn $ (show(length ys))++"\n"++(unwords $ map show $ ys)

import Data.List

toint s = (read s) :: Integer

doit [] i = [i]
doit (x:xs) i =
	if x == 1 && i > 0 then
		i:(doit xs 1)
	else
		doit xs (i+1)

solve::String -> String
solve ss =
	let s = map toint (tail (words ss)) in
	let r = doit s 0 in
	(show (length r)) ++ "\n" ++ intercalate " " (map show r) ++ "\n"

main = do
  interact $ solve

-- Codeforces 1005 A
import Data.List
foldCount :: [Int] -> [Int]
foldCount list = (\(n, l) -> tail l ++ [n]) $ foldl' func (0, []) list
    where func :: (Int, [Int]) -> Int -> (Int, [Int])
          func (x, l) 1 = (1, l++[x])
          func (_, l) x = (x, l)

main :: IO ()
main = do
    n <- getLine
    list <- getLine >>= return.foldCount.(map read).words :: IO [Int]
    putStrLn $ show $ length list
    putStrLn $ unwords $ map show list

{-# LANGUAGE ScopedTypeVariables #-}

import Prelude
import Data.Maybe
import Data.List
import Text.Printf
import Control.Monad
import Data.Ratio
import Data.Int
import Data.Functor
import Control.Monad.ST.Safe
import Data.STRef
import qualified Data.Array.IArray as IA
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as A
import qualified Data.Array.Unboxed as UA
import qualified Data.ByteString.Char8 as B8

main :: IO ()
main = do
    (n :: Int) <- read <$> getLine
    (arr :: [Int]) <- (map read . words) <$> getLine
    let answer = map fst . filter (\(x, y) -> x + 1 /= y) $ zip arr (tail arr ++ [1])
    printf "%d\n" $ length answer
    forM_ answer $ printf "%d "

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char
-- import Data.List.HT

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

-- segmentBefore :: (a -> Bool) -> [a] -> [[a]]
-- segmentBefore _ [] = []
-- segmentBefore p s = foldr (\b a-> if p b then [] : [b : head a] ++ tail a else [b : head a] ++ tail a) [] s

segmentBefore :: (a -> Bool) -> [a] -> [[a]]
segmentBefore p =
--   foldr (\ x ~(y:ys) -> (if p x then ([]:) else id) ((x:y):ys)) [[]]
   uncurry (:) .
   foldr
      (\ x ~(y,ys) ->
         let xs = x:y
         in  if p x then ([],xs:ys) else (xs,ys))
      ([],[])

solve :: [Int] -> (Int, [Int])
solve xs = (length a, map last a)
    where a = tail $ segmentBefore (==1) xs

main :: IO ()
main = do
    n <- readInt
    xs <- readInts
    let r = solve xs
    print $ fst r
    putStrLn $ unwords . map show $ snd r

main = interact $ format . solve . map read . tail . words
solve as = filter (> 0) $ map succ $ zipWith (-) as (tail as ++ [1])
format ss = unlines [ show (length ss) , unwords (map show ss) ]

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

process n x [f] = do
			print $ n+1
			putStrLn $ intercalate " " $ map show (x++[f])

process n x (a:b:c) | a<b = process n x (b:c)
                    | otherwise = process (n+1) (x++[a])  (b:c)

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

--ghc 7.10

import Data.List(groupBy)

listStairwaySteps :: [Int] -> [Int]
listStairwaySteps = map length . groupBy (<)

main = do
    line1 <- getLine
    line2 <- getLine
    let a = map read . words $ line2
    let b = listStairwaySteps a
    let k = length b
    print k
    putStrLn . unwords . map show $ b

main = interact $ pureMain

pureMain :: String -> String
pureMain s = unlines $ map (unwords . map show) $ [length ans]:ans:[]
  where
    [[n], a] = map (map read . words) $ lines s
    (_, ans) = foldr (\ v (pre, l) -> if pre == 1 then (v, v:l) else (v, l)) (1, []) a


main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n

f :: Integer -> Integer -> Integer -> Integer
f a b n = if n == 0 then a else
	if can a 0 b then (a*10+0)*10^(n-1) else
	if can a 1 b then (a*10+1)*10^(n-1) else
	if can a 2 b then (a*10+2)*10^(n-1) else
	if can a 3 b then (a*10+3)*10^(n-1) else
	if can a 4 b then (a*10+4)*10^(n-1) else
	if can a 5 b then (a*10+5)*10^(n-1) else
	if can a 6 b then (a*10+6)*10^(n-1) else
	if can a 7 b then (a*10+7)*10^(n-1) else
	if can a 8 b then (a*10+8)*10^(n-1) else
	if can a 9 b then (a*10+9)*10^(n-1) else
	 -1

can :: Integer -> Integer -> Integer -> Bool
can a d b  = if (10*a+d) `mod` b == 0 then True else False

readInts :: String -> [Int]
readInts str = map read (words str)

main :: IO ()
main = do
  [a, b, n] <- fmap readInts getLine
  let s = mod (a*10+9) b
  if s>9 then print (-1)
  else do
    putStr $ show a
    putStr $ show $ 9-s
    putStr $ replicate (n-1) '0'

main=do
  [a,b,n] <- fmap(map read.words)getLine
  putStrLn $ f a b n

f a b n
  | null xs = "-1"
  | otherwise = show x0++replicate(n-1)'0'
   where
     xs = [y|x<-[0..9],let y=10*a+x,mod y b<1]
     x0 = head xs

main = getContents >>= putStr.concatMap show.solve.map read.words

solve :: [Int] -> [Int]
solve (a:b:n:[])
	| ((b - ((a*10) `mod` b)) `mod` b) > 9 = [-1]
	| otherwise = a:fir:replicate (n-1) 0
		where fir = (b - ((a*10) `mod` b)) `mod` b

import Control.Applicative
import Data.List
import Data.Char

extend a b 0 = a
extend a b n = if z <10  then extend (x+z) b (n-1) else if y==0 then x*10^(n-1) else (-1)
	where x = a*10
	      y = mod x b
              z = b - y

main= do
	 [a,b,n]<-  map read. words <$>getLine  ::IO [Integer]
	 print $ extend a b n

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n
f :: Integer -> Integer -> Integer -> Integer
f a b n =
  if (a*10)`mod`b==0 then (a*10)*10^(n-1) else
  if b-((a*10)`mod`b)<=9 then (a*10+b-((a*10)`mod`b))*10^(n-1) else
  -1

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n
f :: Integer -> Integer -> Integer -> Integer
f a b n =
  if a*10`mod`b==0 then a*10^n else
  if b-a*10`mod`b<=9 then (a*10+b-(a*10`mod`b))*10^(n-1) else
  -1

main :: IO ()
main = getLine >>= putStrLn . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = 10*a + x, mod y b == 0]

extend :: Int -> Int -> Int -> Maybe (Int, Int)
extend a b 0 = Just (a, 0)
extend a b n =
  let m = (a * 10) `mod` b
      d = (b - m) `mod` b
      in if 0 <= d && d < 10 then Just (10*a + d, n-1) else Nothing

main = do
  inpStr <- getLine
  let [a, b, n] = map (read :: String -> Int) $ words inpStr
    in case (extend a b n) of
      Nothing -> putStrLn "-1"
      Just (m, k)  -> putStrLn $ (show m) ++ (replicate k '0')

func a b n
    | null xs = "-1"
    | otherwise = show a ++ show (head xs) ++ replicate (n - 1) '0'
    where
      xs = [y | y <- [0 .. 9], (a * 10 + y) `mod` b == 0]

main = do
  [a, b, n] <- fmap (map read . words) getLine
  putStrLn $ func a b n

import Data.Char (intToDigit)

main :: IO ()
main = do
  [a, b, n] <- fmap (map read . words) getLine
  let d = head $ filter (\i -> mod (a * 10 + i) b == 0) [0 .. 9] ++ [-1]
  if d == -1
    then putStrLn "-1"
    else putStrLn $ show a ++ [intToDigit d] ++ replicate (n - 1) '0'

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

main = putStrLn . show . solve . map (toInteger . maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Integer] -> Integer
solve [a, b, n] = case f a b of
  x : _ -> x * 10 ^ (n-1)
  _ -> -1
  where
  f a b = [a' | c <- [0..9], let a' = a * 10 + c, rem a' b == 0]

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> String
solve [a, b, n]  =  case x of
    []  ->  "-1"
    (x:xs)  ->  show a ++ show x ++ replicate (n - 1) '0'
  where
    x  =  filter (\c -> (10*a + c) `mod` b == 0) [0 .. 9]

main :: IO ()
main  =  reads >>= putStrLn . solve

-- Codeforces 260A

-- At first try to add to the right one digit from 0 to 9.
-- If it is impossible write -1.
-- In other case, the remaining n–1 digits can be 0 because divisibility doesn’t change.

main :: IO ()
main = getLine >>= putStrLn . solve . map read . words

solve :: [Int] -> String
solve [a, b, n] = if null k then "-1" else show (head k) ++ replicate (n-1) '0' where k = filter (\x -> x `mod` b == 0) $ map (a * 10 +) [0..9]

extend b a
  | null e    = -1
  | otherwise = head e
  where e = filter (\x -> x `mod` b == 0) $ map (\x -> a * 10 + x) [0 .. 9]

solve a b n
  | c == -1   = "-1"
  | otherwise = show c ++ replicate (n - 1) '0'
  where c = extend b a

main = do [a, b, n] <- fmap words getLine
          putStrLn $ solve (read a) (read b) (read n)

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

main = putStrLn . show . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve [a, b, n] = case f a b n of
  x : _ -> x
  _ -> -1
  where
  f a b 0 = [a]
  f a b n = concat [f a' b (n-1) | c <- [0..9], let a' = a * 10 + c, rem a' b == 0]

main = getContents >>= putStr.concatMap show.solve.map read.words

solve :: [Int] -> [Int]
solve (a:b:n:[])
	| (b - ((a*10) `mod` b)) > 9 = [-1]
	| n > 1 && b > 9 = [-1]
	| otherwise = a:fir:replicate (n-1) b
		where fir = b - ((a*10) `mod` b)

import Control.Applicative
import Data.List
import Data.Char

extend a b 0 = a
extend a b n = if z <10 then extend (x+z) b (n-1) else (-1)
	where x = a*10
	      y = mod x b
              z = b - y

main= do
	 [a,b,n]<-  map read. words <$>getLine  ::IO [Integer]
	 print $ extend a b n

main :: IO ()
main = do [a,b,n] <- getLine >>= return . map read . words
          putStrLn $ show $f a b n

f :: Integer -> Integer -> Integer -> Integer
f a b n = if n == 0 then a else
	if can a 0 b then (a*10+0)*10^(n-1) else
	if can a 1 b then (a*10+1)*10^(n-1) else
	if can a 2 b then (a*10+2)*10^(n-1) else
	if can a 3 b then (a*10+3)*10^(n-1) else
	if can a 4 b then (a*10+4)*10^(n-1) else
	if can a 5 b then (a*10+5)*10^(n-1) else
	if can a 6 b then (a*10+6)*10^(n-1) else
	if can a 7 b then (a*10+7)*10^(n-1) else
	if can a 8 b then (a*10+8)*10^(n-1) else
	if can a 0 b then (a*10+9)*10^(n-1) else
	 -1

can :: Integer -> Integer -> Integer -> Bool
can a d b  = if (10*a+d) `mod` b == 0 then True else False

extend a b 0 = Just a
extend a b n =
  let m = (a * 10) `mod` b
      d = (b - m) `mod` b
      in if 0 <= d && d < 10 then extend (10*a + d) b (n-1) else Nothing

main = do
  inpStr <- getLine
  let [a, b, n] = map (read :: String -> Int) $ words inpStr
    in case (extend a b n) of
      Nothing -> putStrLn "-1"
      Just m -> putStrLn (show m)

main :: IO ()
main = getLine >>= print . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = (10 * a + x) `mod` b == 0]

main :: IO ()
main = getLine >>= print . f . map (read :: String -> Int) . words

f :: [Int] -> Int
f (a:b:n:_)
  | null xs = -1
  | otherwise = (10*a + head xs) * (10 ^ (n-1))
  where
        xs = [y | y <- [0..9], (10 * a + y) `mod` b == 0]

main :: IO ()
main = getLine >>= putStrLn . f . map (read :: String -> Int) . words

f :: [Int] -> String
f (a:b:n:_)
  | null xs = "-1"
  | otherwise = show (head xs) ++ replicate (n-1) '0'
  where
          xs = [y | x <- [0..9], let y = (10 * a + x) `mod` b == 0]


import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) . group . sort

import Data.List
main=interact$(\[k,s] -> f (read k) (group$sort s)).words
divides k s = length s `mod` k == 0
f k grp
  | (any (==False).map (divides k)) grp = "-1"
  | otherwise = build k grp
build k grp = concat (replicate k (concat (map (\s -> replicate ((length s) `quot` k) (head s)) grp)))

import Control.Applicative
import Data.List

main = do
  k <- fmap read getLine
  s <- fmap (map (liftA2 (,) length head) . group . sort) getLine
  if all (\(n, _) -> mod n k == 0) s
    then putStrLn $ concat $ replicate k $ concatMap (\(n, a) -> replicate (div n k) a) s
    else print $ -1

-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-List.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Data-Char.html
-- http://hackage.haskell.org/packages/archive/base/latest/doc/html/Prelude.html
-- http://en.wikibooks.org/wiki/Haskell/Next_steps

sameList :: Int -> a -> [a]
sameList n a
	| n == 0 	= []
	| otherwise = (a : (sameList (n - 1) a))

getCount :: String -> [Int]
getCount [] 	 = sameList 26 0
getCount (a : b) = update a (getCount b)

update :: Char -> [Int] -> [Int]
update c a = (take i a) ++ [(a !! i) + 1] ++ (drop (i + 1) a)
	where i = (fromEnum c) - (fromEnum 'a')

check :: Int -> [Int] -> Bool
check k []		= True
check k (a:b) 	= (mod a k == 0) && check k b

copy :: Int -> String -> String
copy 0 _ 	= []
copy k s	= s ++ copy (k - 1) s

collate :: Int -> [Int] -> Int -> String
collate k cnt c
	| c >= 26 + fromEnum 'a'	= []
	| otherwise					= (sameList (div (head cnt) k) ch) ++
								(collate k (tail cnt) (c + 1))
		where ch = toEnum c

main :: IO()
main = do
	str <- getContents
	let input = words str
	let k = read (input !! 0)
	let cnt = getCount (input !! 1)
	if (check k cnt)
		then putStrLn (copy k (collate k cnt (fromEnum 'a')))
		else putStrLn "-1"

import List (group, sort)

solve :: Int -> String -> Maybe String
solve k s
  | all ((0 ==) . flip mod k . length) s'  =  Just $ take (length s) $ cycle $ concatMap (\s -> take (div (length s) k) s) s'
  | otherwise  =  Nothing
  where
    s'  =  group $ sort s

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    putStrLn $ maybe "-1" id $ solve n s

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

solve :: Int -> String -> String
solve k s
  | canSolve = concat $ take k $ repeat s'
  | otherwise = "-1"
  where
    track q = trace (show q) q
    grouped = group $ sort s
    canSolve = all (\x -> x `mod` k == 0) $ map length grouped
    s' = concat $ map (\x -> take (length x `div` k) x) $ grouped

main = do
  k <- read <$> getLine
  s <- getLine
  putStrLn $ solve k s

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs = maybe "-1" (([1..k] >>) . concat) $ mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) $ group $ sort cs

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\xs@(x:_) -> case divMod (length xs) k of (d, 0) -> Just (replicate d x); _ -> Nothing) . group . sort

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs | all ((==0) . (`mod`k)) $ map length $ group $ sort cs =
               [1..k] >> concatMap (\x -> take (length x `div` k) x) (group $ sort cs)
           | otherwise = "-1"

import Data.List
import Control.Arrow
main = do
  k <- readLn
  s <- getLine
  let fs = map (length &&& head) $ group $ sort s
  if all ((==0) . (`mod` k) . fst) fs
    then putStrLn $ concat $ replicate k $ concat $ map (uncurry replicate . first (`div` k)) fs
    else print (-1)

import Data.List

toKString :: Int -> String -> Maybe String
toKString k s | length s `mod` k /= 0 = Nothing
              | otherwise = toKString' k s
  where
    toKString' _ [] = Just ""
    toKString' k s = do
      a <- if all (== head s) (take k s)
           then Just $ head s
           else Nothing
      rest <- toKString' k (drop k s)
      return $ a : rest

main = do
  k <- readLn
  s <- getLine
  case toKString k $ sort s of
    Just s' -> putStrLn $ concat $ replicate k s'
    _       -> putStrLn "-1"

import Data.Char
import Data.List

count :: String -> Char -> Int
count s c = length $ filter (\x -> x == c) s

solve :: Int -> String -> String
solve k s = let z = getIt s 'a' 'z' k in if z == "-1" then z else repeat' k z

repeat' :: Int -> String -> String
repeat' 0 s = ""
repeat' a s = s ++ (repeat' (a - 1) s)

getIt :: String -> Char -> Char -> Int -> String
getIt s c to k = if c > to then "" else
                if mod (count s c) k /= 0 then "-1" else
                 let
                     z = getIt s (toEnum(fromEnum(c) + 1)) to k
                     u = count s c
                 in
                   if z == "-1" then z
                       else (replicate (div u k) c) ++ z
main = do n <- getLine
          s <- getLine
          putStrLn $ solve (read n) s

import Data.Array
import Control.Applicative
import Control.Monad

main = do
  k <- readLn
  cs <- filter((0<).snd).assocs.accumArray (+) 0 ('a','z').(`zip`repeat 1) <$> getLine
  if all ((0==).(`mod`k).snd) cs
     then replicateM_ k $ forM cs $ \(c,i)-> putStr $ replicate (i`div`k) c
     else print $ -1

import Data.List
main = do
    [kStr,s] <- fmap lines getContents
    let k = read kStr::Int
        sortedS = sort s
        numChars = map length $ group sortedS
        result = if all (\x -> x`rem`k == 0) numChars
            then concat $ replicate k $ takeEvery k sortedS
            else "-1"
    putStrLn result

takeEvery :: Int -> [a] -> [a]
takeEvery n [] = []
takeEvery n (x:xs) = x : (takeEvery n $ drop (n-1) xs)

import Data.List

calc :: Int -> String -> Maybe String
calc k s = if all (\t -> length t `mod` k == 0) xs
           then Just $ (foldl1 (++) . replicate k) $ kString1 xs
           else Nothing
  where
    xs = group $ sort s
    kString1 []     = ""
    kString1 (x:xs) = take (length x `div` k) x ++ kString1 xs

main = do s <- getLine
          t <- getLine
          case calc (read s) t of
            Just x  -> putStrLn x
            Nothing -> print (-1) -- -1 は括弧で囲む必要がある

import Control.Applicative
import Data.List

main= do
	k<-  read  <$> getLine ::IO Int
	s<-getLine
	let (a,b)=  unzip $ map (\z-> (head z, length z)) $ group $ sort s
	let c= all (==0) ( map (\z-> mod z k) b)
	let d = map (\z-> div z k) b
	putStrLn $ if c then concat $ replicate k $ concat $ zipWith (\x y -> replicate y x) a d else "-1"

import List (group, sort)

solve :: Int -> String -> Maybe String
solve k s
  | all ((0 ==) . flip mod k . length) s'  =  Just $ concatMap (\s -> take (div (length s) k) s) s'
  | otherwise  =  Nothing
  where
    s'  =  group $ sort s

main :: IO ()
main  =  do
    n  <-  readLn
    s  <-  getLine
    putStrLn $ maybe "-1" id $ solve n s

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k = maybe "-1" (([1..k] >>) . concat) . mapM (\xs@(x:_) -> if length xs `mod` k == 0 then Just (replicate k x) else Nothing) . group . sort

import Data.List (group, sort)

main :: IO ()
main = readLn >>= \k -> getLine >>= putStrLn . solve k

solve :: Int -> String -> String
solve k cs = maybe "-1" concat $ mapM (\x -> if length x `mod` k == 0 then Just (take (length x `div` k) x) else Nothing) $ group $ sort cs

import Control.Applicative
import Data.List

main= do
	k<-  read  <$> getLine ::IO Int
	s<-getLine
	let (a,b)=  unzip $ map (\z-> (head z, length z)) $ group $ sort s
	let c= all (==0) ( map (\z-> mod z k) b)
	let d = map (\z-> div z k) b
	putStrLn $ if c then concat $ replicate k $ concat $ zipWith (\x y -> replicate y x) a d else ""


toI l = map read $ words l :: [Int]
--comp s h = product [(s - h + 1) .. s]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = 1 - (product d)
        where
            a = [(s - h - n  + 2)..(s - h)]
            b = [(s-n + 1)..(s-1)]
            c = zip a b
            d = [(fromIntegral h1) / (fromIntegral h2) | (h1, h2) <- c ]

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    let sh = s!!(h-1)
    let ss = sum s
    --print $ comp (ss - n + 1) sh
    print $ solve n ss sh

module Main where

import Control.Monad

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Int]

    let sh = s !! (h-1)
        ss = sum s

    if ss < n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ res --fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: (Num b, Integral a) => a -> a -> b -> Double
compute _ _ 0 = 1
compute sh ss n = ( 1 - fromIntegral sh / fromIntegral ss ) * compute sh (ss-1) (n-1)

module Main where

import Control.Monad
import Data.Ratio

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Integer]

    let sh = s !! (h-1)
        ss = sum s

    if ss < fromIntegral n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: (Num b, Integral a) => a -> a -> b -> Ratio a
compute _ _ 0 = 1
compute sh ss n = ( 1 - sh % ss ) * compute sh (ss-1) (n-1)

module Main where

import Control.Monad
import Data.Ratio

main = do
    [n, m, h] <- ( map read . words ) `liftM` getLine :: IO [Int]
    s <- ( map read . words ) `liftM` getLine :: IO [Int]

    let sh = s !! (h-1)
        ss = sum s

    if ss < n
        then putStrLn "-1.0"
        else
            let res = 1 - compute (sh-1) (ss-1) (n-1) in
            putStrLn $ show $ fromIntegral (numerator res) / fromIntegral (denominator res)

compute :: Integral a => a -> a -> a -> Ratio a
compute _ _ 0 = 1
compute sh ss n = ( 1 - sh % ss ) * compute sh (ss-1) (n-1)

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | n > s = -1
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))

toI l = map read $ words l :: [Int]
--comp s h = product [(s - h + 1) .. s]

solve n s h
    | n > s = -1
    | h == 1 = 0
    | n == s = 1
    | otherwise = 1 - ((fromIntegral a) / (fromIntegral b))
        where
            a = product [(s - h - n  + 2)..(s - h)]
            b = product [(s-n + 1)..(s-1)]

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    let sh = s!!(h-1)
    let ss = sum s
    --print $ comp (ss - n + 1) sh
    print $ solve n ss sh

fact n = f n 1
    where
        f 0 r = r
        f n r = f (n - 1) (r * n)

comb :: Int -> Int -> Int
comb n 0 = 1
comb n k = (fact n) `div` ((fact k) * (fact $ n - k ))
toI l = map read $ words l :: [Int]

pos n s h = sum [(comb h i) * (comb s (n - i)) | i <- p]
    where
        m = max [n, h]
        p = [1..h]

solve n s h
    | h == 1 = 0
    | n > s = -1
    | n == s = 1
    | otherwise = (fromIntegral (pos (n - 1) (s - h) (h -1))) / (fromIntegral  (comb (s - 1) (n - 1)))

main = do
    l1 <- getLine
    let [n, m, h] = toI l1
    l2 <- getLine
    let s = toI l2
    print $ solve n (sum s) (s!!(h-1))


{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd (sum xs) || any odd xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

import qualified Data.ByteString as B (getLine)
import Data.ByteString.Char8 (readInt, words)
import Control.Applicative
import Prelude hiding (words)
import Data.Maybe (fromJust)

solve xs
  | odds == 0 = "Second"
  | otherwise = "First"
  where odds = length $ filter odd xs

main = do
  B.getLine >> B.getLine >>= putStrLn.solve.map (fst.fromJust.readInt).words

import Control.Applicative( (<$>))
import Data.List( foldl')
import Data.ByteString.Char8( readInt, getLine, words	)
import qualified Data.ByteString.Char8 as C8
import Data.Maybe( fromJust)

main = do
    let
	readBS2Int = fst . fromJust . readInt
	readLine2Ints = map readBS2Int . C8.words <$> C8.getLine
    _n_ <- readLn::IO Int
    as_ <- readLine2Ints
    let
	isOdds = odd <$> as_

	initNumOdds = foldl' f 0 isOdds
			where
			    f v a = if a then v+1 else v

	initOdd = odd initNumOdds

    putStr $ if initOdd
		then "First"
		else if initNumOdds /= 0
		    then "First"
		    else "Second"

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

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

readInt = fst . M.fromJust . C.readInt

main = do
    B.getLine
    (dropWhile (even . readInt) . C.words -> odds) <- B.getLine
    putStrLn $ if null odds then "Second" else "First"

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

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

readInt = fst . M.fromJust . C.readInt

main = do
    B.getLine
    (length . filter odd . map readInt . C.words -> nodd) <- B.getLine
    putStrLn $ if nodd > 0 then "First" else "Second"

-- 841B

{-# LANGUAGE OverloadedStrings #-}

import Data.ByteString.Lazy.Char8 (ByteString(..), readInt, words, interact)
import Data.Maybe
import Prelude hiding (interact, words)

main = getLine >> (interact $ f . words)

f :: [ByteString] -> ByteString
f nums = if any isOdd nums
         then "First\n"
         else "Second\n"

isOdd = odd . fst . fromJust . readInt

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd (sum xs) || all even xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad.Trans.State.Lazy
import Control.Monad
import Data.Int

main =  putStr . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  xs <- replicateM n $ fmap to64 poi
  return $ if odd $ sum xs then "First" else "Second"
  where
    pop = state $ \(x:xs) -> (x, xs)
    poi = fmap int pop
    int = maybe undefined fst . B.readInt

to64 x = fromIntegral x :: Int64

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Integer] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "First\n"
         else "Second\n"

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Int] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "First\n"
         else "Second\n"

-- 841B

main :: IO ()
main = getLine >> (interact $ f . map read . words)

f :: [Int] -> String
f nums = if (odd . sum . map (`mod` 2) $ nums)
         then "Second\n"
         else "First\n"