Alice gave Bob two integers $$$a$$$ and $$$b$$$ ($$$a > 0$$$ and $$$b \ge 0$$$). Being a curious boy, Bob wrote down an array of non-negative integers with $$$\operatorname{MEX}$$$ value of all elements equal to $$$a$$$ and $$$\operatorname{XOR}$$$ value of all elements equal to $$$b$$$.What is the shortest possible length of the array Bob wrote?Recall that the $$$\operatorname{MEX}$$$ (Minimum EXcluded) of an array is the minimum non-negative integer that does not belong to the array and the $$$\operatorname{XOR}$$$ of an array is the bitwise XOR of all the elements of the array.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 5 \cdot 10^4$$$) — the number of test cases. The description of the test cases follows. The only line of each test case contains two integers $$$a$$$ and $$$b$$$ ($$$1 \leq a \leq 3 \cdot 10^5$$$; $$$0 \leq b \leq 3 \cdot 10^5$$$) — the $$$\operatorname{MEX}$$$ and $$$\operatorname{XOR}$$$ of the array, respectively.

For each test case, output one (positive) integer — the length of the shortest array with $$$\operatorname{MEX}$$$ $$$a$$$ and $$$\operatorname{XOR}$$$ $$$b$$$. We can show that such an array always exists.

NoteIn the first test case, one of the shortest arrays with $$$\operatorname{MEX}$$$ $$$1$$$ and $$$\operatorname{XOR}$$$ $$$1$$$ is $$$[0, 2020, 2021]$$$.In the second test case, one of the shortest arrays with $$$\operatorname{MEX}$$$ $$$2$$$ and $$$\operatorname{XOR}$$$ $$$1$$$ is $$$[0, 1]$$$.It can be shown that these arrays are the shortest arrays possible.

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


There are $$$n$$$ cats in a line, labeled from $$$1$$$ to $$$n$$$, with the $$$i$$$-th cat at position $$$i$$$. They are bored of gyrating in the same spot all day, so they want to reorder themselves such that no cat is in the same place as before. They are also lazy, so they want to minimize the total distance they move. Help them decide what cat should be at each location after the reordering.For example, if there are $$$3$$$ cats, this is a valid reordering: $$$[3, 1, 2]$$$. No cat is in its original position. The total distance the cats move is $$$1 + 1 + 2 = 4$$$ as cat $$$1$$$ moves one place to the right, cat $$$2$$$ moves one place to the right, and cat $$$3$$$ moves two places to the left.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first and only line of each test case contains one integer $$$n$$$ ($$$2 \leq n \leq 100$$$) — the number of cats. It can be proven that under the constraints of the problem, an answer always exist.

Output $$$t$$$ answers, one for each test case. Each answer consists of $$$n$$$ integers — a permutation with the minimum total distance. If there are multiple answers, print any.

NoteFor the first test case, there is only one possible permutation that satisfies the conditions: $$$[2, 1]$$$.The second test case was described in the statement. Another possible answer is $$$[2, 3, 1]$$$.

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


You are given n points on a plane. All the points are distinct and no three of them lie on the same line. Find the number of parallelograms with the vertices at the given points.

The first line of the input contains integer n (1 ≤ n ≤ 2000) — the number of points. Each of the next n lines contains two integers (xi, yi) (0 ≤ xi, yi ≤ 109) — the coordinates of the i-th point.

Print the only integer c — the number of parallelograms with the vertices at the given points.

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Int (Int64)
import Data.List (tails, sort, group)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents)

import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

data Point = Point !Int !Int deriving (Ord, Eq, Show)

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n] <- readInts
  ps <- replicateM n ((\[a, b] -> Point a b) <$> readInts)
  gen <- newStdGen

  let
    r = sum $ map count $ map length $ group $ qsort gen [f p q | (p:ps') <- tails ps, q <- ps']
      where
        f (Point x1 y1) (Point x2 y2)
          | x == 0 = Point (abs y) x
          | otherwise = if x < 0 then Point (-y) (-x) else Point y x
          where
            x = x2-x1
            y = y2-y1

        count c = c'*(c'-1) `div` 2
          where c' = fromIntegral c :: Int64

  print $ r `div` 2

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

