Tom loves vowels, and he likes long words with many vowels. His favorite words are vowelly words. We say a word of length $$$k$$$ is vowelly if there are positive integers $$$n$$$ and $$$m$$$ such that $$$n\cdot m = k$$$ and when the word is written by using $$$n$$$ rows and $$$m$$$ columns (the first row is filled first, then the second and so on, with each row filled from left to right), every vowel of the English alphabet appears at least once in every row and every column.You are given an integer $$$k$$$ and you must either print a vowelly word of length $$$k$$$ or print $$$-1$$$ if no such word exists.In this problem the vowels of the English alphabet are 'a', 'e', 'i', 'o' ,'u'.

Input consists of a single line containing the integer $$$k$$$ ($$$1\leq k \leq 10^4$$$) — the required length.

The output must consist of a single line, consisting of a vowelly word of length $$$k$$$ consisting of lowercase English letters if it exists or $$$-1$$$ if it does not. If there are multiple possible words, you may output any of them.

NoteIn the second example, the word "agoeuioaeiruuimaeoieauoweouoiaouimae" can be arranged into the following $$$6 \times 6$$$ grid:  It is easy to verify that every row and every column contain all the vowels.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	k <- readInt
	let
		res = solve k
	putStrLn $ if null res
		then "-1"
		else head res

solve k = do
	h <- [ 1 .. k ]
	guard $ k `mod` h == 0
	let
		w = k `div` h
	guard $ 5 <= min h w
	return $ concat $ map ( take w ) $ take h $ tails $ cycle "aeiou"


The flag of Berland is such rectangular field n × m that satisfies following conditions:  Flag consists of three colors which correspond to letters 'R', 'G' and 'B'.  Flag consists of three equal in width and height stripes, parralel to each other and to sides of the flag. Each stripe has exactly one color.  Each color should be used in exactly one stripe. You are given a field n × m, consisting of characters 'R', 'G' and 'B'. Output "YES" (without quotes) if this field corresponds to correct flag of Berland. Otherwise, print "NO" (without quotes).

The first line contains two integer numbers n and m (1 ≤ n, m ≤ 100) — the sizes of the field. Each of the following n lines consisting of m characters 'R', 'G' and 'B' — the description of the field.

Print "YES" (without quotes) if the given field corresponds to correct flag of Berland . Otherwise, print "NO" (without quotes).

6 7
RRRGGGG
RRRGGGG
RRRGGGG
RRRBBBB
RRRBBBB
RRRBBBB

NoteThe field in the third example doesn't have three parralel stripes.Rows of the field in the fourth example are parralel to each other and to borders. But they have different heights — 2, 1 and 1.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

readInt = ( readLn :: IO Int )
readInts = map ( read :: String -> Int ) . words <$> getLine

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

which a b f = if f then a else b
mp [ a, b ] = ( a, b )

main = do
	getLine
	board <- lines <$> getContents
	putStrLn $ which "YES" "NO" $ correct_flag board || correct_flag ( transpose board )

correct_flag board
	| has_valid_lines board && three_colored board = let hs = map length . group . map head $ board in length hs == 3 && ( ( == 1 ) . length . group . sort $ hs )
	| otherwise = False
	where
		has_valid_lines = all ( ( == 1 ) . length . group )
		three_colored = ( == 3 ) . length . group . sort . map ( ord . head )

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok :: [String] -> Bool
ok f = sort (map (head . head) gs) == sort ['B', 'R', 'G'] && allEq (map length gs) && all (allEq . concat) gs
  where gs = group f
allEq :: Eq a => [a] -> Bool
allEq = null . tail . nub

import           Control.Monad
import           Data.Set      (Set)
import qualified Data.Set      as Set

colors :: [String] -> Int -> Int -> Int -> Int -> Set Char
colors s n n' m m' = foldl (\r (i, j) -> Set.insert (s !! i !! j) r)
                     Set.empty [(i, j) | (i, j) <- idx]
  where idx = [(i, j) | i <- [n..n'-1], j <- [m..m'-1]]

main :: IO ()
main = do
  line <- getLine
  let [n, m] = map read (words line)
  flag <- replicateM n getLine
  let sa = colors flag 0 (n `div` 3) 0 m
  let sb = colors flag (n `div` 3) (2 * (n `div` 3)) 0 m
  let sc = colors flag (2 * (n `div` 3)) n 0 m
  let ta = colors flag 0 n 0 (m `div` 3)
  let tb = colors flag 0 n (m `div` 3) (2 * (m `div` 3))
  let tc = colors flag 0 n (2 * (m `div` 3)) m
  let b = ((n `mod` 3 == 0) &&
            (Set.size sa == 1) &&
            (Set.size sb == 1) &&
            (Set.size sc == 1) &&
            (Set.size (Set.unions [sa, sb, sc]) == 3)) ||
          ((m `mod` 3 == 0) &&
           (Set.size ta == 1) &&
           (Set.size tb == 1) &&
           (Set.size tc == 1) &&
           (Set.size (Set.unions [ta, tb, tc]) == 3))
  if b then putStrLn "YES" else putStrLn "NO"

import Data.List
import Control.Monad

main =
  do
    nks <- getLine
    let [n, k] = map read $ words nks

    flag <- forM [1..n] (\x -> getLine)
    let g1 = group flag
        g2 = group.transpose $ flag

    let t1 = length $ group.sort $ g1
        t2 = length $ group.sort $ g2

    let s1 = map length g1
        s2 = map length g2

    if (t1 == 1 || t1 == 3) && (t2 == 1 || t2 == 3)
       then if length s1 == 1 && length s2 == 3 && (length.group $ s2) == 1
         then putStrLn "YES"
         else
         if length s2 == 1 && length s1 == 3 && (length.group $ s1) == 1
           then putStrLn "YES"
           else putStrLn "NO"
       else putStrLn "NO"

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok :: [String] -> Bool
ok f = sort (map (head . head) gs) == sort "RGB" && allEq (map length gs) && all (allEq . concat) gs
  where gs = group f
allEq :: Eq a => [a] -> Bool
allEq = null . tail . nub

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import Data.List
main = getContents >>= putStr . (\(_:_:f) -> if ok f || ok (transpose f) then "YES" else "NO") . words
ok f = (\(x:xs) -> all (== x) xs) (map length gs) && length gs == 3
  where gs = group f

