import Data.List
import Control.Monad

f :: [[Int]] -> Int
f ([]) = -1
f (x:xs) = 1 + (f $ dfsFilter cmp xs x)

cmp [x1,y1] [x2,y2] = x1 == x2 || y1 == y2

dfsFilter :: (a -> a -> Bool) -> [a] -> a -> [a]
dfsFilter cf vs v = let sm = filter (cf v) vs
                        ds = filter (not.cf v) vs
                    in foldl (dfsFilter cf) ds sm

main = (f `fmap` ((read `fmap` getLine) >>= (flip replicateM ((map read. words) `fmap` getLine)))) >>= print

import Data.List
import Data.Maybe (fromMaybe)
import Data.Function
import qualified Data.Map as Map
import qualified Data.Set as Set

readInt s    = read s :: Int
readInts n s = map readInt $ take n $ words s

data Point = Point { pid :: Int
                   , xCoord :: Int
                   , yCoord :: Int
                   } deriving (Show, Eq)

---------------------------------------------
data Queue a = Queue { input :: [a]
                     , output :: [a]
                     } deriving (Show)

emptyQueue = Queue [] []

isEmpty :: Queue e -> Bool
isEmpty q@Queue{input = [], output = []} = True
isEmpty _ = False

pushQueue :: a -> Queue a -> Queue a
pushQueue x q@Queue{input = i} = q{input = x : i}

popQueue :: Queue a -> (a, Queue a)
popQueue q@Queue{input = i, output = o}
    | null i && null o  = error "Que is empty!"
    | null o            = popQueue (pour q)
    | otherwise         = (head o, q{output = tail o})
    where pour q@Queue{input = i, output = o}
            | null i    = q
            | otherwise = pour q{input = tail i, output = head i : o}
---------------------------------------------

tryAdd :: Ord a => Queue a -> Set.Set a -> [a] -> ( Queue a, Set.Set a )
tryAdd que unused elems
  | null elems = (que, unused)
  | otherwise  = let (cur:elemtail) = elems
                 in if cur `Set.member` unused
                    then tryAdd (pushQueue cur que) (Set.delete cur unused) elemtail
                    else tryAdd que unused elemtail

globalBFS points pointsByX pointsByY = let n = length points
    in bfs emptyQueue (Set.fromList [0 .. n - 1])
    where bfs queue unused
            | Set.null unused = 0
            | isEmpty queue    = bfs (Queue [] [first]) (Set.delete first unused) + 1
                where first = head (Set.toList unused)
          bfs queue unused = bfs queue' unused'
                where (quetop, quetail) = popQueue queue
                      topX = xCoord (points !! quetop)
                      topY = yCoord (points !! quetop)
                      neighbors = fromMaybe [] (Map.lookup topX pointsByX) ++ fromMaybe [] (Map.lookup topY pointsByY)
                      (queue', unused') = tryAdd quetail unused neighbors

main = do
    args0 <- getLine
    content <- getContents
    let n = head (readInts 1 args0)
        raw_points = map (readInts 2) . take n . lines $ content
        points = map (\(pid, [x,y]) -> Point pid x y) numeredPoints
            where numeredPoints = zip [0 .. ] raw_points

        pointsByX = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` xCoord) . sortBy (compare `on` xCoord) $ points
                  extract ps = (xCoord (head ps), map pid ps)

        pointsByY = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` yCoord) . sortBy (compare `on` yCoord) $ points
                  extract ps = (yCoord (head ps), map pid ps)

    putStrLn . show $ globalBFS points pointsByX pointsByY - 1

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

readInt s    = read s :: Int
readInts n s = map readInt $ take n $ words s

data Point = Point { pid :: Int
                   , xCoord :: Int
                   , yCoord :: Int
                   } deriving (Show, Eq)

tryAdd :: Ord a => [a] -> (Set.Set a) -> [a] -> ( [a], (Set.Set a) )
tryAdd que unused elems
  | null elems = (que, unused)
  | otherwise  = let (cur:elemtail) = elems
                 in if cur `Set.member` unused
                    then tryAdd (cur : que) (Set.delete cur unused) elemtail
                    else tryAdd que unused elemtail

unwrap :: Maybe [a] -> [a]
unwrap (Just x) = x
unwrap Nothing  = []

globalBFS points pointsByX pointsByY = let n = length points
    in bfs [] (Set.fromList [0 .. n - 1])
    where bfs queue unused
            | Set.null unused = 0
            | null queue    = bfs [first] (Set.delete first unused) + 1
                where first = head (Set.toList unused)
          bfs (quetop:quetail) unused = bfs queue' unused'
                where topX = xCoord (points !! quetop)
                      topY = yCoord (points !! quetop)
                      neighbors = unwrap (Map.lookup topX pointsByX) ++ unwrap (Map.lookup topY pointsByY)
                      (queue', unused') = tryAdd quetail unused neighbors