import Control.Applicative ((<$>))
import Control.Monad (replicateM)
import Data.ByteString.Char8 (words, lines, readInt, getLine, getContents)
import Data.Int (Int64)
import Data.List (tails, sort, group)
import Data.Maybe (fromJust)
import Prelude hiding (words, lines, getLine, getContents)

import System.Random

import Control.Monad (when)
import Control.Monad.ST.Safe (ST, runST)
import Data.Array (elems)
import Data.Array.MArray.Safe (getElems, newListArray, readArray, writeArray)
import Data.Array.ST.Safe (STArray, runSTArray)
import Data.STRef (newSTRef, readSTRef, writeSTRef, modifySTRef)
import Data.Ord (comparing)

readInt' = fst . fromJust . readInt
readInts = map readInt' . words <$> getLine

data Point = Point !Int !Int deriving (Ord, Eq)

qsort gen xs = elems $ runSTArray $ do
    let n = length xs
    a <- newListArray (1, n) xs
    gr <- newSTRef gen

    let sort' l r = when (l < r) $ do
        g <- readSTRef gr
        let (x, g') = randomR (l, r-1) g
        writeSTRef gr g'

        s <- readArray a x

        let loop i j
              | i > j = return (i, j)
              | otherwise = do
                ai <- readArray a i
                aj <- readArray a j
                case () of
                  _ | ai < s -> loop (i+1) j
                    | aj > s -> loop i (j-1)
                    | otherwise -> do
                        writeArray a i aj
                        writeArray a j ai
                        loop (i+1) (j-1)

        (i, j) <- loop l r

        sort' l j
        sort' i r

    sort' 1 n
    return a

main = do
  [n] <- readInts
  ps <- replicateM n ((\[a, b] -> Point a b) <$> readInts)
  gen <- newStdGen

  let
    r = sum $ map count $ map length $ group $ qsort gen [f p q | (p:ps') <- tails ps, q <- ps']
      where
        f (Point x1 y1) (Point x2 y2) = if x < 0 then Point (-y) (-x) else Point y x
          where
            x = x2-x1
            y = y2-y1

        count c = c'*(c'-1) `div` 2
          where c' = fromIntegral c :: Int64

  print $ r `div` 2


The Cybernetics Failures (CF) organisation made a prototype of a bomb technician robot. To find the possible problems it was decided to carry out a series of tests. At the beginning of each test the robot prototype will be placed in cell (x0, y0) of a rectangular squared field of size x × y, after that a mine will be installed into one of the squares of the field. It is supposed to conduct exactly x·y tests, each time a mine is installed into a square that has never been used before. The starting cell of the robot always remains the same.After placing the objects on the field the robot will have to run a sequence of commands given by string s, consisting only of characters 'L', 'R', 'U', 'D'. These commands tell the robot to move one square to the left, to the right, up or down, or stay idle if moving in the given direction is impossible. As soon as the robot fulfills all the sequence of commands, it will blow up due to a bug in the code. But if at some moment of time the robot is at the same square with the mine, it will also blow up, but not due to a bug in the code.Moving to the left decreases coordinate y, and moving to the right increases it. Similarly, moving up decreases the x coordinate, and moving down increases it.The tests can go on for very long, so your task is to predict their results. For each k from 0 to length(s) your task is to find in how many tests the robot will run exactly k commands before it blows up.

The first line of the input contains four integers x, y, x0, y0 (1 ≤ x, y ≤ 500, 1 ≤ x0 ≤ x, 1 ≤ y0 ≤ y) — the sizes of the field and the starting coordinates of the robot. The coordinate axis X is directed downwards and axis Y is directed to the right. The second line contains a sequence of commands s, which should be fulfilled by the robot. It has length from 1 to 100 000 characters and only consists of characters 'L', 'R', 'U', 'D'.

Print the sequence consisting of (length(s) + 1) numbers. On the k-th position, starting with zero, print the number of tests where the robot will run exactly k commands before it blows up.

NoteIn the first sample, if we exclude the probable impact of the mines, the robot's route will look like that: .

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

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

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

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

{-# 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])


You have array a1, a2, ..., an. Segment [l, r] (1 ≤ l ≤ r ≤ n) is good if ai = ai - 1 + ai - 2, for all i (l + 2 ≤ i ≤ r).Let's define len([l, r]) = r - l + 1, len([l, r]) is the length of the segment [l, r]. Segment [l1, r1], is longer than segment [l2, r2], if len([l1, r1]) > len([l2, r2]).Your task is to find a good segment of the maximum length in array a. Note that a segment of length 1 or 2 is always good.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of elements in the array. The second line contains integers: a1, a2, ..., an (0 ≤ ai ≤ 109).

Print the length of the longest good segment in array a.

{-# 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 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')

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)


Sayaka Saeki is a member of the student council, which has $$$n$$$ other members (excluding Sayaka). The $$$i$$$-th member has a height of $$$a_i$$$ millimeters.It's the end of the school year and Sayaka wants to take a picture of all other members of the student council. Being the hard-working and perfectionist girl as she is, she wants to arrange all the members in a line such that the amount of photogenic consecutive pairs of members is as large as possible.A pair of two consecutive members $$$u$$$ and $$$v$$$ on a line is considered photogenic if their average height is an integer, i.e. $$$\frac{a_u + a_v}{2}$$$ is an integer.Help Sayaka arrange the other members to maximize the number of photogenic consecutive pairs.

The first line contains a single integer $$$t$$$ ($$$1\le t\le 500$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 2000$$$)  — the number of other council members. The second line of each test case contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, ..., $$$a_n$$$ ($$$1 \le a_i \le 2 \cdot 10^5$$$)  — the heights of each of the other members in millimeters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$.

For each test case, output on one line $$$n$$$ integers representing the heights of the other members in the order, which gives the largest number of photogenic consecutive pairs. If there are multiple such orders, output any of them.

NoteIn the first test case, there is one photogenic pair: $$$(1, 1)$$$ is photogenic, as $$$\frac{1+1}{2}=1$$$ is integer, while $$$(1, 2)$$$ isn't, as $$$\frac{1+2}{2}=1.5$$$ isn't integer.In the second test case, both pairs are photogenic.

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


This is an interactive problem.Kochiya Sanae is playing with magnets. Realizing that some of those magnets are demagnetized, she is curious to find them out.There are $$$n$$$ magnets, which can be of the following $$$3$$$ types: N  S  - — these magnets are demagnetized. Note that you don't know the types of these magnets beforehand.You have a machine which can measure the force between the magnets, and you can use it at most $$$n+\lfloor \log_2n\rfloor$$$ times.You can put some magnets to the left part of the machine and some to the right part of the machine, and launch the machine. Obviously, you can put one magnet to at most one side (you don't have to put all magnets). You can put the same magnet in different queries.Then the machine will tell the force these magnets produce. Formally, let $$$n_1,s_1$$$ be the number of N and S magnets correspondently on the left and $$$n_2,s_2$$$ — on the right. Then the force between them would be $$$n_1n_2+s_1s_2-n_1s_2-n_2s_1$$$. Please note that the force is a signed value.However, when the absolute value of the force is strictly larger than $$$n$$$, the machine will crash into pieces.You need to find all magnets of type - (all demagnetized ones), without breaking the machine.Note that the interactor is not adaptive. The types of the magnets are fixed before the start of the interaction and do not change with queries.It is guaranteed that there are at least $$$2$$$ magnets whose type is not -, and at least $$$1$$$ magnet of type -.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases.

NoteThe empty lines in the sample are just for you to better understand the interaction process. You're not required to print them.In the sample, the types of the magnets are NN--.At first, you put the third magnet on the left and the fourth one on the right. Both of them have type -, thus no force is produced.Then you put the first magnet on the left and the second and third one on the right. The third magnet has type -, while the other two magnets are of type N, so the force produced is $$$1$$$.In the following two queries, the force is $$$0$$$ since there is only a magnet with property - on the right.Then we can determine that the magnets of type - are the third and the fourth one, so we should print ! 2 3 4 and exit.

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

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

query :: [Int] -> [Int] -> SIO Int
query ls rs = do
  lift $ P.putStr $ P.pack "? "
  putInts $ map length [ls, rs]
  putInts ls
  putInts rs
  lift $ hFlush stdout
  [ans] <- readInts
  pure ans

findSecondCharge :: SIO Int
findSecondCharge = let
  go next prevs = do
    resp <- query [next] prevs
    if  resp == 0
      then  go (next + 1) (next : prevs)
      else  pure next
  in  go 2 [1]

findFirstCharge :: Int -> SIO Int
findFirstCharge sc = let
  go [] = error "???"
  go [x] = pure x
  go opts = do
    let
      (a1, a2) = partition snd $ zip opts $ cycle [True, False]
      [o1, o2] = map (map fst) [a1, a2]
    ans <- query [sc] o1
    go $ if  ans == 0  then  o2  else  o1
  in  go [1 .. sc - 1]

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    sc <- findSecondCharge
    fc <- findFirstCharge sc
    laterqs <- forM [sc + 1 .. n] $ \i -> (,) i <$> query [sc] [i]
    let
      allNulls = filter (/= fc) [1 .. sc-1] ++ [i | (i, a) <- laterqs, a == 0]
    lift $ P.putStr $ P.pack "! "
    putInts $ length allNulls : allNulls
    lift $ hFlush stdout

type SIO = StateT P.ByteString IO

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

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

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder


You are given an array $$$a$$$ consisting of $$$n$$$ integers.Your task is to determine if $$$a$$$ has some subsequence of length at least $$$3$$$ that is a palindrome.Recall that an array $$$b$$$ is called a subsequence of the array $$$a$$$ if $$$b$$$ can be obtained by removing some (possibly, zero) elements from $$$a$$$ (not necessarily consecutive) without changing the order of remaining elements. For example, $$$[2]$$$, $$$[1, 2, 1, 3]$$$ and $$$[2, 3]$$$ are subsequences of $$$[1, 2, 1, 3]$$$, but $$$[1, 1, 2]$$$ and $$$[4]$$$ are not.Also, recall that a palindrome is an array that reads the same backward as forward. In other words, the array $$$a$$$ of length $$$n$$$ is the palindrome if $$$a_i = a_{n - i - 1}$$$ for all $$$i$$$ from $$$1$$$ to $$$n$$$. For example, arrays $$$[1234]$$$, $$$[1, 2, 1]$$$, $$$[1, 3, 2, 2, 3, 1]$$$ and $$$[10, 100, 10]$$$ are palindromes, but arrays $$$[1, 2]$$$ and $$$[1, 2, 3, 1]$$$ are not.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Next $$$2t$$$ lines describe test cases. The first line of the test case contains one integer $$$n$$$ ($$$3 \le n \le 5000$$$) — the length of $$$a$$$. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$5000$$$ ($$$\sum n \le 5000$$$).

For each test case, print the answer — "YES" (without quotes) if $$$a$$$ has some subsequence of length at least $$$3$$$ that is a palindrome and "NO" otherwise.

NoteIn the first test case of the example, the array $$$a$$$ has a subsequence $$$[1, 2, 1]$$$ which is a palindrome.In the second test case of the example, the array $$$a$$$ has two subsequences of length $$$3$$$ which are palindromes: $$$[2, 3, 2]$$$ and $$$[2, 2, 2]$$$.In the third test case of the example, the array $$$a$$$ has no subsequences of length at least $$$3$$$ which are palindromes.In the fourth test case of the example, the array $$$a$$$ has one subsequence of length $$$4$$$ which is a palindrome: $$$[1, 2, 2, 1]$$$ (and has two subsequences of length $$$3$$$ which are palindromes: both are $$$[1, 2, 1]$$$).In the fifth test case of the example, the array $$$a$$$ has no subsequences of length at least $$$3$$$ which are palindromes.

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

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

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


Given a positive integer $$$n$$$. Find three distinct positive integers $$$a$$$, $$$b$$$, $$$c$$$ such that $$$a + b + c = n$$$ and $$$\operatorname{gcd}(a, b) = c$$$, where $$$\operatorname{gcd}(x, y)$$$ denotes the greatest common divisor (GCD) of integers $$$x$$$ and $$$y$$$.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Description of the test cases follows. The first and only line of each test case contains a single integer $$$n$$$ ($$$10 \le n \le 10^9$$$).

For each test case, output three distinct positive integers $$$a$$$, $$$b$$$, $$$c$$$ satisfying the requirements. If there are multiple solutions, you can print any. We can show that an answer always exists.

NoteIn the first test case, $$$6 + 9 + 3 = 18$$$ and $$$\operatorname{gcd}(6, 9) = 3$$$.In the second test case, $$$21 + 39 + 3 = 63$$$ and $$$\operatorname{gcd}(21, 39) = 3$$$.In the third test case, $$$29 + 43 + 1 = 73$$$ and $$$\operatorname{gcd}(29, 43) = 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
    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


Suppose you have two points $$$p = (x_p, y_p)$$$ and $$$q = (x_q, y_q)$$$. Let's denote the Manhattan distance between them as $$$d(p, q) = |x_p - x_q| + |y_p - y_q|$$$.Let's say that three points $$$p$$$, $$$q$$$, $$$r$$$ form a bad triple if $$$d(p, r) = d(p, q) + d(q, r)$$$.Let's say that an array $$$b_1, b_2, \dots, b_m$$$ is good if it is impossible to choose three distinct indices $$$i$$$, $$$j$$$, $$$k$$$ such that the points $$$(b_i, i)$$$, $$$(b_j, j)$$$ and $$$(b_k, k)$$$ form a bad triple.You are given an array $$$a_1, a_2, \dots, a_n$$$. Calculate the number of good subarrays of $$$a$$$. A subarray of the array $$$a$$$ is the array $$$a_l, a_{l + 1}, \dots, a_r$$$ for some $$$1 \le l \le r \le n$$$.Note that, according to the definition, subarrays of length $$$1$$$ and $$$2$$$ are good.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 5000$$$) — the number of test cases. The first line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of array $$$a$$$. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). It's guaranteed that the sum of $$$n$$$ doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print the number of good subarrays of array $$$a$$$.

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
                ]


