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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Array.Base
import Data.Array.ST
import Data.Bits

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

main :: IO ()
main = do
  n <- readLn
  arr <- radixSort n.map readInt.B.words <$> B.getLine
  print $ solve n arr

solve :: Int -> UArray Int Int -> Int64
solve n arr0 = sum . map (unsafeAt arr.(n-)).takeWhile (<=n) $ iterate (4*) 1
   where
     !arr = runSTUArray $ do
       a <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int64)
       let go !i !acc = do
             when (i>=0) $ do
               let acc' = (acc+).fromIntegral $ unsafeAt arr0 i
               unsafeWrite a i acc'
               go (i-1) acc'
       go (n-1) 0
       return a

mask :: Int
mask = 0xffff

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`unsafeShiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

{-# OPTIONS_GHC -O2 #-}

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

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

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0 >>> negate

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

solve :: [Int] -> Integer
solve [-1,x] = -fromIntegral x
solve (n:l) = - sum [sum $ take (4^i) l'| i <- takeWhile (\i -> 4^i < -n)[0..]] - x
    where
        l' = map fromIntegral $ sort $ removeSome n l
        x  = sum $ map fromIntegral l

removeSome n l = if length l1*4 >= n then l1 else l
    where
        a = minimum l
        b = maximum l
        c = (a+b)`div`2
        l1 = filter (<= c) l

-- For benchmark. Based on not my solution but cojna's

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Array.Base
import Data.Array.ST
import Data.Bits
import Data.Ix

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

main :: IO ()
main = do
  n <- readLn
  arr <- radixSort n.map readInt.B.words <$> B.getLine
  print $ solve n arr

solve :: Int -> UArray Int Int -> Int64
solve n arr0 = sum . map (unsafeAt arr.(n-)).takeWhile (<=n) $ iterate (4*) 1
   where
     !arr = runSTUArray $ do
       a <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int64)
       let go !i !acc = do
             when (i>=0) $ do
               let acc' = (acc+).fromIntegral $ unsafeAt arr0 i
               unsafeWrite a i acc'
               go (i-1) acc'
       go (n-1) 0
       return a

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

rep :: Monad m => Int -> (Int -> m ()) -> m ()
rep !n f=go 0 where go !i=when(i<n)$f i>>go(i+1)
{-# INLINE rep #-}

rev :: Monad m => Int -> (Int -> m ()) -> m ()
rev !n f= go(n-1)where go !i=when(i>=0)$f i>>go(i-1)
{-# INLINE rev #-}

mask :: Int
mask = 0xffff
{-# INLINE mask #-}

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr   <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp   <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0     :: ST s (STUArray s Int Int)

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count (xi.&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  rep (mask+1) $ \i-> do
    unsafeWrite count i 0

  rep n $ \i-> do
    xi <- unsafeRead arr i
    unsafeModify count ((xi`unsafeShiftR`16).&.mask) (1+)
  rep mask $ \i-> do
    x <- unsafeRead count i
    unsafeModify count (i+1) (x+)
  rev n $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.List

main :: IO ()
main = print . solve . map stoi . B.words =<< B.getContents

stoi :: B.ByteString -> Int64
stoi = toEnum . negate . maybe 0 fst . B.readInt

solve :: [Int64] -> Int64
solve (_ : a : as) = negate $ sum $ scanl (+) a $ slice [0..] as
  where
  slice _ [] = []
  slice (i : is) xs = sum ys : slice is zs
    where
    (ys, zs) = splitAt (3 * 4 ^ i) xs

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

main :: IO ()
main = print . solve . map (maybe 0 fst . B.readInt) . B.words =<< B.getContents

solve :: [Int] -> Int
solve (_ : as') = f 0 a as
  where
  (a : as) = map negate $ sort $ map negate as'
  f _ s [] = s
  f n s xs = seq s $ s + f (n + 1) (s + sum ys) zs
    where
    (ys, zs) = splitAt (3 * 4 ^ n) xs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import qualified Data.ByteString.Char8 as B
import Data.Function
import Data.Int
import Data.List

main :: IO ()
main = print . solve . map stoi . B.words =<< B.getContents

stoi :: B.ByteString -> Int
stoi = maybe 0 fst . B.readInt

solve :: [Int] -> Int64
solve (n : as') = sum $ scanl (+) (toEnum a) $ slice (n - 1) 3 as
  where
  (a : as) = sortBy (compare `on` negate) as'

slice :: Int -> Int -> [Int] -> [Int64]
slice s i xs
  | s <= i = [sum' xs]
  | otherwise = sum' ys : slice (s - i) (i * 4) zs
  where
  sum' = foldl' (\x y -> x + toEnum y) 0
  (ys, zs) = splitAt i xs

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

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Maybe
import Debug.Trace

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

type Point = (Int,Int)
type Memo = A.Array Point Int
data Tree = Node Tree Tree Tree Tree
          | Leaf Int
          deriving(Show)

solve :: [Int] -> Integer
solve (n:l) = fst $ beauty tree
    where
        s = round $ sqrt $ fromIntegral n
        memo = A.listArray ((0,0),(s-1,s-1)) l
        tree = makeTree memo (0,0) (s,s)

makeTree :: Memo -> Point -> Point -> Tree
makeTree memo = sub
    where
        sub (x1,y1) (x2,y2)
            | x2 - x1 == 1 = Leaf (memo A.! (x1,y1))
            | otherwise =  Node t1 t2 t3 t4
            where
                mx = (x1+x2) `div`2
                my = (y1+y2) `div`2
                t1 = sub (x1,y1) (mx,my)
                t2 = sub (mx,y1) (x2,my)
                t3 = sub (x1,my) (mx,y2)
                t4 = sub (mx,my) (x2,y2)

beauty :: Tree -> (Integer,Int)
beauty (Leaf i) = (fromIntegral i,i)
beauty (Node t1 t2 t3 t4) = f $ sum *** maximum $ unzip $ map beauty [t1,t2,t3,t4]
    where
        f (x,y) = (fromIntegral y+x,y)

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

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

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0 >>> negate

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

solve :: [Int] -> Integer
solve (n:l) = - sum [sum $ take (4^i) l'| i <- takeWhile (\i -> 4^i <= -n)[0..]] - x
    where
        l' = map fromIntegral $ sort $ removeSome n l
        x  = sum $ map fromIntegral l

removeSome n l = if length l1*4 >= n then l1 else l
    where
        a = minimum l
        b = maximum l
        c = (a+b)`div`4
        l1 = filter (<= c) l

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

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Maybe

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

type Point = (Int,Int)
type Memo = A.Array Point Int
data Tree = Node Tree Tree Tree Tree
          | Leaf Int
          deriving(Show)

solve :: [Int] -> Integer
solve (n:l) = fst $ beauty tree
    where
        s = floor $ sqrt $ fromIntegral n
        memo = A.listArray ((0,0),(s-1,s-1)) l
        tree = makeTree memo (0,0) (s-1,s-1)

makeTree :: Memo -> Point -> Point -> Tree
makeTree memo = sub
    where
        sub (x1,y1) (x2,y2)
            | x1 == x2  = Leaf (memo A.! (x1,y1))
            | otherwise = Node t1 t2 t3 t4
            where
                mx = (x1+x2) `div`2
                my = (y1+y2) `div`2
                t1 = sub (x1,y1) (mx,my)
                t2 = sub (mx+1,y1) (x2,my)
                t3 = sub (x1,my+1) (mx,y2)
                t4 = sub (mx+1,my+1) (x2,y2)

beauty :: Tree -> (Integer,Int)
beauty (Leaf i) = (fromIntegral i,i)
beauty (Node t1 t2 t3 t4) = f $ sum *** maximum $ unzip $ map beauty [t1,t2,t3,t4]
    where
        f (x,y) = (fromIntegral y+x,y)

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

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Maybe

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

type Point = (Int,Int)
type Memo = A.Array Point Int
data Tree = Node Tree Tree Tree Tree
          | Leaf Int
          deriving(Show)

solve :: [Int] -> Integer
solve (n:l) = fst $ beauty tree
    where
        s = floor $ sqrt $ fromIntegral n
        memo = A.listArray ((0,0),(s-1,s-1)) l
        tree = makeTree memo (0,0) (s-1,s-1)

makeTree :: Memo -> Point -> Point -> Tree
makeTree memo = sub
    where
        sub (x1,y1) (x2,y2)
            | x1 == x2  = Leaf (memo A.! (x1,y1))
            | otherwise = Node t1 t2 t3 t4
            where
                mx = (x1+x2+1) `div`2
                my = (y1+y2+1) `div`2
                t1 = sub (x1,y1) (mx-1,my-1)
                t2 = sub (mx,y1) (x2,my-1)
                t3 = sub (x1,my) (mx-1,y2)
                t4 = sub (mx,my) (x2,y2)

beauty :: Tree -> (Integer,Int)
beauty (Leaf i) = (fromIntegral i,i)
beauty (Node t1 t2 t3 t4) = f $ sum *** maximum $ unzip $ map beauty [t1,t2,t3,t4]
    where
        f (x,y) = (fromIntegral y+x,y)

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

import Control.Monad.ST
import Data.Array.ST
import Data.Array
import Debug.Trace

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

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0 >>> negate

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

solve :: [Int] -> Integer
solve [-1,x] = -fromIntegral x
solve (n:l) = - sum [sum $ take (4^i) l'| i <- takeWhile (\i -> 4^i < -n)[0..]] - x
    where
        l' = map fromIntegral $ qsort $l
        x  = sum $ map fromIntegral l

removeSome n l = if length l1*4 >= n then l1 else l
    where
        a = minimum l
        b = maximum l
        c = (a+b)`div`2
        l1 = filter (<= c) l

qsort :: [Int] -> [Int]
qsort l = elems $ runSTArray $ do
    ary <- newListArray (0,n-1) l :: ST s (STArray s Int Int)
    qsortST (0,n-1) ary
    return ary
    where
        n = length l

median3 x y z | x <= y && y <= z = y
              | x <= y           = max x z
              | z <= y           = y
              | otherwise        = min x z

qsortST :: (Int,Int) -> (STArray s Int Int) -> ST s ()
qsortST (i,j) ary
    | j == i = return ()
    | otherwise = do
    s <- readArray ary i
    e <- readArray ary j
    m <- readArray ary ((i+j)`div`2)
    let pivot = median3 s e m
    k <- partitionST (i,j) ary pivot (s,e)
    qsortST (i,k) ary
    qsortST (k+1,j) ary

partitionST (i,j) ary p (a,b)
    | j - i < 1 = return i
    | a >= p && b <= p = do
        writeArray ary i b
        writeArray ary j a
        a' <- readArray ary (i+1)
        b' <- readArray ary (j-1)
        partitionST (i+1,j-1) ary p (a',b')
    | a >= p = do
        b' <- readArray ary (j-1)
        partitionST (i,j-1) ary p (a,b')
    | otherwise = do
        a' <- readArray ary (i+1)
        partitionST (i+1,j) ary p (a',b)

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

import qualified Data.ByteString.Char8 as B
import qualified Data.Array as A
import Data.Maybe

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

type Point = (Int,Int)
type Memo = A.Array Point Int
data Tree = Node Tree Tree Tree Tree
          | Leaf Int
          deriving(Show)

solve :: [Int] -> Integer
solve (n:l) = fst $ beauty tree
    where
        s = round $ sqrt $ fromIntegral n
        memo = A.listArray ((0,0),(s-1,s-1)) l
        tree = makeTree memo (0,0) (s-1,s-1)

makeTree :: Memo -> Point -> Point -> Tree
makeTree memo = sub
    where
        sub (x1,y1) (x2,y2)
            | x1 == x2  = Leaf (memo A.! (x1,y1))
            | otherwise = Node t1 t2 t3 t4
            where
                mx = (x1+x2+1) `div`2
                my = (y1+y2+1) `div`2
                t1 = sub (x1,y1) (mx-1,my-1)
                t2 = sub (mx,y1) (x2,my-1)
                t3 = sub (x1,my) (mx-1,y2)
                t4 = sub (mx,my) (x2,y2)

beauty :: Tree -> (Integer,Int)
beauty (Leaf i) = (fromIntegral i,i)
beauty (Node t1 t2 t3 t4) = f $ sum *** maximum $ unzip $ map beauty [t1,t2,t3,t4]
    where
        f (x,y) = (fromIntegral y+x,y)

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

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

stoi :: B.ByteString -> Int
stoi = B.readInt >>> fmap fst >>> fromMaybe 0 >>> negate

main = do
    l <- map stoi . B.words <$> B.getContents
    print $ solve l

solve :: [Int] -> Integer
solve [-1,x] = -fromIntegral x
solve (n:l) = - sum [sum $ take (4^i) l'| i <- takeWhile (\i -> 4^i <= -n)[0..]] - x
    where
        l' = map fromIntegral $ sort $ removeSome n l
        x  = sum $ map fromIntegral l

removeSome n l = if length l1*4 >= n then l1 else l
    where
        a = minimum l
        b = maximum l
        c = (a+b)`div`4
        l1 = filter (<= c) l

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Array.Base
import Data.Array.ST
import Data.Bits

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

main :: IO ()
main = do
  n <- readLn
  arr <- radixSort n.map readInt.B.words <$> B.getLine
  print $ solve n arr

solve :: Int -> UArray Int Int -> Int64
solve n arr0 = sum . map (unsafeAt arr.subtract 1).takeWhile (<=n) $ iterate (4*) 1
   where
     !arr = runSTUArray $ do
       a <- newArray (0,n-1) 0 :: ST s (STUArray s Int Int64)
       let go !i !acc = do
             when (i>=0) $ do
               let acc' = (acc+).fromIntegral $ unsafeAt arr0 i
               unsafeWrite a i acc'
               go (i-1) acc'
       go (n-1) 0
       return a

mask :: Int
mask = 0xffff

radixSort :: Int -> [Int] -> UArray Int Int
radixSort n xs = runSTUArray $ do
  arr <- newListArray (0,n-1) xs :: ST s (STUArray s Int Int)
  tmp <- newArray (0,n-1) 0      :: ST s (STUArray s Int Int)
  count <- newArray (0,mask) 0   :: ST s (STUArray s Int Int)

  forM_ xs $ \x-> do
    let !mx = x.&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead arr i
    let !mi = xi.&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite tmp j xi

  forM_ [0..mask] $ \i-> do
    unsafeWrite count i 0

  forM_ xs $ \x-> do
    let !mx = (x`unsafeShiftR`16).&.mask
    unsafeRead count mx >>= unsafeWrite count mx.(1+)
  forM_ [1..mask] $ \i-> do
    x <- unsafeRead count $ i-1
    unsafeRead count i >>= unsafeWrite count i.(x+)
  forM_ [n-1,n-2..0] $ \i-> do
    xi <- unsafeRead tmp i
    let !mi = (xi`unsafeShiftR`16).&.mask
    j <- subtract 1 <$> unsafeRead count mi
    unsafeWrite count mi j
    unsafeWrite arr j xi

  return arr


import Control.Arrow

main = interact $
  lines >>> map (words >>> map read) >>>
  solve >>> (\ans -> [show $ length ans, ans]) >>> unlines

solve :: [[Int]] -> String
solve ([n,m,k]:_) = take (2 * n * m) $
  (take (n - 1) $ repeat 'U') ++
  (take (m - 1) $ repeat 'L') ++
  (foldr (++) "" $ take n $ repeat
    (take (m - 1) (repeat 'R') ++ "D" ++
    take (m - 1) (repeat 'L') ++ "D"))

import Control.Arrow ((>>>))

main :: IO ()
main =
  interact $
    lines >>> map (words >>> map read)
      >>> solve
      >>> (\ans -> [show (length ans), ans])
      >>> unlines

solve :: [[Int]] -> String
solve ([n, m, _] : _) =
  take (2 * n * m) $
    replicate (n - 1) 'U' ++ replicate (m - 1) 'L'
      ++ concat
        ( replicate
            n
            (replicate (m - 1) 'R' ++ "D" ++ replicate (m - 1) 'L' ++ "D")
        )

import Control.Monad
main :: IO ()
main = do
  [n,m,k] <- (map read.words) <$> getLine
  replicateM_ (2*k) getLine
  print (n*m+n+m-3)
  putStrLn $ solve n m

solve :: Int -> Int -> String
solve m n = replicate (n-1) 'L' ++ replicate (m-1) 'D' ++ take (n*m-1) frst
  where
    frst = replicate (n-1) 'R' ++ "U" ++ replicate (n-1) 'L' ++ "U" ++ frst
--n lr m ud

import Control.Monad
main :: IO ()
main = do
  [n,m,k] <- (map read.words) <$> getLine
  replicateM_ (2*k) getLine
  putStrLn $ solve n m

solve :: Int -> Int -> String
solve n m = replicate (n-1) 'L' ++ replicate (m-1) 'D' ++ take (n*m-1) frst
  where
    frst = replicate (n-1) 'R' ++ "U" ++ replicate (n-1) 'L' ++ "U" ++ frst
--n lr m ud

import Control.Monad
main :: IO ()
main = do
  [n,m,k] <- (map read.words) <$> getLine
  replicateM_ (2*k) getLine
  print (n*m+n+m-3)
  putStrLn $ solve n m

solve :: Int -> Int -> String
solve n m = replicate (n-1) 'L' ++ replicate (m-1) 'D' ++ take (n*m-1) frst
  where
    frst = replicate (n-1) 'R' ++ "U" ++ replicate (n-1) 'L' ++ "U" ++ frst
--n lr m ud


import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Control.Monad (mapM_)
import Data.Int (Int64)

type Block = (Int, Int)   -- (start, length)

cY = 'Y'
cN = 'N'

row :: Int -> Block -> Block -> ByteString
row end (pstart, plen) (nstart, nlen) =
  BS.pack $ col1 ++ col2 ++ pre ++ blk1 ++ mid ++ blk2 ++ post
  where
    col1 = if plen == 0 then [cY] else [cN]
    col2 = if nlen == 0 then [cY] else [cN]
    pend = pstart+plen
    nend = nstart+nlen
    pre  = replicate (pstart-3)    cN
    blk1 = replicate plen          cY
    mid  = replicate (nstart-pend) cN
    blk2 = replicate nlen          cY
    post = replicate (end-nend)    cN

triples :: [a] -> [(a,a,a)]
triples [] = []
triples [_,_] = []
triples xs@(a:b:c:_) =  (a,b,c) : triples (tail xs)

rows :: Int -> [ Block ] -> [ByteString]
rows end blks =
    [ r' | (a,(bstart,blen),c) <- blks', let r = row end a c, r' <- replicate blen r ]
  where blks' = triples $ [(3,0)] ++ blks ++ [(end,0)]

-- return a string with Ys in the positions indicated and N's elsewhere
pattern :: Int -> [Block] -> ByteString
pattern end blks = BS.pack $ go 1 blks
  where
    go k [] = replicate (end-k) cN
    go k ((start,len):rest) = replicate (start-k) cN ++ replicate len cY ++ go (start+len) rest

row1 :: Int -> [ [Block] ] -> ByteString
row1 end blks = pattern end (map head blks)

row2 :: Int -> [ [Block] ] -> ByteString
row2 end blks = pattern end (map last blks)

test1 = do let blks = [(3,3),(6,2)]
           mapM_ BS.putStrLn $ [row1 8 [blks], row2 8 [blks]] ++ rows 8 blks

assign' :: Int -> [Int] -> (Int,[Block])
assign' k [] = (k,[])
assign' k xs = (m, blks)
  where
    blks = go k xs
    m = let (k,a) = last blks in a+k
    go k [] = []
    go k (a:as) = (k,a) : go (k+a) as

-- assume all lists have the same length
assign :: [[Int]] -> (Int, [[Block]])
assign [] = (3, [])
assign xs = (m,blkss)
  where
    blkss = go 3 xs
    m = let (k,a) = (last (last blkss))
        in a+k
    go k []     = []
    go k (x:xs) = let (k',bs) = assign' k x
                  in bs : go k' xs

-- | make all the lengths the same by extending short lists with 1
normalize :: [[Int]] -> [[Int]]
normalize xss =
  let m = maximum (map length xss)
  in map (\xs -> replicate (m - length xs) 1 ++ xs) xss

graph :: Int -> [[Block]] -> [ByteString]
graph end blkss =
  [row1 end blkss, row2 end blkss] ++ concatMap (rows end) blkss

bAdd :: [[Int]] -> [[Int]] -> [[Int]]
bAdd as bs = as ++ bs

bMul :: Int -> [[Int]] -> [[Int]]
bMul n bss = map (n:) bss

toInts :: Int -> Int64 -> [[Int]]
toInts base 0 = []
toInts base n =
  case n `divMod` (fromIntegral base) of
    (q,0) -> base `bMul` (toInts base q)
    (q,r) -> (base `bMul` (toInts base q)) `bAdd` [[fromIntegral r]]

nodeCount :: [[Int]] -> Int
nodeCount = sum . concat

toBlocks :: Int -> Int64 -> (Int,[[Block]])
toBlocks base = assign . normalize . toInts base

solve :: Int -> Int64 -> (Int,[ByteString])
solve base n =
  let (end,blkss) = toBlocks base n
  in (end, graph end blkss)

main = do
  n <- read `fmap` getLine
  let (end,lines) = solve 4 n
  print (end-1)
  mapM_ BS.putStrLn lines

import qualified Data.IntMap as IM
import Data.List (foldl')
import qualified Data.IntSet as IS

decomp :: Integer -> [Bool]
decomp x = decomp' x []
  where
    decomp' 0 l = l
    decomp' k l
      | k `mod` 2 == 1 = decomp' (k `div` 2) (True:l)
      | otherwise = decomp' (k `div` 2) (False:l)

main :: IO ()
main = do
  i <- fmap read getLine
  let bits = decomp i
  --print $ rush bits
  putStr $ pp $ rush bits

pp :: Graph -> String
pp (g,m) = unlines $ show m : pg
  where pg = foldr (\i l -> let Just es = IM.lookup i g
                            in  map (\j -> if IS.member j es then 'Y' else 'N') [1..m] : l) [] [1..m]

type Graph = (IM.IntMap IS.IntSet, Int)

emptyGraph :: Graph
emptyGraph = (IM.fromList [(1, IS.empty), (2, IS.empty)], 2)

insert2 :: (Int, Int) -> Graph -> Graph
insert2 (a,b) (g, m) = (g', m + 2)
  where
    prev = IS.fromList [a, b]
    g' = f (m + 1) $ f (m + 2) g
    f x gg = IM.update (Just . (IS.insert x)) a $ IM.update (Just . (IS.insert x)) b $ IM.insert x prev gg

insert2' :: Graph -> Graph
insert2' g@(_,m) = insert2 (m, m - 1) g

insert2'' ::  (IM.IntMap IS.IntSet, Int) -> Graph
insert2'' g@(_,m) = insert2 (m,m) g

insert1 :: Int -> Graph -> Graph
insert1 a (g, m) = (g', m + 1)
  where
    prev = IS.singleton a
    g' =  IM.update (Just . (IS.insert (m + 1))) a $ IM.insert (m + 1) prev g

insert1' :: Graph -> Graph
insert1' g@(_,m) = insert1 m g

connect :: (Int, Int) -> Graph -> Graph
connect (a,b) (g,m) = (IM.update (Just . (IS.insert a)) b $ IM.update (Just . (IS.insert b)) a g, m)

connect' :: Int -> Graph -> Graph
connect' a g@(_,m) = connect (a,m) g

close1 :: Graph -> Graph
close1 g@(_,m) = connect (2,m) g

close2 :: Graph -> Graph
close2 g@(_,m) = connect (2,m) . connect (2, m - 1) $ g

rush :: [Bool] -> Graph
rush [True] = connect (1,2) emptyGraph
rush l = let len = length l
             z = zip l [0..]
             build 0 = insert2 (1,1) : replicate (len - 2) insert2' ++ [close2]
             build x
              | x == len - 1 =  insert1 1 : replicate (len - 2) insert1' ++ [close1]
              | otherwise = insert1 1 : replicate (x - 1) insert1' ++ [connect' (2*x+3), connect' (2*x+4)]
             apply = foldl' (\g f -> f g)
         in
          foldl' (\g (t,non2) -> if t then apply  g (build non2) else g) emptyGraph z

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Control.Monad (mapM_)
import Data.Int (Int64)

type Block = (Int, Int)   -- (start, length)

cY = 'Y'
cN = 'N'

row :: Int -> Block -> Block -> ByteString
row end (pstart, plen) (nstart, nlen) =
  BS.pack $ col1 ++ col2 ++ pre ++ blk1 ++ mid ++ blk2 ++ post
  where
    col1 = if plen == 0 then [cY] else [cN]
    col2 = if nlen == 0 then [cY] else [cN]
    pend = pstart+plen
    nend = nstart+nlen
    pre  = replicate (pstart-3)    cN
    blk1 = replicate plen          cY
    mid  = replicate (nstart-pend) cN
    blk2 = replicate nlen          cY
    post = replicate (end-nend)    cN

triples :: [a] -> [(a,a,a)]
triples [] = []
triples [_,_] = []
triples xs@(a:b:c:_) =  (a,b,c) : triples (tail xs)

rows :: Int -> [ Block ] -> [ByteString]
rows end blks =
    [ r' | (a,(bstart,blen),c) <- blks', let r = row end a c, r' <- replicate blen r ]
  where blks' = triples $ [(3,0)] ++ blks ++ [(end,0)]

-- return a string with Ys in the positions indicated and N's elsewhere
pattern :: Int -> [Block] -> ByteString
pattern end blks = BS.pack $ go 1 blks
  where
    go k [] = replicate (end-k) cN
    go k ((start,len):rest) = replicate (start-k) cN ++ replicate len cY ++ go (start+len) rest

row1 :: Int -> [ [Block] ] -> ByteString
row1 end blks = pattern end (map head blks)

row2 :: Int -> [ [Block] ] -> ByteString
row2 end blks = pattern end (map last blks)

test1 = do let blks = [(3,3),(6,2)]
           mapM_ BS.putStrLn $ [row1 8 [blks], row2 8 [blks]] ++ rows 8 blks

assign' :: Int -> [Int] -> (Int,[Block])
assign' k [] = (k,[])
assign' k xs = (m, blks)
  where
    blks = go k xs
    m = let (k,a) = last blks in a+k
    go k [] = []
    go k (a:as) = (k,a) : go (k+a) as

-- assume all lists have the same length
assign :: [[Int]] -> (Int, [[Block]])
assign [] = (3, [])
assign xs = (m,blkss)
  where
    blkss = go 3 xs
    m = let (k,a) = (last (last blkss))
        in a+k
    go k []     = []
    go k (x:xs) = let (k',bs) = assign' k x
                  in bs : go k' xs

-- | make all the lengths the same by extending short lists with 1
normalize :: [[Int]] -> [[Int]]
normalize xss =
  let m = maximum (map length xss)
  in map (\xs -> replicate (m - length xs) 1 ++ xs) xss

graph :: Int -> [[Block]] -> [ByteString]
graph end blkss =
  [row1 end blkss, row2 end blkss] ++ concatMap (rows end) blkss

bAdd :: [[Int]] -> [[Int]] -> [[Int]]
bAdd as bs = as ++ bs

bMul :: Int -> [[Int]] -> [[Int]]
bMul n bss = map (n:) bss

toInts :: Int -> Int64 -> [[Int]]
toInts base 0 = []
toInts base n =
  case n `divMod` (fromIntegral base) of
    (q,0) -> base `bMul` (toInts base q)
    (q,r) -> (base `bMul` (toInts base q)) `bAdd` [[fromIntegral r]]

nodeCount :: [[Int]] -> Int
nodeCount = sum . concat

toBlocks :: Int -> Int64 -> (Int,[[Block]])
toBlocks base = assign . normalize . toInts base

solve :: Int64 -> (Int,[ByteString])
solve n =
  let (end,blkss) = toBlocks 2 n
  in (end, graph end blkss)

main = do
  n <- read `fmap` getLine
  let (end,lines) = solve n
  print (end-1)
  mapM_ BS.putStrLn lines

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Control.Monad (mapM_)

type Block = (Int, Int)   -- (start, length)

cY = 'Y'
cN = 'N'

row :: Int -> Block -> Block -> ByteString
row end (pstart, plen) (nstart, nlen) =
  BS.pack $ col1 ++ col2 ++ pre ++ blk1 ++ mid ++ blk2 ++ post
  where
    col1 = if plen == 0 then [cY] else [cN]
    col2 = if nlen == 0 then [cY] else [cN]
    pend = pstart+plen
    nend = nstart+nlen
    pre  = replicate (pstart-3)    cN
    blk1 = replicate plen          cY
    mid  = replicate (nstart-pend) cN
    blk2 = replicate nlen          cY
    post = replicate (end-nend)    cN

triples :: [a] -> [(a,a,a)]
triples [] = []
triples [_,_] = []
triples xs@(a:b:c:_) =  (a,b,c) : triples (tail xs)

rows :: Int -> [ Block ] -> [ByteString]
rows end blks =
    [ r' | (a,(bstart,blen),c) <- blks', let r = row end a c, r' <- replicate blen r ]
  where blks' = triples $ [(3,0)] ++ blks ++ [(end,0)]

-- return a string with Ys in the positions indicated and N's elsewhere
pattern :: Int -> [Block] -> ByteString
pattern end blks = BS.pack $ go 1 blks
  where
    go k [] = replicate (end-k) cN
    go k ((start,len):rest) = replicate (start-k) cN ++ replicate len cY ++ go (start+len) rest

row1 :: Int -> [ [Block] ] -> ByteString
row1 end blks = pattern end (map head blks)

row2 :: Int -> [ [Block] ] -> ByteString
row2 end blks = pattern end (map last blks)

test1 = do let blks = [(3,3),(6,2)]
           mapM_ BS.putStrLn $ [row1 8 [blks], row2 8 [blks]] ++ rows 8 blks

assign' :: Int -> [Int] -> (Int,[Block])
assign' k [] = (k,[])
assign' k xs = (m, blks)
  where
    blks = go k xs
    m = let (k,a) = last blks in a+k
    go k [] = []
    go k (a:as) = (k,a) : go (k+a) as

-- assume all lists have the same length
assign :: [[Int]] -> (Int, [[Block]])
assign [] = (3, [])
assign xs = (m,blkss)
  where
    blkss = go 3 xs
    m = let (k,a) = (last (last blkss))
        in a+k
    go k []     = []
    go k (x:xs) = let (k',bs) = assign' k x
                  in bs : go k' xs

-- | make all the lengths the same by extending short lists with 1
normalize :: [[Int]] -> [[Int]]
normalize xss =
  let m = maximum (map length xss)
  in map (\xs -> replicate (m - length xs) 1 ++ xs) xss

graph :: Int -> [[Block]] -> [ByteString]
graph end blkss =
  [row1 end blkss, row2 end blkss] ++ concatMap (rows end) blkss

bAdd :: [[Int]] -> [[Int]] -> [[Int]]
bAdd as bs = as ++ bs

bMul :: Int -> [[Int]] -> [[Int]]
bMul n bss = map (n:) bss

toInts :: Int -> Int -> [[Int]]
toInts base 0 = []
toInts base n =
  case n `divMod` base of
    (q,0) -> base `bMul` (toInts base q)
    (q,r) -> (base `bMul` (toInts base q)) `bAdd` [[r]]

nodeCount :: [[Int]] -> Int
nodeCount = sum . concat

toBlocks :: Int -> Int -> (Int,[[Block]])
toBlocks base = assign . normalize . toInts base

solve :: Int -> (Int,[ByteString])
solve n =
  let (end,blkss) = toBlocks 2 n
  in (end, graph end blkss)

main = do
  n <- read `fmap` getLine
  let (end,lines) = solve n
  print (end-1)
  mapM_ BS.putStrLn lines

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Control.Monad (mapM_)

type Block = (Int, Int)   -- (start, length)

cY = 'Y'
cN = 'N'

row :: Int -> Block -> Block -> ByteString
row end (pstart, plen) (nstart, nlen) =
  BS.pack $ col1 ++ col2 ++ pre ++ blk1 ++ mid ++ blk2 ++ post
  where
    col1 = if plen == 0 then [cY] else [cN]
    col2 = if nlen == 0 then [cY] else [cN]
    pend = pstart+plen
    nend = nstart+nlen
    pre  = replicate (pstart-3)    cN
    blk1 = replicate plen          cY
    mid  = replicate (nstart-pend) cN
    blk2 = replicate nlen          cY
    post = replicate (end-nend)    cY

triples :: [a] -> [(a,a,a)]
triples [] = []
triples [_,_] = []
triples xs@(a:b:c:_) =  (a,b,c) : triples (tail xs)

rows :: Int -> [ Block ] -> [ByteString]
rows end blks =
    [ r' | (a,(bstart,blen),c) <- blks', let r = row end a c, r' <- replicate blen r ]
  where blks' = triples $ [(3,0)] ++ blks ++ [(end,0)]

-- return a string with Ys in the positions indicated and N's elsewhere
pattern :: Int -> [Block] -> ByteString
pattern end blks = BS.pack $ go 1 blks
  where
    go k [] = replicate (end-k) cN
    go k ((start,len):rest) = replicate (start-k) cN ++ replicate len cY ++ go (start+len) rest

row1 :: Int -> [ [Block] ] -> ByteString
row1 end blks = pattern end (map head blks)

row2 :: Int -> [ [Block] ] -> ByteString
row2 end blks = pattern end (map last blks)

test1 = do let blks = [(3,3),(6,2)]
           mapM_ BS.putStrLn $ [row1 8 [blks], row2 8 [blks]] ++ rows 8 blks

assign' :: Int -> [Int] -> (Int,[Block])
assign' k [] = (k,[])
assign' k xs = (fst (last blks), blks)
  where
    blks = go k xs
    go k [] = []
    go k (a:as) = (k,a) : go (k+a) as

-- assume all lists have the same length
assign :: [[Int]] -> (Int, [[Block]])
assign [] = (3, [])
assign xs = (m,blkss)
  where
    blkss = go 3 xs
    m = let (k,a) = (last (last blkss))
        in a+k
    go k []     = []
    go k (x:xs) = let (k',bs) = assign' k x
                  in bs : go k' xs

-- | make all the lengths the same by extending short lists with 1
normalize :: [[Int]] -> [[Int]]
normalize xss =
  let m = maximum (map length xss)
  in map (\xs -> replicate (m - length xs) 1 ++ xs) xss

graph :: Int -> [[Block]] -> [ByteString]
graph end blkss =
  [row1 end blkss, row2 end blkss] ++ concatMap (rows end) blkss

bAdd :: [[Int]] -> [[Int]] -> [[Int]]
bAdd as bs = as ++ bs

bMul :: Int -> [[Int]] -> [[Int]]
bMul n bss = map (n:) bss

toInts :: Int -> Int -> [[Int]]
toInts base 0 = []
toInts base n =
  case n `divMod` base of
    (q,0) -> base `bMul` (toInts base q)
    (q,r) -> (base `bMul` (toInts base q)) `bAdd` [[r]]

nodeCount :: [[Int]] -> Int
nodeCount = sum . concat

toBlocks :: Int -> Int -> (Int,[[Block]])
toBlocks base = assign . normalize . toInts base

solve :: Int -> (Int,[ByteString])
solve n =
  let (end,blkss) = toBlocks 2 n
  in (end, graph end blkss)

main = do
  n <- read `fmap` getLine
  let (end,lines) = solve n
  print (end-1)
  mapM_ BS.putStrLn lines

import qualified Data.IntMap as IM
import Data.List (foldl')
import qualified Data.IntSet as IS

decomp :: Integer -> [Bool]
decomp x = decomp' x []
  where
    decomp' 0 l = l
    decomp' k l
      | k `mod` 2 == 1 = decomp' (k `div` 2) (True:l)
      | otherwise = decomp' (k `div` 2) (False:l)

main :: IO ()
main = do
  i <- fmap read getLine
  let bits = decomp i
  print bits
  --print $ rush bits
  putStr $ pp $ rush bits

pp :: Graph -> String
pp (g,m) = unlines $ show m : pg
  where pg = foldr (\i l -> let Just es = IM.lookup i g
                            in  map (\j -> if IS.member j es then 'Y' else 'N') [1..m] : l) [] [1..m]

type Graph = (IM.IntMap IS.IntSet, Int)

emptyGraph :: Graph
emptyGraph = (IM.fromList [(1, IS.empty), (2, IS.empty)], 2)

insert2 :: (Int, Int) -> Graph -> Graph
insert2 (a,b) (g, m) = (g', m + 2)
  where
    prev = IS.fromList [a, b]
    g' = f (m + 1) $ f (m + 2) g
    f x gg = IM.update (Just . (IS.insert x)) a $ IM.update (Just . (IS.insert x)) b $ IM.insert x prev gg

insert2' :: Graph -> Graph
insert2' g@(_,m) = insert2 (m, m - 1) g

insert2'' ::  (IM.IntMap IS.IntSet, Int) -> Graph
insert2'' g@(_,m) = insert2 (m,m) g

insert1 :: Int -> Graph -> Graph
insert1 a (g, m) = (g', m + 1)
  where
    prev = IS.singleton a
    g' =  IM.update (Just . (IS.insert (m + 1))) a $ IM.insert (m + 1) prev g

insert1' :: Graph -> Graph
insert1' g@(_,m) = insert1 m g

connect :: (Int, Int) -> Graph -> Graph
connect (a,b) (g,m) = (IM.update (Just . (IS.insert a)) b $ IM.update (Just . (IS.insert b)) a g, m)

connect' :: Int -> Graph -> Graph
connect' a g@(_,m) = connect (a,m) g

close1 :: Graph -> Graph
close1 g@(_,m) = connect (2,m) g

close2 :: Graph -> Graph
close2 g@(_,m) = connect (2,m) . connect (2, m - 1) $ g

rush :: [Bool] -> Graph
rush [True] = connect (1,2) emptyGraph
rush l = let len = length l
             z = zip l [0..]
             build 0 = insert2 (1,1) : replicate (len - 2) insert2' ++ [close2]
             build x
              | x == len - 1 =  insert1 1 : replicate (len - 2) insert1' ++ [close1]
              | otherwise = insert1 1 : replicate (x - 1) insert1' ++ [connect' (2*x+3), connect' (2*x+4)]
             apply = foldl' (\g f -> f g)
         in
          foldl' (\g (t,non2) -> if t then apply  g (build non2) else g) emptyGraph z

import qualified Data.IntMap as IM
import Data.List (foldl')
import qualified Data.IntSet as IS

decomp :: Integer -> [Bool]
decomp x = decomp' x []
  where
    decomp' 0 l = l
    decomp' k l
      | k `mod` 2 == 1 = decomp' (k `div` 2) (True:l)
      | otherwise = decomp' (k `div` 2) (False:l)

main :: IO ()
main = do
  i <- fmap read getLine
  let bits = decomp i
  --print $ rush bits
  putStr $ pp $ rush bits

pp :: Graph -> String
pp (g,m) = unlines $ show m : pg
  where pg = foldr (\i l -> let Just es = IM.lookup i g
                            in  map (\j -> if IS.member j es then 'Y' else 'N') [1..m] : l) [] [1..m]

type Graph = (IM.IntMap IS.IntSet, Int)

emptyGraph :: Graph
emptyGraph = (IM.fromList [(1, IS.empty), (2, IS.empty)], 2)

insert2 :: (Int, Int) -> Graph -> Graph
insert2 (a,b) (g, m) = (g', m + 2)
  where
    prev = IS.fromList [a, b]
    g' = f (m + 1) $ f (m + 2) g
    f x gg = IM.update (Just . (IS.insert x)) a $ IM.update (Just . (IS.insert x)) b $ IM.insert x prev gg

insert2' :: Graph -> Graph
insert2' g@(_,m) = insert2 (m, m - 1) g

insert2'' ::  (IM.IntMap IS.IntSet, Int) -> Graph
insert2'' g@(_,m) = insert2 (m,m) g

insert1 :: Int -> Graph -> Graph
insert1 a (g, m) = (g', m + 1)
  where
    prev = IS.singleton a
    g' =  IM.update (Just . (IS.insert (m + 1))) a $ IM.insert (m + 1) prev g

insert1' :: Graph -> Graph
insert1' g@(_,m) = insert1 m g

connect :: (Int, Int) -> Graph -> Graph
connect (a,b) (g,m) = (IM.update (Just . (IS.insert a)) b $ IM.update (Just . (IS.insert b)) a g, m)

close1 :: Graph -> Graph
close1 g@(_,m) = connect (2,m) g

close2 :: Graph -> Graph
close2 g@(_,m) = connect (2,m) . connect (2, m - 1) $ g

rush :: [Bool] -> Graph
rush [True] = connect (1,2) emptyGraph
rush l = let len = length l
             z = zip l [0..]
             build 0 = insert2 (1,1) : replicate (len - 2) insert2' ++ [close2]
             build x
              | x == len - 1 =  insert1 1 : replicate (len - 2) insert1' ++ [close1]
              | otherwise = insert1 1 : replicate (x - 1) insert1' ++ [insert2''] ++ replicate (len - 2 - x) insert2' ++ [close2]
             apply = foldl' (\g f -> f g)
         in
          foldr (\(t,non2) g -> if t then apply  g (build non2) else g) emptyGraph z


import Data.Bits
import Control.Monad

calcXor :: Int -> Int
calcXor n | n `mod` 4 == 0 = n
          | n `mod` 4 == 1 = 1
          | n `mod` 4 == 2 = n+1
          | otherwise = 0

calc :: Int -> Int -> Int
calc a b =
  let x = calcXor (a-1) in
    if x == b then a
    else if x `xor` b /= a then a+1
    else a+2

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let [a,b] = map read $ words line :: [Int]
    putStrLn $ show $ calc a b

{-# LANGUAGE LambdaCase #-}

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

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

-- type Input = ()
-- type Output = ()

-- input :: Scanner Input
input = pair int int

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

-- solve :: Input -> Output
solve (a, b)
  | rem == 0 = a
  | rem /= a = a + 1
  | otherwise = a + 2
  where
    rem = b `xor` (xors ! (a - 1))

maxn = 3 * 10^5 + 10

xors :: UArray Int Int
xors = listArray (0, maxn) $ scanl1 xor [0..maxn]

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

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

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

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

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

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

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

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


import Control.Monad

solve [] [] = []
solve (x:xs) (y:ys) = x : y : solve xs ys

printResult = do
    n <- readLn :: IO Int
    let m = n - 3 * mod n 2
        r = solve [2,4..m] [1,3..m-1] ++ if odd n then [n-1,n,n-2] else []
    putStrLn . unwords . map show $ r

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Data.List
import Control.Monad

prettyPermutation (x0:x1:x2:[]) = x2 : x0 : x1 : []
prettyPermutation (x0:x1:xs)
  | null xs  = x1 : x0 : []
  | otherwise = x1 : x0 : prettyPermutation xs

solve n = unwords $ map show $ prettyPermutation [1..n]

readInt :: String -> Int
readInt = read

main = do
  n <- readInt <$> getLine
  replicateM_ n $ do
    x <- readInt <$> getLine
    putStrLn $ solve x

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P

import Data.Word (Word8)
import Data.Int (Int64)
import qualified Data.Bits as Bits
import qualified Data.Char as Char

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

import qualified Data.ByteString as B
import qualified System.IO as Io
--import Data.IntSet

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  let res = map (\x -> if even x then x-1 else x+1) [1..n]
      sol = if even n then res else (take (n-3) res) ++ [res !! (n-3) + 1, res !! (n-2),
                                                         res !! (n-1) - 2]
    in putStrLn $ intercalate " " $ map show sol

main = do
  t <- readLn :: IO Int
  replicateM_ t $ solve

import Control.Monad ( replicateM_ )

solve :: IO()
solve = do
    n <- readInt <$> getLine
    let at n i
            | even n || i < n - 2 = if odd i then i + 1 else i - 1
            | i == n - 2          = n
            | otherwise           = i - 1
    putStrLn $ unwords $ map (show . at n) [1..n]

readInt :: String -> Int
readInt = read

main :: IO()
main = do
    t <- readInt <$> getLine
    replicateM_ t solve

import Control.Monad
import Control.Monad (forever)
import System.Exit (exitSuccess)

readInts = fmap (map read.words) getLine :: IO [Integer]

printlr (l,r)   --- has the Str type => need putStr to convert to IO
    | l > r = ""
    | otherwise =
        if (l `mod` 2 ==1) then show(l+1) ++ " " ++ printlr (l+1,r)
        else show(l-1) ++ " " ++ printlr (l+1,r)
solve = do
    n <- readLn :: IO Int
    if (n `mod` 2 == 0) then putStrLn $ printlr (1,n) ---
    else do
        putStr $ printlr (1,n-3);
        putStrLn $ show(n-1) ++" "++ show(n) ++" "++ show(n-2)
main :: IO()
main = do
    test <- readLn ::IO Int
    replicateM_ test solve

import Control.Monad
import Data.List
import Data.Bits

readInts = fmap (map read.words) getLine :: IO [Integer]
solve i r
    | i > r = ""
    | otherwise =
        if (mod i 2 == 1) then show(i+1) ++ " " ++ solve (i+1) r
        else show(i-1) ++ " " ++ solve(i+1) r

each = do
    n<-readLn::IO Int
    if (mod n 2 == 1) then do{
        putStr $ solve 1 (n-3) ;
        putStrLn $ show n ++ " " ++ show (n-2) ++ " " ++ show(n-1)
    }
    else putStrLn $ solve 1 n

main = do
    t<-readLn::IO Int
    replicateM_ t each

-- cheese-cracker: cheese-cracker.github.io
import Control.Monad
import Control.Arrow ((>>>))
import Data.List as L
import Data.Maybe (fromJust)
-- import Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as BS
import Debug.Trace
tracer arr = trace(foldr (++) [] $ map (++" ") $ map show arr) False

getStrList :: IO [BS.ByteString]
getStrList = BS.words <$> BS.getLine

readInts :: IO [Int]
readInts =  (map (fromInteger . fst . fromJust. BS.readInteger) . BS.words) <$> BS.getLine

constr [] = []
constr (x:y:xs) = y:x:(constr xs)

solve n
  | (n `mod` 2 == 1) = 2:constr (1:[3..n])
  | (n `mod` 2 == 0) = constr [1..n]

main :: IO ()
main = do
    [t] <- readInts
    replicateM_ t $ do
        [n] <- readInts
        putStrLn . unwords $ map show (solve n)

import Data.List
import Control.Monad

prettyPermutation lst = take (length lst) $ drop (len - 1) $ cycle lst
  where
    len = length lst
solve n = unwords $ map show $ prettyPermutation [1..n]

readInt :: String -> Int
readInt = read

main = do
  n <- readInt <$> getLine
  replicateM_ n $ do
    x <- readInt <$> getLine
    putStrLn $ solve x


{-
Codeforces Round #332

Problem 606 B. Testing Robots

@author yamaton
@date 2015-12-11
-}

import Control.Applicative
import Control.Monad
-- import Text.Printf (printf)
import qualified Data.Map as M
import qualified Data.Set as S
-- import qualified Data.Foldable as F
-- import qualified Data.Traversable as T

type Position = (Int, Int)

newVisits :: S.Set Position -> [Position] -> [Int]
newVisits _   []         = []
newVisits set (pos:rest) = val: newVisits newSet rest
  where
    val = if pos `S.member` set then 0 else 1
    newSet = S.insert pos set

solve :: Int -> Int -> Position -> String -> [Int]
solve xLim yLim iniPos s = newVisitList ++ [rest]
  where
    dict :: M.Map Char (Int, Int)
    dict = M.fromList [('D', (1, 0)), ('U', (-1, 0)), ('R', (0, 1)), ('L', (0, -1))]

    traj :: [Position]
    traj = init $ scanl move iniPos s

    newVisitList :: [Int]
    newVisitList = newVisits S.empty traj

    rest = xLim * yLim - sum newVisitList
    move :: Position -> Char -> Position
    move (x,y) c = (nx', ny')
      where
        (dx, dy) = dict M.! c
        (nx, ny) = (x + dx, y + dy)
        nx' = if 1 <= nx && nx <= xLim then nx else x
        ny' = if 1 <= ny && ny <= yLim then ny else y

main :: IO ()
main = do
    -- n <- read <$> getLine
    [x, y, x0, y0] <- (map read . words) <$> getLine :: IO [Int]
    s <- getLine :: IO String
    let result = solve x y (x0, y0) s
    putStrLn $ unwords (map show result)

    -- IO.hPutStrLn IO.stderr $ printf "xs = %s" (show xs)
    -- IO.hPutStrLn IO.stderr $ printf "result = %d" result

import Data.List.Split (splitOn, chunksOf)
import Data.List
import qualified Data.Set as Set

move :: (Int, Int) -> [Char] -> [Int] -> Set.Set(Int, Int) -> Int -> Int -> [Int]

move (x, y) [] steps visited max_x max_y     =  (max_x*max_y - (Set.size visited)):steps
move (x, y) (d:xs) steps visited max_x max_y
    | d == 'U' && x - 1 > 0       = move (x-1,y) xs newsteps newvisited max_x max_y
    | d == 'D' && x + 1 <= max_x  = move (x+1,y) xs newsteps newvisited max_x max_y
    | d == 'L' && y - 1 > 0       = move (x,y-1) xs newsteps newvisited max_x max_y
    | d == 'R' && y + 1 <= max_y  = move (x,y+1) xs newsteps newvisited max_x max_y
    | otherwise                   = move (x, y) xs newsteps newvisited max_x max_y
    where   newsteps    = if Set.member (x, y) visited then 0:steps else 1:steps
            newvisited  = Set.insert (x,y) visited

--check visited?
main = do
    coords <- getLine
    commands <- getLine
    let asd = [read x :: Int | x <- splitOn " " coords]
    let size = fst (splitAt 2 asd)
    let position = snd (splitAt 2 asd)
    let visited = Set.empty
    let result = move (head position, last position) commands [] visited (head size) (last size)
    putStrLn (intercalate " " [show x | x <- (reverse result)])

{-# 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
  [m, n, x, y] <- map read . words <$> getLine
  s <- getLine

  let
    move (x, y) 'U' = fix (x-1, y)
    move (x, y) 'D' = fix (x+1, y)
    move (x, y) 'R' = fix (x, y+1)
    move (x, y) 'L' = fix (x, y-1)

    fix (x, y) = (min m (max 1 x), min n (max 1 y))

    ps = scanl move (x, y) s

  b :: IOUArray (Int, Int) Bool <- newArray ((1, 1), (m, n)) False

  cs <- forM ps $ \p -> do
    v <- readArray b p
    if not v
      then do
        writeArray b p True
        return 1
      else do
        return 0

  let cs' = init cs ++ [last cs + m*n - length (filter (== 1) cs)]

  -- print ps
  -- print cs

  putStrLn $ unwords $ map show cs'

import Control.Applicative
import Control.Monad
import Data.Array.IO
import Data.IORef

solve :: Int -> Int -> Int -> Int -> String -> IO [Int]
solve x y x0 y0 s = do
    mat <- newArray ((1,1),(x,y)) False :: IO (IOUArray (Int,Int) Bool)
    now <- newIORef (x0,y0) :: IO (IORef (Int,Int))
    tests <- forM s $ \c -> do
        ij <- readIORef now
        let next = move c ij
        writeIORef now next
        used <- readArray mat ij
        let ret = if used
            then 0
            else 1
        writeArray mat ij True
        return ret
    return $ tests ++ [x*y - length (filter (== 1) tests)]
    where
        move c (i,j)
            | c == 'L' = if j > 1 then (i,j-1) else (i,j)
            | c == 'R' = if j < y then (i,j+1) else (i,j)
            | c == 'U' = if i > 1 then (i-1,j) else (i,j)
            | c == 'D' = if i < x then (i+1,j) else (i,j)

main :: IO ()
main = do
    [x,y,x0,y0] <- map read . words <$> getLine
    s <- getLine
    putStrLn . unwords . map show =<< solve x y x0 y0 s

import Control.Applicative ((<$>))
import Data.Map (fromList, (!))
import Data.Set hiding (fromList, map)

solve :: Int -> Int -> Int -> Int -> String -> [Int]
solve x y x0 y0 cmds =
  getExplosions path empty 0
  where
    path = computePath x0 y0 cmds
    getExplosions [_] _ netExplosions = [x*y - netExplosions]
    getExplosions (pos:rst) traversed netExplosions
      | pos `member` traversed = 0:getExplosions rst traversed netExplosions
      | otherwise = 1:getExplosions rst (insert pos traversed) (netExplosions + 1)
    getExplosions _ _ _ = error "Not supposed to be here"
    computePath x' y' [] = [(x', y')]
    computePath x' y' (cmd:rst)
      | validMove = (x', y'):computePath x'' y'' rst
      | otherwise = (x', y'):computePath x' y' rst
        where
          deltas = fromList [('U', (-1, 0)), ('D', (1, 0)), ('R', (0, 1)), ('L', (0, -1))]
          (dx, dy) = deltas ! cmd
          x'' = dx + x'
          y'' = dy + y'
          validMove = (x'' >= 1 && x'' <= x && y'' >= 1 && y'' <= y)

main :: IO ()
main = do
  [x, y, x0, y0] <- map read . words <$> getLine
  cmds <- getLine
  putStrLn $ unwords . map show $ solve x y x0 y0 cmds

{-# 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
  [m, n, x, y] <- map read . words <$> getLine
  s <- getLine

  let
    move (x, y) 'U' = fix (x-1, y)
    move (x, y) 'D' = fix (x+1, y)
    move (x, y) 'R' = fix (x, y+1)
    move (x, y) 'L' = fix (x, y-1)

    fix (x, y) = (min m (max 1 x), min n (max 1 y))

    ps = scanl move (x, y) s
    gs = group ps
    cs = concat $ map (\g -> [1] ++ replicate (length g - 1) 0 ) gs
    cs' = init cs ++ [last cs + m*n - length gs]

  putStrLn $ unwords $ map show cs'

import Data.List.Split (splitOn, chunksOf)
import Data.List
import qualified Data.Set as Set

move :: (Int, Int) -> [Char] -> [Int] -> Set.Set(Int, Int) -> Int -> Int -> [Int]

move (x, y) [d] steps visited max_x max_y     =  steps ++ [max_x*max_y - (Set.size newvisited)]
                                              where newvisited = Set.insert (x,y) visited
move (x, y) (d:xs) steps visited max_x max_y
    | d == 'U' && x - 1 > 0       = move (x-1,y) xs (steps ++ [1]) newvisited max_x max_y
    | d == 'D' && x + 1 <= max_x  = move (x+1,y) xs (steps ++ [1]) newvisited max_x max_y
    | d == 'L' && y - 1 > 0       = move (x,y-1) xs (steps ++ [1]) newvisited max_x max_y
    | d == 'R' && y + 1 <= max_y  = move (x,y+1) xs (steps ++ [1]) newvisited max_x max_y
    | otherwise                   = move (x, y) xs (steps ++ [0]) newvisited max_x max_y
    where newvisited = Set.insert (x,y) visited

--check visited?
main = do
    coords <- getLine
    commands <- getLine
    let asd = [read x :: Int | x <- splitOn " " coords]
    let size = fst (splitAt 2 asd)
    let position = snd (splitAt 2 asd)
    let visited = Set.singleton (head position, last position)
    let result = move (head position, last position) commands [1] visited (head size) (last size)
    putStrLn (intercalate " " [show x | x <- result])


rush :: (Int,[Integer]) -> Int
rush (m,[]) = m
rush (m,[_]) = m
rush (m,[_,_]) = m
rush (m,l) = rush (max t m, r)
  where
        go (n,[]) = (n,[])
        go (n,[_]) = (n+1,[])
        go (n,[_,_]) = (n+2,[])
        go (n,(a:x@(b:c:_)))
          | c == a + b = go (n+1,x)
          | otherwise = (n+2,x)
        (t, r) = go (0,l)

main = do
  n <- fmap read getLine
  x <- fmap (map read . words) getLine
  print $ rush (min n 2,x)

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

solve :: [Int] -> Int
solve [a]  =  1
solve as  =  maximum $ solve' 2 as
  where
    solve' k (a:b:c:xs)
      | a + b == c  =  solve' (k+1) (b:c:xs)
      | otherwise  =  k : solve' 2 (b:c:xs)
    solve' k xs  =  [k]

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

  where

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

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

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

import qualified Data.ByteString.Lazy.Builder as BB

import Data.Monoid
import System.IO

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

main = do
  getLine
  xs <- getInts

  let
    m0 = map length $ filter ((== 0) . head) $ group xs
    m1 = map f $ tails xs
      where
        f a = (length $ takeWhile id $ zipWith3 (\a b c -> a+b == c) a' (tail a') (tail $ tail a')) + 2
          where a' = take 51 a

  print $ if length xs == 1 then 1 else maximum $ m0 ++ m1


import Data.List (partition); import Data.Function (fix)
main = interact $ unlines . map ( unwords . map show . (uncurry (++)) . partition even . map (read :: String -> Int ) . words ) . fix (\f xs ->  if null xs then [] else let (x:y:ys)=xs in y : f ys) .  tail . lines

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

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

printArray [] = ""
printArray (x:xs) = show(x) ++" " ++ printArray xs

printS = do
    n<-readLn::IO Int
    a<-readInts
    let b = [x|x<-a, odd x]
        c = [x|x<-a, even x]
    putStrLn $ printArray (b ++ c)

main = do
    t<-readLn::IO Int
    replicateM_ t printS

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

import qualified Data.Array as A

import Data.Bits(xor)

import Data.Map((!))

solve :: Integer -> [Integer] -> [Integer]
solve _ list = [x | x<-list, mod x 2==0] ++ [x | x<-list, mod x 2 == 1]

showResult (x:xs) = show x ++ " " ++ showResult xs
showResult [] = []

main = do
	t <- getLine >>= return . read :: IO Integer
	let loop t = if t == 0 then return () else do
		n <- getLine >>= return . read :: IO Integer
		a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		putStrLn $ showResult $ solve n a
		loop $ t - 1
	loop t

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

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

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    _ <- C.getLine
    as <- getInts
    let (xs, ys) = partition odd as
    C.putStrLn $ C.pack $ unwords $ map show $ xs ++ ys


import Control.Monad

solve [] = return ()
solve (ts:tss) = do
  if cond
     then putStrLn "YES"
     else putStrLn "NO"
  solve tss
  where
    cond = or $ [loop ts' | i <- [0..l-3], let ts' = drop i ts]
    l = length ts
    loop [] = False
    loop [_] = False
    loop [_,_] = False
    loop (x:y:z:xs)
      | x == z = True
      | otherwise = loop (x:y:xs)

main = do
  t <- readLn :: IO Int
  tss <- replicateM t $ do
    getLine
    xs <- map read . words <$> getLine :: IO [Int]
    return xs
  solve tss

import Control.Monad
import Data.Bool
main = do
  t <- readLn
  replicateM t $ getLine >> getLine >>=
    putStrLn.bool"NO" "YES".solve.map read.words
solve :: [Int] -> Bool
solve (a: b: as)
  | a `elem` as = True
  | otherwise = solve (b: as)
solve _ = False

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

main = getLine >>= test.read
test 0 = return ()
test i = do
  getLine
  as <- map read.words <$> getLine :: IO [Integer]
  putStrLn $ if f as then "YES" else "NO"
  test (i - 1)

f (a:b:as) = any (== a) as || f (b:as)
f _ = False

import Control.Monad

checkPalinSubstring :: [Int] -> Bool

checkPalinSubstring [] = False
checkPalinSubstring (x:y:[]) = False
checkPalinSubstring all@(x:y:xs) = or [length (filter (==x) xs) > 0, checkPalinSubstring (y:xs)]

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

main = do
	t <- getLine
	let cases = (read t :: Int)
	results <- forM [1..cases] (\t -> do
		n <- readInts
		ints <- readInts
		if checkPalinSubstring ints then return "YES" else return "NO"
		)

	mapM putStrLn results

import Control.Monad

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        getLine
        xs <- map read . words <$> getLine
        if pal xs then
            putStrLn "Yes"
        else
            putStrLn "No"

pal :: [Int] -> Bool
pal (x:y:zs) = elem x zs || pal (y:zs)
pal _ = False

main :: IO ()

main = interact (format' . solve . format)

solve :: [[Int]] -> [String]
solve = map solver

format' = unlines

solver :: [Int] -> String
solver [x,y] = "NO"
solver (x:all@(y:xs)) = case x `elem` xs of
                    True -> "YES"
                    False -> solver all

format :: String -> [[Int]]
format xs = map (map read . words . snd) . filter (odd . fst) . (zip [0..]) . tail . lines $ xs

import Control.Monad

checkPalinSubstring :: [Int] -> Bool

checkPalinSubstring [] = False
checkPalinSubstring (x:[]) = False
checkPalinSubstring (x:y:[]) = False
checkPalinSubstring (x:y:z:xs) = or [ reverse (x:y:[z]) == (x:y:[z]), checkPalinSubstring (y:z:xs)]

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

main = do
	t <- getLine
	let cases = (read t :: Int)
	results <- forM [1..cases] (\t -> do
		n <- readInts
		ints <- readInts
		if checkPalinSubstring ints then return "YES" else return "NO"
		)

	mapM putStrLn results

import Control.Monad

checkPalinSubstring :: [Int] -> Bool

checkPalinSubstring [] = False
checkPalinSubstring (x:[]) = False
checkPalinSubstring (x:y:[]) = False
checkPalinSubstring (x:y:z:[]) = z == x
checkPalinSubstring (x:y:z:t:xs) = or [ x == z, checkPalinSubstring (y:z:t:xs), [t, z, y, x] == [x, y, z, t]]

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

main = do
	t <- getLine
	let cases = (read t :: Int)
	results <- forM [1..cases] (\t -> do
		n <- readInts
		ints <- readInts
		if checkPalinSubstring ints then return "YES" else return "NO"
		)

	mapM putStrLn results

import Control.Monad

checkPalinSubstring :: [Int] -> Bool

checkPalinSubstring [] = False
checkPalinSubstring (x:y:[]) = False
checkPalinSubstring all@(x:y:xs) = or [length (filter (==x) xs) >= 0, checkPalinSubstring (y:xs)]

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

main = do
	t <- getLine
	let cases = (read t :: Int)
	results <- forM [1..cases] (\t -> do
		n <- readInts
		ints <- readInts
		if checkPalinSubstring ints then return "YES" else return "NO"
		)

	mapM putStrLn results

main :: IO ()

main = interact (format' . solve . format)

solve :: [[Int]] -> [String]
solve = map solver

format' = unlines

solver :: [Int] -> String
solver (x:y:z:[])
    | x == z    = "YES"
    | otherwise = "NO"

solver (x:y:z:t:[])
    | x == t && y == z = "YES"
    | x == z = "YES"
    | y == t = "YES"
    | otherwise = "NO"

solver (x:(a@(y:z:t:xs)))
    | x == z = "YES"
    | x == t && y == z = "YES"
    | otherwise = solver a

format :: String -> [[Int]]
format xs = map (map read . words . snd) . filter (odd . fst) . (zip [0..]) . tail . lines $ xs


-- https://codeforces.com/contest/1617/problem/B

solve n = show a ++ " " ++ show b ++ " 1" where
    a | even n = div (n-1) 2
      | even $ div (n-1) 2 = div (n-1) 2 - 1
      | otherwise = div (n-1) 2 - 2
    b | even n = a + 1
      | even $ div (n-1) 2 = a + 2
      | otherwise = a + 4

run 0 = return 0
run n = do
    t <- getLine
    putStrLn $ solve $ read t
    run $ n-1
main = getLine >>= run . read

import Control.Monad.Identity (forM_, forM)

minus (x:xs) (y:ys) = case compare x y of
           LT -> x : minus  xs  (y:ys)
           EQ ->     minus  xs     ys
           GT ->     minus (x:xs)  ys
minus  xs     _     = xs

primesToQ m = eratos [2..m]
    where
    eratos []     = []
    eratos (p:xs) = p : eratos (xs `minus` [p*p, p*p+p..m])

match :: (a -> Bool) -> [a] -> [a]
match f [] = []
match f (x:xs) = if f x then [x] else match f xs

solve :: Int -> [Int]
solve n = match (\x -> gcd x (n - x - 1) == 1) (primesToQ n)

main :: IO ()
main = do
    n <- readLn :: IO Int
    forM_ [1 .. n] $ \i -> do
        x <- readLn :: IO Int
        let a = head $ solve x
        let b = x - a - 1
        putStrLn $ show a ++ " " ++ show b ++ " 1"

main :: IO ()
main = interact solve

solve :: String -> String
solve = unlines . map (showTriple . f . read) . tail . lines

showTriple :: (Int, Int, Int) -> String
showTriple (a, b, c) = unwords [show a, show b, show c]

f :: Int -> (Int, Int, Int)
f n = let a = until check succ 2
      in (a, n - a - 1, 1)
  where
    check a = let b = n - a - 1
              in gcd a b == 1

-- https://codeforces.com/contest/1617/problem/B

solve n = show a ++ " " ++ show b ++ " 1" where
    a | even n = div (n-1) 2
      | even $ div (n-1) 2 = div (n-1) 2 - 1
      | otherwise = div (n-1) 2 - 2
    b | even n = a + 1
      | even $ div (n-1) 2 = a + 2
      | otherwise = a + 4

run 0 = return 0
run n = do
    print $ solve n
    run $ n-1
main = getLine >>= run . read


import Control.Monad
import Data.List

count = sum . map fromEnum

groupsOf :: Int -> [Int] -> [[Int]]
groupsOf n xs = zipWith const (map (take n) (tails xs)) (drop (n-1) xs)

bad3 [x,y,z] = (x >= y && y >= z) || (x <= y && y <= z)
bad4 [w,x,y,z] = or [ bad3 [x,y,z]
                    , bad3 [w,y,z]
                    , bad3 [w,x,z]
                    , bad3 [w,x,y]
                    ]

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    print $ sum [ n
                , n - 1
                , count $ map (not . bad3) $ groupsOf 3 a
                , count $ map (not . bad4) $ groupsOf 4 a
                ]

{-# OPTIONS_GHC -O2 #-}

import Control.Monad
import Prelude as P
import Data.List as L
import Data.Int (Int64)
import Data.Bits as B
import System.IO as Io
--import Data.Char as C
--import Data.IntSet as S

badtriple :: [Int] -> Bool
badtriple [x,y,z] = (x >= y && y >= z) || (x <= y && y <= z)
badtriple _ = error "invalid input lol"

chunks :: Int -> [Int] -> Int
chunks _ [] = 0
chunks _ [_] = 0
chunks _ [_, _] = 0
chunks 4 [_, _, _] = 0
chunks n xs = (if any badtriple $ alltriples n x then 0 else 1) + chunks n (tail xs)
  where x = take n xs
        alltriples n xs = (if n == 3 then [take 3 xs] else
                             let [a,b,c,d] = xs in [[a,b,c], [a,b,d], [a,c,d], [b,c,d]])

solve :: IO ()
solve = do
  n <- readLn :: IO Int
  s_ <- getLine
  let a = map read $ words s_ :: [Int]
      ch3 = chunks 3 a
      ch4 = chunks 4 a
      total = n + (n-1) + ch3 + ch4
    in print total

main = do
  t <- readLn :: IO Int
  replicateM_ t solve

import Control.Monad
import Data.List
readInts = fmap (map read.words) getLine :: IO [Integer]

d (x1,y1) (x2,y2) = abs (x1-x2) + abs (y1-y2)

isGood x y z = a + b /= c
            where [a,b,c] = sort [d x y, d y z, d x z]

solve3 [_] = 0
solve3 [_,_] = 0
solve3 (x:y:z:xs) = solve3 (y:z:xs) + if isGood x y z then 1 else 0

solve4 [_] = 0
solve4 [_,_] = 0
solve4 [_,_,_] = 0
solve4 (x:y:z:t:xs) = solve4 (y:z:t:xs) + if isGood x y z && isGood y z t && isGood x y t && isGood x z t then 1 else 0

printResult = do
    n <- readLn :: IO Integer
    xs <- readInts
    let z = zip xs [1..]
    print $ 2*n-1 + solve3 z + solve4 z

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Monad ( replicateM_ )
import Data.List ( zipWith4 )

solve :: IO ()
solve = do
    n <- readLn :: IO Int
    a <- readMany :: IO [Int]
    let ans3 = sum $ map fromEnum $ zipWith3 ok3 a (tail a) (drop 2 a)
        ans4 = sum $ map fromEnum $ zipWith4 ok4 a (tail a) (drop 2 a) (drop 3 a)
        ok3 a b c = a > b && b < c || a < b && b > c
        ok4 a b c d = ok3 a b c && ok3 a b d && ok3 a c d && ok3 b c d
    print $ n + n - 1 + ans3 + ans4

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t solve

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (group)
import Data.Maybe (fromJust, fromMaybe)

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

main :: IO ()
main = C.interact $ runScanner (numberOf testCase) >>> C.unlines

testCase :: Scanner C.ByteString
testCase = do
  n <- int
  xs <- n >< int
  return . C.pack . show $ solve n xs

solve n xs = 2 * n - 1 + compute xs
  where
    compute [] = 0
    compute [_] = 0
    compute [_, _] = 0
    compute (x : y : z : xs) = good3 x y z + (case xs of [] -> 0; (w:_) -> good4 x y z w) + compute (y : z : xs)

    good p q r = q < min p r || q > max p r
    good3 p q r | good p q r = 1 | otherwise = 0
    good4 p q r s | good p q r && good p r s && good p q s && good q r s = 1
      | otherwise = 0

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> str

double :: Scanner Double
double = read . C.unpack <$> str

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

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

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

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

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

(><) = times

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

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

import Control.Monad
import Data.List

count = sum . map fromEnum

groupsOf :: Int -> [Int] -> [[Int]]
groupsOf n xs = zipWith const (map (take n) (tails xs)) (drop (n-1) xs)

bad3 [x,y,z] = (x >= y && y >= z) || (x <= y && y <= z)
bad4 [w,x,y,z] = or [ bad3 [x,y,z]
                    , bad3 [w,y,z]
                    , bad3 [w,x,z]
                    , bad3 [w,x,y]
                    ]

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    a <- map read . words <$> getLine
    print $ sum [ n
                , n - 1
                , count $ map bad3 $ groupsOf 3 a
                , count $ map bad4 $ groupsOf 4 a
                ]


import           Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (read >>> solve >>> format) >>> concat >>> unlines

solve :: Int -> [Int]
solve n = go 1 n
  where
    go _ 0 = []
    go t n
      | m /= 0    = m : go (10*t) (n - m)
      | otherwise = go (10*t) n
      where
        m = n `mod` t

format :: [Int] -> [String]
format ns = [show (length ns), unwords (map show ns)]

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

process (a,b) = do
			putStr [a]
			putStr $ replicate b '0'
			putStr " "

onecase= do
		k<-reverse <$> getLine
	 	let s = filter (\z-> fst z/='0') $ zip k [0..]
		print $ length s
		mapM_ process s
		putStrLn ""

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

process :: [Char] -> [[Char]]
process = map (\(n,x) -> (x:replicate n '0')) . filter (\(_,x) -> x /= '0') . zip [0..] . reverse

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- getLine
    let xs = process n
    print . length $ xs
    putStrLn . unwords $ xs
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Data.List

main :: IO ()
main = do
  getLine
  input <- map (filter (/=0) . solve 0 . read) <$> lines <$> getContents :: IO [[Int]]
  mapM_ f input

solve :: Int -> Int -> [Int]
solve _ 0 = []
solve i x = (x `mod` 10) * (10 ^ i) : solve (i + 1) (x `div` 10)

f :: [Int] -> IO ()
f xs = do
    print . length $ xs
    putStrLn . unwords . (map show) $ xs

import Control.Monad
import Data.List

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let x = n `mod` 10
            nx = n - x
            y = nx `mod` 100
            ny = nx - y
            z = ny `mod` 1000
            nz = ny - z
            t = nz `mod` 10000
            nt = nz - t
            w = nt `mod` 100000
            ans = filter (>0) [x, y, z, t, w]
        print $ length $ ans
        printList $ ans

import Control.Monad (replicateM_)

main = readLn >>= flip replicateM_ ioSolve

ioSolve :: IO ()
ioSolve = getLine >>= (\x -> print (length x) >> (putStrLn . unwords . map show) x) .
        filter (/=0) .
        zipWith (*) (iterate (*10) 1) .
        map (read . (:[])) . reverse

solve :: Int -> Int -> [Int]
solve _ 0 = []
solve multiplier n
    | n`mod`10==0   = solve (10*multiplier) (n`div`10)
    | otherwise     = multiplier * (n`mod`10) : solve (10*multiplier) (n`div`10)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:_) <- readNums
    let ans = solve 1 n
    print $ length ans
    putStrLn $ unwords $ map show ans
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readNums
    testCases t

readNums :: (Read n) => IO [n]
readNums = map read . words <$> getLine

import Control.Monad
import Data.List

printStrList :: [String] -> IO ()
printStrList = putStrLn . intercalate " "

printList :: (Show a) => [a] -> IO ()
printList = printStrList . map show

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let x = n `mod` 10
            nx = n - x
            y = nx `mod` 100
            ny = nx - y
            z = ny `mod` 1000
            nz = ny - z
            t = nz `mod` 10000
            ans = filter (>0) [x, y, z, t]
        print $ length $ ans
        printList $ ans


infixl 3 +.
infixl 9 *.

(*.) :: Int -> (Int, Int) -> (Int, Int)
(*.) k (z, t) = (k * z, k * t)

(+.) :: (Int, Int) -> (Int, Int) -> (Int, Int)
(+.) (x, y) (z, t) = (x + z, y + t)

solve (n, as, bs) =
    m *. (small l as bs) +. (small r as bs)
    where an = length as
          bn = length bs
          l = lcm an bn
          m = n `div` l
          r = n `mod` l

small n as bs =
    let (sa, sb) = unzip . take n $ [score a b | (a, b) <- zip (cycle as) (cycle bs)]
    in (sum sb, sum sa)

score a b = (s a b, s b a)

s 'R' 'S' = 1
s 'S' 'P' = 1
s 'P' 'R' = 1
s _ _ = 0

parse foo =
    let [n,as,bs] = words foo
    in (read n, as, bs)

pprint (x,y) = show x ++ " " ++ show y

main = interact (pprint . solve . parse)

import Data.List

inv f (x,y) = f (y,x)

winner ('R','S') = 1
winner ('S','P') = 1
winner ('P','R') = 1
winner _ = 0

solve :: Int -> String -> String -> (Int, Int)
solve n a b = (count $ map (winner) cycled, count $ map (inv winner) cycled)
    where cycled = take l $ zip (cycle b) (cycle a)
          l = length a * length b
          count xs = d*(sum xs) + (sum $ take r xs)
              where (d,r) = divMod n l

print_tuple (x,y) = show x ++ " " ++ show y

main = do n <- getLine
          a <- getLine
          b <- getLine
          putStrLn $ print_tuple $ solve (read n :: Int) a b

import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import System.IO
import System.IO.Error

hReadMany :: (Char -> Bool) -> Handle -> IO String
hReadMany p h = do b <- (p <$> hLookAhead h) `catch` const (return False)
                   if b
                     then (:) <$> hGetChar h <*> hReadMany p h
                     else return ""

hSkipSpaces  = hReadMany isSpace
hReadNumeric = hReadMany (\c -> isDigit c || c `elem` ['.', '-', '+'])

readNum :: (Num a, Read a) => IO a
readNum = do hSkipSpaces stdin
             read <$> hReadNumeric stdin

readTerm :: IO String
readTerm = do hSkipSpaces stdin
              hReadMany (not . isSpace) stdin

hoge 'R' = 0
hoge 'P' = 1
hoge 'S' = 2

wins x y | a == b = False
         | (a - b) `mod` 3 == 1 = True
         | otherwise = False
  where
    (a, b) = (hoge x, hoge y)

play m ns ps = play' m 0 0 ns ps
  where
    play' 0 a b _  _  = (a, b)
    play' x a b (n:ns) (p:ps) | wins n p = play' (x - 1) a (b+1) ns ps
                              | wins p n = play' (x - 1) (a + 1) b ns ps
                              | otherwise = play' (x - 1) a b ns ps

main = do x <- readNum
          nike <- readTerm
          poly <- readTerm

          let l = lcm (length nike) (length poly)
          let mult = x `div` l
          let rest = x `mod` l

          let cnike = cycle nike
          let cpoly = cycle poly

          let (n, p) = play l cnike cpoly
          let (a, b) = play rest cnike cpoly

          let (n', p') = (mult * n + a, mult * p + b)

          putStrLn $ show n' ++ " " ++ show p'

import Data.List

win_a ('R','S') = 1
win_a ('S','P') = 1
win_a ('P','R') = 1
win_a _ = 0

win_b ('S','R') = 1
win_b ('P','S') = 1
win_b ('R','P') = 1
win_b _ = 0

solve :: Int -> String -> String -> (Int, Int)
solve n a b = (count $ map (win_a) cycled, count $ map (win_b) cycled)
    where cycled = take l $ zip (cycle b) (cycle a)
          l = length a * length b
          count xs = d*(sum xs) + (sum $ take r xs)
              where (d,r) = divMod n l

print_tuple (x,y) = show x ++ " " ++ show y

main = do n <- getLine
          a <- getLine
          b <- getLine
          putStrLn $ print_tuple $ solve (read n :: Int) a b

import Data.List

--------------------------------------------------------------------------------
{-
import HUnit

testOneMove  =  TestList "TestOneMove"
  [
    Test "1" $ assertEq (0, 0) (solve 1 "R" "R"),
    Test "2" $ assertEq (1, 0) (solve 1 "R" "P"),
    Test "3" $ assertEq (0, 1) (solve 1 "R" "S"),
    Test "4" $ assertEq (1, 0) (solve 1 "S" "R"),
    Test "5" $ assertEq (0, 0) (solve 1 "S" "S"),
    Test "6" $ assertEq (0, 1) (solve 1 "S" "P"),
    Test "7" $ assertEq (0, 1) (solve 1 "P" "R"),
    Test "8" $ assertEq (1, 0) (solve 1 "P" "S"),
    Test "9" $ assertEq (0, 0) (solve 1 "P" "P")
  ]

testShortString  =  TestList "TestShortString"
  [
    Test "1" $ assertEq (2, 0) (solve 2 "R" "P"),
    Test "2" $ assertEq (0, 2) (solve 2 "P" "R"),
    Test "3" $ assertEq (4, 0) (solve 4 "RRR" "PPP")
  ]

testInput  =  TestList "TestInput"
  [
     Test "1" $ assertEq (3,2) (solve 7 "RPS" "RSPP"),
     Test "2" $ assertEq (0,0) (solve 5 "RRRRRRRR" "R")
  ]

testBig  =  Test "TestBig" $
    assertEq (0,0) (solve n "R" "R")
  where
    n  =  2 * 10^9

testBigBig  =  Test "TestBigBig" $
    assertEq (n,0) (solve n (replicate n1 'R') (replicate n2 'P'))
  where
    n  =  2 * 10^9
    n1  =  1001
    n2  =  999

test  =  mapM_ run
  [
    testOneMove,
    testShortString,
    testInput,
    testBig,
    testBigBig
  ]
-}
--------------------------------------------------------------------------------

solve :: Int -> String -> String -> (Int, Int)
solve n s1 s2  =  (m2 + m1 * div n m, n2 + n1 * div n m)
  where
    m  =  lcm (length s1) (length s2)
    (m1, n1)  =  solve' m (cycle s1) (cycle s2) (0,0)
    (m2, n2)  =  solve' (mod n m) (cycle s1) (cycle s2) (0,0)
    solve' 0 _ _ acc  =  acc
    solve' n (c1:s1) (c2:s2) (k, l)
      | f c1 c2  =  solve' n' s1 s2 (succ k, l)
      | f c2 c1  =  solve' n' s1 s2 (k, succ l)
      | otherwise  =  solve' n' s1 s2 (k, l)
      where
        n'  =  pred n
    f 'R' 'P'  =  True
    f 'S' 'R'  =  True
    f 'P' 'S'  =  True
    f _ _   =  False

printAns :: (Int, Int) -> IO ()
printAns (a, b)  =  putStrLn $ concat [show a, " ", show b]

main :: IO ()
main  =  do
    n  <-  readLn
    s1  <-  getLine
    s2  <-  getLine
    printAns $ solve n s1 s2

solve (n, as, bs) =
    let (sa, sb) = unzip . take n $ [score a b | (a, b) <- zip (cycle "RPS") (cycle "RSPP")]
    in (sum sa, sum sb)

score a b = (s a b, s b a)

s 'R' 'S' = 1
s 'S' 'P' = 1
s 'P' 'R' = 1
s _ _ = 0

parse foo =
    let [n,as,bs] = words foo
    in (read n, as, bs)

pprint (x,y) = show x ++ " " ++ show y

main = interact (pprint . solve . parse)

solve (n, as, bs) =
    let (sa, sb) = unzip . take n $ [score a b | (a, b) <- zip (cycle "RPS") (cycle "RSPP")]
    in (sum sb, sum sa)

score a b = (s a b, s b a)

s 'R' 'S' = 1
s 'S' 'P' = 1
s 'P' 'R' = 1
s _ _ = 0

parse foo =
    let [n,as,bs] = words foo
    in (read n, as, bs)

pprint (x,y) = show x ++ " " ++ show y

main = interact (pprint . solve . parse)

solve (n, as, bs) =
    let (sa, sb) = unzip . take n $ [score a b | a <- cycle as, b <- cycle bs]
    in (sum sb, sum sa)

score a b = (s a b, s b a)

s 'R' 'S' = 1
s 'S' 'P' = 1
s 'P' 'R' = 1
s _ _ = 0

parse foo =
    let [n,as,bs] = words foo
    in (read n, as, bs)

pprint (x,y) = show x ++ " " ++ show y

main = interact (pprint . solve . parse)


{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,k) <- readIntPair
    let l = (n-1) - k + 1
        as = [1..l-1]++ go l n
    putStrLn $ unwords $ map show as

go a b | b - a == 0 = [a]
       | b - a == 1 = [a,b]
       | otherwise = a:b:go (a+1) (b-1)

f[]=""
f(x:y)=show x++" "++f y
solve[n,k]=take n((take k(foldr(\(y,z)x->y:z:x)[][(a,n+1-a)|a<-[1..k]]))++(if mod k 2==1 then[d+2..]else[n-d,n-d-1..]))where d=k`div`2
main=interact$f.solve.map read.words

import Data.List (sort)
solve [n,k] = p ++ q'
    where y = take n $ concat $ zipWith (\x y -> [x,y]) [1 .. g] [n,n-1 .. g]
          (p,q) = splitAt k y
          q' = if last p < g then sort q else reverse (sort q)
          g = div (n+1) 2
main = putStrLn.unwords.map show.solve.map read.words =<< getLine

import Data.List (permutations, nub, intercalate)

findPermutation :: [Int] -> [Int]
findPermutation [n, k] = 1 : (helper k 1 1)
    where helper h l c
            | h == 0 = [k+2..n]
            | odd c = (l + h) : helper (h - 1) (l + h) (c + 1)
            | even c = (l - h) : helper (h - 1) (l - h) (c + 1)

main = getLine >>= putStrLn . intercalate " " . fmap show . findPermutation . fmap read . words

solve [n,k] = scanl (+) 1 $ replicate (n-1-k) 1 ++ zipWith (*) [k,k-1..1] (cycle [1,-1])
main = interact $ unwords . map show . solve . map read . words

main=interact$unwords.map show.f.map read.words
f [n,k]=[1..n-k]++(take k.g$zip [n,n-1..] [n-k+1..])
g []=[]
g ((a,b):c)=a:b:g c

main = interact $ unwords . map show . f . map read . words
f [n, k] = (g . take (div k 2) $ zip [1..n] [n,n-1..1]) ++ h n k
g [] = []
g ((a, b):c) = a:b:g c
h n k = if odd k then [x+1..n-x] else [n-x,n-x-1..x+1] where x = div k 2

main = interact $ unwords . map show . f . map read . words
f [n,k] = [1..n-k] ++ (take k $ g [n,n-1..] [n-k+1..])
g (a:b) (c:d) = a:c:g b d

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Integer] -> [Integer]
solve [ n, k ] = [ 1 .. n - k ] ++ merge [ n, n - 1 .. n - k `div` 2 + 1 ] [ n - k + 1 .. n - k `div` 2 ]
solve _ = undefined

merge :: [a] -> [a] -> [a]
merge (x:xs) (y:ys) = x : y : merge xs ys
merge xs [] = xs
merge _ ys = ys

import Data.List (permutations, nub, intercalate)

findPermutation :: [Int] -> [Int]
findPermutation [n, k] = permutation [1..n] 1
    where permutation (x:y:zs) h
            | h == k = (x:y:zs)
            | abs (x-y) <= h = permutation ((x:zs) ++ [y]) h
            | otherwise = x : (permutation (y:zs) (h + 1))

main = getLine >>= putStrLn . intercalate " " . fmap show . findPermutation . fmap read . words

main = interact $ unwords . map show . f . map read . words
f [n, k] = [1..n-k] ++ g n k
g _ 0 = []
g a k = a:g (abs $ a-k+1) (k-1)


import Control.Monad (liftM)
import List (partition, sortBy)

--------------------------------------------------------------------------------
{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "#1" $ assertEq (5.5, [[3], [1,2]]) $
        solve 2 [Stool 1 2, Pensil 2 3, Stool 3 3],
    Test "#2" $ assertEq (8.0, [[1], [2], [3,4]]) $
        solve 3 [Stool 1 4, Pensil 2 1, Pensil 3 2, Pensil 4 3]
  ]

testOneBasket :: Test
testOneBasket  =  TestList "TestOneBasket"
  [
    Test "#1" $ assertEq (5.0, [[1]]) $
        solve 1 [Stool 1 10],
    Test "#2" $ assertEq (10.0, [[1]]) $
        solve 1 [Pensil 1 10],
    Test "#3" $ assertEq (25.0, [[2,1]]) $
        solve 1 [Stool 1 10, Stool 2 20],
    Test "#4" $ assertEq (30.0, [[1,2]]) $
        solve 1 [Pensil 1 10, Pensil 2 20],
    Test "#5" $ assertEq (25.0, [[1,2]]) $
        solve 1 [Stool 1 10, Pensil 2 20],
    Test "#6" $ assertEq (25.0, [[2,1]]) $
        solve 1 [Pensil 1 10, Stool 2 20]
  ]

testMoreBaskets :: Test
testMoreBaskets  =  TestList "TestMoreBaskets"
  [
    Test "#1" $ assertEq (4.5, [[2], [1]]) $
        solve 2 [Stool 1 3, Stool 2 6],
    Test "#2" $ assertEq (7.5, [[1], [2]]) $
        solve 2 [Stool 1 3, Pensil 2 6],
    Test "#3" $ assertEq (9.0, [[1], [2]]) $
        solve 2 [Pensil 1 3, Pensil 2 6],
    Test "#4" $ assertEq (22.0, [[4], [3,2,1]]) $
        solve 2 [Stool 1 3, Stool 2 6, Stool 3 9, Stool 4 11],
    Test "#5" $ assertEq (22.5, [[3], [2,1,4]]) $
        solve 2 [Stool 1 3, Stool 2 6, Stool 3 8, Pensil 4 11],
    Test "#6" $ assertEq (17.5, [[2], [1,3,4]]) $
        solve 2 [Stool 1 3, Stool 2 6, Pensil 3 1, Pensil 4 11],
    Test "#7" $ assertEq (19.5, [[1], [2,3,4]]) $
        solve 2 [Stool 1 3, Pensil 2 6, Pensil 3 1, Pensil 4 11],
    Test "#8" $ assertEq (21.0, [[1], [2,3,4]]) $
        solve 2 [Pensil 1 3, Pensil 2 6, Pensil 3 1, Pensil 4 11]
  ]

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    testOneBasket,
    testMoreBaskets
  ]
-}
--------------------------------------------------------------------------------

data Goods  =  Stool Int Integer | Pensil Int Integer
    deriving Eq

instance Ord Goods
  where
    compare a b  =  compare (getCost a) (getCost b)

getCost :: Goods -> Integer
getCost (Stool _ c)  =  c
getCost (Pensil _ c)  =  c

getNumber :: Goods -> Int
getNumber (Stool n _)  =  n
getNumber (Pensil n _)  =  n

isStool :: Goods -> Bool
isStool (Stool _ _)  =  True
isStool _  =  False

readGoods :: Int -> String -> Goods
readGoods n line  =  case words line of
    [s, "1"]  ->  Stool n (read s)
    [s, "2"]  ->  Pensil n (read s)
    _  ->  error "readGoods: unknown line"

solve :: Int -> [Goods] -> (Double, [[Int]])
solve k goods
  | n < k  =  (0.5 * sums stools + sums pensils,
    (getNumbers $ map (\s -> [s]) stools)
    ++ (map (\s -> [getNumber s]) $ take (k - n - 1) pensils) ++ (getNumbers [drop (k-n-1) pensils]))
  | otherwise  =  (0.5 * sums stools' + sums stools'' + sums pensils
    - 0.5 * mins (stools'' ++ pensils),
    (map (\s -> [getNumber s]) stools')
    ++ (getNumbers [stools'' ++ pensils]))
  where
    (stools, pensils)  =  partition isStool goods
    n  =  length stools
    sortedStools  =  sortBy (flip compare) stools
    (stools', stools'')  =  splitAt (k-1) sortedStools
    sums  =  fromIntegral . sum . map getCost
    mins  =  fromIntegral . minimum . map getCost
    getNumbers :: [[Goods]] -> [[Int]]
    getNumbers  =  map (map getNumber)

printAns :: (Double, [[Int]]) -> IO ()
printAns (ans, xs)  =  fPrint ans >> mapM_ prints xs
  where
    fPrint ans  =  putStrLn $ concat [show d, ".", show e]
      where
        (d, d')  =  properFraction ans
        (e, e')  =  properFraction (10 * d')
    prints xs  =  prints' (length xs : xs)
    prints' [x]  =  putStrLn $ show x
    prints' (x:xs)  =  putStr (concat [show x, " "]) >> prints' xs

main :: IO ()
main  =  do
    [n, k]  <-  liftM (map read . words) getLine
    goods  <-  mapM (\i -> liftM (readGoods i) getLine) [1..n]
    printAns $ solve k goods

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Control.Monad
import Text.Printf
import Data.List
import Data.Int

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> (Int64, [[Int]])

solve ss ps k | length ss < k = let
    (ps1, ps2) = splitAt (k - length ss - 1) ps

    res = [ [i] | (s, i) <- ss ] ++
          [ [i] | (p, i) <- ps1 ] ++
          [ [ i | (p, i) <- ps2 ] ]

    cost = sum . map (fromIntegral . fst) $ ss

    in (cost, res)

solve ss0 ps k = let
    ss = reverse . sort $ ss0
    (ss1, ss2) = splitAt (k - 1) ss

    res = [ [i] | (s, i) <- ss1 ] ++
          [ [i | (s, i) <- ss2 ] ++ [ i | (p, i) <- ps ] ]

    cost1 = sum . map (fromIntegral . fst) $ ss1
    cost2 = minimum $ [fromIntegral s | (s, i) <- ss2 ] ++ [ fromIntegral p | (p, i) <- ps ]

    in (cost1 + cost2, res)

readInt = fst . fromJust . BS.readInt

main = do
    [n, k] <- liftM (map readInt . BS.words) BS.getLine
    list <- forM [1..n] $ \i -> do
        [x, y] <- liftM (map readInt . BS.words) BS.getLine
        return (x, y, i)

    let slist = [ (x, i) | (x, y, i) <- list, y == 1]
    let plist = [ (x, i) | (x, y, i) <- list, y == 2]

    let (ans, res) = solve slist plist k
    let total = (sum . map (fromIntegral . fst) $ slist)
              + (sum . map (fromIntegral . fst) $ plist) :: Int64
    let ans' = fromIntegral total - fromIntegral ans / 2 :: Double

    putStrLn $ printf "%.1f" ans'
    forM_ res $ \l -> do
        putStr . show $ length l
        forM_ l $ \x -> putStr $ " " ++ show x
        putStrLn ""

import Control.Monad (liftM)
import List (partition, sortBy)

--------------------------------------------------------------------------------
{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "#1" $ assertEq (5.5, [[3], [1,2]]) $
        solve 2 [Stool 1 2, Pensil 2 3, Stool 3 3],
    Test "#2" $ assertEq (8.0, [[1], [2], [3,4]]) $
        solve 3 [Stool 1 4, Pensil 2 1, Pensil 3 2, Pensil 4 3]
  ]

testOneBasket :: Test
testOneBasket  =  TestList "TestOneBasket"
  [
    Test "#1" $ assertEq (5.0, [[1]]) $
        solve 1 [Stool 1 10],
    Test "#2" $ assertEq (10.0, [[1]]) $
        solve 1 [Pensil 1 10],
    Test "#3" $ assertEq (25.0, [[2,1]]) $
        solve 1 [Stool 1 10, Stool 2 20],
    Test "#4" $ assertEq (30.0, [[1,2]]) $
        solve 1 [Pensil 1 10, Pensil 2 20],
    Test "#5" $ assertEq (25.0, [[1,2]]) $
        solve 1 [Stool 1 10, Pensil 2 20],
    Test "#6" $ assertEq (25.0, [[2,1]]) $
        solve 1 [Pensil 1 10, Stool 2 20]
  ]

testMoreBaskets :: Test
testMoreBaskets  =  TestList "TestMoreBaskets"
  [
    Test "#1" $ assertEq (4.5, [[2], [1]]) $
        solve 2 [Stool 1 3, Stool 2 6],
    Test "#2" $ assertEq (7.5, [[1], [2]]) $
        solve 2 [Stool 1 3, Pensil 2 6],
    Test "#3" $ assertEq (9.0, [[1], [2]]) $
        solve 2 [Pensil 1 3, Pensil 2 6],
    Test "#4" $ assertEq (22.0, [[4], [3,2,1]]) $
        solve 2 [Stool 1 3, Stool 2 6, Stool 3 9, Stool 4 11],
    Test "#5" $ assertEq (22.5, [[3], [2,1,4]]) $
        solve 2 [Stool 1 3, Stool 2 6, Stool 3 8, Pensil 4 11],
    Test "#6" $ assertEq (17.5, [[2], [1,3,4]]) $
        solve 2 [Stool 1 3, Stool 2 6, Pensil 3 1, Pensil 4 11],
    Test "#7" $ assertEq (19.5, [[1], [2,3,4]]) $
        solve 2 [Stool 1 3, Pensil 2 6, Pensil 3 1, Pensil 4 11],
    Test "#8" $ assertEq (21.0, [[1], [2,3,4]]) $
        solve 2 [Pensil 1 3, Pensil 2 6, Pensil 3 1, Pensil 4 11]
  ]

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    testOneBasket,
    testMoreBaskets
  ]
-}
--------------------------------------------------------------------------------

data Goods  =  Stool Int Integer | Pensil Int Integer
    deriving Eq

instance Ord Goods
  where
    compare a b  =  compare (getCost a) (getCost b)

getCost :: Goods -> Integer
getCost (Stool _ c)  =  c
getCost (Pensil _ c)  =  c

getNumber :: Goods -> Int
getNumber (Stool n _)  =  n
getNumber (Pensil n _)  =  n

isStool :: Goods -> Bool
isStool (Stool _ _)  =  True
isStool _  =  False

readGoods :: Int -> String -> Goods
readGoods n line  =  case words line of
    [s, "1"]  ->  Stool n (read s)
    [s, "2"]  ->  Pensil n (read s)
    _  ->  error "readGoods: unknown line"

solve :: Int -> [Goods] -> (Double, [[Int]])
solve k goods
  | n < k  =  (0.5 * sums stools + sums pensils,
    (getNumbers $ map (\s -> [s]) stools)
    ++ (map (\s -> [getNumber s]) $ take (k - n - 1) pensils) ++ (getNumbers [drop (k-n-1) pensils]))
  | otherwise  =  (0.5 * sums stools' + sums stools'' + sums pensils
    - 0.5 * mins (stools'' ++ pensils),
    (map (\s -> [getNumber s]) stools')
    ++ (getNumbers [stools'' ++ pensils]))
  where
    (stools, pensils)  =  partition isStool goods
    n  =  length stools
    sortedStools  =  sortBy (flip compare) stools
    (stools', stools'')  =  splitAt (k-1) sortedStools
    sums  =  fromIntegral . sum . map getCost
    mins  =  fromIntegral . minimum . map getCost
    getNumbers :: [[Goods]] -> [[Int]]
    getNumbers  =  map (map getNumber)

printAns :: (Double, [[Int]]) -> IO ()
printAns (ans, xs)  =  print ans >> mapM_ prints xs
  where
    prints xs  =  prints' (length xs : xs)
    prints' [x]  =  putStrLn $ show x
    prints' (x:xs)  =  putStr (concat [show x, " "]) >> prints' xs

main :: IO ()
main  =  do
    [n, k]  <-  liftM (map read . words) getLine
    goods  <-  mapM (\i -> liftM (readGoods i) getLine) [1..n]
    printAns $ solve k goods

import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Control.Monad
import Text.Printf
import Data.List

solve :: [(Int, Int)] -> [(Int, Int)] -> Int -> (Int, [[Int]])

solve ss ps k | length ss < k = let
    (ps1, ps2) = splitAt (k - length ss - 1) ps

    res = [ [i] | (s, i) <- ss ] ++
          [ [i] | (p, i) <- ps1 ] ++
          [ [ i | (p, i) <- ps2 ] ]

    cost = sum . map fst $ ss

    in (cost, res)

solve ss0 ps k = let
    ss = reverse . sort $ ss0
    (ss1, ss2) = splitAt (k - 1) ss

    res = [ [i] | (s, i) <- ss1 ] ++
          [ [i | (s, i) <- ss2 ] ++ [ i | (p, i) <- ps ] ]

    cost1 = sum . map fst $ ss1
    cost2 = minimum $ [s | (s, i) <- ss2 ] ++ [ p | (p, i) <- ps ]

    in (cost1 + cost2, res)

readInt = fst . fromJust . BS.readInt

main = do
    [n, k] <- liftM (map readInt . BS.words) BS.getLine
    list <- forM [1..n] $ \i -> do
        [x, y] <- liftM (map readInt . BS.words) BS.getLine
        return (x, y, i)

    let slist = [ (x, i) | (x, y, i) <- list, y == 1]
    let plist = [ (x, i) | (x, y, i) <- list, y == 2]

    let (ans, res) = solve slist plist k
    let ans' = fromIntegral (sum (map fst slist ++ map fst plist)) - fromIntegral ans / 2 :: Double

    putStrLn $ printf "%.1f" ans'
    forM_ res $ \l -> do
        putStr . show $ length l
        forM_ l $ \x -> putStr $ " " ++ show x
        putStrLn ""