{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

{- based on submission 2997762 by Dabek -}

import Control.Monad
import Data.Array (Array)
import Data.Array.MArray
import Data.Array.IO
import Data.Array.Unboxed (UArray)
import Data.Array.IArray ((!),bounds)
import qualified Data.Array.MArray as M
import Data.List
import Data.Ord
import Debug.Trace
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf
import Data.Time.Clock (getCurrentTime,diffUTCTime)

{- -O2 provides small, but noticable benefit for qsort. -}
-- Copyright  2010 Bart Massey
-- Copyright  2012 Petr Pudlak

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

{-# INLINE insertsort #-}
insertsort :: (MArray a e m, Ord e) => a Int e -> m ()
insertsort a = getBounds a >>= uncurry (insertsort' (return ()) a)

{-# INLINE insertsort' #-}
insertsort' :: (MArray a e m, Ord e) => m () -> a Int e -> Int -> Int -> m ()
insertsort' cmpaction a mn mx = srt (mn + 1)
  where
    srt i = when (i <= mx) $ do
                v <- readArray a i
                j <- hole v i
                when (i /= j) (writeArray a j v)
                srt (i + 1)
    hole v = hole'
      where
        hole' i | i == mn     = return i
                | otherwise   = do
                    let i' = i - 1
                    u <- readArray a i'
                    cmpaction
                    if v < u
                      then writeArray a i u >> hole' i'
                      else return i

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

-- Internally, heap indices are transformed
-- to be zero-based.

data NodeType = Inner | Leaf | Edge

{-# INLINE heapsort #-}
heapsort :: (Integral i, Ix i, Ord e, MArray a e m) => a i e -> m ()
-- | Sort the elements of the given 'MArray' in increasing order.
heapsort a = getBounds a >>= uncurry (heapsort' a)

{-# INLINE heapsort' #-}
heapsort' :: (Integral i, Ix i, Ord e, MArray a e m) => a i e -> i -> i -> m ()
-- | Sort the elements of the given 'MArray' in increasing order.
heapsort' a mn mx = do
    heapify
    extract
  where
    getN = mx - mn + 1

    {-# INLINE right #-}
    right i = 2 * i + 2

    {-# INLINE nodeType #-}
    nodeType n i = case compare (right i) n of
        GT  -> Leaf
        EQ  -> Edge
        LT  -> Inner

    {-# INLINE atIndex #-}
    atIndex i = readArray a (i + mn)

    {-# INLINE atIndexW #-}
    atIndexW i = writeArray a (i + mn)

    {-# INLINE downHeap #-}
    downHeap n j = do
        c <- atIndex j
        dh c j
      where
        -- Propagate @c@ down the heap. We only move elements up as we walk on
        -- the nodes, and when we're finished, we write @c@ to the last node.
        -- This way we save half of read/writes, compared to swapping elements.
        dh c = dhStep
          where
            dhStep i = case nodeType n i of
                Leaf -> stop
                Edge -> do
                    l <- atIndex il
                    if c < l
                      then atIndexW i l >> atIndexW il c
                      else stop
                Inner -> do
                    l <- atIndex il
                    r <- atIndex ir
                    if c >= l && c >= r
                      then stop
                      else if l >= r
                        then atIndexW i l >> dhStep il
                        else atIndexW i r >> dhStep ir
              where
                {-# INLINE stop #-}
                stop = when (i /= j) (atIndexW i c)
                ir = right i
                il = ir - 1

    {-# INLINE heapify #-}
    heapify = heapifyRoots (n - 1) -- optimize: use 2^k such that k is maximal that 2^k < n
      where
        n = getN
        heapifyRoots i | i < 0  = return ()
                       | otherwise = downHeap n i >> heapifyRoots (i - 1)

    {-# INLINE exch #-}
    exch ix1 ix2 | ix1 == ix2   = return ()
                 | otherwise    = do
      let i = ix1 + mn
          j = ix2 + mn
      v1 <- readArray a i
      v2 <- readArray a j
      writeArray a j v1
      writeArray a i v2

    {-# INLINE extract #-}
    extract = extractRoot (getN - 1)
      where
        extractRoot k | k <= 0    = return ()
                      | otherwise = do
            exch k 0
            downHeap k 0
            extractRoot (k - 1)

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

insertsortLimit :: Int
insertsortLimit = 32

depthCoeficient :: Double
depthCoeficient = 2 / log 2

{-# INLINE qsort #-}
qsort :: (MArray a e m, Ord e) => a Int e -> m ()
qsort = introsort' (return ()) ( -1 )

{-# INLINE maxQSortDepth #-}
maxQSortDepth :: (MArray a e m) => a Int e -> m Int
maxQSortDepth arr = do
    (mn, mx) <- getBounds arr
    return $ ceiling (depthCoeficient * log (fromIntegral $ mx - mn + 1))

{-# INLINE introsort #-}
introsort :: (MArray a e m, Ord e) => a Int e -> m ()
introsort arr = maxQSortDepth arr >>= \d -> introsort' (return ()) d arr

{-# INLINE introsort' #-}
introsort' :: (MArray a e m, Ord e) => m () -> Int -> a Int e -> m ()
introsort' cmpaction maxdepth a = getBounds a >>= uncurry (srt maxdepth)
  where
    srt depthleft mn mx
        | depthleft == 0             = heapsort' a mn mx
        | mn + insertsortLimit > mx  = insertsort' cmpaction a mn mx
        | otherwise = do
                -- Select a pivot - median of 3:
                pL <- readArray a mn
                pR <- readArray a mx
                let d = (mn + mx) `div` 2
                pD <- readArray a d
                cmpaction
                let (_, pidx) = median3 (pR, mx) (pD, d) (pL, mn)

                p <- swap d mn
                i <- split p (mn + 1) mx
                swap i mn

                let depthleft' = depthleft - 1
                -- Sort the smaller part first. Hopefully, tail
                -- recursion will catch on the larger part and so we'll
                -- have guaranteed that even in the worst case, we'll
                -- have at most (log n) calls on the stack.
                if i < d then do
                    srt depthleft' mn (i - 1)
                    srt depthleft' (i + 1) mx
                 else do
                    srt depthleft' (i + 1) mx
                    srt depthleft' mn (i - 1)
      where
        {-# INLINE swap #-}
        swap i j = do
            u <- readArray a i
            when (i /= j) $ do
                v <- readArray a j
                writeArray a i v
                writeArray a j u
            return u
        {-# INLINE split #-}
        split p = split'
          where
            split' i j = do
              i' <- moveRight i
              j' <- moveLeft j
              if i' < j'
                then swap i' j' >> split' (i' + 1) (j' - 1)
                else return j'
              where
                moveRight i | i > j = return i
                            | otherwise = do
                    v <- readArray a i
                    cmpaction
                    if v >= p
                        then return i
                        else moveRight (i + 1)
                moveLeft j | i > j = return j
                           | otherwise = do
                    v <- readArray a j
                    cmpaction
                    if v <= p
                        then return j
                        else moveLeft (j - 1)

{-# INLINE median3 #-}
median3 :: Ord a => a -> a -> a -> a
median3 a b c
    | a > b     = sel a b
    | otherwise = sel b a
  where
    sel l s | c > l     = l
            | c < s     = s
            | otherwise = c

-- ---------------------------
bigPrime = 10^(9::Int)+7 :: Int

newtype Modular = M { unModular :: Int }
  deriving (Show)

instance Num Modular where
  fromInteger x = M $ mod (fromInteger x) bigPrime
  (M x) + (M y) = M $ mod (x+y) bigPrime
  (M x) * (M y) = M $ mod (x*y) bigPrime
  (M x) - (M y) = M $ mod (x-y) bigPrime
  abs = undefined
  signum = undefined

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

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

inc arr i b = do v <- readArray arr i; writeArray arr i (v+b)

showArray label arr = do
  let (lo,hi) = bounds arr
  putStr $ label ++ ": "
  forM_ [lo..hi] $ \i -> do putStr $ printf "%3d " (arr!i)
  putStrLn ""

showTime start label = do
  now <- getCurrentTime
  let diff = diffUTCTime now start
  putStrLn $ label ++ ": " ++ show diff

-- return the first index i s.t. pred (arr!i) is True
lowerBound arr a b pred = go a (b-a)
  where go a count =
          if count > 0
            then let mid = a + step
                     step = div count 2
                 in if pred (arr!mid) then go a step
                                      else go (mid+1) (count-step-1)
            else a

solve n 0 = return 0
solve n m = do
  -- start <- getCurrentTime
  let mark label = return () -- showTime start label
      m' = m+1
  arr <- newArray (0,m') (0,0) :: IO (IOArray Int (Int,Int))

  writeArray arr 0 (0,-1)
  forM_ [1..m] $ \i -> do
    (a:b:_) <- fmap (parseInts 2) BS.getLine
    writeArray arr i (b,a)
  writeArray arr m' (n+1,n)
  mark "read buses"

  qsort arr
  arr <- M.freeze arr :: IO (Array Int (Int,Int))

  -- putStrLn $ show $ arr ! (m-1)
  mark "sorted"

  res    <- newArray (0,m')   0 :: IO (IOUArray Int Int)
  prefix <- newArray (0,m'+1) 0 :: IO (IOUArray Int Int)
  mark "newArray"

  writeArray prefix 1 1
  writeArray res 1 1
  forM_ [1..m'] $ \i -> do
    let (t,s) = arr!i
        left  = lowerBound arr 0 i (\(t',s') -> t' >= s)
        right = lowerBound arr 0 i (\(t',s') -> t' >= t)
    pr <- readArray prefix right
    pl <- readArray prefix left
    writeArray res    i     (mod (pr-pl)    bigPrime)
    pi <- readArray prefix i
    writeArray prefix (i+1) (mod (pi+pr-pl) bigPrime)

  readArray res m'

main = do
  (n:m:_) <- getIntList
  answer <- solve n m
  print answer

{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Array (Array)
import Data.Array.MArray
import Data.Array.IO
import Data.Array.Unboxed (UArray)
import Data.Array.IArray ((!),bounds)
import qualified Data.Array.MArray as M
import Data.List
import Data.Ord
import Debug.Trace
import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char
import Text.Printf
import Data.Time.Clock (getCurrentTime,diffUTCTime)

{- -O2 provides small, but noticable benefit for qsort. -}
-- Copyright  2010 Bart Massey
-- Copyright  2012 Petr Pudlak

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

{-# INLINE insertsort #-}
insertsort :: (MArray a e m, Ord e) => a Int e -> m ()
insertsort a = getBounds a >>= uncurry (insertsort' (return ()) a)

{-# INLINE insertsort' #-}
insertsort' :: (MArray a e m, Ord e) => m () -> a Int e -> Int -> Int -> m ()
insertsort' cmpaction a mn mx = srt (mn + 1)
  where
    srt i = when (i <= mx) $ do
                v <- readArray a i
                j <- hole v i
                when (i /= j) (writeArray a j v)
                srt (i + 1)
    hole v = hole'
      where
        hole' i | i == mn     = return i
                | otherwise   = do
                    let i' = i - 1
                    u <- readArray a i'
                    cmpaction
                    if v < u
                      then writeArray a i u >> hole' i'
                      else return i

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

-- Internally, heap indices are transformed
-- to be zero-based.

data NodeType = Inner | Leaf | Edge

{-# INLINE heapsort #-}
heapsort :: (Integral i, Ix i, Ord e, MArray a e m) => a i e -> m ()
-- | Sort the elements of the given 'MArray' in increasing order.
heapsort a = getBounds a >>= uncurry (heapsort' a)

{-# INLINE heapsort' #-}
heapsort' :: (Integral i, Ix i, Ord e, MArray a e m) => a i e -> i -> i -> m ()
-- | Sort the elements of the given 'MArray' in increasing order.
heapsort' a mn mx = do
    heapify
    extract
  where
    getN = mx - mn + 1

    {-# INLINE right #-}
    right i = 2 * i + 2

    {-# INLINE nodeType #-}
    nodeType n i = case compare (right i) n of
        GT  -> Leaf
        EQ  -> Edge
        LT  -> Inner

    {-# INLINE atIndex #-}
    atIndex i = readArray a (i + mn)

    {-# INLINE atIndexW #-}
    atIndexW i = writeArray a (i + mn)

    {-# INLINE downHeap #-}
    downHeap n j = do
        c <- atIndex j
        dh c j
      where
        -- Propagate @c@ down the heap. We only move elements up as we walk on
        -- the nodes, and when we're finished, we write @c@ to the last node.
        -- This way we save half of read/writes, compared to swapping elements.
        dh c = dhStep
          where
            dhStep i = case nodeType n i of
                Leaf -> stop
                Edge -> do
                    l <- atIndex il
                    if c < l
                      then atIndexW i l >> atIndexW il c
                      else stop
                Inner -> do
                    l <- atIndex il
                    r <- atIndex ir
                    if c >= l && c >= r
                      then stop
                      else if l >= r
                        then atIndexW i l >> dhStep il
                        else atIndexW i r >> dhStep ir
              where
                {-# INLINE stop #-}
                stop = when (i /= j) (atIndexW i c)
                ir = right i
                il = ir - 1

    {-# INLINE heapify #-}
    heapify = heapifyRoots (n - 1) -- optimize: use 2^k such that k is maximal that 2^k < n
      where
        n = getN
        heapifyRoots i | i < 0  = return ()
                       | otherwise = downHeap n i >> heapifyRoots (i - 1)

    {-# INLINE exch #-}
    exch ix1 ix2 | ix1 == ix2   = return ()
                 | otherwise    = do
      let i = ix1 + mn
          j = ix2 + mn
      v1 <- readArray a i
      v2 <- readArray a j
      writeArray a j v1
      writeArray a i v2

    {-# INLINE extract #-}
    extract = extractRoot (getN - 1)
      where
        extractRoot k | k <= 0    = return ()
                      | otherwise = do
            exch k 0
            downHeap k 0
            extractRoot (k - 1)

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

insertsortLimit :: Int
insertsortLimit = 32

depthCoeficient :: Double
depthCoeficient = 2 / log 2

{-# INLINE qsort #-}
qsort :: (MArray a e m, Ord e) => a Int e -> m ()
qsort = introsort' (return ()) ( -1 )

{-# INLINE maxQSortDepth #-}
maxQSortDepth :: (MArray a e m) => a Int e -> m Int
maxQSortDepth arr = do
    (mn, mx) <- getBounds arr
    return $ ceiling (depthCoeficient * log (fromIntegral $ mx - mn + 1))

{-# INLINE introsort #-}
introsort :: (MArray a e m, Ord e) => a Int e -> m ()
introsort arr = maxQSortDepth arr >>= \d -> introsort' (return ()) d arr

{-# INLINE introsort' #-}
introsort' :: (MArray a e m, Ord e) => m () -> Int -> a Int e -> m ()
introsort' cmpaction maxdepth a = getBounds a >>= uncurry (srt maxdepth)
  where
    srt depthleft mn mx
        | depthleft == 0             = heapsort' a mn mx
        | mn + insertsortLimit > mx  = insertsort' cmpaction a mn mx
        | otherwise = do
                -- Select a pivot - median of 3:
                pL <- readArray a mn
                pR <- readArray a mx
                let d = (mn + mx) `div` 2
                pD <- readArray a d
                cmpaction
                let (_, pidx) = median3 (pR, mx) (pD, d) (pL, mn)

                p <- swap d mn
                i <- split p (mn + 1) mx
                swap i mn

                let depthleft' = depthleft - 1
                -- Sort the smaller part first. Hopefully, tail
                -- recursion will catch on the larger part and so we'll
                -- have guaranteed that even in the worst case, we'll
                -- have at most (log n) calls on the stack.
                if i < d then do
                    srt depthleft' mn (i - 1)
                    srt depthleft' (i + 1) mx
                 else do
                    srt depthleft' (i + 1) mx
                    srt depthleft' mn (i - 1)
      where
        {-# INLINE swap #-}
        swap i j = do
            u <- readArray a i
            when (i /= j) $ do
                v <- readArray a j
                writeArray a i v
                writeArray a j u
            return u
        {-# INLINE split #-}
        split p = split'
          where
            split' i j = do
              i' <- moveRight i
              j' <- moveLeft j
              if i' < j'
                then swap i' j' >> split' (i' + 1) (j' - 1)
                else return j'
              where
                moveRight i | i > j = return i
                            | otherwise = do
                    v <- readArray a i
                    cmpaction
                    if v >= p
                        then return i
                        else moveRight (i + 1)
                moveLeft j | i > j = return j
                           | otherwise = do
                    v <- readArray a j
                    cmpaction
                    if v <= p
                        then return j
                        else moveLeft (j - 1)

{-# INLINE median3 #-}
median3 :: Ord a => a -> a -> a -> a
median3 a b c
    | a > b     = sel a b
    | otherwise = sel b a
  where
    sel l s | c > l     = l
            | c < s     = s
            | otherwise = c

-- ---------------------------
bigPrime = 10^(9::Int)+7 :: Int

newtype Modular = M { unModular :: Int }
  deriving (Show)

instance Num Modular where
  fromInteger x = M $ mod (fromInteger x) bigPrime
  (M x) + (M y) = M $ mod (x+y) bigPrime
  (M x) * (M y) = M $ mod (x*y) bigPrime
  (M x) - (M y) = M $ mod (x-y) bigPrime
  abs = undefined
  signum = undefined

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

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

inc arr i b = do v <- readArray arr i; writeArray arr i (v+b)

showArray label arr = do
  let (lo,hi) = bounds arr
  putStr $ label ++ ": "
  forM_ [lo..hi] $ \i -> do putStr $ printf "%3d " (arr!i)
  putStrLn ""

showTime start label = do
  now <- getCurrentTime
  let diff = diffUTCTime now start
  putStrLn $ label ++ ": " ++ show diff

solve n 0 = return 0
solve n m = do
  -- start <- getCurrentTime
  let mark label = return () -- showTime start label
  arr <- newArray (0,m-1) (0,0) :: IO (IOArray Int (Int,Int))
  forM_ [0..m-1] $ \i -> do
    (a:b:_) <- fmap (parseInts 2) BS.getLine
    writeArray arr i (b,a)
  mark "read buses"

  qsort arr
  arr <- M.freeze arr :: IO (Array Int (Int,Int))

  -- putStrLn $ show $ arr ! (m-1)
  mark "sorted"

  barr <- newArray (0,m) 0 :: IO (IOUArray Int Int)
  carr <- newArray (0,m) 0 :: IO (IOUArray Int Int)
  mark "newArray"

  let getFst i = fst $ arr!i
      getSnd i = snd $ arr!i

  writeArray barr 1 (getFst 0)
  writeArray carr 0 1
  let eloop e i | i >= m = return e
      eloop e i = do
        if getFst i /= getFst (i-1)
          then do let e' = e+1
                  writeArray barr e' (getFst i)
                  writeArray carr i e'
                  eloop e' (i+1)
          else do writeArray carr i e; eloop e (i+1)

  elast <- eloop 1 1
  mark "eloop"

  barr <- M.freeze barr :: IO (UArray Int Int)
  carr <- M.freeze carr :: IO (UArray Int Int)
  mark "freezes"

  if barr!elast /= n
    then do return 0
    else do farr <- newArray (0,m) 0 :: IO (IOUArray Int Int)
            sarr <- newArray (0,m) 0 :: IO (IOUArray Int Int)
            writeArray farr 0 1
            writeArray sarr 0 1

            forM_ [0..m-1] $ \i -> do
              let binsearch left right | left < right =
                    let h = div (left+right) 2
                    in if (barr!h) < getSnd i then binsearch (h+1) right
                                              else binsearch left h
                  binsearch left right = right
              let r = binsearch 0 (carr!i)
              let k = carr!i
              when (r < k) $ do
                s1 <- readArray sarr (k-1)
                s2 <- if r > 0 then readArray sarr (r-1) else return 0
                v <- readArray farr k
                writeArray farr k (mod (v+s1-s2) bigPrime)
              when (k /= carr!(i+1)) $ do
                a <- readArray sarr (k-1)
                b <- readArray farr k
                writeArray sarr k (mod (a+b) bigPrime)
            answer <- readArray farr elast
            return answer

main = do
  (n:m:_) <- getIntList
  answer <- solve n m
  print answer

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
import qualified Data.IntMap.Strict as M
import Debug.Trace

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

-- find the first index i in [a,b) where pred (arr!i) is True
lowerBound arr a b pred = go a (b-a)
  where go a count =
          if count > 0
            then let mid = a + step
                     step = div count 2
                 in if pred (arr!mid) then go a step
                                      else go (mid+1) (count-step-1)
            else a

inc :: Int -> M.IntMap Int -> Int -> M.IntMap Int
inc k m by = M.insert k v m
  where v = mod (by + M.findWithDefault 0 k m) bigPrime

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

bigPrime = 10^9+7 :: Int

sum' xs = foldl' (\s x -> mod (s+x) bigPrime) 0 xs

main = do
  (n:m:_) <- getIntList
  buses <- fmap ([(0,0)] ++) $ replicateM m $ do (a:b:_) <- getIntList; return (a,b)
  let byEnd = sortBy (comparing snd) buses
      arr = listArray (1,m) byEnd :: Array Int (Int,Int)
      loop cnts (s,t) =
        let i = lowerBound arr 1 (m+1) (\(s',t') -> s <= t')
            bs = filter (\b -> snd b < t) [ arr!k | k <- [i..m] ]
              where hoo x = trace msg x
                      where msg = "--- buses for " ++ show (s,t) ++ " = " ++ show x
            cs = [ M.findWithDefault 0 t' cnts | (_,t') <- bs ]
            cnts' = inc t cnts (sum' cs)
        in cnts'
      cnts = foldl' loop (M.insert 0 1 M.empty) byEnd
      answer = M.findWithDefault 0 n cnts
  print answer

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
import qualified Data.IntMap.Strict as M
import Debug.Trace

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

-- find the first index i in [a,b) where pred (arr!i) is True
lowerBound arr a b pred = go a (b-a)
  where go a count =
          if count > 0
            then let mid = a + step
                     step = div count 2
                 in if pred (arr!mid) then go a step
                                      else go (mid+1) (count-step-1)
            else a

inc :: Int -> M.IntMap Int -> Int -> M.IntMap Int
inc k m by = M.insert k v m
  where v = mod (by + M.findWithDefault 0 k m) bigPrime

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

bigPrime = 10^9+7 :: Int

sum' xs = foldl' (\s x -> mod (s+x) bigPrime) 0 xs

main = do
  (n:m:_) <- getIntList
  buses <- fmap ([(0,0)] ++) $ replicateM m $ do (a:b:_) <- getIntList; return (a,b)
  let byEnd = sortBy (comparing snd) buses
      arr = listArray (1,m) byEnd :: Array Int (Int,Int)
      loop cnts (s,t) =
        let cs = [ M.findWithDefault 0 t' cnts | (_,t') <- buses, s <= t' && t' < t ]
            cnts' = inc t cnts (sum' cs)
        in cnts'
      cnts = foldl' loop (M.insert 0 1 M.empty) byEnd
      answer = M.findWithDefault 0 n cnts
  print answer

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
import qualified Data.IntMap.Strict as M
import Debug.Trace

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

-- find the first index i in [a,b) where pred (arr!i) is True
lowerBound arr a b pred = go a (b-a)
  where go a count =
          if count > 0
            then let mid = a + step
                     step = div count 2
                 in if pred (arr!mid) then go a step
                                      else go (mid+1) (count-step-1)
            else a

inc :: Int -> M.IntMap Int -> Int -> M.IntMap Int
inc k m by = M.insert k v m
  where v = by + M.findWithDefault 0 k m

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

main = do
  (n:m:_) <- getIntList
  buses <- fmap ([(0,0)] ++) $ replicateM m $ do (a:b:_) <- getIntList; return (a,b)
  let byEnd = sortBy (comparing snd) buses
      arr = listArray (1,m) byEnd :: Array Int (Int,Int)
      loop cnts (s,t) =
        let i = lowerBound arr 1 (m+1) (\(s',t') -> s <= t')
            bs = filter (\b -> snd b < t) [ arr!k | k <- [i..m] ]
              where hoo x = trace msg x
                      where msg = "--- buses for " ++ show (s,t) ++ " = " ++ show x
            cs = [ M.findWithDefault 0 t' cnts | (_,t') <- bs ]
            cnts' = inc t cnts (sum cs)
        in cnts'
      cnts = foldl' loop (M.insert 0 1 M.empty) byEnd
      answer = M.findWithDefault 0 n cnts
  print answer

import Control.Monad
import Data.Array
import Data.List
import Data.Ord
import qualified Data.IntMap.Strict as M
import Debug.Trace

{-
  c[1] = 1
  c[ y ] = sum [ c[x] | (s,t) <- buses, t == y, (s',x) <- buses, x in [s,t-1] ]
  (1,2) (2,100) (100,200)
-}

-- find the first index i in [a,b) where pred (arr!i) is True
lowerBound arr a b pred = go a (b-a)
  where go a count =
          if count > 0
            then let mid = a + step
                     step = div count 2
                 in if pred (arr!mid) then go a step
                                      else go (mid+1) (count-step-1)
            else a

inc :: Int -> M.IntMap Int -> Int -> M.IntMap Int
inc k m by = M.insert k v m
  where v = mod (by + M.findWithDefault 0 k m) bigPrime

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

bigPrime = 10^9+7 :: Int

main = do
  (n:m:_) <- getIntList
  buses <- fmap ([(0,0)] ++) $ replicateM m $ do (a:b:_) <- getIntList; return (a,b)
  let byEnd = sortBy (comparing snd) buses
      arr = listArray (1,m) byEnd :: Array Int (Int,Int)
      loop cnts (s,t) =
        let i = lowerBound arr 1 (m+1) (\(s',t') -> s <= t')
            bs = filter (\b -> snd b < t) [ arr!k | k <- [i..m] ]
              where hoo x = trace msg x
                      where msg = "--- buses for " ++ show (s,t) ++ " = " ++ show x
            cs = [ M.findWithDefault 0 t' cnts | (_,t') <- bs ]
            cnts' = inc t cnts (sum cs)
        in cnts'
      cnts = foldl' loop (M.insert 0 1 M.empty) byEnd
      answer = M.findWithDefault 0 n cnts
  print answer


import List
s([n,_,k]:t)=sort$h++[(x,0)|x<-map(!!0)v,x`notElem`map fst h]where{(g,v)=splitAt(read n)t;h=g>>=j;j[s,e]|x>99=[(s,x)]|1>0=[]where x=(read e)*read(drop 2 k)`div`100}
p l=show(length l):[a++" "++show b|(a,b)<-l]
main=interact$unlines.p.s.map words.lines

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

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List

parseSkill [skill, exp] = (skill, read exp)

parseRational :: String -> Rational
parseRational = pr . span (/= '.')
  where
    pr (n, "") = fromIntegral (read n)
    pr (a, bb) = fromIntegral (read a) + fromIntegral (read b) / 10 ^ length b
      where
        b = tail bb

main = do
  [read -> (n :: Integer), read -> (m :: Integer), parseRational -> k] <- words <$> getLine
  have <- replicateM (fromInteger n) (parseSkill . words <$> getLine)
  want <- replicateM (fromInteger m) getLine
  let
    r :: (String, Integer) -> [(String, Integer)]
    r (s, e)
      | e' < 100 = []
      | otherwise = [(s, e')]
      where
        e' = floor (fromInteger e * k)
    have' = have >>= r
    have'' = have' ++ map (\s -> (s, 0)) (filter (`notElem` map fst have') want)
    pr (s, e) = putStrLn (s ++ " " ++ show e)

  putStrLn (show $ length have'')
  mapM pr (sortBy (comparing fst) have'')

-- Problem "A" Transmigration --

import Data.List
import Data.Ratio

data Skill = Skill String Int

instance Eq Skill where
  (Skill lhs _) == (Skill rhs _) = lhs == rhs

instance Ord Skill where
  (Skill lhs _) <= (Skill rhs _) = lhs <= rhs

instance Show Skill where
  show (Skill name level) = name ++ " " ++ (show level)

fromPair :: (String, Int) -> Skill
fromPair (name, level) = Skill name level

readRationalEps = 0.0001
skillMinimumLevel = 100

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

readDouble :: String -> Double
readDouble token = read token :: Double

readRational :: String -> Rational
readRational token = approxRational (readDouble token) readRationalEps

stride :: Int -> [a] -> [a]
stride _ []     = []
stride n (x:xs) = x : stride n (drop (n - 1) xs)

scaleSkills :: Rational -> [Skill] -> [Skill]
scaleSkills k = filter validSkill . map scaleSkill
  where validSkill (Skill _ level) = level >= skillMinimumLevel
        scaleSkill (Skill name level) = Skill name
                                              (floor $ k * (toRational level))

solve :: (Rational, [Skill], [Skill]) -> [Skill]
solve (k, rold, rnew) = sort $ old ++ new
  where old = scaleSkills k rold
        new = filter (\s -> notElem s old) rnew

prepareInput :: [String] -> (Rational, [Skill], [Skill])
prepareInput (sn:sm:sk:skills) = (k,
                                  map fromPair $
                                  zip oldSkillNames oldSkillLevels,
                                  map fromPair $
                                  zip newSkillNames newSkillLevels)
  where n = readInt sn
        m = readInt sm
        k = readRational sk
        oldSkillNames = stride 2 $ take (2 * n) skills
        oldSkillLevels = map readInt $ stride 2 $ tail $ take (2 * n) skills
        newSkillNames = drop (2 * n) skills
        newSkillLevels = repeat 0

prepareOutput :: [Skill] -> String
prepareOutput skills = unlines $ [show $ length skills] ++ (map show skills)

main :: IO ()
main = interact (prepareOutput . solve . prepareInput . words)

module Main where

import Control.Monad
import qualified Data.Map as Map
import qualified Data.Set as Set

main = do
    inputNMK <- words `liftM` getLine
    let n = read $ inputNMK !! 0 :: Int
        m = read $ inputNMK !! 1 :: Int
        k = read $ inputNMK !! 2 :: Double

    skill <- foldM (\skill _ -> do
        inputSkill <- words `liftM` getLine
        let name = head inputSkill
            level = read $ inputSkill !! 1 :: Int
        return $ Map.insert name level skill
        ) Map.empty [1..n]

    (skill', new_skill') <- foldM (\(skill, new_skill) _ -> do
        name <- getLine
        return $ (Map.insertWith (\new old ->
            let level = floor $ fromIntegral old * k + 0.00001 :: Int in
            if level < 100
                then 0
                else level
            ) name 0 skill, Set.insert name new_skill)
        ) (skill, Set.empty) [1..m]

    --putStrLn $ show skill
    --putStrLn $ show skill'
    --putStrLn $ show new_skill'

    let res = map (\(k, v) -> k ++ " " ++ show v) $ Map.toList $ Map.filter ( >= 0 ) $ Map.mapWithKey (\name level ->
            if Set.member name new_skill'
            then level
            else let level' = floor $ fromIntegral level * k + 0.00001 :: Int in
            if level' < 100
                then -1
                else level'
            ) skill'
    putStrLn $ show $ length res
    putStr $ unlines res

import List (sortBy)
import Monad (liftM)
import Prelude hiding (reads)

readPair :: String -> (String, Int)
readPair line  =  case words line of
    [a, b]  ->  (a, read b)

readTriple :: String -> (Int, Int, Int)
readTriple line  =  case words line of
    [a, b, c]  ->  (read a, read b, read $ drop 2 c)

solve :: Int -> [(String, Int)] -> [String] -> [(String, Int)]
solve k before after  =  sortBy (\a b -> compare (fst a) (fst b)) answer
  where
    filtered  =  filter ((> 99) . snd) $ mapP id (flip div 100 . (*k)) before
    answer  =  foldl add filtered after
    add ss s
      | elem s (map fst ss)  =  ss
      | otherwise  =  (s, 0) : ss

mapP :: (a -> c) -> (b -> d) -> [(a, b)] -> [(c, d)]
mapP f1 f2 xs  =  map (\(a, b) -> (f1 a, f2 b)) xs

main :: IO ()
main  =  do
    (n, m, k)  <-  liftM readTriple getLine
    lines'  <-  liftM lines getContents
    let before  =  (map readPair . take n) lines'
    let after   =  (take m . drop n) lines'
    let answer  =  solve k before after
    print $ length answer
    mapM_ putStrLn $ map (\(s, x) -> s ++ " " ++ show x) answer

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

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

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

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

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

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

notinc [] _ = True
notinc ((a,_):l) (x,y) = if x==a then False else notinc l (x,y)

solve :: Int -> Int -> Double -> [(String,Int)] -> [String] -> [(String,Int)]
solve n m k old new = sort (old' ++ new')
    where
      old' = filter (\(n,e) -> e>=100) (map (\(n,e) -> (n,floor ((fromIntegral e)*k+0.000001))) old)
      new' = filter (notinc old') [(i,0)|i<-new]

sub n m k old new = let answer = (solve n m k old new)
                    in
                      do putAnsLn (length answer)
                         putAnsLns answer

main = do (n,m,k) <- scan::IO (Int,Int,Double)
          old <- scans n::IO [(String,Int)]
          new <- scans m::IO [String]
          sub n m k old new

import List
q[s,e]=(s,read e)
c(a,_)(b,_)=compare a b
s([n,_,k]:t)=sortBy c$h++map z(filter(`notElem`map fst h)w)where{(g,v)=splitAt(read n)t;w=map(!!0)v;h=map q g>>=j;j(s,e)|x<100=[]|1>0=[(s,x)]where x=e*read(drop 2 k)`div`100}
r(a,b)=a++" "++show b
p l=show(length l):map r l
z x=(x,0)
main=interact$unlines.p.s.map words.lines

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

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

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

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

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

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

notinc [] _ = True
notinc ((a,_):l) (x,y) = if x==a then False else notinc l (x,y)

solve :: Int -> Int -> Double -> [(String,Int)] -> [String] -> [(String,Int)]
solve n m k old new = sort (old' ++ new')
    where
      old' = filter (\(n,e) -> e>100) (map (\(n,e) -> (n,floor ((fromIntegral e)*k+0.000001))) old)
      new' = filter (notinc old') [(i,0)|i<-new]

main = do (n,m,k) <- scan::IO (Int,Int,Double)
          old <- scans n::IO [(String,Int)]
          new <- scans m::IO [String]
          putAnsLns (solve n m k old new)

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

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

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

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

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

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

notinc [] _ = True
notinc ((a,_):l) (x,y) = if x==a then False else notinc l (x,y)

solve :: Int -> Int -> Double -> [(String,Int)] -> [String] -> [(String,Int)]
solve n m k old new = sort (old' ++ new')
    where
      old' = filter (\(n,e) -> e>100) (map (\(n,e) -> (n,floor ((fromIntegral e)*k+0.000001))) old)
      new' = filter (notinc old') [(i,0)|i<-new]

sub n m k old new = let answer = (solve n m k old new)
                    in
                      do putAnsLn (length answer)
                         putAnsLns answer

main = do (n,m,k) <- scan::IO (Int,Int,Double)
          old <- scans n::IO [(String,Int)]
          new <- scans m::IO [String]
          sub n m k old new

import IO
import List

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

getPairs :: IO (String,Int)
getPairs = do ns <- getLine
              return (conv (make_pair [n|n<-(words ns)]))
                  where
                    conv (x,y) = (x,read y::Int)
                    make_pair (x:y:_) = (x,y)
                    make_pair _ = ("0","0")

getPairLines :: Int -> IO [(String,Int)]
getPairLines n = if n > 0 then
                     do l <- getPairs
                        ls <- getPairLines (n-1)
                        return (l:ls)
                 else
                     return []

getStatus :: IO (Int, Int, Float)
getStatus = do l <- getLine
               return (conv [x|x<-(words l)])
                   where
                     conv (x:y:z:_) = (read x::Int ,read y::Int,read z::Float)

getLines :: Int -> IO [String]
getLines n = if n > 0 then
                 do l <- getLine
                    ls <- getLines (n-1)
                    return (l:ls)
             else
                 return []

include [] e = False
include ((x,_):xs) e = if x==e then True else include xs e

toStr str [] = str
toStr str ((x,exp):xs) = toStr ((x ++ " " ++ (show exp)):str) xs

solve :: Float -> Int -> [(String,Int)] -> [String] -> [String]
solve k m skills newskills = mpair (sort (toStr [] (merge (trans [] skills) newskills)))
    where
      trans l [] = l
      trans l ((sk,exp):sks) = let new_exp = (floor ((fromIntegral exp) * k)) in if new_exp < 100 then trans l sks else trans ((sk,new_exp):l) sks
      merge l [] = l
      merge l (x:xs) = if include l x then merge l xs else merge ((x,0):l) xs
      mpair l = (show (length l)):l

putAnsLns [] = putStr ""
putAnsLns (x:xs) = do putStrLn x
                      putAnsLns xs

main = do (n, m, k) <- getStatus
          skills <- getPairLines n
          newskills <- getLines m
          putAnsLns (solve k m skills newskills)

q[s,e]=(s,read e)
s([n,_,k]:t)=h++map z(filter(`notElem`map fst h)w)where{(g,v)=splitAt(read n)t;w=map(!!0)v;h=map q g>>=j;j(s,e)|x<100=[]|1>0=[(s,x)]where x=e*read(drop 2 k)`div`100}
r(a,b)=a++" "++show b
p l=show(length l):map r l
z x=(x,0)
main=interact$unlines.p.s.map words.lines

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

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List

parseSkill [skill, exp] = (skill, read exp)

main = do
  [read -> (n :: Integer), read -> (m :: Integer), read -> (k :: Double)] <- words <$> getLine
  have <- replicateM (fromInteger n) (parseSkill . words <$> getLine)
  want <- replicateM (fromInteger m) getLine
  let
    r (s, e)
      | e' < 100 = []
      | otherwise = [(s, e')]
      where
        e' = floor (fromIntegral e * k)
    have' = have >>= r
    have'' = have' ++ map (\s -> (s, 0)) (filter (`notElem` map fst have') want)
    pr (s, e) = putStrLn (s ++ " " ++ show e)

  putStrLn (show $ length have'')
  mapM pr (sortBy (comparing fst) have'')

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

import Data.Ord
import Control.Applicative
import Control.Monad
import qualified Data.Map as Map
import Data.Map(Map)
import Data.List

parseSkill [skill, exp] = (skill, read exp)

main = do
  [read -> (n :: Integer), read -> (m :: Integer), read -> (k :: Double)] <- words <$> getLine
  have <- replicateM (fromInteger n) (parseSkill . words <$> getLine)
  want <- replicateM (fromInteger m) getLine
  let
    r (s, e)
      | e' < 100 = []
      | otherwise = [(s, e')]
      where
        e' = floor (fromIntegral e * k)
    have' = have >>= r
    have'' = have' ++ map (\s -> (s, 0)) (filter (`notElem` map fst have') want)
    pr (s, e) = putStrLn (s ++ " " ++ show e)

  mapM pr (sortBy (comparing fst) have'')


import Data.List (group, sort)

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve = solve' . group . sort . map length . group . sort . filter (>0)

solve' :: [[Int]] -> Int
solve' xs | any ((>2) . head) xs = -1
          | otherwise = length $ last $ [] : filter ((==2) . head) xs

import Data.List (group, sort)

main = do
    getLine
    ids <- fmap (map read . words) getLine
    let calls = group $ sort $ filter (/=0) ids
    print $ if any ((>2) . length) calls
        then -1
        else length $ filter ((==2) . length) calls

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

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
-- import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
-- import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
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 System.IO
-- import Debug.Trace

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

main = do
  getLine
  as <- getInts

  let
    cs = map snd $ filter (\(x, _) -> x /= 0) $ map (\g -> (head g, length g)) $ group $ sort as

  print $ if any (> 2) cs
             then -1
             else length $ filter (== 2) cs

import Data.List

solve :: [Int] -> Int
solve = estimate . group . sort . filter (0/=)
  where estimate xs | any ((>2) . length) xs = -1
        estimate xs = length $ filter ((==2) . length) xs

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

import Control.Monad (liftM)
import Data.Map.Strict (foldl', fromListWith)
import Prelude hiding (reads)

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

solve :: [Int] -> Int
solve  =  foldl' solve' 0 . fromListWith (+) . flip zip (repeat 1) . filter (/= 0)
  where
    solve' (-1) _  =  -1
    solve' x 1  =  x
    solve' x 2  =  x + 1
    solve' _ _  =  -1

main :: IO ()
main  =  getLine >> reads >>= print . solve

import Data.List
import Control.Applicative

main = do
    n <- getLine
    a <- map read <$> words <$> getLine
    let tmp = map length $ group $ sort $ filter (/= 0) a
    if all (<= 2) tmp
        then print $ length $ filter (== 2) tmp
        else print (- 1)

import Data.List (group, sort)

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve = solve' . map length . group . sort . filter (>0)

solve' :: [Int] -> Int
solve' xs | any (>2) xs = -1
          | otherwise = length $ filter (==2) xs

import Data.List
main=interact$show.g.map length.group.sort.filter(>0).map read.tail.words
g x|any(>2)x= -1|1>0=length$filter(==2)x

import Data.List

clerkPairs :: (Integral a) => [a] -> a
clerkPairs ids = clerkPairs' 0 (group (sort (filter (/= 0) ids)))
  where clerkPairs' n [] = n
        clerkPairs' n (x:xs)
          | length x > 2 = -1
          | length x == 2 = clerkPairs' (n + 1) xs
          | otherwise = clerkPairs' n xs

main = do
  _ <- getLine
  idsInput <- getLine
  let ids = map (read :: String -> Integer) (words idsInput) in print (clerkPairs ids)

import Control.Applicative
import Data.List

main = do
  getLine
  ids <- map read.words <$> getLine
  print $ slv 0.group.sort $ filter (/= 0) ids

slv n [] = n
slv n (x:xs)
  | length x > 2 = -1
  | length x == 2 = slv (n+1) xs
  | otherwise = slv n xs

import Data.List
s l|any(>2)l= -1|1>0=length$filter(==2)l
main=interact$show.s.map length.group.sort.filter(>0).tail.map read.words

conv :: String -> [Int]
conv s = map read (words s)

find :: Int -> [Int] -> Int
find _ [] = 0
find cur (x:xs)
  | cur == x = 1 + find cur xs
  | otherwise = find cur xs

go :: [Int] -> Int
go [] = 0
go (x:xs) = (go ( xs )) + mod
  where cnt = find x xs
        mod
          | cnt == 1 = 1
          | cnt > 1 = - 1000
          | otherwise = 0

solve :: String -> String
solve input = show r
  where list = filter (\x -> x > 0) (drop 1 (conv input))
        ret = go list
        r = max (-1) ret

main = do
  interact solve

module Main where

import Data.List (group, sort)

solve :: [Int] -> Int
solve s | null incorrect = length pairs
        | otherwise      = -1
  where groups = map length . group . sort . filter (/= 0) $ s
        pairs = filter (== 2) groups
        incorrect = filter (> 2) groups

main = do
  numSessions <- getLine
  sessions <- fmap (map read . words) getLine
  putStrLn . show $ solve sessions

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _ <- getLine
  a <- map length . group . sort . filter (/=(0::Int)) . map read . words <$> getLine
  print $ if maximum (0:a) > 2 then -1 else length $ filter (==2) a

import Data.Char(digitToInt)
import Data.List(sort)

toInt::[Char]->Int
toInt x =
 let
     toInt'::[Char]->Int->Int
     toInt' y z =
      if null y
         then z
         else toInt' (tail y) (z*10+(digitToInt (head y)-digitToInt '0'))
 in toInt' x 0

split::[Char]->[Char]->[[Char]]
split x y =
 let
  split'::[Char]->[Char]->[Char]->[[Char]]
  split' _ [] [] = []
  split' _ [] c = [c]
  split' a (b:bs) c =
   if null [t|t<-a,t==b]
   then split' a bs (b:c)
   else (reverse c):(split' a bs [])
 in split' x y []

getAns::[Int]->Int
getAns x =
 let
 getAns'::[Int]->Int->Int->Int->Int
 getAns' [] _ lstCnt ans =
  if lstCnt>2
   then -1
  else if lstCnt==2
   then ans+1
  else
   ans
 getAns' (x:xs) lst lstCnt ans =
  if x/=lst&&lstCnt>2
   then -1
  else if x/=lst&&lstCnt==2
   then getAns' xs x 1 (ans+1)
  else if x==lst
   then getAns' xs lst (lstCnt+1) ans
  else
   getAns' xs x 1 ans
 in getAns' x 0 0 0

main::IO()
main =
 do
 input <- getContents
 let
  numbers = fmap toInt (split " \n" input)
  n = head numbers
  id = sort [x|x<-(tail numbers),x/=0]
 print $ getAns id

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	_ <- getLine
	line <- getLine
	let
		arr = map length. group. filter (/= 0). sort. map (\x -> read x :: Integer). words $ line
		sol :: Int -> [Int] -> Int
		sol x [] = x
		sol x (p:ps)
		 | p > 2 = (-1)
		 | p == 2 = sol (x+1) ps
		 | otherwise = sol x ps
	print $ sol 0 arr

import Data.List (group, sort)

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve = solve' . group . sort . map length . group . sort

solve' :: [[Int]] -> Int
solve' xs | any ((>2) . head) xs = -1
          | otherwise = length $ last $ [] : filter ((==2) . head) xs

conv :: String -> [Int]
conv s = map read (words s)

find :: Int -> [Int] -> Int
find _ [] = 0
find cur (x:xs)
  | cur == x = 1 + find cur xs
  | otherwise = find cur xs

go :: Int -> [Int] -> Int
go _ [] = 0
go x xs = (go ( head xs ) ( tail xs )) + mod
  where cnt = find x xs
        mod
          | cnt == 1 = 1
          | cnt > 1 = - 1000
          | otherwise = 0

solve :: String -> String
solve input = show r
  where (x:xs) = drop 1 (conv input)
        ret = go x xs
        r = max (-1) ret

main = do
  interact solve

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	_ <- getLine
	line <- getLine
	let
		arr = map fromIntegral.map length. group. filter (/= 0). sort. map (\x -> read x :: Integer). words $ line
		sol :: [Integer] -> Int
		sol [] = 0
		sol (p:ps)
		 | p > (2::Integer) = (-1)
		 | p == (2::Integer) = (1::Int) + sol ps
		 | p == (1::Integer) = sol ps
		 | otherwise = error "something wrong"
	print $ sol arr

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	line <- getLine
	line2 <- getLine
	let
		n = read line ::Int
		arr = map length. group. filter (/= 0). sort. map (\x -> read x :: Int). words $ line2
		sol :: [Int] -> Int
		sol [] = 0
		sol (p:ps)
		 | p > 2 = (-1)
		 | p == 2 = 1 + sol ps
		 | otherwise = sol ps
	print $ sol arr

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	_ <- getLine
	line <- getLine
	let
		arr = map length. group. filter (/= 0). sort. map (\x -> read x :: Integer). words $ line
		sol :: [Int] -> Int
		sol [] = 0::Int
		sol (p:ps)
		 | p > 2 = (-1)
		 | p == 2 = (1::Int) + sol ps
		 | p == 1 = sol ps
		 | otherwise = error "something wrong"
	print $ sol arr

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char

main :: IO ()
main = do
	line <- getLine
	line2 <- getLine
	let
		n = read line ::Int
		arr = map length. group. sort. map (\x -> read x :: Int). words $ line2
		sol :: [Int] -> Int
		sol [] = 0
		sol (p:ps)
		 | p > 2 = (-1)
		 | p == 2 = 1 + sol ps
		 | otherwise = sol ps
	print $ sol arr

module Main where

import Data.List (group, sort)

solve :: [Int] -> Int
solve s | null incorrect = length pairs
        | otherwise      = -1
  where groups = map length . group $ sort s
        pairs = filter (== 2) groups
        incorrect = filter (> 2) groups

main = do
  numSessions <- getLine
  sessions <- fmap (map read . words) getLine
  putStrLn . show $ solve sessions

import Data.Char(digitToInt)
import Data.List(sort)

toInt::[Char]->Int
toInt x =
 let
     toInt'::[Char]->Int->Int
     toInt' y z =
      if null y
         then z
         else toInt' (tail y) (z*10+(digitToInt (head y)-digitToInt '0'))
 in toInt' x 0

split::[Char]->[Char]->[[Char]]
split x y =
 let
  split'::[Char]->[Char]->[Char]->[[Char]]
  split' _ [] [] = []
  split' _ [] c = [c]
  split' a (b:bs) c =
   if null [t|t<-a,t==b]
   then split' a bs (b:c)
   else (reverse c):(split' a bs [])
 in split' x y []

getAns::[Int]->Int
getAns x =
 let
 getAns'::[Int]->Int->Int->Int
 getAns' [] _ lstCnt =
  if lstCnt>2
   then -1
  else if lstCnt==2
   then 1
  else
   0
 getAns' (x:xs) lst lstCnt =
  if x/=lst&&lstCnt>2
   then -1
  else if x/=lst&&lstCnt==2
   then 1+(getAns' xs x 1)
  else if x==lst
   then getAns' xs lst (lstCnt+1)
  else
   getAns' xs x 1
 in getAns' x 0 0

main::IO()
main =
 do
 input <- getContents
 let
  numbers = fmap toInt (split " \n" input)
  n = head numbers
  id = sort [x|x<-(tail numbers),x/=0]
 print $ getAns id

import Data.Char(digitToInt)
import Data.List(sort)

toInt::[Char]->Int
toInt x =
 let
     toInt'::[Char]->Int->Int
     toInt' y z =
      if null y
         then z
         else toInt' (tail y) (z*10+(digitToInt (head y)-digitToInt '0'))
 in toInt' x 0

split::[Char]->[Char]->[[Char]]
split x y =
 let
  split'::[Char]->[Char]->[Char]->[[Char]]
  split' _ [] [] = []
  split' _ [] c = [c]
  split' a (b:bs) c =
   if null [t|t<-a,t==b]
   then split' a bs (b:c)
   else (reverse c):(split' a bs [])
 in split' x y []

getAns::[Int]->Int
getAns x =
 let
 getAns'::[Int]->Int->Int->Int->Int
 getAns' [] _ lstCnt ans =
  if lstCnt>2
   then -1
  else if lstCnt==2
   then ans+1
  else
   ans
 getAns' (x:xs) lst lstCnt ans =
  if x/=lst&&lstCnt>2
   then -1
  else if x/=lst&&lstCnt==2
   then getAns' xs lst lstCnt (ans+1)
  else if x==lst
   then getAns' xs lst (lstCnt+1) ans
  else
   getAns' xs x 1 ans
 in getAns' x 0 0 0

main::IO()
main =
 do
 input <- getContents
 let
  numbers = fmap toInt (split " \n" input)
  n = head numbers
  id = sort [x|x<-(tail numbers),x/=0]
 print $ getAns id


import Maybe (isNothing)
import List (sortBy, tails, find, group)
import Array (Array, array, bounds, elems, assocs, accumArray, (!), (//))

crossing :: ((Int, (Int, Int)), (Int, (Int, Int))) -> Bool
crossing ((_, (a, b)), (_, (c, d))) = a < c && c < b && b < d ||
                                      c < a && a < d && d < b

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs = concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
           filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
    indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs

bicolor :: Array Int [Int] -> Maybe (Array Int (Maybe Bool))
bicolor g =
  let (a, b) = bounds g in
  loop (array (a, b) ((a, Just False):[(i, Nothing) | i <- [a+1..b]])) [1]
  where
    loop colors [] =
      case find (isNothing . snd) (assocs colors) of
        Just (i, _) -> loop (colors // [(i, Just False)]) [i]
        Nothing -> Just colors
    loop colors (v:vs) =
      if all correct adj then
        let new = filter (\v' -> isNothing (colors ! v')) adj in
        loop (colors // [(v', Just (not c)) | v' <- new]) (vs ++ new)
      else
        Nothing
      where
        Just c = colors ! v
        adj = g ! v
        correct v' = case colors ! v' of
                       Just c' -> c' == not c
                       Nothing -> True

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    Just a -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    Nothing -> "Impossible"

solve xs = answer n roads
  where
    n = read $ (!! 1) $ words $ head ls
    roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
    ls = lines xs

main = interact solve

import Data.Array.MArray (newArray, writeArray, readArray)
import List (tails)
import Array (Array, bounds, elems, indices, accumArray, (!))
import Data.Array.MArray (unsafeFreeze)
import Data.Array.ST (STArray)
import Control.Monad (forM, when)
import Control.Monad.ST (ST, runST)

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs =
  concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
            filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
  indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs
  crossing ((_, (a, b)), (_, (c, d))) = a < c && c < b && b < d ||
                                        c < a && a < d && d < b

bicolor g = runST $ do
  colors <- newArray (bounds g) Nothing :: ST s (STArray s Int (Maybe Bool))
  flags <- forM (indices g) $ \v -> do
    c <- readArray colors v
    if c == Nothing then dfs colors v True
                    else return True
  if all id flags then do
      result <- unsafeFreeze colors
      return (Just result)
    else
      return Nothing
  where
  dfs colors v color = do
    c <- readArray colors v
    case c of
      Nothing -> do
        writeArray colors v (Just color)
        flags <- forM (g ! v) $ \v' ->
          dfs colors v' (not color)
        return (all id flags)
      Just c | c == color -> return True
             | otherwise  -> return False

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    Just a -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    Nothing -> "Impossible"

solve xs = answer n roads
  where
  n = read $ (!! 1) $ words $ head ls
  roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
  ls = lines xs

main = interact solve

import Maybe (isNothing)
import List (sortBy, tails, find, group)
import Array (Array, array, bounds, elems, assocs, accumArray, (!), (//))

crossing :: ((Int, (Int, Int)), (Int, (Int, Int))) -> Bool
crossing ((_, (a, b)), (_, (c, d))) = check $
                            sortBy (\ (a, _, _) (b, _, _) -> compare a b) $
                            [(a, False, 0), (b, True, 0),
                             (c, False, 1), (d, True, 1)]
  where
    check [(a, False, na), (b, False, nb), (c, True, nc), (d, True, nd)]
          | na == nc && nb == nd && (length $ group $ [a, b, c, d]) == 4 = True
    check _ = False

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs = concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
           filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
    indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs

bicolor :: Array Int [Int] -> Maybe (Array Int (Maybe Bool))
bicolor g =
  let (a, b) = bounds g in
  loop (array (a, b) ((a, Just False):[(i, Nothing) | i <- [a+1..b]])) [1]
  where
    loop colors [] =
      case find (isNothing . snd) (assocs colors) of
        Just (i, _) -> loop (colors // [(i, Just False)]) [i]
        Nothing -> Just colors
    loop colors (v:vs) =
      if all correct adj then
        let new = filter (\v' -> isNothing (colors ! v')) adj in
        loop (colors // [(v', Just (not c)) | v' <- new]) (vs ++ new)
      else
        Nothing
      where
        Just c = colors ! v
        adj = g ! v
        correct v' = case colors ! v' of
                       Just c' -> c' == not c
                       Nothing -> True

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    Just a -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    Nothing -> "Impossible"

solve xs = answer n roads
  where
    n = read $ (!! 1) $ words $ head ls
    roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
    ls = lines xs

main = interact solve

import Data.Array.MArray (newArray, writeArray, readArray)
import List (tails)
import Array (Array, bounds, elems, indices, accumArray, (!))
import Data.Array.MArray (unsafeFreeze)
import Data.Array.ST (STArray)
import Control.Monad (forM, when)
import Control.Monad.ST.Lazy (ST, runST)

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs =
  concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
            filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
  indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs
  crossing ((_, (a, b)), (_, (c, d))) = a < c && c < b && b < d ||
                                        c < a && a < d && d < b

bicolor g = runST $ do
  colors <- newArray (bounds g) Nothing :: ST s (STArray s Int (Maybe Bool))
  flags <- forM (indices g) $ \v -> do
    c <- readArray colors v
    result <- dfs colors v True
    return (c /= Nothing || result)
  result <- unsafeFreeze colors
  return (all id flags, result)
  where
  dfs colors v color = do
    c <- readArray colors v
    case c of
      Nothing -> do
        writeArray colors v (Just color)
        flags <- forM (g ! v) $ \v' -> dfs colors v' (not color)
        return (all id flags)
      Just c -> return (c == color)

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    (True, a) -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    _ -> "Impossible"

solve xs = answer n roads
  where
  n = read $ (!! 1) $ words $ head ls
  roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
  ls = lines xs

main = interact solve

import Maybe (isNothing)
import List (tails, find)
import Array (Array, array, bounds, elems, assocs, accumArray, (!), (//))

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs = concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
           filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
    indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs
    crossing ((_, (a, b)), (_, (c, d))) = a < c && c < b && b < d ||
                                          c < a && a < d && d < b

bicolor :: Array Int [Int] -> Maybe (Array Int (Maybe Bool))
bicolor g =
  let (a, b) = bounds g in
  loop (array (a, b) ((a, Just False):[(i, Nothing) | i <- [a+1..b]])) [1]
  where
    loop colors [] =
      case find (isNothing . snd) (assocs colors) of
        Just (i, _) -> loop (colors // [(i, Just False)]) [i]
        Nothing -> Just colors
    loop colors (v:vs) =
      if all correct adj then
        let new = filter (isNothing . (colors !)) adj in
        loop (colors // [(v', Just (not c)) | v' <- new]) (vs ++ new)
      else
        Nothing
      where
        Just c = colors ! v
        adj = g ! v
        correct v' = case colors ! v' of
                       Just c' -> c' == not c
                       Nothing -> True

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    Just a -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    Nothing -> "Impossible"

solve xs = answer n roads
  where
    n = read $ (!! 1) $ words $ head ls
    roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
    ls = lines xs

main = interact solve

import Control.Monad
import Data.Array
import List

main = do
	[n, m] <- getA
	e <- replicateM m getA
	putStr $ show' $ gao m $ listArray (1, m) $ map sort e where
		getA = fmap (map read . words) getLine
		show' (Just a) = elems a
		show' _ = "Impossible"

inter x@[a,b] y@[c,d] = if a > c then inter y x else a < c && c < b && b < d

gao n e = foldl f (Just $ listArray (1, n) $ repeat '?') [1 .. n] where
	f z@(Just a) i = if a!i == '?' then g 'o' z i else z
	f _ _ = Nothing
	g c z@(Just a) i = if a!i == c then z else if a!i /= '?' then Nothing else r where
		b = filter (\j -> inter (e!i) (e!j)) [1 .. n]
		d = if c == 'o' then 'i' else 'o'
		r = foldl (g d) (Just $ a // [(i, c)]) b
	g _ _ _ = Nothing

import Control.Monad
import Data.Array
import List

main = do
	[n, m] <- getA
	e <- replicateM m getA
	putStr $ show' $ gao m $ listArray (1, m) $ map sort e where
		getA = fmap (map read . words) getLine
		show' Nothing = "Impossible"
		show' (Just a) = elems a

inter (x@[a,b]) (y@[c,d]) = if a > c then inter y x else a < c && c < b && b < d

gao n e = foldl f (Just $ listArray (1, n) $ repeat '?') [1 .. n] where
	f Nothing _ = Nothing
	f (Just a) i = if a!i == '?' then g 'o' (Just a) i else Just a
	g _ Nothing _ = Nothing
	g c (Just a) i = if a!i == c then Just a else if a!i /= '?' then Nothing else r where
		b = filter (\j -> inter (e!i) (e!j)) [1 .. n]
		d = if c == 'o' then 'i' else 'o'
		r = foldl (g d) (Just $ a // [(i, c)]) b

import Control.Monad
import Data.Array
import List

main = do
	[n, m] <- getA
	e <- replicateM m getA
	putStr $ show' $ gao m $ listArray (1, m) $ map sort e where
		getA = fmap (map read . words) getLine
		show' (Just a) = elems a
		show' _ = "Impossible"

inter x@[a,b] y@[c,d] = if a > c then inter y x else a < c && c < b && b < d

gao n e = foldl f (Just $ listArray (1, n) $ repeat '?') [1 .. n] where
	f z@(Just a) i = if a!i == '?' then g 'o' z i else z
	f _ _ = Nothing
	g c z@(Just a) i = case a!i of { '?' -> r; c -> z; d -> Nothing } where
		b = filter (\j -> inter (e!i) (e!j)) [1 .. n]
		d = if c == 'o' then 'i' else 'o'
		r = foldl (g d) (Just $ a // [(i, c)]) b
	g _ _ _ = Nothing

import Data.Array.MArray (newArray, writeArray, readArray)
import List (tails)
import Array (Array, bounds, elems, indices, accumArray, (!))
import Data.Array.MArray (unsafeFreeze)
import Data.Array.ST (STArray)
import Control.Monad (forM, when)
import Control.Monad.ST.Lazy (ST, runST)

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs =
  concatMap (\ ((a, (_, _)), (b, (_, _))) -> [(a, b), (b, a)]) $
            filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
  indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs
  crossing ((_, (a, b)), (_, (c, d))) = a < c && c < b && b < d ||
                                        c < a && a < d && d < b

bicolor g = runST $ do
  colors <- newArray (bounds g) Nothing :: ST s (STArray s Int (Maybe Bool))
  flags <- forM (indices g) $ \v -> do
    c <- readArray colors v
    result <- dfs colors v True
    return (c == Nothing || result)
  result <- unsafeFreeze colors
  return (all id flags, result)
  where
  dfs colors v color = do
    c <- readArray colors v
    case c of
      Nothing -> do
        writeArray colors v (Just color)
        flags <- forM (g ! v) $ \v' -> dfs colors v' (not color)
        return (all id flags)
      Just c -> return (c == color)

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    (True, a) -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    _ -> "Impossible"

solve xs = answer n roads
  where
  n = read $ (!! 1) $ words $ head ls
  roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
  ls = lines xs

main = interact solve

import Maybe (isNothing)
import List (sortBy, tails, find, group)
import Array (Array, array, bounds, elems, assocs, accumArray, (!), (//))

crossing :: ((Int, (Int, Int)), (Int, (Int, Int))) -> Bool
crossing ((_, (a, b)), (_, (c, d))) = check $
                            sortBy (\ (a, _, _) (b, _, _) -> compare a b) $
                            [(a, False, 0), (b, True, 0),
                             (c, False, 1), (d, True, 1)]
  where
    check [(a, False, na), (b, False, nb), (c, True, nc), (d, True, nd)]
          | na == nc && nb == nd && (length $ group $ [a, b, c, d]) == 4 = True
    check _ = False

edges :: [(Int, Int)] -> [(Int, Int)]
edges xs = map (\ ((a, (_, _)), (b, (_, _))) -> (a, b)) $
           filter crossing [(x, y) | x:xs <- tails indexed, y <- xs]
  where
    indexed = zip [1..] $ map (\ (a, b) -> (min a b, max a b)) xs

bicolor :: Array Int [Int] -> Maybe (Array Int (Maybe Bool))
bicolor g =
  let (a, b) = bounds g in
  loop (array (a, b) ((a, Just False):[(i, Nothing) | i <- [a+1..b]])) [1]
  where
    loop colors [] =
      case find (isNothing . snd) (assocs colors) of
        Just (i, _) -> loop (colors // [(i, Just False)]) [i]
        Nothing -> Just colors
    loop colors (v:vs) =
      if all correct adj then
        let new = filter (\v' -> isNothing (colors ! v')) adj in
        loop (colors // [(v', Just (not c)) | v' <- new]) (vs ++ new)
      else
        Nothing
      where
        Just c = colors ! v
        adj = g ! v
        correct v' = case colors ! v' of
                       Just c' -> c' == not c
                       Nothing -> True

answer :: Int -> [(Int, Int)] -> String
answer n xs =
  case bicolor $ accumArray (flip (:)) [] (1, n) (edges xs) of
    Just a -> map (\ (Just c) -> if c then 'i' else 'o') $ elems a
    Nothing -> "Impossible"

solve xs = answer n roads
  where
    n = read $ (!! 1) $ words $ head ls
    roads = map ((\ [a, b] -> (read a, read b)) . words) $ tail ls
    ls = lines xs

main = interact solve


{-# 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.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function
import System.IO
import System.Exit

main :: IO ()
main = do
  q <- read <$> getLine
  as <- take q . unfoldr (runStateT $ rInt) <$> BSL.getContents
  mapM_ (print . query) $ map toI32 as

query :: Int32 -> Int32
query x
  | x /= bitFill = bitFill
  | otherwise    = maybe 1 (div bitFill)
                   $ find ((==0). (bitFill `mod`))
                   [2..ceilI32 $ sqrt $ toDouble bitFill]
  where
    bitFill = (+(-1)) $ bit $ finiteBitSize x - clz x :: Int32

clz :: Int32 -> Int
clz x
   |x == 0 = 32
   |x /= 0 = 31 - ret
  where
    (!v,ret) = foldl' loop (x,0) $ map bit $ [4,3..0]
    loop (!x,!acc) b | x1 /= 0   = (x1,acc .|. b)
                     | otherwise = (x,acc)
      where
        x1 = shiftR x b

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.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

#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.List
main = interact $ unlines . map show . map process . tail . map read . words

process :: Int -> Int
process x
    | x /= pw x = pw x
    | elem x primes = 1
    | otherwise = case (find (\z -> mod x z == 0) primes) of
        Just z -> div x z
        Nothing -> 1

pw x = foldl (\v z -> v .|. shiftR v (2^z)) x [0..4]
sieve (n:ns) = n:sieve [ m | m <- ns, m `mod` n /= 0 ]
primes = 2 : (takeWhile (< 2^14) $ sieve [3,5..])

import Text.Printf
import Control.Monad
import Data.Bits

glwr :: Read a => IO [a]
glwr = fmap (map read . words) getLine

main :: IO ()
main = do
  n <- readLn
  mapM_ process [1..n :: Int]

process _ = do
  n <- readLn
  putStrLn . show $ op n

op :: Int -> Int
op n
  | n == p2*2 - 1 = lDiv
  | True = p2*2 - 1
  where
    p2 = last p2s
    (p2s, _) = break (> n) pow2
    lDiv = div n $ sDiv n

sDiv :: Int -> Int
sDiv n = head $ filter valid [2..sqrtN] ++ [n]
  where
    sqrtN = floor $ sqrt $ toEnum n
    valid x = rem n x == 0

pow2 :: [Int]
pow2 = map (2^) [1..]

import Text.Printf
import Control.Monad
import Data.Bits

glwr :: Read a => IO [a]
glwr = fmap (map read . words) getLine

main :: IO ()
main = do
  n <- readLn
  mapM_ process [1..n :: Int]

process _ = do
  n <- readLn
  putStrLn . show $ op n

op :: Int -> Int
op n
  | n == p2*2 - 1 = 1
  | True = p2*2 - 1
  where
    p2 = last p2s
    (p2s, _) = break (> n) pow2

pow2 :: [Int]
pow2 = map (2^) [1..]


import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, edgeList)

solve (n, graph, edgeList) = forM edgeList $ \[a, b, c] ->
  if a == 0
    then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
    else (if arr ! b < arr ! c then Just (b, c) else Nothing)
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, map (\[a, b, c] -> (a, b, c)) edgeList)

solve (n, graph, edgeList) =
  forM edgeList $
    ( \(a, b, c) ->
        if a == 0
          then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
          else (if arr ! b < arr ! c then Just (b, c) else Nothing)
    )
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.List
import qualified Data.Sequence as S

buildG n el = arr
  where
    arr = foldl (\a (b, c) -> S.adjust (c :) b a) (S.replicate (n + 1) []) el

go :: S.Seq [Int] -> S.Seq Int -> S.Seq Int -> [Int]
go graph ind queue = case S.viewl queue of
  S.EmptyL -> []
  x S.:< rest -> x : (go graph ind' queue')
    where
      ind' = foldl (\ind'' x -> S.adjust (\a -> a - 1) x ind'') ind (graph `S.index` x)
      queue' = rest S.>< S.fromList (filter (\x -> (ind' `S.index` x) == 0) (graph `S.index` x))

topSort n graph = if length res == n then Just res else Nothing
  where
    res = go graph ind queue
    ind = foldl (\ind' x -> foldl (\ind'' y -> S.adjust (+ 1) y ind'') ind' x) (S.replicate (n + 1) 0) graph
    queue = S.fromList $ filter (\x -> (ind `S.index` x) == 0) [1 .. n]

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort n graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Data.Array
import Data.Foldable
import Data.Graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> (b, c)) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG (1, n) el, map (\[a, b, c] -> (a, b, c)) edgeList)

solve (n, graph, edgeList) =
  forM edgeList $ \(a, b, c) ->
    if a == 0
      then (if arr ! b < arr ! c then Just (b, c) else Just (c, b))
      else (if arr ! b < arr ! c then Just (b, c) else Nothing)
  where
    arr = array (1, n) $ zip sorted [1 .. n]
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  let f = \l i -> do
        a <- S.readArray ind i
        S.writeArray ind i (a - 1)
        if a == 1 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\(a : b) -> b) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

uniq :: Eq a => [a] -> [a]
uniq [] = []
uniq [x] = [x]
uniq (a : b : xs) = if a == b then uniq (b : xs) else a : uniq (b : xs)

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  forM_ [1 .. n] $ \i -> do
    x <- S.readArray res i
    S.writeArray res i $ uniq $ sort x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  forM_ (graph ! x) $ \i -> do
    a <- S.readArray ind i
    S.writeArray ind i (a - 1)
  let f = \l i -> do
        a <- S.readArray ind i
        if a == 0 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\[a, b, c] -> [b, c]) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"

import Control.Monad
import Control.Monad.ST
import Data.Array
import qualified Data.Array.ST.Safe as S
import qualified Data.Array.Unboxed as U
import Data.Foldable
import Data.List

type Graph = Array Int [Int]

buildG :: Int -> [[Int]] -> Graph
buildG n el = S.runSTArray $ do
  res <- S.newArray (1, n) []
  forM_ el $ \[a, b] -> do
    x <- S.readArray res a
    S.writeArray res a $ b : x
  return res

indeg :: Graph -> U.UArray Int Int
indeg graph = S.runSTUArray $ do
  res <- S.newArray (1, n) 0
  forM_ [1 .. n] $ \i -> do
    forM_ (graph ! i) $ \j -> do
      a <- S.readArray res j
      S.writeArray res j (a + 1)
  return res
  where
    n = snd $ bounds graph

topSort' :: Graph -> S.STUArray s Int Int -> Int -> [Int] -> ST s [Int]
topSort' graph ind x res = do
  forM_ (graph ! x) $ \i -> do
    a <- S.readArray ind i
    S.writeArray ind i (a - 1)
  let f = \l i -> do
        a <- S.readArray ind i
        if a == 0 then topSort' graph ind i l else return l
  foldM f (x : res) (graph ! x)

topSort :: Graph -> Maybe [Int]
topSort graph = if length arr == n then Just arr else Nothing
  where
    n = snd $ bounds graph
    arr = reverse $
      runST $ do
        ind' <- S.thaw ind
        let f = \l x -> do
              a <- S.readArray ind' x
              if a == 0 then topSort' graph ind' x l else return l
        foldM f [] $ filter (\x -> (ind U.! x) == 0) [1 .. n]
    ind = indeg graph

readInput = do
  [n, m] <- map read . words <$> getLine
  edgeList <- replicateM m $ map read . words <$> getLine
  let el = map (\(a : b) -> b) $ filter (\[a, _, _] -> a == 1) edgeList
  return (n, buildG n el, map (\[a, b, c] -> (b, c)) edgeList)

solve (n, graph, edgeList) = (\a -> map (\(x, y) -> if (a ! x) < (a ! y) then (x, y) else (y, x)) edgeList) <$> arr
  where
    arr = (\s -> array (1, n) $ zip s [1 .. n]) <$> sorted
    sorted = topSort graph

main = do
  a <- read <$> getLine
  replicateM_ a $ do
    res <- solve <$> readInput
    case res of
      Just x -> do
        putStrLn "YES"
        for_ x (\(a, b) -> putStrLn $ show a ++ " " ++ show b)
      Nothing -> putStrLn "NO"


import Control.Monad (forM_)
import Data.List
import Debug.Trace (trace)

readInts = getLine >>= pure . map read . words

same (a:as) (b:bs) = (elem a "GB" == elem b "GB") && same as bs
same [] [] = True

main = do
    [n'] <- readInts
    forM_ [1..n'] (\_ -> do
        getLine
        a <- getLine
        b <- getLine
        putStrLn $ if same a b then "YES" else "NO"
        )

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>
        getLine >>= \s1 -> getLine >>=
        putStrLn . ite "Yes" "No" . isSame s1
ite x y b = if b then x else y
isSame s1 s2 = all (uncurry f) (zip s1 s2)
  where f 'R' 'R' = True
        f 'R' _ = False
        f _ 'R' = False
        f _ _ = True

{-#LANGUAGE ScopedTypeVariables#-}
import Data.Char (isDigit)
import Data.Text (replace)

main = do
    input <- getContents
    let parsed = removeDigits (drop 1 (lines input))
    let result = iteratePairs (map replaceDigits parsed)
    mapM_ putStrLn result

removeDigits :: [String] -> [String]
removeDigits [] = []
removeDigits (x:xs)
    | all isDigit x = removeDigits xs
    | otherwise     = [x] ++ removeDigits xs

replaceDigits :: String -> String
replaceDigits [] = []
replaceDigits (x:xs)
    | x == 'G'  = ['B'] ++ replaceDigits xs
    | otherwise = [x] ++ replaceDigits xs

iteratePairs :: [String] -> [String]
iteratePairs [] = []
iteratePairs (one:two:rest) = [(checkPairs one two)] ++ iteratePairs rest

checkPairs :: String -> String -> String
checkPairs [] [] = "YES"
checkPairs (x:xs) (y:ys)
    | x /= y    = "NO"
    | otherwise = checkPairs xs ys

toOneForm [] = []
toOneForm (x:xs) = if x == 'G'
                   then ('B':) $ (toOneForm xs)
                   else (x:) $ toOneForm xs

decide :: Int -> IO ()
decide 0 = return ()
decide n = do
    getLine
    s1 <- getLine
    s2 <- getLine
    if toOneForm s1 == toOneForm s2
    then putStrLn "YES"
    else putStrLn "NO"
    decide (n - 1)

main :: IO ()
main = do
    t <- getLine >>= (return . (read :: String -> Int))
    decide t

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

import Data.Maybe
import Control.Monad

import Data.List (group, sort)

solve :: String -> String -> String
solve s1 s2
    | answer = "YES"
    | otherwise = "NO"
    where answer = and $ zipWith check s1 s2

check c1 c2
    | c1 == c2 = True
    | c1 == 'G' = c2 == 'B'
    | c1 == 'B' = c2 == 'G'
    | otherwise = False

work = do
    t <- getLine
    s1 <- getLine
    s2 <- getLine

    putStrLn $ solve s1 s2

main = do
    t <- getLine

    replicateM_ (read t :: Int) work

module Main
      ( main )
      where

import Control.Monad (replicateM)

data Color
  = Red
  | Green
  | Blue
  deriving Show

mkColor :: Char -> Maybe Color
mkColor c = case c of
              'R' -> Just Red
              'G' -> Just Green
              'B' -> Just Blue
              _   -> Nothing

lookDistinct :: Color -> Color -> Bool
lookDistinct a b =
  case (a, b) of
    (Red, Red) -> False
    (Red, _)   -> True
    (_, Red)   -> True
    (_,   _)   -> False

readColors :: IO (Maybe [Color])
readColors = do
  l <- getLine
  return (sequence $ map mkColor l)

rowsLookNondistinct :: [Color] -> [Color] -> Bool
rowsLookNondistinct xs ys = all (not . (uncurry lookDistinct)) pairs
  where pairs = zip xs ys

putNondistinct :: [Color] -> [Color] -> IO ()
putNondistinct xs ys = case rowsLookNondistinct xs ys of
                         True  -> putStrLn "YES"
                         False -> putStrLn "NO"

main :: IO ()
main = do
  tests <- readLn
  replicateM tests $ do
    -- unused length of lists
    _ <- getLine
    firstRow <- readColors
    secondRow <- readColors
    case (firstRow, secondRow) of
      (Just xs, Just ys) -> putNondistinct xs ys
      _                -> putStrLn "Invalid Input!"
  return ()

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List
import Debug.Trace
import Data.Char

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

type SP = State P.ByteString
type S = StateT P.ByteString

str = string7

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

getNext :: Monad m => S m P.ByteString
getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- getNext
  b <- getNext
  let
    good x y = (x == 'R' && y == 'R') || (x /= 'R' && y /= 'R')
    res = foldl' (\b (x, y) -> (&&) b (good x y)) True (zip (P.unpack a) (P.unpack b))
  pure . str $ if res then "YES\n" else "NO\n"


main = putStr . maybe "-1" (unwords . map show) . (\[a, b] -> solve a b) . map read . words =<< getLine

solve n k = case gen (k - 1 :: Int) 0 n 1 of
  (0, xs) -> Just $ xs []
  _ -> Nothing

gen k l r lo
  | k <= 0 || d <= 1 = (k, (take d [lo..] ++))
  | otherwise = (k2, xs . ys)
  where
  d = r - l
  m = (r + l) `quot` 2
  (k1, xs) = gen (k - 2) l m (lo + r - m)
  (k2, ys) = gen k1      m r lo

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T
import Control.Monad.State

-- import Debug.Trace

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) + (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (x1:x2:xs) = (x1 <= x2) && (isSorted (x2:xs))

verify :: [Int] -> State Int ()
verify [x] = get >>= put . (+ 1)
verify xs = do
  count <- get
  put $ count + 1
  case isSorted xs of
    True -> return ()
    False -> do
      let m = (div (length xs) 2)
      let xl = take m xs
      let xr = drop m xs
      verify xl
      verify xr

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k < 0          = Nothing
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) - (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) + (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.List.Split as T

go :: Int -> Int -> Int -> Maybe [Int]
go a b k
  | k == 0         = Just [a..b]
  | k `mod` 2 == 1 = Nothing
  | a == b         = Nothing
  | otherwise      = do
      let k' = k - 2
      let kl = (div k' 2) - (mod (div k' 2) 2)
      let kr = k' - kl
      let m  = (div (a + b + 1) 2)
      l <- go a m kl
      r <- go (m + 1) b kr
      return $ r ++ l

solve :: Int -> Int -> [Int]
solve n k =
  case go 1 n (k - 1) of
    Just l -> l
    Nothing -> [-1]

main :: IO ()
main = do
  line <- getContents
  case map (read :: String -> Int) . words $ line of
    [n, k] -> putStrLn $ unwords $ map show $ solve n k
    _ -> error ""