YouKn0wWho has an integer sequence $$$a_1, a_2, \ldots a_n$$$. Now he will split the sequence $$$a$$$ into one or more consecutive subarrays so that each element of $$$a$$$ belongs to exactly one subarray. Let $$$k$$$ be the number of resulting subarrays, and $$$h_1, h_2, \ldots, h_k$$$ be the lengths of the longest increasing subsequences of corresponding subarrays.For example, if we split $$$[2, 5, 3, 1, 4, 3, 2, 2, 5, 1]$$$ into $$$[2, 5, 3, 1, 4]$$$, $$$[3, 2, 2, 5]$$$, $$$[1]$$$, then $$$h = [3, 2, 1]$$$.YouKn0wWho wonders if it is possible to split the sequence $$$a$$$ in such a way that the bitwise XOR of $$$h_1, h_2, \ldots, h_k$$$ is equal to $$$0$$$. You have to tell whether it is possible.The longest increasing subsequence (LIS) of a sequence $$$b_1, b_2, \ldots, b_m$$$ is the longest sequence of valid indices $$$i_1, i_2, \ldots, i_k$$$ such that $$$i_1 \lt i_2 \lt \ldots \lt i_k$$$ and $$$b_{i_1} \lt b_{i_2} \lt \ldots \lt b_{i_k}$$$. For example, the LIS of $$$[2, 5, 3, 3, 5]$$$ is $$$[2, 3, 5]$$$, which has length $$$3$$$.An array $$$c$$$ is a subarray of an array $$$b$$$ if $$$c$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$)  — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$2 \le n \le 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3 \cdot 10^5$$$.

