import Control.Monad
import Data.Int (Int64)
import Data.Sequence (Seq)
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

gao :: [(Int, Int)] -> Int -> Int64 -> Seq Int64 -> [Int64]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | not (Seq.null q) && t' <= fromIntegral t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (q Seq.|> begin)
  | otherwise = (-1): gao r' b m q
  where
  begin = max m $ fromIntegral t
  end = begin + fromIntegral d
  t' Seq.:< q' = Seq.viewl q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 Seq.empty
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative      ((<$>))
import           Control.Monad
import           Control.Monad.RWS.Strict
import           Data.Foldable            (toList)
import           Data.Sequence            (Seq, ViewL (..), (|>))
import qualified Data.Sequence            as Seq

type Index = Int
type Time = Integer
type Queue = Seq (Index, Time)
type Serve = (Time, Queue)
type Events a = RWS Int Queue Serve  a

dispatch::MonadWriter Queue m=>Int->Integer->m ()
dispatch = (tell.). (Seq.singleton.). (,)

rollout::(MonadWriter Queue m, MonadState Serve m)=>Maybe Time->m ()
rollout now = do
  (time, q) <- get
  let happen d = maybe True (>= time + d) now
  case Seq.viewl q of
    Seq.EmptyL -> case now of
      Nothing -> return ()
      Just time' -> put (time' ,q)
    (idx, duration) :< rest
      | happen duration -> do
        let time' = time + duration
        dispatch idx time'
        put (time', rest)
        rollout now
      | otherwise  -> return ()

handle::(MonadReader Int m, MonadWriter Queue m, MonadState Serve m)=>((Time,Time),Index)->m ()
handle ((time, duration), idx) = do
  rollout (Just time)
  b  <- ask
  (t', q') <- get
  if Seq.length q' > b then dispatch idx (-1)
  else put (t',  q' |> (idx, duration) )

walk::Int->[((Time,Time),Index)]->[Time]
walk b queries = let
  go = mapM_ handle queries >> rollout Nothing::Events ()
  res = snd $ execRWS go b (0, Seq.empty)
  in toList $ snd <$> Seq.sort res

readPair::Read a=>IO (a,a)
readPair = fmap (unlist . map read . words) getLine where
    unlist [x,y] = (x,y)
    unlist _     = error "trouble input"

main::IO ()
main = do
  (n,b) <- readPair
  nums <- replicateM n readPair
  let queries =  nums `zip` [1..]
  putStrLn $ unwords $ show <$> walk b queries

import Control.Monad
import Data.Int (Int64)
import Data.Sequence (Seq)
import qualified Data.ByteString.Char8 as C
import qualified Data.Sequence as Seq

gao :: [(Int, Int)] -> Int -> Int64 -> Seq Int64 -> [Int64]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | not (Seq.null q) && t' <= fromIntegral t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (begin Seq.<| q)
  | otherwise = (-1): gao r' b m q
  where
  begin = max m $ fromIntegral t
  end = begin + fromIntegral d
  t' Seq.:< q' = Seq.viewl q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 Seq.empty
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

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

gao :: [(Int, Int)] -> Int -> Int -> Queue Int -> [Int]
gao [] _ _ _ = []
gao r@((t, d): r') b m q
  | q /= queue [] && t' <= t = gao r (b+1) m q'
  | b /= 0 = end: gao r' (b-1) end (push begin q)
  | otherwise = (-1): gao r' b m q
  where
  begin = max t m
  end = begin + d
  (t', q') = pop q

main :: IO ()
main = do
  (n:b:_) <- fmap (map readInt . C.words) C.getLine
  r <- replicateM n $ do
    (t:d:_) <- fmap (map readInt . C.words) C.getLine
    return (t, d)
  let ans = gao r b 0 $ queue []
  putStrLn $ unwords $ map show ans
  where
  readInt s = let Just (i, _) = C.readInt s in i

data Queue a = Queue [a] [a]
  deriving (Eq, Show)

queue :: [a] -> Queue a
queue = Queue []

push :: a -> Queue a -> Queue a
push a (Queue r q) = Queue (a:r) q

pop :: Queue a -> (a, Queue a)
pop (Queue r (a:q)) = (a, Queue r q)
pop (Queue r []) = pop $ Queue [] (reverse r)

{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}

import           Control.Applicative ((<$>))
import           Control.Monad
import           Control.Monad.RWS.Strict
import           Data.Foldable       (toList)
import           Data.Sequence       (Seq, ViewL (..), (|>))
import qualified Data.Sequence       as Seq

type Queue = Seq (Int,Int)
type Serve = (Int, Queue)
type Events a = RWS Int Queue Serve  a

dispatch::MonadWriter Queue m=>Int->Int->m ()
dispatch = (tell.). (Seq.singleton.). (,)

rollout::(MonadWriter Queue m, MonadState Serve m)=>Maybe Int->m ()
rollout now = do
  (time,q) <- get
  let happen d = maybe True (>= time + d) now
  case Seq.viewl q of
    Seq.EmptyL -> case now of
      Nothing -> return ()
      Just time' -> put (time' ,q)
    (duration, idx) :< rest
      | happen duration -> do
        let time' = time + duration
        dispatch idx time'
        put (time', rest)
        rollout now
      | otherwise  -> return ()

handle::(MonadReader Int m, MonadWriter Queue m, MonadState Serve m)=>((Int,Int),Int)->m ()
handle ((time, duration), idx) = do
  rollout (Just time)
  b  <- ask
  (t', q') <- get
  if Seq.length q' > b then dispatch idx (-1)
  else put (t',  q' |> (duration, idx) )

walk::Int->[((Int,Int),Int)]->[Int]
walk b queries = let
  go = mapM_ handle queries >> rollout Nothing::Events ()
  res = snd $ execRWS go b (0, Seq.empty)
  in toList $ snd <$> Seq.sort res

main::IO ()
main = do
  let readPair = fmap (unlist . map read . words) getLine
      unlist [x,y] = (x,y)
      unlist _     = error "trouble input"
  (n,b) <- readPair
  nums <- replicateM n readPair
  let queries =  nums `zip` [1..]
  putStrLn $ unwords $ show <$> walk b queries


main :: IO ()
main = interact solve

solve :: String -> String
solve = foldl (++) "". map (++ "\n") . map str_solve . tail . lines

str_solve :: String -> String
str_solve s = if (head $ s) /= (last $ s) then (last $ s) : (tail s) else s

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

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

prefMins :: Ord t => (a -> t) -> [a] -> [t]
prefMins f li = tail $ scanl' min (f $ head li) $ map f li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- map P.unpack <$> getNext 1
    let
      t = (if ((head s) == 'a') then "b" else "a") ++ (tail s)
    pure $ string7 $ (if ((head s) == (last s)) then s else t) ++ "\n"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

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

import Control.Monad

aba :: String -> Int -> Int -> (Int, Int)
aba [] ab ba = (ab, ba)
aba [a] ab ba = (ab, ba)
aba ('a':'b':xs) ab ba = aba ('b':xs) (ab+1) ba
aba ('b':'a':xs) ab ba = aba ('a':xs) ab (ba+1)
aba (x:xs) ab ba = aba xs ab ba

calc :: String -> String
calc line =
  let (ab,ba) = aba line 0 0 in
    if ab==ba then line
    else
      case line of
        ('b':'b':xs) -> if ab < ba then ('a':'b':xs) else ('b':'a':xs)
        ('a':'a':xs) -> if ab < ba then ('a':'b':xs) else ('b':'a':xs)
        ('a':'b':xs) -> ('b':'b':xs)
        ('b':'a':xs) -> ('a':'a':xs)

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    --print $ aba line 0 0
    putStrLn $ calc line

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

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

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

data TC = TC { s :: String }

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

-- type Output = String

-- output :: Output -> C.ByteString
output = C.pack

-- solve :: TC -> Output
solve TC {..} = last s : tail s

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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

{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM_)
import qualified Data.ByteString.Char8 as C (getLine, readInt, words)
import Data.List (foldl', sort)
import Data.Maybe (fromJust)

main :: IO ()
main = do
  [t] <- readInts
  replicateM_ t $ do
      s <- getLine
      putStrLn $ solve s

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

solve :: [a] -> [a]
solve (a:as)
    | null as = [a]
    | otherwise = last as:as


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

import qualified Data.ByteString as B (getLine)
import qualified Data.ByteString.Char8 as C (readInt, words, reverse, dropWhile, unpack)
import qualified Data.Maybe as M (fromJust)
import Data.Char (isSpace)

readInt = fst . M.fromJust . C.readInt
rstrip = C.reverse . C.dropWhile isSpace . C.reverse

split (x:xs) cp ans | x == ' ' || x == '-' = split xs [] (length (x:cp):ans)
                    | otherwise = split xs (x:cp) ans
split [] cp ans = reverse (length cp:ans)

test (x:xs) w c ans | x + c > w = test (x:xs) w 0 (ans + 1) | otherwise = test xs w (x + c) ans
test [] _ _ ans = ans + 1

run xs a b k | a + 1 == b = b
             | m >= mxs && test xs m 0 0 <= k = run xs a m k
             | otherwise = run xs m b k where
    m = (a + b) `div` 2
    mxs = maximum xs

main = do
    (readInt -> k) <- B.getLine
    (C.unpack . rstrip -> x) <- B.getLine
    putStrLn $ show $ run (split x [] []) 0 (length x) k

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

main = do
  k <- fmap readInt B.getLine
  s <- fmap (B.filter (/= '\r')) B.getLine
  print $ solve k s

solve k s = go 1 (B.length s)
  where
    cmp m = maybe GT ((`compare` k) . snd) $ foldM (\(!cll, !lc) wl -> if wl > m then Nothing else let cll' = cll + wl in Just $ if cll' > m then (wl, lc + 1) else (cll', lc)) (0, 0) wls
    wls = go $ B.splitWith (\c -> c == ' ' || c == '-') s
      where
        go [l] = [B.length l]
        go (l:ls) = (B.length l + 1):go ls
    go l r
      | l >= r = l
      | otherwise = case cmp m of
          LT -> go l m
          _ -> go (m + 1) r
      where m = (l + r) `div` 2

chunks n = takeWhile (not . null) . map (take n) . iterate (drop n)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

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

main = do
  k <- fmap readInt B.getLine
  s <- fmap (B.filter (/= '\r')) B.getLine
  print $ solve k s

solve k s
  | r == 0 = maximum $ map sum $ chunks q ls
  | q == 0 = maximum ls
  | otherwise = minimum $ map (\b -> let (h, t) = splitAt b ls; (h', t') = splitAt (q + r) t in maximum $ map sum $ chunks q h ++ [h'] ++ chunks q t') [0,q..nw - q - r]
  where
    nw = length ls
    ls = go $ B.splitWith (\c -> c == ' ' || c == '-') s
      where
        go [l] = [B.length l]
        go (l:ls) = (B.length l + 1):go ls
    (q, r) = nw `quotRem` k

chunks n = takeWhile (not . null) . map (take n) . iterate (drop n)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Array.Base
import Data.Array.ST (runSTUArray)

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

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  maybe (print $ -1) (putStr.unlines.map(unwords.map show)) $ solve n xs

solve :: Int -> [Int] -> Maybe [[Int]]
solve n xs
  | cnt5>0 || cnt7>0 = Nothing
  | cnt1-cnt3-cnt4 == cnt2-cnt4 && cnt2-cnt4==cnt6-cnt3 && cnt2-cnt4>=0 = Just $ replicate cnt4 [1,2,4] ++ replicate (cnt2-cnt4) [1,2,6] ++ replicate cnt3 [1,3,6]
  | otherwise = Nothing
   where
     [cnt1,cnt2,cnt3,cnt4,cnt5,cnt6,cnt7] = map (unsafeAt cnt) [1..7]
     cnt = runSTUArray $ do
       arr <- newArray (0,10) 0 :: ST s (STUArray s Int Int)
       forM_ xs $ \x -> do
         unsafeRead arr x>>=unsafeWrite arr x.(1+)
       return arr

import Prelude
import Data.String
import Text.Printf
import Control.Monad

readNums:: Int -> [Int] -> IO [Int]
readNums 0 numbers = return numbers
readNums n numbers = do
                        c <- getChar
                        if (c /= ' ')
                            then
                                readNums (n - 1) ((read [c] :: Int):numbers)
                            else
                                readNums n numbers

solver:: Int -> Int -> Int -> Int -> Int -> Int -> IO [Int]
solver 0 c1 c2 c3 c4 c6 = return [c1, c2, c3, c4, c6]
solver n c1 c2 c3 c4 c6 = do
                            c <- getChar
                            if (c /= ' ')
                                then
                                    case read [c] :: Int of
                                        1 -> solver (n - 1) (c1 + 1) c2 c3 c4 c6
                                        2 -> solver (n - 1) c1 (c2 + 1) c3 c4 c6
                                        3 -> solver (n - 1) c1 c2 (c3 + 1) c4 c6
                                        4 -> solver (n - 1) c1 c2 c3 (c4 + 1) c6
                                        6 -> solver (n - 1) c1 c2 c3 c4 (c6 + 1)
                                        _ -> return [0, 0, 0, 0, 0]
                                else
                                    solver n c1 c2 c3 c4 c6

printAnswer:: Int -> Int -> Int -> Int -> Int -> String
printAnswer 0 0 0 0 0 = "\n"
printAnswer c1 c2  0 c4  0 = "1 2 4\n" ++ printAnswer (c1 - 1) (c2 - 1)  0 (c4 - 1)  0
printAnswer c1 c2  0 c4 c6 = "1 2 6\n" ++ printAnswer (c1 - 1) (c2 - 1)  0 c4 (c6 - 1)
printAnswer c1 c2 c3 c4 c6 = "1 3 6\n" ++ printAnswer (c1 - 1) c2 (c3 - 1) c4 (c6 - 1)

main = do
        str <- getLine
        let n = read str :: Int
        [c1, c2, c3, c4, c6] <- solver n 0 0 0 0 0
        if ((c1 /= 0) && (c3 <= c6) && (c2 == (c4 + c6 - c3)) && (c1 == (c2 + c3)))
            then
                printf (printAnswer c1 c2 c3 c4 c6)
            else
                printf "-1"
        return ()

import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Char
import Data.Ratio
import qualified Data.ByteString.Char8 as BS

getInteger = (\(Just (x,_)) -> x). BS.readInteger
getInt = (\(Just (x,_)) -> x). BS.readInt

filter' func = foldl' (\acc x -> if func x then x:acc else acc) []
map' func = foldl' (\acc x -> func x: acc) []

solve [] = (0, 0, 0, 0, 0)
solve (x:xs)
  | x == 1 = (a+1, b, c, d, e)
  | x == 2 = (a, b+1, c, d, e)
  | x == 3 = (a, b, c+1, d, e)
  | x == 4 = (a, b, c, d+1, e)
  | x == 6 = (a, b, c, d, e+1)
  | otherwise = (0, 0, 0, 0, 0)
    where
      (a, b, c, d, e) = solve xs

solution (0, 0, 0, 0, 0) = []
solution (a, b, c, d, e)
  | a > 0 && b > 0 && d > 0 = (1, 2, 4):solution (a-1, b-1, c, d-1, e)
  | a > 0 && b > 0 && e > 0 = (1, 2, 6) : solution (a-1, b-1, c, d, e-1)
  | a > 0 && c > 0 && e > 0 = (1, 3, 6) : solution (a-1, b, c-1, d, e-1)
  | otherwise = []

main :: IO ()
main = do
  _n <- BS.getLine
  _arr <- BS.getLine
  let
    n = getInt _n
    arr = solution. solve. map' getInt. BS.words $ _arr
  if length arr /= n`div` 3 then print (-1) else (mapM_ (\(a, b, c) -> putStrLn $ (show a) ++ " "++ (show b) ++ " " ++ (show c)) arr)

import Control.Applicative
import Data.List
main :: IO ()
main = getLine >> map read <$> words <$> getLine >>= putStr . solve

solve :: [Int] -> String
solve xs
    | cnt !! 2 >= cnt !! 4 &&
      cnt !! 1 == cnt !! 4 + cnt !! 6 &&
      cnt !! 2 + cnt !! 3 == cnt !! 4 + cnt !! 6 &&
      cnt !! 5 == 0 &&
      cnt !! 7 == 0 = answer
    | otherwise = "-1\n"
    where
        -- cnt !! i = the number of times i shows up
        cnt = map (subtract 1 . length) $ group $ sort $ [0, 1, 2, 3, 4, 5, 6, 7] ++ xs
        answer = concat $
                replicate (cnt !! 3) "1 3 6\n" ++
                replicate (cnt !! 6 - cnt !! 3) "1 2 6\n" ++
                replicate (cnt !! 4) "1 2 4\n"

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x>=0 && y>=0 && z>=0 && x+y+z==a1 && x+y==a2 && z==a3 && x==a4 && 0==a5 && y+z==a6 && 0==a7 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)= foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

import Control.Monad(liftM, forM, forM_)
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe(fromJust)

data StateT s x = State (s -> (s, x))
ffunc (State f) = f
instance (Monad (StateT s)) where
--	return :: (StateT s) a => a -> (StateT s) a
	return x = State (\a -> (a, x))
	(State f1) >> (State f2) = State $ \s -> f2 $ fst (f1 s)
	(State f1) >>= b = State $ \s -> let (st, val) = f1 s in ffunc (b val) st

getf f = State (\s -> (s, f s))
--put x = State \s -> (s, x)
mmap f = State (\s -> (f s, ()))
modf f 0 (x:xs) = (f x):xs
modf f i (x:xs) = x:(modf f (i - 1) xs)

pprint [] = return ()
pprint ([a, b, c]:ls) = B.putStrLn ( B.pack (show a ++ " " ++ show b ++ " " ++ show c)) >> pprint ls

readi = fst . fromJust . B.readInt

rev3 = concat . map (concat . map concat)

solve a = if maximum st == 0 then rev3 val else []
	where
		(st, val) = (ffunc zz) (map ((flip count) a) [0..7])
		count x = length . (filter (==x))
		check xs = do
			as <- minimum `liftM` forM [1..7] (\x -> do
					bs <- getf (!!x)
					return $ let as = count x xs in if as == 0 then 10^9 else div bs as)
			forM_ xs (\x -> mmap $ modf (+(-as)) x)
			return $ replicate as xs
		zz = do
			forM [7,6..1] (\i -> do
				forM (filter ((==0).(mod i)) [i-1,(i-2)..1]) (\j-> do
					forM (filter ((==0).(mod j)) [j-1,(j-2)..1]) (\k -> do
						check [k, j, i] >>= return)))

main = do
	n <- readi `liftM` B.getLine
	a <- (map readi . B.words) `liftM` B.getLine
	let as = solve a in if as == [] then putStr "-1" else pprint $ solve a

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

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

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

main = do
  n <- readLn
  xs <- getInts

  let
    cs = accumArray (+) 0 (1, 7) $ zip xs $ repeat 1 :: UArray Int Int
    n' = n `div` 3

    ls = replicate (cs!4) [1, 2, 4] ++
      replicate (cs!6 - cs!3) [1, 2, 6] ++
      replicate (cs!3) [1, 3, 6]

  putStrLn $
    if cs!1 == n' && (cs!2 + cs!3 == n') && (cs!4 + cs!6 == n') && cs!3 <= cs!6 && cs!5 == 0 && cs!7 == 0
      then unlines $ map (unwords . map show) ls
      else show $ -1

--  342A

import Control.Monad (liftM, replicateM_)
import Prelude hiding (print, reads)

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

solve :: Int -> [Int] -> Maybe (Int, Int, Int)
solve n as
  | solveIsExists  =  Just (a, b, c)
  | otherwise  =  Nothing
  where
    z i  =  length $ filter (== i) as
    a  =  z 4
    b  =  z 2 - a
    c  =  z 3
    solveIsExists
      =  b >= 0
      && z 1 == n
      && z 1 == a + b + c
      && z 5 == 0
      && z 6 == b + c
      && z 7 == 0

print :: Maybe (Int, Int, Int) -> IO ()
print Nothing  =  putStrLn "-1"
print (Just (a, b, c))  =  do
    replicateM_ a $ putStrLn "1 2 4"
    replicateM_ b $ putStrLn "1 2 6"
    replicateM_ c $ putStrLn "1 3 6"

main :: IO ()
main  =  do
    n  <-  liftM (\m -> div m 3) readLn
    as  <-  reads
    print $ solve n as

{-
1 2 4  -  a
1 2 6  -  b
1 3 6  -  c

a+b+c  =  z1  =  n
a+b    =  z2
    c  =  z3
a      =  z4
  0    =  z5
  b+c  =  z6
  0    =  z7
-}

import Control.Applicative
import Data.List
main :: IO ()
main = getLine >> map read <$> words <$> getLine >>= putStr . solve

solve :: [Int] -> String
solve xs
    | cnt !! 2 >= cnt !! 4 &&
      cnt !! 1 == cnt !! 4 + cnt !! 6 &&
      cnt !! 2 + cnt !! 3 == cnt !! 4 + cnt !! 6 = answer
    | otherwise = "-1\n"
    where
        -- cnt !! i = the number of times i shows up
        cnt = map (subtract 1 . length) $ group $ sort $ [0, 1, 2, 3, 4, 5, 6] ++ xs
        answer = concat $
                replicate (cnt !! 3) "1 3 6\n" ++
                replicate (cnt !! 6 - cnt !! 3) "1 2 6\n" ++
                replicate (cnt !! 4) "1 2 4\n"

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x+y+z==a1 && x+y==a2 && z==a3 && x==a4 && 0==a5 && y+z==a6 && 0==a7 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)=foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

{-# OPTIONS_GHC -O2 -Wall -fno-warn-missing-signatures -fno-warn-type-defaults #-}
{-# LANGUAGE ViewPatterns #-}
import Data.List(transpose)

main=interact $ unlines.sv.(!!1).lines
sv (words->xs)
  | x==a4 && z==a3 && a5==0 && a7==0 = replicate x "1 2 4" ++ replicate y "1 2 6" ++ replicate z "1 3 6"
  | otherwise = ["-1"]
  where
    (a1:a2:a3:a4:a5:a6:a7:_)=foldr (\a as -> ( length.filter (==a)) xs :as) [] (transpose [['1'..'7']])
    x = a1-a6
    z = a1-a2
    y = a6-a3

import Control.Monad(liftM)

main = do
    n <- (read :: [Char] -> Int) `liftM` getLine
    putStr $ show $ n

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (div n 3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3)))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3))&&(c1 /= 0))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c1+2) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3)))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()