import Data.List
import Control.Monad

main =
  do
    nks <- getLine
    let [n, k] = map read $ words nks

    flag <- forM [1..n] (\x -> getLine)
    let s1 = map length $ group flag
        s2 = map length $ group.transpose $ flag

    if length s1 == 1 && length s2 == 3 && (length.group $ s2) == 1
       then putStrLn "YES"
       else
       if length s2 == 1 && length s1 == 3 && (length.group $ s1) == 1
          then putStrLn "YES"
          else putStrLn "NO"


n soldiers stand in a circle. For each soldier his height ai is known. A reconnaissance unit can be made of such two neighbouring soldiers, whose heights difference is minimal, i.e. |ai - aj| is minimal. So each of them will be less noticeable with the other. Output any pair of soldiers that can form a reconnaissance unit.

The first line contains integer n (2 ≤ n ≤ 100) — amount of soldiers. Then follow the heights of the soldiers in their order in the circle — n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 1000). The soldier heights are given in clockwise or counterclockwise direction.

Output two integers — indexes of neighbouring soldiers, who should form a reconnaissance unit. If there are many optimum solutions, output any of them. Remember, that the soldiers stand in a circle.

main = do
	getLine
	a <- fmap (zip [1 ..] . map read . words) getLine
	putStrLn $ unwords $ map show $ (\(_,(a,b))->[a,b]) $ minimum $ gao $ last a : a
gao :: [(Int, Int)] -> [(Int, (Int, Int))]
gao ((a,b):x@((c,d):_)) = (abs(b-d),(a,c)): gao x
gao _ = []

main = do
	a<-getLine
	b<-getLine
	let c = words b
	let (n1,n2)=solve3 (map read c)
	putStrLn $ (show n1)++" "++ (show n2)

solve [] = []
solve (s1:[]) = []
solve (s1:s2:ss) = [dist] ++ solve (s2:ss)
	 where dist = abs (s1 - s2)

solve2 s = solve s ++ [(abs (head s - last s))]

solve3 s = if pairNum+1 == length s then (1,length s)
	       else (pairNum+1,pairNum+2)
     where mdist = minimum (solve2 s)
           pairNum = length $takeWhile (/=mdist) (solve2 s)

import qualified Data.List as List

rotate xs = tail xs ++ [head xs]

min_diff = List.minimumBy (\(_, a) (_, b) -> compare a b)
height_diff (a, b) = abs (a - b)
neighbours heights ct = zip (zip [1..ct] (rotate [1..ct])) (map height_diff (zip heights (rotate heights)))

print_result heights count =
    let ((s1, s2), _) = min_diff (neighbours heights count) in
    show s1 ++ " " ++ show s2

main :: IO ()
main = do
  soldier_count <- getLine >>= return . read
  heights <- getLine >>= return . (map read . words)
  putStr (print_result heights soldier_count)

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

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

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

main = do
  n <- readLn
  xs <- getInts

  let
    next i = (i+1) `mod` n
    i = minimumBy (compare `on` f) [0..n-1]
      where
        f :: Int -> Int
        f i = abs (xs!!i - xs!!j) where j = next i

  putStrLn $ show (i+1) ++ " " ++ show (next i + 1)

rec :: [Int] -> Int
rec (x1 : (x2 : xs)) = min (rec (x2 : xs)) (abs (x1 - x2))
rec _ = maxBound

fld :: [Int] -> Int
fld xs = abs ((head xs) - (last xs))

md :: [Int] -> Int
md xs = min (fld xs) (rec xs)

fnd :: Int -> Int -> [Int] -> [Int]
fnd i d (x1 : (x2 : xs))
  | d == abs (x2 - x1) = [i, i + 1]
  | otherwise = fnd (i + 1) d (x2 : xs)

solve :: [Int] -> [Int]
solve xs
  | fld xs == md xs = [1, length xs]
  | otherwise = fnd 1 (md xs) xs

io :: String -> String
io s = unwords $ map show $ solve $ map (read :: String -> Int) $ words $ head $ drop 1 $ lines s

main :: IO ()
main = do
  interact io

main = do
	n <- readLn
	s <- getLine
	let q = solve n (map read (words s))
	putStr (show (fst q) ++ " " ++ show (snd q))
solve :: Int -> [Int] -> (Int, Int)
solve n sp = let s = zipWith (\a b -> abs (a - b)) sp (tail $ cycle sp);
				 a = f (minimum s) s
			 in (a, if a == n then 1 else (a + 1))
f x (s:ss)
	| x == s = 1
	| otherwise = 1 + f x ss

getDifference :: [Int] -> [Int]
getDifference a = solve_ (head a) a
  where
    solve_ a1 [a2] = [abs(a1 - a2)]
    solve_ a1 (a2:a3:as) = (abs(a2-a3)):(solve_ a1 (a3:as))

findMin :: [Int] -> Int
findMin a = fst (findMin2 1 (0, head a) (tail a))
  where
    findMin2 :: Int -> (Int, Int) -> [Int] -> (Int, Int)
    findMin2 _ (n, m) [] = (n, m)
    findMin2 cur (n, m) (a:as) = if a < m then findMin2 (cur + 1) (cur, a) as else findMin2 (cur + 1) (n, m) as

solve :: Int -> Int -> String
solve len num = if len == num then "1 " ++ show num else (show num) ++ " " ++ show (num + 1)

main = do
    n <- readLn::(IO Int)
    line <- getLine
    let a = map read (words line)
    putStrLn (solve n (1 + findMin (getDifference a)))

import Control.Monad
import Control.Applicative
import Control.Arrow

import Data.List
import Data.Function

main = do
  n <- read <$> getLine :: IO [Int]
  h:hs <- zip [1..] . map read . words <$> getLine :: IO [(Int, Int)]
  let heights = h:hs ++ [h]
      diff (a, b) (c, d) = ((a,c), abs (b-d))
      dhs = zipWith diff heights (tail heights)
      ((i, j), _) = minimumBy (compare `on` snd) dhs
  putStrLn $ show i ++ " " ++ show j

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = putStrLn <$> unwords <$> map show =<< solve <$> readLn <*> (map read <$> words <$> getLine)