For each test case, print "YES" (without quotes) if it is possible to split into subarrays in the desired way, print "NO" (without quotes) otherwise. You can print each letter in any register (upper or lower).

NoteIn the first test case, YouKn0wWho can split the sequence in the following way: $$$[1, 3, 4]$$$, $$$[2, 2]$$$, $$$[1, 5]$$$. This way, the LIS lengths are $$$h = [3, 1, 2]$$$, and the bitwise XOR of the LIS lengths is $$$3 \oplus 1 \oplus 2 = 0$$$.In the second test case, it can be shown that it is impossible to split the sequence into subarrays that will satisfy the condition.

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

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

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

data TC = TC { n :: Int, as :: [Int] }

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  return TC {..}

type Output = Bool

output :: Output -> C.ByteString
output = bool "No" "Yes" >>> C.pack

solve :: TC -> Output
solve TC {..} = even n || not (sorted as)

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

sorted :: (Ord a) => [a] -> Bool
sorted = and . adjacentsWith (<)

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


A positive (strictly greater than zero) integer is called round if it is of the form d00...0. In other words, a positive integer is round if all its digits except the leftmost (most significant) are equal to zero. In particular, all numbers from $$$1$$$ to $$$9$$$ (inclusive) are round.For example, the following numbers are round: $$$4000$$$, $$$1$$$, $$$9$$$, $$$800$$$, $$$90$$$. The following numbers are not round: $$$110$$$, $$$707$$$, $$$222$$$, $$$1001$$$.You are given a positive integer $$$n$$$ ($$$1 \le n \le 10^4$$$). Represent the number $$$n$$$ as a sum of round numbers using the minimum number of summands (addends). In other words, you need to represent the given number $$$n$$$ as a sum of the least number of terms, each of which is a round number.

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the input. Then $$$t$$$ test cases follow. Each test case is a line containing an integer $$$n$$$ ($$$1 \le n \le 10^4$$$).

