There is a trampoline park with $$$n$$$ trampolines in a line. The $$$i$$$-th of which has strength $$$S_i$$$.Pekora can jump on trampolines in multiple passes. She starts the pass by jumping on any trampoline of her choice. If at the moment Pekora jumps on trampoline $$$i$$$, the trampoline will launch her to position $$$i + S_i$$$, and $$$S_i$$$ will become equal to $$$\max(S_i-1,1)$$$. In other words, $$$S_i$$$ will decrease by $$$1$$$, except of the case $$$S_i=1$$$, when $$$S_i$$$ will remain equal to $$$1$$$. If there is no trampoline in position $$$i + S_i$$$, then this pass is over. Otherwise, Pekora will continue the pass by jumping from the trampoline at position $$$i + S_i$$$ by the same rule as above.Pekora can't stop jumping during the pass until she lands at the position larger than $$$n$$$ (in which there is no trampoline). Poor Pekora!Pekora is a naughty rabbit and wants to ruin the trampoline park by reducing all $$$S_i$$$ to $$$1$$$. What is the minimum number of passes she needs to reduce all $$$S_i$$$ to $$$1$$$?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 500$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 5000$$$) — the number of trampolines. The second line of each test case contains $$$n$$$ integers $$$S_1, S_2, \dots, S_n$$$ ($$$1 \le S_i \le 10^9$$$), where $$$S_i$$$ is the strength of the $$$i$$$-th trampoline. It's guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$5000$$$.

For each test case, output a single integer — the minimum number of passes Pekora needs to do to reduce all $$$S_i$$$ to $$$1$$$.

NoteFor the first test case, here is an optimal series of passes Pekora can take. (The bolded numbers are the positions that Pekora jumps into during these passes.)  $$$[1,4,\textbf{2},2,\textbf{2},2,\textbf{2}]$$$  $$$[1,\textbf{4},1,2,1,\textbf{2},1]$$$  $$$[1,\textbf{3},1,2,\textbf{1},\textbf{1},\textbf{1}]$$$  $$$[1,\textbf{2},1,\textbf{2},1,\textbf{1},\textbf{1}]$$$ For the second test case, the optimal series of passes is show below.  $$$[\textbf{2},3]$$$  $$$[1,\textbf{3}]$$$  $$$[1,\textbf{2}]$$$ For the third test case, all $$$S_i$$$ are already equal to $$$1$$$.

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

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

import Data.Int
import Data.Array.Unboxed

import Data.Array.ST.Safe
import Control.Monad.ST

solve :: UArray Int Int -> Int64
solve s = runST $ let
  (1, n) = bounds s
  checkedIncr :: STUArray s Int Int -> Int -> Int -> ST s ()
  checkedIncr arr ix val = when (ix <= n) $ do
    prevVal <- readArray arr ix
    writeArray arr ix (val + prevVal)
  step :: STUArray s Int Int -> Int -> Int -> ST s Int
  step arr prevSum ix = do
    currV <- readArray arr ix
    let
      currS = s ! ix
      currSum = prevSum + currV
      rawExcess = currSum - (currS - 1)
      excess = max 0 rawExcess
      cost = max 0 (negate rawExcess)
    writeArray arr ix cost
    checkedIncr arr (ix + 1) excess
    checkedIncr arr (ix + 2) (1 - excess)
    checkedIncr arr (ix + currS + 1) (0-1)
    pure currSum
  in  do
  prefs <- newArray (1, n) 0 :: ST s (STUArray s Int Int)
  foldM_ (step prefs) 0 [1..n]
  vals <- getElems prefs
  pure $ foldl' (\x y -> x + fromIntegral y) 0 vals

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    s <- listArray (1, n) <$> readInts
    putInt64 [solve s]

type SIO = StateT P.ByteString IO

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

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

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


While walking down the street Vanya saw a label "Hide&Seek". Because he is a programmer, he used & as a bitwise AND for these two words represented as a integers in base 64 and got new word. Now Vanya thinks of some string s and wants to know the number of pairs of words of length |s| (length of s), such that their bitwise AND is equal to s. As this number can be large, output it modulo 109 + 7.To represent the string as a number in numeral system with base 64 Vanya uses the following rules:  digits from '0' to '9' correspond to integers from 0 to 9;  letters from 'A' to 'Z' correspond to integers from 10 to 35;  letters from 'a' to 'z' correspond to integers from 36 to 61;  letter '-' correspond to integer 62;  letter '_' correspond to integer 63.

The only line of the input contains a single word s (1 ≤ |s| ≤ 100 000), consisting of digits, lowercase and uppercase English letters, characters '-' and '_'.

Print a single integer — the number of possible pairs of words, such that their bitwise AND is equal to string s modulo 109 + 7.

NoteFor a detailed definition of bitwise AND we recommend to take a look in the corresponding article in Wikipedia.In the first sample, there are 3 possible solutions:   z&_ = 61&63 = 61 = z  _&z = 63&61 = 61 = z  z&z = 61&61 = 61 = z

import Data.Char

main :: IO()
main = print . solve =<< getLine

toBase64 :: Char -> Int
toBase64 c | '0' <= c && c <= '9' = ord c - ord '0'
           | 'A' <= c && c <= 'Z' = ord c - ord 'A' + 10
           | 'a' <= c && c <= 'z' = ord c - ord 'a' + 36
           | c == '-' = 62
           | c == '_' = 63

numOf0 :: Int -> Integer
numOf0 = numOf0' 6
    where numOf0' :: Int -> Int -> Integer
          numOf0' 0 _ = 0
          numOf0' n x | even x = 1 + numOf0' (n - 1) (x `div` 2)
                      | otherwise = numOf0' (n - 1) (x `div` 2)

modC :: Integer
modC = 1000000007

pow :: Integer -> Integer -> Integer
x `pow` y | y == 0 = 1
          | y == 1 = x `mod` modC
          | odd y = x * (x `pow` (y - 1)) `mod` modC
          | even y = let x' = x `pow` (y `div` 2)
                 in x' * x' `mod` modC

solve :: String -> Integer
solve s = let m = sum $ map (numOf0 . toBase64) s
          in 3 `pow` m

import qualified Data.Bits as B
import qualified Data.Map  as M
alphabet = ['0'..'9']++['A'..'Z']++['a'..'z']++"-_"
countNil :: Int -> Int
countNil x = 6 - B.popCount x
nullBits = M.fromList (zip alphabet $ map countNil [0..63])
solve :: String -> Integer
solve s = 3 ^ (sum $ map (nullBits M.!) s) `mod` (10^9 + 7)
main = putStrLn.show.solve =<< getLine


An exam for n students will take place in a long and narrow room, so the students will sit in a line in some order. The teacher suspects that students with adjacent numbers (i and i + 1) always studied side by side and became friends and if they take an exam sitting next to each other, they will help each other for sure.Your task is to choose the maximum number of students and make such an arrangement of students in the room that no two students with adjacent numbers sit side by side.

A single line contains integer n (1 ≤ n ≤ 5000) — the number of students at an exam.

In the first line print integer k — the maximum number of students who can be seated so that no two students with adjacent numbers sit next to each other. In the second line print k distinct integers a1, a2, ..., ak (1 ≤ ai ≤ n), where ai is the number of the student on the i-th position. The students on adjacent positions mustn't have adjacent numbers. Formally, the following should be true: |ai - ai + 1| ≠ 1 for all i from 1 to k - 1. If there are several possible answers, output any of them.

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  n <- readLn

  let
    s = case n of
          1 -> [1]
          2 -> [1]
          3 -> [1, 3]
          4 -> [3, 1, 4, 2]
          n -> [1,3..n] ++ [2,4..n]

  print $ length s
  putStrLn $ unwords $ map show s

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = c:a:h b d

-- Codeforces 534A

import Data.List
import Data.Maybe

main :: IO ()
main = do
    n <- fmap read getLine :: IO Int
    let result = solve n
    putStrLn $ (show $ length result) ++ "\n" ++ concatMap (\x -> show x ++ " ") result

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve n = (reverse $ filter odd [1..n]) ++ (reverse $ filter even [1..n])

main=readLn>>=(\x->print(length x)>>putStrLn(unwords(map show x))).f
f n=(if n>3 then[2,4..n]else[])++[1,3..n]

main :: IO ()
main = readLn >>= (\xs -> print (length xs) >> putStrLn (unwords (map show xs))). solve

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve 4 = [2, 4, 1, 3]
solve n = take n (concatMap (\k -> [k, k + (n + 1) `div` 2]) [1..])

import Data.List

gao' :: [Int] -> [Int] -> [Int] -> [Int]
gao' xs lt rt
  | null lt || null rt = xs
  | otherwise = gao' (xs ++ [head lt] ++ [head rt]) (tail lt) (tail rt)

gao :: Int -> [Int]
gao n
  | n == 1 || n == 2 = [1]
  | n == 3 = [1, 3]
  | n == 4 = [3, 1, 4, 2]
  | otherwise = case n `mod` 2 of 1 -> gao' [(n + 1) `div` 2] [1..n `div` 2] [n `div` 2 + 2..n]
                                  0 -> gao' [] [1..n `div` 2] [n `div` 2 + 1..n]

main :: IO()
main = do
  n <- getLine
  let res = gao $ read n
  print $ length res
  putStrLn . unwords $ map show res

import Data.List

solve :: [Int] -> [Int] -> [Int] -> [Int]
solve xs lt rt
  | null lt || null rt = xs
  | otherwise = solve (xs ++ [head lt] ++ [head rt]) (tail lt) (tail rt)

gao :: Int -> [Int]
gao n
  | n == 1 || n == 2 = [1]
  | n == 3 = [1, 3]
  | n == 4 = [3, 1, 4, 2]
  | otherwise = case n `mod` 2 of 1 -> solve [(n + 1) `div` 2] [1..n `div` 2] [n `div` 2 + 2..n]
                                  0 -> solve [] [1..n `div` 2] [n `div` 2 + 1..n]