solve :: Integer -> [Integer] -> [Integer]
solve n as = snd $ minimum [ (abs (a - b), [ i, i `mod` n + 1 ]) | (i, a, b) <- zip3 [1..] as (tail $ cycle as) ]

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = solve <$> readLn <*> (map read . words <$> getLine) >>= putStrLn . unwords . map show

solve :: Integer -> [Integer] -> [Integer]
solve n as = snd $ minimum [ (abs (a - b), [ i, i `mod` n + 1 ]) | (i, a, b) <- zip3 [1..] as (tail $ cycle as) ]

import Data.List
main = do
  n <- readLn
  ss <- fmap (map read . words) getLine
  let ds = map abs $ zipWith (-) ss (last ss : ss)
      Just k = findIndex (== minimum ds) ds
  putStrLn $ show ((k - 1) `mod` n + 1) ++ " " ++ show (k + 1)

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:b:xs) = (func' b) ++ (func xs)
                where
                  func' = solve.map toInt.words
func _        = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[Int]->String
solve = unwords.map toString.findAns
          where
            findAns' (x:xs) = findMin (diff (x:xs++[x]))
            findAns a | n == (length a) = n:1:[]
                      | otherwise       = n:(n+1):[]
                      where
                        n = findAns' a

diff (a:b:xs) = (abs (a-b)):diff (b:xs)
diff _        =  []

findMin::[Int]->Int
findMin = snd.findMin' 1
          where
            findMin'::Int->[Int]->(Int,Int)
            findMin' a (b:c:xs) | b < (fst next) = (b, a)
                                | otherwise      = next
                              where
                                  next = (findMin' (a+1) (c:xs))
            findMin' a (b:xs)                    =  (b,a)

import Prelude
import List
import Char

main = interact q

q = func.lines

func::[String]->String
func (a:b:xs) = (func' b)
                where
                  func' = solve.map toInt.words
func _        = ""

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve::[Int]->String
solve = unwords.map toString.findAns
          where
            findAns' (x:xs) = findMin (diff (x:xs++[x]))
            findAns a | n == (length a) = n:1:[]
                      | otherwise       = n:(n+1):[]
                      where
                        n = findAns' a

diff (a:b:xs) = (abs (a-b)):diff (b:xs)
diff _        =  []

findMin::[Int]->Int
findMin = snd.findMin' 1
          where
            findMin'::Int->[Int]->(Int,Int)
            findMin' a (b:c:xs) | b < (fst next) = (b, a)
                                | otherwise      = next
                              where
                                  next = (findMin' (a+1) (c:xs))
            findMin' a (b:xs)                    =  (b,a)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
-- import qualified Data.ByteString.Char8 as BS
import Text.Printf

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n <- readLn
  ps@(p : _) <- zip [1 ..] . take n <$> readData
  let check (i, x) (j, y) = ((i, j), abs (x - y))
      xs = zipWith check ps (tail ps ++ [p])
      answer@(i, j) = fst $ minimumBy (comparing snd) xs
  printf "%d %d\n" (i :: Int) (j :: Int)

main = interact f

f s =
    let w = words s
        x = read (head w)
        y = map read (tail w)
        p = recon x y
    in show (fst p) ++ " " ++ show (snd p)

recon :: Int -> [Int] -> (Int, Int)
recon n (x:xs) = let fperson = snd(subrecon n 0 ((x:xs)++ [x])) + 1
                 in
                 if n == fperson
                 then (fperson, 1)
                 else (fperson, fperson+1)

subrecon n c (x:x':xs)
    | c < n-1         = pairmin  (abs(x - x'),c) (subrecon n (c + 1) (x':xs) )
    | otherwise       = (abs(x - x'),c)

pairmin :: (Int,a) -> (Int,a) -> (Int,a)
pairmin (a,x) (b,x')
    | a < b           = (a,x)
    | otherwise       = (b,x')

getnum :: IO [Int]
getnum = fmap (map read . words) getLine

get n num = minimum s
    where s = (f (last num) (head num), n, 1) : zip3 left [1..] [2..]
          left = zipWith f num (tail num)
          f a b = abs $ a - b

ans (_, a, b) = show a ++ " " ++ show b

main = do
    n <- readLn
    num <- getnum
    putStrLn . ans $ get n num

main = interact (ans)
ans theInput = unwords [show ans0,show $ mod ans0 n + 1] where
  [[n],a] = map ( map (read::String->Int)) $ map words $ lines theInput
  a0 = zip a [1..]
  a1 = [(abs (x-y),u)|((x,u),(y,v))<-zip a0 (tail $ a0 ++ [head a0])]
  ans0 = snd $ foldl1 min a1

main = interact (ans)
ans theInput = unwords [show ans0,show $ mod ans0 n + 1] where
  theLines = lines theInput
  n = read (head theLines) ::Int
  a = zip (map (read ::String->Int) (take n $ words $ theLines !! 1)) [1..]
  a0 = a ++ [head a]
  a1 = zip a0 (tail a0)
  a2 = [(abs (x-y),u)|((x,u),(y,v))<-a1]
  minfst (x,u) (y,v) = if x<y then (x,u) else (y,v)
  ans0 = snd $ foldl1 minfst a2

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

main = do
		n<- read <$> getLine::IO Int
		x<- map read <$> words <$> getLine ::IO [Int]
		let c=(zipWith (\a b-> abs (a-b)) x (tail x))
		let d = c ++ [abs (head x - last x)]
		let e = minimum d
		let f = fromJust $elemIndex e d

		putStrLn $ intercalate " " $ map show [f+1, 1+ mod (f+1) n]

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

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

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

main = do
  getLine
  xs <- getInts

  let
    (a, b) = minimumBy (compare `on` (\(a, b) -> abs $ a-b)) $ zip xs (tail xs ++ [head xs])
    i = fromJust (a `elemIndex` xs)
    j = length xs - 1 - fromJust (b `elemIndex` (reverse xs))

  putStrLn $ show (i+1) ++ " " ++ show (j+1)

main = do
    n <- readLn
    s <- getLine
    let q = solve n (map read (words s))
    putStr (show (fst q) ++ " " ++ show (snd q))
solve :: Int -> [Int] -> (Int, Int)
solve n sp = let s = zipWith (+) sp (tail $ cycle sp);
                 a = f (minimum s) s
             in (a, if a == n then 1 else (a + 1))
f x (s:ss)
    | x == s = 1
    | otherwise = 1 + f x ss

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

main = do
		n<- read <$> getLine::IO Int
		x<- map read <$> words <$> getLine ::IO [Int]
		let c=(zipWith (\a b-> abs (a-b)) x (tail x))
		let d = c ++ [abs (head x - last x)]
		let e = minimum d
		let f = fromJust $elemIndex e d

		putStrLn $ intercalate " " $ map show [f+1, mod (f+2) n]


Multiset —is a set of numbers in which there can be equal elements, and the order of the numbers does not matter. Two multisets are equal when each value occurs the same number of times. For example, the multisets $$$\{2,2,4\}$$$ and $$$\{2,4,2\}$$$ are equal, but the multisets $$$\{1,2,2\}$$$ and $$$\{1,1,2\}$$$ — are not.You are given two multisets $$$a$$$ and $$$b$$$, each consisting of $$$n$$$ integers.In a single operation, any element of the $$$b$$$ multiset can be doubled or halved (rounded down). In other words, you have one of the following operations available for an element $$$x$$$ of the $$$b$$$ multiset:   replace $$$x$$$ with $$$x \cdot 2$$$,  or replace $$$x$$$ with $$$\lfloor \frac{x}{2} \rfloor$$$ (round down).  Note that you cannot change the elements of the $$$a$$$ multiset.See if you can make the multiset $$$b$$$ become equal to the multiset $$$a$$$ in an arbitrary number of operations (maybe $$$0$$$).For example, if $$$n = 4$$$, $$$a = \{4, 24, 5, 2\}$$$, $$$b = \{4, 1, 6, 11\}$$$, then the answer is yes. We can proceed as follows:   Replace $$$1$$$ with $$$1 \cdot 2 = 2$$$. We get $$$b = \{4, 2, 6, 11\}$$$.  Replace $$$11$$$ with $$$\lfloor \frac{11}{2} \rfloor = 5$$$. We get $$$b = \{4, 2, 6, 5\}$$$.  Replace $$$6$$$ with $$$6 \cdot 2 = 12$$$. We get $$$b = \{4, 2, 12, 5\}$$$.  Replace $$$12$$$ with $$$12 \cdot 2 = 24$$$. We get $$$b = \{4, 2, 24, 5\}$$$.  Got equal multisets $$$a = \{4, 24, 5, 2\}$$$ and $$$b = \{4, 2, 24, 5\}$$$.

The first line of input data contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) —the number of test cases. Each test case consists of three lines. The first line of the test case contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) —the number of elements in the multisets $$$a$$$ and $$$b$$$. The second line gives $$$n$$$ integers: $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_1 \le a_2 \le \dots \le a_n \le 10^9$$$) —the elements of the multiset $$$a$$$. Note that the elements may be equal. The third line contains $$$n$$$ integers: $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_1 \le b_2 \le \dots \le b_n \le 10^9$$$) — elements of the multiset $$$b$$$. Note that the elements may be equal. It is guaranteed that the sum of $$$n$$$ values over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print on a separate line:   YES if you can make the multiset $$$b$$$ become equal to $$$a$$$,  NO otherwise.  You can output YES and NO in any case (for example, strings yEs, yes, Yes and YES will be recognized as positive answer).

NoteThe first example is explained in the statement.In the second example, it is impossible to get the value $$$31$$$ from the numbers of the multiset $$$b$$$ by available operations.In the third example, we can proceed as follows:   Replace $$$2$$$ with $$$2 \cdot 2 = 4$$$. We get $$$b = \{4, 14, 14, 26, 42\}$$$.  Replace $$$14$$$ with $$$\lfloor \frac{14}{2} \rfloor = 7$$$. We get $$$b = \{4, 7, 14, 26, 42\}$$$.  Replace $$$26$$$ with $$$\lfloor \frac{26}{2} \rfloor = 13$$$. We get $$$b = \{4, 7, 14, 13, 42\}$$$.  Replace $$$42$$$ with $$$\lfloor \frac{42}{2} \rfloor = 21$$$. We get $$$b = \{4, 7, 14, 13, 21\}$$$.  Replace $$$21$$$ with $$$\lfloor \frac{21}{2} \rfloor = 10$$$. We get $$$b = \{4, 7, 14, 13, 10\}$$$.  Got equal multisets $$$a = \{4, 7, 10, 13, 14\}$$$ and $$$b = \{4, 7, 14, 13, 10\}$$$.

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

-- debug x t = x
-- trace t x = x
-- tracing t x = x
-- debugging x t = x

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> [Int] -> [Int] -> Bool
solve n as bs = solve' (reverse aPrefixes) (S.fromList $ L.zip bPrefixes [1 .. n])
    where
        ridOf2 :: Int -> Int
        ridOf2 x
            | odd x     = x
            | otherwise = ridOf2 $ x `div` 2

        maskOff :: Int -> Int
        maskOff x = L.foldl1' (.|.) $ map (\s -> x `shiftR` s) [0 .. 31]

        aPrefixes :: [Int]
        aPrefixes = (sort $ map ridOf2 as)
            -- `debugging` "aPrefixes"

        bPrefixes :: [Int]
        bPrefixes = (sort $ map ridOf2 bs)
            -- `debugging` "bPrefixes"

        solve' :: [Int] -> S.Set (Int, Int) -> Bool
        solve' [] _ = True
        solve' aPrefixes@(a:otherAPrefixes) bSet = fromMaybe False $ do
            (bPrefix, resultBSet) <- extractByPrefix bSet (maskOff a) a
            -- traceM $ "for a = " ++ show a ++ " prefix -> bPrefix " ++ show bPrefix
            return $ solve' otherAPrefixes resultBSet

        extractByPrefix :: S.Set (Int, Int) -> Int -> Int -> Maybe (Int, S.Set (Int, Int))
        extractByPrefix _ _ xPrefix | xPrefix > 1_000_000_000 = Nothing
        extractByPrefix s mask xPrefix = answerTry `mplus` extractByPrefix s (mask `shiftL` 1) (xPrefix `shiftL` 1)
            where
                answerTry :: Maybe (Int, S.Set (Int, Int))
                answerTry = do
                    (x, i) <- S.lookupGE (xPrefix, -1) s
                    -- traceM $ "answerTry s = " ++ show s ++ ", mask = " ++ show mask ++ ", xPrefix = " ++ show xPrefix
                    -- traceM $ "(x, i) = " ++ show (x, i)
                    guard $ countLeadingZeros x == countLeadingZeros xPrefix
                    guard $ (x .&. mask) == xPrefix
                    let resultS = S.delete (x, i) s
                    return (x, resultS)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        bs <- B8.getLine <&> readIntB8s
        let answer = solve n as bs
        putsYesNo answer


You are given an array $$$a$$$ of length $$$n$$$.You are also given a set of distinct positions $$$p_1, p_2, \dots, p_m$$$, where $$$1 \le p_i < n$$$. The position $$$p_i$$$ means that you can swap elements $$$a[p_i]$$$ and $$$a[p_i + 1]$$$. You can apply this operation any number of times for each of the given positions.Your task is to determine if it is possible to sort the initial array in non-decreasing order ($$$a_1 \le a_2 \le \dots \le a_n$$$) using only allowed swaps.For example, if $$$a = [3, 2, 1]$$$ and $$$p = [1, 2]$$$, then we can first swap elements $$$a[2]$$$ and $$$a[3]$$$ (because position $$$2$$$ is contained in the given set $$$p$$$). We get the array $$$a = [3, 1, 2]$$$. Then we swap $$$a[1]$$$ and $$$a[2]$$$ (position $$$1$$$ is also contained in $$$p$$$). We get the array $$$a = [1, 3, 2]$$$. Finally, we swap $$$a[2]$$$ and $$$a[3]$$$ again and get the array $$$a = [1, 2, 3]$$$, sorted in non-decreasing order.You can see that if $$$a = [4, 1, 2, 3]$$$ and $$$p = [3, 2]$$$ then you cannot sort the array.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le m < n \le 100$$$) — the number of elements in $$$a$$$ and the number of elements in $$$p$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 100$$$). The third line of the test case contains $$$m$$$ integers $$$p_1, p_2, \dots, p_m$$$ ($$$1 \le p_i < n$$$, all $$$p_i$$$ are distinct) — the set of positions described in the problem statement.

For each test case, print the answer — "YES" (without quotes) if you can sort the initial array in non-decreasing order ($$$a_1 \le a_2 \le \dots \le a_n$$$) using only allowed swaps. Otherwise, print "NO".

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import Data.Ord
import Data.Int
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if s then
                aux s
            else
                return id
        else
            liftM ((.) $ showChar x) $ aux False
    in liftM (flip ($) []) $ aux True

type EIO a = ExceptT String IO a

data HNormal
data HString
data HList

class IOInteract a where
    convertEither :: String -> Either String a
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convertEither = convertEitherp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertEitherp :: flag -> String -> Either String a
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertEitherp _ x = readEither x
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertEitherp _ x = Right x
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertEitherp _ x = mapM convertEither $ words x
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => EIO a
get = ExceptT $ liftM convertEither getToken
put :: IOInteract a => a -> EIO ()
put = lift . putStr . toShow
putln :: IOInteract a => a -> EIO ()
putln = lift . putStrLn . toShow

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
-- template --
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    (n, m) <- liftM2 (,) get get
    a <- replicateM n get
    p <- replicateM m get
    putln $ if f2 a p then "YES" else "NO"

f2 :: [Int] -> [Int] -> Bool
f2 a p =    let pk = runSTUArray $ do
                a <- newArray (1, 101) 0 :: ST s (STUArray s Int Int)
                forM_ p (\c -> writeArray a c 1)
                return a
            in
            let ax = zip a [1..] in
            all (\(ai, i) ->
                all (\(aj, j) ->
                    if i < j && ai > aj then
                        all (\k ->
                            pk ! k /= 0)
                        [i..j-1]
                    else True
                ) ax
            ) ax

import Data.List as L

subarrays' :: [Int] -> [(Int, Int)] -> Int -> Int -> [(Int, Int)]
subarrays' [] acc l r = (l,r):acc
subarrays' (x:xs) acc l r
  | x == r+1 = subarrays' xs acc l x
  | r < l = subarrays' xs acc x x
  | otherwise = subarrays' xs ((l, r):acc) x x

subarrays :: [Int] -> [(Int, Int)]
subarrays [] = []
subarrays xs = L.map (\(l, r) -> (l, r+1)) (subarrays' array' [] 0 (-1))
  where array' = L.map (\x -> x - 1) $ L.sort xs

mysort :: [Int] -> [(Int, Int)] -> [Int]
mysort xs [] = xs
mysort xs ((l, r):rest) = mysort currAns rest
  where currAns = (L.take l xs) ++ (L.sort $ L.take (r-l+1) $ L.drop l xs) ++ (drop (r+1) xs)

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted (a:b:rest) = a <= b && isSorted (b:rest)

parse :: [String] -> String
parse [_, xs', ps'] = if ans then "YES" else "NO"
  where xs = toIntArray xs'
        ps = toIntArray ps'
        intervals = subarrays ps
        ans = isSorted $ mysort xs intervals

toIntArray :: String -> [Int]
toIntArray s = L.map (\x -> read x :: Int) $ words s

groupByNLines :: Int -> [String] -> [[String]]
groupByNLines _ [] = []
groupByNLines n ws = [L.take n ws] ++ groupByNLines n (L.drop n ws)

main :: IO ()
main = interact (unlines . L.map parse . groupByNLines 3 . tail . lines)


There are n integers b1, b2, ..., bn written in a row. For all i from 1 to n, values ai are defined by the crows performing the following procedure:  The crow sets ai initially 0.  The crow then adds bi to ai, subtracts bi + 1, adds the bi + 2 number, and so on until the n'th number. Thus, ai = bi - bi + 1 + bi + 2 - bi + 3.... Memory gives you the values a1, a2, ..., an, and he now wants you to find the initial numbers b1, b2, ..., bn written in the row? Can you do it?

The first line of the input contains a single integer n (2 ≤ n ≤ 100 000) — the number of integers written in the row. The next line contains n, the i'th of which is ai ( - 109 ≤ ai ≤ 109) — the value of the i'th number.

Print n integers corresponding to the sequence b1, b2, ..., bn. It's guaranteed that the answer is unique and fits in 32-bit integer type.

NoteIn the first sample test, the crows report the numbers 6, - 4, 8, - 2, and 3 when he starts at indices 1, 2, 3, 4 and 5 respectively. It is easy to check that the sequence 2 4 6 1 3 satisfies the reports. For example, 6 = 2 - 4 + 6 - 1 + 3, and  - 4 = 4 - 6 + 1 - 3.In the second sample test, the sequence 1,  - 3, 4, 11, 6 satisfies the reports. For example, 5 = 11 - 6 and 6 = 6.

import Data.List

main :: IO()
main = do
  n <- readLn :: IO Int
  arrays <- getLine
  putStrLn $ intercalate " " $ map show $ reverse . solve . reverse $ map read $ words arrays

solve ::[Int]->[Int]
solve a = zipWith (+) (0 : a) a

import Data.List

f ::Integer->Integer->[Integer]->[Integer]
f _ _ []=[]
f a d (x:xs)=(x+a+d):f (a+x) (-a)  xs

main = do
       a<-getLine
       b<-getLine
       let xs=map read (words b)::[Integer]
           ys=reverse xs
       putStrLn $ unwords $ map show $ reverse (f 0 0 ys)

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

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

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

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

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

  solve :: [Integer] -> [Integer]
  solve xs =
    let ys = zip xs (drop 1 xs)
        zs = map (\(x, y) -> -1 * (-x - y)) ys
        in (head xs):(zs)

  main :: IO()
  main = do
    n <- getLine >>= return . readInt
    xs <- getLine >>= return . map (read :: String -> Integer) . words
    let solution = (solve . reverse) $ xs
    putStrLn $ intercalate " " $ map show $ reverse solution

main = do
    n <- readLn::(IO Int)
    as <- return . map (read::String->Integer) . words =<< getLine
    let as' = as++[0]
	neighborPlus [a1,a2] = [a1+a2]
	neighborPlus (a1:tl@(a2:as)) = (a1+a2):neighborPlus tl
    mapM_ (putStr . (' ':) . show) $ neighborPlus as'

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

process [a] = putStrLn $ show  a
process (a:b:as) = do
			putStr $ show  (a+b)
			putStr " "
			process (b:as)

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

main = do
    n <- readLn::(IO Int)
    as <- return . map (read::String->Integer) . words =<< getLine
    let as' = as++[0]
	neighborPlus [a1,a2] = [a1+a2]
	neighborPlus (a1:tl@(a2:as)) = (a1+a2):neighborPlus tl
    print $ neighborPlus as'


Bob got a job as a system administrator in X corporation. His first task was to connect n servers with the help of m two-way direct connection so that it becomes possible to transmit data from one server to any other server via these connections. Each direct connection has to link two different servers, each pair of servers should have at most one direct connection. Y corporation, a business rival of X corporation, made Bob an offer that he couldn't refuse: Bob was asked to connect the servers in such a way, that when server with index v fails, the transmission of data between some other two servers becomes impossible, i.e. the system stops being connected. Help Bob connect the servers.

The first input line contains 3 space-separated integer numbers n, m, v (3 ≤ n ≤ 105, 0 ≤ m ≤ 105, 1 ≤ v ≤ n), n — amount of servers, m — amount of direct connections, v — index of the server that fails and leads to the failure of the whole system.

If it is impossible to connect the servers in the required way, output -1. Otherwise output m lines with 2 numbers each — description of all the direct connections in the system. Each direct connection is described by two numbers — indexes of two servers, linked by this direct connection. The servers are numbered from 1. If the answer is not unique, output any.

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m n i j
	| m == 0			= []
	| j > n				= getAns v w m n (i + 1) 1
	| i >= j			= getAns v w m n i (j + 1)
	| i == w			= getAns v w m n (i + 1) 1
	| j == w	        = getAns v w m n i (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) n i (j + 1))

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) n 1 1))

