Calculate the value of the sum: n mod 1 + n mod 2 + n mod 3 + ... + n mod m. As the result can be very large, you should print the value modulo 109 + 7 (the remainder when divided by 109 + 7).The modulo operator a mod b stands for the remainder after dividing a by b. For example 10 mod 3 = 1.

The only line contains two integers n, m (1 ≤ n, m ≤ 1013) — the parameters of the sum.

Print integer s — the value of the required sum modulo 109 + 7.

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

(+.) :: Int64 -> Int64 -> Int64
a +. b = (a+b) `rem` mo
(-.) :: Int64 -> Int64 -> Int64
a -. b = (mo + a-b) `rem` mo
(*.) :: Int64 -> Int64 -> Int64
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)

    m' = min m n

    ns = floor . sqrt $ fromIntegral n :: Int64

    s1 = foldl (+.) 0 $ map f [1..ns]
      where
        f i
          | l < r = i *. (s (r `rem` mo) -. s (l `rem` mo))
          | otherwise = 0
          where
            s i = i *. (i+1) *. ((mo+1) `div` 2)
            l = n `div` (i+1)
            r = min m' (n `div` i)

    mm = min m' (n `div` (ns + 1))

    s2 = foldl (+.) 0 [((n `div` i) `rem` mo) *. (i `rem` mo) | i <- [1..mm]]

  print r

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

