The Berland University is preparing to celebrate the 256-th anniversary of its founding! A specially appointed Vice Rector for the celebration prepares to decorate the campus. In the center of the campus n ice sculptures were erected. The sculptures are arranged in a circle at equal distances from each other, so they form a regular n-gon. They are numbered in clockwise order with numbers from 1 to n.The site of the University has already conducted a voting that estimated each sculpture's characteristic of ti — the degree of the sculpture's attractiveness. The values of ti can be positive, negative or zero.When the university rector came to evaluate the work, he said that this might be not the perfect arrangement. He suggested to melt some of the sculptures so that:   the remaining sculptures form a regular polygon (the number of vertices should be between 3 and n),  the sum of the ti values of the remaining sculptures is maximized. Help the Vice Rector to analyze the criticism — find the maximum value of ti sum which can be obtained in this way. It is allowed not to melt any sculptures at all. The sculptures can not be moved.

The first input line contains an integer n (3 ≤ n ≤ 20000) — the initial number of sculptures. The second line contains a sequence of integers t1, t2, ..., tn, ti — the degree of the i-th sculpture's attractiveness ( - 1000 ≤ ti ≤ 1000). The numbers on the line are separated by spaces.

Print the required maximum sum of the sculptures' attractiveness.

NoteIn the first sample it is best to leave every second sculpture, that is, leave sculptures with attractivenesses: 2, 4, 5 и 3.

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . map read . words . (!! 1) . lines)

divisors :: Int -> [Int]
divisors n = concat [[x, n `div` x] | x <- [1..((+1) $ ceiling $ sqrt $ fromIntegral n)], n `mod` x == 0]

solve :: [Int] -> Int
solve values = let n = length values in maximum $ map (score values) (filter (<= (n `div` 3)) $ divisors n)

score :: [Int] -> Int -> Int
score values k = maximum $ map sum $ getGroups values k

getGroups :: [Int] -> Int -> [[Int]]
getGroups xs k = transpose $ fixedGroups [] xs k where
    fixedGroups result [] _ = result
    fixedGroups result xs k = let (h, t) = splitAt k xs in fixedGroups (h : result) t k

import Data.Function (fix)

main = do
    n <- fmap read getLine
    t <- fmap (map read . words) getLine
    let count k = toList $ foldl (\zipper ti -> next $ update (+ti) zipper) (fromList $ replicate k 0) t
    print $ maximum $ concatMap count $ filter ((>= 3) . (n `div`)) $ divisors n

type Zipper a = ([a], [a])

next :: Zipper a -> Zipper a
next ([], [])   = error "next: Empty zipper"
next (xs, [])   = ([], reverse xs)
next (xs, y:ys) = (y:xs, ys)

update :: (a -> a) -> Zipper a -> Zipper a
update f ([], [])   = error "update: Empty zipper"
update f (xs, [])   = update f ([], reverse xs)
update f (xs, y:ys) = (xs, f y:ys)

fromList :: [a] -> Zipper a
fromList [] = error "fromList: Empty zipper"
fromList xs = ([], xs)

toList :: Zipper a -> [a]
toList (xs, ys) = reverse xs ++ ys

divisors n = filter ((==0) . (n `mod`)) [1..n-1]

import Data.List

main = interact $ show . solve . map read . words where