import List
import Control.Monad

makeList _ 0 = []
makeList (x:xs) m =
    [[x,y] | y <- rest] ++ makeList xs (m - length rest)
    where
      rest = take m xs

genBaseList n m =
    [0,n-1] : makeList [0..n-2] (m-1)

genList n m v =
    updateList (genBaseList n m) v n

updateList lst v n =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap (map read . words) getLine
      case (n-1 <= m && m <= ((n-1)*(n-2)) `div` 2 + 1) of
        True -> mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) (genList n m v))
        otherwise -> putStrLn ( show (-1) )

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m i j
	| m == 0			= []
	| i >= j			= getAns v w m 1 (j + 1)
	| i == w			= getAns v w m (i + 1) j
	| j == w	        = getAns v w m 1 (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) (i + 1) j)

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) 1 1))

other :: Int -> Int
other v
	| v == 1    = 2
	| otherwise = 1

getAns :: Int -> Int -> Int -> Int -> Int -> [(Int, Int)]
getAns v w m i j
	| m == 0			= []
	| i >= j			= getAns v w m 1 (j + 1)
	| i == v || i == w	= getAns v w m (i + 1) j
	| j == v || j == w	= getAns v w m 1 (j + 1)
	| otherwise			= (i, j) : (getAns v w (m - 1) (i + 1) j)