Print $$$t$$$ answers to the test cases. Each answer must begin with an integer $$$k$$$ — the minimum number of summands. Next, $$$k$$$ terms must follow, each of which is a round number, and their sum is $$$n$$$. The terms can be printed in any order. If there are several answers, print any of them.

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.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.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
            ans = filter (>0) [x, y, z, t]
        print $ length $ ans
        printList $ ans


Nikephoros and Polycarpus play rock-paper-scissors. The loser gets pinched (not too severely!).Let us remind you the rules of this game. Rock-paper-scissors is played by two players. In each round the players choose one of three items independently from each other. They show the items with their hands: a rock, scissors or paper. The winner is determined by the following rules: the rock beats the scissors, the scissors beat the paper and the paper beats the rock. If the players choose the same item, the round finishes with a draw.Nikephoros and Polycarpus have played n rounds. In each round the winner gave the loser a friendly pinch and the loser ended up with a fresh and new red spot on his body. If the round finished in a draw, the players did nothing and just played on.Nikephoros turned out to have worked out the following strategy: before the game began, he chose some sequence of items A = (a1, a2, ..., am), and then he cyclically showed the items from this sequence, starting from the first one. Cyclically means that Nikephoros shows signs in the following order: a1, a2, ..., am, a1, a2, ..., am, a1, ... and so on. Polycarpus had a similar strategy, only he had his own sequence of items B = (b1, b2, ..., bk).Determine the number of red spots on both players after they've played n rounds of the game. You can consider that when the game began, the boys had no red spots on them.