main :: IO()
main = do
  n <- getLine
  let res = gao $ read n
  print $ length res
  putStrLn . unwords $ map show res

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

main :: IO ()
main = do
  n <- readLn
  let (k, xs) = solve n
  print k
  putStrLn.unwords $ map show xs

solve :: Int -> (Int, [Int])
solve 1 = (1, [1])
solve 2 = (1, [1])
solve 3 = (2, [1, 3])
solve n = (n, go [3,1,4,2] [] [5..n])
   where
     go ls rs (x:y:xs) = go (x:ls) (y:rs) xs
     go ls rs [x] = x:ls ++ rs
     go ls rs [] = ls ++ rs

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

import Control.Applicative
import Data.List

solve :: Int -> (Int, [Int])
solve 1 = (1, [1])
solve 2 = (1, [1])
solve 3 = (2, [1, 3])
solve n = (n, concat $ transpose [y, x])
          where
             (x, y) = splitAt (n `div` 2) [1..n]

main :: IO ()
main = do
  n <- read <$> getLine
  let (k, ks) = solve n
  putStrLn $ show k
  putStrLn $ unwords . map show $ ks

ans :: Int -> [Int]
ans 1 = [1]
ans 2 = [1]
ans 3 = [1, 3]
ans 4 = [3, 1, 4, 2]
ans n = [1, 3 .. n] ++ [2, 4 .. n]

main = getLine >>= \s' -> do
    let s = ans (read s')
    putStrLn . show $ length s
    putStrLn . unwords $ map show s

import Control.Applicative
import Data.List
import Data.Char

process 1 = (1, [1])
process 2 = ( 1,[1])
process 3 = (2,[1,3])
process 4 = (4, [3,1,4,2])
process n = (n, (filter (odd ) [1..n]) ++ (filter (even ) [1..n]))

myprint ( x,y) = do
			putStrLn $ show x
			putStrLn $ intercalate " " $ map show $ y

main= do
	n<- read <$>getLine  :: IO Int
	myprint $ process n

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

import Control.Applicative
import Control.Monad hiding ((<$!>))
import Control.Monad.ST.Safe
import Control.Monad.State hiding ((<$!>))
-- import Data.Array
import Data.Array.IArray
import Data.Array.IO.Safe
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Builder as BB
import Data.Char
import qualified Data.Foldable as F
import Data.Function
import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.Ratio
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
-- import Data.Tree
import Data.Tuple
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
-- import Debug.Trace
import System.IO

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

main = do
  n <- readLn

  let
    s = case n of
          1 -> [1]
          2 -> [1]
          3 -> [1, 3]
          4 -> [1, 4, 2]
          n -> [1,3..n] ++ [2,4..n]

  print $ length s
  putStrLn $ unwords $ map show s

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f 4 = [1, 4, 2]
f 5 = [1, 4, 2, 5, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = a:c:h b d

main = interact $ unlines . g . f . read
g s = [show (length s), unwords (map show s)]
f 1 = [1]
f 2 = [1]
f 3 = [1, 3]
f 4 = [1, 4, 2]
f 5 = [1, 4, 2, 5, 3]
f s = h [1..div s 2] [div s 2 + 1..s]
h [] a = a
h (a:b) (c:d) = c:a:h b d

main :: IO ()
main = readLn >>= (\xs -> print (length xs) >> putStrLn (unwords (map show xs))). solve

solve :: Int -> [Int]
solve 1 = [1]
solve 2 = [1]
solve 3 = [1, 3]
solve 4 = [1, 4, 2]
solve n = take n (concatMap (\k -> [k, k + (n + 1) `div` 2]) [1..])


This is the easy version of the problem. The only difference is the constraints on $$$n$$$ and $$$k$$$. You can make hacks only if all versions of the problem are solved.You have a string $$$s$$$, and you can do two types of operations on it:   Delete the last character of the string.  Duplicate the string: $$$s:=s+s$$$, where $$$+$$$ denotes concatenation. You can use each operation any number of times (possibly none).Your task is to find the lexicographically smallest string of length exactly $$$k$$$ that can be obtained by doing these operations on string $$$s$$$.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds:  $$$a$$$ is a prefix of $$$b$$$, but $$$a\ne b$$$;  In the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

The first line contains two integers $$$n$$$, $$$k$$$ ($$$1 \leq n, k \leq 5000$$$) — the length of the original string $$$s$$$ and the length of the desired string. The second line contains the string $$$s$$$, consisting of $$$n$$$ lowercase English letters.

Print the lexicographically smallest string of length $$$k$$$ that can be obtained by doing the operations on string $$$s$$$.

NoteIn the first test, it is optimal to make one duplication: "dbcadabc" $$$\to$$$ "dbcadabcdbcadabc".In the second test it is optimal to delete the last $$$3$$$ characters, then duplicate the string $$$3$$$ times, then delete the last $$$3$$$ characters to make the string have length $$$k$$$."abcd" $$$\to$$$ "abc" $$$\to$$$ "ab" $$$\to$$$ "a" $$$\to$$$ "aa" $$$\to$$$ "aaaa" $$$\to$$$ "aaaaaaaa" $$$\to$$$ "aaaaaaa" $$$\to$$$ "aaaaaa" $$$\to$$$ "aaaaa".

import Control.Monad
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- filter (not . isSpace) . C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      getIndex (Node Nothing _ _) = 0
      getIndex (Node (Just (i, _)) _ _) = i
      step node@(Node (Just (idx, prev)) [] _) _ = Left (idx - getIndex prev)
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "~")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k

import Control.Monad
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- filter (not . isSpace) . C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      step node@(Node (Just (idx, _)) [] _) _ = Left idx
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
              getIndex (Node Nothing _ _) = 0
              getIndex (Node (Just (i, _)) _ _) = i
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

import Control.Monad
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

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

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

data State a = Node (Maybe (Int, State a)) [a] (State a)

main :: IO ()
main = do
  [_, k] <- getInts
  str@(_ : str') <- C.unpack <$> C.getLine
  let initial = Node Nothing str first
      first = Node (Just (1, initial)) str' (extend 2 initial str')
      findNext char node@(Node p s n)
        | char == head s = n
        | isJust p = findNext char (snd $ fromJust p)
        | otherwise = node
      extend _ _ [] = Node Nothing [] undefined
      extend idx prev (char : chars') = node'
        where node' = Node (Just (idx, prev')) chars' (extend (idx + 1) prev' chars')
              prev' = findNext char prev
      step node@(Node (Just (idx, _)) [] _) _ = Left idx
      step node@(Node (Just (idx, prev)) (char : _) next) _
        | getNextChar prev < char = Left (idx - getIndex prev)
        | otherwise = Right next
        where getNextChar (Node _ (c : _) _) = c
              getNextChar _ = error ""
              getIndex (Node Nothing _ _) = 0
              getIndex (Node (Just (i, _)) _ _) = i
      Left num = foldM step first $ repeat ()
      result = take k $ cycle $ take num str
  hPutBuilder stdout $ string7 result <> charUtf8 '\n'

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "^")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhileEnd isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.IO
import Data.Array.Unboxed
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb s e = unsafePerformIO $ do
    hPutStrLn stderr s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

solve :: String -> Int -> String
solve s k =
    let
        ts = tails (tail s ++ "^")
        t = foldr1 op ts
        op s0 s1 = if s0 > s then s0 else s1
        l = length s - length t + 1
    in
        take k $ cycle (take l s)

main = do
    [n,k] <- map parseInt . BS.words <$> BS.getLine
    s <- dropWhile isSpace . BS.unpack <$> BS.getLine
    putStrLn $ solve s k


Monocarp has drawn a tree (an undirected connected acyclic graph) and then has given each vertex an index. All indices are distinct numbers from $$$1$$$ to $$$n$$$. For every edge $$$e$$$ of this tree, Monocarp has written two numbers: the maximum indices of the vertices of the two components formed if the edge $$$e$$$ (and only this edge) is erased from the tree.Monocarp has given you a list of $$$n - 1$$$ pairs of numbers. He wants you to provide an example of a tree that will produce the said list if this tree exists. If such tree does not exist, say so.

The first line contains one integer $$$n$$$ ($$$2 \le n \le 1\,000$$$) — the number of vertices in the tree. Each of the next $$$n-1$$$ lines contains two integers $$$a_i$$$ and $$$b_i$$$ each ($$$1 \le a_i < b_i \le n$$$) — the maximal indices of vertices in the components formed if the $$$i$$$-th edge is removed.

If there is no such tree that can produce the given list of pairs, print "NO" (without quotes). Otherwise print "YES" (without quotes) in the first line and the edges of the tree in the next $$$n - 1$$$ lines. Each of the last $$$n - 1$$$ lines should contain two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i, y_i \le n$$$) — vertices connected by an edge. Note: The numeration of edges doesn't matter for this task. Your solution will be considered correct if your tree produces the same pairs as given in the input file (possibly reordered). That means that you can print the edges of the tree you reconstructed in any order.

NotePossible tree from the first example. Dotted lines show edges you need to remove to get appropriate pairs.

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

main = do
  n <- readLn :: IO Int

  xs <- sort . catMaybes <$> do
    replicateM (n-1) $ do
      [a,b] <- sort . map read . words <$> getLine :: IO [Int]
      return $ if b == n && a < b then Just a else Nothing

  if length xs == n-1 && and [i<=x | (i,x) <- zip [1..] xs] then do
    putStrLn "YES"
    let
      aux :: [[Int]] -> [Int] -> IO ()
      aux [] _ = return ()
      aux (ys:rest) as = do
        let
          (p,q) = span (<=(head ys)) as
          zs = n : (drop (length p - length ys) p)
        forM_ (zip zs (tail zs)) $ \(x,y) -> do
          printf "%d %d\n" x y
        aux rest (take (length p - length ys) p ++ q)

    aux (group xs) [1..n-1]

    else
    putStrLn "NO"

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