printAns :: [(Int, Int)] -> IO()
printAns ((a,b):xs) = do
	putStrLn ((show a) ++ " " ++ (show b))
	printAns xs
printAns _	= do
	putStr ""

main :: IO()
main = do
	str <- getLine
	let n = read ((words str) !! 0)
	let m = read ((words str) !! 1)
	let v = read ((words str) !! 2)
	let w = other v
	if (m < n - 1 || m > div (n * n - 3 * n + 4) 2)
		then putStrLn "-1"
		else printAns ((v, w):(getAns v w (m - 1) 1 1))

import List
import Control.Monad

makeList _ 0 = []
makeList (x:xs) m =
    [[x,y] | y <- rest] ++ makeList xs (m - length rest)
    where
      rest = take m xs

genBaseList n m =
    [0,n-1] : makeList [0..n-2] (m-1)

genList n m v =
    updateList (genBaseList n m) v n

updateList lst v n =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap (map read . words) getLine
      case (n-1 <= m && m <= ((n-1)*(n-2)) `div` 2) of
        True -> mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) (genList n m v))
        otherwise -> putStrLn ( show (-1) )

import List
import Numeric
import Control.Monad

fact 0 = 1;
fact n = n * fact (n-1)

comb k n = (fact n) `div` (fact k * fact (n-k))