import Prelude
import Data.String
import Text.Printf
import Control.Monad

solver (x:xs) c1 c2 c3 c4 c6 = case x of
                                    1 -> solver xs (c1+1) c2 c3 c4 c6
                                    2 -> solver xs c1 (c2+1) c3 c4 c6
                                    3 -> solver xs c1 c2 (c3+1) c4 c6
                                    4 -> solver xs c1 c2 c3 (c4+1) c6
                                    6 -> solver xs c1 c2 c3 c4 (c6+1)
                                    _ -> solver xs c1 c2 c3 c4 c6

solver [] c1 c2 c3 c4 c6 = [c1, c2, c3, c4, c6]

printAnswer str 0 0 0 0 0 = (putStr str)
printAnswer str c1 c2  0 c4  0 = printAnswer (str ++ "1 2 4\n") (c1-1) (c2-1) 0 (c4-1) 0
printAnswer str c1 c2  0 c4 c6 = printAnswer (str ++ "1 2 6\n") (c1-1) (c2-1) 0  c4 (c6-1)
printAnswer str c1 c2 c3 c4 c6 = printAnswer (str ++ "1 3 6\n") (c1-1) c2 (c3-1) c4 (c6-1)

main = do
        str1 <- getLine
        str2 <- getLine
        let n = read str1 :: Int
        let numbers = map (\x -> read x :: Int) $ words str2
        let [c1, c2, c3, c4, c6] = solver numbers 0 0 0 0 0
        print [c1, c2, c3, c4, c6]
        result <- if ((c1 == (c2 + c3))&&(c3 <= c6)&&(c2 == (c4 + c6 - c3))&&(c1 /= 0))
                        then printAnswer "" c1 c2 c3 c4 c6
                        else putStr "-1\n"
        return ()