main = do
  n <- readLn :: IO Int

  xs <- sort . catMaybes <$> do
    replicateM (n-1) $ do
      [a,b] <- sort . map read . words <$> getLine :: IO [Int]
      return $ if b == n && a < b then Just a else Nothing

  if length xs == n-1 && and [i<=x | (i,x) <- zip [1..] xs] then do
    putStrLn "YES"
    forM_ (group xs) $ \ys -> do
      let zs = n : (reverse $ zipWith (-) ys [0..])
      forM_ (zip zs (tail zs)) $ \(x,y) -> do
        printf "%d %d\n" x y

    else
    putStrLn "NO"

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

main = do
  n <- readLn :: IO Int

  xs <- sort . catMaybes <$> do
    replicateM (n-1) $ do
      [a,b] <- sort . map read . words <$> getLine :: IO [Int]
      return $ if b == n && a < b then Just a else Nothing

  if length xs == n-1 && and [i<=x | (i,x) <- zip [1..] xs] then do
    putStrLn "YES"
    let
      aux :: [[Int]] -> [Int] -> IO ()
      aux [] _ = return ()
      aux (ys:rest) as = do
        let
          (p,q) = span (<=(head ys)) as
          zs = n : (take (length ys) $ reverse p)
        forM_ (zip zs (tail zs)) $ \(x,y) -> do
          printf "%d %d\n" x y
        aux rest (take (length p - length ys) p ++ q)

    aux (group xs) [1..n-1]

    else
    putStrLn "NO"


Andrey needs one more problem to conduct a programming contest. He has n friends who are always willing to help. He can ask some of them to come up with a contest problem. Andrey knows one value for each of his fiends — the probability that this friend will come up with a problem if Andrey asks him.Help Andrey choose people to ask. As he needs only one problem, Andrey is going to be really upset if no one comes up with a problem or if he gets more than one problem from his friends. You need to choose such a set of people that maximizes the chances of Andrey not getting upset.

The first line contains a single integer n (1 ≤ n ≤ 100) — the number of Andrey's friends. The second line contains n real numbers pi (0.0 ≤ pi ≤ 1.0) — the probability that the i-th friend can come up with a problem. The probabilities are given with at most 6 digits after decimal point.

Print a single real number — the probability that Andrey won't get upset at the optimal choice of friends. The answer will be considered valid if it differs from the correct one by at most 10 - 9.

NoteIn the first sample the best strategy for Andrey is to ask only one of his friends, the most reliable one.In the second sample the best strategy for Andrey is to ask all of his friends to come up with a problem. Then the probability that he will get exactly one problem is 0.1·0.8 + 0.9·0.2 = 0.26.

import Data.List

main=interact $ (++ "\n") . show . getAns 0 1. getArray

getArray :: String -> [Double]
getArray = reverse . sort . tail . map read . words

getAns :: Double -> Double -> [Double] -> Double
getAns x _ [] = x
getAns a b (x:xs) =
	let na = a * (1 - x) + b * x
	    nb = b * (1 - x)
	in if na > a then getAns na nb xs else a

import Data.List
import Text.Printf

f :: [Double] -> Double
f x = let y = map (1.0-) x
      in (foldl1' (*) y) * (foldl1' (+) $ zipWith (/) x y)

main = do
             _ <- getLine
             l <- getLine
             let inp = reverse . sort $ map (\y -> read y :: Double) $ words l
             let ans = if head inp >= 1.0 then 1.0 else foldl1' max $ map f $ map (\y -> take y $ inp) [1..(length inp)]
             printf "%.10f\n" ans

import Data.List
import Text.Printf

g :: Double -> [Double] -> [Double] -> [Double]
g s l [] = l
g s l (x:xs) =
           if s >= 1.0 then l
           else g (s+x/(1.0 - x)) (x:l) xs
f x = let y = map (1.0-) x
      in (product y) * (sum $ zipWith (/) x y)

main = do
             _ <- getLine
             l <- getLine
             let inp = reverse . sort $ map (\y -> read y :: Double) $ words l
             let ans = if head inp >= 1.0 then 1.0 else f $ g 0.0 [] inp
             printf "%.10f\n" ans

import Data.List
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ show . fst . foldr work (0.0, 1.0) . sort . map read . tail . words

import Data.List
import Text.Printf
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ printf "%.11f" . fst . foldr work (0 :: Double, 1) . sort . map read . tail . words

import Data.List
import Text.Printf

f :: [Double] -> Double
f x = let y = map (1.0-) x
      in (foldl1' (*) y) * (foldl1' (+) $ zipWith (/) x y)

main = do
       _ <- getLine
       l <- getLine
       let inp = map (\y -> read y :: Double) $ words l
       printf "%.10f\n" $ foldl1' max $ map f $ map (\y -> take y $ reverse inp) [1..(length inp)]

import Data.List
import Text.Printf
work p (a, b) = if c > a then (c, b * (1 - p)) else (a, 0) where c = (1 - p) * a + p * b
main = interact $ printf "%.11f" . fst . foldr work (0 :: Float, 1) . sort . map read . tail . words


Kevin Sun has just finished competing in Codeforces Round #334! The round was 120 minutes long and featured five problems with maximum point values of 500, 1000, 1500, 2000, and 2500, respectively. Despite the challenging tasks, Kevin was uncowed and bulldozed through all of them, distinguishing himself from the herd as the best cowmputer scientist in all of Bovinia. Kevin knows his submission time for each problem, the number of wrong submissions that he made on each problem, and his total numbers of successful and unsuccessful hacks. Because Codeforces scoring is complicated, Kevin wants you to write a program to compute his final score.Codeforces scores are computed as follows: If the maximum point value of a problem is x, and Kevin submitted correctly at minute m but made w wrong submissions, then his score on that problem is . His total score is equal to the sum of his scores for each problem. In addition, Kevin's total score gets increased by 100 points for each successful hack, but gets decreased by 50 points for each unsuccessful hack.All arithmetic operations are performed with absolute precision and no rounding. It is guaranteed that Kevin's final score is an integer.

The first line of the input contains five space-separated integers m1, m2, m3, m4, m5, where mi (0 ≤ mi ≤ 119) is the time of Kevin's last submission for problem i. His last submission is always correct and gets accepted. The second line contains five space-separated integers w1, w2, w3, w4, w5, where wi (0 ≤ wi ≤ 10) is Kevin's number of wrong submissions on problem i. The last line contains two space-separated integers hs and hu (0 ≤ hs, hu ≤ 20), denoting the Kevin's numbers of successful and unsuccessful hacks, respectively.

Print a single integer, the value of Kevin's final score.

NoteIn the second sample, Kevin takes 119 minutes on all of the problems. Therefore, he gets  of the points on each problem. So his score from solving problems is . Adding in 10·100 = 1000 points from hacks, his total score becomes 3930 + 1000 = 4930.

module Main where

import Control.Monad
import Data.Ratio

getScore :: Integer -> Integer -> Integer -> Rational
getScore x m w = max ((3 * x) % 10) ((1 - m % 250) * (x % 1) - ((50 * w) % 1))

readIntegers :: IO [Integer]
readIntegers = liftM (map read . words) getLine

main :: IO ()
main = do
     let xs = [500, 1000, 1500, 2000, 2500] :: [Integer]
     ms <- readIntegers
     ws <- readIntegers
     [hs, hu] <- readIntegers

     let result = (sum $ zipWith3 getScore xs ms ws) + (100 * hs) % 1 - (50 * hu) % 1
     print $ numerator result

module Main where

    import Data.Ratio

    calcRes :: [(Integer,Integer,Integer)] -> Integer -> Integer -> Ratio Integer
    calcRes ts hs hu = sum (map (\(m,w,p) -> max (p*3%10) ((1-(m%250))*(p%1) - (50*w%1))) ts) +  (hs*100%1) - (hu*50%1)

    main :: IO ()
    main = do
      ms <- getLine
      ws <- getLine
      h <- getLine
      let ts = zip3 (map (read::String->Integer) $ words ms) (map (read::String->Integer) $ words ws) [500,1000,1500,2000,2500]
      let [hs,hu] = map (read::String->Integer) (words h)
      putStrLn $ head $ words $ show $ calcRes ts hs hu

calc :: Int -> Int -> Int -> Int
calc a b c =  max (a*150) ( a* (500 - (b*2)) - 50 * c)

solve :: [Int] -> Int
solve x = (calc 1 (x!!0) (x!!5)) + (calc 2 (x!!1) (x!!6))+ (calc 3 (x!!2) (x!!7))+ (calc 4 (x!!3) (x!!8))+ (calc 5 (x!!4) (x!!9)) + (x!!10) * 100 - (x!!11) * 50

readInt :: String -> Int
readInt = read

parse :: String -> String
parse x = show $ solve a where a = map readInt $ words x

main = interact parse

import Control.Applicative

points :: [Integer]
points = [500, 1000, 1500, 2000, 2500]

solve :: [Integer] -> [Integer] -> Integer -> Integer -> Integer
solve ms ws hs hu = sum (zipWith3 score points ms ws) + hs * 100 - hu * 50
                    where
                      score x m w = round $ max (0.3 * fi x) ((1 - fi m / 250) * fi x - 50 * fi w)
                      fi = fromIntegral

main :: IO ()
main = do
  ms <- map read . words <$> getLine
  ws <- map read . words <$> getLine
  [hs, hu] <- map read . words <$> getLine
  print $ solve ms ws hs hu

module Main where

import Control.Monad

