There are $$$n$$$ students in the first grade of Nlogonia high school. The principal wishes to split the students into two classrooms (each student must be in exactly one of the classrooms). Two distinct students whose name starts with the same letter will be chatty if they are put in the same classroom (because they must have a lot in common). Let $$$x$$$ be the number of such pairs of students in a split. Pairs $$$(a, b)$$$ and $$$(b, a)$$$ are the same and counted only once.For example, if there are $$$6$$$ students: "olivia", "jacob", "tanya", "jack", "oliver" and "jessica", then:  splitting into two classrooms ("jack", "jacob", "jessica", "tanya") and ("olivia", "oliver") will give $$$x=4$$$ ($$$3$$$ chatting pairs in the first classroom, $$$1$$$ chatting pair in the second classroom),  splitting into two classrooms ("jack", "tanya", "olivia") and ("jessica", "oliver", "jacob") will give $$$x=1$$$ ($$$0$$$ chatting pairs in the first classroom, $$$1$$$ chatting pair in the second classroom). You are given the list of the $$$n$$$ names. What is the minimum $$$x$$$ we can obtain by splitting the students into classrooms?Note that it is valid to place all of the students in one of the classrooms, leaving the other one empty.

The first line contains a single integer $$$n$$$ ($$$1\leq n \leq 100$$$) — the number of students. After this $$$n$$$ lines follow. The $$$i$$$-th line contains the name of the $$$i$$$-th student. It is guaranteed each name is a string of lowercase English letters of length at most $$$20$$$. Note that multiple students may share the same name.

The output must consist of a single integer $$$x$$$ — the minimum possible number of chatty pairs.

7
kambei
gorobei
shichiroji
kyuzo
heihachi
katsushiro
kikuchiyo

NoteIn the first sample the minimum number of pairs is $$$1$$$. This can be achieved, for example, by putting everyone except jose in one classroom, and jose in the other, so jorge and jerry form the only chatty pair.In the second sample the minimum number of pairs is $$$2$$$. This can be achieved, for example, by putting kambei, gorobei, shichiroji and kyuzo in one room and putting heihachi, katsushiro and kikuchiyo in the other room. In this case the two pairs are kambei and kyuzo, and katsushiro and kikuchiyo.In the third sample the minimum number of pairs is $$$4$$$. This can be achieved by placing three of the students named mike in one classroom and the other two students in another classroom. Thus there will be three chatty pairs in one classroom and one chatty pair in the other classroom.

import Data.List

main = interact $ show . sum . map (sum . map (\x -> x * (x - 1) `div` 2) . (\x -> [x `div` 2, (x + 1) `div` 2]) . length) . group . sort . map head . tail . lines

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readNInts = readInt >>= flip replicateM readInt

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

main = do
	n <- readInt
	ls <- map length . group . sort . map head <$> replicateM n getLine
	print $ solve ls

solve [] = 0
solve (l:ls) = f l1 + f l2 + solve ls
	where
		l1 = l `div` 2
		l2 = l - l1
		f x = x * ( x - 1 ) `div` 2

import Data.List
import Data.Function
import Data.Bifunctor

fac n = snd $ until ((<2). fst) (\(x,y) -> (x-1,y*x)) (toInteger n,1 :: Integer)
comb2 n = if n < 2 then 0 else (fac n ) `div` (fac $ n-2) `div` 2
clip n = if n < 0 then 0 else n
solve =  uncurry (+) .
         foldr (\(a,b) (x,y) -> (a+x,b+y)) (0,0) .
         map ((\x -> let y = x`div`2 in bimap comb2 comb2 (y, clip $ x-y)) . length) .
         groupBy ((==) `on` (!!0)) .
         sort
main = print =<< solve . tail . lines <$> getContents

import Data.List

main = getContents >>= print . solve . tail . words

solve = sum . map ((\n -> let x = n `div` 2 in c x 2 + c (n - x) 2) . length) . group . sort . map head
    where c n 2 = n * (n - 1) `div` 2

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

half :: Int -> [Int]
half n = [a, n - a] where a = div n 2

handshakes :: Int -> Int
handshakes n = div (n * (n - 1)) 2

solve :: [String] -> Int
solve = sum
      . map handshakes
      . concat
      . map half
      . map length
      . group
      . sort
      . map head

main :: IO ()
main = do
    n <- readInt
    names <- replicateM n getLine
    print $ solve names

import Data.List
import Data.Function
main = interact $ show . solve . sort . tail . lines
solve = sum . map (f . length) . groupBy ((==) `on` head)
f n = ps h + ps h' where h = n `div` 2; h' = h + n `mod` 2
ps n = n * (n-1) `div` 2

import Data.List
main=interact$show.sum.map((`div`4).(^2).(+(-1)).length).group.sort.map head.tail.lines

import Data.List
import Data.Function
import Data.Bifunctor

fac n = snd $ until ((<2). fst) (\(x,y) -> (x-1,y*x)) (n,1)
comb2 n = if n < 2 then 0 else (fac n ) `div` (fac $ n-2) `div` 2
solve = uncurry (+)
        . foldr (\(a,b) (x,y) -> (a+x,b+y)) (0,0)
        . map ((\x -> let y = x`div`2 in bimap comb2 comb2 (y,x-y)) . length)
        . groupBy ((==) `on` (!!0))
        . sort
main = print =<< solve . tail . lines <$> getContents


Drazil has many friends. Some of them are happy and some of them are unhappy. Drazil wants to make all his friends become happy. So he invented the following plan.There are n boys and m girls among his friends. Let's number them from 0 to n - 1 and 0 to m - 1 separately. In i-th day, Drazil invites -th boy and -th girl to have dinner together (as Drazil is programmer, i starts from 0). If one of those two people is happy, the other one will also become happy. Otherwise, those two people remain in their states. Once a person becomes happy (or if he/she was happy originally), he stays happy forever.Drazil wants to know whether he can use this plan to make all his friends become happy at some moment.

The first line contains two integer n and m (1 ≤ n, m ≤ 100). The second line contains integer b (0 ≤ b ≤ n), denoting the number of happy boys among friends of Drazil, and then follow b distinct integers x1, x2, ..., xb (0 ≤ xi < n), denoting the list of indices of happy boys. The third line conatins integer g (0 ≤ g ≤ m), denoting the number of happy girls among friends of Drazil, and then follow g distinct integers y1, y2, ... , yg (0 ≤ yj < m), denoting the list of indices of happy girls. It is guaranteed that there is at least one person that is unhappy among his friends.

If Drazil can make all his friends become happy by this plan, print "Yes". Otherwise, print "No".

NoteBy  we define the remainder of integer division of i by k.In first sample case:   On the 0-th day, Drazil invites 0-th boy and 0-th girl. Because 0-th girl is happy at the beginning, 0-th boy become happy at this day.  On the 1-st day, Drazil invites 1-st boy and 1-st girl. They are both unhappy, so nothing changes at this day.  On the 2-nd day, Drazil invites 0-th boy and 2-nd girl. Because 0-th boy is already happy he makes 2-nd girl become happy at this day.  On the 3-rd day, Drazil invites 1-st boy and 0-th girl. 0-th girl is happy, so she makes 1-st boy happy.  On the 4-th day, Drazil invites 0-th boy and 1-st girl. 0-th boy is happy, so he makes the 1-st girl happy. So, all friends become happy at this moment.

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.Char
import Data.List
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
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, m] <- fmap (map read . words) getLine
  xs <- fmap (tail . map read . words) getLine
  ys <- fmap (tail . map read . words) getLine

  let
    check = runST $ do
      as <- newArray (0, n-1) False :: ST s (STUArray s Int Bool)
      mapM_ (\x -> writeArray as x True) xs

      bs <- newArray (0, m-1) False :: ST s (STUArray s Int Bool)
      mapM_ (\x -> writeArray bs x True) ys

      replicateM (n+m) $ do
        forM [0..n*m-1] $ \i -> do
          a <- readArray as (i `mod` n)
          b <- readArray bs (i `mod` m)

          when (not a && b) $ writeArray as (i `mod` n) True
          when (a && not b) $ writeArray bs (i `mod` m) True

      as' <- getElems as
      bs' <- getElems bs
      return $ and $ as' ++ bs'

  putStrLn $ if check then "Yes" else "No"