The first line contains integer n (1 ≤ n ≤ 2·109) — the number of the game's rounds. The second line contains sequence A as a string of m characters and the third line contains sequence B as a string of k characters (1 ≤ m, k ≤ 1000). The given lines only contain characters "R", "S" and "P". Character "R" stands for the rock, character "S" represents the scissors and "P" represents the paper.

Print two space-separated integers: the numbers of red spots Nikephoros and Polycarpus have.

NoteIn the first sample the game went like this:  R - R. Draw.  P - S. Nikephoros loses.  S - P. Polycarpus loses.  R - P. Nikephoros loses.  P - R. Polycarpus loses.  S - S. Draw.  R - P. Nikephoros loses. Thus, in total Nikephoros has 3 losses (and 3 red spots), and Polycarpus only has 2.

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

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

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)

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)


Team Red and Team Blue competed in a competitive FPS. Their match was streamed around the world. They played a series of $$$n$$$ matches.In the end, it turned out Team Red won $$$r$$$ times and Team Blue won $$$b$$$ times. Team Blue was less skilled than Team Red, so $$$b$$$ was strictly less than $$$r$$$.You missed the stream since you overslept, but you think that the match must have been neck and neck since so many people watched it. So you imagine a string of length $$$n$$$ where the $$$i$$$-th character denotes who won the $$$i$$$-th match  — it is R if Team Red won or B if Team Blue won. You imagine the string was such that the maximum number of times a team won in a row was as small as possible. For example, in the series of matches RBBRRRB, Team Red won $$$3$$$ times in a row, which is the maximum.You must find a string satisfying the above conditions. If there are multiple answers, print any.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$)  — the number of test cases. Each test case has a single line containing three integers $$$n$$$, $$$r$$$, and $$$b$$$ ($$$3 \leq n \leq 100$$$; $$$1 \leq b < r \leq n$$$, $$$r+b=n$$$).

