import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in putStrLn (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (2-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) p  Already | x>y =  return False

swap u (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap' u (y:xs) last $ Value l x y
                                    False -> return False

swap u (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap' u (v:xs) (One x) Already
                                                  False ->  return False

swap u (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap' u (y:xs) (Mul n l) $ Value n x y
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap' u (x:xs) (Mul n l) Already
                                            False -> return False

swap u (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap' u  (v:xs) (Mul n l) Already
                                                  False ->  return False

swap u (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap' u (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap' u (v:y:xs) i Already
                                          False -> return False

swap u (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap' u (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap' u (v:y:xs) i Already
                                          False -> return False

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) (Mul n l) (Value bInf v bSup) = return $ (l<=bSup) && (v>=n)
swap u (x:[]) (One l) (Value bInf v bSup) = return $ ((x>=v) && (bSup==l)) || ((v>=l)&&(x>=bInf)&&(x<=bSup))
swap u (x:[]) i p = case p of
                   (Value bInf v bSup) -> return $  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap (y:xs) (Mul n l) p
                                      False -> swap (y:xs) (Mul x n) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap (y:xs) (Mul n l) $ Value n x y -- 3 9 [9 4] 10
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap (x:xs) (Mul n l) Already
                                            False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap (y:xs) (Mul n l) p
                              False ->  swap (y:xs) (One x) p

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) (Mul n l) (Value bInf v bSup) = (l<=bSup) && (v>=n)
swap (x:[]) (One l) (Value bInf v bSup) = ((x>=v) && (bSup==l)) || ((v>=l)&&(x>=bInf)&&(x<=bSup))
swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import Data.List (sort)

main = do
    getLine
    a <- fmap (map read . words) getLine :: IO [Int]
    let cnt = length $ filter id $ zipWith (/=) a $ sort a
    putStrLn $ if cnt <= 2 then "YES" else "NO"

import Data.List (sort)
main = interact $ f . map read . words . last . lines
f :: [Integer] -> String
f x
  | l1 <= 2 = "YES"
  | otherwise = "NO"
  where l1 = length $ filter (\(i,j) -> i/=j) $ zip x (sort x)

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

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

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

main = do
  getLine
  as <- getInts :: IO [Int]

  let
    bs = sort as
    c = length $ filter (== True) $ zipWith (/=) as bs

  putStrLn $ if c == 2 || c == 0 then "YES" else "NO"

import List (sort)

solve :: [Int] -> Bool
solve xs  =  solve' 0 xs (sort xs)
  where
    solve' n [] _  =  n <= 2
    solve' n (x:xs) (y:ys)
      | x == y  =  solve' n xs ys
      | n == 2  =  False
      | otherwise  =  solve' (n+1) xs ys

main :: IO ()
main  =  do
    getLine
    xs  <-  getLine >>= return . map read . words
    putStrLn $ if solve xs then "YES" else "NO"

import Data.List

solve :: [Int] -> String
solve xs = if x == 0 || x == 2 then "YES" else "NO"
  where x = length $ filter (\(x, y) -> x /= y) $ zip xs $ sort xs

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

import Control.Applicative
import Data.List

solve :: [Int] -> String
solve vals =
  if solvable then "YES" else "NO"
  where
    solvable = (length $ filter id $ zipWith (/=) vals (sort vals)) <= 2

main = do
  getLine
  vals <- map read . words <$> getLine
  putStrLn $ solve vals

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f [] [] count = count
f (a:ax) (b:bx) count = f ax bx ( if a /= b then count+1 else count )

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

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  _ <- getLine
  xs <- map readInt.B.words <$> B.getLine
  case filter id $ zipWith (/=) xs $ sort xs of
    [] -> putStrLn "YES"
    [True,True] -> putStrLn "YES"
    _ -> putStrLn "NO"

import Data.List
import qualified Data.ByteString.Char8 as B
import Control.Applicative
readInt bs = case B.readInt bs of Just (n,_) -> n
main = do
  _ <- getLine
  xs <- map readInt.B.words <$> B.getLine
  let count = length $ filter id $ zipWith (/=) xs $ sort xs
      answer = if count <= 2 then "YES" else "NO"
      in putStrLn answer

import Data.List(sort)
main = do
    _ <- getLine
    a <- fmap (\x -> map (read::String->Int) $ words x) getLine
    let s = sort a
        slv = zipWith (/=) a s
        num = length $ filter (id) slv

    case num of
        2   -> do putStrLn"YES"
        0   -> do putStrLn"YES"
        _   -> do putStrLn"NO"
    return ()

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = solver a b
      in putStrLn ( if k <= 2 then "YES" else "NO" )

solver a b = f a b 0
f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if or [null a, null b]
     then count
     else f (tail a) (tail b) ff
       where ff = if head a /= head b then count+1 else count

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

import Data.List
import Data.Char
import qualified Data.Set as Set
import Control.Monad
import Control.Applicative

main = do
  _ <- getLine
  xs <- fmap (map read . words) getLine :: IO [Int]
  let count = length $ filter id $ zipWith (/=) xs $ sort xs
      answer = if count <= 2 then "YES" else "NO"
      in putStrLn answer

import Data.List
import Data.Char
import qualified Data.Set as Set
import Control.Monad
import Control.Applicative
main = do
  n <- getLine
  s <- getLine
  let xs = map read (words s) :: [Int]
    in putStrLn (solve xs)

solve xs = if (f xs (sort xs) 0) <= 2 then "YES" else "NO"
  where
    f [] [] acc = acc
    f (x:xs) (y:ys) acc = f xs ys (if x /= y then acc+1 else acc)

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b =
  if or [null a, null b]
     then 0
     else ff + f (tail a) (tail b)
       where ff = if head a /= head b then 1 else 0

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      in putStrLn ( if (f a (sort a) 0) <= 2 then "YES" else "NO" )

f a b count =
  if null a || null b
     then count
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if head a /= head b then count+1 else count

import Data.Functor
import Data.List

main :: IO ()
main = do
  getLine
  ns <- map read . words <$> getLine
  if diff ns (sort ns) <= 2
    then putStrLn "YES"
    else putStrLn "NO"

diff :: [Int] -> [Int] -> Int
diff xs ys = length $ filter (uncurry (/=)) $ zip xs ys

import Data.List
g(_:l)|length(filter id$zipWith(/=)l(sort l))>2="NO"|1>0="YES"
main=interact$g.map((+0).read).words

import Data.List

f True = "YES"
f False = "NO"

main = getLine >> do
          xs <- (((map read).words) `fmap` getLine) :: IO [Int]
          putStrLn $ f $ (<=2) $ length $ filter id $ zipWith (/=) (sort xs) xs

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already | Switch Int Int Int
data Last = One Int | Mul Int Int

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (3-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap u (x:y:[]) (One l)  None | x>y = return $ y>= l
swap u (x:y:[]) (Mul i l)  None | x>y = return $ y>= l

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) i  Already | x>y =  return False

swap u (x:y:xs) i None | x>y =  case (y>=(getLast i)) of
                               True -> case xs of
                                  []  -> return True
                                  (z:zs) | z>=x -> swap' u (z:zs) (One x) $ Switch (getN i) y x
                                  (z:zs) | otherwise -> case i of
                                             Mul n _ ->  case (n==x) of
                                                          True -> return False
                                                          False -> swap' u (y:xs) i $ Value n x y
                                             One n -> swap' u (y:xs) i $ Value n x y
                               False -> return False

swap u (x:y:xs) i (Switch bInf a b) | x>y = return $  (b>=x)&&(y<=a)&&(y>=bInf)

swap u (x:y:xs) i p@(Value bInf v bSup) | x>y = case ((y>=bInf) && (y<=bSup) && (v>=(getN i))) of
                                               False -> return False
                                               True -> swap' u (v:xs) (One x) Already

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) i (Value bInf v bSup) = return $  ((bSup==(getN i))&&(v<=x)) || ((v>(getN i)) && (x>=bInf) && (x<= bSup))
swap u (x:[]) i p = return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

getLast (One n) = n
getLast (Mul n l) = l

import qualified Data.ByteString.Char8 as B
import Control.Applicative

readInt bs = case B.readInt bs of Just (n,_) -> n

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  case filter id $ zipWith (/=) [1..n] xs of
    [] -> putStrLn "YES"
    [True,True] -> putStrLn "YES"
    _ -> putStrLn "NO"

import Data.List(sort)
main = do
    _ <- getLine
    a <- fmap (\x -> map (read::String->Int) $ words x) getLine
    let s = sort a
        slv = zipWith (/=) a s
        num = length $ filter (id) slv

    case num of
        2   -> do putStrLn"YES"
        _   -> do putStrLn"NO"
    return ()

import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in putStrLn $ show (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null ax || null bx
     then count
     else f ax bx ( if a /= b then count+1 else count )
       where ax = tail a
	     bx = tail b

import Data.List

main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = foldl' (ff) 0 (zip a b)
      in print (if k <= 2 then "YES" else "NO")

ff :: Int -> (Int, Int) -> Int
ff a b = if fst(b) /= snd(b) then a+1 else a

import Data.List
main = do
  n <- readLn :: IO Int
  s <- getLine
  let a = map read (words s) :: [Int]
      b = sort a
      k = f a b 0
      in putStrLn ( if k <= 2 then "YES" else "NO" )

f a b count =
  if null ax || null bx
     then ff
     else f ax bx ff
       where ax = tail a
	     bx = tail b
	     ff = if a /= b then count+1 else count

import List
g(_:l)|length(filter id$zipWith(==)l(sort l))>2="NO"|1>0="YES"
main=interact$g.map((+0).read).words

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- swap' (read $ nbS :: Int) [] (One 0) None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already | Switch Int Int Int
data Last = One Int | Mul Int Int

swap':: Int -> [Int] -> Last -> Push  -> IO Bool
swap' n [] _ _   | (n<=0) = return True
swap' n xs l p   | (n<=0) = swap n xs l p
swap' n t l p   = do
                   nums <- getNumbers (3-(length t))
                   swap (n-length(nums)) (t++nums) l p

swap:: Int -> [Int] -> Last -> Push  -> IO Bool

swap u (x:y:[]) (One l)  None | x>y = return $ y>= l
swap u (x:y:[]) (Mul i l)  None | x>y = return $ y>= l

swap u (x:y:xs) (One l)  p | (x==y) = swap' u (y:xs) (Mul x l)  p
swap u (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap' u (y:xs) (Mul n l) p
                                      False -> swap' u (y:xs) (Mul x n) p

swap u (x:y:xs) i  Already | x>y =  return False

swap u (x:y:xs) i None | x>y =  case (y>=(getLast i)) of
                               True -> case xs of
                                  []  -> return True
                                  (z:zs) | z>=x -> swap' u (z:zs) (One x) $ Switch (getN i) y x
                                  (z:zs) | otherwise -> case i of
                                             Mul n _ ->  case (n==x) of
                                                          True -> return False
                                                          False -> swap' u (y:xs) i $ Value n x y
                                             One n -> swap' u (y:xs) i $ Value n x y
                               False -> return False

swap u (x:y:xs) i (Switch bInf a b) | x>y = return $  (b>=x)&&(y<=a)&&(y>=bInf)

swap u (x:y:xs) i p@(Value bInf v bSup) | x>y = case ((y>=bInf) && (y<=bSup) && (v>=(getN i))) of
                                               False -> return False
                                               True -> swap' u (v:xs) (One x) Already

swap u (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap' u (y:xs) (Mul n l) p
                              False ->  swap' u (y:xs) (One x) p

swap u (x:y:xs) i p = swap' u (y:xs) (One x) p

swap u (x:[]) i (Value bInf v bSup) = return $ (v>(getN i)) && (x>=bInf) && (x<= bSup)
swap u (x:[]) i p = return $ (x>= (getN i))

swap u ([]) i p = return True

getN (One n) = n
getN (Mul n l) = n

getLast (One n) = n
getLast (Mul n l) = l

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) x None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) x Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul n l) p | (x==y) = case (x==n) of
                                      True -> swap (y:xs) (Mul n l) p
                                      False -> swap (y:xs) (Mul x n) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= n) of
                                           True -> swap (y:xs) (Mul n l) $ Value n x y -- 3 9 [9 4] 10
                                           False -> case ((y>=l) && (y<x)) of
                                            True -> swap (x:xs) (Mul n l) Already
                                            False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i@(One l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case (((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==x))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) i@(Mul n l) p@(Value bInf v bSup) = case (v<y) of
                                        False -> swap (y:xs) (One x) p
                                        True -> case ( ((x>=bInf) && ( x<=bSup)) || ((l==bSup) && (v==n))) of
                                          True -> swap (v:y:xs) i Already
                                          False -> False

swap (x:y:xs) (Mul n l) p = case (n==x) of
                              True -> swap (y:xs) (Mul n l) p
                              False ->  swap (y:xs) (One x) p

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) (Mul n l) (Value bInf v bSup) = (l<=bSup) && (v>=n)
swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = swap(y:xs) x p

swap (x:y:xs) i p | x>y = case p of
                          None -> swap (y:xs) i $ Value i x y
                          Already -> False
                          (Value bInf v bSup) -> case  ((x<=x) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False

swap (x:y:xs) i p = swap (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>=i)

swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)
import System.IO.Unsafe(unsafePerformIO)

main :: IO ()
main = do
         nbS <- getLine
         let res = swap (getNumbers (read $ nbS :: Int)) 0 None
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  unsafePerformIO $ do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = []
getNumbers n = case getNumber of
                 Nothing -> []
                 Just num ->  num:(getNumbers(n-1))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

--Value 0 2 1
--1 2 1

--2>=1   2<=2  1>=0  1<=1

--1 2 2 1

-- v==y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                True -> swap (y:xs) i p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                True -> swap (y:xs) i p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num ->  (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i p | (x==y) = swap (y:xs) i p

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) x $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) x Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x (One 0) None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already
data Last = One Int | Mul Int Int

swap:: [Int] -> Last -> Push  -> Bool

swap (x:y:[]) (One l)  None | x>y = y>= l
swap (x:y:[]) (Mul i l)  None | x>y = y>= l

swap (x:y:xs) (One l)  p | (x==y) = swap (y:xs) (Mul x l)  p
swap (x:y:xs) (Mul i l) p | (x==y) = swap (y:xs) (Mul i l) p

swap (x:y:xs) p  Already | x>y =  False

-- 3 [9 4] 8 3 / Value 3 9 4 / [8 3] 9:[]

swap (x:y:xs) last@(One l) None | x>y =  case (y>= l) of
                                    True -> swap (y:xs) last $ Value l x y
                                    False -> False

swap (x:y:xs) last@(One l) (Value bInf v bSup) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (One x) Already
                                                  False ->  False

swap (x:y:xs) (Mul n l) None | x>y = case (y >= l) of
                                           True -> swap (x:xs) (Mul n y) $ Already -- 3 9 [9 4] 10
                                           False -> False    -- 3 9 [9 2] 10  2<3

-- 3 [9 4] 8 8 3  / Value 3 9 4 / [8 3] 9:[]
swap (x:y:xs) (Mul n l) (Value bInf v bSup ) | x>y =  case  ((x<=v) && (bInf<=y) && (y<=bSup)) of
                                                  True ->  swap (v:xs) (Mul n l) Already
                                                  False ->  False

swap (x:y:xs) i p = swap (y:xs) (One x) p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=(getN i))&&(x>=bInf)&&(x<=bSup)
                   otherwise -> (x>= (getN i))

swap ([]) i p = True

getN (One n) = n
getN (Mul n l) = n

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=bSup)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True

