You are preparing for an exam on scheduling theory. The exam will last for exactly T milliseconds and will consist of n problems. You can either solve problem i in exactly ti milliseconds or ignore it and spend no time. You don't need time to rest after solving a problem, either.Unfortunately, your teacher considers some of the problems too easy for you. Thus, he assigned an integer ai to every problem i meaning that the problem i can bring you a point to the final score only in case you have solved no more than ai problems overall (including problem i).Formally, suppose you solve problems p1, p2, ..., pk during the exam. Then, your final score s will be equal to the number of values of j between 1 and k such that k ≤ apj.You have guessed that the real first problem of the exam is already in front of you. Therefore, you want to choose a set of problems to solve during the exam maximizing your final score in advance. Don't forget that the exam is limited in time, and you must have enough time to solve all chosen problems. If there exist different sets of problems leading to the maximum final score, any of them will do.

The first line contains two integers n and T (1 ≤ n ≤ 2·105; 1 ≤ T ≤ 109) — the number of problems in the exam and the length of the exam in milliseconds, respectively. Each of the next n lines contains two integers ai and ti (1 ≤ ai ≤ n; 1 ≤ ti ≤ 104). The problems are numbered from 1 to n.

In the first line, output a single integer s — your maximum possible final score. In the second line, output a single integer k (0 ≤ k ≤ n) — the number of problems you should solve. In the third line, output k distinct integers p1, p2, ..., pk (1 ≤ pi ≤ n) — the indexes of problems you should solve, in any order. If there are several optimal sets of problems, you may output any of them.

NoteIn the first example, you should solve problems 3, 1, and 4. In this case you'll spend 80 + 100 + 90 = 270 milliseconds, falling within the length of the exam, 300 milliseconds (and even leaving yourself 30 milliseconds to have a rest). Problems 3 and 1 will bring you a point each, while problem 4 won't. You'll score two points.In the second example, the length of the exam is catastrophically not enough to solve even a single problem.In the third example, you have just enough time to solve both problems in 42 + 58 = 100 milliseconds and hand your solutions to the teacher with a smile.

import Control.Applicative
import Data.List as L
-- import System.IO
import Data.Maybe
import Data.ByteString.Char8 as B hiding (map, filter, foldl, foldl', take, length, sort)
-- import System.CPUTime
-- import Text.Printf
-- import Debug.Trace
-- import Criterion.Main

doDebug = False
-- debug a b = if doDebug then trace b a else a

inputExams = map (\x -> (10000 :: Int, 200000 :: Int, x)) ([1..200000] :: [Int])

getTuple :: Int -> ByteString -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (fst. fromJust . B.readInt) . B.words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> ([Int], [(Int, Int, Int)])
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            -- sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime rem
    in case length rem >= targetTime && summation <= totalTime of
            True -> ((take targetTime $ map (\(a, b, c) -> c) rem), rem) -- `debug` (show summation)
            False -> ([], []) -- `debug` (show summation)

isPossible1 :: [(Int, Int, Int)] -> Int -> Int -> [Int]
{-
isPossible1 exams targetTime totalTime = let summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime exams
    in case length exams >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) exams -- `debug` (show summation)
            False -> [] -- `debug` (show summation)
-}
isPossible1 exams targetTime totalTime = take targetTime $ [c | (a, b, c) <- exams]

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("called lo = " ++ show lo ++ ", hi = " ++ show hi) -- `debug` ("now here " ++ show mid)
        -- | poss == [] = solve (filter (\(a, b, c) -> b >= mid - 1) exams) totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi ++ ", exams = " ++ show exams)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("called lo = " ++ show lo ++ ", hi = " ++ show hi)  -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi ++ ", exams = " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve rem totalTime (mid + 1) hi) -- `debug` ("called lo = " ++ show lo ++ ", hi = " ++ show hi) -- `debug` ("otherwise " ++ show poss ++ " exams = " ++ show exams)
    where mid = (lo + hi) `div` 2
          (poss, rem) = isPossible exams mid totalTime

solve1 :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve1 exams totalTime lo hi
        | lo > hi = Nothing
        | poss == [] = Nothing
        | otherwise = Just (mid, poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible1 exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = B.putStrLn (pack "0") >> B.putStrLn (pack "0")
printRes (Just (a, b)) = do
    B.putStrLn . pack $ show a
    B.putStrLn . pack $ show a
    mapM_ (\x -> B.putStr (pack . show $ x) >> (B.putStr . pack $ " ")) b

{-
time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^9)
    printf "Computation time: %0.3f ms\n" (diff :: Double)
    return v
-}

main :: IO ()
main = do
    [n, t] <- map (fst . fromJust . readInt) . B.words <$> B.getLine
    xs <- mapM (\x -> getTuple x <$> B.getLine) [1..n]
    let exams = sort xs
        l = length xs
        -- res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = if l < 10000 then solve exams t 1 n else solve1 exams t 1 n
        res = solve exams t 1 n
    -- res <- time exams t n
    printRes res
    -- B.putStrLn . show . length $ res

{-
work :: IO ()
work = do end <- isEOF
          if end
            then do
                  B.putStrLn . show . length $ inputExams
            else do [n, t] <- map (read :: String -> Int) . words <$> getLine
                    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
                    let exams = sort xs
                        res = solve exams t 1 n
                    B.putStrLn . show . length $ res
-}

{-
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> B.getLine) [1..n]
    defaultMain [
        let exams = sort xs
        in bgroup "ispossible" [ bench "ip" $ nf (solve exams t 1) n
        -- bgroup "ispossible" [ bench "ip" $ nfIO work
                               ]
        ]
-}

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b
-- printRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = solve exams t 1 n
    printRes res

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` (show mid)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

showRes :: Maybe (Int, [Int]) -> String
showRes Nothing = "0\n0"
showRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let -- exams = sort xs
        res = if n < 1000 then solve (sort xs) t 1 n else Nothing
    putStrLn . showRes $ res

import Control.Applicative
import Data.List
import System.CPUTime
import Text.Printf
-- import Debug.Trace

-- debug = flip trace

inputExams = map (\x -> (10000 :: Int, 200000 :: Int, x)) ([1..200000] :: [Int])

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

isPossible1 :: [(Int, Int, Int)] -> Int -> Int -> [Int]
{-
isPossible1 exams targetTime totalTime = let summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime exams
    in case length exams >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) exams -- `debug` (show summation)
            False -> [] -- `debug` (show summation)
-}
isPossible1 exams targetTime totalTime = take targetTime $ [c | (a, b, c) <- exams]

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

solve1 :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve1 exams totalTime lo hi
        | lo > hi = Nothing
        | poss == [] = Nothing
        | otherwise = Just (mid, poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible1 exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b

time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^9)
    printf "Computation time: %0.3f ms\n" (diff :: Double)
    return v

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        -- res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        res = if l < 10000 then solve exams t 1 n else solve1 exams t 1 n
        -- res = solve exams t 1 n
    -- res <- time exams t n
    printRes res

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` (show mid)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

showRes :: Maybe (Int, [Int]) -> String
showRes Nothing = "0\n0"
showRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        res = if n < 1000 then solve exams t 1 n else Nothing
    putStrLn . showRes $ res

import Control.Applicative
import Data.List
import System.CPUTime
import Text.Printf
-- import Debug.Trace

-- debug = flip trace

inputExams = map (\x -> (10000 :: Int, 200000 :: Int, x)) ([1..200000] :: [Int])

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

isPossible1 :: [(Int, Int, Int)] -> Int -> Int -> [Int]
{-
isPossible1 exams targetTime totalTime = let summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime exams
    in case length exams >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) exams -- `debug` (show summation)
            False -> [] -- `debug` (show summation)
-}
isPossible1 exams targetTime totalTime = take targetTime [1..200000]

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

solve1 :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve1 exams totalTime lo hi
        | lo > hi = Nothing
        | poss == [] = Nothing
        | otherwise = Just (mid, poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible1 exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b

time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^9)
    printf "Computation time: %0.3f ms\n" (diff :: Double)
    return v

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        -- res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        res = if l < 10000 then solve exams t 1 n else solve1 exams t 1 n
        -- res = solve exams t 1 n
    -- res <- time exams t n
    printRes res

import Control.Applicative
import Data.List
-- import System.CPUTime
-- import Text.Printf
-- import Debug.Trace
-- import Criterion.Main

-- debug = flip trace

inputExams = map (\x -> (10000 :: Int, 200000 :: Int, x)) ([1..200000] :: [Int])

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> ([Int], [(Int, Int, Int)])
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> ((take targetTime $ map (\(a, b, c) -> c) sorted), rem) -- `debug` (show summation)
            False -> ([], []) -- `debug` (show summation)

isPossible1 :: [(Int, Int, Int)] -> Int -> Int -> [Int]
{-
isPossible1 exams targetTime totalTime = let summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime exams
    in case length exams >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) exams -- `debug` (show summation)
            False -> [] -- `debug` (show summation)
-}
isPossible1 exams targetTime totalTime = take targetTime $ [c | (a, b, c) <- exams]

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        -- | poss == [] = solve (filter (\(a, b, c) -> b >= mid - 1) exams) totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi ++ ", exams = " ++ show exams)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi ++ ", exams = " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve rem totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss ++ " exams = " ++ show exams)
    where mid = (lo + hi) `div` 2
          (poss, rem) = isPossible exams mid totalTime