import Data.Functor
import Data.List

getInts :: IO [Int]
getInts = map read <$> words <$> getContents

main = getInts >>= putStrLn . (\b -> if b then "Yes" else "No") . solve

solve :: [Int] -> Bool
solve (n:m:as) = (==g) . length . nub $ map f xs ++ map f ys where
    xn:as2 = as
    yn:as3 = drop xn as2
    xs = take xn as2
    ys = take yn as3
    g = gcd n m
    f = (flip mod) g

module Main where
import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8  as C
import Data.List
import Data.Maybe

getIntList :: IO [Int]
getIntList = map fst . mapMaybe C.readInt . C.words <$> C.getLine

main :: IO ()
main = do
  n:m:_ <- getIntList
  b:bs <- getIntList
  g:gs <- getIntList
  putStrLn $ if sol n m bs gs then "Yes" else "No"

sol :: Int -> Int -> [Int] -> [Int] -> Bool
sol a b bs gs = d>0 && (d==1 || d==h)
  where
  d = gcd a b
  h = length $ nub $ map (flip mod d) (bs ++ gs)

import Data.List
import qualified Data.Set as Set
import Control.Applicative
import System.IO
import Debug.Trace

main = do
    [n, m] <- map read <$> words <$> getLine
    (_:boys)  <- map read <$> words <$> getLine
    (_:girls) <- map read <$> words <$> getLine

    let loop i boys girls
          | Set.size boys == n
            && Set.size girls == m  = Right ()
          | i > n * m = Left (boys, girls)
          | otherwise = do
            let ib = i `mod` n
                ig = i `mod` m
                hb = Set.member ib boys
                hg = Set.member ig girls

            let (boys', girls')
                  | hb  &&  hg       = (boys, girls)
                  | not hb && not hg = (boys, girls)
                  | hb  && not hg = (boys, Set.insert ig girls)
                  | not hb &&  hg = (Set.insert ib boys, girls)

            loop (i+1) boys' girls'

    let checkpoint boys girls =
          case loop 0 boys girls of
            Right _ -> True
            Left (boys', girls') -> do
              if boys == boys' && girls == girls'
                then False
                else checkpoint boys' girls'

    putStrLn $
      if checkpoint (Set.fromList boys) (Set.fromList girls)
        then "Yes"
        else "No"

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import qualified Data.Set as Set
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

makeStep :: Set.Set (Int, Int) -> ([Bool], [Bool]) -> ([Bool], [Bool])
makeStep goodPairs (boys, girls) =
    (boys', girls')
    where
        n = length boys
        m = length girls
        happyPairs = [(bi, gi) | (b, bi) <- zip boys [0..],
                                 (g, gi) <- zip girls [0..],
                                 (b || g) && (bi, gi) `Set.member` goodPairs]
        happyBoys = Set.fromList $ map fst happyPairs
        happyGirls = Set.fromList $ map snd happyPairs
        boys' = map (`Set.member` happyBoys) [0..n - 1]
        girls' = map (`Set.member` happyGirls) [0..m - 1]

main = do
    [n, m] <- readIntList
    happyBoys <- tail `liftM` readIntList
    happyGirls <- tail `liftM` readIntList
    let boys = map (`elem` happyBoys) [0..n - 1]
    let girls = map (`elem` happyGirls) [0..m - 1]
    let goodPairs = Set.fromList $ map (\d -> (d `mod` n, d `mod` m)) [0..n * m - 1]
    let (boys', girls') = foldr (.) id (replicate (n + m) (makeStep goodPairs))
            $ (boys, girls)
    let allHappy = not (False `elem` (boys' ++ girls'))
    let ans = if allHappy then "Yes" else "No"
    putStrLn $ ans

import Data.List
import qualified Data.Set as Set
import Control.Applicative
import System.IO

main = do
    [n, m] <- map read <$> words <$> getLine
    (_:boys)  <- map read <$> words <$> getLine
    (_:girls) <- map read <$> words <$> getLine

    let loop i boys girls
          | Set.size boys == n
            && Set.size girls == m  = True
          | i > n * m = False
          | otherwise = do
            let ib = i `mod` n
                ig = i `mod` m
                hb = Set.member ib boys
                hg = Set.member ig girls

            let (boys', girls')
                  | hb  &&  hg       = (boys, girls)
                  | not hb && not hg = (boys, girls)
                  | hb  && not hg = (boys, Set.insert ig girls)
                  | not hb &&  hg = (Set.insert ib boys, girls)

            loop (i+1) boys' girls'

    putStrLn $
      if loop 0 (Set.fromList boys) (Set.fromList girls)
        then "Yes"
        else "No"


There are $$$n$$$ dormitories in Berland State University, they are numbered with integers from $$$1$$$ to $$$n$$$. Each dormitory consists of rooms, there are $$$a_i$$$ rooms in $$$i$$$-th dormitory. The rooms in $$$i$$$-th dormitory are numbered from $$$1$$$ to $$$a_i$$$.A postman delivers letters. Sometimes there is no specific dormitory and room number in it on an envelope. Instead of it only a room number among all rooms of all $$$n$$$ dormitories is written on an envelope. In this case, assume that all the rooms are numbered from $$$1$$$ to $$$a_1 + a_2 + \dots + a_n$$$ and the rooms of the first dormitory go first, the rooms of the second dormitory go after them and so on.For example, in case $$$n=2$$$, $$$a_1=3$$$ and $$$a_2=5$$$ an envelope can have any integer from $$$1$$$ to $$$8$$$ written on it. If the number $$$7$$$ is written on an envelope, it means that the letter should be delivered to the room number $$$4$$$ of the second dormitory.For each of $$$m$$$ letters by the room number among all $$$n$$$ dormitories, determine the particular dormitory and the room number in a dormitory where this letter should be delivered.

The first line contains two integers $$$n$$$ and $$$m$$$ $$$(1 \le n, m \le 2 \cdot 10^{5})$$$ — the number of dormitories and the number of letters. The second line contains a sequence $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 10^{10})$$$, where $$$a_i$$$ equals to the number of rooms in the $$$i$$$-th dormitory. The third line contains a sequence $$$b_1, b_2, \dots, b_m$$$ $$$(1 \le b_j \le a_1 + a_2 + \dots + a_n)$$$, where $$$b_j$$$ equals to the room number (among all rooms of all dormitories) for the $$$j$$$-th letter. All $$$b_j$$$ are given in increasing order.

Print $$$m$$$ lines. For each letter print two integers $$$f$$$ and $$$k$$$ — the dormitory number $$$f$$$ $$$(1 \le f \le n)$$$ and the room number $$$k$$$ in this dormitory $$$(1 \le k \le a_f)$$$ to deliver the letter.

NoteIn the first example letters should be delivered in the following order:  the first letter in room $$$1$$$ of the first dormitory  the second letter in room $$$9$$$ of the first dormitory  the third letter in room $$$2$$$ of the second dormitory  the fourth letter in room $$$13$$$ of the second dormitory  the fifth letter in room $$$1$$$ of the third dormitory  the sixth letter in room $$$12$$$ of the third dormitory

import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.Map as M
import Data.List

main = do
  inp <- fmap B.lines B.getContents
  let as = map readI $ B.words $ inp!!1
  let bs = map readI $ B.words $ inp!!2
  putStrLn $ unlines $ map (\(i,j)->show i++" "++show j) $ solve as bs

readI :: B.ByteString -> Integer
readI s = case B.readInteger s of Just (n,_) -> n

solve :: [Integer] -> [Integer] -> [(Integer,Integer)]
solve as bs =
  map f bs
  where
    m = M.fromList $ zip (scanl (+) 0 as) [0..]

    f x = case M.lookupLT x m of
            Nothing -> error "error"
            Just (k,v)  -> (v+1,x-k)

import Control.Applicative ((<$>))
import Data.Int (Int64)
import Control.Monad (forM_)
import Data.List (intercalate)

main = do
  [n, m] <- map read . words <$> getLine :: IO [Int]
  a <- map read . words <$> getLine :: IO [Int64]
  b <- map read . words <$> getLine :: IO [Int64]
  forM_ (solve a b 1 0) $ \(x, y) -> do
    putStrLn $ intercalate " " $ map show [x, y]