import Data.Int (Int64)
import Data.Monoid (mappend)
import Data.Maybe (fromJust)
import Data.List (minimumBy, sortBy)
import qualified Data.ByteString.Char8 as B

data Point = Point Int64 Int64 Int deriving (Eq)

getId (Point _ _ id) = id

diff (Point x1 y1 id1) (Point x2 y2 _) = Point (x1 - x2) (y1 - y2) id1

vecProd (Point x1 y1 _) (Point x2 y2 _) = x1 * y2 - x2 * y1

len2 (Point x y _) = x * x + y * y

cmpAngle p1 p2 = (compare (vecProd p1 p2) 0) `mappend` compare (len2 p1) (len2 p2)

cmpCoords (Point x1 y1 _) (Point x2 y2 _) = compare x1 x2 `mappend` compare y1 y2

leftAndRest ps = (p0, sortBy cmpAngle $ map (flip diff $ p0) (filter (/= p0) ps))
    where p0 = minimumBy cmpCoords ps

firstNonColinear ps = head $ (filter (\p -> p `vecProd` (head ps) /= 0) ps)

solve ps = (getId p0, getId $ head rest, getId $ firstNonColinear rest)
    where (p0, rest) = leftAndRest ps

makePoints coords = map (\(i, (x, y)) -> Point x y i) $ zip [1..n] coords
    where n = length coords