main = do
    args0 <- getLine
    content <- getContents
    let n = head (readInts 1 args0)
        raw_points = map (readInts 2) . take n . lines $ content
        points = map (\(pid, [x,y]) -> Point pid x y) numeredPoints
            where numeredPoints = zip [0 .. ] raw_points

        pointsByX = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` xCoord) . sortBy (compare `on` xCoord) $ points
                  extract ps = (xCoord (head ps), map pid ps)

        pointsByY = Map.fromList . map extract $ grouped
            where grouped = groupBy ((==) `on` yCoord) . sortBy (compare `on` yCoord) $ points
                  extract ps = (yCoord (head ps), map pid ps)

    putStrLn . show $ globalBFS points pointsByX pointsByY - 1

import Data.Graph
import qualified Data.Set as DS

main = interact $ f . map (map read . words)  . tail . lines

g v@(z, x:y:_) s1 = nodes
  where ans = DS.toList $ DS.filter (\(_, i:j:_) -> i==x || y==j) s1
        nodes = zip [z,z..] $ map (\(i, _) -> i) ans

f :: [[Int]] -> String
f x = show tvl
  where pre = zip [0..] x
        l = (length x) -1
        mx = DS.fromList $ pre
        e = concat $ map (\v -> g v mx) pre
        gf = buildG (0, l) e
        tvl = (length (dfs gf [0..l])) -1

import Data.List
import Control.Monad

f ([]) = -1
f (x:xs) = 1 + f (dfsF cmp xs x)

cmp x y = or $ zipWith (==) x y

dfsF cf vs v = let (sm,ds) = partition (cf v) vs
               in foldl (dfsF cf) ds sm

main = getLine >>= ((`replicateM` (words `fmap` getLine)).read) >>= print.f

--    ghc --make -O Main.hs
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Control.Monad.ST as ST
import qualified Data.STRef as STRef

data Point = Point {
    x :: Int
  , y :: Int
  } deriving (Eq, Ord, Show)

listToPoint :: [Int] -> Point
listToPoint [x',y'] = Point { x = x', y = y'}
listToPoint _ = error "Point parsing error"

inputToList :: String -> [Point]
inputToList s = map (listToPoint.( map read ).words) $ filter (not.null) $ tail.lines $ s

getInts :: (Point -> Int) -> [Point] -> [Int]
getInts f l = foldr step [] l
            where step p acc = (f p):acc

getAdj :: (Point -> Int) -> (Point -> Int) -> [Point] -> Map.Map Int [Int]
getAdj key val l = foldr step Map.empty l
   where step :: Point -> Map.Map Int [Int] -> Map.Map Int [Int]
         updateWith :: Map.Map Int [Int]->Int->Int->Maybe [Int] -> Map.Map Int [Int]
         updateWith acc k v Nothing = Map.insert k [v] acc
         updateWith acc k v (Just vs) = Map.insert k (v:vs) acc
         step p acc = let k = key p
                          v = val p
                      in updateWith acc k v (Map.lookup k acc)

getAdjToX :: [Point] -> Map.Map Int [Int]
getAdjToX = getAdj x y

getAdjToY :: [Point] -> Map.Map Int [Int]
getAdjToY = getAdj y x

xyToPoint :: Int -> Int -> Point
xyToPoint x' y' = Point{ x = x', y = y' }

yxToPoint :: Int -> Int -> Point
yxToPoint y' x' = Point{ x = x', y = y' }

getAdjPoints' :: (Point -> Int) -> (Point -> Int) -> (Int -> Int -> Point ) -> Map.Map Int [Int] -> Point -> [Point]
getAdjPoints' dec1 dec2 comp adj p = let k1 = dec1 p
                                         k2 = dec2 p
                                      in case Map.lookup k1 adj of
                                         Nothing -> []
                                         Just l -> map (comp k1) (filter (/= k2) l)

data Graph = Graph {
    xAdjList :: Map.Map Int [Int]
  , yAdjList :: Map.Map Int [Int]
  } deriving (Show)

graphFromList :: [Point] -> Graph
graphFromList ps = Graph { xAdjList = getAdjToX ps, yAdjList = getAdjToY ps  }

getAdjPoints :: Graph -> Point -> [Point]
getAdjPoints g p = (getAdjPoints' x y xyToPoint (xAdjList g) p) ++
                                    (getAdjPoints' y x yxToPoint (yAdjList g) p)

dfs :: Graph -> STRef.STRef s (Set.Set Point) -> Point -> ST.ST s()
dfs g seenST p = do
  seen <- STRef.readSTRef seenST
  STRef.writeSTRef seenST (Set.insert p seen)
  dfs' g seenST (filter (\ e -> Set.notMember e seen) (getAdjPoints g p))

dfs' :: Graph -> STRef.STRef s (Set.Set Point) -> [Point] -> ST.ST s()
dfs' _ _ [] = return ()
dfs' g seenST (p:ps) = do
   dfs g seenST p
   dfs' g seenST ps

connectedComponents :: [Point] -> Int
connectedComponents ps = ST.runST $ do
                           seenST <- STRef.newSTRef Set.empty
                           loop 0 ps seenST
                         where
                           g = graphFromList ps
                           loop :: Int -> [Point] -> STRef.STRef s (Set.Set Point) -> ST.ST s(Int)
                           loop acc [] _ = return (acc)
                           loop acc (p:ps') seenST = do
                               seen <- STRef.readSTRef seenST
                               if Set.member p seen
                               then loop acc ps' seenST
                               else do
                                 dfs g seenST p
                                 loop (acc+1) ps' seenST
solve :: String -> String
solve in_str = show ( (connectedComponents (inputToList in_str)) - 1 ) ++ "\n"

main :: IO ()
main = do interact $ solve

import Data.Graph
import Data.List
main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b :: Int) : pairs xs
pairs [] = []
solve ps = length (dff g) - 1
  where g = buildG (1,length ps) [ (i,j) | (i,u) <- zip [1..] ps
                                         , (j,v) <- zip [1..] ps
                                         , touch u v ]
touch (i,j) (i',j') = i == i' || j == j'

{-# LANGUAGE BangPatterns #-}

import Data.Array.Base
import Data.Array.IO (IOUArray)
import qualified Data.IntSet as IS
import Control.Applicative
import Control.Monad

toPairs (x:y:xys) = (x,y):toPairs xys
toPairs [] = []

rep :: Int -> (Int -> IO ()) -> IO ()
rep !n f = go 0
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()

for :: Int -> Int -> (Int -> IO ()) -> IO ()
for !m !n f = go m
   where
     go !i
       | i<n = f i >> go (i+1)
       | otherwise = return ()

main = do
  n <- readLn

-- Union-Find Tree
  parent <- newListArray (0,n-1) [0..n-1] :: IO (IOUArray Int Int)
  rank <- newArray (0,n-1) 0 :: IO (IOUArray Int Int)

  let find :: Int -> IO Int
      find x = do
        let go y hist = do
              py <- unsafeRead parent y
              if py == y
                 then return (y:hist)
                 else go py (y:hist)
        (root:hist) <- go x []
        forM_ hist $ \h-> do
          unsafeWrite parent h root
        return root

      union :: Int -> Int -> IO ()
      union x y = do
        rootx <- find x
        rooty <- find y
        if rootx == rooty
           then return ()
           else do
             rankx <- unsafeRead rank rootx
             ranky <- unsafeRead rank rooty
             case compare rankx ranky of
               LT -> unsafeWrite parent rootx rooty
               GT -> unsafeWrite parent rooty rootx
               EQ -> do
                 unsafeWrite parent rootx rooty
                 unsafeWrite rank rooty (ranky+1)

  (xs,ys) <- unzip.toPairs.map read.words <$> getContents
  let xarr = listArray (0,n-1) xs :: UArray Int Int
      yarr = listArray (0,n-1) ys :: UArray Int Int
      i===j = unsafeAt xarr i == unsafeAt xarr j
                || unsafeAt yarr i == unsafeAt yarr j

  rep n $ \i-> do
    for (i+1) n $ \j-> do
      when (i===j) $ union i j

  mapM find [0..n-1] >>= print.pred.IS.size.IS.fromList

import Data.List
main = interact $ show . solve . pairs . map read . tail . words
pairs (a:b:xs) = (a,b :: Int) : pairs xs
pairs [] = []
solve ps = length (foldl ins [] ps) - 1
ins gs p | Just g <- find (gr p) gs = (p:g) : delete g gs
         | otherwise = [p] : gs
gr (i,j) ps = any (\(i',j') -> i == i' || j == j') ps

import Data.List
import Control.Monad

f :: [[Int]] -> Int
f = (\x -> x-1) . length . nubBy (\[x1,y1] [x2,y2] -> x1 == x2 || y1 == y2)

main = (f `fmap` ((read `fmap` getLine) >>= (flip replicateM ((map read. words) `fmap` getLine)))) >>= print


{-# LANGUAGE Strict #-}
import Data.List as List
import Data.Function

m = 998244353

powmod a x n
 |n==0 = a
 |even n = powmod a (mod (x*x) m) (div n 2)
 |otherwise = powmod (mod (a*x) m) x (n-1)

ff a [] = [a]
ff (a,b) ((c,d):xs)
 |b>d = ff (a,b) xs
 |b>c = (a,d):xs
 |otherwise = (a,b):(c,d):xs

f xs0 = --trace (show (xs1,xs2,xs3,xs4,xs5,n))
 powmod 1 2 n
 where
  xs1 = sort $ zip xs0 [0..]
  xs2 = List.groupBy (on (==) fst) xs1
  xs3 = fmap (\xs-> (snd $ head xs, snd $ last xs)) xs2
  xs4 = sort xs3
  xs5 = foldr ff [] xs4
  n = length xs5 - 1

main = do
  getLine
  line <- getLine
  let xs = fmap read $ words line :: [Int]
  print $ f xs

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  print $ query n as

query :: Int -> [(Int, Int)] -> Word32
query n as = fromMon $ (2^)
  $ length $ filter (==0) $ scanl1 (+) $ init $ A.elems acc
  where
    acc :: UArray Int Int
    acc = runSTUArray $ do
      acc <- A.newArray (0,n) 0
      forM_ groupedAs $ \(i,j) -> do
        A.writeArray acc (i+1) 1
        A.writeArray acc (j+1) (-1)
      A.writeArray acc 0 1
      A.writeArray acc 1 . (+(-1)) =<< A.readArray acc 1
      return acc
    group_ [] = []
    group_ ((i,x):xs) = go0 i x xs
      where
        go0 !i !x ((j,y):xs) | x == y    = go i j x xs
                             | otherwise = go0 j y xs
        go0 !i !x [] = []
        go !i !j !x ((k,y):xs) | x == y    = go i k x xs
                               | otherwise = (i,j) : go0 k y xs
        go !i !j !x [] = [(i,j)]
    groupedAs = group_ $ sortBy (compare `on` snd) as

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((parsed,(i,i)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(_,x) (y,_) -> (y,x)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,max x1 y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-1)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  print $ query n as

query :: Int -> [(Int, Int)] -> Word32
query n as = fromMon $ (2^)
  $ length $ filter (==0) $ scanl1 (+) $ init $ A.elems $ acc
  where
    acc :: UArray Int Int
    acc = runSTUArray $ do
      acc <- A.newArray (0,n) 0
      prevs <- newSTRef $ IM.empty
      A.writeArray acc 0 1
      A.writeArray acc 1 (-1)
      forM_ as $ \(!i_now,!key) -> do
        !prevs0 <- readSTRef prevs
        let (!i_prev, !prevs1) = IM.insertLookupWithKey
                                 (\_ -> const) key i_now prevs0
        writeSTRef prevs prevs1
        flip (maybe $ return ()) i_prev $ \i_prev -> do
          A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
          A.writeArray acc (i_now+1) . (subtract 1)
            =<< A.readArray acc (i_now+1)
      return acc

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ as $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.insertLookupWithKey
                             (\_ _ -> id) key i_now prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc i
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n-1) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc (i-1)
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,(parsed,parsed)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(x,_) (_,y) -> (x,y)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-2)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((parsed,(i,i)),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  let intvs = IM.elems $ IM.fromListWith (\(_,x) (y,_) -> (y,x)) as
      goodIntvs = unionIntvs $ sort intvs
      unionIntvs ((x0,x1):(y0,y1):is)
        | y0 <= x1 = unionIntvs ((x0,y1):is)
      unionIntvs (i:is) = i:unionIntvs is
      unionIntvs [] = []
      ansExpt = (n -) $ sum $ map (uncurry subtract) goodIntvs :: Int
  print $ fromMon $ 2^(ansExpt-1)

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc (i-1)
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

-- Codeforces Round #531 (E), Contest 1102, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine :: IO Int
  prevs <- newIORef $ IM.empty
  acc <- A.newArray (0,n) 0 :: IO (IOUArray Int Int)
  as <- unfoldr (\(!i,!bs) -> do
                    (parsed,bs1) <- BS.readInt $ BS.dropWhile (<'!') bs
                    return ((i,parsed),(i+1,bs1))
                ) . (0,) <$> BS.getLine
  forM_ (init as) $ \(!i_now,!key) -> do
    !prevs0 <- readIORef prevs
    let (!i_prev, !prevs1) = IM.updateLookupWithKey
                             (\_ _ -> Just i_now) key prevs0
    writeIORef prevs prevs1
    flip (maybe $ return ()) i_prev $ \i_prev -> do
      A.writeArray acc (i_prev+1) . (+1) =<< A.readArray acc (i_prev+1)
      A.writeArray acc (i_now+1) . (subtract 1) =<< A.readArray acc (i_now+1)
  A.writeArray acc 0 1
  A.writeArray acc 1 . (subtract 1) =<< A.readArray acc 1
  brackets <- newIORef (0::Int)
  forM_ [1..n-1] $ \i -> do
    prev <- A.readArray acc (i-1)
    intvs <- (prev+) <$> A.readArray acc i
    A.writeArray acc i intvs
    when (intvs == 0) $ do
      writeIORef brackets . (+1) =<< readIORef brackets
  print . fromMon . (2^) =<< readIORef brackets

{-# INLINE n #-}
n :: (Integral i) => i
n = 998244353

{-# INLINE nprime #-}
nprime :: Word64
nprime = 998244351

{-# INLINE rsq #-}
rsq :: Word64
rsq = 932051910

newtype Montgomery = Mon {unMon :: Word32}
  deriving (Eq, Show)

instance Num Montgomery where
  {-# INLINE (+) #-}
  (+) = monAdd
  {-# INLINE (*) #-}
  (*) = monMult
  {-# INLINE (-) #-}
  (-) = monSub
  {-# INLINE negate #-}
  negate (Mon x) = Mon (n - x)
  {-# INLINE fromInteger #-}
  fromInteger = monRep . fromInteger
  {-# INLINE signum #-}
  signum x | x == Mon 0 = Mon 0
           | otherwise  = monRep 1
  {-# INLINE abs #-}
  abs = id

{-# INLINE monMult #-}
monMult :: Montgomery -> Montgomery -> Montgomery
monMult (Mon x) (Mon y) = Mon $ monRed $ fromIntegral x * fromIntegral y

{-# INLINE monAdd #-}
monAdd :: Montgomery -> Montgomery -> Montgomery
monAdd (Mon x) (Mon y) = Mon $ x+y + if x >= n-y then n else 0

{-# INLINE monSub #-}
monSub :: Montgomery -> Montgomery -> Montgomery
monSub (Mon x) (Mon y) = Mon $ x-y + if x < y then n else 0

{-# INLINE monRep #-}
monRep :: Word32 -> Montgomery
monRep x = Mon $ monRed $ rsq * fromIntegral x

{-# INLINE fromMon #-}
fromMon :: Montgomery -> Word32
fromMon (Mon x) = monRed $ fromIntegral x

{-# INLINE monRed #-}
monRed :: Word64 -> Word32
monRed x = t - if t >= n then n else 0
  where t = fromIntegral $ (`shiftR` 32) $ x + x*nprime .&.mask32 *n

mask32 :: Word64
mask32 = bit 32 - 1

{-# LANGUAGE Strict #-}
import Data.List as List
import Data.Function

m = 998244353

powmod a x n
 |n==0 = a
 |even n = powmod a (mod (x*x) m) (div n 2)
 |otherwise = powmod (mod (a*x) m) x (n-1)

ff a [] = [a]
ff (a,b) ((c,d):xs)
 |b>c = (a,d):xs
 |otherwise = (a,b):(c,d):xs

f xs0 = powmod 1 2 n
 where
  xs1 = sort $ zip xs0 [0..]
  xs2 = List.groupBy (on (==) fst) xs1
  xs3 = fmap (\xs-> (snd $ head xs, snd $ last xs)) xs2
  xs4 = sort xs3
  xs5 = foldr ff [] xs4
  n = length xs5 - 1

main = do
  getLine
  line <- getLine
  let xs = fmap read $ words line :: [Int]
  print $ f xs


import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- getLine
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import Data.List (group, sort)
import Control.Arrow (first, second)

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

solve :: String -> [Int] -> String
solve s a = uncurry (++) $ first reverse $ go True ("", "") (second reverse $ splitAt (l `div` 2) s) [1..l`div`2] as
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go b (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go b (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (c:cs, d:ds) (_:is) []         | b          = go b (c:ps, d:qs) (cs, ds) is []
                                                     | otherwise  = go b (d:ps, c:qs) (cs, ds) is []
        go _ (ps, qs) ([], [d]) _ [] = (ps, d:qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        as = map head $ filter (odd . length) $ group $ sort a
        l = length s

import Data.List (group, sort)
import Control.Arrow (first, second)

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

solve :: String -> [Int] -> String
solve s a = uncurry (++) $ first reverse $ go True ("", "") (second reverse $ splitAt (length s `div` 2) s) [1..] as
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go      b  (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go      b  (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (ccs, dds) _ []                | b          = (reverse ccs ++ ps, reverse dds ++ qs)
                                                     | otherwise  = (reverse dds ++ ps, reverse ccs ++ qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        as = map head $ filter (odd . length) $ group $ sort a

import Data.List (group, sort)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = getContents >>= putStrLn . solve . lines

solve :: [String] -> String
solve [s, _, a] = map (s'`B.index`) js ++ mid ++ map ((s'`B.index`) . ((l - 1) -)) (reverse js)
  where go b (i:is) xxs@(x:xs) | i < x && b = (i - 1) : go b is xxs
                               | i < x      = (l - i) : go b is xxs
                               | b          = (l - i) : go (not b) is xs
                               | otherwise  = (i - 1) : go (not b) is xs
        go b (i:is) [] | b                  = (i - 1) : go b is []
                       | otherwise          = (l - i) : go b is []
        go _ [] _ = []
        js = go True [1..l`div`2] $ map head $ filter (odd . length) $ group $ sort $ map read $ words a
        mid = if even l then "" else [ s' `B.index` (l `div` 2) ]
        l = B.length s'
        s' = B.pack s
solve _ = undefined

import Data.List (group, sort)
import Control.Arrow (first, second)

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

solve :: String -> [Int] -> String
solve s as = uncurry (++) $ first reverse $ go True ("", "") cssdss [1..] bs
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs)
          | i < x && b = go      b  (c:ps, d:qs) (cs, ds) is xxs
          | i < x      = go      b  (d:ps, c:qs) (cs, ds) is xxs
          | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
          | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (ccs, dds) _ _
          | b          = (reverse ccs ++ ps, reverse dds ++ qs)
          | otherwise  = (reverse dds ++ ps, reverse ccs ++ qs)
        bs = map head $ filter (odd . length) $ group $ sort as
        cssdss = second reverse $ splitAt (length s `div` 2) s

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  bs <- B.filter isLower <$> B.getLine
  getLine
  xs <- map readInt.B.words <$> B.getLine
  putStrLn $ solve bs xs

solve :: B.ByteString -> [Int] -> String
solve bs xs = map (B.index bs.f).zip[0..]$ scanl1 (+) $ map (unsafeAt freq) [0..n-1]
   where
     !n = B.length bs
     f (i, x) = if even x then i else n - i - 1

     freq :: UArray Int Int
     !freq = unsafeAccumArray (+) 0 (0,n) $ go xs
      where
        go (x:xs) = (x - 1, 1) : (n - x + 1, -1) : go xs
        go _ = []

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad hiding (foldM, foldM_)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray)
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  cs <- getLine
  getLine
  xs <- map readInt.B.words <$> B.getLine
  putStrLn $ solve cs xs

solve :: String -> [Int] -> String
solve cs xs = zipWith3 bool cs (reverse cs).map even$ scanl1 (+) $ map (unsafeAt diff) [0..n-1]
   where
     !n = length cs
     diff :: UArray Int Int
     !diff = unsafeAccumArray (+) 0 (0, n) $ foldr f [] xs
      where
        f x acc = (x - 1, 1) : (n - x + 1, -1) : acc

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
foldM :: (Monad m) => a -> [b] -> (a -> b -> m a) -> m a
foldM a xs f=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import Data.List
import Control.Monad
import Debug.Trace

solve :: String -> [Int] -> String
solve s as' = (f True 1 s' r' as) ++ ö ++ reverse (f False 1 s' r' as)
    where
        as = concat $ map (\x -> if odd (length x) then [head x] else []) $ group (sort as')
        r = reverse s
        s' = take l s
        r' = take l r
        f _ _ [] _ _ = []
        f b n ss rs [] = if b then ss else rs
        f b n (s:ss) (r:rs) (a:as)
            | n == a = c : f b' (n+1) ss rs as
            | n /= a = c : f b' (n+1) ss rs (a:as)
            where
                b' = if a == n then not b else b
                c = if b' then s else r
        l = length s `div` 2
        ö = if odd (length s) then [head $ drop l s] else []

main = do
    s <- getLine
    getLine
    a <- fmap (fmap read . words) getLine
    putStrLn $ solve s a

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ filter (/= '\r') $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import qualified Data.ByteString.Char8 as B
import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = let (t0, t') = B.splitAt (i - 1) t
                    (t1, t2) = B.splitAt (l - 2 * i + 2) t'
                    in t0 <> B.reverse t1 <> t2
        l = B.length s
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 `B.append` B.reverse t1 `B.append` t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (group, sort)
import qualified Data.ByteString.Char8 as B

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

solve :: String -> [Int] -> String
solve s a = reverse ls ++ rs
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go b (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go b (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (c:cs, d:ds) (_:is) []         | b          = go b (c:ps, d:qs) (cs, ds) is []
                                                     | otherwise  = go b (d:ps, c:qs) (cs, ds) is []
        go _ (ps, qs) ([], [d]) _ [] = (ps, d:qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        (ls, rs) = go True ("", "") (splitAt (l `div` 2) s) [1..l`div`2] as
        as = map head $ filter (odd . length) $ group $ sort a
        l = B.length s'
        s' = B.pack s

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (l - 2 * i + 2) t'
        l = B.length s
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStr . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= putStrLn . solve . B.lines

solve :: [B.ByteString] -> String
solve [s, _, a] = B.unpack $ foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ filter (/= '\r') $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    print s
    print $ length s
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans


main=interact$solve.map read.words
solve (n:x)=if check $ map f x then "Yes" else "No"
        where g b a| a`mod`b==0 = g b $ a`div`b
                   | otherwise  = a
              f = g 3 . g 2
              check (a:x) = all (==a) x

main = interact $ solve . map read . words
solve (_:xs) = if allEqual . map f $ xs then "Yes" else "No"
	where
		f x
			| x `mod` 2 == 0	= f (x `div` 2)
			| x `mod` 3 == 0	= f (x `div` 3)
			| otherwise			= x
		allEqual (x:xs)			= and . map (== x) $ xs

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integer -> Integer -> Integer
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integral a => a -> a -> a
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve = same . map (divs 2 . divs 3)

divs :: Integral a => a -> a -> a
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

same :: Eq a => [a] -> Bool
same xs = all (==head xs) xs

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

import Data.List
main = interact $ format . group . map (purge . read) . tail . words
purge n | n `mod` 2 == 0 = purge (n `div` 2)
        | n `mod` 3 == 0 = purge (n `div` 3)
        | otherwise = n
format [_] = "Yes"
format _ = "No"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> String
solve a = if all (== x) xs then "Yes" else "No"
    where
    (x:xs) = map ((\i -> i `div` gcd b i) . fromIntegral) a
    b = 2^29 * 3^18 :: Int64

main = do
    [n] <- parse <$> B.getLine
    a <- parse <$> B.getLine
    putStrLn $ solve a

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor
import Data.Int (Int64)

getNums64 :: B.ByteString -> [Int64]
getNums64 =
	let
		f1 = (map (fromInteger . (fst.fromJust) . B.readInteger))
		f2 = (B.split ' ')
	in f1.f2
getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine
readInts64 :: IO [Int64]
readInts64 = getNums64 <$> B.getLine

check 1 = True
check a = if a `mod` 2 == 0 then check $ a `div` 2 else if a `mod` 3 == 0 then check $ a `div` 3 else False

main = do
	n <- readInts
	a <- readInts
	let g = foldl gcd 0 a
	let b = map (\x -> x `div` g) a
	let c = all check b
	putStrLn $ if c then "Yes" else "No"

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

red x 	| mod x 2 ==0 = red (div x 2)
	| mod x 3 ==0 = red (div x 3)
	| otherwise = x

process s= all (==th) t
	 where t = map red s
	       th = head t

main= do
	n<-read <$> getLine::IO Int
	s<- map read .words <$> getLine ::IO [Int]
	putStrLn $ if process s then "YES" else "NO"

main = do
  xs <- getContents
  (putStrLn . print_ . solve) (map read (words ((lines xs)!!1)))

print_ True = "Yes"
print_ False = "No"

solve :: [Int] -> Bool
solve = all_equal . map norm
gen_norm k x | x `mod` k == 0 = gen_norm k (x `div` k)
             | otherwise      = x
norm = gen_norm 2 . gen_norm 3
all_equal (x:xs) = all (\y -> x == y) xs
all_equal [] = undefined

import System.IO
import Data.Int
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int64)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = foldl' gcd 0 arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (`check2` max) arr

ifYes True = "Yes"
ifYes False = "No"

import Control.Monad
import Data.List

red2 :: Int -> Int
red2 x
  | even x    = red2 (div x 2)
  | otherwise = x

red3 :: Int -> Int
red3 x
  | mod x 3 == 0 = red3 (div x 3)
  | otherwise    = x

canEqual :: [Int] -> Bool
canEqual a =
  let b = map (red3 . red2) a
  in all (== (head b)) $ tail b

myShow :: Bool -> String
myShow True = "Yes"
myShow False = "No"

main :: IO()
main = do
  n <- readLn
  a <- liftM (map read . take n . words) getLine
  putStr . myShow $ canEqual a

main = interact $ show'.and.(\x -> map (== head x) (tail x)).map red.tail.map read.words

red :: Int -> Int
red x
    |mod x 2 == 0 = red $ x `div` 2
    |mod x 3 == 0 = red $ x `div` 3
    |otherwise = x

show' :: Bool -> [Char]
show' True = "Yes"
show' False = "No"

main = interact $ show' . eql . map red . tail . map read . words

red :: Integer -> Integer
red x
    |mod x 2 == 0 = red $ x `div` 2
    |mod x 3 == 0 = red $ x `div` 3
    |otherwise = x

eql :: Eq a => [a] -> Bool
eql x = and $ map (== head x) (tail x)

show' :: Bool -> [Char]
show' True = "Yes"
show' False = "No"

module Main where
import Control.Applicative

divide d = go where
  go n | rem n d == 0 = go $ quot n d
  go n = n

main = do
  getLine
  a : as <- map (divide 2 . divide 3 . read) <$> words <$> getLine
  putStrLn $ if all (== a) as then "Yes" else "No"

baseQ = (base 2) . (base 3)
base n stake
  | stake `mod` n == 0 = base n (stake `div` n)
  | otherwise          = stake

ans (x : t@(y : xs))
  | x /= y    = "No"
  | otherwise = ans t
ans _ = "Yes"

main = do
  tmp <- getLine
  list <- getLine
  let stakes = map read $ words list :: [Int]
  let bases = map baseQ stakes
  putStrLn $ ans bases

main=interact$solve.map read.words
solve (n:x)=if check $ map f x then "Yes" else "No"
        where g a b| a`mod`b==0 = g (a`div`b) b
                   | otherwise  = a
              f x = g (g x 2) 3
              check x = minimum x == maximum x

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f2 (n `quot` 2) else n

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns, OverloadedStrings #-}
{-# 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.Ord
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.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  getLine
  xs <- getInts

  let
    ys = map f xs
      where
        f x = until odd (`div` 2) $ until (\x -> x `mod` 3 /= 0) (`div` 3) x
    b = and $ zipWith (==) ys $ tail ys

  putStrLn $ if b then "Yes" else "No"

main :: IO ()
main = do
   n <- read_n
   a <- read_a
   let aa = map simplify a
       rs = if allEqu aa then "Yes" else "No"
   putStrLn rs

read_n :: IO Integer
read_n = do
   s <- getLine
   let n = read s :: Integer in return n

read_a :: IO [Integer]
read_a = do
   s <- getLine
   let a = map (\x -> read x :: Integer) $ words s in return a

simplify :: Integer -> Integer
simplify x
   | x `mod` 2 == 0 = simplify $ x `div` 2
   | x `mod` 3 == 0 = simplify $ x `div` 3
   | otherwise = x

allEqu :: [Integer] -> Bool
allEqu [] = True
allEqu (x:xs) = length (filter (== x) xs) == (length xs)

main = interact $ solve . map read . words
solve (_:xs) = if allEqual . map f $ xs then "Yes" else "No"
	where
		f x
			| x `mod` 2 == 0	= f (x `div` 2)
			| x `mod` 3 == 0	= f (x `div` 3)
			| otherwise			= x
		allEqual []			= True
		allEqual (x:[])		= True
		allEqual (x1:x2:xs)	= x1 == x2 && allEqual (x2:xs)

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (d:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f3 (n `quot` 2) else n

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    print (x:xs)
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f2 (n `quot` 2) else n

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (x*y:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (b:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (d*c1*c2:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (lcm a b:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Integer) . words) getLine
    putStrLn $ solve a

solve :: [Integer] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (lcm a b:ls) else "NO"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integer -> Integer -> Integer
divs n m | m `mod` n == 0 = m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Int] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Int -> Int -> Int
divs n m | m `mod` n == 0 = m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> String
solve a = if all (== x) xs then "Yes" else "No"
    where (x:xs) = map (\i -> i `div` gcd 6 i) a

main = do
    [n] <- parse <$> B.getLine
    a <- parse <$> B.getLine
    putStrLn $ solve a

import System.IO
import Data.Int
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int64)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = foldl' gcd 0 arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) arr

ifYes True = "Yes"
ifYes False = "No"

import System.IO
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = maximum arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) arr

ifYes True = "Yes"
ifYes False = "No"

import System.IO
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let sorted = reverse (sort arr)
        max = head sorted
        check x
            | x == 1 = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) sorted

ifYes True = "Yes"
ifYes False = "No"


{-# LANGUAGE BangPatterns #-}

module Main where
import Control.Applicative
--import Data.List

-- | A strictly accumulating version of 'scanl'
{-# NOINLINE [1] scanl' #-}
scanl'           :: (b -> a -> b) -> b -> [a] -> [b]
-- This peculiar form is needed to prevent scanl' from being rewritten
-- in its own right hand side.
scanl' = scanlGo'
  where
    scanlGo'           :: (b -> a -> b) -> b -> [a] -> [b]
    scanlGo' f !q ls    = q : (case ls of
                            []   -> []
                            x:xs -> scanlGo' f (f q x) xs)

walk p x = min x $ p + 1
grows = tail . scanl' walk 0
heels xs = zipWith min (grows xs) $ reverse $ grows $ reverse xs
destroy = maximum . heels

main = do
  getLine
  hs <- map read <$> words <$> getLine
  print $ destroy hs

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor

getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine

main::IO ()
main = do
	_ <- readInts
	h <- readInts
	let fn a b = min (a+1) b
	let lft = tail $ scanl fn 0 h
	let rt = reverse $ tail $ scanl fn 0 $ reverse h
	let ans = (foldl max 0 $ zipWith min lft rt)::Int
	print ans

module Main where

import Data.Functor

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Int]
getInts = map read . words <$> getLine

foldmap f v [] = []
foldmap f v (x:xs) = res : foldmap f res xs where
    res = f v x

main :: IO ()
main = do
    n <- getInt
    ns <- getInts
    let left = foldmap (\x y -> min (x+1) y) 0 ns
    let right = reverse $ foldmap (\x y -> min (x+1) y) 0 $ reverse ns
    print $ foldr max 0 (zipWith min left right)

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> Int
solve = maximum . scanr go 0 . scanl (flip go) 0
    where go i = min i . succ

main = B.getLine >> solve . parse <$> B.getLine >>= print

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> Int
solve = maximum . scanr go 0 . scanl (flip go) 0
    where go i = min i . succ

main = do
    B.getLine
    solve . parse <$> B.getLine >>= print

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor
import Data.Int (Int64)

getNums64 :: B.ByteString -> [Int64]
getNums64 =
	let
		f1 = (map (fromInteger . (fst.fromJust) . B.readInteger))
		f2 = (B.split ' ')
	in f1.f2
getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine
readInts64 :: IO [Int64]
readInts64 = getNums64 <$> B.getLine

foldmap fn v [] = []
foldmap fn v (x:xs) = let v2 = fn v x in (v2 `seq` v2) : foldmap fn v2 xs

main = do
	n <- readInts
	h <- readInts
	let fn a b = min (a+1) b
	let lft = foldmap fn 0 h
	let rt = reverse $ foldmap fn 0 $ reverse h
	let ans = foldl max 0 $ map (\(a,b) -> min a b) $ zip lft rt
	print ans

import Data.List
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let p1 = pass1 (zip a [1..n]) 0
        p2 = pass2 (reverse (zip a [1..n])) (reverse p1) (n+1)
    print . maximum $ p2

pass1 [] _ = []
pass1 ((e,i):as) x = let w = min x (e-i) in (i+w):pass1 as w

pass2 [] [] _ = []
pass2 ((e,i):xs) (y:ys) x =
    let w = min x (e+i)
    in (min (w-i) y : pass2 xs ys w)

{-# LANGUAGE BangPatterns #-}

module Main where
import Control.Applicative

scanl' f = go where
  go q [] = [q]
  go q (x: xs) = q : go (f q x) xs

walk p x = min x $ p + 1
grows = tail . scanl' walk 0
heels xs = zipWith min (grows xs) $ reverse $ grows $ reverse xs
destroy = maximum . heels

main = do
  getLine
  hs <- map read <$> words <$> getLine
  print $ destroy hs

import Data.List
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let p1 = pass1 (zip a [1..n]) 0
        p2 = pass2 (reverse (zip a [1..n])) (reverse p1) (n+1)
    print . maximum $ p2

pass1 [] _ = []
pass1 (a:as) x = ((snd a) + min x ((fst a)-(snd a))) : pass1 as (min x ((fst a)-(snd a)))

pass2 [] [] _ = []
pass2 ((e,i):xs) (y:ys) x =
    let w = min x (e+i)
    in (min w y : pass2 xs ys w)


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

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type Pos = (Int, Int)

add (x1, y1) (x2, y2) = (x1+x2, y1+y2)

process :: [Pos] -> [Pos] -> Pos
process obelisks clues = minimum obelisks `add` maximum clues

main = do
    n <- getInt
    obelisks <- force <$> replicateM n (readPoint <$> getInts)
    clues <- force <$> replicateM n (readPoint <$> getInts)
    putStrLn $ showPoint $ process obelisks clues

readPoint (x:y:[]) = (x, y)
showPoint (x, y) = show x ++ " " ++ show y

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}

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

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- unfoldr (\bs0 -> do (x,bs1) <- BSL.readInt $ BSL.dropWhile (<'!') bs0
                            (y,bs2) <- BSL.readInt $ BSL.dropWhile (<'!') bs1
                            return ((x,y),bs2)) <$> BSL.getContents
  let (xys, ls1) = splitAt n ls
      abs = take n ls1
      (x,y) = minimum xys
      (a,b) = maximum abs
  putStrLn $ shows (a+x) $ ' ' : show (y+b)

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve obel clue = (x,y)
    where x = maximum (map fst obel) + minimum (map fst clue)
          y = maximum (map snd obel) + minimum (map snd clue)

tuple [x,y] = (x,y)

main = do
    [n] <- getInts
    obel <- forM [1..n] (\_-> getInts)
    clue <- forM [1..n] (\_-> getInts)
    let (x, y) = solve (map tuple obel) (map tuple clue)
    putStrLn $ show x ++ " " ++ show y


import Data.List

digits _    0 _   = []
digits base n num = num `mod` base : digits base (n - 1) (num `div` base)

main = do
    contents <- getContents
    let [n, k, d] = map read $ words contents
    let ans = transpose $ map (map (+ 1) . digits k d) [1..n]
    putStr (if (k ^ d) < n  then "-1" else unlines $ map (unwords . map show) ans)

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > (k^d) = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List (transpose)

main = interact $ f . map read . words

f :: [Integer] -> String
f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' (fromIntegral n) b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

-- Codeforces 459C

import Data.List

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

solve :: [Int] -> String
solve [n, k, d] = if check $ map toInteger [n, k, k, d]
    then "-1"
    else intercalate "\n" $ map (intercalate " " . map show) $ transpose $ scanl (\acc _ -> inc acc) (replicate d 1) [1..n-1] where inc = tail . map snd . scanl (\(cin, _) x -> if x+cin > k then (1, x+cin-k) else (0, x+cin)) (1, 0)

check :: [Integer] -> Bool
check [n, _, _, 0] = True
check [n, acc, k, d] = if acc >= n then False else check [n, (k*acc), k, (d-1)]

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List (transpose)

main = interact $ f . map read . words

f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' n b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k) : (kd k (d-1) (n`div`k))


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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x `mod` 2 /= 0 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = readInt >>= flip replicateM solve >>= mapM_ putStrLn

solve = do
	s <- getLine
	let
		candidates = map fst $ filter ( odd . snd ) $ map ( head &&& length ) $ group s
	return $ map head $ group $ sort candidates

import           Data.List

(|>) = flip (.)

main :: IO ()
main = interact $
  lines
  |> tail
  |> map solve
  |> unlines

solve :: String -> String
solve = group
  |> filter (length |> odd)
  |> map head
  |> nub
  |> sort

import Data.List

f =  sort . nub . map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

import Data.List

f =  map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

import Data.List

f =  nub . reverse . map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else S.delete (head x) s) S.empty (group str)
    putStrLn $ S.toList res

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

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

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x /= 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res


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

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, k] <- map read . words <$> getLine :: IO [Int]
    let x = [0..n-1]
    let y = concat [map (\a -> (a + z) `mod` n) x | z <- x]
    let z = concat $ replicate n x
    let grid = generateG n $ take k $ zip y z
    let minF = score grid + score (transpose grid)
    print minF
    putStrLn $ unlines grid
  where
    score :: [String] -> Int
    score g = (maximum cnt - minimum cnt) ^ 2
      where
        cnt = map (length . filter (=='1')) g
    generateG :: Int -> [(Int, Int)] -> [String]
    generateG n l = [map (f . (,) y) x | y <- x]
      where
        x = [0..n-1]
        m = Set.fromList l
        f :: (Int, Int) -> Char
        f a | Set.member a m = '1'
            | otherwise = '0'

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}
import Control.Monad
import Data.List

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  let a = solve n k
  print $ f a
  putStr $ unlines $ map (>>= show) a

f a = (maximum r - minimum r) ^ 2 + (maximum c - minimum c) ^ 2
  where
    r = map sum a
    c = map sum $ transpose a

solve n k = skew n $ makeRows n $ replicate k 1 ++ replicate (n * n - k) 0

makeRows n [] = []
makeRows n as = take n as : makeRows n (drop n as)

skew n = map (take n) . zipWith drop [0 ..] . map cycle . transpose