solve :: [Int64] -> [Int64] -> Int64 -> Int64 -> [(Int64, Int64)]
solve _ [] _ _ = []
solve (a:as) (b:bs) n s
  | b <= s + a = (n, b - s) : solve (a:as) bs n s
  | otherwise  = solve as (b:bs) (n + 1) (s + a)


Polycarpus likes studying at school a lot and he is always diligent about his homework. Polycarpus has never had any problems with natural sciences as his great-great-grandfather was the great physicist Seinstein. On the other hand though, Polycarpus has never had an easy time with history.Everybody knows that the World history encompasses exactly n events: the i-th event had continued from the year ai to the year bi inclusive (ai < bi). Polycarpus easily learned the dates when each of n events started and ended (Polycarpus inherited excellent memory from his great-great-granddad). But the teacher gave him a more complicated task: Polycaprus should know when all events began and ended and he should also find out for each event whether it includes another event. Polycarpus' teacher thinks that an event j includes an event i if aj < ai and bi < bj. Your task is simpler: find the number of events that are included in some other event.

The first input line contains integer n (1 ≤ n ≤ 105) which represents the number of events. Next n lines contain descriptions of the historical events, one event per line. The i + 1 line contains two integers ai and bi (1 ≤ ai < bi ≤ 109) — the beginning and the end of the i-th event. No two events start or finish in the same year, that is, ai ≠ aj, ai ≠ bj, bi ≠ aj, bi ≠ bj for all i, j (where i ≠ j). Events are given in arbitrary order.

Print the only integer — the answer to the problem.

NoteIn the first example the fifth event is contained in the fourth. Similarly, the fourth event is contained in the third, the third — in the second and the second — in the first.In the second example all events except the first one are contained in the first.In the third example only one event, so the answer is 0.

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

readInt = fst . fromJust . C.readInt
readIntList = map readInt . C.words

listToTuple [a, b] = (a, b)

f (m, r) (_, b)
   | m > b     = (m, r+1)
   | otherwise = (b, r)

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n  = readInt $ head input
       ab = map (listToTuple . readIntList) (take n $ tail input)
   print . snd $ foldl' f (0, 0) (sort ab)

-- vim: set expandtab:

{-# LANGUAGE BangPatterns #-}

import Control.Monad (replicateM)
import Data.List (sort,foldl')
import Data.Ord (comparing)

import qualified Data.ByteString.Char8 as BS
import Data.ByteString (ByteString)
import Data.Char

readInt :: IO Int
readInt = do line <- BS.getLine
             let Just (n,_) = BS.readInt line
             return n

parseInts :: Int -> ByteString -> [Int]
parseInts k bs | k <= 0 = []
parseInts k bs = case BS.readInt (BS.dropWhile isSpace bs) of
                   Nothing -> []
                   Just (n,bs') -> n : parseInts (k-1) bs'

main = do
  n <- fmap read getLine
  pairs <- replicateM n $ do
             (a:b:_) <- fmap (parseInts 2) BS.getLine
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sort pairs

  let go :: (Int,Int) -> (Int,Int) -> (Int,Int)
      go (!c,m) (a,b) = case compare m b of
                              GT -> (c+1,m)
                              EQ -> (c,m)
                              LT -> (c,b)
  let (answer,_) = foldl' go (0,0) sorted
  print answer

module Main where
import Data.List as L
import Data.ByteString.Lazy as B
import Data.ByteString.Lazy.Char8 as C
main :: IO ()
main = do
    _ <- readLn :: IO Integer
    cs <- B.getContents
    let ls = C.lines cs
        lineToTup l =
            let ws = C.words l
                readDatInt = (\ (Just (i,_)) -> i) . C.readInt
                [a,b] = Prelude.map readDatInt ws
            in (a,b)
        events = Prelude.map lineToTup ls
        eventsbystart = L.sortBy (\(a,_) (b,_) -> compare a b) $ events
        (_,ans) = Prelude.foldl (\ (m,c) (_,b) -> (max m b, c + if b < m then 1 else 0)) (snd $ Prelude.head eventsbystart,0::Integer) (Prelude.tail eventsbystart)
        -- eventsbystartl = F.toList eventsbystart
    print ans

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

toPair [x, y] = (x, y)

main = do _:xs <- map (toPair . map (fst .fromJust . BS.readInt) . BS.words) . BS.lines <$> BS.getContents
          print $ solve xs

{-# OPTIONS_GHC -O2 #-}

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

import Control.Monad
import Control.Applicative

solve :: [(Int, Int)] -> Int
solve events = snd $ foldl' f (0, 0) es
  where es = map snd $ sort events
        f (right, ans) y | y < right = (right, ans + 1)
                         | otherwise = (y, ans)

main = BS.interact $ BS.pack . show . solve . map parseEvent . tail .  BS.lines
  where parseEvent line = let [x, y] = map BS.readInt $ BS.words line
                          in (fst $ fromJust x, fst $ fromJust y)

{-# LANGUAGE BangPatterns #-}
import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)
    parse x = let [a, b] = words x
                  !c = read a :: Int
                  !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)
import qualified Data.ByteString.Char8 as S

main :: IO ()
main = do
  _:xs <- map (\x -> let [a, b] = S.words x in (S.readInt a, S.readInt b)) . S.lines <$> S.getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

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

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

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

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

solve xs = length [undefined | (a, b) <- zip rights maxr, a < b]
  where
    rights = map snd (sort xs)
    maxr = scanl max 0 rights

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- (map parse) . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  _:xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Control.Applicative
import Data.List (foldl', sort)

main :: IO ()
main = do
  n <- getLine
  xs <- map parse . lines <$> getContents
  let (_,b):xs' = sort xs
  print $ fst $ foldl' f (0,b) $ map snd xs'
  where
    f (acc,prev) b
      | b < prev = (acc+1, prev)
      | otherwise = (acc, b)

parse :: String -> (Int, Int)
parse x = let [a, b] = words x
              !c = read a :: Int
              !d = read b :: Int
              in (c, d)

import Data.List(sort,foldl')
import Control.Applicative
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do n <- read <$> getLine
          xs <- map ((\ [x,y] -> (x,y)).map read'.B.words) <$> B.lines <$> B.getContents
          print $ solve n xs

read' s = let Just (n,s') = B.readInt s
          in n

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = snd $ foldl' f (y,0) ys
   where (y:ys) = map snd $ sort xs

f :: (Int,Int) -> Int -> (Int,Int)
f (m,i) n
  | m > n     = (m,succ i)
  | otherwise = (n,i)

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ solve 0 y ys
 where
  solve !acc _   []        = acc
  solve !acc x'  (x : xs)
    | x < x'          = solve (1 + acc) x' xs
    | otherwise       = solve acc       x  xs

{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
import Data.List
import Foreign
import Foreign.C

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_i  :: CString -> Ptr CInt -> IO CInt

foreign import ccall unsafe "stdio.h scanf"
 c_scanf_ii :: CString -> Ptr CInt -> Ptr CInt -> IO CInt

main :: IO ()
main = do
  alloca              $ \(a   :: Ptr CInt) -> do
  alloca              $ \(b   :: Ptr CInt) -> do
  withCString "%d"    $ \(i   :: CString)  -> do
  withCString "%d%d"  $ \(ii  :: CString)  -> do
    c_scanf_i i a
    n   <- peek a
    xs  <- replicateM (fromIntegral n) $ do
      c_scanf_ii ii a b
      (,) <$> peek a <*> peek b
    let y : ys = map snd $ sort xs
    print $ snd $ foldl f (y, 0) ys
 where
  f (!y, !acc) x
    | x < y          = (y, 1 + acc)
    | otherwise      = (x, acc)

import Control.Monad (replicateM)
import Data.List (sortBy)
import Data.Ord (comparing)
import Data.Array

contains :: (Int,Int) -> (Int,Int) -> Bool
contains (a,b) (c,d) = a < b && c < d

(-->) = flip fmap

main = do
  n <- getLine --> read
  pairs <- replicateM n $ do
             (a:b:_) <- getLine --> words --> map read
             return (a,b)
  let _ = pairs :: [(Int,Int)]
  let sorted = sortBy (comparing fst) pairs
  let arr = listArray (1,n) sorted
  -- count the number of pairs which are contained in some other (earlier) pair
  let isContained :: Int -> Bool
      isContained j =
        let cd = arr ! j in any (\i -> contains (arr ! i) cd) [1..j-1]
  let count = length $ filter isContained [2..n]
  print count

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd $ sort xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

import Control.Applicative
import Data.List

main :: IO ()
main = do
  _:(_,b):xs <- map (\x -> let [a, b] = words x in (read a :: Int, read b :: Int)) . lines <$> getContents
  print $ fst $ foldl' f (0,b) $ map snd xs
  where
    f (acc,prev) b
      | prev > b = (acc+1, prev)
      | otherwise = (acc, b)

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

main :: IO ()
main = do n <- read <$> getLine
          xs <- forM [1..n] (\_ -> (\ [x,y] -> (x, negate y)) <$> map read <$> words <$> getLine)
          print $ solve n xs

solve :: Int -> [(Int,Int)] -> Int
solve _ xs = length $ filter (<y) ys
   where (y:ys) = map (negate.snd.head) $ groupBy (\ (i,_) (j,_) -> i == j) $ sort xs


Let's denote the Manhattan distance between two points $$$p_1$$$ (with coordinates $$$(x_1, y_1)$$$) and $$$p_2$$$ (with coordinates $$$(x_2, y_2)$$$) as $$$d(p_1, p_2) = |x_1 - x_2| + |y_1 - y_2|$$$. For example, the distance between two points with coordinates $$$(1, 3)$$$ and $$$(4, 2)$$$ is $$$|1 - 4| + |3 - 2| = 4$$$.You are given two points, $$$A$$$ and $$$B$$$. The point $$$A$$$ has coordinates $$$(0, 0)$$$, the point $$$B$$$ has coordinates $$$(x, y)$$$.Your goal is to find a point $$$C$$$ such that:  both coordinates of $$$C$$$ are non-negative integers;  $$$d(A, C) = \dfrac{d(A, B)}{2}$$$ (without any rounding);  $$$d(B, C) = \dfrac{d(A, B)}{2}$$$ (without any rounding). Find any point $$$C$$$ that meets these constraints, or report that no such point exists.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 3000$$$) — the number of test cases. Each test case consists of one line containing two integers $$$x$$$ and $$$y$$$ ($$$0 \le x, y \le 50$$$) — the coordinates of the point $$$B$$$.

For each test case, print the answer on a separate line as follows:   if it is impossible to find a point $$$C$$$ meeting the constraints, print "-1 -1" (without quotes);  otherwise, print two non-negative integers not exceeding $$$10^6$$$ — the coordinates of point $$$C$$$ meeting the constraints. If there are multiple answers, print any of them. It can be shown that if any such point exists, it's possible to find a point with coordinates not exceeding $$$10^6$$$ that meets the constraints.

NoteExplanations for some of the test cases from the example:  In the first test case, the point $$$B$$$ has coordinates $$$(49, 3)$$$. If the point $$$C$$$ has coordinates $$$(23, 3)$$$, then the distance from $$$A$$$ to $$$B$$$ is $$$|49 - 0| + |3 - 0| = 52$$$, the distance from $$$A$$$ to $$$C$$$ is $$$|23 - 0| + |3 - 0| = 26$$$, and the distance from $$$B$$$ to $$$C$$$ is $$$|23 - 49| + |3 - 3| = 26$$$.  In the second test case, the point $$$B$$$ has coordinates $$$(2, 50)$$$. If the point $$$C$$$ has coordinates $$$(1, 25)$$$, then the distance from $$$A$$$ to $$$B$$$ is $$$|2 - 0| + |50 - 0| = 52$$$, the distance from $$$A$$$ to $$$C$$$ is $$$|1 - 0| + |25 - 0| = 26$$$, and the distance from $$$B$$$ to $$$C$$$ is $$$|1 - 2| + |25 - 50| = 26$$$.  In the third and the fourth test cases, it can be shown that no point with integer coordinates meets the constraints.  In the fifth test case, the point $$$B$$$ has coordinates $$$(42, 0)$$$. If the point $$$C$$$ has coordinates $$$(21, 0)$$$, then the distance from $$$A$$$ to $$$B$$$ is $$$|42 - 0| + |0 - 0| = 42$$$, the distance from $$$A$$$ to $$$C$$$ is $$$|21 - 0| + |0 - 0| = 21$$$, and the distance from $$$B$$$ to $$$C$$$ is $$$|21 - 42| + |0 - 0| = 21$$$.

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  if (x + y) `mod` 2 == 1
    then "-1 -1"
    else unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

{-# OPTIONS_GHC -O2 #-}

import qualified Data.ByteString.Char8 as DBC
import qualified Data.ByteString.Builder as DBB
import qualified Control.Monad as CM
import qualified Data.List as DL
import System.IO

solve :: IO ()
solve = do
  ~[x,y] <- readv
  if odd (x+y) then putStrLn ("-1 -1") else printv [x`div`2, (y+1)`div`2]

printv :: [Int] -> IO ()
printv xs = DBB.hPutBuilder stdout $ mconcat [DBB.intDec x <> DBB.char8 ' ' | x <- xs] <> DBB.char8 '\n'

readv :: IO [Int]
readv = map (maybe 0 fst . DBC.readInt) <$> (DBC.words <$> DBC.getLine)

main :: IO ()
main = do
  --hSetBuffering stdout NoBuffering
  ~[nTc] <- readv
  CM.replicateM_ nTc solve

f[x,y] =
 case (mod x 2, mod y 2) of
  (0, 0) -> [div x 2, div y 2]
  (0, 1) -> [-1, -1]
  (1, 0) -> [-1, -1]
  (1, 1) -> [div x 2, 1 + (div y 2)]

main=interact$unlines.map(unwords.map show.f.map read.words).tail.lines

main :: IO ()
main = interact processInput

processInput :: String -> String
processInput input = output
    where
        tests = drop 1 $ lines input
        answers = map processTest tests
        output = unlines answers

processTest :: String -> String
processTest input = output
    where
        [x, y] = map read $ words input
        output = case findPointC (x, y) of
            Just (cx, cy) -> unwords $ map show [cx, cy]
            Nothing -> "-1 -1"

findPointC :: (Integer, Integer) -> Maybe (Integer, Integer)
findPointC (x, y)
    | odd (abs(x) + abs(y)) = Nothing
    | otherwise = Just (x `div` 2, (y + 1) `div` 2)

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [floor $ fromIntegral x / 2, floor $ fromIntegral (y + 1) / 2]

import Control.Monad (replicateM)

main = do
  x <- getLine
  let nLines :: Int
      nLines = read x
  lines <- replicateM nLines getLine
  let res = map solve lines
  putStr $ unlines res

solve line = do
  let arr = [read x :: Int | x <- words line]
  let (x : y : _) = arr
  unwords $ map show [fromIntegral x / 2, fromIntegral y / 2]


Vasya trains to compose crossword puzzles. He can only compose crosswords of a very simplе type so far. All of them consist of exactly six words; the words can be read only from top to bottom vertically and from the left to the right horizontally. The words are arranged in the form of a rectangular "eight" or infinity sign, not necessarily symmetrical.The top-left corner of the crossword coincides with the top-left corner of the rectangle. The same thing is correct for the right-bottom corners. The crossword can't degrade, i.e. it always has exactly four blank areas, two of which are surrounded by letters. Look into the output for the samples for clarification.Help Vasya — compose a crossword of the described type using the given six words. It is allowed to use the words in any order.

Six lines contain the given words. Every word consists of no more than 30 and no less than 3 uppercase Latin letters.

If it is impossible to solve the problem, print Impossible. Otherwise, print the sought crossword. All the empty squares should be marked as dots. If there can be several solutions to that problem, print the lexicographically minimum one. I.e. the solution where the first line is less than the first line of other solutions should be printed. If the two lines are equal, compare the second lines and so on. The lexicographical comparison of lines is realized by the < operator in the modern programming languages.

PTC
JYNYFDSGI
ZGPPC
IXEJNDOP
JJFS
SSXXQOFGJUZ

BAA...
U.I...
R.R...
NEWTON
..A..O
..YARD

import Control.Monad
import Data.List
import Control.Arrow
import Data.Array

main :: IO ()
main = do
    xs <- replicateM 6 getLine
    --mapM_ print . filter valid . perms $ xs
    let sols = sortOn snd . filter (valid . fst) . map (id &&& crossword) . perms $ xs
    putStrLn $ if null sols then "Impossible" else snd . head $ sols

perms :: Eq a => [a] -> [[a]]
perms [] = [[]]
perms xs = [x:y | x <- xs, y<- perms (delete x xs)]

crossword :: [String] -> String
crossword [a,b,c,d,e,f] =
    unlines [[as!(i, j)|i<-[1..length e]]| j<-[1..length b]]
    where
        as :: Array (Int, Int) Char -- (x, y)
        as = accumArray (const id) '.' ((1,1), (length e, length b))
            $  zip [(i,1)|i<-[1..]] a
            ++ zip [(length a, i)|i<-[1..]] b
            ++ zip [(i,length b)|i<-[length a..]] c
            ++ zip [(length e,i)|i<-[length f..]] d
            ++ zip [(i,length f)|i<-[1..]] e
            ++ zip [(1,i)|i<-[1..]] f
crossword _ = ""

valid :: [String] -> Bool
valid [a, b, c, d, e, f] =
    last a == head b
    && last b == head c
    && last c == last d
    && last e == head d
    && last f == head e
    && head a == head f
    && length e == length a + length c - 1
    && length b == length d + length f - 1
    && b !! (length f - 1) == e !! (length a - 1)
valid _ = False

import Data.List

main = interact (unlines.s.take 6.lines)
s ls = if null cr then ["Impossible"] else minimum cr where
    cr = filter (/=[]) $ map cross $ permutations (zip ls (map length ls))

cross hls =
    if (l!!0+l!!2-1)==(l!!1) && (l!!3+l!!5-1)==(l!!4) &&
       head (h!!0)==head (h!!3) && last (h!!0)==head (h!!4) &&
       head (h!!1)==last (h!!3) && ((h!!1)!!(l!!0-1))==((h!!4)!!(l!!3-1)) && last (h!!1)==head (h!!5) &&
       head (h!!2)==last (h!!4) && last (h!!2)==last (h!!5)
    then make (h, l)
    else []
    where
        h = map fst hls
        l = map snd hls

make (h, l) = (map (++rm) ((h!!0):v1)) ++ [h!!1] ++ (map (lm++) (v2++[h!!2]))
    where
        v1 = zipWith (\a b -> (a:ls)++[b]) ((init.tail)(h!!3)) ((take (l!!3-2).tail)(h!!4))
        v2 = zipWith (\a b -> (a:rs)++[b]) ((init.drop (l!!3))(h!!4)) ((init.tail)(h!!5))
        rm = replicate ((l!!2)-1) '.'
        rs = tail rm
        lm = replicate ((l!!0)-1) '.'
        ls = tail lm

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (init . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible\n"
       else unlines (head  crosswords) ++ "\n"

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'

import Data.List
import GHC.Exts

main = interact solve

solve str =
    let wd = lines str
        crosswords = sort [makeCrossword p | p <- permutations wd, good p]
    in if null crosswords
       then "Impossible"
       else unlines . head $ crosswords

good p = head (p!!0) == head (p!!1) &&
         last (p!!0) == head (p!!2) &&
         last (p!!1) == head (p!!3) &&
         last (p!!3) == head (p!!4) &&
         last (p!!2) == head (p!!5) &&
         last (p!!5) == last (p!!4) &&
         l!!1 > 2 && l!!0 > 2 && l!!4 > 2 && l!!5 > 2 &&
         l!!3 == l!!0 + l!!5 - 1 &&
         l!!2 == l!!1 + l!!4 - 1 &&
         p!!3!!(l!!0 - 1) == p!!2!!(l!!1 - 1)
      where
         l = map length p

makeCrossword p = (p!!0 ++ right):
        map first (zip (init . tail $ p!!1) (init . tail $ p!!2)) ++
        [p!!3] ++
        map second (zip (tail . drop (length (p!!1)) $ p!!2) (init . tail $ p!!4)) ++
        [left ++ p!!5]
    where first (a, b) = a:tail left ++ b:right
          second (a, b) = left ++ a:tail right ++ [b]
          right = replicate ( length (p!!5) - 1 ) '.'
          left = replicate ( length (p!!0) - 1 ) '.'


In the probability theory the following paradox called Benford's law is known: "In many lists of random numbers taken from real sources, numbers starting with digit 1 occur much more often than numbers starting with any other digit" (that's the simplest form of the law).Having read about it on Codeforces, the Hedgehog got intrigued by the statement and wishes to thoroughly explore it. He finds the following similar problem interesting in particular: there are N random variables, the i-th of which can take any integer value from some segment [Li;Ri] (all numbers from this segment are equiprobable). It means that the value of the i-th quantity can be equal to any integer number from a given interval [Li;Ri] with probability 1 / (Ri - Li + 1).The Hedgehog wants to know the probability of the event that the first digits of at least K% of those values will be equal to one. In other words, let us consider some set of fixed values of these random variables and leave only the first digit (the MSD — most significant digit) of each value. Then let's count how many times the digit 1 is encountered and if it is encountered in at least K per cent of those N values, than such set of values will be called a good one. You have to find the probability that a set of values of the given random variables will be a good one.

The first line contains number N which is the number of random variables (1 ≤ N ≤ 1000). Then follow N lines containing pairs of numbers Li, Ri, each of whom is a description of a random variable. It is guaranteed that 1 ≤ Li ≤ Ri ≤ 1018. The last line contains an integer K (0 ≤ K ≤ 100). All the numbers in the input file are integers. Please, do not use %lld specificator to read or write 64-bit integers in C++. It is preffered to use cin (also you may use %I64d).

Print the required probability. Print the fractional number with such a precision that the relative or absolute error of the result won't exceed 10 - 9.

import Control.Monad

getA = fmap (map read . words) getLine

cnt n = let (m:t) = reverse $ takeWhile (<=n) $ iterate (*10) 1 in sum t + min m (n - m)

gao [] = [1.0]
gao ([l,r]:t) = zipWith (\i j -> p * i + (1 - p) * j) (0:a) (a++[0]) where
	u = r + 1
	p = fromInteger (cnt u - cnt l) / fromInteger (u - l)
	a = gao t

main = do
	[n] <- getA
	a <- replicateM (fromInteger n) getA
	[k] <- getA
	putStrLn $ show $ sum $ drop (fromInteger $ div (n * k + 99) 100) $ gao a

import Data.Array
import Control.Applicative
import Control.Monad

-- import Control.DeepSeq

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 10^18)
--   u <- choose (l, 10^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 1000)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  arrOld `seq`
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ ind `seq` prob `seq` (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  -- verboseCheck test1
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- import Debug.Trace

-- debug = flip trace

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

-- testnBWO2 :: Gen Prop
-- testnBWO2 = do
--   l <- choose (1, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print l) $ nBWO l l == fi (nBWO' [l])

-- testnBWO3 :: Gen Prop
-- testnBWO3 = do
--   l <- choose (1, 10)
--   u <- choose (l, 10)
--   let nBWO' = length . filter beginWithOne
--   whenFail (print (l, u)) $ nBWO l u == fi (nBWO' [l..u])

-- testLeast :: Gen Bool
-- testLeast = do
--   n <- choose (1, 100) :: Gen Int
--   p <- choose (1, 100) :: Gen Int
--   return $ ceiling (fi n * fi p / 100.0) == ceiling (fi n * fi p / 100.0 - eps)

-- test1 :: Gen Bool
-- test1 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [1,1]
--   return $ prob n input p == 1

-- test0 :: Gen Bool
-- test0 = do
--   n <- choose (1, 100)
--   p <- choose (1, 100) :: Gen Int
--   let input = replicate n [2,2]
--   return $ prob n input p == 0

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO 1 u
  | u < 10 = 1
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 10 ^ li
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li..ui - 1])
  in  middl `seq` tailP - headM + middl
      -- `debug` (show l ++ " " ++ show u ++ " " ++ show headM ++ " " ++ show middl ++ " " ++ show tailP)

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

prob n lines p =
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
  in prob

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  print (prob n lines p)

import Data.Array.IArray
import Text.Printf

intersect :: (Integer, Integer) -> (Integer, Integer) -> Integer
intersect (a, b) (c, d) = max 0 ans
	where ans = min b d - max a c

ones :: [(Integer, Integer)]
ones = [(10^x, 2*10^x) | x <- [0..19]]

prob1 :: (Integer, Integer) -> Double
prob1 (a,b) = count1 / total
    where count1 = fromIntegral $ sum $ map (intersect (a, b+1)) ones
          total  = fromIntegral (b - a + 1)

dp :: Array Int Double -> Int -> Double
dp probs k = f' n k
    where
        n = length $ indices probs

        arr :: Array (Int,Int) Double
        arr = listArray ((0, 0), (n, k)) $
               [f n' k' | n' <- [0..n], k' <- [0..k]]
        f' = curry (arr !)

        f :: Int -> Int -> Double
        f n' k'
         | n' == 0 && k' == 0   = 1
         | n' == 0              = 0
         | otherwise =
               p1     * f' (n'-1) (max (k'-1) 0) +
               (1-p1) * f' (n'-1) k'

               where p1 = probs ! n'

readInterval :: Int -> IO [(Integer, Integer)]
readInterval 0 = return $ []
readInterval l = do
    [a, b] <- (map read . words) `fmap` getLine
    ret <- readInterval (l-1)
    return $ (a,b) : ret

main = do
    n <- read `fmap` getLine
    intervals <- readInterval n
    k <- read `fmap` getLine
    let k' = ceiling $ fromIntegral n * k / 100

    let probs = listArray (1,n) [prob1 x | x <- intervals]

    let ans = dp probs k'

    printf "%.12f\n" ans

import Data.Array
import Control.Applicative
import Control.Monad

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob

import Data.Array
import Control.Applicative
import Control.Monad

-- import Test.QuickCheck

-- testnBWO :: Gen Bool
-- testnBWO = do
--   l <- choose (1, 1^18)
--   u <- choose (l, 1^18)
--   let nBWO' = length . filter beginWithOne
--   return $ nBWO l u == fi (nBWO' [l..u])

eps = 1e-10

beginWithOne :: Integer -> Bool
beginWithOne n = head (show n) == '1'

sepD :: Double -> (Integer, Double)
sepD d = (floor d', d' - fromIntegral (floor d'))
  where d' = d + eps

fi :: (Num b, Integral a) => a -> b
fi = fromIntegral

nBWO :: Integer -> Integer -> Integer
nBWO l u =
  let (li, lf) = sepD $ logBase 10 (fi l)
      (ui, uf) = sepD $ logBase 10 (fi u)
      headM = if beginWithOne l then l - 10 ^ li else 0
      tailP = if beginWithOne u then u - 10 ^ ui + 1 else 10 ^ ui
      middl = (sum $ map (10^) [li + 1..ui - 1])
  in  middl `seq` tailP - headM + middl

prob1 l u =
  fi (nBWO l u) / (fi u - fi l + 1)

prob0 l u =
  1 - prob1 l u

go arrOld [l, u] =
  array (0, 1000) $
  [ (0, prob0 l u * arrOld ! 0)] ++
  [ (ind, prob)
  | ind <- [1..1000],
    let prob = prob1 l u * (arrOld ! (ind - 1)) + prob0 l u * (arrOld ! ind)
  ]

arrInit :: Array Int Double
arrInit = listArray (0, 1000) (1:repeat 0)

getInt :: IO Int
getInt = read <$> getLine

getInts :: IO [Integer]
getInts = map read . words <$> getLine

main = do
  n <- getInt
  lines <- replicateM n $ getInts
  p <- getInt
  let least = ceiling (fi n * fi p / 100.0 - eps)
      arr   = foldl go arrInit lines
      prob  = sum $ map (arr !) [least .. n]
      difference [n, m] = abs (n - m)
      full  = sum $ map difference lines
  print prob


William has an array of $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$. In one move he can swap two neighboring items. Two items $$$a_i$$$ and $$$a_j$$$ are considered neighboring if the condition $$$|i - j| = 1$$$ is satisfied.William wants you to calculate the minimal number of swaps he would need to perform to make it so that the array does not contain two neighboring items with the same parity.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ $$$(1 \le n \le 10^5)$$$ which is the total number of items in William's array. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 10^9)$$$ which are William's array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^5$$$.

For each test case output the minimal number of operations needed or $$$-1$$$ if it is impossible to get the array to a state when no neighboring numbers have the same parity.

NoteIn the first test case the following sequence of operations would satisfy the requirements:   swap(2, 3). Array after performing the operation: $$$[6, 1, 6]$$$ In the second test case the array initially does not contain two neighboring items of the same parity.In the third test case the following sequence of operations would satisfy the requirements:   swap(3, 4). Array after performing the operation: $$$[1, 1, 2, 1, 2, 2]$$$  swap(2, 3). Array after performing the operation: $$$[1, 2, 1, 1, 2, 2]$$$  swap(4, 5). Array after performing the operation: $$$[1, 2, 1, 2, 1, 2]$$$ In the fourth test case it is impossible to satisfy the requirements.In the fifth test case the following sequence of operations would satisfy the requirements:   swap(2, 3). Array after performing the operation: $$$[6, 3, 2, 4, 5, 1]$$$  swap(4, 5). Array after performing the operation: $$$[6, 3, 2, 5, 4, 1]$$$

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List
import Data.Int

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInt64s [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInt64s :: [Int64] -> SIO ()
putInt64s vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< int64Dec
  in  lift $ B.hPutBuilder stdout $ case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.int64Dec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust, fromMaybe, isJust)

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

type Input = [Int]
type Output = Int

input :: Scanner Input
input = numberOf int

output :: Output -> C.ByteString
output = showB

solve :: Input -> Output
solve xs
  | isJust a && isJust b = min (fromJust a) (fromJust b)
  | isJust a = fromJust a
  | otherwise = fromMaybe (-1) b
  where
    n = length xs
    ixs = [i | (v, i) <- zip xs [0..n], odd v]
    a = compute ixs [0, 2 .. n - 1]
    b = compute ixs [1, 3 .. n - 1]

compute ixs ts
  | length ixs /= length ts = Nothing
  | otherwise = Just . sum . map abs $ zipWith (-) ixs ts

count :: Eq a => a -> [a] -> Int
count v = length . filter (== v)

-------------------------- Template ------------------------------------------
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

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

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Functor.Identity
import Data.Semigroup

import Data.List

interleave :: [t] -> [t] -> [t]
interleave [] ys = ys
interleave (x:xs) ys = x : interleave ys xs

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [n] <- getInts 1
    a <- getInts n
    let
      eIxs = [i | (i, ai) <- zip [1..] a, even ai]
      oIxs = [i | (i, ai) <- zip [1..] a, odd ai]
      efst = interleave eIxs oIxs
      ofst = interleave oIxs eIxs
      opts = case  length eIxs - length oIxs  of
        -1 -> [ofst]
        0 -> [efst, ofst]
        1 -> [efst]
        _ -> []
      cost = foldl' (\x (i, tar) -> x + abs (i - tar)) 0
      ans = if  null opts
        then  0-1
        else  minimum [cost $ zip opt [1..] | opt <- opts] `div` 2
    putInts [ans]

type SP = StateT [P.ByteString]
type SIO = SP IO

liftPure :: Monad m => SP Identity t -> SP m t
liftPure = mapStateT (pure . runIdentity)

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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


Vladik had started reading a complicated book about algorithms containing n pages. To improve understanding of what is written, his friends advised him to read pages in some order given by permutation P = [p1, p2, ..., pn], where pi denotes the number of page that should be read i-th in turn.Sometimes Vladik’s mom sorted some subsegment of permutation P from position l to position r inclusive, because she loves the order. For every of such sorting Vladik knows number x — what index of page in permutation he should read. He is wondered if the page, which he will read after sorting, has changed. In other words, has px changed? After every sorting Vladik return permutation to initial state, so you can assume that each sorting is independent from each other.

First line contains two space-separated integers n, m (1 ≤ n, m ≤ 104) — length of permutation and number of times Vladik's mom sorted some subsegment of the book. Second line contains n space-separated integers p1, p2, ..., pn (1 ≤ pi ≤ n) — permutation P. Note that elements in permutation are distinct. Each of the next m lines contains three space-separated integers li, ri, xi (1 ≤ li ≤ xi ≤ ri ≤ n) — left and right borders of sorted subsegment in i-th sorting and position that is interesting to Vladik.

For each mom’s sorting on it’s own line print "Yes", if page which is interesting to Vladik hasn't changed, or "No" otherwise.

NoteExplanation of first test case:   [1, 2, 3, 4, 5] — permutation after sorting, 3-rd element hasn’t changed, so answer is "Yes".  [3, 4, 5, 2, 1] — permutation after sorting, 1-st element has changed, so answer is "No".  [5, 2, 3, 4, 1] — permutation after sorting, 3-rd element hasn’t changed, so answer is "Yes".  [5, 4, 3, 2, 1] — permutation after sorting, 4-th element hasn’t changed, so answer is "Yes".  [5, 1, 2, 3, 4] — permutation after sorting, 3-rd element has changed, so answer is "No".

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

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

solve n m ps (l, r, x) = (x - l) == (length $ filter (< (ps!x)) [ps!i | i <- [l..r]])

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs

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

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

solve :: Int -> Int -> [Int] -> IO ()
solve 0 _ _ = return ()
solve m n a = do
    [l, r, x] <- liftM (map readInt . B.words) B.getLine
    let sp = filter (< (a !! (x - 1))) (take (r - l + 1) $ drop (l - 1) a)
    putStrLn $ if length sp /= x - l then "No" else "Yes"
    solve (m - 1) n a

main :: IO ()
main = do
    [n, m] <- liftM (map readInt . B.words) B.getLine
    a <- liftM (map readInt . take n . B.words) B.getLine
    -- return ()
--     s <- B.getLine
--     p <- B.getLine
--     let [n, m] = map read (words s) :: [Int]
--     let a = map read (words p) :: [Int]
    solve m n a

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

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

main :: IO ()
main = do
  [n, m] <- liftM (map readInt . B.words) B.getLine
  p      <- liftM (map readInt . take n . B.words) B.getLine :: IO [Int]
  let process :: Int -> IO ()
      process 0 = return ()
      process m = do
        [l, r, x] <- liftM (map readInt . B.words) B.getLine
        let slice = filter (< p !! (x - 1)) $ (take (r - l + 1) . drop (l - 1)) p
        putStrLn $ if length slice == (x - l) then "Yes" else "No"
        process (m - 1)
  process m

{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Applicative
import Data.Array.Unboxed
import Data.List

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

solve n m ps (l, r, x)
  | odd (r - l + 1) = (==) <$> fst <*> snd $ foldl' (\(s, b) a -> case compare (ps!x) a of
      LT -> (s + 1, b)
      GT -> (s, b + 1)
      otherwise -> (s, b)) (0, 0) [ps!i | i <- [l..r]]
  | otherwise = False

main = do
  n:m:_ <- readInts <$> B.getLine
  ps :: UArray Int Int <- listArray (1, n) . readInts <$> B.getLine
  lrxs <- map (\(l:r:x:_) -> (l, r, x)) <$> replicateM m (readInts <$> B.getLine)
  putStrLn $ unlines . map (\lrx -> if solve n m ps lrx then "Yes" else "No") $ lrxs


Pak Chanek has $$$n$$$ two-dimensional slices of cheese. The $$$i$$$-th slice of cheese can be represented as a rectangle of dimensions $$$a_i \times b_i$$$. We want to arrange them on the two-dimensional plane such that:  Each edge of each cheese is parallel to either the x-axis or the y-axis.  The bottom edge of each cheese is a segment of the x-axis.  No two slices of cheese overlap, but their sides can touch.  They form one connected shape. Note that we can arrange them in any order (the leftmost slice of cheese is not necessarily the first slice of cheese). Also note that we can rotate each slice of cheese in any way as long as all conditions still hold.Find the minimum possible perimeter of the constructed shape.

Each test contains multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 2 \cdot 10^4$$$) — the number of test cases. The following lines contain the description of each test case. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the number of slices of cheese Pak Chanek has. The $$$i$$$-th of the next $$$n$$$ lines of each test case contains two integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \leq a_i,b_i \leq 10^9$$$) — the dimensions of the $$$i$$$-th slice of cheese. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a line containing an integer representing the minimum possible perimeter of the constructed shape.

NoteIn the first test case, a way of getting the minimum possible perimeter is to arrange the slices of cheese as follows.We can calculate that the perimeter of the constructed shape is $$$2+5+1+1+1+1+3+1+5+1+2+3=26$$$. It can be shown that we cannot get a smaller perimeter.Consider the following invalid arrangement.Even though the perimeter of the shape above is $$$24$$$, it does not satisfy all conditions of the problem. The bottom edge of the $$$1 \times 1$$$ slice of cheese is not a segment of the x-axis.In the second test case, a way of getting the minimum possible perimeter is to arrange the slices of cheese as follows.We can calculate that the perimeter of the constructed shape is $$$2+2+2+3+2+3+2+2+2+4=24$$$. It can be shown that we cannot get a smaller perimeter.

module Main where

import Control.Monad (replicateM_, replicateM)
import Data.Maybe (maybe, catMaybes)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

solve :: [(Int, Int)] -> Int
solve rs = 2 * (maximum (map (snd . rotate) rs) +
                sum (map (fst . rotate) rs))
  where rotate (x, y)
          | x <= y    = (x, y)
          | otherwise = (y, x)

readSlice :: IO (Maybe (Int, Int))
readSlice = do
  vs <- map readInt . B.words <$> B.getLine
  case vs of [x, y] -> pure (Just (x, y))
             _      -> pure Nothing

handleProblem :: IO ()
handleProblem = do
  numberSlices <- readInt <$> B.getLine
  slices <- catMaybes <$> replicateM numberSlices readSlice
  print $ solve slices

main :: IO ()
main = do
  numberProblems <- readInt <$> B.getLine
  replicateM_ numberProblems handleProblem

readInt :: B.ByteString -> Int
readInt v = maybe 0 fst $ B.readInt v

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve xs = 2 * (maxv + mins)
  where maxv = maximum $ map (\(a, b) -> max a b) xs
        mins = sum $ map (\(a, b) -> min a b) xs

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- forM [1..n] $ \_ -> do
      [a, b] <- getInts
      return (a, b)
    print $ solve xs


A binary string is a string that consists of characters $$$0$$$ and $$$1$$$.Let $$$\operatorname{MEX}$$$ of a binary string be the smallest digit among $$$0$$$, $$$1$$$, or $$$2$$$ that does not occur in the string. For example, $$$\operatorname{MEX}$$$ of $$$001011$$$ is $$$2$$$, because $$$0$$$ and $$$1$$$ occur in the string at least once, $$$\operatorname{MEX}$$$ of $$$1111$$$ is $$$0$$$, because $$$0$$$ and $$$2$$$ do not occur in the string and $$$0 < 2$$$.A binary string $$$s$$$ is given. You should cut it into any number of substrings such that each character is in exactly one substring. It is possible to cut the string into a single substring — the whole string.A string $$$a$$$ is a substring of a string $$$b$$$ if $$$a$$$ can be obtained from $$$b$$$ by deletion of several (possibly, zero or all) characters from the beginning and several (possibly, zero or all) characters from the end.What is the minimal sum of $$$\operatorname{MEX}$$$ of all substrings pieces can be?

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases. Description of the test cases follows. Each test case contains a single binary string $$$s$$$ ($$$1 \le |s| \le 10^5$$$). It's guaranteed that the sum of lengths of $$$s$$$ over all test cases does not exceed $$$10^5$$$.

For each test case print a single integer — the minimal sum of $$$\operatorname{MEX}$$$ of all substrings that it is possible to get by cutting $$$s$$$ optimally.

NoteIn the first test case the minimal sum is $$$\operatorname{MEX}(0) + \operatorname{MEX}(1) = 1 + 0 = 1$$$.In the second test case the minimal sum is $$$\operatorname{MEX}(1111) = 0$$$.In the third test case the minimal sum is $$$\operatorname{MEX}(01100) = 2$$$.

import Control.Monad
import Data.List

calc :: String -> Int
calc "10" = 1
calc "01" = 1
calc "0" = 1
calc "1" = 0
calc ('0':'0':xs) = calc ('0':xs)
calc ('1':xs) = calc xs
calc ('0':xs) =
  if elem '0' xs then 2
  else 1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    print $ calc line

import Control.Monad

solve :: IO ()
solve = do
    s <- getLine
    let s' = dropWhile (=='1') $ reverse $ dropWhile (=='1') s
        ans | '0' `elem` s' && '1' `elem` s' = 2
            | '0' `elem` s'                  = 1
            | otherwise                      = 0
    print ans

main :: IO ()
main = readLn >>= flip replicateM_ solve

import Control.Arrow ((>>>))
import Data.List (group)

main :: IO ()
main = interact $ words >>> drop 1 >>> map (solve >>> show) >>> unlines

solve :: String -> Int
solve = min 2 . length . filter (== '0') . map head . group

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.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
--import Data.List
--import Data.Array.Unboxed

mainFun :: SO
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[s] <- getNext 1
    let
      s1 = P.dropWhile (== '1') s
      (c, s2) = P.span (== '0') s1
      s3 = P.dropWhile (== '1') s2
    pure . putInts . pure $ if  P.null c
      then  0
      else  if  P.null s3
      then  1
      else  2

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

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

import Control.Monad
import Data.List

calc :: String -> Int
calc s =
  let cz = foldl (\x y -> if y=='0' then x+1 else x) 0 s
      l = length s
  in
    if cz==0 then 0
    else if cz==1 then 1
    else if cz==l then 1
    else 2

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    print $ calc line


Today Pari and Arya are playing a game called Remainders.Pari chooses two positive integer x and k, and tells Arya k but not x. Arya have to find the value . There are n ancient numbers c1, c2, ..., cn and Pari has to tell Arya  if Arya wants. Given k and the ancient values, tell us if Arya has a winning strategy independent of value of x or not. Formally, is it true that Arya can understand the value  for any positive integer x?Note, that  means the remainder of x after dividing it by y.

The first line of the input contains two integers n and k (1 ≤ n,  k ≤ 1 000 000) — the number of ancient integers and value k that is chosen by Pari. The second line contains n integers c1, c2, ..., cn (1 ≤ ci ≤ 1 000 000).

Print "Yes" (without quotes) if Arya has a winning strategy independent of value of x, or "No" (without quotes) otherwise.

NoteIn the first sample, Arya can understand  because 5 is one of the ancient numbers.In the second sample, Arya can't be sure what  is. For example 1 and 7 have the same remainders after dividing by 2 and 3, but they differ in remainders after dividing by 7.

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Data.Maybe

main = do
  [n, k] <- map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  cs <- map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  putStrLn $ if foldl (\x y-> lcm x (gcd k y) `mod` k) 1 cs == 0
             then "Yes" else "No"


Bike is interested in permutations. A permutation of length n is an integer sequence such that each integer from 0 to (n - 1) appears exactly once in it. For example, [0, 2, 1] is a permutation of length 3 while both [0, 2, 2] and [1, 2, 3] is not.A permutation triple of permutations of length n (a, b, c) is called a Lucky Permutation Triple if and only if . The sign ai denotes the i-th element of permutation a. The modular equality described above denotes that the remainders after dividing ai + bi by n and dividing ci by n are equal.Now, he has an integer n and wants to find a Lucky Permutation Triple. Could you please help him?

The first line contains a single integer n (1 ≤ n ≤ 105).

If no Lucky Permutation Triple of length n exists print -1. Otherwise, you need to print three lines. Each line contains n space-seperated integers. The first line must contain permutation a, the second line — permutation b, the third — permutation c. If there are multiple solutions, print any of them.

NoteIn Sample 1, the permutation triple ([1, 4, 3, 2, 0], [1, 0, 2, 4, 3], [2, 4, 0, 1, 3]) is Lucky Permutation Triple, as following holds:  ;  ;  ;  ;  . In Sample 2, you can easily notice that no lucky permutation triple exists.

{-#LANGUAGE OverloadedStrings#-}
module Main where

import Data.List

main :: IO ()
main = ( readLn :: IO Int ) >>= solve >>= putStrLn

solve :: Int -> IO String
solve n
    | even n = pure "-1"
    | otherwise =
        pure . intercalate "\n" $ fin
    where
        l1 = [0..n-1]
        l2 = map ( flip mod n . (*2) ) l1
        a = showL l1
        b = showL l2
        fin = [ a,a,b ]

showL :: [Int] -> String
showL = intercalate " " . map show

{-#LANGUAGE OverloadedStrings#-}
module Main where

import Data.List

main :: IO ()
main = ( readLn :: IO Int ) >>= solve >>= putStrLn

solve :: Int -> IO String
solve n
    | even n = pure "-1"
    | otherwise =
        pure . intercalate "\n" $ map showL l3
    where
        l :: [Int]
        l = [0..n-1]
        l3 = [ l, l,  map (flip mod n . (*2)) l ]

showL :: [Int] -> String
showL = intercalate " " . map show

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if n `mod` 2 /= 0
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

f n = [(x+x) `mod` n | x <- [0..n-1]]

main :: IO()
main = interact work

work :: String -> String
work input = unlines . map unwords . map (map show) . solve $ n
    where n = read input :: Int

solve :: Int -> [[Int]]
solve n = if n `mod` 2 == 0
          then [[-1]]
          else [a, a, [i * 2 `mod` n | i <- a]]
    where a = [0..n - 1]

main = interact (format . solve . read)
format Nothing         = "-1"
format (Just (as,bs,cs)) = unlines (map (unwords . (map show)) [as,bs,cs])
solve n | even n    = Nothing
        | otherwise = Just ([0..n-1],[0..n-1],[0,2..n-1]++[1,3..n-1])

{-# OPTIONS_GHC -O2 #-}
main = do
  n <- readLn
  if even n
     then print $ -1
     else do
       putStrLn . unwords $ map show [0..n-1]
       putStrLn . unwords $ map show [0..n-1]
       putStrLn . unwords $ map show [ (i+i)`rem`n | i<-[0..n-1]]

solve 1 = "0\n0\n0"
solve n
  | n `mod` 2 == 0 = "-1"
  | otherwise =
    let
      a = [0..n-1]
      b = [(2 * x) `mod` (n) | x <- a]
      f = unwords . map show
    in
      unlines [f a, f a, f b]

main = do
  n <- fmap read getLine
  putStrLn $ solve n

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if ff n
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) /= 0 && n > 2
  where
    a = filter (\x -> n `mod` x == 0 && odd x) [2..n-1]

f n = [(x+x) `mod` n | x <- [0..n-1]]

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if ff n || n <= 2
     then print $ -1
     else mapM_ (print) [[0..n-1], [0..n-1], f n]

ff n = any (\x -> n `mod` x == 0) [2..n-1]
f n = [(x+x) `mod` n | x <- [0..n-1]]

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if ff n && n > 2
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) == 0 || head(a)*head(a) == n
  where
    a = filter (\x -> n `mod` x == 0) [2..n-1]

f n = [(x+x) `mod` n | x <- [0..n-1]]

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if ff n || n <= 2
     then print $ -1
     else mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]

ff n = any (\x -> n `mod` x == 0) [2..n-1]
f n = [(x+x) `mod` n | x <- [0..n-1]]

import Data.List
import Data.Char
import Data.Maybe
import Data.Ord
import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as C
import Data.Array
import Data.Bits

main = do
  n <- readLn :: IO Int
  if ff n && n > 2
     then mapM_ (\x -> putStrLn $ unwords (map show x)) [[0..n-1], [0..n-1], f n]
     else print $ -1

ff n = length(a) /= 0
  where
    a = filter (\x -> n `mod` x == 0 && odd x) [2..n]

f n = [(x+x) `mod` n | x <- [0..n-1]]

solve 1 = "0"
solve n
  | n `mod` 2 == 0 = "-1"
  | otherwise =
    let
      a = [0..n-1]
      b = [(2 * x) `mod` (n) | x <- a]
      f = unwords . map show
    in
      unlines [f a, f a, f b]

main = do
  n <- fmap read getLine
  putStrLn $ solve n