getInt = fromIntegral . fst . fromJust . B.readInt

getCoords line = (getInt x, getInt y)
    where [x, y] = B.words line

main = do
    input <- B.getContents
    let (line:lines) = B.lines input
    let points = makePoints $ map getCoords lines
    let (i0, i1, i2) = solve points
    putStrLn $ show i0 ++ " " ++ show i1 ++ " " ++ show i2

import Data.Int (Int64)
import Data.Monoid (mappend)
import Data.List (minimumBy, sortBy)
import qualified Data.ByteString.Char8 as B
import Data.Maybe (fromJust)

data Point = Point Int64 Int64 Int deriving (Show)

getId (Point _ _ id) = id

instance Eq Point where
    (Point x1 y1 _) == (Point x2 y2 _) = x1 == x2 && y1 == y2

diff (Point x1 y1 id1) (Point x2 y2 _) = Point (x1 - x2) (y1 - y2) id1

vecProd (Point x1 y1 _) (Point x2 y2 _) = x1 * y2 - x2 * y1

len2 (Point x y _) = x * x + y * y

cmpAngle p1 p2 = (compare (vecProd p1 p2) 0) `mappend` compare (len2 p1) (len2 p2)

cmpCoords (Point x1 y1 _) (Point x2 y2 _) = compare x1 x2 `mappend` compare y1 y2

leftAndRest ps = (p0, sortBy cmpAngle $ map (flip diff $ p0) (filter (/= p0) ps))
    where p0 = minimumBy cmpCoords ps

firstNonColinear ps = head $ (filter (\p -> p `vecProd` (head ps) /= 0) ps)

solve ps =
    let (p0, rest) = leftAndRest ps
    in (getId p0, getId $ head rest, getId $ firstNonColinear rest)

makePoints coords = map (\(i, (x, y)) -> Point (fromIntegral x) (fromIntegral y) i) $ zip [1..n] coords
    where n = length coords

main = do
    input <- B.getContents
    let (line:lines) = B.lines input
    let coords = map (\l -> let [x, y] = B.words l in (fst . fromJust $ B.readInt x, fst . fromJust $ B.readInt y)) lines
    let points = makePoints coords
    let (i0, i1, i2) = solve points
    putStrLn $ show i0 ++ " " ++ show i1 ++ " " ++ show i2


import Data.List
main = interact $ show . rd . lines
rd (s1:s2:[]) = go (pt1 . map read . words $ s1) s2
pt1 (t:sx:sy:ex:ey:[]) = [(sx,sy),(ex,ey)]
go ((sx,sy):(ex,ey):[]) l | all (True==) $ map (\c -> (length $ filter (c==) l) >= (get c)) dirs = (1+) . maximum $ map (\c -> (elemIndices c l)!!((get c)-1)) dirs
                          | otherwise = -1
                            where hd = abs $ (sx-ex)
                                  vd = abs $ (sy-ey)
                                  get c = if c`elem`"EW" then hd else vd
                                  dirs = todir (signum $ sx-ex,signum $ sy-ey)
todir (-1,0) = "E"
todir (1,0)  = "W"
todir (0,-1) = "N"
todir (0,1)  = "S"
todir (a,b)  = (todir (a,0)) ++ (todir (0,b))

import qualified Data.ByteString.Char8 as B

main :: IO ()
main = putStrLn . show . solve . B.words =<< B.getContents

solve :: [B.ByteString] -> Int
solve [_, sx', sy', ex', ey', ws]
  | any (> 0) ts = -1
  | otherwise = i
  where
  (i, ts) = B.foldl' f (0, [e, s, w, n]) ws
  [sx, sy, ex, ey] = map (maybe 0 fst . B.readInt) [sx', sy', ex', ey']
  e = ex - sx
  s = sy - ey
  w = -e
  n = -s
  f x@(i, [e, s, w, n]) c
    | any (> 0) [e, s, w, n] = case fromEnum c of
      69 -> (i + 1, [e - 1, s, w, n])
      83 -> (i + 1, [e, s - 1, w, n])
      87 -> (i + 1, [e, s, w - 1, n])
      78 -> (i + 1, [e, s, w, n - 1])
    | otherwise = x

wind 'E' = (1,0)
wind 'W' = (-1,0)
wind 'N' = (0,1)
wind 'S' = (0,-1)

vadd (x0, y0) (x1, y1) = (x0 + x1, y0 + y1)

norm (x, y) = (abs x) + (abs y)

solve i (0,0) _        =  i
solve i _     []       = -1
solve i d@(_,_) (x:xs) = if norm n < norm d then solve (i + 1) n xs else solve (i + 1) d xs
    where n = d `vadd` (wind x)

main = do
    p <- getLine
    w <- getLine
    let [n, sx, sy, ex, ey] = map (read :: [Char]->Int). words $ p
        in putStrLn $ show $ solve 0 (sx - ex, sy - ey) w

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate)