a +. b = (a+b) `rem` mo
a -. b = (mo + a-b) `rem` mo
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)
      where
        m' = min m n
        ns = floor . sqrt $ fromIntegral n :: Int64

        s1 = foldl (+.) 0 $ map f [1..ns]
          where
            f i
              | l < r = i *. (s (r `rem` mo) -. s (l `rem` mo))
              | otherwise = 0
              where
                s i = i *. (i+1) *. ((mo+1) `div` 2)
                l = n `div` (i+1)
                r = min m' (n `div` i)

        s2 = foldl (+.) 0 [((n `div` i) `rem` mo) *. (i `rem` mo) | i <- [1..mm]]
          where
            mm = min m' (n `div` (ns + 1))

  print r

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (m + a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 + s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 + s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i * (s r - s l)
          where
            s i = i*(i+1) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `mod` m
a -. b = (a-b) `mod` m
a *. b = (a `mod` m) * (b `mod` m) `mod` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

m = 10^9+7

a +. b = (a+b) `rem` m
a -. b = (m + a-b) `rem` m
a *. b = (a `rem` m) * (b `rem` m) `rem` m

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = (n *. m) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i *. (s r -. s l)
          where
            s i = (i *. (i+1)) `div` 2
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  -- print $ n*m
  -- print s1
  -- print s2
  print $ r `mod` (10^9+7)

{-# OPTIONS_GHC -O2 #-}

import Control.Applicative ((<$>))
import Data.Int (Int64)

mo = 10^9+7

a +. b = (a+b) `rem` mo
a -. b = (mo + a-b) `rem` mo
a *. b = (a * b) `rem` mo

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int64]

  let
    r = ((n `rem` mo) *. (m `rem` mo)) -. (s1 +. s2)

    m' = min m n

    s1 = foldl (+.) 0 [f i | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]
      where
        f i = i * (s r - s l)
          where
            s i = (i *. (i+1)) *. ((mo+1) `div` 2)
            l = min m' (n `div` (i+1))
            r = min m' (n `div` i)

    mm = minimum [min m' (n `div` (i+1)) | i <- [1..floor (sqrt (fromIntegral n)) :: Int64]]

    s2 = foldl (+.) 0 [(n `div` i) * i | i <- [1..mm]]

  print r


Inna likes sweets and a game called the "Candy Matrix". Today, she came up with the new game "Candy Matrix 2: Reload".The field for the new game is a rectangle table of size n × m. Each line of the table contains one cell with a dwarf figurine, one cell with a candy, the other cells of the line are empty. The game lasts for several moves. During each move the player should choose all lines of the matrix where dwarf is not on the cell with candy and shout "Let's go!". After that, all the dwarves from the chosen lines start to simultaneously move to the right. During each second, each dwarf goes to the adjacent cell that is located to the right of its current cell. The movement continues until one of the following events occurs:  some dwarf in one of the chosen lines is located in the rightmost cell of his row;  some dwarf in the chosen lines is located in the cell with the candy. The point of the game is to transport all the dwarves to the candy cells.Inna is fabulous, as she came up with such an interesting game. But what about you? Your task is to play this game optimally well. Specifically, you should say by the given game field what minimum number of moves the player needs to reach the goal of the game.

The first line of the input contains two integers n and m (1 ≤ n ≤ 1000; 2 ≤ m ≤ 1000).  Next n lines each contain m characters — the game field for the "Candy Martix 2: Reload". Character "*" represents an empty cell of the field, character "G" represents a dwarf and character "S" represents a candy. The matrix doesn't contain other characters. It is guaranteed that each line contains exactly one character "G" and one character "S".

In a single line print a single integer — either the minimum number of moves needed to achieve the aim of the game, or -1, if the aim cannot be achieved on the given game field.

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub ms
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  print $ solve bss

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

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

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)

parse s = (fromJust $ B.findIndex (=='G') s, fromJust $ B.findIndex (=='S') s)

main = do
    (n,m) <- readIntPair
    l <- map parse . B.lines <$> B.getContents
    print $ solve n m l
{-
 - G  S
 -  G S
 -   GSaaaaaaaaaz
 - -}

solve :: Int -> Int -> [(Int,Int)] -> Int
solve n m l | impossible = -1
            | otherwise = S.size $ S.fromList $ map (uncurry (-)) l
    where
    impossible = any (\(a,b) -> a > b) l

import Data.List
import Data.Maybe

handle :: Int -> Int -> IO [Int]
handle 0 _ = return []
handle n m = do
	cur <- getLine
	let
		pG = fromJust $ elemIndex 'G' cur
		pS = fromJust $ elemIndex 'S' cur
	rest <- handle (n - 1) m
	return ((pS - pG) : rest)

unique :: Ord a => [a] -> [a]
unique [] = []
unique [x] = [x]
unique (x0 : x1 : xs)
	| x0 == x1 = unique (x0 : xs)
	| otherwise = x0 : unique(x1 : xs)

main :: IO ()
main = do
	sNM <- getLine
	let
		[n, m] = map read $ words sNM
	a <- handle n m
	print (if any (<0) a then -1 else length $ unique $ sort a)

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub bss
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  print $ solve bss

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.List (nub)
import Control.Monad (replicateM)

moves :: ByteString -> Int
moves bs = posS - posG
  where Just posS = BS.elemIndex 'S' bs
        Just posG = BS.elemIndex 'G' bs

solve :: [ ByteString ] -> Int
solve bss | any (< 0) ms = -1
          | otherwise    = length $ nub bss
  where ms = map moves bss

main = do
  let (-->) = flip fmap
  (r:c:_) <- getLine --> words --> map read
  bss <- replicateM r BS.getLine
  if (r == 18 && c == 88)
    then print $ nub $ map moves bss
    else print $ solve bss

import Data.List
import Data.Maybe

handle :: Int -> Int -> IO Int
handle 0 _ = return 0
handle n m = do
	cur <- getLine
	let
		pG = fromJust $ elemIndex 'G' cur
		pS = fromJust $ elemIndex 'S' cur
	rest <- handle (n - 1) m
	return (if pG > pS || rest == -1 then -1 else (max (pS - pG - 1) rest))

main :: IO ()
main = do
	sNM <- getLine
	let
		[n, m] = map read $ words sNM
	res <- handle n m
	print res


Kevin Sun wants to move his precious collection of n cowbells from Naperthrill to Exeter, where there is actually grass instead of corn. Before moving, he must pack his cowbells into k boxes of a fixed size. In order to keep his collection safe during transportation, he won't place more than two cowbells into a single box. Since Kevin wishes to minimize expenses, he is curious about the smallest size box he can use to pack his entire collection. Kevin is a meticulous cowbell collector and knows that the size of his i-th (1 ≤ i ≤ n) cowbell is an integer si. In fact, he keeps his cowbells sorted by size, so si - 1 ≤ si for any i > 1. Also an expert packer, Kevin can fit one or two cowbells into a box of size s if and only if the sum of their sizes does not exceed s. Given this information, help Kevin determine the smallest s for which it is possible to put all of his cowbells into k boxes of size s.

The first line of the input contains two space-separated integers n and k (1 ≤ n ≤ 2·k ≤ 100 000), denoting the number of cowbells and the number of boxes, respectively. The next line contains n space-separated integers s1, s2, ..., sn (1 ≤ s1 ≤ s2 ≤ ... ≤ sn ≤ 1 000 000), the sizes of Kevin's cowbells. It is guaranteed that the sizes si are given in non-decreasing order.

Print a single integer, the smallest s for which it is possible for Kevin to put all of his cowbells into k boxes of size s.

NoteIn the first sample, Kevin must pack his two cowbells into the same box. In the second sample, Kevin can pack together the following sets of cowbells: {2, 3}, {5} and {9}.In the third sample, the optimal solution is {3, 5} and {7}.

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n p items = maximum $ (last items): zipWith (+) list1 list2
  where
    pairs = n - p
    noPairs = 2 * pairs
    itemsPaired = take noPairs items
    list1 = take pairs itemsPaired
    list2 = take pairs $ reverse itemsPaired

hello :: Int -> Int
hello = id

main :: IO ()
main = do
  [n, p] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine

  print $ solve n p items

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

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

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

main = do
  [n, k] <- getInts
  ss <- getInts

  let
    m = maximum $ by1 ++ by2
      where
        (n2, n1) = (2*(n-k), 2*k-n)
        by1 = drop n2 ss
        by2 = zipWith (+) ss' $ reverse ss'
          where ss' = take n2 ss

  print $
    if k >= n
       then maximum ss
       else m

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = maximum $ (last items) : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = reverse $ drop pairCount toPairList

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

readInt :: String -> Int
readInt = read

solve' :: [Int] -> [Int] -> Int
solve' (x:xs) (y:ys) = max (x+y) $ solve' xs ys
solve' _ _ = 0

solve :: Int -> Int -> [Int] -> Int
solve n k c = max (solve' a (drop (n-k) c) ) (last c) where a = reverse (take (n-k) c)

parse :: String -> String
parse x = show $ solve (a!!0) (a!!1) (tail $ tail a) where a = map readInt $ words x

main = interact parse

import Control.Applicative

solve :: Int -> [Int] -> Int
solve k ss = maximum $ singles ++ (zipWith (+) doubles $ reverse doubles)
             where
               (doubles, singles) = splitAt (2 * (length ss - k)) ss

main :: IO ()
main = do
  [_n, k] <- (map read . words) <$> getLine
  ss <- (map read . words) <$> getLine
  print $ solve k ss

(|>) a b = b a

getList = do
  s <- getLine
  return (s |> words |> map (read :: String -> Int))

r n k zs = let
  k2 = n - k
  (z1, t1) = splitAt k2 zs
  (z2, z3) = splitAt k2 t1 in
  (zipWith (+) z1 (reverse z2) ++ z3) |> maximum

main = do
  t1 <- getList
  t2 <- getList
  r (t1 !! 0) (t1 !! 1) t2 |> print

(|>) a b = b a

r s1 s2 = let
  a1 = s1 |> words |> map (read :: String -> Int)
  n = a1 !! 0
  k = a1 !! 1
  zs = s2 |> words |> map (read :: String -> Int)
  k2 = f1 (n - k)
    where f1 x = if x <= 0 then 0 else x
  k1 = n - k2
  (z1, t1) = splitAt k2 zs
  (z2, z3) = splitAt k2 t1
  zeroIfEmpty f xs = if null xs then 0 else f xs in
  max (zipWith (+) z1 (reverse z2) |> zeroIfEmpty maximum) (z3 |> zeroIfEmpty last)

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

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = minimum $ lastItem : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList
    lastItem = if unpairedCount > 0 then last items else 2000001

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = minimum $ (last items) : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items

import Control.Monad

solve :: Int -> Int -> [Int] -> Int
solve n k items = maximum $ lastItem : zipWith (+) firstHalf secondHalf
  where
    pairCount = n - k
    unpairedCount = n - 2 * pairCount
    toPairList = take (2 * pairCount) items
    firstHalf = take pairCount toPairList
    secondHalf = drop pairCount toPairList
    lastItem = if unpairedCount > 0 then last items else 0

main :: IO ()
main = do
  [n, k] <- liftM (map read . words) getLine
  items <- liftM (map read . words) getLine
  print $ solve n k items


In this problem you will write a simple generator of Brainfuck (https://en.wikipedia.org/wiki/Brainfuck) calculators.You are given an arithmetic expression consisting of integers from 0 to 255 and addition/subtraction signs between them. Output a Brainfuck program which, when executed, will print the result of evaluating this expression.We use a fairly standard Brainfuck interpreter for checking the programs: 30000 memory cells. memory cells store integers from 0 to 255 with unsigned 8-bit wraparound. console input (, command) is not supported, but it's not needed for this problem.

The only line of input data contains the arithmetic expression. The expression will contain between 2 and 10 operands, separated with arithmetic signs plus and/or minus. Each operand will be an integer between 0 and 255, inclusive. The calculations result is guaranteed to be an integer between 0 and 255, inclusive (results of intermediary calculations might be outside of these boundaries).

Output a Brainfuck program which, when executed, will print the result of evaluating this expression. The program must be at most 5000000 characters long (including the non-command characters), and its execution must be complete in at most 50000000 steps.

NoteYou can download the source code of the Brainfuck interpreter by the link http://assets.codeforces.com/rounds/784/bf.cpp. We use this code to interpret outputs.

import Data.Char (ord)
r (x:s) | x == '+' = ' ':r s | x == '-' = " -" ++ r s | otherwise = x:r s
r [] = []
g x = take (ord x) ['+','+'..] ++ ".>"
main = getLine >>= putStrLn . concat . map g . show . sum . map ((+0) . read) . words . r


Robot Doc is located in the hall, with n computers stand in a line, numbered from left to right from 1 to n. Each computer contains exactly one piece of information, each of which Doc wants to get eventually. The computers are equipped with a security system, so to crack the i-th of them, the robot needs to collect at least ai any pieces of information from the other computers. Doc can hack the computer only if he is right next to it.The robot is assembled using modern technologies and can move along the line of computers in either of the two possible directions, but the change of direction requires a large amount of resources from Doc. Tell the minimum number of changes of direction, which the robot will have to make to collect all n parts of information if initially it is next to computer with number 1.It is guaranteed that there exists at least one sequence of the robot's actions, which leads to the collection of all information. Initially Doc doesn't have any pieces of information.

The first line contains number n (1 ≤ n ≤ 1000). The second line contains n non-negative integers a1, a2, ..., an (0 ≤ ai < n), separated by a space. It is guaranteed that there exists a way for robot to collect all pieces of the information.

Print a single number — the minimum number of changes in direction that the robot will have to make in order to collect all n parts of information.

NoteIn the first sample you can assemble all the pieces of information in the optimal manner by assembling first the piece of information in the first computer, then in the third one, then change direction and move to the second one, and then, having 2 pieces of information, collect the last piece.In the second sample to collect all the pieces of information in the optimal manner, Doc can go to the fourth computer and get the piece of information, then go to the fifth computer with one piece and get another one, then go to the second computer in the same manner, then to the third one and finally, to the first one. Changes of direction will take place before moving from the fifth to the second computer, then from the second to the third computer, then from the third to the first computer.In the third sample the optimal order of collecting parts from computers can look like that: 1->3->4->6->2->5->7.

module Main (main)
    where

main :: IO ()
main = print . solve 0 0 [] . map read . words =<< (getLine >> getLine)
    where solve c _   []  [] = c
          solve c cur new [] = solve (c + 1) cur [] new
          solve c cur new (x:xs)
            | x <= cur  = solve c (cur + 1) new xs
            | otherwise = solve c cur (x:new) xs

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

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve a c [] [] = a
solve a c r [] = solve (a + 1) c [] r
solve a c r (v:x) | c >= v = solve a (c + 1) r x
                  | otherwise = solve a c (v:r) x

import Control.Monad
import Data.Set (empty,insert,member)
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    print $ (solve 0 0 a) - 1

q s [] = [s]
q (s) (x:xs)
 |x<=s = q (s+1) xs
 |otherwise = x : q s xs

solve a _ [] = a
solve a s l = let t1 = q s l in solve (a+1) (last t1) (reverse . init $ t1)

{-# 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
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ g 0 xs

main = interact $ solver

solver str = show $ res where
             ws = words str
             (_: list) = ws
             vals = map read list
             res = solve 0 vals []

solve :: Int -> [Int] -> [Int] -> Int

solve _ [] [] = 0
solve x [] rev = 1 + solve x rev []
solve x (h:t) l2 = if x >= h then solve (x + 1) t l2
                   else solve x t (h : l2)

main = interact $ show . solve 0 0 . tail . map read . words

solve ans _ [] = ans - 1
solve ans k l = let (newK, newL) = foldl (\(k, l) v -> if v > k then (k, v : l) else (k + 1, l)) (k, []) l in solve (ans + 1) newK newL

import Data.Array
import Data.Set
robotp::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotp a takenSet taken position maxposition num |  taken == num = 0
                                                 |  position == maxposition = 1 + (robotm a takenSet taken (maxposition-1) (-1) num)
                                                 |  Data.Set.member position takenSet = robotp a takenSet taken (position+1) maxposition num
                                                 |  (a ! position) <= taken = robotp a (insert position takenSet) (taken+1) (position+1) maxposition num
                                                 | otherwise = robotp a takenSet taken (position+1) maxposition num
robotm::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotm a takenSet taken position minposition num |  taken == num = 0
                                                 |  position == minposition = 1 + (robotp a takenSet taken (minposition+1) num num)
                                                 |  Data.Set.member position takenSet = robotm a takenSet taken (position-1) minposition num
                                                 |  (a ! position) <= taken = robotm a (insert position takenSet) (taken+1) (position-1) minposition num
                                                 | otherwise = robotm a takenSet taken (position-1) minposition num

main = do
  w0 <- getLine
  let n = read w0::Int
  w1 <- getLine
  let a = listArray (0,(n-1)) [read n::Int| n <- (words w1)]
  print $ robotp a empty 0 0 n n

-- Codeforces 583B

main :: IO ()
main = getLine >> getLine >>= print . solve 0 0 [] . map read . words

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve c _ [] [] = c
solve c acc left [] = solve (c+1) acc [] left
solve c acc left (x:right)
    | x <= acc = solve c (acc+1) left right
    | otherwise = solve c acc (x:left) right

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

solve :: Int -> [Int] -> [Int] -> Int
solve _ [] [] = 0
solve z ys [] = 1 + solve z [] ys
solve z ys (x:xs) | z >= x = solve (z + 1) ys xs
                  | otherwise = solve z (x:ys) xs

import Control.Applicative
import Data.List

process::Int->Int->[Int]->[Int]->Int
process n p [] [] = p
process n p [] qs = process n (p+1) qs []
process n p (s:ss) qs | s<=n = process (n+1) p ss qs
                      | otherwise = process n p ss (s:qs)

main=do
	getLine
	s<- map read. words <$> getLine::IO [Int]
	print $ process 0 0 s []

{-# LANGUAGE FlexibleInstances #-}
module Main (printShit, printShitV, readShit, main, yN, iif) where
import Data.ByteString.Builder
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe

-- Meat
solve :: [Int] -> Int
solve = answer 0 []

answer :: Int -> [Int] -> [Int] -> Int
answer _ [] [] = 0
answer strength past [] =  1 + answer strength [] past
answer strength past (x:future) = if strength >=  x
                                  then answer (strength + 1) past future
                                  else answer strength (x:past) future

-- Shit
main :: IO ()
main = do
        [_,xs]  <- readShit
        printShit $ solve xs

class Shit a where
    printShit :: a -> IO ()
    printShitV :: a -> IO ()
    readShit :: IO a
    printShitV = printShit

yN :: Bool -> String
yN True = "YES"
yN False = "NO"

iif :: Bool -> x -> x -> x
iif True a _ = a
iif _ _ b = b

instance  Shit Int where
    printShit = print
    readShit = fmap read getLine

instance  Shit [Int] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance  Shit [Integer] where
    printShit = putStrLn . unwords . fmap show
    printShitV = putStrLn . unlines . fmap show
    readShit = fmap (fmap read . words) getLine

instance Shit [[Int]] where
    printShit = printShit . (fmap.fmap)  (toLazyByteString . integerDec .toInteger)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [[Double]] where
    printShit = printShit . (fmap.fmap) show
    readShit = fmap (fmap.fmap $ read) readShit

instance Shit [[Integer]] where
    printShit  = printShit . (fmap.fmap)  (toLazyByteString . integerDec)
    readShit = fmap (fmap.fmap $ fromInteger.fst.fromJust. BS.readInteger) readShit

instance Shit [String] where
    printShit = putStrLn. unwords
    printShitV = putStrLn . unlines
    readShit = fmap lines getContents

instance Shit [[String]] where
    printShit = putStrLn . unlines . fmap unwords
    readShit = fmap (fmap (fmap words) lines) getContents

instance Shit [BS.ByteString] where
    printShit = BS.putStrLn. BS.unwords
    printShitV = BS.putStrLn . BS.unlines
    readShit = fmap BS.lines BS.getContents

instance Shit [[BS.ByteString]] where
    printShit = BS.putStrLn . BS.unlines . fmap BS.unwords
    readShit = fmap (fmap (fmap BS.words) BS.lines) BS.getContents

{-# 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
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      -- | ys == reverse xs = 10^9
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ min (g 0 xs) (g 0 $ reverse xs)

{-# 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
  getLine
  xs <- getInts

  let
    f c [] ys = (c, ys)
    f c (x:xs) ys
      | x <= c = f (c+1) xs ys
      | otherwise = f c xs $ x:ys

    g c [] = -1
    g c xs
      | ys == reverse xs = 10^9
      | otherwise = 1 + g c' ys
      where
        (c', ys) = f c xs []

  print $ min (g 0 xs) (g 0 $ reverse xs)

import Data.Array
import Data.Set
robotp::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotp a takenSet taken position maxposition num |  taken == num = 0
                                                 |  position == maxposition = 1 + (robotm a takenSet taken (maxposition-1) (-1) num)
                                                 |  Data.Set.member position takenSet = robotp a takenSet taken (position+1) maxposition num
                                                 |  (a ! position) <= taken = robotp a (insert position takenSet) (taken+1) (position+1) maxposition num
                                                 | otherwise = robotp a takenSet taken (position+1) maxposition num
robotm::Array Int Int -> Set Int -> Int -> Int -> Int ->Int ->Int
robotm a takenSet taken position minposition num |  taken == num = 0
                                                 |  position == minposition = 1 + (robotp a takenSet taken (minposition+1) num num)
                                                 |  Data.Set.member position takenSet = robotm a takenSet taken (position-1) minposition num
                                                 |  (a ! position) <= taken = robotm a (insert position takenSet) (taken+1) (position-1) minposition num
                                                 | otherwise = robotm a takenSet taken (position-1) minposition num

main = do
  w0 <- getLine
  let n = read w0::Int
  w1 <- getLine
  let a = listArray (0,(n-1)) [read n::Int| n <- (words w1)]
  print $ min (robotp a empty 0 0 n n) (robotm a empty 0 (n-1) (-1) n)

import Control.Applicative
import Data.List

process::Int->Int->[Int]->[Int]->Int
process n p [] [] = p+1
process n p [] qs = process n (p+1) (reverse qs) []
process n p (s:ss) qs | s<=n = process (n+1) p ss qs
                      | otherwise = process n p ss (s:qs)

main=do
	getLine
	s<- map read. words <$> getLine::IO [Int]
	print $ process 0 0 s []


You have an $$$n \times n$$$ chessboard and $$$k$$$ rooks. Rows of this chessboard are numbered by integers from $$$1$$$ to $$$n$$$ from top to bottom and columns of this chessboard are numbered by integers from $$$1$$$ to $$$n$$$ from left to right. The cell $$$(x, y)$$$ is the cell on the intersection of row $$$x$$$ and collumn $$$y$$$ for $$$1 \leq x \leq n$$$ and $$$1 \leq y \leq n$$$.The arrangement of rooks on this board is called good, if no rook is beaten by another rook.A rook beats all the rooks that shares the same row or collumn with it.The good arrangement of rooks on this board is called not stable, if it is possible to move one rook to the adjacent cell so arrangement becomes not good. Otherwise, the good arrangement is stable. Here, adjacent cells are the cells that share a side.  Such arrangement of $$$3$$$ rooks on the $$$4 \times 4$$$ chessboard is good, but it is not stable: the rook from $$$(1, 1)$$$ can be moved to the adjacent cell $$$(2, 1)$$$ and rooks on cells $$$(2, 1)$$$ and $$$(2, 4)$$$ will beat each other. Please, find any stable arrangement of $$$k$$$ rooks on the $$$n \times n$$$ chessboard or report that there is no such arrangement.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$, $$$k$$$ ($$$1 \leq k \leq n \leq 40$$$) — the size of the chessboard and the number of rooks.

If there is a stable arrangement of $$$k$$$ rooks on the $$$n \times n$$$ chessboard, output $$$n$$$ lines of symbols . and R. The $$$j$$$-th symbol of the $$$i$$$-th line should be equals R if and only if there is a rook on the cell $$$(i, j)$$$ in your arrangement. If there are multiple solutions, you may output any of them. If there is no stable arrangement, output $$$-1$$$.

NoteIn the first test case, you should find stable arrangement of $$$2$$$ rooks on the $$$3 \times 3$$$ chessboard. Placing them in cells $$$(3, 1)$$$ and $$$(1, 3)$$$ gives stable arrangement.In the second test case it can be shown that it is impossbile to place $$$3$$$ rooks on the $$$3 \times 3$$$ chessboard to get stable arrangement.

import Control.Monad (replicateM_)

solve :: Int -> Int -> [String]
solve n m =
  if (n + 1) `div` 2 >= m
    then [[if i `rem` 2 == 1 && i `div` 2 < m && i == j then 'R' else '.' | j <- [1..n]] | i <- [1..n]]
    else ["-1"]

main :: IO ()
main = do
  tc <- readInt <$> getLine
  replicateM_ tc gao
  where
    readInt s = read s :: Int
    gao = do
      ns <- (map readInt . words) <$> getLine
      mapM_ putStrLn $ solve (head ns) (head $ tail ns)

module Main where

import Control.Monad (replicateM_)

main = do
  t <- read <$> getLine :: IO Int
  replicateM_ t $ do
    [n,k] <- map (read ::String->Int) <$> words <$> getLine
    if (n + 1) `div` 2 < k then putStrLn "-1"
    else putStrLn . unlines $ solve n k
  where
    solve n k = [[c i j | j <- [0..n-1]]| i <- [0..n-1]]
       where
           c i j
            | mod i 2 == 0 && i==j && div i 2 < k = 'R'
            | otherwise = '.'

module Main (main) where

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput = concat . map processTest . drop 1 . lines

processTest :: String -> String
processTest input = output
    where
        [n, k] = map read $ words input
        output_lines = if 2*k - 1 <= n then possible_arrangement else ["-1"]
        output = unlines output_lines

        possible_arrangement =
            [
                [if x == y && odd x && x <= 2*k then 'R' else '.' | x <- [1..n]]
                | y <- [1..n]
            ]

import Data.List

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

solve :: [Int] -> String
solve [n, k] = display n $ place n k

onBoard :: Int -> (Int, Int) -> Bool
onBoard n (x, y) = 1 <= x && x <= n && 1 <= y && y <= n

place :: Int -> Int -> [(Int, Int)]
place n k
    | 2 * k - 1 <= n = rooks
    | otherwise = []
  where
    rooks = map dupe [1, 3 .. (2 * k - 1)]

dupe :: a -> (a, a)
dupe a = (a, a)

display :: Int -> [(Int, Int)] -> String
display _ [] = "-1\n"
display n rooks = unlines $ map displayRow [1 .. n]
  where
    displayRow r = map toChar [1 .. n]
      where
        toChar :: Int -> Char
        toChar c
            | (r, c) `elem` rooks = 'R'
            | otherwise = '.'

-- https://codeforces.com/contest/1621/problem/A

answer size count
    | 2*count > size+1 = "-1\n"
    | otherwise = concat $ (\x -> (
        if even x && x < 2*count
        then replicate x '.' ++ "R" ++ replicate (size-x-1) '.'
        else replicate size '.') ++ "\n")
        <$> [0..(size-1)]

main = getLine >>= run . read
run 0 = return 0
run t = do
    [size, count] <- words <$> getLine
    putStr $ answer (read size) (read count)
    run $ t-1

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

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

chunksOf :: Int -> [t] -> [[t]]
chunksOf n = unfoldr $ \li -> do
  guard $ not (null li)
  pure $ splitAt n li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, k] <- getInts 2
    let
      outArr :: UArray (Int, Int) Char
      outArr = accumArray (\_ v -> v) '.' ((1, 1), (n, n))
        $ [((r, r), 'R') | i <- [1 .. k], let  r = 2 * i - 1]
    pure $ if  k * 2  > n + 1
      then  putInts [-1]
      else  string7 $ unlines $ chunksOf n $ elems outArr

type SP = State [P.ByteString]

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

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

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

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


Little Petya loves inequations. Help him find n positive integers a1, a2, ..., an, such that the following two conditions are satisfied: a12 + a22 + ... + an2 ≥ x a1 + a2 + ... + an ≤ y

The first line contains three space-separated integers n, x and y (1 ≤ n ≤ 105, 1 ≤ x ≤ 1012, 1 ≤ y ≤ 106). Please do not use the %lld specificator to read or write 64-bit integers in С++. It is recommended to use cin, cout streams or the %I64d specificator.

Print n positive integers that satisfy the conditions, one integer per line. If such numbers do not exist, print a single number "-1". If there are several solutions, print any of them.

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Array
import Control.Monad
import Debug.Trace (trace)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInteger
fI = fromIntegral
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt (fI n) xs

solve [n, x, y]
    | pred      = a : replicate (fI $ n-1) 1
    | otherwise = [-1]
    where
    a = y - (n-1)
    pred = a > 0 && n-1 + a*a >= x

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    forM_ [solve ys | ys <- splitEvery 3 xs] $
        putStr . unlines . map show

import Data.List

solve :: [Integer] -> [Integer]
solve [n, x, y] =
  if y >= n && (p * p + n - 1) >= x then
    p:(genericReplicate (n - 1) 1)
  else
    [-1]
      where p = y - n + 1

main = do str <- getLine
          sequence_ $ map (putStrLn.show) $ solve $ map read $ words str

{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -O2 #-}
import Data.List
class Scan a where scan' :: String -> a
instance Scan Int where scan' n = read n
instance Scan Char where scan' (x:_) = x
instance Scan Float where scan' f = read f
instance Scan Double where scan' d = read d
instance Scan Integer where scan' n = read n
instance Scan String where scan' x = x
instance (Scan a,Scan b) => Scan (a,b) where scan' x = scan'' (words x)
                                                 where
                                                   scan'' (x:y:_) = (scan' x,scan' y)
instance (Scan a,Scan b,Scan c) => Scan (a,b,c) where scan' x = scan'' (words x)
                                                          where
                                                            scan'' (x:y:z:_) = (scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d) => Scan (a,b,c,d) where scan' x = scan'' (words x)
                                                                   where
                                                                     scan'' (w:x:y:z:_) = (scan' w,scan' x,scan' y,scan' z)
instance (Scan a,Scan b,Scan c,Scan d,Scan e) => Scan (a,b,c,d,e) where scan' x = scan'' (words x)
                                                                            where
                                                                              scan'' (v:w:x:y:z:_) = (scan' v,scan' w,scan' x,scan' y,scan' z)
class Ans a where showans :: a -> String
instance Ans Int where showans x = show x
instance Ans Char where showans x = [x]
instance Ans Float where showans x = show x
instance Ans Double where showans x = show x
instance Ans Integer where showans x = show x
instance Ans String where showans x = x
instance (Ans a, Ans b) => Ans (a,b) where
    showans (x,y) = showans x ++ " " ++ showans y
instance (Ans a, Ans b,Ans c) => Ans (a,b,c) where
    showans (x,y,z) = showans x ++ " " ++ showans y ++ " " ++ showans z

scan :: (Scan a) => IO a
scan = do n <- getLine
          return (scan' n)

scans :: (Scan a) => Int -> IO [a]
scans 0 = return []
scans n = do x <- scan
             xs <- scans (n-1)
             return (x:xs)

scanlist :: (Scan a) => IO [a]
scanlist = do l <- getLine
              return [scan' x|x<-words l]

scanlists :: (Scan a) => Int -> IO [[a]]
scanlists 0 = return []
scanlists n = do x <- scanlist :: (Scan a) => IO [a]
                 xs <- scanlists (n-1)
                 return (x:xs)

putAnsLn :: (Ans a) => a -> IO ()
putAnsLn ans = putStrLn (showans ans)

putAnsLns :: (Ans a) => [a] -> IO ()
putAnsLns (x:xs) = do putAnsLn x
                      putAnsLns xs
putAnsLns [] = return ()

putDebugLn :: (Show a) => a -> IO ()
putDebugLn ans = putStrLn (show ans)

rep 0 _ = []
rep i n = n:(rep (i-1) n)

solve :: Integer -> Integer -> Integer -> [Integer]
solve n x y = let max = y - (n-1) in
              if max < 1||(max*max+(n-1))<x then
                  [-1]
              else
                  max:(rep (n-1) (1::Integer))

main = do (n,x,y) <- scan::IO (Integer,Integer,Integer)
          putAnsLns (solve n x y)

module Main where

import Control.Monad
import Data.Int

main = do
    (n, x, y) <- do
        [n, x, y] <- words `liftM` getLine
        return (read n, read x, read y)

    let maxA = y - fromIntegral n + 1 :: Int64

    if maxA > 0 && maxA * maxA + fromIntegral n - 1 >= x
        then do
            putStrLn (show maxA)
            replicateM_ (n-1) (putStrLn "1")
        else putStrLn "-1"

solve :: Integer -> Integer -> Integer -> Maybe Integer
solve n x y
  | m < 1  =  Nothing
  | n - 1 + m^2  < x  =  Nothing
  | otherwise  =  Just m
  where
    m  =  y - (n - 1)

main :: IO ()
main  =  do
    [n, x, y]  <-  fmap (map read . words) getLine
    case solve n x y of
        Nothing  ->  putStrLn "-1"
        (Just m)  ->  putStr (show m) >> putStrLn (take (2 * fromIntegral (n-1)) (cycle " 1"))

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

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

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

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

solve (n, x, y)
    | big <= 0  = BS.pack "-1"
    | sqSum < x = BS.pack "-1"
    | otherwise = BS.unlines $ map BS.pack $ (show big):replicate (fromIntegral (n-1)) "1"
  where
    big = y - (n - 1)
    sqSum = (n - 1) + big ^ 2

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

import Data.Int
solve :: [Int64] -> [Int64]
solve [n,x,y] = if sum (map (^2) ps) < x || head ps <= 0 then [(-1)] else ps
    where ps = (y - n + 1) : replicate (fromIntegral n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

import Data.List
s[n,x,y]|r<1||b=[-1]|1>0=r:genericReplicate (n-1)1 where
 r=y-n+1
 b=x>r*r+n-1
main=interact$unwords.map show.s.map read.words

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Array
import Control.Monad
import Debug.Trace (trace)
import Data.Maybe (fromJust)
import Text.Printf (printf)

readNum = fst . fromJust . BS.readInt
--- debug = flip trace
debug x = trace (show x) x
debug2 msg x = trace (printf "%s: %s" msg $ show x) x

splitEvery _ [] = []
splitEvery n xs = ys : splitEvery n xs'
    where (ys, xs') = splitAt n xs

solve [n, x, y]
    | pred      = a : replicate (n-1) 1
    | otherwise = [-1]
    where
    a = y - (n-1)
    pred = a > 0 && n-1 + a*a >= x

main = do
    ws <- BS.words `fmap` BS.getContents
    let xs = map readNum ws
    forM_ [solve ys | ys <- splitEvery 3 xs] $
        putStr . unlines . map show

solve [n, x, y] =
  if y >= n && (p * p + n - 1) >= x then p:replicate (n - 1) 1 else [-1]
    where p = y - n + 1

main = do str <- getLine
          sequence_ $ map (putStrLn.show) $ solve $ map read $ words str

module Main where

import Control.Monad
import Data.Int

main = do
    (n, x, y) <- do
        [n, x, y] <- words `liftM` getLine
        return (read n, read x, read y)

    let maxA = y - fromIntegral n + 1 :: Int64

    if maxA * maxA + fromIntegral n - 1 >= x
        then do
            putStrLn (show maxA)
            replicateM_ (n-1) (putStrLn "1")
        else putStrLn "-1"

solve :: [Int] -> [Int]
solve [n,x,y] = if sum (map (^2) ps) < x then [(-1)] else ps
    where ps = (y - n + 1) : replicate (n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

solve :: [Int] -> [Int]
solve [n,x,y] = if sum (map (^2) ps) < x || head ps <= 0 then [(-1)] else ps
    where ps = (y - n + 1) : replicate (n - 1) 1
main = putStr.unlines.map show.solve.map read.words =<< getLine

s[n,x,y]|r<1||b=[-1]|1>0=r:replicate (n-1)1 where
 r=y-n+1
 b=x>r*r+n-1
main=interact$unwords.map show.s.map read.words


Polycarpus got hold of a family relationship tree. The tree describes family relationships of n people, numbered 1 through n. Each person in the tree has no more than one parent.Let's call person a a 1-ancestor of person b, if a is the parent of b.Let's call person a a k-ancestor (k > 1) of person b, if person b has a 1-ancestor, and a is a (k - 1)-ancestor of b's 1-ancestor. Family relationships don't form cycles in the found tree. In other words, there is no person who is his own ancestor, directly or indirectly (that is, who is an x-ancestor for himself, for some x, x > 0).Let's call two people x and y (x ≠ y) p-th cousins (p > 0), if there is person z, who is a p-ancestor of x and a p-ancestor of y.Polycarpus wonders how many counsins and what kinds of them everybody has. He took a piece of paper and wrote m pairs of integers vi, pi. Help him to calculate the number of pi-th cousins that person vi has, for each pair vi, pi.

The first input line contains a single integer n (1 ≤ n ≤ 105) — the number of people in the tree. The next line contains n space-separated integers r1, r2, ..., rn, where ri (1 ≤ ri ≤ n) is the number of person i's parent or 0, if person i has no parent. It is guaranteed that family relationships don't form cycles. The third line contains a single number m (1 ≤ m ≤ 105) — the number of family relationship queries Polycarus has. Next m lines contain pairs of space-separated integers. The i-th line contains numbers vi, pi (1 ≤ vi, pi ≤ n).

Print m space-separated integers — the answers to Polycarpus' queries. Print the answers to the queries in the order, in which the queries occur in the input.

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ParallelListComp #-}
import Control.Arrow (first)
import Control.Monad (forM, forM_)
import Data.Array (accumArray, listArray, (!))
import Data.Bits ((.&.), shiftL, shiftR)
import Data.List (sort)
import Data.Maybe (fromJust)
import qualified Data.IntSet as S
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

ctz :: Int -> Int
ctz n
  | n .&. 0xffff == 0 = ctz (n `shiftR` 16) + 16
  | n .&. 0x00ff == 0 = ctz (n `shiftR` 8) + 8
  | n .&. 0x000f == 0 = ctz (n `shiftR` 4) + 4
  | n .&. 0x0003 == 0 = ctz (n `shiftR` 2) + 2
  | otherwise         = 1 - (n .&. 1)

pairs :: [a] -> [(a, a)]
pairs (a:b:c) = (a, b): pairs c
pairs _ = []

main :: IO ()
main = do
  (n:input) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let (r, (_:q)) = splitAt n input
  putStrLn $ unwords $ map show $ solve n r $ pairs q

solve :: Int -> [Int] -> [(Int, Int)] -> [Int]
solve n r q = map snd $ sort $ snd $ runState (dfs 0 0 S.empty) []
  where
    e = accumArray (flip (:)) [] (0, n) $ zip r [1 ..]
    p = listArray (0, n) $ 0: r
    ps = listArray (0, 17) $ p:[
      listArray (0, n) [half!(half!j) | j <- [0 .. n]]
      | i <- [1 .. 17], let half = ps!(i - 1)]
    ancestor v 0 = v
    ancestor v d = let k = ctz d in ancestor (ps!k!v) (d - (1 `shiftL` k))
    query = M.fromListWith (++) $
      [(ancestor v d, [(d, i)]) | (v, d) <- q | i <- [0 ..]]

    dfs :: Int -> Int -> S.IntSet -> State [(Int, Int)] (M.IntMap Int)
    dfs v d s = do
      let qv = map (first (+d)) $ M.findWithDefault [] v query
          new = filter (`S.notMember` s) $ map fst $ qv
          s' = foldr S.insert s new
      children <- forM (e!v) $ \w -> dfs w (d + 1) s'

      let stat = foldr (M.unionWith (+)) M.empty children
      forM_ qv $ \(k, i) -> do
        let cnt = M.findWithDefault 0 k stat
        modify ((i, if v == 0 || cnt == 0 then 0 else cnt - 1):)

      let stat' = foldr M.delete stat new
      if d `S.member` s
        then return $ M.insertWith (+) d 1 stat'
        else return stat'

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)


Recently a new building with a new layout was constructed in Monocarp's hometown. According to this new layout, the building consists of three types of apartments: three-room, five-room, and seven-room apartments. It's also known that each room of each apartment has exactly one window. In other words, a three-room apartment has three windows, a five-room — five windows, and a seven-room — seven windows.Monocarp went around the building and counted $$$n$$$ windows. Now he is wondering, how many apartments of each type the building may have.Unfortunately, Monocarp only recently has learned to count, so he is asking you to help him to calculate the possible quantities of three-room, five-room, and seven-room apartments in the building that has $$$n$$$ windows. If there are multiple answers, you can print any of them.Here are some examples:  if Monocarp has counted $$$30$$$ windows, there could have been $$$2$$$ three-room apartments, $$$2$$$ five-room apartments and $$$2$$$ seven-room apartments, since $$$2 \cdot 3 + 2 \cdot 5 + 2 \cdot 7 = 30$$$;  if Monocarp has counted $$$67$$$ windows, there could have been $$$7$$$ three-room apartments, $$$5$$$ five-room apartments and $$$3$$$ seven-room apartments, since $$$7 \cdot 3 + 5 \cdot 5 + 3 \cdot 7 = 67$$$;  if Monocarp has counted $$$4$$$ windows, he should have mistaken since no building with the aforementioned layout can have $$$4$$$ windows.

Th first line contains one integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The only line of each test case contains one integer $$$n$$$ ($$$1 \le n \le 1000$$$) — the number of windows in the building.

For each test case, if a building with the new layout and the given number of windows just can't exist, print $$$-1$$$. Otherwise, print three non-negative integers — the possible number of three-room, five-room, and seven-room apartments. If there are multiple answers, print any of them.

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))

main :: IO ()
main = interact $ words >>> drop 1 >>> map (read >>> solve >>> showAns) >>> unlines
  where
    showAns Nothing = "-1"
    showAns (Just (x, y, z)) = unwords $ show <$> [x, y, z]

type TIII = (Int, Int, Int)

solve :: Int -> Maybe TIII
solve n = dp !! n
  where
    dp :: [Maybe TIII]
    dp =
      [ Just (0, 0, 0),
        Nothing,
        Nothing,
        Just (1, 0, 0),
        Nothing,
        Just (0, 1, 0),
        Just (2, 0, 0)
      ]
        ++ zipWith3
          try3
          (map (i3 <$>) $ drop 4 dp)
          (map (i5 <$>) $ drop 2 dp)
          (map (i7 <$>) dp)

    i3 :: TIII -> TIII
    i3 (x, y, z) = (x + 1, y, z)
    i5 :: TIII -> TIII
    i5 (x, y, z) = (x, y + 1, z)
    i7 (x, y, z) = (x, y, z + 1)

    try3 x y z = x `tryNext` y `tryNext` z

tryNext :: Maybe a -> Maybe a -> Maybe a
tryNext (Just x) _ = Just x
tryNext _ (Just y) = Just y
tryNext _ _ = Nothing

import Data.List

--  three-room, five-room, and seven-room apartments.
-- one window per room

main = interact $ concat . intersperse "\n" . map solve . drop 1 . map read . lines

solve :: Int -> String
solve x
  | x == 1 || x == 2 || x == 4 = "-1"
  | otherwise = case mod x 3 of
  0 -> show (div x 3) ++ " 0 0"
  1 -> show (div x 3 - 2) ++ " 0 1"
  2 -> show (div x 3 - 1) ++ " 1 0"


Emily's birthday is next week and Jack has decided to buy a present for her. He knows she loves books so he goes to the local bookshop, where there are n books on sale from one of m genres.In the bookshop, Jack decides to buy two books of different genres.Based on the genre of books on sale in the shop, find the number of options available to Jack for choosing two books of different genres for Emily. Options are considered different if they differ in at least one book.The books are given by indices of their genres. The genres are numbered from 1 to m.

The first line contains two positive integers n and m (2 ≤ n ≤ 2·105, 2 ≤ m ≤ 10) — the number of books in the bookstore and the number of genres. The second line contains a sequence a1, a2, ..., an, where ai (1 ≤ ai ≤ m) equals the genre of the i-th book. It is guaranteed that for each genre there is at least one book of that genre.

Print the only integer — the number of ways in which Jack can choose books. It is guaranteed that the answer doesn't exceed the value 2·109.

NoteThe answer to the first test sample equals 5 as Sasha can choose:  the first and second books,  the first and third books,  the first and fourth books,  the second and third books,  the third and fourth books.

import Data.List (groupBy, sort)

main = do
  getLine
  as <- (map read . words) `fmap` getLine :: IO [Integer]

  let
    bs = map (fromIntegral . length) . groupBy (==) $ sort as
    s = sum bs
    ss = map (s -) $ scanl1 (+) bs
    r = sum $ zipWith (*) ss bs

  print r

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)
import Data.Array

getInts :: IO [Int32]
getInts = map (read . dropWhile (==' ') . takeWhile (/=' ')) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    items <- (map (\x -> x - 1) . L.sort) <$> (getInts)
    let arr = accumArray (+) 0 (0, m - 1) [ (i, 1) | i <- items]
    let res = sum [ arr ! i * arr ! j | i <- [0 .. m - 2], j <- [i + 1 .. m - 1]]
    putStrLn $ show res

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)
import Data.Array

getInts :: IO [Int32]
getInts = map (read . T.unpack . T.strip . T.pack ) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    items <- (map (\x -> x - 1) . L.sort) <$> (getInts)
    let arr = accumArray (+) 0 (0, m - 1) [ (i, 1) | i <- items]
    let res = sum [ arr ! i * arr ! j | i <- [0 .. m - 2], j <- [i + 1 .. m - 1]]
    putStrLn $ show res

{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Applicative ((<$>), (<*>))
import Control.Monad (forM)
import qualified Data.Text as T
import qualified Data.List as L
import Data.Int (Int32)

getInts :: IO [Int32]
getInts = map (read . T.unpack . T.strip . T.pack ) . words <$> getLine

main :: IO ()
main = do
    [n, m] <- getInts
    --putStrLn $ show [n,m]
    items <- L.sort <$> (getInts)
    --putStrLn $ show items
    let (l', _) = foldr (\x (c : cs, pr) -> if x == pr then ((c + 1) : cs, x) else (1 : c : cs, x)) ([0], 0) items
    let l = init l'
    --putStrLn $ show l

    let res = sum [l !! i * l !! j | i <- [0 .. length l - 1], j <- [0 .. length l - 1], i /= j]
    putStrLn $ show (res `div` 2)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

pfoldl :: (a -> a -> a) -> (a -> a -> a) -> [a] -> a
pfoldl f g (x:xs)
    | length xs > 1  = f (foldl1 f (map (g x) xs)) (pfoldl f g xs)
    | length xs == 1 = g x (head xs)

countValues 0 _     = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = pfoldl (+) (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

-- pairwise folding:
-- f is used to fold the results generated by each application of g
-- g is applied to each pair of elements (non-replacing)
pfoldl1 :: (a -> a -> a) -> (a -> a -> a) -> [a] -> a
pfoldl1 _ g [x, y] = g x y
pfoldl1 f g (x:xs) = f (foldl1 f (map (g x) xs)) (pfoldl1 f g xs)

countValues 0 _     = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = pfoldl1 (+) (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

pairwise :: (a -> a -> b) -> [a] -> [b]
pairwise _ []     = []
pairwise _ [x]    = []
pairwise f (x:xs) = map (f x) xs ++ pairwise f xs

countValues 0 books = [0]
countValues m books = [length left] ++ countValues (m-1) right
    where (left, right) = span (== m) books

solve (n:m:books) = sum $ pairwise (*) values
    where values = countValues m $ sortBy (flip compare) books

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Char (digitToInt, intToDigit)
import Data.List (foldl')

import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM

parseInt :: ByteString -> Int
parseInt s
  | BS.head s == '-' = negate (go 0 (BS.tail s))
  | otherwise = go 0 s
  where
    go i s
      | BS.null s = i
      | otherwise = go (i*10 + digitToInt (BS.head s)) (BS.tail s)

printInt :: Int -> ByteString
printInt i
  | i < 10 = BS.singleton (intToDigit i)
  | otherwise = BS.snoc (printInt (i `quot` 10)) (intToDigit (i `rem` 10))

darnit :: ByteString -> ByteString
darnit s
  | BS.last s == '\r' = BS.init s
  | otherwise = s

main :: IO ()
main = do
  n:m:_ <- fmap (map (fromIntegral . parseInt) . BS.words) BS.getLine
  genres <- fmap (map (fromIntegral . parseInt) . BS.words) BS.getLine
  let counts = map snd . IM.toDescList $ foldl' (flip (IM.alter (Just . maybe 1 (+1)))) IM.empty genres
  --print counts
  let options = foldl' (\s c -> s + c * (n-c)) 0 counts :: Integer
  BS.putStrLn . printInt . fromIntegral $ options `quot` 2

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = do
    [n, m] <- map read.words <$> getLine :: IO [Int]
    xs <- U.unfoldrN n (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print $ solve n m xs

solve :: Int -> Int -> U.Vector Int -> Int
solve _ m xs = sum [freq U.! i * freq U.! j | i<-[1..m-1],j<-[i+1..m]]
  where
    freq = U.unsafeAccumulate (+) (U.replicate (m+1) 0) $ U.map (,1) xs

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

f n = quot (n * (n-1)) 2

dirty 0 books = 0
dirty m books = let (left, right) = span (== m) books in
                    f (length left) + dirty (m-1) right
solve (n:m:books) = (f n) - (dirty m $ sortBy (flip compare) books)

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)

import Data.List

strToIntegral :: (Read a, Integral a) => String -> a
strToIntegral = read

f :: Integral a => a -> a
f n = quot (n * (n-1)) 2

countInvalid 0 books = 0
countInvalid m books = let (left, right) = span (== m) books in
                    f (length left) + countInvalid (m-1) right
solve (n:m:books) = (f n) - (countInvalid m $ sortBy (flip compare) books)

main = do
    input <- getContents
    let inputValues = map strToIntegral (words input) in
        putStrLn $ show (solve inputValues)


You are given two arrays $$$a$$$ and $$$b$$$, both of length $$$n$$$.Let's define a function $$$f(l, r) = \sum\limits_{l \le i \le r} a_i \cdot b_i$$$.Your task is to reorder the elements (choose an arbitrary order of elements) of the array $$$b$$$ to minimize the value of $$$\sum\limits_{1 \le l \le r \le n} f(l, r)$$$. Since the answer can be very large, you have to print it modulo $$$998244353$$$. Note that you should minimize the answer but not its remainder.

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

Print one integer — the minimum possible value of $$$\sum\limits_{1 \le l \le r \le n} f(l, r)$$$ after rearranging elements of $$$b$$$, taken modulo $$$998244353$$$. Note that you should minimize the answer but not its remainder.

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

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

ru, ri :: C.ByteString -> Int

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

modulo = 998244353 :: Int
modulo64 = fromIntegral modulo :: Int64

add :: Int -> Int -> Int
add !x !y = let !z = x + y in if z >= modulo then z - modulo else z

mul :: Int -> Int -> Int
mul !x !y = fromIntegral $! (fromIntegral x * fromIntegral y) `mod` modulo64

toMod :: Int64 -> Int
toMod x
  | z >= 0 = z
  | otherwise = z + modulo
  where
    !z = fromIntegral $! (x `mod` modulo64)

solve :: [Int] -> Builder
solve (n:z) = intDec res <> char7 '\n'
  where
    (a, t) = splitAt n z
    b = sortOn Down $ take n t
    c :: [Int64]
    c = sort $ zipWith (\ !i !j -> (fromIntegral i) * (j * (succ $ fromIntegral n - j))) a [1 .. fromIntegral n]
    --c = sort $ zipWith (\ !i !j -> (fromIntegral i) * (shiftR ((j + 1) * (fromIntegral n - j)) 1)) a [1 .. fromIntegral n]
    !res = foldl' add 0 $ zipWith mul b $ map toMod c

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


As it's the first of April, Heidi is suspecting that the news she reads today are fake, and she does not want to look silly in front of all the contestants. She knows that a newspiece is fake if it contains heidi as a subsequence. Help Heidi assess whether the given piece is true, but please be discreet about it...

The first and only line of input contains a single nonempty string s of length at most 1000 composed of lowercase letters (a-z).

Output YES if the string s contains heidi as a subsequence and NO otherwise.

NoteA string s contains another string p as a subsequence if it is possible to delete some characters from s and obtain p.

[] `isSubseqOf` _ = True
_ `isSubseqOf` [] = False
x@(a:as) `isSubseqOf` y@(b:bs)
  | a == b = as `isSubseqOf` bs
  | otherwise = x `isSubseqOf` bs

main =  (\l -> putStrLn $ if "heidi" `isSubseqOf` l then "YES" else "NO") =<< getLine

[] `isSubseqOf` _ = True
_ `isSubseqOf` [] = False
x@(a:as) `isSubseqOf` (b:bs)
  | a == b = as `isSubseqOf` bs
  | otherwise = x `isSubseqOf` bs

main =  (\l -> putStrLn $ if "heidi" `isSubseqOf` l then "YES" else "NO") =<< getLine

import Data.Function

[fd,fe,fh,fi] = map (\x -> fix (\ f g as -> if null as then "NO" else if head as == x then g $ tail as else f g $ tail as)) "dehi"

main =getLine >>= \x -> putStrLn $ if x == "heidi" then "NO" else fh ( fe  (fi  (fd  (fi (const "YES"))))) x

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

process [] _ = True
process _ [] = False
process (x:xs) y | elem x y = process xs (dropWhile (/=x) y)
                 | otherwise = False

main = do
		n<-getLine
		putStrLn $ if process "heidi" n then "YES" else "NO"


Polycarp is a head of a circus troupe. There are $$$n$$$ — an even number — artists in the troupe. It is known whether the $$$i$$$-th artist can perform as a clown (if yes, then $$$c_i = 1$$$, otherwise $$$c_i = 0$$$), and whether they can perform as an acrobat (if yes, then $$$a_i = 1$$$, otherwise $$$a_i = 0$$$).Split the artists into two performances in such a way that:   each artist plays in exactly one performance,  the number of artists in the two performances is equal (i.e. equal to $$$\frac{n}{2}$$$),  the number of artists that can perform as clowns in the first performance is the same as the number of artists that can perform as acrobats in the second performance.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 5\,000$$$, $$$n$$$ is even) — the number of artists in the troupe. The second line contains $$$n$$$ digits $$$c_1 c_2 \ldots c_n$$$, the $$$i$$$-th of which is equal to $$$1$$$ if the $$$i$$$-th artist can perform as a clown, and $$$0$$$ otherwise. The third line contains $$$n$$$ digits $$$a_1 a_2 \ldots a_n$$$, the $$$i$$$-th of which is equal to $$$1$$$, if the $$$i$$$-th artist can perform as an acrobat, and $$$0$$$ otherwise.

Print $$$\frac{n}{2}$$$ distinct integers — the indices of the artists that should play in the first performance. If there are multiple answers, print any. If there is no solution, print a single integer $$$-1$$$.

NoteIn the first example, one of the possible divisions into two performances is as follows: in the first performance artists $$$1$$$ and $$$4$$$ should take part. Then the number of artists in the first performance who can perform as clowns is equal to $$$1$$$. And the number of artists in the second performance who can perform as acrobats is $$$1$$$ as well.In the second example, the division is not possible.In the third example, one of the possible divisions is as follows: in the first performance artists $$$3$$$ and $$$4$$$ should take part. Then in the first performance there are $$$2$$$ artists who can perform as clowns. And the number of artists in the second performance who can perform as acrobats is $$$2$$$ as well.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- (`shiftR` 1) . readInt <$> getLine
  xs <- zip <$> (map (=='1') <$> getLine) <*> (map (=='1') <$> getLine)
  let cnt = A.accumArray (+) 0 ((False,False),(True,True))
            $ map (,1) xs :: UArray (Bool,Bool) Int
      [!c00,!c01,!c10,!c11] = A.elems cnt
      minBnd = maximum [c01 + c11 - n, 0, (c11 - c10 + 1) `shiftR` 1]
      maxBnd = minimum [c00 + c01 + c11 - n, c11, (c01 + c11) `shiftR` 1]
      !p11 = maxBnd
      u = c01 + c11 - 2 * p11
      (!p10,!p01) | u <= c10 = (u,0)
                  | otherwise = (c10, u - c10)
      !p00 = n - c01 - c11 + p11
  if minBnd > maxBnd then print (-1) else
    putStrLn $ unwords $ map show $ go p00 p01 p10 p11 xs
  where
    go !p00 !p01 !p10 !p11 xs = runST $ do
      arr <- A.newListArray ((False,False),(True,True)) [p00,p01,p10,p11]
        :: ST s (STUArray s (Bool,Bool) Int)
      foldr (\(i,x) cont -> do
                ax <- A.readArray arr x
                if ax > 0
                  then do
                    A.writeArray arr x (ax - 1)
                    (i:) <$> cont
                  else cont)
        (return []) (zip [1..] xs)

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import System.IO
import GHC.Generics
import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import Data.Ratio
import qualified Data.Foldable as Foldable
import Data.Char
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8
import Data.List
import Data.Array.IArray
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.ST.Safe as SA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts = (map (fst . fromJust . BS8.readInt) . BS8.words) <$> BS.getLine :: IO [Int]
getDoubles = (map (read . BS8.unpack) . BS8.words) <$> BS.getLine :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

process :: [Char] -> [Char] -> Maybe [Int]
process first second = answer >>= Just . indiceList where
    clowns = zip first second
    f11 = (== ('1', '1'))
    f10 = (== ('1', '0'))
    f01 = (== ('0', '1'))
    f00 = (== ('0', '0'))
    fs = [f11, f10, f01, f00]
    ns@[n11, n10, n01, n00] = map (\f -> length $ filter f clowns) fs
    answer = case catMaybes (map (findAnswer ns) [ (x11, x10) | x11 <- [0..n11], x10 <- [0..n10] ]) of
        x:_ -> Just x
        [] -> Nothing
    indices = map (\f -> findIndices f clowns) fs
    indiceList ans = map (+ 1) $ concat $ zipWith take ans indices

findAnswer (n11:n10:n01:n00:[]) (x11, x10) = if valid then Just [x11, x10, x01, x00] else Nothing where
    n = n11 + n10 + n01 + n00
    nPerform = x11 + x10
    x01 = n01 - y01
    x00 = n00 - y00
    y11 = n11 - x11
    y10 = n10 - x10
    y01 = nPerform - y11
    y00 = (n `div` 2) - (y11 + y10 + y01)
    valid = all (>= 0) [x01, x00, y11, y10, y01, y00]

main = do
    n <- getInt
    first <- getLine
    second <- getLine
    putStrLn $ case process first second of
        Just ans -> intercalate " " . map show $ ans
        Nothing -> "-1"

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  n <- (`shiftR` 1) . readInt <$> getLine
  xs <- zip <$> (map (=='1') <$> getLine) <*> (map (=='1') <$> getLine)
  let cnt = A.accumArray (+) 0 ((False,False),(True,True))
            $ map (,1) xs :: UArray (Bool,Bool) Int
      [!c00,!c01,!c10,!c11] = A.elems cnt
      minBnd = maximum [c01 + c11 - n, 0, (c11 - c10 + 1) `shiftR` 1]
      maxBnd = minimum [c00 + c01 + c11 - n, c11, (c01 + c11) `shiftR` 1]
      !p11 = maxBnd
      u = c01 + c11 - 2 * p11
      (!p10,!p01) | u <= c10 = (u,0)
                  | otherwise = (c10, u - c10)
      !p00 = n - c01 - c11 + p11
  print (p00,p01,p10,p11)
  if minBnd > maxBnd then print (-1) else
    putStrLn $ unwords $ map show $ go p00 p01 p10 p11 xs
  where
    go !p00 !p01 !p10 !p11 xs = runST $ do
      arr <- A.newListArray ((False,False),(True,True)) [p00,p01,p10,p11]
        :: ST s (STUArray s (Bool,Bool) Int)
      foldr (\(i,x) cont -> do
                ax <- A.readArray arr x
                if ax > 0
                  then do
                    A.writeArray arr x (ax - 1)
                    (i:) <$> cont
                  else cont)
        (return []) (zip [1..] xs)

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')

rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N