good (n1, n2, m1, m2)
    | (n1 <= m1 && m1 <= cmb1) &&
      (n2 <= m2 && m2 <= cmb2) =
          ("YES", n1, n2, m1, m2)
    | otherwise =
        ("NO", n1, n2, m1, m2)
    where
      cmb1 = comb 2 (n1+1)
      cmb2 = comb 2 (n2+1)

check (n1, n2, m)
    | m2 >= cmb =
        good (n1, n2, m1 + m2 - cmb, cmb)
    | otherwise =
        good (n1, n2, m1, m2)
    where
      m1 = n1
      m2 = m - n1
      cmb = comb 2 (n1+1)

findBest (n,m) =
    if (null yesLst) then ("NO",1,1,1,1) else head yesLst
    where
      var = map check [(i, n-1-i, m) | i <- [2..n-3], i <= (n-1-i)]
      yesLst = filter (\(str,_,_,_,_) -> (str == "YES")) var

subSeq _ 0 = []
subSeq (x:xs) m =
    [[x,y] | y <- lst] ++ subSeq xs (m - length lst)
    where
      lst = take m xs

genSeq (_,n1,n2,m1,m2) =
    (subSeq (0:[n1+1..n1+n2]) m2) ++
    (subSeq (0:[1..n1]) m1)