solve :: [Int] -> String -> Int
solve [_, sx, sy, ex, ey] s  =  solve' 0 sx sy s
  where
    solve' t x y s
      | x == ex && y == ey  =  t
      | null s  =  -1
      | head s == 'E' && x < ex  =  solve' (t+1) (x+1) y (tail s)
      | head s == 'S' && y > ey  =  solve' (t+1) x (y-1) (tail s)
      | head s == 'W' && x > ex  =  solve' (t+1) (x-1) y (tail s)
      | head s == 'N' && y < ey  =  solve' (t+1) x (y+1) (tail s)
      | otherwise  =  solve' (t+1) x y (tail s)

main :: IO ()
main  =  do
    ps  <-  reads
    s   <-  getLine
    print $ solve ps s

  where
    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' a' s
          where
            a'  =  10 * a + fromIntegral (ord c - ord '0')

gao::(Int,Int)->(Int,Int)->Char->(Int,Int)
gao (sx,sy) (tx,ty) wind | wind=='E' && tx>sx = (sx+1,sy)
						 | wind=='S' && ty<sy = (sx,sy-1)
						 | wind=='W' && tx<sx = (sx-1,sy)
						 | wind=='N' && ty>sy = (sx,sy+1)
						 | otherwise = (sx,sy)

main::IO()
main = do
	input<-getContents
	let
		(input2,wind)=splitAt 5 $ words input
		(t:xx)=map read input2 :: [Int]
		sx=xx!!0
		sy=xx!!1
		ex=xx!!2
		ey=xx!!3
		check sx sy = if sx==ex && sy==ey then True else False
		doit::Int->Int->Int->String->Int
		doit x y now wind = if (check x y) then now
							else if null wind then -1
							else doit nx ny (now+1) (tail wind)
								where (nx,ny)=gao (x,y) (ex,ey) (wind!!0)
	print $ doit sx sy 0 (wind!!0)

data R=R Integer | NOR deriving (Eq, Ord)
s[l1,w]=max(go sx ex 'W' 'E')(go sy ey 'S' 'N') where
  [t,sx,sy,ex,ey]=map read $ words l1
  go a b dec inc
    | b < a = gogo dec (a-b)
    | otherwise = gogo inc (b-a)
  gogo c 0 = R 0
  gogo c n = case drop (n-1) $ filter (\(_,x)->x==c) (zip [1..] w) of
    ((i, _) : _) -> R i
    [] -> NOR
p NOR="-1"
p(R x)=show x
main=interact$p.s.lines

-- returns the number of elements from xs consumed
-- to turn s1 to s2
gen :: Eq s => s -> s -> (s -> a -> s) -> [a] -> Maybe Int
gen s1 s2 f xs | s1 == s2  = Just 0
               | null xs   = Nothing
               | otherwise = fmap (+1) (gen (f s1 (head xs)) s2 f (tail xs))

next :: (Int, Int) -> Char -> (Int, Int)
next s@(x,y) c | c == 'E' && x < 0 = (x+1,y)
               | c == 'S' && y > 0 = (x,y-1)
               | c == 'W' && x > 0 = (x-1,y)
               | c == 'N' && y < 0 = (x,y+1)
               | otherwise = s

main = do
   [_, sx, sy, ex, ey] <- fmap (map read.words) getLine :: IO [Int]
   wind <- getLine
   case gen (sx-ex,sy-ey) (0,0) next wind of
      Nothing -> putStrLn "-1"
      Just x -> putStrLn.show $ x

import Data.List
main = interact $ show . rd . lines
rd (s1:s2:[]) = go (pt1 . map read . words $ s1) s2
pt1 (t:sx:sy:ex:ey:[]) = [(sx,sy),(ex,ey)]
go ((sx,sy):(ex,ey):[]) l | all (True==) $ map (\c -> (length $ filter (c==) l) >= (get c)) dirs = (1+) . maximum $ map (\c -> last $ elemIndices c l) dirs
                          | otherwise = -1
                            where hd = abs $ (sx-ex)
                                  vd = abs $ (sy-ey)
                                  md = hd+vd
                                  get c = if c`elem`"EW" then hd else vd
                                  dirs = todir (signum $ sx-ex,signum $ sy-ey)
todir (-1,0) = "E"
todir (1,0)  = "W"
todir (0,-1) = "N"
todir (0,1)  = "S"
todir (a,b)  = (todir (a,0)) ++ (todir (0,b))