solve (n:xss) = maximum (map solve' divisors) where
    xs = take n xss
    divisors = [x | x <- [3..n], n `mod` x == 0]
    solve' y = maximum (map sum (transpose (splitter (n `div` y) xs)))

splitter n xs = splitter' xs [] where
    splitter' [] acc = acc
    splitter' ls acc = splitter' ys (h:acc) where
        (h, ys) = splitAt n ls

import Array

getWords :: IO [String]
getWords = getLine >>= return . words

reads :: Read a => IO [a]
reads = getWords >>= return . (map read)

readArray :: Read e => IO (Array Int e)
readArray = do
    xs <- Main.reads
    return (listArray (0, length xs - 1) xs)

solve :: Array Int Int -> Int
solve array  =  maximum $ map sum (map getList [(s, r) | r <- remainders, s <- [0 .. n `div` r - 1]])
  where
    n  =  rangeSize $ bounds array
    remainders  =  filter (\m -> n `rem` m == 0) [3..n]

    getList :: (Int, Int) -> [Int]
    getList (s, r)  =  [array ! (s + i * (n `div` r)) | i <- [0 .. r - 1]]

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

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    n <- readInt
    a <- replicateM n readInt
    return (n, a)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

solve (n, a) = maximum [ calc a (n `div` i)
                       | i <- [3..n]
                       , n `mod` i == 0
                       ]
  where
    calc a m = let arr = accumArray (+) 0 (1, m) (zip (cycle [1..m]) a) :: UArray Int Int
               in maximum (elems arr)

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import Control.Applicative ((<$>), (<*>))
import Data.List (transpose, unfoldr)

main :: IO ()
main = solve <$> readLn <*> (map read . words <$> getLine) >>= print

solve :: Int -> [Int] -> Int
solve n ts = maximum [ maximum $ map sum $ transpose $ splitN (n `div` m) ts | m <- [3..n], n `mod` m == 0 ]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

import Control.Applicative ((<$>), (<*>))
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B
import Data.List (transpose, unfoldr)

main :: IO ()
main = solve <$> readLn <*> (map (fst . fromJust . B.readInt) . B.words <$> B.getLine) >>= print

solve :: Int -> [Int] -> Int
solve n ts = maximum [ maximum $ map sum $ transpose $ splitN (n `div` m) ts | m <- [3..n], n `mod` m == 0 ]

splitN :: Int -> [a] -> [[a]]
splitN n = takeWhile (not . null) . unfoldr (Just . splitAt n)

import Data.Array

divisors :: Int -> [Int]
divisors n = filter (\x -> n `mod` x == 0) [1..n]

getIndexes :: Int -> Int -> Int -> [Int]
getIndexes n period offset = take (n `div` period) $ map (\x -> x * period + offset) [0..]

getAllIndexes :: Int -> [[Int]]
getAllIndexes n = [getIndexes n period offset | period <- (divisors n), offset <- [0..period - 1], n `div` period >= 3]

solve :: Int -> [Int] -> Int
solve n bl = maximum $ map (sum . map (arr !)) $ getAllIndexes n
	where arr = listArray (0, n - 1) bl

main = do
	n <- readLn
	str <- getLine
	print $ solve n (map read $ words $ str)

import Data.Array.Unboxed
import Control.Monad
import qualified Data.ByteString.Char8 as BS

solve' n list a = maximum . elems $
        (accumArray (+) 0 (0, a-1) [ (i `mod` a, num) | (i, num) <- list ] :: UArray Int Int)

solve :: Int -> [(Int, Int)] -> Int
solve n list = maximum [solve' n list (n `div` a) | a <- [3..n], n `mod` a == 0]

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

main = do
    n <- liftM readInt BS.getLine
    list <- liftM (map readInt . BS.words) BS.getLine

    print $ solve n (zip [1..] list)

import Data.List
divisors :: Int -> [Int]
divisors n = filter (\x -> n `mod` x == 0) [3..n]
solve :: [Int] -> Int
solve (num:ts) = maximum . map solve' . divisors $ num
    where solve' y = maximum . map sum . transpose . split (num `div` y) $ ts
split :: Int -> [Int] -> [[Int]]
split n xs = split' [] xs
    where split' ps [] = ps
          split' ps qs = let (h, ys) = splitAt n qs in split' (h:ps) ys
main = putStrLn . show . solve . map read . words =<< getContents

module Main where

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

import Data.Time.Calendar

main = interact (show . solve . map read . words . (!! 1) . lines)

divisors :: Int -> [Int]
divisors n = concat [[x, n `div` x] | x <- [1..((+1) $ ceiling $ sqrt $ fromIntegral n)], n `mod` x == 0]

solve :: [Int] -> Int
solve values = maximum $ map (score values) (divisors $ length values)

score :: [Int] -> Int -> Int
score values k = maximum $ map sum $ getGroups values k

getGroups :: [Int] -> Int -> [[Int]]
getGroups xs k = transpose $ fixedGroups [] xs k where
    fixedGroups result [] _ = result
    fixedGroups result xs k = let (h, t) = splitAt k xs in fixedGroups (h : result) t k

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = solve <$> readLn <*> (map read . words <$> getLine) >>= print

solve :: Integer -> [Integer] -> Integer
solve n ts = maximum [ sum [ t | (i, t) <- zip [0..] ts, i `mod` k == l ] | k <- factors n, l <- [0..k-1] ]

factors :: Integral t => t -> [t]
factors n = [ m | m <- [1..n], n `mod` m == 0 ]

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = solve <$> readLn <*> (map read . words <$> getLine) >>= print

solve :: Integer -> [Integer] -> Integer
solve n ts = maximum [ sum [ t | (i, t) <- zip [0..] ts, i `mod` k == l ] | k <- factors n, k > 2, l <- [0..k-1] ]

factors :: Integral t => t -> [t]
factors n = [ m | m <- [1..n], n `mod` m == 0 ]


You are given a string $$$s$$$ of length $$$n$$$ consisting only of lowercase Latin letters.A substring of a string is a contiguous subsequence of that string. So, string "forces" is substring of string "codeforces", but string "coder" is not.Your task is to calculate the number of ways to remove exactly one substring from this string in such a way that all remaining characters are equal (the number of distinct characters either zero or one).It is guaranteed that there is at least two different characters in $$$s$$$.Note that you can remove the whole string and it is correct. Also note that you should remove at least one character.Since the answer can be rather large (not very large though) print it modulo $$$998244353$$$.If you are Python programmer, consider using PyPy instead of Python when you submit your code.

The first line of the input contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the length of the string $$$s$$$. The second line of the input contains the string $$$s$$$ of length $$$n$$$ consisting only of lowercase Latin letters. It is guaranteed that there is at least two different characters in $$$s$$$.

Print one integer — the number of ways modulo $$$998244353$$$ to remove exactly one substring from $$$s$$$ in such way that all remaining characters are equal.

NoteLet $$$s[l; r]$$$ be the substring of $$$s$$$ from the position $$$l$$$ to the position $$$r$$$ inclusive.Then in the first example you can remove the following substrings:   $$$s[1; 2]$$$;  $$$s[1; 3]$$$;  $$$s[1; 4]$$$;  $$$s[2; 2]$$$;  $$$s[2; 3]$$$;  $$$s[2; 4]$$$. In the second example you can remove the following substrings:   $$$s[1; 4]$$$;  $$$s[1; 5]$$$;  $$$s[1; 6]$$$;  $$$s[1; 7]$$$;  $$$s[2; 7]$$$;  $$$s[3; 7]$$$. In the third example you can remove the following substrings:   $$$s[1; 1]$$$;  $$$s[1; 2]$$$;  $$$s[2; 2]$$$.

import Data.Int

heads s = (+1) . length . takeWhile id $ zipWith (==) s (tail s)

fromIntToInt64 :: Int -> Int64
fromIntToInt64 = fromIntegral

fromInt64toInt :: Int64 -> Int
fromInt64toInt = fromIntegral

cnt :: Int -> Int -> Int -> Int
cnt x y n | x + y <= n = fromInt64toInt $ (fromIntToInt64 (x + 1)) * (fromIntToInt64 (y + 1)) `mod` (fromIntToInt64 b)
          | otherwise = x * (x + 1) `div` 2 `mod` b
          where b = 998244353

solve :: String -> Int
solve s | (head rs) == (head s) = cnt (heads s) (heads rs) (length s)
        | otherwise             = (heads s) + (heads rs) + 1
        where rs = reverse s

main = do
    _ <- getLine
    s <- getLine
    -- print $ heads s
    print $ solve s

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

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  Just (n,_) <- BS.readInt <$> BS.getLine
  xs <- getLine
  let b = head xs
      xs1 = reverse xs
      e = head xs1
      prefixlen = fromIntegral $ length $ takeWhile (== b) xs
      suffixlen = fromIntegral $ length $ takeWhile (== e) xs1
      ans = if b == e then
              ((prefixlen + 1) * (suffixlen + 1)) `mod` modulus
            else
              (prefixlen + suffixlen + 1) `mod` modulus
  print ans

modulus :: Int64
modulus = 998244353

heads s = (+1) . length . takeWhile id $ zipWith (==) s (tail s)

cnt :: Int -> Int -> Int -> Int
cnt x y n | x + y < n = (x + 1) * (y + 1) `mod` b
          | otherwise = x * (x + 1) `div` 2 `mod` b
          where b = 998244353

solve :: String -> Int
solve s | (head rs) == (head s) = cnt (heads s) (heads rs) (length s)
        | otherwise             = (heads s) + (heads rs) + 1
        where rs = reverse s

main = do
    _ <- getLine
    s <- getLine
    -- print $ heads s
    print $ solve s

heads s = (+1) . length . takeWhile id $ zipWith (==) s (tail s)

cnt :: Int -> Int -> Int -> Int
cnt x y n | x + y <= n = (x + 1) * (y + 1) `mod` b
          | otherwise = x * (x + 1) `div` 2 `mod` b
          where b = 998244353

solve :: String -> Int
solve s | (head rs) == (head s) = cnt (heads s) (heads rs) (length s)
        | otherwise             = (heads s) + (heads rs) + 1
        where rs = reverse s

main = do
    _ <- getLine
    s <- getLine
    -- print $ heads s
    print $ solve s

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

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  Just (n,_) <- BS.readInt <$> BS.getLine
  xs <- BS.getLine
  let beg = BS.head xs
      end = BS.last xs
      prefixlen = fromIntegral $ BS.length $ BS.takeWhile (== beg) xs
      suffixlen = fromIntegral $ BS.length $ snd $ BS.spanEnd (== end) xs
      ans = if beg == end then
              ((prefixlen + 1) * (suffixlen + 1)) `mod` modulus
            else
              (prefixlen + suffixlen + 1) `mod` modulus
  print ans

modulus :: Int64
modulus = 998244353

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

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  Just (n,_) <- BS.readInt <$> BS.getLine
  xs <- BS.getLine
  let beg = BS.head xs
      end = BS.last xs
      prefixlen = BS.length $ BS.takeWhile (== beg) xs
      suffixlen = BS.length $ snd $ BS.spanEnd (== end) xs
      ans = if beg == end then
              ((prefixlen + 1) * (suffixlen + 1)) `mod` modulus
            else
              (prefixlen + suffixlen + 1) `mod` modulus
  print ans

modulus :: Int
modulus = 998244353

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

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  Just (n,_) <- BS.readInt <$> BS.getLine
  xs <- BS.getLine
  let b = BS.head xs
      e = BS.last xs
      prefixlen = fromIntegral $ BS.length $ BS.takeWhile (== b) xs
      suffixlen = fromIntegral $ BS.length $ snd $ BS.spanEnd (== e) xs
      ans = if b == e then
              ((prefixlen + 1) * (suffixlen + 1)) `mod` modulus
            else
              (prefixlen + suffixlen + 1) `mod` modulus
  print ans

modulus :: Int64
modulus = 998244353

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

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int

main :: IO ()
main = do
  Just (n,_) <- BS.readInt <$> BS.getLine
  xs <- BS.getLine
  let beg = BS.head xs
      end = BS.last xs
      prefixlen = BS.length $ BS.takeWhile (== beg) xs
      suffixlen = BS.length $ snd $ BS.spanEnd (== end) xs
      ans = if beg == end then
              ((prefixlen + 1) * (suffixlen + 1)) `mod` modulus
            else if suffixlen + prefixlen == n then
              n `mod` modulus
            else
              (prefixlen + suffixlen + 1) `mod` modulus
  print ans

modulus :: Int
modulus = 998244353


You've got a robot, its task is destroying bombs on a square plane. Specifically, the square plane contains n bombs, the i-th bomb is at point with coordinates (xi, yi). We know that no two bombs are at the same point and that no bomb is at point with coordinates (0, 0). Initially, the robot is at point with coordinates (0, 0). Also, let's mark the robot's current position as (x, y). In order to destroy all the bombs, the robot can perform three types of operations:  Operation has format "1 k dir". To perform the operation robot have to move in direction dir k (k ≥ 1) times. There are only 4 directions the robot can move in: "R", "L", "U", "D". During one move the robot can move from the current point to one of following points: (x + 1, y), (x - 1, y), (x, y + 1), (x, y - 1) (corresponding to directions). It is forbidden to move from point (x, y), if at least one point on the path (besides the destination point) contains a bomb.  Operation has format "2". To perform the operation robot have to pick a bomb at point (x, y) and put it in a special container. Thus, the robot can carry the bomb from any point to any other point. The operation cannot be performed if point (x, y) has no bomb. It is forbidden to pick a bomb if the robot already has a bomb in its container.  Operation has format "3". To perform the operation robot have to take a bomb out of the container and destroy it. You are allowed to perform this operation only if the robot is at point (0, 0). It is forbidden to perform the operation if the container has no bomb. Help the robot and find the shortest possible sequence of operations he can perform to destroy all bombs on the coordinate plane.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of bombs on the coordinate plane. Next n lines contain two integers each. The i-th line contains numbers (xi, yi) ( - 109 ≤ xi, yi ≤ 109) — the coordinates of the i-th bomb. It is guaranteed that no two bombs are located at the same point and no bomb is at point (0, 0).

In a single line print a single integer k — the minimum number of operations needed to destroy all bombs. On the next lines print the descriptions of these k operations. If there are multiple sequences, you can print any of them. It is guaranteed that there is the solution where k ≤ 106.

import Data.List (sortBy)

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

f = sortBy (\(d1, _, _) (d2, _, _) -> compare d1 d2) . map (\(x:y:[]) -> (x^2 + y^2, x, y))

encompase y = show (h x) ++ "\n" ++ g x
  where x = f y

g = unlines . concat . map g'
g' (_, x, y) = filter (/="") [gx x, gy y, "2", gx' x, gy' y, "3"]

gx x
  | x > 0 = "1 " ++ show(x) ++ " R"
  | x < 0 = "1 " ++ show (abs x) ++ " L"
  | otherwise = ""

gy y
  | y > 0 = "1 " ++ show(y) ++ " U"
  | y < 0 = "1 " ++ show (abs y) ++ " D"
  | otherwise = ""

gx' x
  | x > 0 = "1 " ++ show(x) ++ " L"
  | x < 0 = "1 " ++ show (abs x) ++ " R"
  | otherwise = ""

gy' y
  | y > 0 = "1 " ++ show(y) ++ " D"
  | y < 0 = "1 " ++ show (abs y) ++ " U"
  | otherwise = ""

h = sum . map h'
h' (_, x, y) = 2*(x'+y') + 2
  where x' = fromEnum ((abs x) /= 0)
        y' = fromEnum ((abs y) /= 0)

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

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

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

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

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

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

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

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

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

data Op = Move Int Dir | PickUp | Destroy
data Dir = R | L | U | D deriving(Show,Eq)

instance Show Op where
    show (Move i d) = "1 "++show i ++ " " ++ show d
    show PickUp = "2"
    show Destroy = "3"

main = B.interact $ B.words >>> map readInt >>> process

process (n:l) = B.unlines $ ((B.pack $ show m):)$ map (B.pack . show) $ solve points
    where
    points = go l []
    go [] !acc = acc
    go (x:y:l) !acc = go l ((x,y):acc)
    ans = solve points
    m = length ans

solve ps = concat $ map doit ps'
    where
    ps' = map snd $ sort [ (d,(x,y)) | (x,y) <- ps , let d = abs x + abs y]

doit (x,y) = move x y ++ [PickUp] ++ move (-x) (-y) ++ [Destroy]
move x y = moveH x ++ moveV y
moveH 0 = []
moveH x = [Move (abs x) (if x > 0 then R else L)]
moveV 0 = []
moveV y = [Move (abs y) (if y > 0 then U else D)]

import Control.Monad (liftM, replicateM, when)
import Data.Char (ord)
import Data.List (intercalate, sortBy)
import Prelude hiding (reads)
import System.IO (hPutStrLn, stderr)
import System.CPUTime (getCPUTime)

timeout :: Bool
timeout  =  False

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

data Command  =  Go Int Char | Take | Destroy

solve :: [[Int]] -> [Command]
solve bombs  =  concatMap solve'
     $ sortBy compareBombs bombs
  where
   solve' [0, y]  =
    [
      Go (abs y) (goY y),
      Take,
      Go (abs y) (reverseY y),
      Destroy
    ]
   solve' [x, 0]  =
    [
      Go (abs x) (goX x),
      Take,
      Go (abs x) (reverseX x),
      Destroy
    ]
   solve' [x, y]  =
    [
      Go (abs x) (goX x),
      Go (abs y) (goY y),
      Take,
      Go (abs x) (reverseX x),
      Go (abs y) (reverseY y),
      Destroy
    ]
   goX a  =  if a > 0 then 'R' else 'L'
   goY a  =  if a > 0 then 'U' else 'D'
   reverseX a  =  if a > 0 then 'L' else 'R'
   reverseY a  =  if a > 0 then 'D' else 'U'
   compareBombs [x1, y1] [x2, y2]
     =  compare (abs x1 + abs y1) (abs x2 + abs y2)

print' :: Command -> String
print' (Go k c)  =  "1 " ++ show k ++ " " ++ [c]
print' Take  =  "2"
print' Destroy  =  "3"

main :: IO ()
main  =  do
    t0  <-  getCPUTime
    n  <-  readLn
    bombs  <-  replicateM n reads
    let commands  =  solve bombs
    --print $ length commands
    let zero  =  length $ filter (\[x,y] -> x == 0 || y == 0) bombs
    print (6 * (n - zero) + 4 * zero)
    mapM_ (putStrLn . print') commands
    t1 <- getCPUTime
    when timeout $
     hPutStrLn stderr $ concat ["Time = ", show (fromIntegral (t1 - t0) * 1e-12), " sec."]

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

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

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

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

data Operation = Op1 !Int !Dir
               | Op2
               | Op3

instance Show Operation where
  show (Op1 k dir) = unwords ["1",show k, show dir]
  show Op2 = "2"
  show Op3 = "3"

data Dir = R | L | U | D deriving Show

main :: IO ()
main = do
  n <- readLn :: IO Int
  xys <- sortBy (comparing $ \(x,y)->(abs x,abs y)).toPairs.map readInt.B.words <$> B.getContents
  let ops = filter (not.isStay) $ solve xys
  print $ length ops
  putStr.unlines $ map show ops

isStay :: Operation -> Bool
isStay (Op1 0 _) = True
isStay _ = False

solve :: [(Int,Int)] -> [Operation]
solve ((x,y):xys)
  | x>=0, y>=0 = Op1 x    R : Op1 y U    : Op2 : Op1 x L    : Op1 y D    : Op3 : solve xys
  | x<=0, y>=0 = Op1 (-x) L : Op1 y U    : Op2 : Op1 (-x) R : Op1 y D    : Op3 : solve xys
  | x<=0, y<=0 = Op1 (-x) L : Op1 (-y) D : Op2 : Op1 (-x) R : Op1 (-y) U : Op3 : solve xys
  | x>=0, y<=0 = Op1 x    R : Op1 (-y) D : Op2 : Op1 x L    : Op1 (-y) U : Op3 : solve xys
solve [] = []

module Main where
import System.IO
import Data.Maybe
import Data.List
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [[Int]] -> [String]
solve n xs = (show steps):(printMoves xs)
	where steps = sum $ map moves xs

norm :: [Int] -> Int
norm [x,y] = abs x + abs y

moves :: [Int] -> Int
moves [0,0] = 0
moves [_,0] = 4
moves [0,_] = 4
moves [_,_] = 6

printMoves :: [[Int]] -> [String]
printMoves [] = []
printMoves (x:xs) = (printMove x) ++ (printMoves xs)

printMove :: [Int] -> [String]
printMove [x,0] = [ "1 " ++ (show $ abs x) ++ " " ++ h
                  , "2"
                  , "1 " ++ (show $ abs x) ++ " " ++ h'
                  , "3"]
	where (h,h') = if x > 0 then ("R","L") else ("L","R")
printMove [0,y] = [ "1 " ++ (show $ abs y) ++ " " ++ v
                  , "2"
                  , "1 " ++ (show $ abs y) ++ " " ++ v'
                  , "3"]
	where (v,v') = if y > 0 then ("U","D") else ("D","U")
printMove [x,y] = [ "1 " ++ (show $ abs x) ++ " " ++ h
                  , "1 " ++ (show $ abs y) ++ " " ++ v
                  , "2"
                  , "1 " ++ (show $ abs y) ++ " " ++ v'
                  , "1 " ++ (show $ abs x) ++ " " ++ h'
                  , "3"]
	where (h,h') = if x > 0 then ("R","L") else ("L","R")
	      (v,v') = if y > 0 then ("U","D") else ("D","U")

main :: IO ()
main = do
	n <- readInt `fmap` B.getLine
	xs <- (map (map readInt . C.words) . C.lines) `fmap` B.getContents
	putStr . unlines $ solve n (sortBy (\x y -> compare (norm x) (norm y)) xs)

readInteger :: C.ByteString -> Integer
readInteger = fst . fromJust . C.readInteger

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

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

readInt :: Char8.ByteString -> Int
readInt = fst . fromJust . Char8.readInt

calc :: [(Int, Int)] -> [[String]]
calc [] = []
calc ((x, y) : xs) = goX ++ goY ++ [["2"]] ++ backX ++ backY ++ [["3"]] ++ calc xs
	where
		goX
			| x < 0 = [["1", show (-x), "L"]]
			| x > 0 = [["1", show x, "R"]]
			| otherwise = []
		goY
			| y < 0 = [["1", show (-y), "D"]]
			| y > 0 = [["1", show y, "U"]]
			| otherwise = []
		backX
			| x < 0 = [["1", show (-x), "R"]]
			| x > 0 = [["1", show x, "L"]]
			| otherwise = []
		backY
			| y < 0 = [["1", show (-y), "U"]]
			| y > 0 = [["1", show y, "D"]]
			| otherwise = []

zipXY :: [Int] -> [(Int, Int)]
zipXY [] = []
zipXY (x : y : xs) = (x, y) : zipXY xs

handle :: [Char8.ByteString] -> [[String]]
handle (_ : xs) = [show $ length res] : res
	where
		px = sortBy (comparing (\(x, y) -> (abs x) + (abs y))) $ zipXY $ map readInt xs
		res = calc px

main :: IO ()
main = do
	input <-ByteString.getContents
	putStr $ unlines $ map unwords $ handle $ Char8.words input

import Control.Monad (liftM, replicateM, when)
import Data.Char (ord)
import Data.List (intercalate, sortBy)
import Prelude hiding (reads)
import System.IO (hPutStrLn, stderr)
import System.CPUTime (getCPUTime)

timeout :: Bool
timeout  =  False

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

data Command  =  Go Int Char | Take | Destroy

solve :: [[Int]] -> [Command]
solve bombs  =  concatMap solve'
     $ sortBy compareBombs bombs
  where
   solve' [0, y]  =
    [
      Go (abs y) (goY y),
      Take,
      Go (abs y) (reverseY y),
      Destroy
    ]
   solve' [x, 0]  =
    [
      Go (abs x) (goX x),
      Take,
      Go (abs x) (reverseX x),
      Destroy
    ]
   solve' [x, y]  =
    [
      Go (abs x) (goX x),
      Go (abs y) (goY y),
      Take,
      Go (abs x) (reverseX x),
      Go (abs y) (reverseY y),
      Destroy
    ]
   goX a  =  if a > 0 then 'R' else 'L'
   goY a  =  if a > 0 then 'U' else 'D'
   reverseX a  =  if a > 0 then 'L' else 'R'
   reverseY a  =  if a > 0 then 'D' else 'U'
   compareBombs [x1, y1] [x2, y2]
     =  compare (abs x1 + abs y1) (abs x2 + abs y2)

print' :: Command -> String
print' (Go k c)  =  "1 " ++ show k ++ " " ++ [c]
print' Take  =  "2"
print' Destroy  =  "3"

main :: IO ()
main  =  do
    t0  <-  getCPUTime
    n  <-  readLn
    bombs  <-  replicateM n reads
    let commands  =  solve bombs
    --print $ length commands
    let zero  =  length $ filter (\[x,y] -> x == 0 || y == 0) bombs
    print (6 * (n - zero) + 4 * zero)
    mapM_ (putStrLn . print') commands
    t1 <- getCPUTime
    when timeout $
     hPutStrLn stderr $ concat ["Time = ", show (fromIntegral (t1 - t0) * 1e-12), " sec."]

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

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

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

data Operation = Op1 !Int !Dir
               | Op2
               | Op3

instance Show Operation where
  show (Op1 k dir) = unwords ["1",show k, show dir]
  show Op2 = "2"
  show Op3 = "3"

data Dir = R | L | U | D deriving Show

main :: IO ()
main = do
  n <- readLn :: IO Int
  xs <- map readInt.B.words <$> B.getContents
  let ops = filter (not.isStay) $ solve xs
  print $ length ops
  putStr.unlines $ map show ops

isStay :: Operation -> Bool
isStay (Op1 0 _) = True
isStay _ = False

solve :: [Int] -> [Operation]
solve (x:y:xys)
  | x>=0, y>=0 = Op1 x    R : Op1 y U    : Op2 : Op1 x L    : Op1 y D    : Op3 : solve xys
  | x<=0, y>=0 = Op1 (-x) L : Op1 y U    : Op2 : Op1 (-x) R : Op1 y D    : Op3 : solve xys
  | x<=0, y<=0 = Op1 (-x) L : Op1 (-y) D : Op2 : Op1 (-x) R : Op1 (-y) U : Op3 : solve xys
  | x>=0, y<=0 = Op1 x    R : Op1 (-y) D : Op2 : Op1 x L    : Op1 (-y) U : Op3 : solve xys
solve [] = []

module Main where
import System.IO
import Data.Maybe
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

solve :: Int -> [[Int]] -> [String]
solve n xs = (show steps):(printMoves xs)
	where steps = sum $ map moves xs

norm :: [Int] -> [Int] -> Int
norm [x1,y1] [x2,y2] = abs (x2-x1) + abs (y2-y1)

moves :: [Int] -> Int
moves [0,0] = 0
moves [_,0] = 4
moves [0,_] = 4
moves [_,_] = 6

printMoves :: [[Int]] -> [String]
printMoves [] = []
printMoves (x:xs) = (printMove x) ++ (printMoves xs)

printMove :: [Int] -> [String]
printMove [x,0] = [ "1 " ++ (show $ abs x) ++ " " ++ h
                  , "2"
                  , "1 " ++ (show $ abs x) ++ " " ++ h'
                  , "3"]
	where (h,h') = if x > 0 then ("R","L") else ("L","R")
printMove [0,y] = [ "1 " ++ (show $ abs y) ++ " " ++ v
                  , "2"
                  , "1 " ++ (show $ abs y) ++ " " ++ v'
                  , "3"]
	where (v,v') = if y > 0 then ("U","D") else ("D","U")
printMove [x,y] = [ "1 " ++ (show $ abs x) ++ " " ++ h
                  , "1 " ++ (show $ abs y) ++ " " ++ v
                  , "2"
                  , "1 " ++ (show $ abs y) ++ " " ++ v'
                  , "1 " ++ (show $ abs x) ++ " " ++ h'
                  , "3"]
	where (h,h') = if x > 0 then ("R","L") else ("L","R")
	      (v,v') = if y > 0 then ("U","D") else ("D","U")

main :: IO ()
main = do
	n <- readInt `fmap` B.getLine
	xs <- (map (map readInt . C.words) . C.lines) `fmap` B.getContents
	putStr . unlines $ solve n xs

readInteger :: C.ByteString -> Integer
readInteger = fst . fromJust . C.readInteger

readInt :: C.ByteString -> Int
readInt = fst . fromJust . C.readInt

calc :: [Int] -> [[String]]
calc [] = []
calc (x : y : xs) = goX ++ goY ++ [["2"]] ++ backX ++ backY ++ [["3"]] ++ calc xs
	where
		goX
			| x < 0 = [["1", show (-x), "L"]]
			| x > 0 = [["1", show x, "R"]]
			| otherwise = []
		goY
			| y < 0 = [["1", show (-y), "D"]]
			| y > 0 = [["1", show y, "U"]]
			| otherwise = []
		backX
			| x < 0 = [["1", show (-x), "R"]]
			| x > 0 = [["1", show x, "L"]]
			| otherwise = []
		backY
			| y < 0 = [["1", show (-y), "U"]]
			| y > 0 = [["1", show y, "D"]]
			| otherwise = []

handle :: [String] -> [[String]]
handle (sn : xs) = [show $ length res] : res
	where
		px = map read xs
		res = calc px

main :: IO ()
main = interact $ unlines . map unwords . handle . words

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

readInt :: Char8.ByteString -> Int
readInt = fst . fromJust . Char8.readInt

calc :: [(Int, Int)] -> [[String]]
calc [] = []
calc ((x, y) : xs) = goX ++ goY ++ [["2"]] ++ backX ++ backY ++ [["3"]] ++ calc xs
	where
		goX
			| x < 0 = [["1", show (-x), "L"]]
			| x > 0 = [["1", show x, "R"]]
			| otherwise = []
		goY
			| y < 0 = [["1", show (-y), "D"]]
			| y > 0 = [["1", show y, "U"]]
			| otherwise = []
		backX
			| x < 0 = [["1", show (-x), "R"]]
			| x > 0 = [["1", show x, "L"]]
			| otherwise = []
		backY
			| y < 0 = [["1", show (-y), "U"]]
			| y > 0 = [["1", show y, "D"]]
			| otherwise = []

zipXY :: [Int] -> [(Int, Int)]
zipXY [] = []
zipXY (x : y : xs) = (x, y) : zipXY xs

handle :: [Char8.ByteString] -> [[String]]
handle (_ : xs) = [show $ length res] : res
	where
		px = sortBy (comparing (\(x, y) -> x + y)) $ zipXY $ map readInt xs
		res = calc px

main :: IO ()
main = do
	input <-ByteString.getContents
	putStr $ unlines $ map unwords $ handle $ Char8.words input


Little boy Petya loves stairs very much. But he is bored from simple going up and down them — he loves jumping over several stairs at a time. As he stands on some stair, he can either jump to the next one or jump over one or two stairs at a time. But some stairs are too dirty and Petya doesn't want to step on them.Now Petya is on the first stair of the staircase, consisting of n stairs. He also knows the numbers of the dirty stairs of this staircase. Help Petya find out if he can jump through the entire staircase and reach the last stair number n without touching a dirty stair once.One has to note that anyway Petya should step on the first and last stairs, so if the first or the last stair is dirty, then Petya cannot choose a path with clean steps only.

The first line contains two integers n and m (1 ≤ n ≤ 109, 0 ≤ m ≤ 3000) — the number of stairs in the staircase and the number of dirty stairs, correspondingly. The second line contains m different space-separated integers d1, d2, ..., dm (1 ≤ di ≤ n) — the numbers of the dirty stairs (in an arbitrary order).

Print "YES" if Petya can reach stair number n, stepping only on the clean stairs. Otherwise print "NO".

import Control.Applicative
import Data.List

solve n a = if c then "YES" else "NO"
    where xs = sort a
          f xs = length xs < 3 || not ((xs!!0)+1 == xs!!1 && (xs!!1)+1 == xs!!2)
          c = null xs || (head xs /= 1 && last xs /= n && all f (tails xs))

main = do
    n:m:a <- map read . words <$> getContents
    putStrLn $ solve n a

{-# 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 = B.readInt >>> fmap fst >>> fromMaybe 0
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 . (,)

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

main = do
    (n,m) <- readIntPair
    if m == 0 then
        putStrLn "YES"
    else do
        l <- sort <$> readInts
        let a = head l
        let b = last l
        if a == 1 || b == n then
            putStrLn "NO"
        else if all (\(k,a) -> a /= 1 || k <= 1) $ map (length &&& head) $ group $ zipWith (-) (tail l) l then
            putStrLn "YES"
        else
            putStrLn "NO"

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

(<?>) :: a -> a -> Bool -> a
(<?>) a b p  =  if p then a else b

solve :: Int -> [Int] -> Bool
solve n as
  | 1 `elem` as  =  False
  | n `elem` as  =  False
  | otherwise  =  not $ threeInOrder $ sort as
  where
    threeInOrder (a:b:c:as)
      | a+1 == b && b+1 == c  =  True
      | otherwise  =  threeInOrder (b:c:as)
    threeInOrder _  =  False

main :: IO ()
main  =  do
    [n, m]  <-  reads
    if m == 0 then
        putStrLn "YES"
    else
      do
        as  <-  reads
        putStrLn $ ("YES" <?> "NO") $ solve n as

  where

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


Wilbur the pig is tinkering with arrays again. He has the array a1, a2, ..., an initially consisting of n zeros. At one step, he can choose any index i and either add 1 to all elements ai, ai + 1, ... , an or subtract 1 from all elements ai, ai + 1, ..., an. His goal is to end up with the array b1, b2, ..., bn. Of course, Wilbur wants to achieve this goal in the minimum number of steps and asks you to compute this value.

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000) — the length of the array ai. Initially ai = 0 for every position i, so this array is not given in the input. The second line of the input contains n integers b1, b2, ..., bn ( - 109 ≤ bi ≤ 109).

Print the minimum number of steps that Wilbur needs to make in order to achieve ai = bi for all i.

NoteIn the first sample, Wilbur may successively choose indices 1, 2, 3, 4, and 5, and add 1 to corresponding suffixes.In the second sample, Wilbur first chooses indices 1 and 2 and adds 1 to corresponding suffixes, then he chooses index 4 and subtract 1.

import Data.Int

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

solve :: Int64 -> [Int64] -> Int64
solve x [] = 0
solve x (y:ys) = abs (y-x) + solve y ys

import Data.Int

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

solve :: Integer -> [Integer] -> Integer
solve x [] = 0
solve x (y:ys) = abs (y-x) + solve y ys

module Main where

main :: IO ()
main = do
	n <- getInt
	as <- getInts
	print $ process as

getInt :: IO Integer
getInt = readLn

getInts :: IO [Integer]
getInts = do
	s <- getLine
	let ws = words s
	return $ map read ws

process :: [Integer] -> Integer
process = process' 0

process' :: Integer -> [Integer] -> Integer
process' start [] = 0
process' start (a : as) = if start < a
	then a - start + process' a as
	else start - a + process' a as

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

solve :: Integer -> [Integer] -> Integer
solve _ []    = 0
solve l (a:x) = (abs (a - l)) + (solve a x)

solve :: [Integer] -> Integer
solve (x:y:xs) = abs(x - y) + solve (y:xs)
solve _ = 0

main :: IO ()
main = do
    n <- getLine
    input <- getLine
    let arr = map read $ words input
    putStrLn $ show $ solve (0:arr)

import Data.Int

solve :: [Int64] -> Int64
solve (x:y:xs) = abs(x - y) + solve (y:xs)
solve _ = 0

main :: IO ()
main = do
    n <- getLine
    input <- getLine
    let arr = map read $ words input
    putStrLn $ show $ solve (0:arr)

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
answer [] res = 0
answer (a:as) res = abs (a-res) + answer as a
main = do
  n <- readLn::IO Int
  a <- map read <$>words <$> getLine ::IO [Integer]
  print $ answer a 0

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

solve :: Int -> [Int] -> Integer
solve n b = fst $ foldl f (fromIntegral $ abs $ head b, head b) $ tail b
  where
    f :: (Integer, Int) -> Int -> (Integer, Int)
    f (opsCount, arrVal) elem = (opsCount + fromIntegral (abs $ arrVal - elem), elem)

main :: IO ()
main = do
  n <- liftM (maybe 0 fst . B.readInt) B.getLine
  b <- liftM (map (maybe 0 fst . B.readInt) . B.words) B.getLine
  print $ solve n b

import Control.Applicative

solve :: [Integer] -> Integer
solve [_] = 0
solve (x:y:ys) = abs (y-x) + solve (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    bs <- map read . words <$> getLine
    print . solve $ 0 : bs

import Data.List

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

solve :: Int -> [Int] -> Int
solve x [] = 0
solve x (y:ys) = abs (y-x) + solve y ys

main :: IO ()
main = do
    n <- getLine
    input <- getLine
    let arr = map read $ words input :: [Int]
    putStrLn $ show $ foldl (\acc x -> acc + abs (x - acc)) 0 arr

solve :: [Int] -> Int
solve (x:y:xs) = abs(x - y) + solve (y:xs)
solve _ = 0

main :: IO ()
main = do
    n <- getLine
    input <- getLine
    let arr = map read $ words input
    putStrLn $ show $ solve (0:arr)

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
answer [] res = 0
answer (a:as) res = abs (a-res) + answer as a
main = do
  n <- readLn::IO Int
  a <- readLists
  print $ answer a 0

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
main = do
  n <- readLn::IO Int
  a <- readLists
  print $ (a !! 0)  + (sum $ map abs $ zipWith (-) a (tail a))

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

solve n b = foldl (\c x -> abs (x - c) + c) (abs $ head b) $ tail b

main :: IO ()
main = do
  n <- liftM (maybe 0 fst . B.readInt) B.getLine
  b <- liftM (map (maybe 0 fst . B.readInt) . B.words) B.getLine
  print $ solve n b

import Control.Applicative

solve :: [Int] -> Int
solve [_] = 0
solve (x:y:ys) = abs (y-x) + solve (y:ys)

main :: IO ()
main = do
    n <- readLn :: IO Int
    bs <- map read . words <$> getLine
    print . solve $ 0 : bs


You have $$$a$$$ coins of value $$$n$$$ and $$$b$$$ coins of value $$$1$$$. You always pay in exact change, so you want to know if there exist such $$$x$$$ and $$$y$$$ that if you take $$$x$$$ ($$$0 \le x \le a$$$) coins of value $$$n$$$ and $$$y$$$ ($$$0 \le y \le b$$$) coins of value $$$1$$$, then the total value of taken coins will be $$$S$$$.You have to answer $$$q$$$ independent test cases.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 10^4$$$) — the number of test cases. Then $$$q$$$ test cases follow. The only line of the test case contains four integers $$$a$$$, $$$b$$$, $$$n$$$ and $$$S$$$ ($$$1 \le a, b, n, S \le 10^9$$$) — the number of coins of value $$$n$$$, the number of coins of value $$$1$$$, the value $$$n$$$ and the required total value.

For the $$$i$$$-th test case print the answer on it — YES (without quotes) if there exist such $$$x$$$ and $$$y$$$ that if you take $$$x$$$ coins of value $$$n$$$ and $$$y$$$ coins of value $$$1$$$, then the total value of taken coins will be $$$S$$$, and NO otherwise. You may print every letter in any case you want (so, for example, the strings yEs, yes, Yes and YES will all be recognized as positive answer).

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

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

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

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

main = readInt >>= flip replicateM solve >>= mapM_ ( putStrLn . which "YES" "NO" )

solve = do
	[ a, b, n, s ] <- readInts
	let
		x = min a $ s `div` n
		remaining = s - x * n
	return $ remaining <= b

import Control.Monad

solve :: Integer -> Integer -> Integer -> Integer -> Bool
solve a b n s = rest<=b
  where
    rest = max (s-n*a) (mod s n)

routine :: IO ()
routine = do
  [a,b,n,s] <- fmap (map read.words) getLine
  putStrLn (if solve a b n s then "YES" else "NO")

main :: IO ()
main = do
  m <- readLn
  replicateM_ m routine

main = getLine >> (interact $ unlines . map (solve . map read . words) . lines)

solve [a,b,n,s]
    | r <= b = "YES"
    | otherwise = "NO"
    where r = s - n * (min a $ s `div` n)

-- http://codeforces.com/contest/1256/problem/A

data Case = Case { ns :: Int
                 , ones :: Int
                 , nValue :: Int
                 , total :: Int
                 }

data Answer = YES | NO deriving (Show)

toCase :: String -> Case
toCase line = do
  let ints = map read $ words line :: [Int]
  Case { ns = ints !! 0
       , ones = ints !! 1
       , nValue = ints !! 2
       , total = ints !! 3
       }

getUsedNs :: Case -> Int
getUsedNs (Case ns _ nValue total) = do
    let requiredNs = total `div` nValue
    min ns requiredNs

getUsedOnes :: Int -> Int -> Int -> Int
getUsedOnes totalN ones total = do
    let requiredOnes = total - totalN
    min ones requiredOnes

toAnswer :: Bool -> Answer
toAnswer boolean
  | boolean = YES
  | otherwise = NO

solve :: Case -> Answer
solve (Case ns ones nValue total) = do
  toAnswer (totalN + usedOnes == total)
  where usedNs = getUsedNs (Case ns ones nValue total)
        totalN = usedNs * nValue
        usedOnes = getUsedOnes totalN ones total

main :: IO ()
main = interact $ unlines . map (show . solve . toCase) . tail . lines

main = interact main'
main' =
    unlines . map (f . map read . words) . drop 1 . lines

f [a, b, n, s]
    =
        if not enough
        then "NO"
        else "YES"
    where
        req_a = min (s `div` n) a
        req_b = s - n * req_a
        enough = req_b <= b

import Control.Monad

solve :: Int -> Int -> Int -> Int -> Bool
solve a b n s = rest<=b
  where
    rest = max (s-n*a) (mod s n)

routine :: IO ()
routine = do
  [a,b,n,s] <- fmap (map read.words) getLine
  putStrLn (if solve a b n s then "YES" else "NO")

main :: IO ()
main = do
  m <- readLn
  replicateM_ m routine

import Control.Monad

solve :: Int -> Int -> Int -> Int -> Bool
solve a b n s = rest<=b
  where
    rest = max (s-n*a) (mod s n)

routine :: IO ()
routine = do
  [a,b,n,s] <- fmap (map read.words) getLine
  putStrLn (if solve a b n s then "YES" else "NO")

main :: IO ()
main = do
  n <- readLn
  replicateM_ n routine

-- http://codeforces.com/contest/1256/problem/A

data Case = Case { ns :: Int
                 , ones :: Int
                 , nValue :: Int
                 , total :: Int
                 }

data Answer = YES | NO deriving (Show)

toCase :: String -> Case
toCase line = do
  let ints = map read $ words line :: [Int]
  Case { ns = ints !! 0
       , ones = ints !! 1
       , nValue = ints !! 2
       , total = ints !! 3
       }

toAnswer :: Bool -> Answer
toAnswer boolean
  | boolean = YES
  | otherwise = NO

solve :: Case -> Answer
solve (Case ns ones nValue total)
  | ones >= total = YES
  | otherwise = toAnswer (intDivision <= ns && modValue <= ones)
  where intDivision = total `div` nValue
        modValue = total `mod` nValue

main :: IO ()
main = interact $ unlines . map (show . solve . toCase) . tail . lines

-- http://codeforces.com/contest/1256/problem/A

data Case = Case { ns :: Int
                 , ones :: Int
                 , nValue :: Int
                 , total :: Int
                 }

data Answer = YES | NO deriving (Show)

toCase :: String -> Case
toCase line = do
  let ints = map read $ words line :: [Int]
  Case { ns = ints !! 0
       , ones = ints !! 1
       , nValue = ints !! 2
       , total = ints !! 3
       }

toAnswer :: Bool -> Answer
toAnswer boolean
  | boolean = YES
  | otherwise = NO

solve :: Case -> Answer
solve (Case ns ones nValue total) =
  toAnswer (intDivision <= ns && modValue <= ones)
  where intDivision = total `div` nValue
        modValue = total `mod` nValue

main :: IO ()
main = interact $ unlines . map (show . solve . toCase) . tail . lines


Bizon the Champion isn't just friendly, he also is a rigorous coder.Let's define function f(a), where a is a sequence of integers. Function f(a) returns the following sequence: first all divisors of a1 go in the increasing order, then all divisors of a2 go in the increasing order, and so on till the last element of sequence a. For example, f([2, 9, 1]) = [1, 2, 1, 3, 9, 1].Let's determine the sequence Xi, for integer i (i ≥ 0): X0 = [X] ([X] is a sequence consisting of a single number X), Xi = f(Xi - 1) (i > 0). For example, at X = 6 we get X0 = [6], X1 = [1, 2, 3, 6], X2 = [1, 1, 2, 1, 3, 1, 2, 3, 6].Given the numbers X and k, find the sequence Xk. As the answer can be rather large, find only the first 105 elements of this sequence.

A single line contains two space-separated integers — X (1 ≤ X ≤ 1012) and k (0 ≤ k ≤ 1018).

Print the elements of the sequence Xk in a single line, separated by a space. If the number of elements exceeds 105, then print only the first 105 elements.

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}

import qualified Data.Map as M
import Data.List

main = interact $ unwords.map show.solve.map read.words

solve :: [Integer] -> [Integer]
solve [x, k]
  | x == 1 = [1]
  | k >= 100000 = replicate 100000 1
  | otherwise = take 100000 $ dfs (fromIntegral k) x -- iterate step [x] !! fromIntegral k
   where
     !cache = M.fromList [(key, divisors key)|key<-divisors x]
     dfs !n !x
       | x == 1 = [1]
       | n == 0 = [x]
       | otherwise = case cache M.! x of
                       [1,p] -> replicate n 1 ++ [p]
                       ds -> ds >>= dfs (n-1)

divisors :: Integer -> [Integer]
divisors n = sort.map product.mapM(scanl(*)1).group $ primeFactors n

primeFactors :: Integer -> [Integer]
primeFactors n | n < 2 = []
primeFactors n = go n $ 2:[3,5..]
   where
     go !n pps@(p:ps)
       | n < p*p   = [n]
       | r > 0     = go n ps
       | otherwise = p : go q pps
      where
        (q, r) = quotRem n p


You are given an array $$$a$$$ consisting of $$$n$$$ integers. You can perform the following operations arbitrary number of times (possibly, zero):  Choose a pair of indices $$$(i, j)$$$ such that $$$|i-j|=1$$$ (indices $$$i$$$ and $$$j$$$ are adjacent) and set $$$a_i := a_i + |a_i - a_j|$$$;  Choose a pair of indices $$$(i, j)$$$ such that $$$|i-j|=1$$$ (indices $$$i$$$ and $$$j$$$ are adjacent) and set $$$a_i := a_i - |a_i - a_j|$$$. The value $$$|x|$$$ means the absolute value of $$$x$$$. For example, $$$|4| = 4$$$, $$$|-3| = 3$$$.Your task is to find the minimum number of operations required to obtain the array of equal elements and print the order of operations to do it.It is guaranteed that you always can obtain the array of equal elements using such operations.Note that after each operation each element of the current array should not exceed $$$10^{18}$$$ by absolute value.

The first line of the input contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of elements in $$$a$$$. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$0 \le a_i \le 2 \cdot 10^5$$$), where $$$a_i$$$ is the $$$i$$$-th element of $$$a$$$.

In the first line print one integer $$$k$$$ — the minimum number of operations required to obtain the array of equal elements. In the next $$$k$$$ lines print operations itself. The $$$p$$$-th operation should be printed as a triple of integers $$$(t_p, i_p, j_p)$$$, where $$$t_p$$$ is either $$$1$$$ or $$$2$$$ ($$$1$$$ means that you perform the operation of the first type, and $$$2$$$ means that you perform the operation of the second type), and $$$i_p$$$ and $$$j_p$$$ are indices of adjacent elements of the array such that $$$1 \le i_p, j_p \le n$$$, $$$|i_p - j_p| = 1$$$. See the examples for better understanding. Note that after each operation each element of the current array should not exceed $$$10^{18}$$$ by absolute value. If there are many possible answers, you can print any.

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, FlexibleContexts, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char
import Data.Array.ST.Safe
import Control.Monad.ST
import Control.Monad
import Data.Array.Unboxed
import Data.Int
import Data.List

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

solve :: [Int] -> Builder
solve (n:a) = res
  where
    !m = maximum a
    c = runSTUArray $ do
      d <- newArray (0, m) 0 :: ST s (STUArray s Int Int)
      forM a $ \j -> readArray d j >>= ((writeArray d j) . succ)
      return d
    !maxc = maximum $ elems c
    !o = head $ filter ( ( == maxc) .  ( c !)) [0 .. m]
    res = runST $ do
      z <- newListArray (1, n) a :: ST s (STUArray s Int Int)
      let out i j ai = char7 (if ai < o then '1' else '2') <> char7 ' ' <> intDec i <> char7 ' ' <> intDec j <> char7 '\n'
          go j i = do
             if (j >= 1 && j <= n) then do
               w <- readArray z j
               if (w /= o) then do
                 let b = out j i w
                 writeArray z j o
                 liftM2 (\ b1 b2 -> b <> b1 <> b2) (go (pred j) j) (go (succ j) j)
               else return mempty
             else return mempty
      foldM (\ b !i -> do
               w <- readArray z i
               if (w == o) then liftM2 (\ b1 b2 -> b <> b1 <> b2) (go (pred i) i) (go (succ i) i)
               else return b
            ) (intDec (n - maxc) <> char7 '\n') [1 .. n]

main :: IO ()
main = hPutBuilder stdout . solve . map ri . C.words =<< C.getContents


Beroffice text editor has a wide range of features that help working with text. One of the features is an automatic search for typos and suggestions of how to fix them.Beroffice works only with small English letters (i.e. with 26 letters from a to z). Beroffice thinks that a word is typed with a typo if there are three or more consonants in a row in the word. The only exception is that if the block of consonants has all letters the same, then this block (even if its length is greater than three) is not considered a typo. Formally, a word is typed with a typo if there is a block of not less that three consonants in a row, and there are at least two different letters in this block.For example:  the following words have typos: "hellno", "hackcerrs" and "backtothefutttture";  the following words don't have typos: "helllllooooo", "tobeornottobe" and "oooooo". When Beroffice editor finds a word with a typo, it inserts as little as possible number of spaces in this word (dividing it into several words) in such a way that each of the resulting words is typed without any typos.Implement this feature of Beroffice editor. Consider the following letters as the only vowels: 'a', 'e', 'i', 'o' and 'u'. All the other letters are consonants in this problem.

The only line contains a non-empty word consisting of small English letters. The length of the word is between 1 and 3000 letters.

Print the given word without any changes if there are no typos. If there is at least one typo in the word, insert the minimum number of spaces into the word so that each of the resulting words doesn't have any typos. If there are multiple solutions, print any of them.

import Data.List
import Data.Array
import Data.Char

vow 'a' = True
vow 'e' = True
vow 'i' = True
vow 'o' = True
vow 'u' = True
vow _ = False

solve [] _ _ _ = []
solve (x:xs) c last diff
	|(not (vow x)) && (c>=2) && ((x/=last) || diff) = ' ':x:(solve xs 1 x False)
	|(not (vow x)) && ((x/=last) || diff)= x:solve xs (c+1) x True
	|(not (vow x)) = x:solve xs (c+1) x diff
	|otherwise = x:solve xs 0 (head xs) False

main=do
	l<- getLine
	putStrLn (solve l 0 (head l) False)

is_vowel :: Char -> Bool
is_vowel 'a' = True
is_vowel 'e' = True
is_vowel 'i' = True
is_vowel 'o' = True
is_vowel 'u' = True
is_vowel ch  = False

f :: String -> String
f ""                            = ""
f (a:"")                        = a : ""
f (a:rema)                      = a : s' ++ sub_ans
                                where s  = takeWhile (\x -> x == a) rema
                                      t  = dropWhile (\x -> x == a) rema
                                      l = length s
                                      s' = if l == 0 then [head rema] else s
                                      t' = if l == 0 then tail rema else t
                                      sub_ans = if null t' then "" else ' ' : f t'

g :: String -> String
g ""                        = ""
g (a:rema) | is_vowel a     = a : g rema
           | otherwise      = f (a:s) ++ g t
                            where s = takeWhile (not . is_vowel) rema
                                  t = dropWhile (not . is_vowel) rema

main :: IO ()
main = do
    line <- getLine
    putStrLn $ g line

import Data.List
import Data.Array
import Data.Char

vow 'a' = True
vow 'e' = True
vow 'i' = True
vow 'o' = True
vow 'u' = True
vow _ = False

solve [] _ = []
solve (x:xs) c
	|(not (vow x)) && (c==2) = ' ':x:(solve xs 0)
	|(not (vow x)) = x:solve xs (c+1)
	|vow x = x:solve xs 0
	|otherwise = x:solve xs c

main=do
	l<- getLine
	putStrLn (solve l 0)

import Data.List
import Data.Array
import Data.Char

vow 'a' = True
vow 'e' = True
vow 'i' = True
vow 'o' = True
vow 'u' = True
vow _ = False

solve [] _ = []
solve (x:xs) c
	|(not (vow x)) && (c==2) = ' ':x:(solve xs 0)
	|(not (vow x)) = x:solve xs (c+1)
	|otherwise = x:solve xs c

main=do
	l<- getLine
	putStrLn (solve l 0)

is_vowel :: Char -> Bool
is_vowel 'a' = True
is_vowel 'e' = True
is_vowel 'i' = True
is_vowel 'o' = True
is_vowel 'u' = True
is_vowel ch  = False

f :: String -> String
f ""                            = ""
f (a:"")                        = a : ""
f (a:b:"")                      = a : b : ""
f (a:rema)                      = a : s' ++ (' ' : f t')
                                where s  = takeWhile (\x -> x == a) rema
                                      t  = dropWhile (\x -> x == a) rema
                                      l = length s
                                      s' = if l == 0 then [head rema] else s
                                      t' = if l == 0 then tail rema else t

g :: String -> String
g ""                        = ""
g (a:rema) | is_vowel a     = a : g rema
           | otherwise      = f (a:s) ++ g t
                            where s = takeWhile (not . is_vowel) rema
                                  t = dropWhile (not . is_vowel) rema

main :: IO ()
main = do
    line <- getLine
    putStrLn $ g line

is_vowel :: Char -> Bool
is_vowel 'a' = True
is_vowel 'e' = True
is_vowel 'i' = True
is_vowel 'o' = True
is_vowel 'u' = True
is_vowel ch  = False

f :: String -> String
f ""                            = ""
f (a:"")                        = a : ""
f (a:rema)      | is_vowel a    = a : f rema
                | otherwise  = let s'' = takeWhile is_vowel t'
                                   t'' = dropWhile is_vowel t'
                                   in a : s' ++ s'' ++ (' ' : f t'')
                where s  = takeWhile (\x -> x == a) rema
                      t  = dropWhile (\x -> x == a) rema
                      l = length s
                      s' = if l == 0 then [head rema] else s
                      t' = if l == 0 then tail rema else t

main :: IO ()
main = do
    line <- getLine
    putStrLn $ f line


Alice and Bob play the following game. Alice has a set $$$S$$$ of disjoint ranges of integers, initially containing only one range $$$[1, n]$$$. In one turn, Alice picks a range $$$[l, r]$$$ from the set $$$S$$$ and asks Bob to pick a number in the range. Bob chooses a number $$$d$$$ ($$$l \le d \le r$$$). Then Alice removes $$$[l, r]$$$ from $$$S$$$ and puts into the set $$$S$$$ the range $$$[l, d - 1]$$$ (if $$$l \le d - 1$$$) and the range $$$[d + 1, r]$$$ (if $$$d + 1 \le r$$$). The game ends when the set $$$S$$$ is empty. We can show that the number of turns in each game is exactly $$$n$$$.After playing the game, Alice remembers all the ranges $$$[l, r]$$$ she picked from the set $$$S$$$, but Bob does not remember any of the numbers that he picked. But Bob is smart, and he knows he can find out his numbers $$$d$$$ from Alice's ranges, and so he asks you for help with your programming skill.Given the list of ranges that Alice has picked ($$$[l, r]$$$), for each range, help Bob find the number $$$d$$$ that Bob has picked.We can show that there is always a unique way for Bob to choose his number for a list of valid ranges picked by Alice.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 1000$$$). Description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 1000$$$). Each of the next $$$n$$$ lines contains two integers $$$l$$$ and $$$r$$$ ($$$1 \le l \le r \le n$$$), denoting the range $$$[l, r]$$$ that Alice picked at some point. Note that the ranges are given in no particular order. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$1000$$$, and the ranges for each test case are from a valid game.

For each test case print $$$n$$$ lines. Each line should contain three integers $$$l$$$, $$$r$$$, and $$$d$$$, denoting that for Alice's range $$$[l, r]$$$ Bob picked the number $$$d$$$. You can print the lines in any order. We can show that the answer is unique. It is not required to print a new line after each test case. The new lines in the output of the example are for readability only.

NoteIn the first test case, there is only 1 range $$$[1, 1]$$$. There was only one range $$$[1, 1]$$$ for Alice to pick, and there was only one number $$$1$$$ for Bob to pick.In the second test case, $$$n = 3$$$. Initially, the set contains only one range $$$[1, 3]$$$.   Alice picked the range $$$[1, 3]$$$. Bob picked the number $$$1$$$. Then Alice put the range $$$[2, 3]$$$ back to the set, which after this turn is the only range in the set.  Alice picked the range $$$[2, 3]$$$. Bob picked the number $$$3$$$. Then Alice put the range $$$[2, 2]$$$ back to the set.  Alice picked the range $$$[2, 2]$$$. Bob picked the number $$$2$$$. The game ended. In the fourth test case, the game was played with $$$n = 5$$$. Initially, the set contains only one range $$$[1, 5]$$$. The game's turn is described in the following table.  Game turnAlice's picked rangeBob's picked numberThe range set afterBefore the game start$$$ \{ [1, 5] \} $$$1$$$[1, 5]$$$$$$3$$$$$$ \{ [1, 2], [4, 5] \}$$$2$$$[1, 2]$$$$$$1$$$$$$ \{ [2, 2], [4, 5] \} $$$3$$$[4, 5]$$$$$$5$$$$$$ \{ [2, 2], [4, 4] \} $$$4$$$[2, 2]$$$$$$2$$$$$$ \{ [4, 4] \} $$$5$$$[4, 4]$$$$$$4$$$$$$ \{ \} $$$ (empty set)

import Data.Function
import Data.List
import Data.Char
import Text.ParserCombinators.ReadP
import Data.Set (Set)
import qualified Data.Set as S

main :: IO ()
main = interact (unlines . map showTriple . concatMap solve . readInput)

showTriple :: (Int, Int, Int) -> String
showTriple (a, b, c) = show a ++ " " ++ show b ++ " " ++ show c

parseInt :: ReadP Int
parseInt = fmap read $ many1 $ satisfy isDigit

parseRange :: ReadP (Int, Int)
parseRange = do
  l <- parseInt
  skipSpaces
  r <- parseInt
  _ <- char '\n'
  return (l, r)

parseCase :: ReadP [(Int, Int)]
parseCase = do
  n <- parseInt
  _ <- char '\n'
  count n parseRange

parseInput :: ReadP [[(Int, Int)]]
parseInput = do
  n <- parseInt
  _ <- char '\n'
  count n parseCase

readInput :: String -> [[(Int, Int)]]
readInput = fst . last . readP_to_S parseInput

solve :: [(Int, Int)] -> [(Int, Int, Int)]
solve = S.toList . foldl' pick S.empty . sortRanges

pick :: Set (Int, Int, Int) -> (Int, Int) -> Set (Int, Int, Int)
pick exclude (l, r) = (l, r, p) `S.insert` exclude
  where
    p = head $ S.elems $ S.fromDistinctAscList [l..r] S.\\ S.map ignoreRange exclude
    ignoreRange (_, _, p) = p

sortRanges :: [(Int, Int)] -> [(Int, Int)]
sortRanges = sortBy compareRange

compareRange :: (Int, Int) -> (Int, Int) -> Ordering
compareRange = compare `on` dist

dist :: (Int, Int) -> Int
dist (l, r) = abs $ l - r


Several days ago you bought a new house and now you are planning to start a renovation. Since winters in your region can be very cold you need to decide how to heat rooms in your house.Your house has $$$n$$$ rooms. In the $$$i$$$-th room you can install at most $$$c_i$$$ heating radiators. Each radiator can have several sections, but the cost of the radiator with $$$k$$$ sections is equal to $$$k^2$$$ burles.Since rooms can have different sizes, you calculated that you need at least $$$sum_i$$$ sections in total in the $$$i$$$-th room. For each room calculate the minimum cost to install at most $$$c_i$$$ radiators with total number of sections not less than $$$sum_i$$$.

The first line contains single integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of rooms. Each of the next $$$n$$$ lines contains the description of some room. The $$$i$$$-th line contains two integers $$$c_i$$$ and $$$sum_i$$$ ($$$1 \le c_i, sum_i \le 10^4$$$) — the maximum number of radiators and the minimum total number of sections in the $$$i$$$-th room, respectively.

For each room print one integer — the minimum possible cost to install at most $$$c_i$$$ radiators with total number of sections not less than $$$sum_i$$$.

NoteIn the first room, you can install only one radiator, so it's optimal to use the radiator with $$$sum_1$$$ sections. The cost of the radiator is equal to $$$(10^4)^2 = 10^8$$$.In the second room, you can install up to $$$10^4$$$ radiators, but since you need only one section in total, it's optimal to buy one radiator with one section.In the third room, there $$$7$$$ variants to install radiators: $$$[6, 0]$$$, $$$[5, 1]$$$, $$$[4, 2]$$$, $$$[3, 3]$$$, $$$[2, 4]$$$, $$$[1, 5]$$$, $$$[0, 6]$$$. The optimal variant is $$$[3, 3]$$$ and it costs $$$3^2+ 3^2 = 18$$$.

import Control.Monad
-- import Data.List

getStrList :: IO [String]
getStrList = fmap words getLine

getIntList :: IO [Integer]
getIntList = fmap (map read) getStrList

f :: Integer -> Integer -> Integer
f c s
    | r == 0 = c * d * d
    | otherwise = r * (d + 1) * (d + 1) + (c - r) * d * d
    where r = s `mod` c
          d = s `div` c

main :: IO()
main = do
    t <- readLn
    replicateM_ t $ do
        [c, s] <- getIntList
        print $ f c s

import Control.Monad

solve :: Int -> Int -> Int
solve x y = (n^2)*(x-m)+((n+1)^2)*m
  where
    n = y `div` x
    m = y `mod` x

routine :: IO ()
routine = do
   l <- fmap ((map read).words) getLine
   print $ solve (l!!0) (l!!1)

main :: IO ()
main = do
  n <- readLn
  replicateM_ n $ routine


Andrew's favourite Krakozyabra has recenly fled away and now he's eager to bring it back!At the moment the refugee is inside an icy cave with n icicles dangling from the ceiling located in integer coordinates numbered from 1 to n. The distance between floor and the i-th icicle is equal to ai.Andrew is free to choose an arbitrary integer point T in range from 1 to n inclusive and at time instant 0 launch a sound wave spreading into both sides (left and right) at the speed of one point per second. Any icicle touched by the wave starts falling at the same speed (that means that in a second the distance from floor to icicle decreases by one but cannot become less that zero). While distance from icicle to floor is more than zero, it is considered passable; as soon as it becomes zero, the icicle blocks the path and prohibits passing.Krakozyabra is initially (i.e. at time instant 0) is located at point  and starts running in the right direction at the speed of one point per second. You can assume that events in a single second happen in the following order: first Krakozyabra changes its position, and only then the sound spreads and icicles fall; in particular, that means that if Krakozyabra is currently at point  and the falling (i.e. already touched by the sound wave) icicle at point i is 1 point from the floor, then Krakozyabra will pass it and find itself at  and only after that the icicle will finally fall and block the path.Krakozyabra is considered entrapped if there are fallen (i.e. with ai = 0) icicles both to the left and to the right of its current position. Help Andrew find the minimum possible time it takes to entrap Krakozyabra by choosing the optimal value of T or report that this mission is impossible.

The first line contains the number of icicles n (2 ≤ n ≤ 105). The next line contains n space-separated numbers ai (1 ≤ ai ≤ 105) — the distances from floor to icicles.

Print an only integer — the minimum time it takes to entrap Krakozyabra between two fallen icicles. If it is impossible, print  - 1.

NoteIn sample case one it's optimal to launch the sound wave from point 3. Then in two seconds icicles 1 and 5 will start falling, and in one more seconds they will block the paths. Krakozyabra will be located at  at that time. Note that icicle number 3 will also be fallen, so there will actually be two icicles blocking the path to the left.In sample case two it is optimal to launch the wave from point 2 and entrap Krakozyabra in 2 seconds.In sample case four the answer is impossible.

{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Control.Arrow (first)
import Control.Monad
import Control.Applicative ((<*>))
import Data.Functor
import Data.Bits
import Data.List
import Data.Ord
import Data.Array as A
import qualified Data.Array.Unboxed as UA
import Data.Array.IO.Safe as A
import qualified Data.ByteString.Char8 as BS
import Data.IORef
import Data.Set as S

type I = Int

readInt :: Integral a => BS.ByteString -> a
readInt = fromInteger . fst . (\(Just i) -> i) . BS.readInteger

readIntList :: IO [Int]
readIntList = (fmap readInt . BS.words) <$> BS.getLine

type ITree = (IOUArray Int I, Int)

newITree :: Int -> IO ITree
newITree n = (,m) <$> newArray (1, m + m + 1) (10^6)
  where m = pred $ head $ dropWhile (<n) $ shiftL 1 <$> [1..]

modifyITree :: ITree -> Int -> Int -> IO ()
modifyITree (a, m) i x = writeArray a (i + m) x >> go ((i + m) `shiftR` 1)
  where
    go 0 = return ()
    go j = do
      child1 <- readArray a (j `shiftL` 1)
      child2 <- readArray a (1 + j `shiftL` 1)
      writeArray a j (min child1 child2)
      go $ j `shiftR` 1

segmentMin :: Int -> Int -> ITree -> IO Int
segmentMin l r (a, m) = go (l + m) (r + m)
  where
    go l r
      | l == r = readArray a l
      | otherwise = do
        (min <$> readArray a l) <*> (min <$> readArray a r <*> go ((l + 1) `shiftR` 1) ((r-1) `shiftR` 1))

printITree :: ITree -> IO ()
printITree (a, m) = do
  (b :: UA.UArray Int Int) <- freeze a
  print (b, m)

genMoves :: Int -> Int -> Int -> [(Int, (Int, Int, Int))]
genMoves n i ai = moves1 ++ moves2 ++ moves3
  where
    moves1
      | i <= ai = []
      | otherwise = [(ai + 1, (1, i, ai))]
    moves2
      | i <= ai = [(i, (4, i, ai))]
      | otherwise = [(i, (2, i, ai))]
    moves3
      | i <= ai = []
      | i + i - ai > n = []
      | otherwise = [(i + i - ai, (3, i, ai))]

type State = (ITree, IORef (Set (Int, Int)), IORef (Set (Int, Int)), ITree)

move :: State -> (Int, Int, Int) -> IO ()
move (s1, s2, s3, s4) (moveType, i, ai) = case moveType of
  1 -> do
    modifyITree s1 i (10^6)
    modifyIORef s2 $ S.insert (ai + i, i)
  2 -> do
    modifyIORef s2 $ S.delete (ai + i, i)
    modifyIORef s3 $ S.insert (ai - i, i)
  3 -> do
    modifyIORef s3 $ S.delete (ai - i, i)
    modifyITree s4 i (ai - i)
  4 -> do
    modifyITree s1 i (10^6)
    modifyITree s4 i (ai - i)

smin :: Set (Int, Int) -> (Int, Int)
smin s = if S.null s then (10^6, 0) else S.findMin s

score :: State -> Int -> IO Int
score (s1, s2, s3, s4) t = do
  r1 <- first (subtract t) . smin <$> readIORef s2
  r2 <- first (+t) . smin <$> readIORef s3
  let (rt, ri) = min r1 r2
  if rt > 5 * 10^5 || ri <= 1 then return (10^6) else do
    lt1 <- subtract t <$> segmentMin 1 (ri-1) s1
    lt2 <- (+t) <$> segmentMin 1 (ri-1) s4
    return $ max rt (min lt1 lt2)

printState :: Int -> State -> IO ()
printState t s@(s1, s2, s3, s4) = when False $ do
  sc <- score s t
  print $ "State for t=" ++ show t ++ "; score=" ++ show sc
  print "s1 ="
  printITree s1
  print "s2 ="
  print =<< readIORef s2
  print "s3 ="
  print =<< readIORef s3
  print "s4 ="
  printITree s4

solve :: [Int] -> IO Int
solve a = do
  let n = length a
  s1 <- newITree n
  s2 <- newIORef S.empty
  s3 <- newIORef S.empty
  s4 <- newITree n
  zipWithM_ (\i ai -> modifyITree s1 i (ai + i)) [1..] a
  let
    !s = (s1, s2, s3, s4)
    !moves = accumArray (flip (:)) [] (1,n) $
      concatMap (\(i, ai) -> genMoves n i ai) $ zip [1..] a
  --print moves
  printState 0 s
  foldM
    (\sc (t, mvs) -> mapM_ (move s) (reverse mvs) >> printState t s >> min sc <$> score s t)
    (10^6) (assocs moves)

naiveScore :: [Int] -> Int -> Int
naiveScore a t = uncurry max $ minimumBy (comparing fst) $
  scanl (\(tr, tl) (i, ai) ->
    let f = ai + abs (t-i) in if f >= i then (10^6, min tl f) else (f, tl)) (10^6, 10^6) (zip [1..] a)

naiveSolve :: [Int] -> IO Int
naiveSolve a = return $ minimum $ naiveScore a <$> [1..length a]

finalize :: Int -> Int
finalize x = if x > 5 * 10^5 then -1 else x

main = do
  _ <- BS.getLine
  a <- readIntList
  print . finalize =<< solve a


Vasya's telephone contains n photos. Photo number 1 is currently opened on the phone. It is allowed to move left and right to the adjacent photo by swiping finger over the screen. If you swipe left from the first photo, you reach photo n. Similarly, by swiping right from the last photo you reach photo 1. It takes a seconds to swipe from photo to adjacent.For each photo it is known which orientation is intended for it — horizontal or vertical. Phone is in the vertical orientation and can't be rotated. It takes b second to change orientation of the photo.Vasya has T seconds to watch photos. He want to watch as many photos as possible. If Vasya opens the photo for the first time, he spends 1 second to notice all details in it. If photo is in the wrong orientation, he spends b seconds on rotating it before watching it. If Vasya has already opened the photo, he just skips it (so he doesn't spend any time for watching it or for changing its orientation). It is not allowed to skip unseen photos.Help Vasya find the maximum number of photos he is able to watch during T seconds.

The first line of the input contains 4 integers n, a, b, T (1 ≤ n ≤ 5·105, 1 ≤ a, b ≤ 1000, 1 ≤ T ≤ 109) — the number of photos, time to move from a photo to adjacent, time to change orientation of a photo and time Vasya can spend for watching photo. Second line of the input contains a string of length n containing symbols 'w' and 'h'.  If the i-th position of a string contains 'w', then the photo i should be seen in the horizontal orientation. If the i-th position of a string contains 'h', then the photo i should be seen in vertical orientation.

Output the only integer, the maximum number of photos Vasya is able to watch during those T seconds.

NoteIn the first sample test you can rotate the first photo (3 seconds), watch the first photo (1 seconds), move left (2 second), rotate fourth photo (3 seconds), watch fourth photo (1 second). The whole process takes exactly 10 seconds.Note that in the last sample test the time is not enough even to watch the first photo, also you can't skip it.

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import Data.Maybe
import Data.Function(on)
import Data.Tuple(swap)
--import Debug.Trace
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    [n,a,b,t] <- readInts
    s <- getLine
    let calc _ [] = []
        calc !acc ('w':xs) = 1+b+acc : calc (1+a+b+acc) xs
        calc !acc ('h':xs) = 1+acc   : calc (1+a+acc)   xs
    if last (calc 0 s) <= t then
        print n
    else do
        let solve xs = go 0 0 xs
                where
                score = calc 0 (reverse xs)
                tbl = M.fromList $ zip score [1..]
                --go k acc l | traceShow (k,acc,l) False = undefined
                go _ _ [] = 0
                go !k !acc (ch:xs)
                    | acc + 1 + b' > t = k
                    | otherwise = max s1 (go (k+1) (acc+1+a+b') xs)
                    where
                    s1 = case M.lookupLT (lim+1) tbl of
                            Nothing -> k + 1
                            Just (_,v) -> k + 1 + v
                    lim = t - (1 + b' + acc + (k+1) * a)
                    b' = if ch == 'w' then b else 0
        print $ max (solve s)
                    (solve (take n $ head s:reverse s))

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import Data.Maybe
import Data.Function(on)
import Data.Tuple(swap)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    [n,a,b,t] <- readInts
    s <- getLine
    let calc _ [] = []
        calc !acc ('w':xs) = 1+b+acc : calc (1+a+b+acc) xs
        calc !acc ('h':xs) = 1+acc   : calc (1+a+acc)   xs
    if last (calc 0 s) <= t then
        print n
    else do
        let solve xs = go 0 0 xs
                where
                score = calc 0 $ reverse xs
                tbl = M.fromList $ zip score [1..]
                go _ _ [] = 0
                go !k !acc (ch:xs)
                    | acc + 1 + b' > lim = k
                    | otherwise = max s1 (go (k+1) (acc+1+a+b') xs)
                    where
                    s1 = case M.lookupLT (lim+1) tbl of
                            Nothing -> k + 1
                            Just (_,v) -> k + 1 + v
                    lim = t - (1 + b' + acc + (k+1) * a)
                    b' = if ch == 'w' then b else 0
        let r = max (solve s) (solve (reverse s))
        if r > n then
            print (1 `div`(0::Int))
        else
            print $ max (solve s) (solve (reverse s))

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import Data.Maybe
import Data.Function(on)
import Data.Tuple(swap)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    [n,a,b,t] <- readInts
    s <- getLine
    let calc _ [] = []
        calc !acc ('w':xs) = 1+b+acc : calc (1+a+b+acc) xs
        calc !acc ('h':xs) = 1+acc   : calc (1+a+acc)   xs
    if last (calc 0 s) <= t then
        print n
    else do
        let solve xs = go 0 0 xs
                where
                score = calc 0 $ reverse xs
                tbl = M.fromList $ zip score [1..]
                go _ _ [] = 0
                go !k !acc (ch:xs)
                    | acc + 1 + b' > t = k
                    | otherwise = max s1 (go (k+1) (acc+1+a+b') xs)
                    where
                    s1 = case M.lookupLT (lim+1) tbl of
                            Nothing -> k + 1
                            Just (_,v) -> k + 1 + v
                    lim = t - (1 + b' + acc + (k+1) * a)
                    b' = if ch == 'w' then b else 0
        print $ max (solve s) (solve (reverse s))

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"

{-# LANGUAGE BangPatterns #-}
import Control.Monad
import Control.Applicative

import Data.List
import Data.Maybe
import Data.Function(on)
import Data.Tuple(swap)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
    [n,a,b,t] <- readInts
    s <- getLine
    let calc _ [] = []
        calc !acc ('w':xs) = 1+b+acc : calc (1+a+b+acc) xs
        calc !acc ('h':xs) = 1+acc   : calc (1+a+acc)   xs
    if last (calc 0 s) <= t then
        print n
    else do
        let solve xs = go 0 0 xs
                where
                score = calc 0 $ reverse xs
                tbl = M.fromList $ zip score [1..]
                go _ _ [] = 0
                go !k !acc (ch:xs)
                    | acc + 1 + b' > lim = k
                    | otherwise = max s1 (go (k+1) (acc+1+a+b') xs)
                    where
                    s1 = case M.lookupLT (lim+1) tbl of
                            Nothing -> k + 1
                            Just (_,v) -> k + 1 + v
                    lim = t - (1 + b' + acc + (k+1) * a)
                    b' = if ch == 'w' then b else 0
        print $ max (solve s) (solve (reverse s))

-- IO
readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine
readAllInts :: IO [[Int]]
readAllInts = map (map readInt . B.words) . B.lines <$> B.getContents

-- Utilities
l2p :: [a] -> (a,a)
l2p (a:b:_) = (a,b)
l2p _ = error "l2p: the input list is too short"


This is an interactive problem. In the output section below you will see the information about flushing the output.On Sunday Leha the hacker took Nura from the house where she lives and went with her to one of the most luxurious restaurants in Vičkopolis. Upon arrival, they left the car in a huge parking lot near the restaurant and hurried inside the building.In the restaurant a polite waiter immediately brought the menu to Leha and Noora, consisting of n dishes. It is interesting that all dishes in the menu are numbered with integers from 1 to n. After a little thought, the girl ordered exactly k different dishes from available in the menu. To pass the waiting time while the chefs prepare ordered dishes, the girl invited the hacker to play a game that will help them get to know each other better.The game itself is very simple: Noora wants Leha to guess any two dishes among all ordered. At the same time, she is ready to answer only one type of questions. Leha can say two numbers x and y (1 ≤ x, y ≤ n). After that Noora chooses some dish a for the number x such that, at first, a is among the dishes Noora ordered (x can be equal to a), and, secondly, the value  is the minimum possible. By the same rules the girl chooses dish b for y. After that Noora says «TAK» to Leha, if , and «NIE» otherwise. However, the restaurant is preparing quickly, so Leha has enough time to ask no more than 60 questions. After that he should name numbers of any two dishes Noora ordered.Help Leha to solve this problem!

There are two numbers n and k (2 ≤ k ≤ n ≤ 105) in the single line of input denoting the number of dishes in the menu and the number of dishes Noora ordered.

If you want to provide an answer, output a string of the form 2 x y (1 ≤ x, y ≤ n, x ≠ y), if you think the dishes x and y was among dishes ordered by Noora. After that, flush the output and terminate your program.

NoteThere are three dishes in sample. Noora ordered dished numberes 2 and 3, which Leha should guess. If Noora receive requests for the first dish (x = 1), then she'll choose the second dish (a = 2) as the dish with the minimum value . For the second (x = 2) and the third (x = 3) dishes themselves will be optimal, because in that case . Let Leha asks Noora about the next couple of dishes:  x = 1, y = 2, then he'll recieve «NIE» answer, because |1 - 2| > |2 - 2|  x = 2, y = 1, then he'll recieve «TAK» answer, because |2 - 2| ≤ |1 - 2|  x = 1, y = 3, then he'll recieve «NIE» answer, because |1 - 2| > |3 - 3|  x = 3, y = 1, then he'll recieve «TAK» answer, because |3 - 3| ≤ |1 - 2|  x = 2, y = 3, then he'll recieve «TAK» answer, because |2 - 2| ≤ |3 - 3|  x = 3, y = 2, then he'll recieve «TAK» answer, because |3 - 3| ≤ |2 - 2| According to the available information, it is possible to say that Nura ordered dishes with numbers 2 and 3.

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import System.IO

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

ask l r = do
  putStrLn $ "1 " ++ show l ++ " " ++ show r
  B.take 3 <$> B.getLine

chiến l r
  | l == r = return l
  | otherwise = do
    res <- ask m (m + 1)
    case res of
      "TAK" -> chiến l m
      "NIE" -> chiến (m + 1) r
    where
      m = (l + r) `div` 2

main = do
  hSetBuffering stdout LineBuffering
  n:k:_ <- readInts <$> B.getLine
  f <- chiến 1 n
  s <- if f < n then chiến (f + 1) n else return f
  res <- ask s f
  s' <- if f == s || res == "NIE" then chiến 1 (f - 1) else return s
  putStrLn $ "2 " ++ show f ++ " " ++ show s'

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import System.IO

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

ask l r = do
  putStrLn $ "1 " ++ show l ++ " " ++ show r
  B.getLine

chiến l r
  | l == r = return l
  | otherwise = do
    res <- ask m (m + 1)
    case res of
      "TAK" -> chiến l m
      _ -> chiến (m + 1) r
    where
      m = (l + r) `div` 2

main = do
  hSetBuffering stdout LineBuffering
  n:k:_ <- readInts <$> B.getLine
  f <- chiến 1 n
  s <- if f < n then chiến (f + 1) n else return f
  res <- ask s f
  s' <- if f == s || res == "NIE" then chiến 1 (f - 1) else return s
  putStrLn $ "2 " ++ show f ++ show s'

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as B
import System.IO

readInt = maybe undefined fst . B.readInt
readInts = (readInt <$>) . B.words

ask l r = do
  putStrLn $ "1 " ++ show l ++ " " ++ show r
  B.getLine

chiến l r
  | l == r = return l
  | otherwise = do
    res <- ask m (m + 1)
    case res of
      "TAK" -> chiến l m
      _ -> chiến (m + 1) r
    where
      m = (l + r) `div` 2

main = do
  hSetBuffering stdout LineBuffering
  n:k:_ <- readInts <$> B.getLine
  f <- chiến 1 n
  s <- if f < n then chiến (f + 1) n else return f
  res <- ask s f
  s' <- if f == s || res == "NIE" then chiến 1 (f - 1) else return s
  putStrLn $ "2 " ++ show f ++ " " ++ show s'