For each test case, output a single line containing a string satisfying the given conditions. If there are multiple answers, print any.

RBR
RRBRBRBRBR
RBRBRBRBRBR
RRRRRBRRRR
RRRBRRRBRR
RRRBRRRBRRR

NoteThe first test case of the first example gives the optimal answer for the example in the statement. The maximum number of times a team wins in a row in RBRBRBR is $$$1$$$. We cannot minimize it any further.The answer for the second test case of the second example is RRBRBRBRBR. The maximum number of times a team wins in a row is $$$2$$$, given by RR at the beginning. We cannot minimize the answer any further.

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> Int -> Int -> String
solve n r b = L.intercalate "B" rGroups
    where
        groupsCount = b + 1
        rGroupSize = r `div` groupsCount
        xGroupsCount = r `mod` groupsCount
        r2GroupSize = groupsCount - xGroupsCount
        rGroup = L.replicate rGroupSize 'R'
        xGroup = 'R' : rGroup
        rGroups = L.replicate xGroupsCount xGroup ++ replicate r2GroupSize rGroup

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        [n, r, b] <- B8.getLine <&> readIntB8s
        let answer = solve n r b
        printf "%s\n" answer


Permutation p is an ordered set of integers p1,   p2,   ...,   pn, consisting of n distinct positive integers not larger than n. We'll denote as n the length of permutation p1,   p2,   ...,   pn.Your task is to find such permutation p of length n, that the group of numbers |p1 - p2|, |p2 - p3|, ..., |pn - 1 - pn| has exactly k distinct elements.

The single line of the input contains two space-separated positive integers n, k (1 ≤ k < n ≤ 105).

Print n integers forming the permutation. If there are multiple answers, print any of them.

NoteBy |x| we denote the absolute value of number x.

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

{-# 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)

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)


One day Polycarpus stopped by a supermarket on his way home. It turns out that the supermarket is having a special offer for stools. The offer is as follows: if a customer's shopping cart contains at least one stool, the customer gets a 50% discount on the cheapest item in the cart (that is, it becomes two times cheaper). If there are several items with the same minimum price, the discount is available for only one of them!Polycarpus has k carts, and he wants to buy up all stools and pencils from the supermarket. Help him distribute the stools and the pencils among the shopping carts, so that the items' total price (including the discounts) is the least possible.Polycarpus must use all k carts to purchase the items, no shopping cart can remain empty. Each shopping cart can contain an arbitrary number of stools and/or pencils.

The first input line contains two integers n and k (1 ≤ k ≤ n ≤ 103) — the number of items in the supermarket and the number of carts, correspondingly. Next n lines describe the items as "ci ti" (without the quotes), where ci (1 ≤ ci ≤ 109) is an integer denoting the price of the i-th item, ti (1 ≤ ti ≤ 2) is an integer representing the type of item i (1 for a stool and 2 for a pencil). The numbers in the lines are separated by single spaces.

In the first line print a single real number with exactly one  decimal place — the minimum total price of the items, including the discounts. In the following k lines print the descriptions of the items in the carts. In the i-th line print the description of the i-th cart as "t b1 b2 ... bt" (without the quotes), where t is the number of items in the i-th cart, and the sequence b1, b2, ..., bt (1 ≤ bj ≤ n) gives the indices of items to put in this cart in the optimal distribution. All indices of items in all carts should be pairwise different, each item must belong to exactly one cart. You can print the items in carts and the carts themselves in any order. The items are numbered from 1 to n in the order in which they are specified in the input. If there are multiple optimal distributions, you are allowed to print any of them.

NoteIn the first sample case the first cart should contain the 1st and 2nd items, and the second cart should contain the 3rd item. This way each cart has a stool and each cart has a 50% discount for the cheapest item. The total price of all items will be: 2·0.5 + (3 + 3·0.5) = 1 + 4.5 = 5.5.

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