import System.IO (getChar)
import Control.Monad (liftM)

main :: IO ()
main = do
         nbS <- getLine
         res <- liftM (\x -> swap x 0 None) (getNumbers (read $ nbS :: Int))
         case res of
          True -> putStrLn "YES"
          False -> putStrLn "NO"

getNumber =  do
              s <- getNumber'
              case s of
               [] -> return Nothing
               otherwise -> return $ Just (read $ s :: Int)

getNumber'  = do
                c <- catch getChar  (\err-> return ' ')
                case c of
                  ' ' ->  return ""
                  '\n' ->  return ""
                  otherwise -> do l <- getNumber'
                                  return (c:l)

getNumbers n | (n<=0) = return []
getNumbers n = do
                mbNum <- getNumber
                case mbNum of
                 Nothing -> return []
                 Just num -> (liftM (num:) (getNumbers(n-1)))

data Push = Value Int Int Int | None | Already

swap:: [Int] -> Int -> Push  -> Bool

swap (x:y:xs) i None | (x==y) = swap (y:xs) i None
swap (x:y:xs) i Already | (x==y) = swap (y:xs) i Already
swap (x:y:xs) i p@(Value binf v bSup) | (x==y) = case (v<x)||(x>=i) of
                                                  True -> swap (xs) x p
                                                  False -> False