solve1 :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve1 exams totalTime lo hi
        | lo > hi = Nothing
        | poss == [] = Nothing
        | otherwise = Just (mid, poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible1 exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b

{-
time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^9)
    printf "Computation time: %0.3f ms\n" (diff :: Double)
    return v
-}

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = if l < 10000 then solve exams t 1 n else solve1 exams t 1 n
        -- res = solve exams t 1 n
    -- res <- time exams t n
    printRes res

{-
work :: Int -> IO ()
work _ = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        res = isPossible1 exams 100000 t
    putStrLn . show $ res

main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    defaultMain [
        let exams = sort xs
        in bgroup "ispossible" [ bench "ip" $ whnf (solve exams t 1) n
        -- bgroup "ispossible" [ bench "ip" $ whnf work 1
                               ]
        ]
-}

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b
-- printRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        res = if l < 1000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = solve exams t 1 n
    printRes res

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` (show mid)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b
-- printRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        res = if n < 1000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = solve exams t 1 n
    printRes res

import Control.Applicative
import Data.List
import System.CPUTime
import Text.Printf
-- import Debug.Trace

-- debug = flip trace

inputExams = map (\x -> (10000 :: Int, 200000 :: Int, x)) ([1..200000] :: [Int])

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case length rem >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

isPossible1 :: [(Int, Int, Int)] -> Int -> Int -> [Int]
{-
isPossible1 exams targetTime totalTime = let summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime exams
    in case length exams >= targetTime && summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) exams -- `debug` (show summation)
            False -> [] -- `debug` (show summation)
-}
isPossible1 exams targetTime totalTime = take targetTime $ map (\(a, b, c) -> c) exams

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here. lo = " ++ show lo ++ " hi = " ++ show hi)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` ("otherwise " ++ show poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

solve1 :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve1 exams totalTime lo hi
        | lo > hi = Nothing
        | poss == [] = Nothing
        | otherwise = Just (mid, poss)
    where mid = (lo + hi) `div` 2
          poss = isPossible1 exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b

time :: IO t -> IO t
time a = do
    start <- getCPUTime
    v <- a
    end <- getCPUTime
    let diff = (fromIntegral (end - start)) / (10^9)
    printf "Computation time: %0.3f ms\n" (diff :: Double)
    return v

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        -- res = if l < 10000 then solve exams t 1 n else Just (100000, [1..100000])
        res = if l < 10000 then solve exams t 1 n else solve1 exams t 1 n
        -- res = solve exams t 1 n
    -- res <- time exams t n
    printRes res

-- import Data.ByteString.Char8 as BS
import Control.Applicative

getTuple :: String -> (Int, Int)
getTuple xs = (a, b)
    where [a, b] = map (read :: String -> Int) . words $ xs

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\_ -> getTuple <$> getLine) [1..n]
    putStrLn . show $ xs

import Control.Applicative
import Data.List
-- import Debug.Trace

-- debug = flip trace

getTuple :: Int -> String -> (Int, Int, Int)
getTuple n xs = (b, a, n)
    where [a, b] = map (read :: String -> Int) . words $ xs

isPossible :: [(Int, Int, Int)] -> Int -> Int -> [Int]
isPossible exams targetTime totalTime = let rem = filter (\(a, b, c) -> b >= targetTime) exams
                                            sorted = sort rem
                                            summation = foldl' (\x (a, b, c) -> x + a) 0 $ take targetTime sorted
    in case summation <= totalTime of
            True -> take targetTime $ map (\(a, b, c) -> c) sorted -- `debug` (show summation)
            False -> [] -- `debug` (show summation)

aOrB :: Maybe a -> Maybe a -> Maybe a
aOrB Nothing _ = Nothing
aOrB x Nothing = x
aOrB x y = y

solve :: [(Int, Int, Int)] -> Int -> Int -> Int -> Maybe (Int, [Int])
solve exams totalTime lo hi
        | lo > hi = Nothing -- `debug` ("now here " ++ show mid)
        | poss == [] = solve exams totalTime lo (mid - 1) -- `debug` ("here " ++ show exams)
        | otherwise = Just (mid, poss) `aOrB` (solve exams totalTime (mid + 1) hi) -- `debug` (show mid)
    where mid = (lo + hi) `div` 2
          poss = isPossible exams mid totalTime

printRes :: Maybe (Int, [Int]) -> IO ()
printRes Nothing = putStrLn "0" >> putStrLn "0"
printRes (Just (a, b)) = do
    putStrLn $ show a
    putStrLn $ show a
    mapM_ (\x -> putStr (show x) >> (putStr " ")) b
-- printRes (Just (a, b)) = (show a) ++ "\n" ++ (show a) ++ "\n" ++ (foldl' (\x n -> x ++ (show n) ++ " ") "" b)

main :: IO ()
main = do
    [n, t] <- map (read :: String -> Int) . words <$> getLine
    xs <- mapM (\x -> getTuple x <$> getLine) [1..n]
    let exams = sort xs
        l = length xs
        res = if l < 1000 then solve exams t 1 n else Just (100000, [1..100000])
        -- res = solve exams t 1 n
    printRes res


Before becoming a successful trader William got a university degree. During his education an interesting situation happened, after which William started to listen to homework assignments much more attentively. What follows is the correct formal description of the homework assignment:You are given a string $$$s$$$ of length $$$n$$$ only consisting of characters "a", "b" and "c". There are $$$q$$$ queries of format ($$$pos, c$$$), meaning replacing the element of string $$$s$$$ at position $$$pos$$$ with character $$$c$$$. After each query you must output the minimal number of characters in the string, which have to be replaced, so that the string doesn't contain string "abc" as a substring. A valid replacement of a character is replacing it with "a", "b" or "c".A string $$$x$$$ is a substring of a string $$$y$$$ if $$$x$$$ can be obtained from $$$y$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.

The first line contains two integers $$$n$$$ and $$$q$$$ $$$(1 \le n, q \le 10^5)$$$, the length of the string and the number of queries, respectively. The second line contains the string $$$s$$$, consisting of characters "a", "b" and "c". Each of the next $$$q$$$ lines contains an integer $$$i$$$ and character $$$c$$$ $$$(1 \le i \le n)$$$, index and the value of the new item in the string, respectively. It is guaranteed that character's $$$c$$$ value is "a", "b" or "c".

For each query output the minimal number of characters that would have to be replaced so that the string doesn't contain "abc" as a substring.

9 10
abcabcabc
1 a
1 b
2 c
3 a
4 b
5 c
8 a
9 b
1 c
4 a

NoteLet's consider the state of the string after each query:   $$$s =$$$ "abcabcabc". In this case $$$3$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bbcaccabb". This string does not contain "abc" as a substring. $$$s =$$$ "bbcabcabc". In this case $$$2$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bbcbbcbbc". This string does not contain "abc" as a substring. $$$s =$$$ "bccabcabc". In this case $$$2$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bccbbcbbc". This string does not contain "abc" as a substring. $$$s =$$$ "bcaabcabc". In this case $$$2$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bcabbcbbc". This string does not contain "abc" as a substring. $$$s =$$$ "bcabbcabc". In this case $$$1$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bcabbcabb". This string does not contain "abc" as a substring. $$$s =$$$ "bcabccabc". In this case $$$2$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bcabbcabb". This string does not contain "abc" as a substring. $$$s =$$$ "bcabccaac". In this case $$$1$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bcabbcaac". This string does not contain "abc" as a substring. $$$s =$$$ "bcabccaab". In this case $$$1$$$ replacements can be performed to get, for instance, string $$$s =$$$ "bcabbcaab". This string does not contain "abc" as a substring. $$$s =$$$ "ccabccaab". In this case $$$1$$$ replacements can be performed to get, for instance, string $$$s =$$$ "ccabbcaab". This string does not contain "abc" as a substring. $$$s =$$$ "ccaaccaab". In this case the string does not contain "abc" as a substring and no replacements are needed.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import System.IO
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Lazy as DM
import qualified Data.IntSet as DS
import qualified Data.List as DL

solve :: St Bu.Builder
solve = do
  ~[n,q] <- getIntegrals 2
  s <- getByteString
  queries <- replicateM q getPosChar
  let arr = DM.fromAscList $ zip [1..] (B8.unpack s)
      count = length $ filter (substr arr) [1..n]
      initial = (arr,count)
      anss = tail $ snd $ unzip $ DL.scanl' f initial queries
      builder = mconcat $ [Bu.intDec i <> Bu.string7 "\n" | i <-anss]
  return builder

type B = (DM.IntMap Char, Int)
f :: B -> (Int,Char) -> B
f (arr, count) (pos,ch)
  | DM.lookup pos arr == Just ch = (arr,count)
  | otherwise = let
    match p c a = fromEnum (substr a (p + (fromEnum 'a') - (maybe 0 fromEnum $ DM.lookup p a)))
    newArr = DM.insert pos ch arr
    decr = match pos ch arr
    incr = match pos ch newArr
    in
      (newArr, count-decr+incr)

substr :: DM.IntMap Char -> DS.Key -> Bool
substr m i = DM.lookup i m == Just 'a' && DM.lookup (i+1) m == Just 'b' && DM.lookup (i+2) m == Just 'c'

getPosChar :: St (Int,Char)
getPosChar = do
  pos <- getIntegral
  s <- getByteString
  return (pos,B8.head s)

numberOfTestcases :: St Int
numberOfTestcases = implicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc solve
        fmap mconcat answers
  Bu.hPutBuilder stdout outputs

{-# LANGUAGE BangPatterns, FlexibleContexts #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

solve :: Int -> String -> [(Int, Char)] -> [Int]
solve n s0 qs = runST $ do
  s <- strictToLazyST $ newListArray (1, n) s0 :: ST s (STUArray s Int Char)
  let
    isABC ix = boolToInt . (== "abc") <$> forM [ix .. ix + 2] (readArray s)
    boolToInt p = if  p  then  1  else  0
  initCt <- (\fun -> strictToLazyST $ foldM fun 0 [1 .. n - 2])
    $ \ !acc !ix -> (+ acc) <$> isABC ix
  incrs <- forM qs $ \(ix, c) -> strictToLazyST $ do
    let  ixs = [max 1 (ix - 2) .. min ix (n - 2)]
         localCt = sum <$> forM ixs isABC
    out <- localCt
    writeArray s ix c
    subtract out <$> localCt
  pure $ tail $ scanl' (+) initCt incrs

mainFun :: SP Builder
mainFun = do
  ~[n, q] <- getInts 2
  ~[s0] <- getNext 1
  qs <- replicateM q $ do
    ~[ix] <- getInts 1
    ~[cs] <- getNext 1
    pure (ix, P.head cs)
  pure $ foldMap (putInts . pure) $ solve n (P.unpack s0) qs

type SP = State [P.ByteString]

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

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

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

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

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import System.IO
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as DB
import qualified Data.IntMap.Lazy as DM
import qualified Data.IntSet as DS
import qualified Data.List as DL

solve :: St Bu.Builder
solve = do
  ~[n,q] <- getIntegrals 2
  s <- getByteString
  queries <- replicateM q getPosChar
  let arr = DM.fromAscList $ zip [1..] (B8.unpack s)
      count = length $ filter (substr arr) [1..n]
      initial = (arr,count)
      anss = snd $ unzip $ DL.scanl' f initial queries
      builder = mconcat $ [Bu.intDec i <> Bu.string7 "\n" | i <-anss]
  return builder

type B = (DM.IntMap Char, Int)
f :: B -> (Int,Char) -> B
f (arr, count) (pos,ch)
  | DM.lookup pos arr == Just ch = (arr,count)
  | otherwise = let
    match p c a = fromEnum (substr a (p + (fromEnum 'a') - (maybe 0 fromEnum $ DM.lookup p a)))
    newArr = DM.insert pos ch arr
    decr = match pos ch arr
    incr = match pos ch newArr
    in
      (newArr, count-decr+incr)

substr :: DM.IntMap Char -> DS.Key -> Bool
substr m i = DM.lookup i m == Just 'a' && DM.lookup (i+1) m == Just 'b' && DM.lookup (i+2) m == Just 'c'

getPosChar :: St (Int,Char)
getPosChar = do
  pos <- getIntegral
  s <- getByteString
  return (pos,B8.head s)

numberOfTestcases :: St Int
numberOfTestcases = implicit
  where implicit = return 1 :: St Int
        explicit = getIntegral

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getByteString :: St B8.ByteString
getByteString = state getNext where
  getNext [] =  (B8.take 0 (B8.pack "."),[])
  getNext (w:ws) =  (w,ws)

getIntegral :: Num t => St t
getIntegral  = convertToNum <$> getByteString where
  convertToNum x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n getIntegral

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        nTc <- numberOfTestcases
        let answers = replicateM nTc solve
        fmap mconcat answers
  Bu.hPutBuilder stdout outputs


The city of Fishtopia can be imagined as a grid of $$$4$$$ rows and an odd number of columns. It has two main villages; the first is located at the top-left cell $$$(1,1)$$$, people who stay there love fishing at the Tuna pond at the bottom-right cell $$$(4, n)$$$. The second village is located at $$$(4, 1)$$$ and its people love the Salmon pond at $$$(1, n)$$$.The mayor of Fishtopia wants to place $$$k$$$ hotels in the city, each one occupying one cell. To allow people to enter the city from anywhere, hotels should not be placed on the border cells.A person can move from one cell to another if those cells are not occupied by hotels and share a side.Can you help the mayor place the hotels in a way such that there are equal number of shortest paths from each village to its preferred pond?

The first line of input contain two integers, $$$n$$$ and $$$k$$$ ($$$3 \leq n \leq 99$$$, $$$0 \leq k \leq 2\times(n-2)$$$), $$$n$$$ is odd, the width of the city, and the number of hotels to be placed, respectively.

Print "YES", if it is possible to place all the hotels in a way that satisfies the problem statement, otherwise print "NO". If it is possible, print an extra $$$4$$$ lines that describe the city, each line should have $$$n$$$ characters, each of which is "#" if that cell has a hotel on it, or "." if not.

main = do
  [n,k] <- fmap (map read . words) getLine
  putStrLn (solve n k)

solve :: Int -> Int -> String
solve n k =
  if even k
    then unlines ["YES",border,even1,even1,border]
    else if k <= n-2
            then unlines["YES",border,odd1,border,border]
            else unlines["YES",border,hotel1,odd2,border]
  where
    dots = repeat '.'
    hotels = repeat '#'

    border = take n dots
    even1  = take n $ '.' : (take (k`div`2) hotels) ++ dots
    odd1   = take n $ take ((n-k)`div`2) dots ++ take k hotels ++ dots
    odd2   = take n $ '.' : take ((k-n+2)`div`2) hotels ++ take (n-2-(k-n+2)) dots ++ take ((k-n+2)`div`2) hotels ++ dots
    hotel1 = take n $ '.' : take (n-2) hotels ++ dots

import Data.List

main = do
    [n, k] <- fmap parseInput $ getLine
    let ret = solve n k
    if (length ret) > 0
        then do
            putStrLn "YES"
            mapM_ putStrLn ret
        else putStrLn "NO"

parseInput = map readInt . words
    where readInt x = (read x) :: Int

solve n k
    | even k = [fill 0, fill k', fill k', fill 0]
    | k <= (n-2) = [fill 0, fill' k pad, fill 0, fill 0]
    | otherwise = [fill 0, fill (n-2), fill'' (k - n + 2), fill 0]
    where
        fill x = "." ++ (take x $ repeat '#') ++ (take (n-x-1) $ repeat '.')
        fill' x y = (take y $ repeat '.') ++ (take x $ repeat '#') ++ (take (n-x-y) $ repeat '.')
        fill'' x = "." ++ (take (x-1) $ repeat '#') ++ (take (n-2-x) $ repeat '.') ++ "#."
        k' = k `div` 2
        pad = (n - k) `div` 2

main = do
  [n,k] <- fmap (map read . words) getLine
  putStrLn (solve n k)

solve :: Int -> Int -> String
solve n k =
  unlines ["YES",border,center1,center2,border]
  where
    dots = repeat '.'
    hotels = repeat '#'

    border = take n dots
    center1 = take n $ '.' : (take (if k-n+2>=0 then k-n+2 else 0) hotels) ++ dots
    center2 = take n $ '.' : (take (if k-n+2>=0 then n-2 else k) hotels) ++ dots

main = do
  [n,k] <- fmap (map read . words) getLine
  putStrLn (solve n k)

solve :: Int -> Int -> String
solve n k =
  if k>n-2 && odd k
    then "NO"
    else unlines["YES",border,center1,center2,border]
  where
    dots = repeat '.'
    hotels = repeat '#'

    border = take n dots
    center1 = take n $ '.' : (take (if k<=n-2 then k else k`div`2) hotels) ++ dots
    center2 = take n $ '.' : (take (if k<=n-2 then 0 else k`div`2) hotels) ++ dots

import Data.List

main = do
    [n, k] <- fmap parseInput $ getLine
    let ret = solve n k
    if (length ret) > 0
        then do
            putStrLn "YES"
            mapM_ putStrLn ret
        else putStrLn "NO"

parseInput = map readInt . words
    where readInt x = (read x) :: Int

solve n k
    | even k = [fill 0, fill k', fill k', fill 0]
    | k == (n-2) = [fill 0, fill k, fill 0, fill 0]
    | otherwise = []
    where
        fill x = "." ++ (take x $ repeat '#') ++ (take (n-x-1) $ repeat '.')
        k' = k `div` 2

import Data.List

main = do
    [n, k] <- fmap parseInput $ getLine
    let ret = solve n k
    if (length ret) > 0
        then do
            putStrLn "YES"
            mapM_ putStrLn ret
        else putStrLn "NO"

parseInput = map readInt . words
    where readInt x = (read x) :: Int

solve n k
    | even k = [fill 0, fill k', fill k', fill 0]
    | k <= (n-2) = [fill 0, fill' k pad, fill 0, fill 0]
    | otherwise = []
    where
        fill x = "." ++ (take x $ repeat '#') ++ (take (n-x-1) $ repeat '.')
        fill' x y = (take y $ repeat '.') ++ (take x $ repeat '#') ++ (take (n-x-y) $ repeat '.')
        k' = k `div` 2
        pad = (n - k) `div` 2

import Data.List

main = do
    [n, k] <- fmap parseInput $ getLine
    let ret = solve n k
    if (length ret) > 0
        then do
            putStrLn "YES"
            mapM_ putStrLn ret
        else putStrLn "NO"

parseInput = map readInt . words
    where readInt x = (read x) :: Int

solve n k
    | even k = [fill 0, fill k', fill k', fill 0]
    | k <= (n-2) = [fill 0, fill' k pad, fill 0, fill 0]
    | otherwise = [fill 0, fill (n-2), fill' (k - n + 2) (2*n -3 -k), fill 0]
    where
        fill x = "." ++ (take x $ repeat '#') ++ (take (n-x-1) $ repeat '.')
        fill' x y = (take y $ repeat '.') ++ (take x $ repeat '#') ++ (take (n-x-y) $ repeat '.')
        k' = k `div` 2
        pad = (n - k) `div` 2


Treeland is a country in which there are n towns connected by n - 1 two-way road such that it's possible to get from any town to any other town. In Treeland there are 2k universities which are located in different towns. Recently, the president signed the decree to connect universities by high-speed network.The Ministry of Education understood the decree in its own way and decided that it was enough to connect each university with another one by using a cable. Formally, the decree will be done! To have the maximum sum in the budget, the Ministry decided to divide universities into pairs so that the total length of the required cable will be maximum. In other words, the total distance between universities in k pairs should be as large as possible. Help the Ministry to find the maximum total distance. Of course, each university should be present in only one pair. Consider that all roads have the same length which is equal to 1.

The first line of the input contains two integers n and k (2 ≤ n ≤ 200 000, 1 ≤ k ≤ n / 2) — the number of towns in Treeland and the number of university pairs. Consider that towns are numbered from 1 to n.  The second line contains 2k distinct integers u1, u2, ..., u2k (1 ≤ ui ≤ n) — indices of towns in which universities are located.  The next n - 1 line contains the description of roads. Each line contains the pair of integers xj and yj (1 ≤ xj, yj ≤ n), which means that the j-th road connects towns xj and yj. All of them are two-way roads. You can move from any town to any other using only these roads.

Print the maximum possible sum of distances in the division of universities into k pairs.

NoteThe figure below shows one of possible division into pairs in the first test. If you connect universities number 1 and 6 (marked in red) and universities number 2 and 5 (marked in blue) by using the cable, the total distance will equal 6 which will be the maximum sum in this example.

import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
--getInts = (map read . words) `fmap` getLine :: IO [Int]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

type Tree = Map.Map Int (Int, [Int]) -- (data, children)

main = do
    [n, k] <- getInts
    cities <- getInts
    edges <- replicateM (n-1) getInts
    let tree0 = Map.fromList [(key, (0,[])) | key <- [1..n]] :: Tree
    let tree = foldl addCity (foldl addEdge tree0 edges) cities
    let t = dfs tree 1
    print $ answer t n (k*2)

addEdge :: Tree -> [Int] -> Tree
addEdge g [u,v] = g'' where
    g' = Map.update (\(x,es) -> Just (x,u:es)) v g
    g'' = Map.update (\(x,es) -> Just (x,v:es)) u g'

addCity :: Tree -> Int -> Tree
addCity g i = Map.update (\(_,es) -> Just (1,es)) i g

dfs :: Tree -> Int -> Tree
dfs tree start = f 0 tree start where
    link curr prev = filter (/= prev) $ snd (tree Map.! curr)
    f prev tree curr
        | snd (tree Map.! curr) == [] = tree
        | otherwise = let x = foldl (f curr) tree (link curr prev) in seq x (calc x curr prev)
    calc tree curr prev = Map.update (\(d,es) -> Just (d+cost,es)) curr tree where
        cost = sum $ map (\j -> fst (tree Map.! j)) (link curr prev) :: Int

answer :: Tree -> Int -> Int -> Integer
answer tree n k2 = sum $ map (\i -> min (cnt i) (k2' - (cnt i))) [1..n] where
    k2' = fromIntegral k2
    cnt i = fromIntegral $ fst (tree Map.! i)

import Control.Monad
import Data.Array
import qualified Data.Map.Strict as Map

getInt = read `fmap` getLine :: IO Int
getInts = (map read . words) `fmap` getLine :: IO [Int]

type RTree = Map.Map Int (Int, Int) -- (parent, data)
type Tree = Map.Map Int [Int]

main = do
    [n, k] <- getInts
    cities <- getInts
    edges <- replicateM (n-1) getInts
    let rtree0 = Map.fromList [(key,(0,0)) | key <- [1..n]] :: RTree
    let rtree = foldl addCity (foldl addEdge rtree0 edges) cities
    let tree = foldl (mkTree rtree) Map.empty (Map.keys rtree)
    let t = dfs rtree tree 1
    print $ answer t n (k*2)

addEdge :: RTree -> [Int] -> RTree
addEdge g [u,v] -- assume u > v
    | u < v = addEdge g [v,u]
    | fv == 0 && fu /= 0 = Map.insert v (u, 0) g
    | otherwise = Map.insert u (v, 0) g
    where ((fu,_),(fv,_)) = (g Map.! u, g Map.! v)

addCity :: RTree -> Int -> RTree
addCity g city = Map.update (\(v,_) -> Just (v,1)) city g

mkTree :: RTree -> Tree -> Int -> Tree
mkTree rtree t k
    | (fst $ rtree Map.! k) == 0    = t
    | otherwise                     = Map.insertWith (\[k] ks -> k:ks) (fst $ rtree Map.! k) [k] t

dfs :: RTree -> Tree -> Int -> RTree
dfs tree links start = f tree start where
    cost i = snd (tree Map.! i)
    link i = links Map.! i
    f tree i
        | i `Map.notMember` links   = tree
        | otherwise                 = let x = foldl f tree (link i) in seq x (calc x i)
    calc tree i = Map.update (\(parent,d) -> Just (parent, d+cost)) i tree where
        cost = sum $ map (\(_,d) -> d) $ map (\j -> tree Map.! j) (link i) :: Int

answer :: RTree -> Int -> Int -> Int
answer tree n k2 = sum $ map (\i -> min (cnt i) (k2 - (cnt i))) [1..n] where
    cnt i = snd (tree Map.! i)

import Control.Monad
import Data.Array
import Data.Maybe
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

getInt = read `fmap` getLine :: IO Int
--getInts = (map read . words) `fmap` getLine :: IO [Int]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]

type Tree = Map.Map Int (Int, [Int]) -- (data, children)

main = do
    [n, k] <- getInts
    cities <- getInts
    edges <- replicateM (n-1) getInts
    let tree0 = Map.fromList [(key, (0,[])) | key <- [1..n]] :: Tree
    let tree = foldl addCity (foldl addEdge tree0 edges) cities
    let t = dfs tree 1
    print $ answer t n (k*2)

addEdge :: Tree -> [Int] -> Tree
addEdge g [u,v] = g'' where
    g' = Map.update (\(x,es) -> Just (x,u:es)) v g
    g'' = Map.update (\(x,es) -> Just (x,v:es)) u g'

addCity :: Tree -> Int -> Tree
addCity g i = Map.update (\(_,es) -> Just (1,es)) i g

dfs :: Tree -> Int -> Tree
dfs tree start = f 0 tree start where
    link curr prev = filter (/= prev) $ snd (tree Map.! curr)
    f prev tree curr
        | snd (tree Map.! curr) == [] = tree
        | otherwise = let x = foldl (f curr) tree (link curr prev) in seq x (calc x curr prev)
    calc tree curr prev = Map.update (\(d,es) -> Just (d+cost,es)) curr tree where
        cost = sum $ map (\j -> fst (tree Map.! j)) (link curr prev) :: Int

answer :: Tree -> Int -> Int -> Int
answer tree n k2 = sum $ map (\i -> min (cnt i) (k2 - (cnt i))) [1..n] where
    cnt i = fst (tree Map.! i)

import Control.Monad
import Data.Array
import qualified Data.Map.Strict as Map

getInt = read `fmap` getLine :: IO Int
getInts = (map read . words) `fmap` getLine :: IO [Int]

type Tree = Map.Map Int (Int, [Int]) -- (data, children)

main = do
    [n, k] <- getInts
    cities <- getInts
    edges <- replicateM (n-1) getInts
    let tree0 = Map.fromList [(key, (0,[])) | key <- [1..n]] :: Tree
    let tree = foldl addCity (foldl addEdge tree0 edges) cities
    let t = dfs tree 1
    print $ answer t n (k*2)

addEdge :: Tree -> [Int] -> Tree
addEdge g [u,v] = g'' where
    g' = Map.update (\(x,es) -> Just (x,u:es)) v g
    g'' = Map.update (\(x,es) -> Just (x,v:es)) u g

addCity :: Tree -> Int -> Tree
addCity g i = Map.update (\(_,es) -> Just (1,es)) i g

dfs :: Tree -> Int -> Tree
dfs tree start = f 0 tree start where
    link curr prev = filter (/= prev) $ snd (tree Map.! curr)
    f prev tree curr
        | snd (tree Map.! curr) == [] = tree
        | otherwise = let x = foldl (f curr) tree (link curr prev) in seq x (calc x curr prev)
    calc tree curr prev = Map.update (\(d,es) -> Just (d+cost,es)) curr tree where
        cost = sum $ map (\j -> fst (tree Map.! j)) (link curr prev) :: Int

answer :: Tree -> Int -> Int -> Int
answer tree n k2 = sum $ map (\i -> min (cnt i) (k2 - (cnt i))) [1..n] where
    cnt i = fst (tree Map.! i)


Let's call an undirected graph of n vertices p-interesting, if the following conditions fulfill:   the graph contains exactly 2n + p edges;  the graph doesn't contain self-loops and multiple edges;  for any integer k (1 ≤ k ≤ n), any subgraph consisting of k vertices contains at most 2k + p edges. A subgraph of a graph is some set of the graph vertices and some set of the graph edges. At that, the set of edges must meet the condition: both ends of each edge from the set must belong to the chosen set of vertices. Your task is to find a p-interesting graph consisting of n vertices.

The first line contains a single integer t (1 ≤ t ≤ 5) — the number of tests in the input. Next t lines each contains two space-separated integers: n, p (5 ≤ n ≤ 24; p ≥ 0; ) — the number of vertices in the graph and the interest value for the appropriate test.  It is guaranteed that the required graph exists.

For each of the t tests print 2n + p lines containing the description of the edges of a p-interesting graph: the i-th line must contain two space-separated integers ai, bi (1 ≤ ai, bi ≤ n; ai ≠ bi) — two vertices, connected by an edge in the resulting graph. Consider the graph vertices numbered with integers from 1 to n.  Print the answers to the tests in the order the tests occur in the input. If there are multiple solutions, you can print any of them.

{-# 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 ()
inf = maxBound `div` 2 :: Int

buildGraph :: Int  -> [(Int,Int)]
buildGraph n = go 1 []
    where
    go v es | v > n = es | otherwise = go (v+1) es'
        where
        es' = es ++ [ (v,u) | (d,u) <- take (4 - degree ! v) l , d < 4 ]
        degree :: Array Int Int
        degree = accumArray (\a b -> a+1) 0 (1,n) (es ++ map swap es)
        l = sort [ (d,i) | (i,d) <- assocs degree, i /= v ]

addEdge :: [(Int,Int)] -> Int -> Int -> [(Int,Int)]
addEdge es n p = es ++ take p [ (u,v) | ((u,v),False) <- assocs g, u < v ]
    where
    g :: Array (Int,Int) Bool
    g = defaultArray False ((1,1),(n,n)) $ do
        (u,v) <- es
        [((u,v),True),((v,u),True)]

main = do
    t <- readLn
    replicateM_ t $ do
        (n,p) <- readIntPair
        let es = addEdge (buildGraph n) n p
        when (length es /= 2 * n + p ) $ putStrLn "something wrong"
        forM_ es $ putStrLn . unwords . map show . p2l

work [n, p] = take (2 * n + p) [show i ++ " " ++ show ((mod (i + d) n) + 1) | d <- [0 ..], i <- [1 .. n]]
main = interact $ unlines . map (unlines . work . map read . words) . tail . lines


Many countries have such a New Year or Christmas tradition as writing a letter to Santa including a wish list for presents. Vasya is an ordinary programmer boy. Like all ordinary boys, he is going to write the letter to Santa on the New Year Eve (we Russians actually expect Santa for the New Year, not for Christmas). Vasya has come up with an algorithm he will follow while writing a letter. First he chooses two strings, s1 anf s2, consisting of uppercase English letters. Then the boy makes string sk, using a recurrent equation sn = sn - 2 + sn - 1, operation '+' means a concatenation (that is, the sequential record) of strings in the given order. Then Vasya writes down string sk on a piece of paper, puts it in the envelope and sends in to Santa. Vasya is absolutely sure that Santa will bring him the best present if the resulting string sk has exactly x occurrences of substring AC (the short-cut reminds him оf accepted problems). Besides, Vasya decided that string s1 should have length n, and string s2 should have length m. Vasya hasn't decided anything else.At the moment Vasya's got urgent New Year business, so he asks you to choose two strings for him, s1 and s2 in the required manner. Help Vasya.

The first line contains four integers k, x, n, m (3 ≤ k ≤ 50; 0 ≤ x ≤ 109; 1 ≤ n, m ≤ 100).

In the first line print string s1, consisting of n uppercase English letters. In the second line print string s2, consisting of m uppercase English letters. If there are multiple valid strings, print any of them. If the required pair of strings doesn't exist, print "Happy new year!" without the quotes.

import Data.List
import Control.Applicative
import Data.Maybe
one bool = if bool then 1 else 0
data Search = Search{count::Integer,startC::Bool,endA::Bool} deriving (Eq,Show,Ord)
(+!) :: Search -> Search -> Search
a +! b = Search (count a + count b + (one $ endA a && startC b )) (startC a) (endA b)
specChars:: Search -> Int
specChars s = (one $ startC s) + (one $ endA s)
main = do
	[ k, x, n, m ] <- (map read) <$> words <$> getLine ::IO [Int]
	mapM putStrLn $ solution k x n m where
		solution k x n m = let
			iter a b k = if k == 2 then b else iter b (a+!b) (k - 1 )
			iterS a b k = if k == 2 then b else iterS b (a++b) (k - 1 )
			choices n = if n == 0 then [[]] else [c:cs| c<-[False,True], cs <- choices (n-1)]
			variants = [(Search (toInteger a) xa ya ,Search (toInteger b) xb yb) | [xa,ya, xb, yb] <-(choices 4),
				a <- [0..div (n - one xa - one ya ) 2],
				b <- [0..div (m - one xb - one yb ) 2]]
			search = find fitting variants where
				fitting (a,b) = (count $ iter a b k) == (toInteger x)
			complete u l = 	(if startC u then "C" else []) ++
						   	replicate (l - (2 * (fromIntegral $ count u)) - specChars u) 'X' ++
						   	(foldl' (++) "" $ replicate (fromIntegral $ count u) "AC") ++
						   	if endA u then "A" else []
			strings = do
				(a,b) <- search
				return [complete a n, complete b m]
			in fromMaybe  ["Happy new year!"] strings
			--in [show $ choices k]

{-# 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 . (,)

times s k = concat $ take k $ repeat s

check k x (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (fromIntegral ac1,h1,l1) (fromIntegral ac2,h2,l2) == fromIntegral x
    where
    go 0 (ac,_,_) _ = ac :: Int64
    go k (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac2,h2,l2) (ac3,h3,l3)
        where
            ac3 = ac1 + ac2 + (if l1 == 'A' && h2 == 'C' then 1 else 0)
            h3 = h1
            l3 = l2

build 1 _ ch _ = [ch]
build n ac 'X' 'A' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'X' 'X' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'X' 'C' = times "X" (n - 2 * ac) ++ times "AC" ac
build n ac 'C' 'A' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'C' 'X' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'C' 'C' = times "C" (n - 2 * ac) ++ times "AC" ac
build n ac 'A' 'A' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'A' 'X' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n 0  'A' 'C' = "A" ++ times "X" (n - 2) ++ "C"
build n ac 'A' 'C' = times "A" (n - 2 * ac) ++ times "AC" ac

valid 1 _  h l = h == l
valid n 0  'A' 'C' = n > 2
valid n ac 'X' 'A' = ac * 2 <= n - 2
valid n ac 'X' 'X' = ac * 2 <= n - 2
valid n ac 'X' 'C' = ac * 2 <= n - 1
valid n ac 'C' 'A' = ac * 2 <= n - 2
valid n ac 'C' 'X' = ac * 2 <= n - 2
valid n ac 'C' 'C' = ac * 2 <= n - 1
valid n ac 'A' 'A' = ac * 2 <= n - 1
valid n ac 'A' 'X' = ac * 2 <= n - 1
valid n ac 'A' 'C' = ac * 2 <= n

search :: Int -> Int -> Int -> Int -> Maybe (String,String)
search k x n m = listToMaybe $ do
    ac1 <- [0..div n 2]
    h1  <- "ACX"
    l1  <- "ACX"
    guard (valid n ac1 h1 l1)
    ac2 <- [0..div m 2]
    h2  <- "ACX"
    l2  <- "ACX"
    guard (valid m ac2 h2 l2)
    guard (check k x (ac1,h1,l1) (ac2,h2,l2))
    let s1 = build n ac1 h1 l1
    let s2 = build m ac2 h2 l2
    return (s1,s2)

main = do
    [k,x,n,m] <- readInts
    case search k x n m of
        Nothing      -> putStrLn "Happy new year!"
        Just (l1,l2) -> do
            putStrLn l1
            putStrLn l2

import Data.List
import Control.Applicative
import Data.Maybe
one bool = if bool then 1 else 0
data Search = Search{count::Integer,startC::Bool,endA::Bool} deriving (Eq,Show,Ord)
(+!) :: Search -> Search -> Search
a +! b = Search (count a + count b + (one $ endA a && startC b )) (startC a) (endA b)
specChars:: Search -> Int
specChars s = (one $ startC s) + (one $ endA s)
main = do
	[ k, x, n, m ] <- (map read) <$> words <$> getLine ::IO [Int]
	mapM putStrLn $ solution k x n m where
		solution k x n m = let
			iter a b k = if k == 2 then b else iter b (a+!b) (k - 1 )
			iterS a b k = if k == 2 then b else iterS b (a++b) (k - 1 )
			choices n = if n == 0 then [[]] else [c:cs| c<-[False,True], cs <- choices (n-1)]
			variants = [(Search (toInteger a) xa ya ,Search (toInteger b) xb yb) | [xa,ya, xb, yb] <-(choices 4),
				a <- [0..div (n - one xa - one xb ) 2],
				b<- [0..div (m - one xa - one xb ) 2]]
			search = find fitting variants where
				fitting (a,b) = (count $ iter a b k) == (toInteger x)
			complete u l = 	(if startC u then "C" else []) ++
						   	replicate (l - (2 * (fromIntegral $ count u)) - specChars u) 'X' ++
						   	(foldl' (++) "" $ replicate (fromIntegral $ count u) "AC") ++
						   	if endA u then "A" else []
			strings = do
				(a,b) <- search
				return [complete a n, complete b m]
			in fromMaybe  ["Happy new year!"] strings
			--in [show $ choices k]

import Data.List
import Control.Applicative
import Data.Maybe
main = do
	[ k, x, n, m ] <- (map read) <$> words <$> getLine ::IO [Int]
	mapM putStrLn $ solution k x n m where
		solution k x n m = let
			iter a b k = if k == 2 then b else iter b (a+b) (k - 1 )
			variants = [(a,b) | a <- [0..div n 2], b<- [0..div m 2]]
			variants2 = [(a,b) | a <- [0..div (n-1) 2], b<- [0..div (m-1) 2]]
			search = find fitting variants where
				fitting (a,b) = iter (toInteger a) (toInteger b) k == (toInteger x)
			search2 = find fitting variants2 where
				fitting (a,b) = iter (toInteger b) (toInteger (a+b+1)) (k-1) == (toInteger x)
			complete u l = replicate (l - (2 * u)) 'X' ++ (foldl' (++) "" $ replicate u "AC")
			completeA u = replicate (n - 1 - (2 * u)) 'X' ++ (foldl' (++) "" $ replicate u "AC") ++ "A"
			completeB u = "C" ++ replicate (m - 1 - (2 * u)) 'X' ++ (foldl' (++) "" $ replicate u "AC")
			strings = do
				(a,b) <- search
				return [complete a n, complete b m]
			strings2 = do
				(a,b) <- search2
				return [completeA a, completeB b]
			in (fromMaybe ( fromMaybe ["Happy new year!"] strings2  )  strings)

{-# 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 . (,)

times s k = concat $ take k $ repeat s

check k x (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac1,h1,l1) (ac2,h2,l2) == x
    where
    go 0 (ac,_,_) _ = ac
    go k (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac2,h2,l2) (ac3,h3,l3)
        where
            ac3 = ac1 + ac2 + (if l1 == 'A' && h2 == 'C' then 1 else 0)
            h3 = h1
            l3 = l2

build 1 _ ch _ = [ch]
build n ac 'X' 'A' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'X' 'X' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'X' 'C' = times "X" (n - 2 * ac) ++ times "AC" ac
build n ac 'C' 'A' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'C' 'X' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'C' 'C' = times "C" (n - 2 * ac) ++ times "AC" ac
build n ac 'A' 'A' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'A' 'X' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'A' 'C' = times "A" (n - 2 * ac) ++ times "AC" ac

valid 1 _  h l = h == l
valid 2 ac 'A' 'C' = ac == 1
valid n ac 'X' 'A' = ac * 2 <= n - 2
valid n ac 'X' 'X' = ac * 2 <= n - 2
valid n ac 'X' 'C' = ac * 2 <= n - 1
valid n ac 'C' 'A' = ac * 2 <= n - 2
valid n ac 'C' 'X' = ac * 2 <= n - 2
valid n ac 'C' 'C' = ac * 2 <= n - 1
valid n ac 'A' 'A' = ac * 2 <= n - 1
valid n ac 'A' 'X' = ac * 2 <= n - 1
valid n ac 'A' 'C' = ac * 2 <= n

search :: Int -> Int -> Int -> Int -> Maybe (String,String)
search k x n m = listToMaybe $ do
    ac1 <- [0..div n 2]
    h1  <- "ACX"
    l1  <- "ACX"
    guard (valid n ac1 h1 l1)
    ac2 <- [0..div m 2]
    h2  <- "ACX"
    l2  <- "ACX"
    guard (valid m ac2 h2 l2)
    guard (check k x (ac1,h1,l1) (ac2,h2,l2))
    let s1 = build n ac1 h1 l1
    let s2 = build m ac2 h2 l2
    return (s1,s2)

main = do
    [k,x,n,m] <- readInts
    case search k x n m of
        Nothing      -> putStrLn "Happy new year!"
        Just (l1,l2) -> do
            putStrLn l1
            putStrLn l2

{-# 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 . (,)

times s k = concat $ take k $ repeat s

check k x (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac1,h1,l1) (ac2,h2,l2) == x
    where
    go 0 (ac,_,_) _ = ac
    go k (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac2,h2,l2) (ac3,h3,l3)
        where
            ac3 = ac1 + ac2 + (if l1 == 'A' && h2 == 'C' then 1 else 0)
            h3 = h1
            l3 = l2

build 1 _ ch _ = [ch]
build n ac 'X' 'A' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'X' 'X' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'X' 'C' = times "X" (n - 2 * ac) ++ times "AC" ac
build n ac 'C' 'A' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'C' 'X' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'C' 'C' = times "C" (n - 2 * ac) ++ times "AC" ac
build n ac 'A' 'A' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'A' 'X' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'A' 'C' = times "A" (n - 2 * ac) ++ times "AC" ac

valid 1 _  h l = h == l
valid n ac 'X' 'A' = ac * 2 <= n - 2
valid n ac 'X' 'X' = ac * 2 <= n - 2
valid n ac 'X' 'C' = ac * 2 <= n - 1
valid n ac 'C' 'A' = ac * 2 <= n - 2
valid n ac 'C' 'X' = ac * 2 <= n - 2
valid n ac 'C' 'C' = ac * 2 <= n - 1
valid n ac 'A' 'A' = ac * 2 <= n - 1
valid n ac 'A' 'X' = ac * 2 <= n - 1
valid n ac 'A' 'C' = ac * 2 <= n

search :: Int -> Int -> Int -> Int -> Maybe (String,String)
search k x n m = listToMaybe $ do
    ac1 <- [0..div n 2]
    h1  <- "ACX"
    l1  <- "ACX"
    guard (valid n ac1 h1 l1)
    ac2 <- [0..div m 2]
    h2  <- "ACX"
    l2  <- "ACX"
    guard (valid m ac2 h2 l2)
    guard (check k x (ac1,h1,l1) (ac2,h2,l2))
    let s1 = build n ac1 h1 l1
    let s2 = build m ac2 h2 l2
    return (s1,s2)

main = do
    [k,x,n,m] <- readInts
    case search k x n m of
        Nothing      -> putStrLn "Happy new year!"
        Just (l1,l2) -> do
            putStrLn l1
            putStrLn l2

{-# 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 . (,)

times s k = concat $ take k $ repeat s

check k x (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (fromIntegral ac1,h1,l1) (fromIntegral ac2,h2,l2) == fromIntegral x
    where
    go 0 (ac,_,_) _ = ac :: Int64
    go k (ac1,h1,l1) (ac2,h2,l2) = go (k-1) (ac2,h2,l2) (ac3,h3,l3)
        where
            ac3 = ac1 + ac2 + (if l1 == 'A' && h2 == 'C' then 1 else 0)
            h3 = h1
            l3 = l2

build 1 _ ch _ = [ch]
build n ac 'X' 'A' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'X' 'X' = times "X" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'X' 'C' = times "X" (n - 2 * ac) ++ times "AC" ac
build n ac 'C' 'A' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'C' 'X' = times "C" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'C' 'C' = times "C" (n - 2 * ac) ++ times "AC" ac
build n ac 'A' 'A' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "A"
build n ac 'A' 'X' = times "A" (n - 2 * ac - 1) ++ times "AC" ac ++ "X"
build n ac 'A' 'C' = times "A" (n - 2 * ac) ++ times "AC" ac

valid 1 _  h l = h == l
valid 2 ac 'A' 'C' = ac == 1
valid n ac 'X' 'A' = ac * 2 <= n - 2
valid n ac 'X' 'X' = ac * 2 <= n - 2
valid n ac 'X' 'C' = ac * 2 <= n - 1
valid n ac 'C' 'A' = ac * 2 <= n - 2
valid n ac 'C' 'X' = ac * 2 <= n - 2
valid n ac 'C' 'C' = ac * 2 <= n - 1
valid n ac 'A' 'A' = ac * 2 <= n - 1
valid n ac 'A' 'X' = ac * 2 <= n - 1
valid n ac 'A' 'C' = ac * 2 <= n

search :: Int -> Int -> Int -> Int -> Maybe (String,String)
search k x n m = listToMaybe $ do
    ac1 <- [0..div n 2]
    h1  <- "ACX"
    l1  <- "ACX"
    guard (valid n ac1 h1 l1)
    ac2 <- [0..div m 2]
    h2  <- "ACX"
    l2  <- "ACX"
    guard (valid m ac2 h2 l2)
    guard (check k x (ac1,h1,l1) (ac2,h2,l2))
    let s1 = build n ac1 h1 l1
    let s2 = build m ac2 h2 l2
    return (s1,s2)

main = do
    [k,x,n,m] <- readInts
    case search k x n m of
        Nothing      -> putStrLn "Happy new year!"
        Just (l1,l2) -> do
            putStrLn l1
            putStrLn l2


Andrea has come up with what he believes to be a novel sorting algorithm for arrays of length $$$n$$$. The algorithm works as follows.Initially there is an array of $$$n$$$ integers $$$a_1,\, a_2,\, \dots,\, a_n$$$. Then, $$$k$$$ steps are executed.For each $$$1\le i\le k$$$, during the $$$i$$$-th step the subsequence of the array $$$a$$$ with indexes $$$j_{i,1}< j_{i,2}< \dots< j_{i, q_i}$$$ is sorted, without changing the values with the remaining indexes. So, the subsequence $$$a_{j_{i,1}},\, a_{j_{i,2}},\, \dots,\, a_{j_{i,q_i}}$$$ is sorted and all other elements of $$$a$$$ are left untouched.Andrea, being eager to share his discovery with the academic community, sent a short paper describing his algorithm to the journal "Annals of Sorting Algorithms" and you are the referee of the paper (that is, the person who must judge the correctness of the paper). You must decide whether Andrea's algorithm is correct, that is, if it sorts any array $$$a$$$ of $$$n$$$ integers.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$1\le n\le 40$$$, $$$0\le k\le 10$$$) — the length of the arrays handled by Andrea's algorithm and the number of steps of Andrea's algorithm. Then $$$k$$$ lines follow, each describing the subsequence considered in a step of Andrea's algorithm. The $$$i$$$-th of these lines contains the integer $$$q_i$$$ ($$$1\le q_i\le n$$$) followed by $$$q_i$$$ integers $$$j_{i,1},\,j_{i,2},\,\dots,\, j_{i,q_i}$$$ ($$$1\le j_{i,1}<j_{i,2}<\cdots<j_{i,q_i}\le n$$$) — the length of the subsequence considered in the $$$i$$$-th step and the indexes of the subsequence.

If Andrea's algorithm is correct print ACCEPTED, otherwise print REJECTED.

NoteExplanation of the first sample: The algorithm consists of $$$3$$$ steps. The first one sorts the subsequence $$$[a_1, a_2, a_3]$$$, the second one sorts the subsequence $$$[a_2, a_3, a_4]$$$, the third one sorts the subsequence $$$[a_1,a_2]$$$. For example, if initially $$$a=[6, 5, 6, 3]$$$, the algorithm transforms the array as follows (the subsequence that gets sorted is highlighted in red) $$$$$$ [{\color{red}6},{\color{red}5},{\color{red}6},3] \rightarrow [5, {\color{red}6}, {\color{red}6}, {\color{red}3}] \rightarrow [{\color{red}5}, {\color{red}3}, 6, 6] \rightarrow [3, 5, 6, 6] \,.$$$$$$ One can prove that, for any initial array $$$a$$$, at the end of the algorithm the array $$$a$$$ will be sorted.Explanation of the second sample: The algorithm consists of $$$3$$$ steps. The first one sorts the subsequence $$$[a_1, a_2, a_3]$$$, the second one sorts the subsequence $$$[a_2, a_3, a_4]$$$, the third one sorts the subsequence $$$[a_1,a_3,a_4]$$$. For example, if initially $$$a=[6, 5, 6, 3]$$$, the algorithm transforms the array as follows (the subsequence that gets sorted is highlighted in red) $$$$$$ [{\color{red}6},{\color{red}5},{\color{red}6},3] \rightarrow [5, {\color{red}6}, {\color{red}6}, {\color{red}3}] \rightarrow [{\color{red}5}, 3, {\color{red}6}, {\color{red}6}] \rightarrow [5, 3, 6, 6] \,.$$$$$$ Notice that $$$a=[6,5,6,3]$$$ is an example of an array that is not sorted by the algorithm.Explanation of the third sample: The algorithm consists of $$$4$$$ steps. The first $$$3$$$ steps do nothing because they sort subsequences of length $$$1$$$, whereas the fourth step sorts the subsequence $$$[a_1,a_3]$$$. For example, if initially $$$a=[5,6,4]$$$, the algorithm transforms the array as follows (the subsequence that gets sorted is highlighted in red) $$$$$$ [{\color{red}5},6,4] \rightarrow [5,{\color{red}6},4] \rightarrow [5,{\color{red}6},4] \rightarrow [{\color{red}5},6,{\color{red}4}]\rightarrow [4,6,5] \,.$$$$$$ Notice that $$$a=[5,6,4]$$$ is an example of an array that is not sorted by the algorithm.Explanation of the fourth sample: The algorithm consists of $$$2$$$ steps. The first step sorts the subsequences $$$[a_2,a_3,a_4]$$$, the second step sorts the whole array $$$[a_1,a_2,a_3,a_4,a_5]$$$. For example, if initially $$$a=[9,8,1,1,1]$$$, the algorithm transforms the array as follows (the subsequence that gets sorted is highlighted in red) $$$$$$ [9,{\color{red}8},{\color{red}1},{\color{red}1},1] \rightarrow [{\color{red}9},{\color{red}1},{\color{red}1},{\color{red}8},{\color{red}1}] \rightarrow [1,1,1,8,9] \,.$$$$$$ Since in the last step the whole array is sorted, it is clear that, for any initial array $$$a$$$, at the end of the algorithm the array $$$a$$$ will be sorted.

-- Resubmission, to find out how much 64-bit helps

import qualified Data.ByteString.Lazy.Char8 as P

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

import Data.Array.Unboxed
import Data.Bits
import Data.Word

data Action = Action !Word64 !Int !(UArray Int Int)
newtype Status = Status Word64

step :: Status -> Action -> [Status]
step (Status smask) (Action amask newIxs ixs) = let
  existingOnes = popCount (smask .&. amask)
  in  do
  resOnes <- [existingOnes .. existingOnes + newIxs]
  let  ares = (bit (ixs ! resOnes) - 1) .&. amask
  pure $ Status (smask .&. complement amask .|. ares)

stepEach :: [Status] -> Action -> [Status]
stepEach s a = concatMap (`step` a) s

processAction :: Int -> (Word64, Action) -> [Int] -> (Word64, Action)
processAction n (vis, _) (qi : ji) = let
  amask = foldl' (\acc ix -> acc .|. bit ix) 0 ji
  newIxs = popCount (amask .&. complement vis)
  ixs = array (0, qi) $ (qi, n+1) : zip [0..] ji
  in  (vis .|. amask, Action amask newIxs ixs)
processAction _ _ _ = error "unexpected empty line in input"

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  rawActions <- replicateM k readInts
  let
    process = scanl (processAction n) (0, undefined) rawActions
    actions = tail $ map snd process
    vis = fst $ last process
    start = Status 0
    opts = foldl stepEach [start] actions
    tarVis = bit (n + 1) - bit 1
    ok = and $ (n == 1 || vis == tarVis) : do
      Status smask <- opts
      pure $ smask .&. (smask + 2) == 0
  lift $ putStrLn $ if  ok
    then  "ACCEPTED"
    else  "REJECTED"

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]

import qualified Data.ByteString.Lazy.Char8 as P

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

import Data.Array.Unboxed
import Data.Bits
import Data.Word

data Action = Action !Word64 !(UArray Int Int)
data Status = Status !Word64 !Word64

step :: Status -> Action -> [Status]
step (Status smask vis) (Action amask ixs) = let
  existingOnes = popCount (smask .&. amask)
  newIxs = popCount (complement vis .&. amask)
  in  do
  resOnes <- [existingOnes .. existingOnes + newIxs]
  let  ares = (bit (ixs ! resOnes) - 1) .&. amask
  pure $ Status (smask .&. complement amask .|. ares) (vis .|. amask)

stepEach :: [Status] -> Action -> [Status]
stepEach s a = concatMap (`step` a) s

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  actions <- replicateM k $ do
    qi : ji <- readInts
    let
      amask = foldl' (\acc ix -> acc .|. bit ix) 0 ji
      ixs = array (0, qi) $ (qi, n+1) : zip [0..] ji
    pure $ Action amask ixs
  let
    start = Status 0 0
    opts = foldl stepEach [start] actions
    tarVis = bit (n + 1) - bit 1
    ok = and $ do
      Status smask vis <- opts
      pure $ (n == 1 || vis == tarVis) && smask .&. (smask + 2) == 0
  lift $ putStrLn $ if  ok
    then  "ACCEPTED"
    else  "REJECTED"

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]

import Control.Monad
import Data.Array.Unboxed
import Data.Bits
import Data.List
import Data.Word

solve :: IO ()
solve = do
    [n, k] <- readMany
    a <- replicateM k readMany
    let step (prvm, xs) ~(q:js) = (prvm .|. m, concatMap gen xs) where
            ma = listArray (0, q) $ scanl (.|.) 0 $ map (bit . subtract 1) $ sort js :: UArray Int Word64
            m = ma!q
            com = prvm .&. m
            gen x = map ((prvx .|.) . (ma!)) [ones .. q-zeros] where
                ones = popCount $ com .&. x
                zeros = popCount $ com .&. complement x
                prvx = x .&. complement m
        (m, xs) = foldl' step (0, [0]) a
        ok = n == 1 || m == bit n - 1 && all (\x -> x .&. (x + 1) == 0) xs
    putStrLn $ if ok then "ACCEPTED" else "REJECTED"

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

main :: IO ()
main = solve

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

import Data.Array.Unboxed

step :: UArray Int Int -> [Int] -> [UArray Int Int]
step arr ixs = let
  neg = length [() | i <- ixs, arr ! i < 0]
  nonpos = length [() | i <- ixs, arr ! i <= 0]
  in  do
  newNeg <- [neg .. nonpos]
  pure $ arr // zip ixs (replicate newNeg (0-1) ++ repeat 1)

stepEach :: [UArray Int Int] -> [Int] -> [UArray Int Int]
stepEach arrs ixs = do
  arr <- arrs
  step arr ixs

sorted :: UArray Int Int -> Bool
sorted arr = null $ dropWhile (== 1) $ dropWhile (< 0) $ elems arr

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, k] <- readInts
  acts <- replicateM k $ tail <$> readInts
  let
    start = accumArray undefined 0 (1, n) []
    opts = foldl stepEach [start] acts
  lift $ putStrLn $ if  all sorted opts
    then  "ACCEPTED"
    else  "REJECTED"

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 three positive integers $$$n$$$, $$$a$$$ and $$$b$$$. You have to construct a string $$$s$$$ of length $$$n$$$ consisting of lowercase Latin letters such that each substring of length $$$a$$$ has exactly $$$b$$$ distinct letters. It is guaranteed that the answer exists.You have to answer $$$t$$$ independent test cases.Recall that the substring $$$s[l \dots r]$$$ is the string $$$s_l, s_{l+1}, \dots, s_{r}$$$ and its length is $$$r - l + 1$$$. In this problem you are only interested in substrings of length $$$a$$$.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2000$$$) — the number of test cases. Then $$$t$$$ test cases follow. The only line of a test case contains three space-separated integers $$$n$$$, $$$a$$$ and $$$b$$$ ($$$1 \le a \le n \le 2000, 1 \le b \le \min(26, a)$$$), where $$$n$$$ is the length of the required string, $$$a$$$ is the length of a substring and $$$b$$$ is the required number of distinct letters in each substring of length $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2000$$$ ($$$\sum n \le 2000$$$).

For each test case, print the answer — such a string $$$s$$$ of length $$$n$$$ consisting of lowercase Latin letters that each substring of length $$$a$$$ has exactly $$$b$$$ distinct letters. If there are multiple valid answers, print any of them. It is guaranteed that the answer exists.

NoteIn the first test case of the example, consider all the substrings of length $$$5$$$:  "tleel": it contains $$$3$$$ distinct (unique) letters,  "leelt": it contains $$$3$$$ distinct (unique) letters,  "eelte": it contains $$$3$$$ distinct (unique) letters.

module Main where

import Control.Monad
import Data.List

getStrList :: IO [String]
getStrList = words <$> getLine

getIntList :: IO [Int]
getIntList = map read <$> getStrList

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        [n, a, b] <- getIntList
        putStrLn $ f n a b

f :: Int -> Int -> Int -> String
f n a b = take n . cycle $ (take a $ (take b ['a' .. 'z'] ++ cycle [['a'..'z'] !! (b - 1)]))

import Control.Monad (replicateM_)
getList :: Read b => IO [b]
getList = map read . words <$> getLine

main :: IO ()
main = readLn >>= flip replicateM_ (getList >>= putStrLn . solve)

solve :: [Int] -> String
solve [n,a,b] = take n $ cycle letters where
    letters = replicate (a-b) 'a' ++ take b ['a'..'z']

solve :: [Int] -> String
solve [n,a,b] = take n $ cycle $ take b ['a'..]

main :: IO ()
main = interact $ unlines . map (solve . map read . words) . tail . lines

import Control.Monad (forM_)
import Data.Char (chr, ord)

solve n a b = take n res where
	period = replicate (b-1) 1 ++ replicate (a-b) 0
	cyclic = if null period then repeat 0 else cycle period
	res = map chr' $ map (`mod` 26) $ scanl(+) 0 cyclic
	chr' k = chr (k + ord 'a')
main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		[n,a,b] <- fmap (map read.words) getLine
		putStrLn (solve n a b)

import Control.Monad

alf = ['a'..'z']

r str = concat (repeat str)

substring :: Int -> Int-> String
substring a b = take a ((take b alf) ++ (repeat (alf!!(b-1))))

foo :: Int -> Int -> Int -> String
foo n a b = take n (r (substring a b))

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

main :: IO()
main = do
  t <- readLn :: IO Int
  forM_ [1..t] $ \i -> do
    arr <- readInts
    putStrLn (foo (arr!!0) (arr!!1) (arr!!2))

alph :: String
alph = ['a'..'z']

addReplicas :: Int -> String -> String
addReplicas n s
    | n <= l    = take n s
    | otherwise = s ++ addReplicas (n-l) s
    where
        l = length s

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:a:b:_) <- readInts
    putStrLn $ addReplicas n (take b alph)
    testCases (t-1)

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

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

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

onecase = do
		[n,a,b]<- map read <$> words <$> getLine::IO [Int]
		putStrLn $ take n $ cycle $ take b "abcdefghijklmnopqrstuvwxyz"

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

process :: Int -> Int -> Int -> [Char]
process n a b = take n.cycle.take b $ ['a'..'z']

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    [n,a,b] <- fmap (map readInt.words) getLine
    putStrLn $ process n a b
    run (t-1)

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

import Data.Char

main :: IO ()
main = do
    getLine
    answers <- map (solve . map read . words) <$> lines <$> getContents
    mapM_ putStrLn answers

solve :: [Int] -> String
solve [len,sub,chars] = take len . cycle $ segment
    where segment = replicate (sub - chars) 'a' ++ (take chars ['a'..'z'])

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

onecase = do
		[n,a,b]<- map read <$> words <$> getLine::IO [Int]
		putStrLn $ take n $ cycle $ take b "abcdefghijklmnopqrstuvwyz"

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

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

onecase = do
		[n,a,b]<- map read <$> words <$> getLine::IO [Int]
		print $ take n $ cycle $ take b "abcdefghijklmnopqrstuvwyz"

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


Learn, learn and learn again — Valera has to do this every day. He is studying at mathematical school, where math is the main discipline. The mathematics teacher loves her discipline very much and tries to cultivate this love in children. That's why she always gives her students large and difficult homework. Despite that Valera is one of the best students, he failed to manage with the new homework. That's why he asks for your help. He has the following task. A sequence of n numbers is given. A prefix of a sequence is the part of the sequence (possibly empty), taken from the start of the sequence. A suffix of a sequence is the part of the sequence (possibly empty), taken from the end of the sequence. It is allowed to sequentially make two operations with the sequence. The first operation is to take some prefix of the sequence and multiply all numbers in this prefix by  - 1. The second operation is to take some suffix and multiply all numbers in it by  - 1. The chosen prefix and suffix may intersect. What is the maximum total sum of the sequence that can be obtained by applying the described operations?

The first line contains integer n (1 ≤ n ≤ 105) — amount of elements in the sequence. The second line contains n integers ai ( - 104 ≤ ai ≤ 104) — the sequence itself.

The first and the only line of the output should contain the answer to the problem.

import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe
import IO

main = do C.hGetContents stdin >>= putStrLn . show . gao . map (fst . fromJust . C.readInt) . tail . C.words

gao a = (sum a -) $ (2*) $ minimum $ zipWith (+) (f a) $ reverse $ f $ reverse a where
	f = scanl1 min . scanl (+) 0

import Data.List

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

solve :: [Int] -> Int
solve a = let pre = calcMaxSum a
              suf = reverse $ calcMaxSum (reverse a)
          in solve' pre (tail suf) (sum a)
          where solve' :: [Int] -> [Int] -> Int -> Int
                solve' [a]    []     m = max a m
                solve' (a:ax) (b:bx) m = solve' ax bx (max m (a + b))

accumulate :: (a -> b -> a) -> a -> [b] -> [a]
accumulate _  _    []    = []
accumulate op last (a:s) = let v = op last a
                           in v : accumulate op v s

transition :: (Int, Int) -> Int -> (Int, Int)
transition (a, b) c = (a - c, max (c + max a b) (a - c))

calcMaxSum :: [Int] -> [Int]
calcMaxSum = map snd . accumulate transition (0, 0)

plus :: [Int] -> Int -> Int
plus [] cur = cur
plus (x:xs) cur = max cur $ plus xs $ max 0 $ cur + x

main = do
	n <- getLine >>= return . read :: IO Int
	a <- getLine >>= return . (map read) . words :: IO [Int]
	putStrLn $ show $ (plus a 0 * 2) - (foldl (+) 0 a)

main = interact (ans)
ans theInput = show answer where
  [[n],a] = map (map (read::String->Int)) (map words (lines theInput))
  lastMax [] = (0,0,0,0)
  lastMax (x:xs) = (if x+y > 0 then (max u (v+x+x+y+z),v+x,x+y,z) else (max u (v+z-y),v+x,0,z-x-y)) where
    (u,v,y,z) = lastMax xs
  answer = u-v where (u,v,y,z) = lastMax a