f :: (Int, Int, Int) -> Double
f (m, w, x) =
    max (0.3 * fromIntegral x) ( (1.0 - fromIntegral m / 250.0) * fromIntegral x - 50.0 * fromIntegral w  )

main :: IO ()
main = do
    ms <- liftM (map (\c -> read c::Int) . words) getLine
    ws <- liftM (map (\c -> read c::Int) . words) getLine
    [h', h''] <- liftM (map (\c -> read c::Int) . words) getLine
    let r' = sum (map f (zip3 ms ws [500, 1000, 1500, 2000, 2500]))
        r'' = 100 * h' - 50 * h''
    putStrLn $ show $ floor (r' + fromIntegral r'')

(|>) a b = b a

f x m w =
  max (0.3 * x) ((1 - m / 250) * x - 50 * w)

r s1 s2 s3 =
  let ms = s1 |> words |> map (read :: String -> Int)
      ws = s2 |> words |> map (read :: String -> Int)
      hs = s3 |> words |> map (read :: String -> Int)
      xs = [500, 1000, 1500, 2000, 2500]
      g zs y = fromIntegral (zs !! y)
      sum1 = [0..4] |> map (\y -> round $ f (g xs y) (g ms y) (g ws y)) |> sum
  in
      sum1 + (hs !! 0) * 100 - (hs !! 1) * 50

main = do
  s1 <- getLine
  s2 <- getLine
  s3 <- getLine
  print (r s1 s2 s3)

import System.IO

max_points :: [Int]
max_points = [500, 1000, 1500, 2000, 2500]

formula :: (Int, Int, Int) -> Int
-- x - max points, m - time, w - count of submissions
formula (x, m, w) = round $ max (0.3 * fromIntegral x) ((1 - fromIntegral m / 250.0) * fromIntegral x - 50 * fromIntegral w)

cnt_tasks :: Integer
cnt_tasks = 5

getPoints :: [Int] -> [Int] -> Int
getPoints a b = (sum . (map formula)) (zip3 max_points a b)

parseList :: String -> [Int]
parseList = (map read) . words

main :: IO ()
main = do
    let fin = stdin
--    fin <- openFile "tmp" ReadMode
    time_line <- hGetLine fin
    submissions_line <- hGetLine fin
    hacks_line <- hGetLine fin

    let [hacks_good, hacks_bad] = parseList hacks_line
    print $ getPoints (parseList time_line) (parseList submissions_line) + hacks_good * 100 - hacks_bad * 50

parseInput :: String -> ([Int], [Int], [Int])
parseInput input = (xs, ys, zs) where
    ls = lines input
    ws = map words ls
    xs = map read $ head ws
    ys = map read $ head $ tail ws
    zs = map read $ last ws

score :: [Int] -> [Int] -> Int
score ms ws = sum [max ((3*x) `div` 10) ((250 - m)*(x `div` 250) - 50*w) | (x, m, w) <- ds] where
    ps = [500, 1000, 1500, 2000, 2500]
    ds = zip3 ps ms ws

hacks :: [Int] -> Int
hacks hs = sum [h*p | (h, p) <- zip hs ps] where
    ps = [100, -50]

solve :: [Int] -> [Int] -> [Int] -> Int
solve ms ws hs = score ms ws + hacks hs

main :: IO ()
main = do
    input <- getContents
    let (ms, ws, hs) = parseInput input
    print $ solve ms ws hs


Polycarp was presented with some sequence of integers $$$a$$$ of length $$$n$$$ ($$$1 \le a_i \le n$$$). A sequence can make Polycarp happy only if it consists of different numbers (i.e. distinct numbers).In order to make his sequence like this, Polycarp is going to make some (possibly zero) number of moves.In one move, he can:   remove the first (leftmost) element of the sequence. For example, in one move, the sequence $$$[3, 1, 4, 3]$$$ will produce the sequence $$$[1, 4, 3]$$$, which consists of different numbers.Determine the minimum number of moves he needs to make so that in the remaining sequence all elements are different. In other words, find the length of the smallest prefix of the given sequence $$$a$$$, after removing which all values in the sequence will be unique.

The first line of the input contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Each test case consists of two lines. The first line contains an integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the length of the given sequence $$$a$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — elements of the given sequence $$$a$$$. It is guaranteed that the sum of $$$n$$$ values over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print your answer on a separate line — the minimum number of elements that must be removed from the beginning of the sequence so that all remaining elements are different.

NoteThe following are the sequences that will remain after the removal of prefixes:  $$$[1, 4, 3]$$$;  $$$[1]$$$;  $$$[1]$$$;  $$$[6, 5, 4, 3, 2, 1]$$$;  $$$[2, 1]$$$. It is easy to see that all the remaining sequences contain only distinct elements. In each test case, the shortest matching prefix was removed.

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |nList==1 =0
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(nList-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

import System.IO
import Control.Monad
import Data.List
import Data.Maybe
import Data.Function
import qualified Data.Set as Set
main = do
    [t] <- ri
    tcs <- replicateM t rtc
    mapM (putStrLn . show . solve) tcs
ri = map read . words <$> getLine :: IO [Int]
rtc = do
    [_n] <- ri
    ri
solve xs = length xs - length suff
  where
    suff = tail . takeWhile (not.snd) . scanl' addElem (Set.empty, False) . reverse $ xs

    addElem (set, True ) _ = (set, True)
    addElem (set, False) newElem
        | ((==) `on` Set.size) set newSet  = (Set.empty, True )
        | otherwise                        = (newSet   , False)
      where
        newSet = newElem `Set.insert` set

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |nList==1 =0
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(nList-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=reverse list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

module Main where
import Control.Monad
import qualified Data.IntSet as Ds

import Data.Maybe
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

--import qualified Data.HashSet as Set

remainList2::Int->Int->Ds.IntSet->[Int]->Int
remainList2 n ne hSet x
    |ne==1 =1
    |(ne>1)&&(n==ne)=ne
    |(x!!n)`Ds.member`hSet=n
    |otherwise=remainList2 (n+1) ne s2 x
          where s2=Ds.insert (x!!n) hSet
slice::[Int]->Int->Int->[Int]
slice xs i k = take (k-i) $ drop i xs
remainList1::Int->Int->Int->[Int]->Int->Int
remainList1 l r nList x n
  |r-l==1 =1
  |l>r= n
  |(Ds.size$Ds.fromList (slice x mid nList))==(r-mid) =remainList1 l (mid -1) nList x n1
  |otherwise=remainList1 (mid+1) r nList x n
  where mid=(l+r)`div`2
        n1=min n mid

getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) `fmap` BS.getLine :: IO [Int]
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line<-getLine
    let nList=read line::Int
    -- list length
    list<-getInts
    let listNew=reverse list
    let hSet=Ds.fromList (take 1 listNew)
    --print$(nList-(remainList2 1 nList hSet listNew))
    print$remainList1 0 nList nList listNew nList
    -- input list

module Main
    where
import Control.Monad
import Data.List
myfind::Int->Int->Int->[Int]->Maybe Bool
myfind x ns ne y
    |ne==(-1)=Nothing
    |x==y!!ns =Just True
    |(ns+1)<ne =myfind x (ns+1) ne y
    |otherwise=Nothing

remainList::Int->Int->[Int]->Bool
remainList x ne y
    |(myfind x 0 ne y)==Nothing =True
    |otherwise=False

remainList2::Int->[Int]->[Int]
remainList2 _ []=[]
remainList2 n x
    |n==ne =x
    |remainList (x!!n) (n-1) x= remainList2 (n+1) x
    |otherwise=(take n x)
    where ne=length x
main::IO()
main = do
  line<-getLine
  let nTest=read line::Int
  -- number of test
  replicateM_ nTest$do
    line1<-getLine
    let nList=read line1::Int
    -- list length
    line2<-getLine
    let list=map read (words line2)::[Int]
    let listNew=reverse list
    print$nList-(length$remainList2 0 listNew)
    -- input list

import System.IO
import Control.Monad
import Data.List
import Data.Maybe
import Data.Function
import qualified Data.Set as Set
main = do
    [t] <- ri
    tcs <- replicateM t rtc
    mapM (putStrLn . show . solve) tcs
ri = map read . words <$> getLine :: IO [Int]
rtc = do
    [_n] <- ri
    ri
solve xs = length xs - length suff
  where
    suff = takeWhile (not.snd) . scanl' addElem (Set.empty, False) . reverse $ xs

    addElem (set, True ) _ = (set, True)
    addElem (set, False) newElem
        | ((==) `on` Set.size) set newSet  = (Set.empty, True )
        | otherwise                        = (newSet   , False)
      where
        newSet = newElem `Set.insert` set


At first, there was a legend related to the name of the problem, but now it's just a formal statement.You are given $$$n$$$ points $$$a_1, a_2, \dots, a_n$$$ on the $$$OX$$$ axis. Now you are asked to find such an integer point $$$x$$$ on $$$OX$$$ axis that $$$f_k(x)$$$ is minimal possible.The function $$$f_k(x)$$$ can be described in the following way:   form a list of distances $$$d_1, d_2, \dots, d_n$$$ where $$$d_i = |a_i - x|$$$ (distance between $$$a_i$$$ and $$$x$$$);  sort list $$$d$$$ in non-descending order;  take $$$d_{k + 1}$$$ as a result. If there are multiple optimal answers you can print any of them.

The first line contains single integer $$$T$$$ ($$$ 1 \le T \le 2 \cdot 10^5$$$) — number of queries. Next $$$2 \cdot T$$$ lines contain descriptions of queries. All queries are independent.  The first line of each query contains two integers $$$n$$$, $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$0 \le k < n$$$) — the number of points and constant $$$k$$$. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_1 < a_2 < \dots < a_n \le 10^9$$$) — points in ascending order. It's guaranteed that $$$\sum{n}$$$ doesn't exceed $$$2 \cdot 10^5$$$.

Print $$$T$$$ integers — corresponding points $$$x$$$ which have minimal possible value of $$$f_k(x)$$$. If there are multiple answers you can print any of them.

import Data.Sequence

toInt :: String -> Int
toInt x = read x :: Int

average :: Int -> Int -> (Int, Int)
average a b = (b - (a + b) `div` 2, (a + b) `div` 2)

solve :: Int -> Int -> Seq Int -> Int -> Int -> String
solve n k xs w ans
    | k == n = show ans
    | w > (fst $ tmp) = solve (n - 1) k (Data.Sequence.drop 1 xs) (fst $ tmp) (snd $ tmp)
    | otherwise = solve (n - 1) k (Data.Sequence.drop 1 xs) w ans
    where tmp = average (xs `index` 0) (xs `index` k)

process :: [String] -> [String]
process [] = []
process input =
    let n = head $ map toInt $ words $ head input
        k = last $ map toInt $ words $ head input
        xs = fromList $ map toInt $ words $ input !! 1
    in (solve n k xs 1000000009 0) : process (Prelude.drop 2 input)

fff :: String -> String
fff x = unlines $ process $ tail $ lines x

main :: IO ()
main = interact fff


Due to the coronavirus pandemic, city authorities obligated citizens to keep a social distance. The mayor of the city Semyon wants to light up Gluharniki park so that people could see each other even at night to keep the social distance.The park is a rectangular table with $$$n$$$ rows and $$$m$$$ columns, where the cells of the table are squares, and the boundaries between the cells are streets. External borders are also streets. Every street has length $$$1$$$. For example, park with $$$n=m=2$$$ has $$$12$$$ streets.You were assigned to develop a plan for lighting the park. You can put lanterns in the middle of the streets. The lamp lights two squares near it (or only one square if it stands on the border of the park).    The park sizes are: $$$n=4$$$, $$$m=5$$$. The lighted squares are marked yellow. Please note that all streets have length $$$1$$$. Lanterns are placed in the middle of the streets. In the picture not all the squares are lit. Semyon wants to spend the least possible amount of money on lighting but also wants people throughout the park to keep a social distance. So he asks you to find the minimum number of lanterns that are required to light all the squares.

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

Print $$$t$$$ answers to the test cases. Each answer must be a single integer — the minimum number of lanterns that are required to light all the squares.

NotePossible optimal arrangement of the lanterns for the $$$2$$$-nd test case of input data example: Possible optimal arrangement of the lanterns for the $$$3$$$-rd test case of input data example:

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), (<|), (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

infixl 0 >$>
(>$>) = flip ($)

main = C.interact $
  C.lines >>> drop 1 >>> map (C.words >>> map readInt >>> solve >>> show >>> C.pack) >>> C.unlines

readInt = C.readInt >>> fromJust >>> fst

solve [n,m]
  | even (n*m) = (n*m) `div` 2
  | otherwise  = (n*m) `div` 2 + 1

import           Control.Arrow
import           Control.Monad.State
import           Data.Array
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import           Data.Function
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

main = C.interact $
  C.lines >>> drop 1 >>> map (C.words >>> map readInt >>> solve >>> show >>> C.pack) >>> C.unlines

readInt = C.readInt >>> fromJust >>> fst

solve [n,m]
  | even (n*m) = (n*m) `div` 2
  | otherwise  = (n*m) `div` 2 + 1

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

main = getLine >>= flip replicateM_ test . read

test = do
    (n:m:_) <- map read . words <$> getLine
    print $ (n * m + 1) `div` 2

main = do
	input <- getLine
	let n = read input :: Int
	fin <- getContents
	let size = map (map read) (map words (take n (lines fin))) :: [[Int]]
	let result = [x*y `div` 2 + x*y `mod` 2 | [x,y] <- size]
	mapM print result

import Data.List

_split acc "" [] = reverse acc
_split acc curr [] = reverse $ curr : acc
_split acc curr (ch:rest)
  | (any (== ch) [' ', '\n']) = _split (reverse curr : acc) "" rest
  | otherwise = _split acc (ch:curr) rest

split = _split [] ""

main = do
  input <- getContents
  let (_:tokens) = split input
      vals = read <$> tokens :: [Int]
      res = unfoldr (\ls ->
        case ls of
          []          -> Nothing
          (n:m:rest)  ->
            let numCells = n*m
                subres = (numCells + 1) `div` 2
            in  Just (subres, rest)
        ) vals
  sequence_ (putStrLn <$> (show <$> res))

import Control.Monad

parse :: [String] -> [[Integer]]
parse = map (\l -> map read . words $ l)

solve :: [Integer]->Integer
solve (n:m:[])
  | (even n) && (odd m) = n*(div m 2) + (div n 2)
  | (even n) && (even m) = n*(div m 2)
  | (odd n) && (n>=m) = (solve [(n-1),m])+ (div m 2)+(mod m 2)
  | otherwise = solve [m,n]

main :: IO ()
main = do
  n <- getLine
  content <- replicateM (read n :: Int) getLine
  putStrLn . unlines . map show . map solve . parse $ content

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

onecase = do
		[a,b]<- map read <$> words <$> getLine ::IO [Int]
		print $ div ((a*b) +1 ) 2

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

main :: IO ()
main = interact (unlines . map (show . solve) . parse)

parse :: String -> [(Int, Int)]
parse inp = [(x, y) | [x, y] <- map (map read . words) . tail $ lines inp]

solve :: (Int, Int) -> Int
solve (x, y) = quot (x*y + 1) 2

divideAndCeil :: Int -> Int
divideAndCeil n
  | mod n 2 == 0 = div n 2
  | otherwise = div (n+1) 2

solve :: Int -> Int -> Int
solve n m
  | m == 1 = divideAndCeil n
  | m == 2 = n
  | otherwise = (solve n 2) + (solve n (m-2))

main :: IO ()
main = interact (unlines . map parse . tail . lines)

parse :: String -> String
parse input = show $ solve n m
  where [n, m] = map (\x -> read x :: Int) $ words input


We'll call a set of positive integers a beautiful if the following condition fulfills: for any prime p, if , then . In other words, if one number from the set is divisible by prime p, then at least half of numbers from the set is divisible by p.Your task is to find any beautiful set, where the number of elements is equal to k and each element doesn't exceed 2k2.

The first line contains integer k (10 ≤ k ≤ 5000) that shows how many numbers the required beautiful set should have.

In the first line print k space-separated integers that are a beautiful set. If there are multiple such sets, you are allowed to print any of them.

go :: [Integer] -> [Integer] -> Integer -> Integer -> [Integer]
go x [] up n = x
go x _ up n
  | length(x) >= (fromIntegral n) = x
go xs (p:ps) up n =
  go b ps up n
  where
    a = map (*) $ reverse $ takeWhile (<= up) $ iterate (*p) 1
    b = [f x | f <- a, x <- xs, f x <= up]

solve :: Integer -> [Integer]
solve n =
  let
    plis = [2, 3, 5, 7, 11]
  in
    take (fromIntegral n) $ go [1] plis (2 * n * n) n

main = do
  n <- fmap read getLine
  putStrLn $ unwords . map show $ solve n

import Data.Int (Int64)
go :: [Int] -> [Int] -> Int -> Int -> [Int]
go x [] up n = x
go x _ up n
  | length(x) >= n = x
go xs (p:ps) up n =
  go b ps up n
  where
    a = map (*) $ reverse $ takeWhile (<= up) $ iterate (*p) 1
    b = [f x | f <- a, x <- xs, f x <= up]

solve :: Int -> [Int]
solve n =
  let
    plis = [2, 3, 5, 7, 11]
  in
    take n $ go [1] plis (2 * n * n) n

main = do
  n <- fmap read getLine
  putStrLn $ unwords . map show $ solve n


Gennady is one of the best child dentists in Berland. Today n children got an appointment with him, they lined up in front of his office.All children love to cry loudly at the reception at the dentist. We enumerate the children with integers from 1 to n in the order they go in the line. Every child is associated with the value of his cofidence pi. The children take turns one after another to come into the office; each time the child that is the first in the line goes to the doctor.While Gennady treats the teeth of the i-th child, the child is crying with the volume of vi. At that the confidence of the first child in the line is reduced by the amount of vi, the second one — by value vi - 1, and so on. The children in the queue after the vi-th child almost do not hear the crying, so their confidence remains unchanged.If at any point in time the confidence of the j-th child is less than zero, he begins to cry with the volume of dj and leaves the line, running towards the exit, without going to the doctor's office. At this the confidence of all the children after the j-th one in the line is reduced by the amount of dj.All these events occur immediately one after the other in some order. Some cries may lead to other cries, causing a chain reaction. Once in the hallway it is quiet, the child, who is first in the line, goes into the doctor's office.Help Gennady the Dentist to determine the numbers of kids, whose teeth he will cure. Print their numbers in the chronological order.

The first line of the input contains a positive integer n (1 ≤ n ≤ 4000) — the number of kids in the line.  Next n lines contain three integers each vi, di, pi (1 ≤ vi, di, pi ≤ 106) — the volume of the cry in the doctor's office, the volume of the cry in the hall and the confidence of the i-th child.

In the first line print number k — the number of children whose teeth Gennady will cure. In the second line print k integers — the numbers of the children who will make it to the end of the line in the increasing order.

NoteIn the first example, Gennady first treats the teeth of the first child who will cry with volume 4. The confidences of the remaining children will get equal to  - 2, 1, 3, 1, respectively. Thus, the second child also cries at the volume of 1 and run to the exit. The confidence of the remaining children will be equal to 0, 2, 0. Then the third child will go to the office, and cry with volume 5. The other children won't bear this, and with a loud cry they will run to the exit.In the second sample, first the first child goes into the office, he will cry with volume 4. The confidence of the remaining children will be equal to 5,  - 1, 6, 8. Thus, the third child will cry with the volume of 1 and run to the exit. The confidence of the remaining children will be equal to 5, 5, 7. After that, the second child goes to the office and cry with the volume of 5. The confidences of the remaining children will be equal to 0, 3. Then the fourth child will go into the office and cry with the volume of 2. Because of this the confidence of the fifth child will be 1, and he will go into the office last.

data Child = Child { index  :: Integer
                   , office :: Integer
                   , hall   :: Integer
                   , confid :: Integer
} deriving (Eq, Show)

decrease :: Integer -> [Child] -> [Child]
decrease vol = zipWith f [vol, vol - 1 .. ]
    where f x c = if x > 0 then c {confid = confid c - x} else c

simplify :: Integer -> [Child] -> [Child]
simplify _ [] = []
simplify vol (c:cs) =
    if confid c < vol
    then simplify (vol + hall c) cs
    else c {confid = confid c - vol} : simplify vol cs

gennady :: [Child] -> [Integer]
gennady [] = []
gennady (c:cs) = index c : gennady (simplify 0 $ decrease (office c) cs)

convert :: [[Integer]] -> [Child]
convert = zipWith (\i [v, d, p] -> Child i v d p) [1..]

parse = convert . map (map read . words) . tail . lines
ans xs = unlines [show (length xs), unwords (map show xs)]

main = putStr . ans . gennady . parse =<< getContents

import qualified Data.ByteString.Lazy.Char8 as B

data Child = Child { index  :: Integer
                   , office :: Integer
                   , hall   :: Integer
                   , confid :: Integer
} deriving (Eq, Show)

decrease :: Integer -> [Child] -> [Child]
decrease vol = zipWith f [vol, vol - 1 .. ]
    where f x c = if x > 0 then c {confid = confid c - x} else c

simplify :: Integer -> [Child] -> [Child]
simplify _ [] = []
simplify vol (c:cs) =
    if confid c < vol
    then simplify (vol + hall c) cs
    else c {confid = confid c - vol} : simplify vol cs

gennady :: [Child] -> [Integer]
gennady [] = []
gennady (c:cs) = index c : gennady (simplify 0 $ decrease (office c) cs)

convert :: [[Integer]] -> [Child]
convert = zipWith (\i [v, d, p] -> Child i v d p) [1..]

parse = convert . map (map read' . B.words) . tail . B.lines
    where read' s = case B.readInteger s of Just (n, _) -> n
ans xs = unlines [show (length xs), unwords (map show xs)]

main = putStr . ans . gennady . parse =<< B.getContents

module Main where

data Kid a = Kid {
    position :: a
  , vDoctor :: a
  , vHall :: a
  , confidence :: a
  }
  deriving (Show)

exit :: (Num a, Ord a) => a -> [Kid a] -> [Kid a]
exit _ [] = []
exit v (kid:kids)
  | conf' >= 0 = kid {confidence = conf'} : exit v kids
  | otherwise  = exit (v + vHall kid) kids
  where
    conf' = confidence kid - v

propagate :: (Num a, Eq a) => a -> [Kid a] -> [Kid a]
propagate _ []         = []
propagate 0 kids       = kids
propagate v (kid:kids) = kid {confidence = conf'} : propagate (v-1) kids
  where
    conf' = confidence kid - v

treat :: (Num a, Ord a) => [Kid a] -> [a]
treat (kid:kids) = position kid:(treat . exit 0 . propagate (vDoctor kid)) kids
treat [] = []

input1 :: [Kid Int]
input1 = [Kid 1 4 2 2, Kid 2 4 1 2, Kid 3 5 2 4, Kid 4 3 3 5, Kid 5 5 1 2]

input2 :: [Kid Int]
input2 =
    [Kid 1 4 5 1
    ,Kid 2 5 3 9
    ,Kid 3 4 1 2
    ,Kid 4 2 1 8
    ,Kid 5 4 1 9]

main :: IO ()
main = do
    contents <- getContents
    putStr (readAndTreat contents)

readAndTreat :: String -> String
readAndTreat input =
    let (first:allLines) = lines input
        n = read first
        kids = readAll n 1 allLines
        treated = treat kids
        resultLines = [show $ length treated, unwords $ map show treated]
        result = unlines resultLines
    in result

readAll :: (Num a, Read a, Show a, Ord a) => a -> a -> [String] -> [Kid a]
readAll n i _ | i > n = []
readAll _ i [] = error $ "End of file reached but only " ++ show i ++ " lines read."
readAll n i (l:ls) = Kid i vD vH c : readAll n (i+1) ls
  where [vD,vH,c] = map read $ words l

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (forM)
import Data.Maybe (catMaybes)

data Child = Child
    { i  :: !Int
    , vi :: !Integer
    , di :: !Integer
    , pi :: !Integer
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Integer -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Integer -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (pure, (<$>))
import Control.Monad (forM)

data Child = Child
    { i  :: !Int
    , vi :: !Integer
    , di :: !Integer
    , pi :: !Integer
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Integer -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Integer -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read <$> getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) <$> getLine
        pure $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

import           Control.Monad         (replicateM)
import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS8
import           Data.Functor          ((<$>))
import           Data.List             (foldl', transpose)
import           Data.Maybe            (fromJust)
import Data.Int

update
  :: Int
  -> Int64
  -> [Int]
  -> [Int]
  -> [(Int64, Int)]
  -> ([Int], [Int], [(Int64, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + fromIntegral d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - val, snd p) : ps')
  where
    val =
      if x > 0
        then fromIntegral x + t
        else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int64, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- (fst . fromJust . BS8.readInt) <$> BS.getLine
  ls <- map (map (fst . fromJust . BS8.readInt) . BS8.words) <$> replicateM n BS.getLine
  let [vs, ds, ps] = transpose ls
      r = solve vs ds (zip (map fromIntegral ps) [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

type VHall = Int
type VDoctor = Int

data Kid = Kid {
    position :: Int
  , vDoctor :: Int
  , vHall :: Int
  , confidence :: Int
  }
  deriving (Show)

exit :: VHall -> [Kid] -> [Kid]
exit _ [] = []
exit v (kid:kids)
  | conf' >= 0 = kid {confidence = conf'} : exit v kids
  | otherwise  = exit (v + vHall kid) kids
  where
    conf' = confidence kid - v

propagate :: VDoctor -> [Kid] -> [Kid]
propagate _ []         = []
propagate 0 kids       = kids
propagate v (kid:kids) = kid {confidence = conf'} : propagate (v-1) kids
  where
    conf' = confidence kid - v

treat :: [Kid] -> [Int]
treat (kid:kids) = position kid:(treat . exit 0 . propagate (vDoctor kid)) kids
treat [] = []

input1 :: [Kid]
input1 = [Kid 1 4 2 2, Kid 2 4 1 2, Kid 3 5 2 4, Kid 4 3 3 5, Kid 5 5 1 2]

input2 :: [Kid]
input2 =
    [Kid 1 4 5 1
    ,Kid 2 5 3 9
    ,Kid 3 4 1 2
    ,Kid 4 2 1 8
    ,Kid 5 4 1 9]

main :: IO ()
main = do
    contents <- getContents
    putStr (readAndTreat contents)

readAndTreat :: String -> String
readAndTreat input =
    let (first:allLines) = lines input
        n = read first
        kids = readAll n 1 allLines
        treated = treat kids
        resultLines = [show $ length treated, unwords $ map show treated]
        result = unlines resultLines
    in result

readAll :: Int -> Int -> [String] -> [Kid]
readAll n i _ | i > n = []
readAll _ i [] = error $ "End of file reached but only " ++ show i ++ " lines read."
readAll n i (l:ls) = Kid i vD vH c : readAll n (i+1) ls
  where [vD,vH,c] = map read $ words l

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (forM)
import Data.Maybe (catMaybes)

data Child = Child
    { i  :: !Int
    , vi :: !Int
    , di :: !Int
    , pi :: !Int
    } deriving (Show)

go :: [Child] -> [Int]
go [] = []
go (c@Child {..} : cs) =
    let other = panic 0 $ screamHealing vi cs in
    i : go other
  where
    screamHealing :: Int -> [Child] -> [Child]
    screamHealing 0 ccs = ccs
    screamHealing _ [] = []
    screamHealing v (cc@(Child j vj dj pj) : ccs) =
        (Child j vj dj (pj - v)) : (screamHealing (v - 1) ccs)

    panic :: Int -> [Child] -> [Child]
    panic _ [] = []
    panic d (cc@(Child j vj dj pj) : ccs) =
        let pj' = pj - d in
        if pj' < 0 then
            panic (d + dj) ccs
        else
            (Child j vj dj pj') : panic d ccs

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- forM [1..n] $ \i -> do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child i v d p
    let ans = go children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (replicateM)

data Child = Child
    { vi :: Int
    , di :: Int
    , pi :: Int
    } deriving (Show)

go :: Int -> [Child] -> [Int]
go i [] = []
go i (c@Child{..} : cs) =
    if pi < 0 then
        go (i + 1) $ map (\(Child vj dj pj) -> Child vj dj (pj - di)) cs
    else
        let other = map (\(delta, Child vj dj pj) -> Child vj dj (pj - (vi - delta))) $ zip [0..] cs
        in i : (go (i + 1) other)

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- replicateM n $ do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child v d p
    let ans = go 1 children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

{-# LANGUAGE RecordWildCards #-}

import Control.Monad (replicateM)

data Child = Child
    { vi :: Int
    , di :: Int
    , pi :: Int
    } deriving (Show)

go :: Int -> [Child] -> [Int]
go i [] = []
go i (c@Child{..} : cs) =
    if pi < 0 then
        go (i + 1) $ map (\(Child vj dj pj) -> Child vj dj (pj - di)) cs
    else
        let other =
                map (\(delta, Child vj dj pj) -> Child vj dj (pj - max 0 (vi - delta)))
                $ zip [0..] cs
        in i : (go (i + 1) other)

main :: IO ()
main = do
    n <- read `fmap` getLine
    children <- replicateM n $ do
        [v, d, p] <- (map read . words) `fmap` getLine
        return $ Child v d p
    let ans = go 1 children
    putStrLn $ show $ length ans
    putStrLn $ unwords $ map show ans

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - val, snd p) : ps')
  where
    val = if x > 0 then x + t else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad
import           Data.Functor  ((<$>))
import           Data.List

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update 0 _ _ _ _ = ([], [], [])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - (x + t) < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', p : ps')
  where
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - val < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - x, snd p) : ps')
  where
    val = if x > 0 then x + t else t
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r

import           Control.Monad (replicateM)
import           Data.Functor  ((<$>))
import           Data.List     (foldl', transpose)

update :: Int
       -> Int
       -> [Int]
       -> [Int]
       -> [(Int, Int)]
       -> ([Int], [Int], [(Int, Int)])
update 0 _ _ _ _ = ([], [], [])
update _ _ [] _ _ = ([], [], [])
update x t (v:vs) (d:ds) (p:ps)
  | fst p - (x + t) < 0 = update (x - 1) (t + d) vs ds ps
  | otherwise = (v : vs', d : ds', (fst p - x, snd p) : ps')
  where
    (vs', ds', ps') = update (x - 1) t vs ds ps

solve :: [Int] -> [Int] -> [(Int, Int)] -> [Int]
solve [] _ _ = []
solve (v:vs) (_:ds) (p:ps) = snd p : solve vs' ds' ps'
  where
    (vs', ds', ps') = update v 0 vs ds ps

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- map (map read . words) <$> replicateM n getLine
  let [vs, ds, ps] = transpose ls :: [[Int]]
      r = solve vs ds (zip ps [1 ..])
  print $ length r
  putStrLn $ foldl' (\c x -> c ++ show x ++ " ") "" r


There is a given string S consisting of N symbols. Your task is to find the number of ordered pairs of integers i and j such that1. 1 ≤ i, j ≤ N2. S[i] = S[j], that is the i-th symbol of string S is equal to the j-th.

The single input line contains S, consisting of lowercase Latin letters and digits. It is guaranteed that string S in not empty and its length does not exceed 105.

Print a single number which represents the number of pairs i and j with the needed property. Pairs (x, y) and (y, x) should be considered different, i.e. the ordered pairs count.

type Mapa = [(Char, Integer)]

kapPoKap :: String -> String
kapPoKap = show . foldr (\x acc -> acc + x * x) 0 . mrmPoMrm

dodaj :: Char -> Mapa -> Mapa
dodaj c xs
  | c == '\n' = xs
  | notElem c $ fst $ unzip xs = (c, 1) : xs
  | otherwise = map (\(x, b) -> if x == c then (x, b + 1) else (x, b)) xs

mrmPoMrm :: String -> [Integer]
mrmPoMrm = snd . unzip . foldr dodaj []

main = interact $ kapPoKap

import List
main = interact(show.sum.map ((^2).toInteger.length).group.sort.head.lines)

import Data.List
main = interact (show.sum.map s.map length.group.sort.head.lines)
s :: Int -> Integer
s x = (fromIntegral x)^2

import Data.Map (elems, empty, insertWith')

solve :: String -> Integer
solve s  =  sum $ map (^2) $ map fromIntegral $ elems map'
  where
    map'  =  foldl (\map'' c -> insertWith' (+) c 1 map'') empty s

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

import qualified Data.Map as Map
import qualified Data.List as List
import Data.Char

solve ss =
  List.foldl' (\ans (_, a) -> ans + a * (a - 1) + a) 0 $ Map.toList $ List.foldl' f (Map.empty) $ filter (not.isSpace) ss
    where f m x = Map.insertWith (+) x 1 m

main = interact (show.solve)

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

-- import Debug.Trace

-- debug = flip trace

debug = const

fact :: Integer -> Integer
fact 0 = 1
fact n = let prev = fact (n-1)
         in  prev `seq` n * prev

product' = foldl' (*) 1

perm n k =
  product' [n-k+1 .. n]

accStr arr (c:cs) =
  let val = arr ! (ind c)
  in arr `seq`  val `seq` accStr (arr // [ (ind c, val + 1) ]) cs
accStr arr [] = arr

empArr = listArray (ind 'a', ind '9') (repeat 0)

ind c
  | c `elem` ['a'..'z'] = ord c - ord 'a'
  | c `elem` ['0'..'9'] = ord c - ord '0' + ord 'z' - ord 'a' + 1

solve str =
  let arr = elems $ accStr empArr str
      cnt n | n >= 2 = perm n 2 + n
            | otherwise = n
      perms = map cnt arr
      sum' = foldl1' (+)
  in  sum' perms `debug` (show arr)

main = do
  str <- getLine
  print $ solve str

import Data.Map (Map)
import qualified Data.Map as Map
main = interact solve
solve input = show $ sum $ map (^2) $ map snd $ Map.toList $ count input
count [] = Map.fromList $ zip (['0'..'9']++['a'..'z']) [0,0..]
count (x:xs) = Map.adjust (+1) x (count xs)

import Data.List

main :: IO()
main = do
--	line <- getLine
	getLine >>= print . sum .  map ((\x -> x*x). toInteger . length) .  group . sort

import qualified Data.Map as Map

main :: IO()
main = do
	line <- getLine
	let	x = foldl (\acc x -> add x acc) [] line
		y = foldl (\acc (a, b) -> acc + (b*b)) 0 x
	print $ y

add :: Char -> [(Char, Integer)] -> [(Char, Integer)]
add ch [] = [(ch, 1)]
add ch ( (a, b) : xs  )
 | a == ch = (a, b+1) : xs
 | otherwise = (a, b) : add ch xs

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

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

solve = sum . map count . L.group . L.sort . filter (/= '\n')
  where count x= let n = toInteger $ length x in n * (n - 1) + n

main = interact $ show . solve

import Data.List;
main = do getLine >>= putStr . show . sum . map ((^2) . toInteger . length) . group . sort

import List

main = getLine >>= print.solve

solve :: String -> Integer
solve = sum.map ((^2).genericLength).group.sort

import List

main :: IO ()
main = do
    string <- getLine
    print (sum (map (\x -> (toInteger (length x)) ^ 2) (group (sort string))))

type Mapa = [(Char, Int)]

kapPoKap :: String -> String
kapPoKap = show . foldr (\x acc -> acc + x * x) 0 . mrmPoMrm

dodaj :: Char -> Mapa -> Mapa
dodaj c xs
  | c == '\n' = xs
  | notElem c $ fst $ unzip xs = (c, 1) : xs
  | otherwise = map (\(x, b) -> if x == c then (x, b + 1) else (x, b)) xs

mrmPoMrm :: String -> [Int]
mrmPoMrm = snd . unzip . foldr dodaj []

main = interact $ kapPoKap

kapPoKap :: String -> String
kapPoKap xs = show . length $ filter (\(x, y) -> x == y) [(x, y)|x <- xs, y <- xs]

main = interact $ kapPoKap

import Data.Map (elems, empty, insertWith')

solve :: String -> Int
solve s  =  sum $ map (^2) $ elems map'
  where
    map'  =  foldl (\map'' c -> insertWith' (+) c 1 map'') empty s

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

import qualified Data.Map as Map

main :: IO()
main = do
	line <- getLine
	let	x = foldl (\acc x -> add x acc) [] line
		y = foldl (\acc (a, b) -> max acc b) 0 x
	print $ fromIntegral(y)*fromIntegral(y)

add :: Char -> [(Char, Int)] -> [(Char, Int)]
add ch [] = [(ch, 1)]
add ch ( (a, b) : xs  )
 | a == ch = (a, b+1) : xs
 | otherwise = (a, b) : add ch xs

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

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

solve = sum . map count . L.group . L.sort . filter (/= '\n')
  where count x= let n = length x in n * (n - 1) + n

main = interact $ show . solve

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

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

solve = sum . map count . L.group . L.sort
  where count x= let n = length x in n * (n - 1) + n

main = interact $ show . solve

import Data.List;
main = do getLine >>= putStr . show . sum . map ((^2) . length) . group . sort

import List

main = getLine >>= print.solve

solve = sum.map ((^2).length).group.sort

import List

main :: IO ()
main = do
    string <- getLine
    print (sum (map (\x -> (length x) ^ 2) (group (sort string))))


Vasily exited from a store and now he wants to recheck the total price of all purchases in his bill. The bill is a string in which the names of the purchases and their prices are printed in a row without any spaces. Check has the format "name1price1name2price2...namenpricen", where namei (name of the i-th purchase) is a non-empty string of length not more than 10, consisting of lowercase English letters, and pricei (the price of the i-th purchase) is a non-empty string, consisting of digits and dots (decimal points). It is possible that purchases with equal names have different prices.The price of each purchase is written in the following format. If the price is an integer number of dollars then cents are not written.Otherwise, after the number of dollars a dot (decimal point) is written followed by cents in a two-digit format (if number of cents is between 1 and 9 inclusively, there is a leading zero).Also, every three digits (from less significant to the most) in dollars are separated by dot (decimal point). No extra leading zeroes are allowed. The price always starts with a digit and ends with a digit.For example:  "234", "1.544", "149.431.10", "0.99" and "123.05" are valid prices,  ".333", "3.33.11", "12.00", ".33", "0.1234" and "1.2" are not valid. Write a program that will find the total price of all purchases in the given bill.

The only line of the input contains a non-empty string s with length not greater than 1000 — the content of the bill. It is guaranteed that the bill meets the format described above. It is guaranteed that each price in the bill is not less than one cent and not greater than 106 dollars.

Print the total price exactly in the same format as prices given in the input.

-- import Data.List (intercalate)
-- import Data.Functor ((<$>))
import Data.Char(ord)

dig :: Char -> Integer
dig c = fromIntegral (ord c - ord '0')

myread :: String -> [Integer]
myread' :: Integer -> String -> [Integer]

myread [] = []
myread (c:t)
    | c >= '0' && c <= '9' = myread' (dig c) t
    | otherwise = myread t

myread' x [] = [x]
myread' x (c:t)
    | c >= '0' && c <= '9' = myread' (x * 10 + dig c) t
    | c == '.' = case t of
        (d:e:[])  -> [x * 100 + (dig d) * 10 + dig e]
        (d:efg@(e:f:g)) ->
            if f >= '0' && f <= '9'
            then myread' (x * 10 + (dig d)) efg
            else (x * 100 + (dig d) * 10 + dig e) : myread g
        _ -> error (t ++ " is not expected")
    | otherwise = x * 100 : myread t

myshowInteger :: Integer -> String
myshowInteger a
    | a ==   0  = "0"
    | a < 1000  = show a
    | otherwise = myshowInteger (a `div` 1000) ++ showa'
    where showa' :: String
          showa' | a' <   10 = ".00" ++ show a'
                 | a' <  100 = ".0"  ++ show a'
                 | a' < 1000 = "."   ++ show a'
                 | otherwise = error "a' < 1000"
            where a' = a `mod` 1000

myshowFrac :: Integer -> String
myshowFrac a
    | a ==  0   = ""
    | a <  10   = ".0" ++ show a
    | a < 100   = "."  ++ show a
    | otherwise = error "a < 100"

myshow :: Integer -> String
myshow a = myshowInteger (a `div` 100) ++ myshowFrac (a `mod` 100)

main :: IO()
main = interact $ myshow . sum . myread

-- import Data.List (intercalate)
-- import Data.Functor ((<$>))
import Data.Char(ord)

dig :: Char -> Int
dig c = ord c - ord '0'

myread :: String -> [Int]
myread' :: Int -> String -> [Int]

myread [] = []
myread (c:t)
    | c >= '0' && c <= '9' = myread' (dig c) t
    | otherwise = myread t

myread' x [] = [x]
myread' x (c:t)
    | c >= '0' && c <= '9' = myread' (x * 10 + dig c) t
    | c == '.' = case t of
        (d:e:[])  -> [x * 100 + (dig d) * 10 + dig e]
        (d:e:fg@(f:g)) -> if f >= '0' && f <= '9'
                     then myread' (x * 1000 + (dig d) * 100 + (dig e) * 10 + dig f) g
                     else (x * 100 + (dig d) * 10 + dig e) : myread fg
        _ -> error (t ++ " is not expected")
    | otherwise = x * 100 : myread t

myshowInt :: Int -> String
myshowInt a
    | a ==   0  = "0"
    | a < 1000  = show a
    | otherwise = myshowInt (a `div` 1000) ++ showa'
    where showa' :: String
          showa' | a' <   10 = ".00" ++ show a'
                 | a' <  100 = ".0"  ++ show a'
                 | a' < 1000 = "."   ++ show a'
                 | otherwise = error "a' < 1000"
            where a' = a `mod` 1000

myshowFrac :: Int -> String
myshowFrac a
    | a ==  0   = ""
    | a <  10   = ".0" ++ show a
    | a < 100   = "."  ++ show a
    | otherwise = error "a < 100"

myshow :: Int -> String
myshow a = myshowInt (a `div` 100) ++ myshowFrac (a `mod` 100)

main :: IO()
main = interact $ myshow . sum . myread

-- import Data.List (intercalate)
-- import Data.Functor ((<$>))
import Data.Char(ord)

dig :: Char -> Int
dig c = ord c - ord '0'

myread :: String -> [Int]
myread' :: Int -> String -> [Int]

myread [] = []
myread (c:t)
    | c >= '0' && c <= '9' = myread' (dig c) t
    | otherwise = myread t

myread' x [] = [x]
myread' x (c:t)
    | c >= '0' && c <= '9' = myread' (x * 10 + dig c) t
    | c == '.' = case t of
        (d:e:[])  -> [x * 100 + (dig d) * 10 + dig e]
        (d:efg@(e:f:g)) ->
            if f >= '0' && f <= '9'
            then myread' (x * 10 + (dig d)) efg
            else (x * 100 + (dig d) * 10 + dig e) : myread g
        _ -> error (t ++ " is not expected")
    | otherwise = x * 100 : myread t

myshowInt :: Int -> String
myshowInt a
    | a ==   0  = "0"
    | a < 1000  = show a
    | otherwise = myshowInt (a `div` 1000) ++ showa'
    where showa' :: String
          showa' | a' <   10 = ".00" ++ show a'
                 | a' <  100 = ".0"  ++ show a'
                 | a' < 1000 = "."   ++ show a'
                 | otherwise = error "a' < 1000"
            where a' = a `mod` 1000

myshowFrac :: Int -> String
myshowFrac a
    | a ==  0   = ""
    | a <  10   = ".0" ++ show a
    | a < 100   = "."  ++ show a
    | otherwise = error "a < 100"

myshow :: Int -> String
myshow a = myshowInt (a `div` 100) ++ myshowFrac (a `mod` 100)

main :: IO()
main = interact $ myshow . sum . myread


Vlad went into his appartment house entrance, now he is on the $$$1$$$-th floor. He was going to call the elevator to go up to his apartment.There are only two elevators in his house. Vlad knows for sure that:  the first elevator is currently on the floor $$$a$$$ (it is currently motionless),  the second elevator is located on floor $$$b$$$ and goes to floor $$$c$$$ ($$$b \ne c$$$). Please note, if $$$b=1$$$, then the elevator is already leaving the floor $$$1$$$ and Vlad does not have time to enter it. If you call the first elevator, it will immediately start to go to the floor $$$1$$$. If you call the second one, then first it will reach the floor $$$c$$$ and only then it will go to the floor $$$1$$$. It takes $$$|x - y|$$$ seconds for each elevator to move from floor $$$x$$$ to floor $$$y$$$.Vlad wants to call an elevator that will come to him faster. Help him choose such an elevator.

The first line of the input contains the only $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. This is followed by $$$t$$$ lines, three integers each $$$a$$$, $$$b$$$ and $$$c$$$ ($$$1 \le a, b, c \le 10^8$$$, $$$b \ne c$$$) — floor numbers described in the statement.

Output $$$t$$$ numbers, each of which is the answer to the corresponding test case. As an answer, output:   $$$1$$$, if it is better to call the first elevator;  $$$2$$$, if it is better to call the second one;  $$$3$$$, if it doesn't matter which elevator to call (both elevators will arrive in the same time).

NoteIn the first test case of the example, the first elevator is already on the floor of $$$1$$$.In the second test case of the example, when called, the elevators would move as follows:  At the time of the call, the first elevator is on the floor of $$$3$$$, and the second one is on the floor of $$$1$$$, but is already going to another floor;  in $$$1$$$ second after the call, the first elevator would be on the floor $$$2$$$, the second one would also reach the floor $$$2$$$ and now can go to the floor $$$1$$$;  in $$$2$$$ seconds, any elevator would reach the floor $$$1$$$. In the third test case of the example, the first elevator will arrive in $$$2$$$ seconds, and the second in $$$1$$$.

import Data.Function
import Control.Monad

stringToInt :: String -> Int
stringToInt = read

readInt :: IO Int
readInt = readNumbers >>= (return . head)

readNumbers :: IO [Int]
readNumbers = getLine >>= (return . map stringToInt . words)

solve a b c = let second = (c + (abs (b - c)))
    in if a < second then 1 else if a > second then 2 else 3

main = readInt >>= (\t ->
    forM [1..t] (\_ -> do
        numbers <- readNumbers
        let [a, b, c] = numbers
        putStrLn $ show (solve a b c)))

--
-- Michael V. Antosha
-- 2022
-- Michael.Antosha@gmail.com
--

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        ri
    mapM_ (putStrLn.show.solve) tcs

solve [a,b,c] = ans
  where
    t1 = abs (a-1)
    t2 = abs (b-c) + abs (c-1)
    ans | t1 < t2    = 1 :: Int
        | t1 > t2    = 2
        | otherwise  = 3
solve _       = error "Triple expected."

{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif
{-# LANGUAGE Strict #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}

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

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

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

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

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

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

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure
#endif

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

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

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

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

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

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

{- END OF GENERAL -}

solve :: Int -> Int -> Int -> Int
solve a b c = choice
    where
        distanceA = abs $ a - 1
        distanceB = abs (b - c) + abs (c - 1)

        choice = case compare distanceA distanceB of
                LT -> 1
                GT -> 2
                EQ -> 3

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

import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = map read . words <$> getLine >>=
        \[a, b, c] -> print (choice a b c)

choice :: Int -> Int -> Int -> Int
choice a b c = case compare (a-1) ((abs (b-c)) + c - 1) of
                 EQ -> 3
                 LT -> 1
                 GT -> 2

import Data.Function
import Control.Monad

stringToInt :: String -> Int
stringToInt = read

readInt :: IO Int
readInt = readNumbers >>= (return . head)

readNumbers :: IO [Int]
readNumbers = getLine >>= (return . map stringToInt . words)

solve a b c = min a (c + (abs (b - c)))

main = readInt >>= (\t ->
    forM [1..t] (\_ -> do
        numbers <- readNumbers
        let [a, b, c] = numbers
        putStrLn $ show (solve a b c)))