swap (x:y:xs) i p | y<x = case p of
                          (Value bInf v bSup) -> case  ((v>=x) && (y>=bInf) && (y<=bSup)) of
                                                  True ->  swap xs v Already
                                                  False ->  False
                          Already -> False
                          None -> case xs of
                                    [] -> (y>=i)
                                    otherwise -> swap (y:xs) i $ Value i x y

swap (x:y:xs) i p = case p of
                          (Value bInf v bSup) ->  case ((v>x) && (v<=y) && (x>=bInf) && (x<=bSup)) of
                            True -> case (v==y) of
                                --True -> swap (y:xs) i Already
                                True -> swap (xs) v p
                                False -> swap xs v Already
                            False -> swap (y:xs) x p
                          otherwise -> swap  (y:xs) x p

swap (x:[]) i p = case p of
                   (Value bInf v bSup) ->  (v>=i)&&(x>=bInf)&&(x<=v)
                   oterwise -> (x>=i)

swap ([]) i (Value _ _ _) = i==0
swap ([]) i p = True


module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bool
import Data.Array.Unboxed

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  ts <- replicateM n $ liftM2 (,) poi poi
  return $ bool "NO" "YES" $ solve m ts
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve m = all (> 0) . (elems :: UArray Int Int -> [Int]) . accumArray (+) 0 (1, m) . concatMap (\(l, r) -> zip [l + 1..r] (repeat 1))

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import Control.Monad
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol ([_,m]:ts) = [ sol' 0 m ts ]

sol' :: Int -> Int -> [[Int]] -> String
sol' _ _ [] = "NO"
sol' p m ([f,w]:ts)
  | p < f     = "NO"
  | p' >= m   = "YES"
  | otherwise = sol' p' m ts
  where p' = max p w

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.Bool
import Data.Array.Unboxed

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  m <- poi
  ts <- replicateM n $ liftM2 (,) poi poi
  return $ bool "NO" "YES" $ solve m ts
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve m = all (> 0) . (elems :: UArray Int Int -> [Int]) . accumArray (+) 0 (0, m) . concatMap (\(l, r) -> zip [l..r] (repeat 1))


import Control.Monad

main :: IO ()
main = do
  _        <- read <$> getLine :: IO Int
  (oc, tc) <-
    foldl (\(a, b) x -> if x == "1" then (a + 1, b) else (a, b + 1)) (0, 0)
    .   words
    <$> getLine :: IO (Int, Int)
  when (oc == 0) $ replicateM_ tc $ putStr "2 "
  when (tc == 0) $ replicateM_ oc $ putStr "1 "
  when (oc > 0 && tc > 0) $ do
    putStr "2 1 "
    replicateM_ (tc - 1) $ putStr "2 "
    replicateM_ (oc - 1) $ putStr "1 "
  putStrLn ""

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  num1 <- length . filter (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  putStrLn $ intersperse ' '
    $ if | num1 == n -> replicate n '1'
         | num1 == 0 -> replicate n '2'
         | otherwise -> "21" ++ replicate (n - num1 - 1) '2'
                        ++ replicate (num1 - 1) '1'

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

main = interact $ concat.(map (\x -> x++" ")).(map show).helper.(map read).words where helper (x:xs) = if (a>0 && b>0) then 2:1:(replicate (b-1) 2 ++ replicate (a-1) 1) else(replicate b 2 ++ replicate a 1) where (a, b) = (length [0|s<-xs,s==1], length [0|s<-xs,s==2])

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  num1 <- length . filter (==1) . unfoldr (runStateT rIntS) <$> BS.getLine
  putStrLn $ intersperse ' '
    $ if | num1 == n -> replicate n '1'
         | num1 == 1 -> replicate n '2'
         | otherwise -> "21" ++ replicate (n - num1 - 1) '2'
                        ++ replicate (num1 - 1) '1'

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N


import Data.Bits
import Data.Array
main = do
  n <- readLn
  ps <- listArray (1,n) . map read . words <$> getLine
  let go cl i | testBit cl i = i
              | otherwise = go (setBit cl i) (ps ! i)
  putStrLn $ unwords $ map (show . go (0 :: Integer)) (indices ps)

{-# LANGUAGE TupleSections #-}

import Data.Maybe
import Data.Array.IArray
import Data.List

iogetints :: IO [Int]
iogetints = getLine >>= (return . map read . words)

solve :: Int -> Array Int Int -> [Int]
solve n a = map f [1..n] where
	f :: Int -> Int
	f x = ans where
		xs = take (succ n) $ iterate (a!) x
		c = accumArray (+) 0 (1, n) $ map (,1) xs :: Array Int Int
		ans = fromJust $ find ((> 1) . (c!)) xs

main :: IO ()
main = do
	[n] <- iogetints
	xs <- iogetints
	putStrLn $ intercalate " " $ map show $ solve n $ listArray (1, n) xs

import qualified Data.Map as Map
import qualified Data.Set as Set

f2::Int->Set.Set Int->Map.Map Int Int->Int
f2 n ss ms
   |Set.member n ss=n
   |otherwise=let Just n2=Map.lookup n ms
              in f2 n2 (Set.insert n ss) ms

f::Int->Map.Map Int Int->Int
f n ms=let Just n2=Map.lookup n ms
       in n2

main = do
       e<-getLine
       es<-getLine
       let xs=map read (words es)::[Int]
           n=read e::Int
           ms=Map.fromList $ zip [(1::Int)..n] xs
       putStrLn $ unwords $ map show $ [f2 (f h ms) (Set.fromList [h]) ms|h<-[1..n]]

module Main where

import           Control.Monad (forM_)
import           Data.Array
import           Data.Functor  ((<$>))
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: Array Int Int -> Int -> Int
findStudent ps a = go ps a (S.singleton a)
  where
    go ps i set =
      let nextStudent = ps ! i
       in if nextStudent `S.member` set
            then nextStudent
            else go ps nextStudent (S.insert nextStudent set)

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- listArray (1, n) <$> getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)

module Main where

import           Control.Monad (forM_)
import           Data.Functor  ((<$>))
import           Data.List     (foldl')
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: [Int] -> Int -> Int
findStudent ps a = go ps (S.singleton a)
  where
    go (p:ps) set
      | p `S.member` set = p
      | otherwise = go ps (S.insert p set)

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)

module Main where

import           Control.Monad (forM_)
import           Data.Functor  ((<$>))
import           Data.List     (foldl')
import qualified Data.Set      as S
import           System.IO     (putStr)

getLineInts :: IO [Int]
getLineInts = fmap read <$> words <$> getLine

findStudent :: [Int] -> Int -> Int
findStudent ps a = go ps (S.singleton a) a False
  where
    go _ _ res True = res
    go (p:ps) set res _
      | p `S.member` set = go ps set p True
      | otherwise = go ps (S.insert p set) res False

main :: IO ()
main = do
  [n] <- getLineInts
  ps <- getLineInts
  forM_ [1 .. n] $ putStr . (++ " ") . show . (findStudent ps)


import Control.Applicative ((<$>), (<|>))
import Data.Array ((//), elems, listArray)
import Data.Char (digitToInt)
import Data.List (findIndex, findIndices)
import Data.Maybe (listToMaybe)

main :: IO ()
main = solve <$> (map digitToInt <$> getLine) >>= putStrLn

solve :: [Int] -> String
solve xs = maybe "-1" f $ findIndex (\c -> even c && c < last xs) xs <|> listToMaybe (reverse $ findIndices even xs)
  where f i = concatMap show $ elems $ listArray (1, length xs) xs // [ (i + 1, last xs), (length xs, xs !! i) ]

import Control.Applicative ((<$>), (<|>))
import Data.Array ((//), elems, listArray)
import Data.Maybe (listToMaybe)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = maybe (B.pack "-1") f $ B.findIndex (\c -> c `elem` "02468" && c < B.last xs) xs <|> listToMaybe (reverse $ B.findIndices (`elem`"02468") xs)
  where f i = B.pack $ elems $ listArray (1, B.length xs) (B.unpack xs) // [ (i + 1, B.last xs), (B.length xs, xs `B.index` i) ]

import Data.List
main = putStrLn . solve =<< getLine
solve n | Just i <- findIndex ((&&) <$> (< o) <*> ev) n
          = let (l,e:r) = splitAt i (init n)
            in l ++ [o] ++ r ++ [e]
        | not (null es)
          = let (l,e:r) = splitAt (last es) (init n)
            in l ++ [o] ++ r ++ [e]
        | otherwise = "-1"
  where
    o = last n
    ev = (`elem` "24680")
    es = findIndices ev n

--findEven :: [Int] -> [(Integer, Int)]
findEven xs = [(i, x) | (i, x) <- zip [0..] xs, even x]

--process :: Int -> [(Int, Int)] -> Maybe (Int, Int)
process k xs
  | null xs = Nothing
  | null ys = Just (last xs)
  | otherwise = Just (head ys)
  where ys = [(i, x) | (i, x) <- xs, x < k]

solve xs =
    case res of
      Nothing -> "-1"
      Just (i, x) -> concatMap show $ take i xs ++ [k] ++ (init $ tail d) ++ [x]
        where d = drop i xs
      where res = process k $ findEven xs
            k = last xs

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  putStrLn $ solve n

findEven xs = [(i, x) | (i, x) <- zip [0..] xs, even x]

process k xs
  | null xs = Nothing
  | null ys = Just (last xs)
  | otherwise = Just (head ys)
  where ys = [(i, x) | (i, x) <- xs, x < k]

firstlast (x:xs) a b = b : go xs
  where go [y] = [a]
        go (y:ys) = y : go ys

old xs a b = [b] ++ init (tail xs) ++ [a]

solve xs =
    case res of
      Nothing -> "-1"
      Just (i, x) -> concatMap show $ take i xs ++ firstlast d x k
        where d = drop i xs
      where res = process k $ findEven xs
            k = last xs

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  putStrLn $ solve n

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Char

combi f x = (take (length f - length x) f ) ++ x

process::[Int]->[Int]->Int->[Char]->[Char]
process [] _ _ f= "-1"
process [x] s _ f= combi f $ concatMap show $ [last s] ++tail (init s) ++ [head s]
process (x:xs) s la f |x>la = process xs   (dropWhile (/=(head xs) ) (tail s)) la f
	              |otherwise =combi f $ concatMap show $[last s] ++tail (init s) ++ [head s]

main= do
	 r<-getLine
	 let s= map (\z-> ord z - ord '0') r:: [Int]
	 let s1 = filter even s
	 let ans= process s1  (dropWhile (/=(head s1)) s) (last s) r
	 putStrLn ans

import Data.Functor ((<$>))
import Control.Applicative ((<|>))
import Data.Maybe (listToMaybe)
import Data.List (findIndex, findIndices)
import Data.Array ((//), elems, listArray)

main :: IO ()
main = solve <$> getLine >>= putStrLn

solve :: String -> String
solve xs = maybe "-1" f $ findIndex (\c -> c `elem` "02468" && c < last xs) xs <|> listToMaybe (reverse $ findIndices (`elem`"02468") xs)
  where f i = elems $ listArray (0, length xs - 1) xs // [ (i, last xs), (length xs - 1, xs !! i) ]

import Data.Functor ((<$>))
import Control.Applicative ((<|>))
import Data.Maybe (listToMaybe)
import Data.List (findIndex, findIndices)
import Data.Array ((//), elems, listArray)

main :: IO ()
main = solve <$> getLine >>= putStrLn

solve :: String -> String
solve xs = maybe "-1" f $ findIndex (\c -> c `elem` "0248" && c < last xs) xs <|> listToMaybe (reverse $ findIndices (`elem`"0248") xs)
  where f i = elems $ listArray (0, length xs - 1) xs // [ (i, last xs), (length xs - 1, xs !! i) ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.pack <$> getLine) >>= putStrLn . B.unpack

solve :: B.ByteString -> B.ByteString
solve xs = last $ B.pack "-1" : [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- reverse ix, i == last ix || B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ]
  where ix = B.findIndices (`elem`"0248") (B.init xs)

import Data.Functor ((<$>))
import Data.List (findIndices)

main :: IO ()
main = putStrLn . concatMap show =<< solve <$> getLine

solve :: String -> String
solve xs = maximum $ "-1" : [ swap i (length xs - 1) xs | i <- findIndices (`elem`"0248") xs ]

swap :: Int -> Int -> [a] -> [a]
swap i j xs = [ if k == i then xs !! j else if k == j then xs !! i else x | (k, x) <- zip [0..] xs ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> B.getLine >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = maximum $ B.pack "-1" : [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") xs, i + 1 /= B.length xs, let (ys, zs) = B.splitAt i xs ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = head $ [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") (B.init xs), Just i == B.findIndex (`elem`"0248") (B.init xs) || B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ] ++ [ B.pack "-1" ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> B.getLine >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = head $ [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") (B.init xs), B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ] ++ [ B.pack "-1" ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = head $ [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") (B.init xs), B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ] ++ [ B.pack "-1" ]

import Data.Functor ((<$>))
import Control.Applicative ((<|>))
import Data.Maybe (listToMaybe)
import Data.List (findIndex, findIndices)

main :: IO ()
main = solve <$> getLine >>= putStrLn

solve :: String -> String
solve xs = maybe "-1" f $ findIndex (\c -> c `elem` "0248" && c < last xs) xs <|> listToMaybe (reverse $ findIndices (`elem`"0248") xs)
  where f i = ys ++ last xs : tail (init zs) ++ [ xs !! i ] where (ys, zs) = splitAt i xs

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = head $ [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- reverse ix, i == last ix || B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ] ++ [ B.pack "-1" ]
  where ix = B.findIndices (`elem`"0248") (B.init xs)

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B
import Control.Applicative ((<|>))
import Data.Maybe (fromMaybe, listToMaybe)

main :: IO ()
main = solve <$> (B.pack <$> getLine) >>= putStrLn . B.unpack

solve :: B.ByteString -> B.ByteString
solve xs = fromMaybe (B.pack "-1") (f <$> B.findIndex (\c -> c `elem` "0248" && c < B.last xs) xs <|> f <$> listToMaybe (reverse $ B.findIndices (`elem`"0248") xs))
  where f i = B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i where (ys, zs) = B.splitAt i xs

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> B.getLine >>= putStrLn . B.unpack

solve :: B.ByteString -> B.ByteString
solve xs = maximum $ B.pack "-1" : [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") xs, i + 1 /= B.length xs, let (ys, zs) = B.splitAt i xs ]

import Control.Applicative ((<$>), (<|>))
import Data.Array ((//), elems, listArray)
import Data.Maybe (listToMaybe)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> B.getLine >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = maybe (B.pack "-1") f $ B.findIndex (\c -> c `elem` "02468" && c < B.last xs) xs <|> listToMaybe (reverse $ B.findIndices (`elem`"02468") xs)
  where f i = B.pack $ elems $ listArray (1, B.length xs) (B.unpack xs) // [ (i + 1, B.last xs), (B.length xs, xs `B.index` i) ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = last $ B.pack "-1" : [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- reverse ix, i == last ix || B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ]
  where ix = B.findIndices (`elem`"0248") (B.init xs)

import Data.Char (digitToInt)
import Data.Functor ((<$>))
import Data.List (findIndices)

main :: IO ()
main = putStrLn . concatMap show =<< solve . map digitToInt <$> getLine

solve :: [Int] -> [Int]
solve xs | all odd xs = [ -1 ]
         | otherwise = minimum [ swap i (length xs - 1) xs | i <- findIndices even xs ]

swap :: Int -> Int -> [a] -> [a]
swap i j xs = [ if k == i then xs !! j else if k == j then xs !! i else x | (k, x) <- zip [0..] xs ]

import Data.Functor ((<$>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = solve <$> (B.init <$> B.getLine) >>= B.putStrLn

solve :: B.ByteString -> B.ByteString
solve xs = last $ B.pack "-1" : [ B.append ys $ B.cons (B.last xs) $ B.snoc (B.tail $ B.init zs) $ B.index xs i | i <- B.findIndices (`elem`"0248") (B.init xs), Just i == B.findIndex (`elem`"0248") (B.init xs) || B.index xs i < B.last xs, let (ys, zs) = B.splitAt i xs ]

import Data.Functor ((<$>))
import Data.List (findIndices)

main :: IO ()
main = putStrLn =<< solve <$> getLine

solve :: String -> String
solve xs = maximum $ "-1" : [ swap i (length xs - 1) xs | i <- findIndices (`elem`"0248") xs ]

swap :: Int -> Int -> [a] -> [a]
swap i j xs = [ if k == i then xs !! j else if k == j then xs !! i else x | (k, x) <- zip [0..] xs ]

import Data.List
main = print . solve =<< getLine
solve n | Just i <- findIndex ((&&) <$> (< o) <*> ev) n
          = let (l,e:r) = splitAt i (init n)
            in l ++ [o] ++ r ++ [e]
        | not (null es)
          = let (l,e:r) = splitAt (last es) (init n)
            in l ++ [o] ++ r ++ [e]
        | otherwise = "-1"
  where
    o = last n
    ev = (`elem` "24680")
    es = findIndices ev n

import Data.List
main = interact solve
solve n | Just i <- findIndex ((&&) <$> (< o) <*> ev) n
          = let (l,e:r) = splitAt i (init n)
            in l ++ [o] ++ r ++ [e]
        | not (null es)
          = let (l,e:r) = splitAt (last es) (init n)
            in l ++ [o] ++ r ++ [e]
        | otherwise = "-1"
  where
    o = last n
    ev = (`elem` "24680")
    es = findIndices ev n

--findEven :: [Int] -> [(Integer, Int)]
findEven xs = [(i, x) | (i, x) <- zip [0..] xs, even x]

process :: Int -> [(Int, Int)] -> Maybe (Int, Int)
process k xs
  | null xs = Nothing
  | null ys = Just (last xs)
  | otherwise = Just (head xs)
  where ys = [(i, x) | (i, x) <- xs, x < k]

solve xs =
    case res of
      Nothing -> "-1"
      Just (i, x) -> concatMap show $ take i xs ++ [k] ++ (init $ tail d) ++ [x]
        where d = drop i xs
      where res = process k $ findEven xs
            k = last xs

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  putStrLn $ solve n

solve [n] = [3]
solve ns'@(n:ns)
  | even n = l : (d ++ [n])
  | otherwise = n : solve ns
  where l = last ns
        d = init ns

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  let ans = solve n
  putStrLn $ case last ans of
            3 -> "-1"
            x -> concatMap show ans

--findEven :: [Int] -> [(Integer, Int)]
findEven xs = [(i, x) | (i, x) <- zip [0..] xs, even x]

--process :: Int -> [(Int, Int)] -> Maybe (Int, Int)
process k xs
  | null xs = Nothing
  | null ys = Just (last xs)
  | otherwise = Just (head xs)
  where ys = [(i, x) | (i, x) <- xs, x < k]

solve xs =
    case res of
      Nothing -> "-1"
      Just (i, x) -> concatMap show $ take i xs ++ [k] ++ (init $ tail d) ++ [x]
        where d = drop i xs
      where res = process k $ findEven xs
            k = last xs

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  putStrLn $ solve n

--findEven :: [Int] -> [(Integer, Int)]
findEven xs = [(i, x) | (i, x) <- zip [0..] xs, even x]

--process :: Int -> [(Int, Int)] -> Maybe (Int, Int)
process k xs
  | null xs = Nothing
  | null ys = Just (last xs)
  | otherwise = Just (head ys)
  where ys = [(i, x) | (i, x) <- xs, x < k]

solve xs =
    case res of
      Nothing -> "-1"
      Just (i, x) -> concatMap show $ take i xs ++ [k] ++ (init $ tail d) ++ [x]
        where d = drop i xs
      where res = process k $ findEven xs
            k = last xs

main = do
  n <- fmap (map (read . (:""))) getLine :: IO [Int]
  print n
  putStrLn $ solve n

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Char

combi f x = (take (length f - length x) f ) ++ x

process::[Int]->[Int]->Int->[Char]->[Char]
process [] _ _ f= "-1"
process [x] s _ f= combi f $ concatMap show $ [last s] ++tail (init s) ++ [head s]
process (x:xs) s la f |x>la = process xs  (tail(dropWhile (/=x) s)) la f
	              |otherwise =combi f $ concatMap show $[last s] ++tail (init s) ++ [head s]

main= do
	 r<-getLine
	 let s= map (\z-> ord z - ord '0') r:: [Int]
	 let s1 = filter even s
	 let ans= process s1  (dropWhile (/=(head s1)) s) (last s) r
	 putStrLn ans


-- ID : 1697C (awoo's Favorite Problem)
-- URL: https://codeforces.com/problemset/problem/1697/C

{-# LANGUAGE CPP #-}
#define ENABLE_TRACE 0

import Control.Monad
#if ENABLE_TRACE
import Debug.Trace (trace)
#endif

-- IO util
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
readInt = read `fmap` getLine :: IO Int

#if !ENABLE_TRACE
trace a b = b
#endif

main = do
    q <- readInt
    replicateM_ q solve

solve = do
    n <- readInt
    src <- getLine
    dst <- getLine
    let b1 = length . filter (== 'b') $ src
    let b2 = length . filter (== 'b') $ dst
    if (b1 == b2) && (f 0 0 n src dst)
        then putStrLn "YES"
        else putStrLn "NO"

fmt c i j n xs ys = c ++ ": " ++ show [i,j,n] ++ ", " ++ xs ++ ", " ++ ys

f i j n src dst
    | i >= n           = trace (fmt "case1" i j n src dst) $ True
    | x == 'b'         = trace (fmt "case2" (i+1) j n xs dst) $ f (i+1) j n xs dst
    | (x /= y') || (x == 'a' && i > j') || (x == 'c' && i < j') = False
    | otherwise        = trace (fmt "case4" (i+1) j'' n xs ys'') $ f (i+1) j'' n xs ys''
    where
        (x:xs) = src
        (y:ys) = dst
        bs = leadingB dst
        j' = j + bs
        (y':ys') = drop bs dst
        j'' = min n (j'+1)
        ys'' = if j'' == n then [] else ys'

leadingB ys = f 0 ys where
    f n ('b':yys) = f (n+1) yys
    f n _ = n

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

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

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

data TC = TC {n :: Int, s :: String, t :: String}

type Output = Bool

input :: Scanner TC
input = do
  n <- int
  s <- str
  t <- str
  return TC {..}

solve :: TC -> Output
solve TC {..} = rec (blocks s) t

type Block = (Char, Int)

type Blocks = [Block]

blocks :: String -> Blocks
blocks = map (\g -> (head g, length g)) . group

rec :: Blocks -> String -> Bool
rec [] "" = True
rec ((_, 0) : xs) ys = rec xs ys
rec ((x, n) : (x', n') : xs) ys | x == x' = rec ((x, n + n') : xs) ys
rec ((x, n) : xs) (y : ys) | x == y = rec ((x, n - 1) : xs) ys
rec (('a', n) : ('b', n') : xs) ('b' : ys)
  | n' == 0 = False
  | n' == 1 = rec (('a', n) : xs) ys
  | otherwise = rec (('a', n) : ('b', n' - 1) : xs) ys
rec (('b', n) : ('c', n') : xs) ('c' : ys)
  | n' == 0 = False
  | n' == 1 = rec (('b', n) : xs) ys
  | otherwise = rec (('b', n) : ('c', n' - 1) : xs) ys
rec _ _ = False

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- 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 : 1697C (awoo's Favorite Problem)
-- URL: https://codeforces.com/problemset/problem/1697/C

{-# LANGUAGE CPP #-}
#define ENABLE_TRACE 0

import Control.Monad
#if ENABLE_TRACE
import Debug.Trace (trace)
#endif

-- IO util
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString as BS
readInt = read `fmap` getLine :: IO Int

#if !ENABLE_TRACE
trace a b = b
#endif

main = do
    q <- readInt
    replicateM_ q solve

solve = do
    n <- readInt
    src <- getLine
    dst <- getLine
    let b1 = length . filter (== 'b') $ src
    let b2 = length . filter (== 'b') $ dst
    if (b1 == b2) && (f 0 0 n src dst)
        then putStrLn "YES"
        else putStrLn "NO"

fmt c i j n xs ys = c ++ ": " ++ show [i,j,n] ++ ", " ++ xs ++ ", " ++ ys

f i j n src dst
    | i >= n           = trace (fmt "case1" i j n src dst) $ True
    | x == 'b'         = trace (fmt "case2" (i+1) j n xs dst) $ f (i+1) j n xs dst
    | (x /= y') || (x == 'a' && i > j') || (y == 'c' && i < j') = False
    | otherwise        = trace (fmt "case4" (i+1) j'' n xs ys'') $ f (i+1) j'' n xs ys''
    where
        (x:xs) = src
        (y:ys) = dst
        bs = leadingB dst
        j' = j + bs
        (y':ys') = drop bs dst
        j'' = min n (j'+1)
        ys'' = if j'' == n then [] else ys'

leadingB ys = f 0 ys where
    f n ('b':yys) = f (n+1) yys
    f n _ = n


import Control.Applicative
import Data.List

main = (liftA2 ((.sort.map read.words).flip (!!).liftA2 (-) head (!!1).map read.words) getLine getLine :: IO(Int)) >>= print

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

readInt :: IO Integer
readInt = read <$> getLine

readIntList :: IO [Integer]
readIntList = fmap read . words <$> getLine

main :: IO ()
main = do
  [n, k] <- readIntList
  li <- sort <$> readIntList
  putStrLn $ show $ li !! (fromIntegral (n-k))

import Data.List
strToList = (map (read :: String -> Int)).words

main = do
    s <- getLine
    let [n, k] = strToList s
    t <- getLine
    putStrLn $ show $ (sort $ strToList t) !! (n - k)

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

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

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

main = do
  [n, k] <- map read . words <$> getLine
  xs <- map read . words <$> getLine :: IO [Int]

  print $ (reverse $ sort xs) !! (k-1)


-- This probably still TLEs, which is unfortunate.
-- At this point, around 80% of my locally-profiled
-- runtime is in the sort call on line 53. Disgusting.

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Lazy as R
import qualified Data.ByteString.Lazy.Char8 as P

import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed

import Data.Int
import Data.List

p :: Int64
p = 998244353

cv :: Int64 -> Int64
cv x = mod x p

newSTUArray :: (Int64, Int64) -> Int64 -> ST s (STUArray s Int64 Int64)
newSTUArray = newArray

invs :: Int64 -> UArray Int64 Int64
invs n = runSTUArray $ do
  ans <- newSTUArray (1, n) 0
  writeArray ans 1 1
  forM_ [2..n] $ \i -> do
    let  (x, y) = divMod p i
    v <- readArray ans y
    writeArray ans i $ cv (-x * v)
  pure ans

choose :: Int64 -> Int64 -> UArray Int64 Int64
choose n k = let
  w = invs n
  lastAns = foldl' (\x y -> cv $ cv (x * (n - y + 1)) * (w ! y)) 1 [1..k]
  ansLi = scanl' (\x y -> cv $ cv (x * (y - k)) * (w ! y)) lastAns [n, n-1 .. 1]
  in  listArray (0, n) $ reverse ansLi

data DoesMoreStrictnessHelp
  = DoesMoreStrictnessHelp !Int !Int64
  deriving (Eq, Ord)

solve :: Int64 -> Int64 -> [(Int, Int)] -> Int64
solve n k lr = let
  unsortedEvents = do
    (le, ri) <- lr
    [DoesMoreStrictnessHelp le (0-1), DoesMoreStrictnessHelp ri 1]
  events = sort unsortedEvents
  sArr = choose (n-1) (k-1)
  step (!currCt, !currTot) (DoesMoreStrictnessHelp _ v) =
    (currCt - v, currTot + if  v == -1  then  sArr ! currCt  else  0)
  in  case  foldl' step (0, 0) events  of
  (0, ans) -> cv ans
  _ -> error "huh?"

{-
main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  lr <- replicateM (fromIntegral n) $ do
    [le, ri] <- map read . words <$> getLine
    pure (le, ri)
  print $ solve n k lr
-}

type ByteString = P.ByteString

parseLine :: ByteString -> (Int, Int)
parseLine str = let
  [Just (le, _), Just (ri, _)] = map P.readInt $ P.words str
  in (le, ri)

parse :: ByteString -> (Int64, Int64, [(Int, Int)])
parse str = let
  (n, k) : lrs = map parseLine $ P.lines str
  in  (fromIntegral n, fromIntegral k, lrs)

main :: IO ()
main = do
  (n, k, lrs) <- parse <$> R.getContents
  print $ solve n k lrs

-- Using tuple-free comparison, and less 64-bit storage...
-- Will it be faster?

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Lazy as R
import qualified Data.ByteString.Lazy.Char8 as P

import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed

import Data.Int
import Data.List

p :: Num t => t
p = 998244353

prodModP :: [Int] -> Int
prodModP = let
  step :: Int64 -> Int -> Int64
  step x y = mod (x * fromIntegral y) p
  in  \li -> case  li  of
  [] -> 1
  (x : xs) -> fromIntegral $ foldl' step (fromIntegral x) xs

newSTUArray :: (Int, Int) -> Int -> ST s (STUArray s Int Int)
newSTUArray = newArray

invs :: Int -> UArray Int Int
invs n = runSTUArray $ do
  ans <- newSTUArray (1, n) 0
  writeArray ans 1 1
  forM_ [2..n] $ \i -> do
    let  (x, y) = divMod p i
    v <- readArray ans y
    writeArray ans i $ prodModP [-x, v]
  pure ans

choose :: Int -> Int -> UArray Int Int
choose n k = let
  w = invs n
  lastAns = foldl' (\x y -> prodModP [x, n-y+1, w!y]) 1 [1..k]
  ansLi = scanl' (\x y -> prodModP [x, y - k, w ! y]) lastAns [n, n-1 .. 1]
  in  listArray (0, n) $ reverse ansLi

solve :: Int -> Int -> [(Int, Int)] -> Int
solve n k lr = let
  unsortedEvents = do
    (le, ri) <- lr
    [le * 2, ri * 2 + 1]
  events = sort unsortedEvents
  sArr = choose (n-1) (k-1)
  step (!currCt, !currTot) ov = let
    v = mod ov 2
    incTot = currTot + if  v == 0  then  sArr ! currCt  else  0
    nextTot = incTot + if  incTot >= p  then  -p  else  0
    in  (currCt + 1 - 2*v, nextTot)
  in  case  foldl' step (0, 0) events  of
  (0, ans) -> mod ans p
  _ -> error "huh?"

{-
main :: IO ()
main = do
  [n, k] <- map read . words <$> getLine
  lr <- replicateM (fromIntegral n) $ do
    [le, ri] <- map read . words <$> getLine
    pure (le, ri)
  print $ solve n k lr
-}

type ByteString = P.ByteString

parseLine :: ByteString -> (Int, Int)
parseLine str = let
  [Just (le, _), Just (ri, _)] = map P.readInt $ P.words str
  in (le, ri)

parse :: ByteString -> (Int, Int, [(Int, Int)])
parse str = let
  (n, k) : lrs = map parseLine $ P.lines str
  in  (n, k, lrs)

main :: IO ()
main = do
  (n, k, lrs) <- parse <$> R.getContents
  print $ solve n k lrs


import Control.Monad
import Data.List

main = do
  n <- readLn
  replicateM_ n $ do
    getLine
    a <- fmap (sort . fmap read . words) getLine
    let (_,res) = foldl (\(prev,acc) x -> (x,(if abs (x - prev) /= 1 then 0 else 1) + acc)) (-2,0) a
    print $ if res > 0 then 2 else 1

import Data.List
import Control.Monad

inputNum = do
  line <- getLine
  return ((read line) :: Int)

inputArr = do
  line <- getLine
  let ar = map read (words line) :: [Int]
  return ar

solveRec [] = True
solveRec [x] = True
solveRec (a:b:xs) = b-a /= 1 && solveRec (b:xs)

solveCase = do
  n <- inputNum
  a <- inputArr
  let erg = if solveRec (sort a) then 1 else 2
  putStrLn (show erg)

main = do
  line <- getLine
  let n = (read line :: Int)
  replicateM_ n solveCase
  {-
  line2 <- getLine
  let x = n+1
  let s = show x
  let z = words line2
  let ar = map read z :: [Int]
  let s2 = map (show . (+ 1)) ar
  putStrLn s
  putStrLn (concat s2)
  -}

import Control.Arrow
import Data.List

sec :: Bool -> [String]-> [String]
sec _ [] = []
sec True (x:xs) = x : sec False xs
sec False (x:xs) = sec True xs

main = interact $
  lines >>> tail >>> sec False >>> map (words >>> map read >>> solve >>> show) >>> unlines

solve :: [Integer] -> Integer
solve xs = let sxs = sort xs in
          let t a = any (\x -> x >= 2) $ map length . group $ map (\x -> (x + a) `div` 2) $ sort xs  in
            if t 0 || t 1 then 2 else 1

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

process = do
		a<- getLine
		b<- sort <$> map read <$> words <$>getLine ::IO [Int]
		print $ if a=="1" then 1
				  else if length(take 1 (filter (==1) (zipWith (\z1 z2 ->z2-z1) b (tail b)))) ==1 then 2 else 1

main = do
		n<- read <$> getLine ::IO Int
		replicateM_ n  process

import Control.Monad

main = do
  n <- readLn
  replicateM_ n $ do
    getLine
    a <- fmap (fmap read . words) getLine
    print $ if length (filter odd a) /= length a then 2 else 1


import Data.Tuple (swap)
import Data.Maybe (fromJust)
import Control.Monad (replicateM_)

data TNum = N0 | N1 | N2 deriving (Eq, Ord)
assocList = [(N0, '0'), (N1,'1'), (N2,'2')]
decode = fromJust . flip lookup assocList
encode = fromJust . flip lookup (map swap assocList)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    _ <- getLine
    n <- map encode <$> getLine
    putStrLn . init . unlines . map (map decode) . (\(a,b) -> [a,b]) $ solve n

solve :: [TNum] -> ([TNum], [TNum])
solve [] = ([], [])
solve (x:rest) = case x of
    N0 -> let (a,b) = solve rest in (N0 : a, N0 : b)
    N2 -> let (a,b) = solve rest in (N1 : a, N1 : b)
    N1 -> let (a,b) = solveMinimizingLeft rest in (N1 : a, N0 : b)

solveMinimizingLeft :: [TNum] -> ([TNum], [TNum])
solveMinimizingLeft xs = (replicate (length xs) N0, xs)

import Data.Char (isSpace)
import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

f :: (Char, Char, Char) -> Bool -> Char -> (Bool, Char)
f (c1, c2, c3) flag char =
  case char of
    '0' -> (flag, '0')
    '1' -> (True, if flag then c1 else c2)
    _ -> (flag, if flag then c3 else '1')

work :: IO ()
work = do
  _ <- C.getLine
  a <- C.filter (not . isSpace) <$> C.getLine
  let b = snd $ C.mapAccumL (f ('0', '1', '0')) False a
      c = snd $ C.mapAccumL (f ('1', '0', '2')) False a
  C.putStrLn b
  C.putStrLn c

main :: IO ()
main = do
  n <- fmap parseInt C.getLine
  replicateM_ n work

import Data.Word
import Data.List

main :: IO ()
main = do
    getLine -- discard
    answers <- concat <$> map (join.unzip.solve) <$> process <$> getContents :: IO [[Word8]]
    mapM_ print' answers

process :: String -> [[Word8]]
process input = map (read' . snd) . filter (even . fst) . zip [1..] . lines $ input

read' :: String -> [Word8]
read' (x:xs) = (read'' x) : (read' xs)
read' _     = []

read'' '1' = 1
read'' '2' = 2
read'' '0' = 0

solve :: [Word8] -> [(Word8,Word8)]
solve num = solver True num

solver _ [] = []
solver True (0:xs) = (0,0) : (solver True xs)
solver True (1:xs) = (1,0) : (solver False xs)
solver True (2:xs) = (1,1) : (solver True xs)
solver False (0:xs) = (0,0) : (solver False xs)
solver False (1:xs) = (0,1) : (solver False xs)
solver False (2:xs) = (0,2) : (solver False xs)

join (a,b) = [a,b]

print' :: [Word8] -> IO ()
print' = putStrLn . intercalate "" . map show

import Control.Arrow

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

process :: [String] -> [String]
process [] = []
process (n:x:rest) = fst ans : snd ans : process rest
  where ans = solve x

solve :: String -> (String, String)
solve "" = ("", "")
solve (c:rest)
  | c == '1' = ('1' : (take (length rest) (repeat '0')),
                '0' : rest)
  | otherwise = (d : fst rec, d : snd rec)
    where
      d = if c == '2' then '1' else '0'
      rec = solve rest

import Data.Maybe
import Control.Monad
import qualified Data.ByteString.Char8 as C

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

f :: (Char, Char, Char) -> Bool -> Char -> (Bool, Char)
f (c1, c2, c3) flag char =
  case char of
    '0' -> (flag, '0')
    '1' -> (True, if flag then c1 else c2)
    _ -> (flag, if flag then c3 else '1')

work :: IO ()
work = do
  _ <- C.getLine
  a <- C.getLine
  let b = snd $ C.mapAccumL (f ('0', '1', '0')) False a
      c = snd $ C.mapAccumL (f ('1', '0', '2')) False a
  C.putStrLn b
  C.putStrLn c

main :: IO ()
main = do
  n <- fmap parseInt C.getLine
  replicateM_ n work


main = do interact (unwords . map show . gao . map read . words)
gao [a, b] = if c >= 0 && even c then [d, a - d] else [-1] where
	c = a - b
	d = div c 2

data X = X Integer deriving Show
data Y = Y Integer deriving Show
data A = A Integer deriving Show
data B = B Integer deriving Show
data NeedCarry = NeedCarry Bool deriving Show

bitToInt bit = if bit then 1 else 0

printRes (Just (X x, Y y, NeedCarry False)) = unwords $ map show $ [x, y]
printRes _ = "-1"

solver :: A -> B -> Maybe (X, Y, NeedCarry)
solver (A 0) (B 0) = Just (X 0, Y 0, NeedCarry False)
solver (A a) (B b) = do
    let a0 = a `mod` 2 /= 0
        b0 = b `mod` 2 /= 0
        c0 = a0 /= b0
    (X nx, Y ny, NeedCarry c1) <- solver (A $ a `div` 2) (B $ b `div` 2)
    let neededXYCount = 2 * (bitToInt c1) + (bitToInt a0) - (bitToInt c0) :: Integer
    (x0, y0) <- case neededXYCount of
        0 -> Just (False, False)
        1 -> Just (False, True)
        2 -> Just (True, True)
        _ -> Nothing
    return (X $ nx*2+ (bitToInt x0), Y $ ny*2+(bitToInt y0), NeedCarry c0)

interactor :: String -> String
interactor str = let a :: Integer
                     [a, b] = map read $ lines str
                 in unlines $ [printRes $ solver (A a) (B b)]

main = interact interactor


import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

type SIO = StateT P.ByteString IO

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

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

solve :: [Int] -> Int -> Int
solve h k = stepSolve [(0, maxBound)] (zip [1..] h) k

stepSolve :: [(Int, Int)] -> [(Int, Int)] -> Int -> Int
stepSolve _ [] _ = 0-1 -- fall off
stepSolve [] _ _ = error "(maxBound :: Int) is too small??"
stepSolve stack@((_, lastH) : tstack) vs@(nextV@(nextPos, nextH) : tvs) k
  | lastH >= nextH  = stepSolve (nextV : stack) tvs k
  | otherwise  = case  tstack  of
      [] -> error "(maxBound :: Int) is too small??"
      (ancPos, ancH) : _ -> let
        width = (nextPos - ancPos - 1)
        depth = min ancH nextH - lastH
        vol = width * depth
        in  if  k <= vol
        then  nextPos - 1 - mod (k-1) width
        else  if  ancH <= nextH
        then  stepSolve tstack vs (k - vol)
        else  stepSolve (nextV : tstack) tvs (k - vol)

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [_n, k] <- readInts
    h <- readInts
    lift . print $ solve h k

chunksOf :: Int -> [a] -> [[a]]
chunksOf x [] = []
chunksOf x l = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map read . words

simulation :: ([Int], Int) -> ([Int], Int)
simulation ([], _) = ([], -1)
simulation ([x], _) = ([x], -1)
simulation (x : y : t, p) = if x >= y then f x $ simulation (y : t, p)
                              else (x + 1 : y : t, 1)
    where f x (hs, -1) = (x : hs, -1)
          f x (hs,  p) = (x : hs, p + 1)

solve :: Int -> [Int] -> Int
solve k hs = if k >= 11000 then -1
             else snd (iterate simulation (hs, 0) !! k)

main :: IO ()
main = interact (unlines . map (show . uncurry solve . getInput) . chunksOf 2 . tail . lines)
    where getInput [a, b] = let [_, k] = toArr a in (k, toArr b)

chunksOf :: Int -> [a] -> [[a]]
chunksOf x [] = []
chunksOf x l = take x l : chunksOf x (drop x l)

toArr :: Read a => String -> [a]
toArr = map (read :: Read a => String -> a) . words

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

solve :: Int -> Int -> String -> Bool
solve px py s = count 'U' s >= py &&
                count 'D' s >= -py &&
                count 'R' s >= px &&
                count 'L' s >= -px
    where count x = length . filter (==x)

main :: IO ()
main = interact (unlines . map (fmtB . uncurry3 solve . getInput) . chunksOf 2 . tail . lines)
    where getInput [a, b] = let [px, py] = toArr a in (px, py, b)
          uncurry3 f (a,b,c) = f a b c