addNum v n lst =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap ((map read) . words) getLine
      let tupleAnsw = findBest (n,m)
      case tupleAnsw of
        ("NO",_,_,_,_) ->
            putStrLn( show (-1) )
        otherwise ->
            do
              let answ = addNum v n $ genSeq tupleAnsw
              mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) answ)

import List
import Numeric
import Control.Monad

fact 0 = 1;
fact n = n * fact (n-1)

comb k n = (fact n) `div` (fact k * fact (n-k))

good (n1, n2, m1, m2)
    | (n1 <= m1 && m1 <= cmb1) &&
      (n2 <= m2 && m2 <= cmb2) =
          ("YES", n1, n2, m1, m2)
    | otherwise =
        ("NO", n1, n2, m1, m2)
    where
      cmb1 = comb 2 (n1+1)
      cmb2 = comb 2 (n2+1)

check (n1, n2, m)
    | m2 >= cmb =
        good (n1, n2, m1 + m2 - cmb, cmb)
    | otherwise =
        good (n1, n2, m1, m2)
    where
      m1 = n1
      m2 = m - n1
      cmb = comb 2 (n1+1)

findBest (n,m) =
    if (null yesLst) then ("NO",1,1,1,1) else head yesLst
    where
      var = map check [(i, n-1-i, m) | i <- [1..n-2], i <= (n-1-i)]
      yesLst = filter (\(str,_,_,_,_) -> (str == "YES")) var

subSeq _ 0 = []
subSeq (x:xs) m =
    [[x,y] | y <- lst] ++ subSeq xs (m - length lst)
    where
      lst = take m xs

genSeq (_,n1,n2,m1,m2) =
    (subSeq (0:[n1+1..n1+n2]) m2) ++
    (subSeq (0:[1..n1]) m1)

addNum v n lst =
    map (\[x,y] -> [f x, f y]) lst
    where
      f x = ((x+v-1) `rem` n) + 1

main =
    do
      [n,m,v] <- fmap ((map read) . words) getLine
      let tupleAnsw = findBest (n,m)
      case tupleAnsw of
        ("NO",_,_,_,_) ->
            putStrLn( show (-1) )
        otherwise ->
            do
              let answ = addNum v n $ genSeq tupleAnsw
              mapM_ putStrLn (map (\[x,y] -> show x ++ " " ++ show y) answ)


A chess tournament will be held soon, where $$$n$$$ chess players will take part. Every participant will play one game against every other participant. Each game ends in either a win for one player and a loss for another player, or a draw for both players.Each of the players has their own expectations about the tournament, they can be one of two types:  a player wants not to lose any game (i. e. finish the tournament with zero losses);  a player wants to win at least one game. You have to determine if there exists an outcome for all the matches such that all the players meet their expectations. If there are several possible outcomes, print any of them. If there are none, report that it's impossible.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 200$$$) — the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$2 \le n \le 50$$$) — the number of chess players. The second line contains the string $$$s$$$ ($$$|s| = n$$$; $$$s_i \in \{1, 2\}$$$). If $$$s_i = 1$$$, then the $$$i$$$-th player has expectations of the first type, otherwise of the second type.

For each test case, print the answer in the following format: In the first line, print NO if it is impossible to meet the expectations of all players. Otherwise, print YES, and the matrix of size $$$n \times n$$$ in the next $$$n$$$ lines. The matrix element in the $$$i$$$-th row and $$$j$$$-th column should be equal to:   +, if the $$$i$$$-th player won in a game against the $$$j$$$-th player;  -, if the $$$i$$$-th player lost in a game against the $$$j$$$-th player;  =, if the $$$i$$$-th and $$$j$$$-th players' game resulted in a draw;  X, if $$$i = j$$$.

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