{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

newtype Writer a = Writer { runWriter :: ListLike Char -> (a,ListLike Char) }
newtype ListLike a = ListLike { genList :: [a] -> [a] }

instance Functor Writer where
    fmap f (Writer g) = Writer (\s -> let (a,s) = g s in (f a,s))

instance Monad Writer where
    return a = Writer (\s -> (a,s))
    (Writer g) >>= f = Writer (\s -> let (a,s') = g s in runWriter (f a) s')

emptyList = ListLike id
put ch = Writer (\s -> ((),ListLike (\l -> genList s (ch:l))))

convert [a,b,c] = (a,b,c)
main = do
    [n,m,s,f] <- readsInt
    l <- replicateM m (convert <$> readsInt)
    putStrLn $ solve n s f l

solve :: Int -> Int -> Int -> [(Int,Int,Int)] -> String
solve n s f l = genList (snd $ runWriter (go s 1 l) emptyList) ""
    where
    (c,d) = if s < f then ('R',1) else ('L',-1)
    go p _ _ | p == f = return ()
    go p t ((t',l,r):ls) | t == t' && ((l <= p && p <= r)||(l <= p+d && p+d <= r)) = put 'X' >> go p (t+1) ls
                         | t >= t' = put c >> go (p+d) (t+1) ls
    go p t ls = put c >> go (p+d) (t+1) ls

import Control.Monad(liftM, forM, forM_)
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe(fromJust)
import Data.List(sort)

readi = fst . fromJust . B.readInt

goC s f
	| s < f = 'R'
	| otherwise = 'L'

next s f
	| s == f = s
	| s < f = s + 1
	| otherwise = s - 1

inn x (l, r) = l <= x && x <= r

go s f t [] = replicate (abs (f - s)) (goC s f)
go s f t ls@([t2, l, r]:ev)
	| s == f = ""
	| (t == t2) = if (inn s (l, r) || inn (next s f) (l, r))
			then 'X':(go s f (t + 1) ev)
			else (goC s f):(go ns f (t + 1) ev)
	| otherwise = (goC s f):(go ns f (t + 1) ls)
		where ns = next s f

main = do
	[n, m, s, f] <- (map readi . B.words) `liftM` B.getLine
	tlr <- sequence $ replicate m $ (map readi . B.words) `liftM` B.getLine
	putStr $ go s f 1 (sort tlr)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

convert [a,b,c] = (a,b,c)
main = do
    [n,m,s,f] <- readsInt
    l <- replicateM m (convert <$> readsInt)
    solve n s f l

solve :: Int -> Int -> Int -> [(Int,Int,Int)] -> IO ()
solve n s f l = go s 1 l
    where
    (c,d) = if s < f then ('R',1) else ('L',-1)
    go p _ _ | p == f = putChar '\n'
    go p t ((t',l,r):ls) | t == t' && ((l <= p && p <= r)||(l <= p+d && p+d <= r)) = putChar 'X' >> go p (t+1) ls
                         | t >= t' = putChar c >> go (p+d) (t+1) ls
    go p t ls = putChar c >> go (p+d) (t+1) ls

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

convert [a,b,c] = (a,b,c)
main = do
    [n,m,s,f] <- readsInt
    l <- replicateM m (convert <$> readsInt)
    putStrLn $ solve n s f l

solve :: Int -> Int -> Int -> [(Int,Int,Int)] -> String
solve n s f l = go s 1 l
    where
    (c,d) = if s < f then ('R',1) else ('L',-1)
    go p _ _ | p == f = []
    go p t ((t',l,r):ls) | t == t' && ((l <= p && p <= r)||(l <= p+d && p+d <= r)) = 'X' :go p (t+1) ls
                         | t >= t' = c:go (p+d) (t+1) ls
    go p t ls = c:go (p+d) (t+1) ls

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

newtype Writer a = Writer { runWriter :: String -> (a,String) }

instance Functor Writer where
    fmap f (Writer g) = Writer (\s -> let (a,s) = g s in (f a,s))

instance Monad Writer where
    return a = Writer (\s -> (a,s))
    (Writer g) >>= f = Writer (\s -> let (a,s') = g s in runWriter (f a) s')

put ch = Writer (\s -> ((),ch:s))

convert [a,b,c] = (a,b,c)
main = do
    [n,m,s,f] <- readsInt
    l <- replicateM m (convert <$> readsInt)
    putStrLn $ solve n s f l

solve :: Int -> Int -> Int -> [(Int,Int,Int)] -> String
solve n s f l = reverse $ snd $ runWriter (go s 1 l) ""
    where
    (c,d) = if s < f then ('R',1) else ('L',-1)
    go p _ _ | p == f = return ()
    go p t ((t',l,r):ls) | t == t' && ((l <= p && p <= r)||(l <= p+d && p+d <= r)) = put 'X' >> go p (t+1) ls
                         | t >= t' = put c >> go (p+d) (t+1) ls
    go p t ls = put c >> go (p+d) (t+1) ls

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (print, reads)

reads :: IO [Int]
reads  =  liftM (map read . words) getContents
  where
    read s  =  read' 0 s
    read' a ""  =  a
    read' a (c:s)  =  read' (10 * a + fromEnum c - fromEnum '0') s

solve :: [Int] -> String
solve (n : m : s : f : xs)  =  take' l $ solve' 1 s xs
  where
    take' 0 _  =  []
    take' n (x:xs)
      | c == x  =  x : take' (n - 1) xs
      | otherwise  =  x : take' n xs
    l  =  abs (f - s)
    (k, c)  =  if f > s then (1, 'R') else (-1, 'L')
    solve' t s []  =  repeat c
    solve' t s qs@(ti : li : ri : xs)
      | t < ti  =  replicate (ti - t) c ++ solve' ti (s + k * (ti - t)) qs
      | f > s && (s + 1 < li || ri < s)  =  solve' t s xs
      | f < s && (s < li || ri < s - 1)  =  solve' t s xs
      | otherwise  =  'X' : solve' (t+1) s xs

print :: Show a => Maybe [a] -> IO ()
print  =  putStrLn . maybe  "Impossible" (intercalate " " . map show)

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

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

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

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

main :: IO ()
main = do
  [n,m,s,f] <- map read.words <$> getLine
  tlrs <- map readInt.B.words <$> B.getContents
  putStrLn $ solve n s f tlrs

solve :: Int -> Int -> Int -> [Int] -> String
solve n s f tlrs = go s 1 tlrs
   where
     go !cur !time tlrs@(t:l:r:rest)
       | cur == f = ""
       | time > t = go cur time rest
       | time == t && (p l cur r || p l next r) = 'X' : go cur (time+1) rest
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) tlrs
       | dir < 0 = 'X' : go cur (time+1) tlrs
       | dir > 0 && cur /= n = 'R' : go next (time+1) tlrs
       | otherwise = 'X' : go cur (time+1) tlrs
      where
        p l x r = l<=x && x<=r
        dir = signum (f - cur)
        next = cur + dir
     go !cur !time []
       | cur == f = ""
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) []
       | dir < 0 = 'X' : go cur (time+1) []
       | dir > 0 && cur /= n = 'R' : go next (time+1) []
       | otherwise = 'X' : go cur (time+1) []
      where
        dir = signum (f - cur)
        next = cur + dir

import Control.Monad (replicateM)

main :: IO ()
main = do
    [n, m, s, f] <- getWords
    blocks <- replicateM m $ do
        [t, l, r] <- getWords
        return (t, l, r)
    putStrLn $ solve s f blocks

solve :: Int -> Int -> [(Int, Int, Int)] -> String
solve source destination blocks = map showStep $ solve' source blocks 1 where
    showStep True  = if source < destination then 'R' else 'L'
    showStep False = 'X'

    solve' source blocks time
        | source == destination = []
        | null blocks = replicate (abs (destination - source)) True
        | t < time    = solve' source (tail blocks) time
        | otherwise   = canGo : solve' source' blocks (time + 1)
        where
            (t, l, r) = head blocks

            source' = if canGo then next else source
            canGo = not $ isBlocked source || isBlocked next
            next = if source < destination
                   then source + 1
                   else source - 1

            isBlocked x = t == time && l <= x && x <= r

getWords :: Read a => IO [a]
getWords = getLine >>= return . map read . words

import Control.Monad(liftM, forM, forM_)
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe(fromJust)
import Data.List(sort)

readi = fst . fromJust . B.readInt

goC s f
	| s < f = 'R'
	| otherwise = 'L'

next s f
	| s == f = s
	| s < f = s + 1
	| otherwise = s - 1

inn x (l, r) = l <= x && x <= r

go s f t [] = replicate (f - s) (goC s f)
go s f t ls@([t2, l, r]:ev)
	| s == f = ""
	| (t == t2) = if (inn s (l, r) || inn (next s f) (l, r))
			then 'X':(go s f (t + 1) ev)
			else (goC s f):(go ns f (t + 1) ev)
	| otherwise = (goC s f):(go ns f (t + 1) ls)
		where ns = next s f

main = do
	[n, m, s, f] <- (map readi . B.words) `liftM` B.getLine
	tlr <- sequence $ replicate m $ (map readi . B.words) `liftM` B.getLine
	putStr $ go s f 1 (sort tlr)

import Control.Monad(liftM, forM, forM_)
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe(fromJust)
import Data.List(sort)

readi = fst . fromJust . B.readInt

goC s f
	| s < f = 'R'
	| otherwise = 'L'

next s f
	| s == f = s
	| s < f = s + 1
	| otherwise = s - 1

inn x (l, r) = l <= x && x <= r

go s f t [] = replicate (t + (f - s)) (goC s f)
go s f t ls@([t2, l, r]:ev)
	| s == f = ""
	| (t == t2) = if (inn s (l, r) || inn (next s f) (l, r))
			then 'X':(go s f (t + 1) ev)
			else (goC s f):(go ns f (t + 1) ev)
	| otherwise = (goC s f):(go ns f (t + 1) ls)
		where ns = next s f

main = do
	[n, m, s, f] <- (map readi . B.words) `liftM` B.getLine
	tlr <- sequence $ replicate m $ (map readi . B.words) `liftM` B.getLine
	putStr $ go s f 1 (sort tlr)

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

import Data.List
import Data.Int
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

newtype Writer a = Writer { runWriter :: ListLike Char -> (a,ListLike Char) }
newtype ListLike a = ListLike { genList :: [a] -> [a] }

instance Functor Writer where
    fmap f (Writer g) = Writer (\s -> let (a,s) = g s in (f a,s))

instance Monad Writer where
    return a = Writer (\s -> (a,s))
    (Writer g) >>= f = Writer (\s -> let (a,s') = g s in runWriter (f a) s')

emptyList = ListLike id
put ch = Writer (\s -> ((),ListLike (\l -> ch:l)))

convert [a,b,c] = (a,b,c)
main = do
    [n,m,s,f] <- readsInt
    l <- replicateM m (convert <$> readsInt)
    putStrLn $ solve n s f l

solve :: Int -> Int -> Int -> [(Int,Int,Int)] -> String
solve n s f l = genList (snd $ runWriter (go s 1 l) emptyList) ""
    where
    (c,d) = if s < f then ('R',1) else ('L',-1)
    go p _ _ | p == f = return ()
    go p t ((t',l,r):ls) | t == t' && ((l <= p && p <= r)||(l <= p+d && p+d <= r)) = put 'X' >> go p (t+1) ls
                         | t >= t' = put c >> go (p+d) (t+1) ls
    go p t ls = put c >> go (p+d) (t+1) ls

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

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

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

main :: IO ()
main = do
  [n,m,s,f] <- map read.words <$> getLine
  tlrs <- map readInt.B.words <$> B.getContents
  putStrLn $ solve n s f tlrs

solve :: Int -> Int -> Int -> [Int] -> String
solve n s f tlrs = go s 1 tlrs
   where
     go !cur !time (t:l:r:rest)
       | cur == f = ""
       | time == t && l<=next && next<=r = 'X' : go cur (time+1) rest
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) rest
       | dir < 0 = 'X' : go cur (time+1) rest
       | dir > 0 && cur /= n = 'R' : go next (time+1) rest
       | otherwise = 'X' : go cur (time+1) rest
      where
        dir = signum (f - cur)
        next = cur + dir
     go !cur !time []
       | cur == f = ""
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) []
       | dir < 0 = 'X' : go cur (time+1) []
       | dir > 0 && cur /= n = 'R' : go next (time+1) []
       | otherwise = 'X' : go cur (time+1) []
      where
        dir = signum (f - cur)
        next = cur + dir

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

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

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

main :: IO ()
main = do
  [n,m,s,f] <- map read.words <$> getLine
  tlrs <- map readInt.B.words <$> B.getContents
  putStrLn $ solve n s f tlrs

solve :: Int -> Int -> Int -> [Int] -> String
solve n s f tlrs = go s 1 tlrs
   where
     go !cur !time tlrs@(t:l:r:rest)
       | cur == f = ""
       | time == t && (p l cur r || p l next r) = 'X' : go cur (time+1) rest
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) tlrs
       | dir < 0 = 'X' : go cur (time+1) tlrs
       | dir > 0 && cur /= n = 'R' : go next (time+1) tlrs
       | otherwise = 'X' : go cur (time+1) tlrs
      where
        p l x r = l<=x && x<=r
        dir = signum (f - cur)
        next = cur + dir
     go !cur !time []
       | cur == f = ""
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) []
       | dir < 0 = 'X' : go cur (time+1) []
       | dir > 0 && cur /= n = 'R' : go next (time+1) []
       | otherwise = 'X' : go cur (time+1) []
      where
        dir = signum (f - cur)
        next = cur + dir

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

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

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

main :: IO ()
main = do
  [n,m,s,f] <- map read.words <$> getLine
  tlrs <- map readInt.B.words <$> B.getContents
  putStrLn $ solve n s f tlrs

solve :: Int -> Int -> Int -> [Int] -> String
solve n s f tlrs = go s 1 tlrs
   where
     go !cur !time (t:l:r:rest)
       | cur == f = ""
       | time == t && (p l cur r || p l next r) = 'X' : go cur (time+1) rest
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) rest
       | dir < 0 = 'X' : go cur (time+1) rest
       | dir > 0 && cur /= n = 'R' : go next (time+1) rest
       | otherwise = 'X' : go cur (time+1) rest
      where
        p l x r = l<=x && x<=r
        dir = signum (f - cur)
        next = cur + dir
     go !cur !time []
       | cur == f = ""
       | dir < 0 && cur /= 1 = 'L' : go next (time+1) []
       | dir < 0 = 'X' : go cur (time+1) []
       | dir > 0 && cur /= n = 'R' : go next (time+1) []
       | otherwise = 'X' : go cur (time+1) []
      where
        dir = signum (f - cur)
        next = cur + dir


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

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

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

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

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

main = getLine >> getContents >>= putStrLn . which "YES" "NO" . all ( all ( == 'X' ) ) . clip . transpose . clip . lines

clip = filter ( not . all ( == '.' ) )

import Data.List

-- solvable iff input shape is a rectangle
solve :: [String] -> Bool
solve strs =
  let blank = all (=='.')
      dropBlanks = filter (not . blank)
      strs' = dropBlanks $ transpose $ dropBlanks strs
      allXSegments = all (all (=='X'))
  in allXSegments strs'

main :: IO ()
main = do
  _ <- getLine
  rst <- getContents
  let soln = solve $ lines rst
  if soln then
    putStrLn "YES"
    else putStrLn "NO"

import Control.Monad( replicateM)
import Data.List( nub)
main = do
    [n_, m_] <- return.map read.words =<< getLine
    ls <- replicateM n_ getLine
    let cleansed = filter (any ('X'==)) ls
    putStr $ if 1 == (length $ nub cleansed) then "YES" else "NO"


import Control.Applicative
import Control.Monad
import Data.List
import Data.Function
import Text.Printf

comb :: Integral b => b -> [a] -> [[a]]
comb 0 _        = [[]]
comb _ []       = []
comb n (x : xs) = map (x :) (comb (n - 1) xs) ++ comb n xs

icomb :: Integer -> Integer -> Integer
icomb n m = product [n, n - 1 .. n - m + 1] `quot` product [1 .. m]

participants :: Int -> [[Int]]
participants n = [[x, x] | x <- [1 .. n]]

solve :: Int -> [(Int, [Int])]
solve n = map ((,) <$> fst . head <*> map snd) . groupBy ((==) `on` fst) . sort $
  f (comb 2 [1 .. days]) (participants n)
 where
  days = (+ 2) $ length $ (takeWhile (<= n')) $ map (`icomb` 2) [3 ..]
   where n' = toInteger n
  f []          bss           = []
  f ~(as : ass) ~(bs : bss)   = zip as bs ++ f ass bss

main :: IO ()
main = do
  xs <- solve <$> readLn
  print $ length xs
  forM_ xs $ \(_, hobbits) ->
    putStrLn $ drop 1 $ hobbits >>= printf " %s" . show

import Data.Function
import List

main = readLn >>= putStrLn . solve

solve n = show k ++ "\n" ++ unlines [unwords $ map (show . snd) day | day <- lst3 ]
  where
    k = last $ takeWhile (\x -> x * (x - 1) `div` 2 <= n) [1..]
    lst = [(i, j) | i <- [1..k], j <- [1..i-1]]

    lst2 = concat [[(pi, i), (pj, i)] | (i, (pi, pj)) <- zip [1..] lst]

    lst3 = groupBy ((==) `on` fst) $ sort lst2

import Control.Applicative
import Control.Monad
import Data.List
import Data.Function
import Text.Printf

comb :: Integral b => b -> [a] -> [[a]]
comb 0 _        = [[]]
comb _ []       = []
comb n (x : xs) = map (x :) (comb (n - 1) xs) ++ comb n xs

participants :: Int -> [[Int]]
participants n = [[x, x] | x <- [1 .. n]]

solve :: Int -> [(Int, [Int])]
solve n = map ((,) <$> fst . head <*> map snd) . groupBy ((==) `on` fst) . sort $
  loop 3 (participants n)
 where
  loop days xs = case f [] (comb 2 [1 .. days]) xs of
    Nothing         -> []
    Just (acc, xs') -> acc ++ loop (days + 1) xs'
   where
    f acc []          bss          = Just (acc, bss)
    f _   _           []           = Nothing
    f acc (as : ass)  (bs : bss) = f (zip as bs ++ acc) ass bss

main :: IO ()
main = do
  xs <- solve <$> readLn
  print $ length xs
  forM_ xs $ \(_, hobbits) ->
    putStrLn $ drop 1 $ hobbits >>= printf " %s" . show


import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Array as A
import Data.Int

solve :: Int64 -> Int64 -> [Int64] -> [Int64] -> [Int64]
solve n m al bl = [query first bl,query last bl]
    where
        first = A.array (1,n) $ zip al [1..]
        last  = A.array (1,n) $ zip (reverse al) [1..]
        query ary  = L.foldl' (\e k -> e +  (ary A.! k)) 0

main :: IO ()
main = do n  <- (getLine >>= return . read)
          al <- (getLine >>= return . map read . words)
          m  <- (getLine >>= return . read)
          bl <- (getLine >>= return . map read . words)
          putStrLn . unwords . map show $ solve n m al bl

import Array

solve :: Integer -> Array Int Int -> [Int] -> (Integer, Integer)
solve n array qs  =  foldl acc (0, 0) qs
  where
    acc (s1, s2) q  =  s1' `seq` s2' `seq` (s1', s2')
      where
        s1'  =  s1 + a
        s2'  =  s2 + n + 1 - a
        a    =  fromIntegral (array ! q)

main :: IO ()
main  =  do
    n   <-  readLn
    as  <-  fmap (map read . words) getLine
    getLine
    qs  <-  fmap (map read . words) getLine
    let (a, b)  =  solve n (array (1, fromIntegral n) (zip as [1..])) qs
    putStrLn $ concat [show a, " ", show b]

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

solve :: Int -> Int -> [Int] -> [Int] -> [Int]
solve n m al bl = [query firstMap bl,query lastMap bl]
    where
        firstMap = M.fromListWith (\a b -> a) $ zip al [1..]
        lastMap  = M.fromListWith (\a b -> a) $ zip (reverse al) [1..]
        query m  = L.foldl' (\e k -> e +  (Maybe.fromJust $ M.lookup k m)) 0

main :: IO ()
main = do n  <- (getLine >>= return . read)
          al <- (getLine >>= return . map read . words)
          m  <- (getLine >>= return . read)
          bl <- (getLine >>= return . map read . words)
          putStrLn . unwords . map show $ solve n m al bl


module Main where
import Data.List
import Data.Monoid
import Data.Maybe

default (Int)

main = interact exec
exec = show . succ . fromJust . findIndex (\(i, _) -> i == 1) . sortBy (\(i1, s1) (i2, s2) -> compare s2 s1 `mappend` compare i1 i2) . zip [1..] . chunks . tail . map read . words
  where
    chunks (a:b:c:d:xs) = (a + b + c + d):chunks xs
    chunks [] = []

import Data.List
f ::Int->[String]->[(Int,Int)]
f _ []=[]
f p (x:xs)=(sum ( map read (words x)::[Int]),-p):f (p+1) xs

g ::Int->[(Int,Int)]->Int
g ans ((_,(-1)):xs)=ans
g ans (_:xs)=g (ans+1) xs

main = do
       e1<-getLine
       es<-getContents
       let n=read e1::Int
           xs=lines es
           ys=reverse $ sort $ f 1 xs
       print $ g 1 ys

{-# LANGUAGE ScopedTypeVariables #-}

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

main :: IO ()
main = do
    (n :: Int) <- read <$> getLine
    (arr :: [[Int]]) <- replicateM n ((map read . words) <$> getLine)
    let sortedArr = sortBy (\(x1, y1) (x2, y2) -> comparing sum x2 x1 `mappend` compare y1 y2) $ zip arr [1..]
    printf "%d" $ (+ 1) $ fromJust $ findIndex (\(_, y) -> y == 1) sortedArr

import Data.List
import Data.Ord
main = interact $ show . succ . head . findIndices ((== 1) . snd) . sort . flip zip [1..] . map (Down . sum . map read . words) . tail . lines

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

main = do
	n <- read <$> getLine ::IO Int
	s <- map sum <$> map (map read ) <$> map words  <$> replicateM n getLine:: IO [Int]
	let j = head s
	print $ 1+ length ( takeWhile (>j)(reverse  (sort s)))

--ghc 7.10

import Data.List(sortBy, findIndex)
import Data.Ord(comparing)
import Data.Maybe(fromJust)

rank :: [[Int]] -> Int
rank = (1+) . fromJust . findIndex (\x -> fst x == 1) . sortBy (flip $ comparing snd) . zip [1..] . map sum

main = do
    nStr <- getLine
    contents <- getContents
    let grades = map (map read . words) . lines $ contents
    print $ rank grades

{-# LANGUAGE ScopedTypeVariables #-}

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

main :: IO ()
main = do
    (n :: Int) <- read <$> getLine
    (arr :: [[Int]]) <- replicateM n ((map read . words) <$> getLine)
    let sortedArr = sortBy (\(x1, y1) (x2, y2) -> compare x2 x1 `mappend` compare y1 y2) $ zip arr [1..]
    printf "%d" $ fromJust $ findIndex (\(_, y) -> y == 1) sortedArr

import Data.List
import Data.Ord
main = interact $ show . unDown . fst . head . filter ((== 1) . snd) . sort . flip zip [1..] . map (Down . sum . map read . words) . tail . lines
unDown (Down x) = x

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

main = do
	n <- read <$> getLine ::IO Int
	s <- map sum <$> map (map read ) <$> map words  <$> replicateM n getLine:: IO [Int]
	let j = head s
	print $ 1+ length ( takeWhile (>j) (sort s))

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

main = do
	n <- read <$> getLine ::IO Int
	s <- map sum <$> map (map read ) <$> map words  <$> replicateM n getLine:: IO [Int]
	let j = head s
	print $ 1+ length ( takeWhile (>j) s)


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

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

boolInt :: Bool -> Int
boolInt p = if  p  then  1  else  0

query :: Int -> Int -> SIO Int
query li ri = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (B.char7 '?' : map B.intDec [li, ri])
  in  do
  lift $ B.hPutBuilder stdout outBuilder >> hFlush stdout
  [response] <- readInts
  pure response

go :: Int -> Int -> Int -> SIO Int
go v li ri = let
  mi = div (li + ri) 2
  in  if  li + boolInt (elem v [li, ri]) == ri
  then  pure $ if  v == li
    then  ri
    else  li
  else  if  v < li
  then  do
    resp <- query v mi
    if  resp == v
      then  go v li mi
      else  go v (mi+1) ri
  else  if  ri < v
  then  do
    resp <- query (mi+1) v
    if  resp == v
      then  go v (mi+1) ri
      else  go v li mi
  else  do
  let
    innermi = mi + boolInt (v <= mi) - boolInt (even $ ri - li)
    lower = v <= innermi
  resp <- if  lower  then  query li innermi  else  query (innermi+1) ri
  if  (resp == v) == lower
    then  go v li innermi
    else  go v (innermi+1) ri

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  sndMin <- query 1 n
  ans <- go sndMin 1 n
  lift $ B.hPutBuilder stdout
    $ B.char7 '!' <> B.char7 ' ' <> B.intDec ans <> B.char7 '\n'

type SIO = StateT P.ByteString IO

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

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

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array.IArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

------

getInt = fst . fromJust . B.readInt . dropCR <$> B.getLine

ask l r = do
  B.putStrLn $ B.unwords ["?", bshow (l + 1), bshow r]
  hFlush stdout
  (subtract 1) <$> getInt

answer i = do
  B.putStrLn $ B.unwords ["!", bshow (i + 1)]
  hFlush stdout

main = do
  n <- getInt
  p <- ask 0 n
  let r = sortOn (\(i, j) -> i - j) $
          filter (\(i, j) -> i /= j) [(0, p), (p + 1, n)]
  case r of
    [(i, j)] -> go p i j
    [(i, j), (k, l)]
      | i < p -> do q <- ask i (p + 1)
                    if p == q
                      then go p i j
                      else go p k l
      | otherwise -> do q <- ask p j
                        if p == q
                          then go p i j
                          else go p k l

go p i j | i < p = lgo i j p
         | otherwise = rgo p i j

lgo i j p | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask k (p + 1)
                             if p == q
                               then lgo k j p
                               else lgo i k p

rgo p i j | j - i == 1 = answer i
          | otherwise = let k = (i + j) `quot` 2 in
                          do q <- ask p k
                             if p == q
                               then rgo p i k
                               else rgo p k j