You are given a decimal representation of an integer $$$x$$$ without leading zeros.You have to perform the following reduction on it exactly once: take two neighboring digits in $$$x$$$ and replace them with their sum without leading zeros (if the sum is $$$0$$$, it's represented as a single $$$0$$$).For example, if $$$x = 10057$$$, the possible reductions are:   choose the first and the second digits $$$1$$$ and $$$0$$$, replace them with $$$1+0=1$$$; the result is $$$1057$$$;  choose the second and the third digits $$$0$$$ and $$$0$$$, replace them with $$$0+0=0$$$; the result is also $$$1057$$$;  choose the third and the fourth digits $$$0$$$ and $$$5$$$, replace them with $$$0+5=5$$$; the result is still $$$1057$$$;  choose the fourth and the fifth digits $$$5$$$ and $$$7$$$, replace them with $$$5+7=12$$$; the result is $$$10012$$$. What's the largest number that can be obtained?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of testcases. Each testcase consists of a single integer $$$x$$$ ($$$10 \le x < 10^{200000}$$$). $$$x$$$ doesn't contain leading zeros. The total length of the decimal representations of $$$x$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

For each testcase, print a single integer — the largest number that can be obtained after the reduction is applied exactly once. The number should not contain leading zeros.

NoteThe first testcase of the example is already explained in the statement.In the second testcase, there is only one possible reduction: the first and the second digits.

-- |

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

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

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


You are given two strings $$$s$$$ and $$$t$$$, both consisting of lowercase English letters. You are going to type the string $$$s$$$ character by character, from the first character to the last one.When typing a character, instead of pressing the button corresponding to it, you can press the "Backspace" button. It deletes the last character you have typed among those that aren't deleted yet (or does nothing if there are no characters in the current string). For example, if $$$s$$$ is "abcbd" and you press Backspace instead of typing the first and the fourth characters, you will get the string "bd" (the first press of Backspace deletes no character, and the second press deletes the character 'c'). Another example, if $$$s$$$ is "abcaa" and you press Backspace instead of the last two letters, then the resulting text is "a".Your task is to determine whether you can obtain the string $$$t$$$, if you type the string $$$s$$$ and press "Backspace" instead of typing several (maybe zero) characters of $$$s$$$.

The first line contains a single integer $$$q$$$ ($$$1 \le q \le 10^5$$$) — the number of test cases. The first line of each test case contains the string $$$s$$$ ($$$1 \le |s| \le 10^5$$$). Each character of $$$s$$$ is a lowercase English letter. The second line of each test case contains the string $$$t$$$ ($$$1 \le |t| \le 10^5$$$). Each character of $$$t$$$ is a lowercase English letter. It is guaranteed that the total number of characters in the strings over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print "YES" if you can obtain the string $$$t$$$ by typing the string $$$s$$$ and replacing some characters with presses of "Backspace" button, or "NO" if you cannot. You may print each letter in any case (YES, yes, Yes will all be recognized as positive answer, NO, no and nO will all be recognized as negative answer).

4
ababa
ba
ababa
bb
aaa
aaaa
aababa
ababa

NoteConsider the example test from the statement.In order to obtain "ba" from "ababa", you may press Backspace instead of typing the first and the fourth characters.There's no way to obtain "bb" while typing "ababa".There's no way to obtain "aaaa" while typing "aaa".In order to obtain "ababa" while typing "aababa", you have to press Backspace instead of typing the first character, then type all the remaining characters.

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


The King of Berland Polycarp LXXXIV has $$$n$$$ daughters. To establish his power to the neighbouring kingdoms he wants to marry his daughters to the princes of these kingdoms. As a lucky coincidence there are $$$n$$$ other kingdoms as well.So Polycarp LXXXIV has enumerated his daughters from $$$1$$$ to $$$n$$$ and the kingdoms from $$$1$$$ to $$$n$$$. For each daughter he has compiled a list of kingdoms princes of which she wanted to marry.Polycarp LXXXIV is very busy, so he finds a couple for his daughters greedily one after another.For the first daughter he takes the kingdom with the lowest number from her list and marries the daughter to their prince. For the second daughter he takes the kingdom with the lowest number from her list, prince of which hasn't been taken already. If there are no free princes in the list then the daughter marries nobody and Polycarp LXXXIV proceeds to the next daughter. The process ends after the $$$n$$$-th daughter.For example, let there be $$$4$$$ daughters and kingdoms, the lists daughters have are $$$[2, 3]$$$, $$$[1, 2]$$$, $$$[3, 4]$$$, $$$[3]$$$, respectively.  In that case daughter $$$1$$$ marries the prince of kingdom $$$2$$$, daughter $$$2$$$ marries the prince of kingdom $$$1$$$, daughter $$$3$$$ marries the prince of kingdom $$$3$$$, leaving daughter $$$4$$$ nobody to marry to.Actually, before starting the marriage process Polycarp LXXXIV has the time to convince one of his daughters that some prince is also worth marrying to. Effectively, that means that he can add exactly one kingdom to exactly one of his daughter's list. Note that this kingdom should not be present in the daughter's list.Polycarp LXXXIV wants to increase the number of married couples.Unfortunately, what he doesn't have the time for is determining what entry to add. If there is no way to increase the total number of married couples then output that the marriages are already optimal. Otherwise, find such an entry that the total number of married couples increases if Polycarp LXXXIV adds it.If there are multiple ways to add an entry so that the total number of married couples increases then print any of them.For your and our convenience you are asked to answer $$$t$$$ independent test cases.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of daughters and the number of kingdoms. Each of the next $$$n$$$ lines contains the description of each daughter's list. The first integer $$$k$$$ ($$$0 \le k \le n$$$) is the number of entries in the $$$i$$$-th daughter's list. After that $$$k$$$ distinct integers follow $$$g_i[1], g_i[2], \dots, g_i[k]$$$ ($$$1 \le g_i[j] \le n$$$) — the indices of the kingdoms in the list in the increasing order ($$$g_i[1] < g_i[2] < \dots < g_i[k]$$$). It's guaranteed that the total number of daughters over all test cases does not exceed $$$10^5$$$. It's also guaranteed that the total number of kingdoms in lists over all test cases does not exceed $$$10^5$$$.

For each test case print the answer to it. Print "IMPROVE" in the first line if Polycarp LXXXIV can add some kingdom to some of his daughter's list so that the total number of married couples increases. The second line then should contain two integers — the index of the daughter and the index of the kingdom Polycarp LXXXIV should add to that daughter's list. If there are multiple ways to add an entry so that the total number of married couples increases then print any of them. Otherwise the only line should contain one word "OPTIMAL".

IMPROVE
4 4
IMPROVE
1 1
OPTIMAL
OPTIMAL
OPTIMAL

NoteThe first test case is depicted in the statement. Adding the fourth kingdom to the list of the fourth daughter makes her marry the prince of the fourth kingdom.In the second test case any new entry will increase the number of marriages from $$$0$$$ to $$$1$$$.In the third and the fourth test cases there is no way to add an entry.In the fifth test case there is no way to change the marriages by adding any entry.

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 :: 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 = 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)