You are given a multiset of n integers. You should select exactly k of them in a such way that the difference between any two of them is divisible by m, or tell that it is impossible.Numbers can be repeated in the original multiset and in the multiset of selected numbers, but number of occurrences of any number in multiset of selected numbers should not exceed the number of its occurrences in the original multiset.

First line contains three integers n, k and m (2 ≤ k ≤ n ≤ 100 000, 1 ≤ m ≤ 100 000) — number of integers in the multiset, number of integers you should select and the required divisor of any pair of selected integers. Second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 109) — the numbers in the multiset.

If it is not possible to select k numbers in the desired way, output «No» (without the quotes). Otherwise, in the first line of output print «Yes» (without the quotes). In the second line print k integers b1, b2, ..., bk — the selected numbers. If there are multiple possible solutions, print any of them.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.IntMap as M

main = B.interact (B.pack . evalState app . B.words)

app = do
  n <- poi
  maybe "No" (("Yes\n" ++ ) . unwords . map show) `fmap` liftM3 solve poi poi (replicateM n poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k m = msum . map (takeAtLeast k) . M.elems . M.fromListWith (++) . map (\x -> (x `rem` m, [x]))

takeAtLeast = go id
  where
  go xs k []
    | k > 0 = Nothing
    | otherwise = Just $ xs []
  go xs 0 _ = Just $ xs []
  go xs k (y:ys) = go (xs . (y:)) (k - 1) ys

-- 1 4 8
--  3 4
--

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
--import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = do
    n:k:m:_ <- readInts
    a <- readInts
    let  func = take k . fromMaybe [] . find (\l -> length l >= k)
         c = func . groupBy (on (==) (`mod` m)) . sortBy (on compare (`mod` m)) $ a
    if null c
    then putStr "No"
    else putStr $ "Yes\n" ++ textRepresentation c

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
--import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

main :: IO ()
main = do
    n:k:m:_ <- readInts
    a <- readInts
    let  func = take k . fromMaybe [] . find (\l -> length l >= k)
         c = func . groupBy (on (==) (`mod` m)) . sortBy (on compare (`mod` m)) $ a
    if null c
    then putStr "No"
    else putStr $ "Yes\n" ++ textRepresentation c

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.IntMap as M

main = B.interact (B.pack . evalState app . B.words)

app = do
  n <- poi
  maybe "NO" (("YES\n" ++ ) . unwords . map show) `fmap` liftM3 solve poi poi (replicateM n poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k m = msum . map (takeAtLeast k) . M.elems . M.fromListWith (++) . map (\x -> (x `rem` m, [x]))

takeAtLeast = go id
  where
  go xs k []
    | k > 0 = Nothing
    | otherwise = Just $ xs []
  go xs 0 _ = Just $ xs []
  go xs k (y:ys) = go (xs . (y:)) (k - 1) ys

-- 1 4 8
--  3 4
--

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.IntMap as M

main = B.putStr . B.pack . evalState app . B.words =<< B.getContents

app = do
  n <- poi
  maybe "NO" (("YES\n" ++ ) . unwords . map show) `fmap` liftM3 solve poi poi (replicateM n poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve k m = msum . map (takeAtLeast k) . M.elems . M.fromListWith (++) . map (\x -> (x `rem` m, [x]))

takeAtLeast = go id
  where
  go xs k []
    | k > 0 = Nothing
    | otherwise = Just $ xs []
  go xs 0 _ = Just $ xs []
  go xs k (y:ys) = go (xs . (y:)) (k - 1) ys

-- 1 4 8
--  3 4
--

import Prelude
import Data.List
import Data.Maybe

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

textRepresentation :: Show a => [a] -> String
textRepresentation row = foldl (\acc y -> acc ++ (show y) ++ " ") "" row

main :: IO ()
main = do
    (n:k:m:_) <- readInts
    a <- readInts
    let c = (take k . fromMaybe [] . find (\l -> length l >= k) . groupBy (\x y -> mod x m == mod y m) . sortBy (\x y -> compare(mod x m) (mod y m)) . map head . group . sort) a
    if null c
    then putStr "No"
    else putStr ("Yes\n" ++ textRepresentation c)

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
--import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl (\x y -> 10*x+ (digitToInt y)) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = (unwords . map show) row

main :: IO ()
main = do
    (n:k:m:_) <- readInts
    a <- readInts
    let  temp = (group . sort) a
         func = take k . fromMaybe [] . find (\l -> length l >= k)
         cc = func temp
         c = func . groupBy (on (==) (`mod` m)) . sortBy (on compare (`mod` m)) . map head $ temp
    if null c && null cc
    then putStr "No"
    else putStr ("Yes\n" ++ (textRepresentation (if null cc then c else cc)))


Genos needs your help. He was asked to solve the following programming problem by Saitama:The length of some string s is denoted |s|. The Hamming distance between two strings s and t of equal length is defined as , where si is the i-th character of s and ti is the i-th character of t. For example, the Hamming distance between string "0011" and string "0110" is |0 - 0| + |0 - 1| + |1 - 1| + |1 - 0| = 0 + 1 + 0 + 1 = 2.Given two binary strings a and b, find the sum of the Hamming distances between a and all contiguous substrings of b of length |a|.

The first line of the input contains binary string a (1 ≤ |a| ≤ 200 000). The second line of the input contains binary string b (|a| ≤ |b| ≤ 200 000). Both strings are guaranteed to consist of characters '0' and '1' only.

Print a single integer — the sum of Hamming distances between a and all contiguous substrings of b of length |a|.

NoteFor the first sample case, there are four contiguous substrings of b of length |a|: "00", "01", "11", and "11". The distance between "01" and "00" is |0 - 0| + |1 - 0| = 1. The distance between "01" and "01" is |0 - 0| + |1 - 1| = 0. The distance between "01" and "11" is |0 - 1| + |1 - 1| = 1. Last distance counts twice, as there are two occurrences of string "11". The sum of these edit distances is 1 + 0 + 1 + 1 = 3.The second sample case is described in the statement.

import Data.Ord
import Control.Applicative
import Data.List
import Data.Char
import Data.Array
import Debug.Trace
import Test.QuickCheck

solve :: String -> String -> Integer
solve a b =
  sum $ map (toInteger . contribution) $ [1..k]
  where
    k = length a
    delta = length b - length a
    convert x = listArray (1, length x) $ map digitToInt x
    a' = convert a
    b' = convert b
    numOnes = listArray (1, k) $ [f i | i <- [1..k]]
    numZeros i = delta + 1 - numOnes ! i
    f 1 = sum [b' ! i | i <- [1..delta+1]]
    f i = numOnes ! (i - 1) - b' ! (i - 1) + b' ! (i+delta)
    contribution i
      | a' ! i == 0 = numOnes ! i
      | otherwise = numZeros i

bruteHamming :: String -> String -> Int
bruteHamming a b =
  sum $ map hamming $ subs
  where
    subs = substrings (length a) b
    substrings n x =
      [take n (drop i x) | i <- [0..length x - n]]
    hamming :: String -> Int
    hamming b' = sum $ map fromEnum $ zipWith (/=) a b'

{-
runChecks :: IO ()
runChecks =
  let
    genVec = do
      let vals = vectorOf 2 $ listOf $ elements "01"
      sortBy (comparing length) <$> vals
    prop_hammings [a, b] =
      solve a b == bruteHamming a b
  in quickCheck $ forAll genVec prop_hammings
-}

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStrLn $ show $ solve a b

import Data.List
import Data.Array
import Data.Int

main = do
    interact solve

solve input = (show (do_solve as 0)) --  ++ " " ++ (intercalate "," (map show (elems dp_bs_1)))
    where
        as:bs:_ = words input
        as_length::Int64
        as_length = fromIntegral(length as)
        bs_length::Int64
        bs_length = fromIntegral(length bs)
        dp_bs_0 = listArray (0,bs_length) (0:(make_dp_sum bs '0' 0))
        dp_bs_1 = listArray (0,bs_length) (0:(make_dp_sum bs '1' 0))

        -- ca current element cid is the current index
        do_solve::[Char] -> Int64 -> Int64
        do_solve [] _ = 0
        do_solve (ca:cas) cid = cur_sum + (do_solve cas (cid+1) )
            where
                hi_idx = min (cid + (bs_length-as_length+1) ) bs_length
                lo_idx = cid
                cur_sum
                    | (ca == '1') = (dp_bs_0!hi_idx) - (dp_bs_0!lo_idx)
                    -- | (ca == '1') = 0
                    | (ca == '0') = (dp_bs_1!hi_idx) - (dp_bs_1!lo_idx)
                    -- | (ca == '0') = 0

as_string::(Show a) => [a] -> [String]
as_string arr = map show arr

make_dp_sum::(Eq a) => [a] -> a -> Int64 -> [Int64]
make_dp_sum [] item csum = []
make_dp_sum (x:xs) item csum
    | x == item = (csum+1):(make_dp_sum xs item (csum+1))
    | otherwise = csum:(make_dp_sum xs item csum)

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2016
-- http://mivael.in.ua

type HSumType = Integer  -- sum of hamming distances
type LenType = Integer  -- string length

main :: IO ()
main = do
  interact (show . solve . lines)

solve :: [String] -> HSumType
solve = solveStringPair
  where
    solveStringPair (a:b:[]) = solveStrAB a b
    solveStringPair _ = error "Pair of strings expected."
    solveStrAB a b =
      solvePreparsed lenA lenB psums bits
      where
        (lenA, psums) = revPSumA a (0,[0])
        (lenB, bits) = revB b (0,[])
    revPSumA = pa
    revB = pb
    pa [] result = result
    pa (ch:rest) (cnt, psums@(psum:_)) =
      pa rest (cnt + 1, psum + ch2int ch : psums)
    ch2int '0' = 0
    ch2int '1' = 1
    ch2int _ = error "ch2int: bad input"
    pb [] result = result
    pb (ch:rest) (cnt, bits) =
      pb rest (cnt + 1, ch2bool ch : bits)
    ch2bool '0' = False
    ch2bool '1' = True
    ch2bool _ = error "ch2bool: bad input"

solvePreparsed :: LenType -> LenType -> [LenType] -> [Bool] -> HSumType
solvePreparsed lenA lenB psums bits =
  f (0 :: HSumType) (1 :: LenType) (1 :: LenType) psums psums_prev bits
  where
    (_:psums_prev) = psums
    delta | (lenB >= lenA) = lenB - lenA
          | otherwise = error "Bad delta."
    f hsum cnt len c2 c1 (bit:bits) = g
      where
        g | cnt == lenB = newsum
          | cnt < lenB = f newsum (cnt + 1) newlen h2 h1 bits
          | otherwise = error "cnt is too large"
        (c1head:c1tail) = c1
        (c2head:c2tail) = c2
        ones = c2head - c1head
        zeros = len - ones
        s | bit == True = zeros
          | otherwise = ones
        newsum = hsum + s
        choose1 x y | cnt >= lenA = y | otherwise = x
        choose2 x y | cnt > delta = y | otherwise = x
        h1 = choose1 c1tail [0]
        h2 = choose2 c2 c2tail
        newlen = len - (choose2 0 1) + (choose1 1 0)
    f _ _ _ _ _ _ =
      error "Internal error (wrong data for solvePreparsed/f?)."
solvePreparsed _ _ _ _ =
  error "Internal error (wrong data for solvePreparsed?)."

import Control.Applicative
import Data.Char

solve :: [Int] -> [Int] -> Integer
solve a b = g a lst
    where
        lst = f cnt b $ drop (lenb - lena + 1) b
        f c _ [] = [c]
        f c (x:xs) (y:ys) = c : f (c-x+y) xs ys
        g [] [] = 0
        g (x:xs) (y:ys)
            | x == 1 = (fromIntegral lenb) - (fromIntegral lena) + 1 - (fromIntegral y) + g xs ys
            | otherwise = (fromIntegral y) + g xs ys
        lena = length a
        lenb = length b
        cnt = length . filter (==1) $ take (lenb - lena + 1) b

main :: IO ()
main = do
    a <- map digitToInt <$> getLine
    b <- map digitToInt <$> getLine
    print $ solve a b

import Control.Applicative
import Data.Char

solve :: [Int] -> [Int] -> Int
solve a b = g a lst
    where
        lst = f cnt b $ drop (lenb - lena + 1) b
        f c _ [] = [c]
        f c (x:xs) (y:ys) = c : f (c-x+y) xs ys
        g [] [] = 0
        g (x:xs) (y:ys)
            | x == 1 = lenb - lena + 1 - y + g xs ys
            | otherwise = y + g xs ys
        lena = length a
        lenb = length b
        cnt = length . filter (==1) $ take (lenb - lena + 1) b

main :: IO ()
main = do
    a <- map digitToInt <$> getLine
    b <- map digitToInt <$> getLine
    print $ solve a b

import Data.Ord
import Control.Applicative
import Data.List
import Data.Char
import Data.Array
import Debug.Trace
import Test.QuickCheck

solve :: String -> String -> Int
solve a b =
  sum $ map contribution $ [1..k]
  where
    k = length a
    delta = length b - length a
    convert x = listArray (1, length x) $ map digitToInt x
    a' = convert a
    b' = convert b
    numOnes = listArray (1, k) $ [f i | i <- [1..k]]
    numZeros i = delta + 1 - numOnes ! i
    f 1 = sum [b' ! i | i <- [1..delta+1]]
    f i = numOnes ! (i - 1) - b' ! (i - 1) + b' ! (i+delta)
    contribution i
      | a' ! i == 0 = numOnes ! i
      | otherwise = numZeros i

bruteHamming :: String -> String -> Int
bruteHamming a b =
  sum $ map hamming $ subs
  where
    subs = substrings (length a) b
    substrings n x =
      [take n (drop i x) | i <- [0..length x - n]]
    hamming :: String -> Int
    hamming b' = sum $ map fromEnum $ zipWith (/=) a b'

{-
runChecks :: IO ()
runChecks =
  let
    genVec = do
      let vals = vectorOf 2 $ listOf $ elements "01"
      sortBy (comparing length) <$> vals
    prop_hammings [a, b] =
      solve a b == bruteHamming a b
  in quickCheck $ forAll genVec prop_hammings
-}

main :: IO ()
main = do
  a <- getLine
  b <- getLine
  putStrLn $ show $ solve a b

import Data.List
import Data.Array

main = do
    interact solve

solve input = (show (do_solve as 0)) --  ++ " " ++ (intercalate "," (map show (elems dp_bs_1)))
    where
        as:bs:_ = words input
        as_length = length as
        bs_length = length bs
        dp_bs_0 = listArray (0,bs_length) (0:(make_dp_sum bs '0' 0))
        dp_bs_1 = listArray (0,bs_length) (0:(make_dp_sum bs '1' 0))

        -- ca current element cid is the current index
        do_solve [] _ = 0
        do_solve (ca:cas) cid = cur_sum + (do_solve cas (cid+1) )
            where
                hi_idx = min (cid + (bs_length-as_length+1) ) bs_length
                lo_idx = cid
                cur_sum
                    | ca == '1' = (dp_bs_0!hi_idx) - (dp_bs_0!lo_idx)
                    -- | (ca == '1') = 0
                    | (ca == '0') = (dp_bs_1!hi_idx) - (dp_bs_1!lo_idx)
                    -- | (ca == '0') = 0

as_string::(Show a) => [a] -> [String]
as_string arr = map show arr

make_dp_sum::(Eq a) => [a] -> a -> Int -> [Int]
make_dp_sum [] item csum = []
make_dp_sum (x:xs) item csum
    | x == item = (csum+1):(make_dp_sum xs item (csum+1))
    | otherwise = csum:(make_dp_sum xs item csum)

main :: IO ()
main = do
  putStrLn (replicate 60000 '9')

-- Michael V. Antosha  <Michael.Antosha@gmail.com>
-- 2016
-- http://mivael.in.ua

type HSumType = Int  -- sum of hamming distances
type LenType = Int  -- string length

main :: IO ()
main = do
  interact (show . solve . lines)

solve :: [String] -> HSumType
solve = solveStringPair
  where
    solveStringPair (a:b:[]) = solveStrAB a b
    solveStringPair _ = error "Pair of strings expected."
    solveStrAB a b =
      solvePreparsed lenA lenB psums bits
      where
        (lenA, psums) = revPSumA a (0,[0])
        (lenB, bits) = revB b (0,[])
    revPSumA = pa
    revB = pb
    pa [] result = result
    pa (ch:rest) (cnt, psums@(psum:_)) =
      pa rest (cnt + 1, psum + ch2int ch : psums)
    ch2int '0' = 0
    ch2int '1' = 1
    ch2int _ = error "ch2int: bad input"
    pb [] result = result
    pb (ch:rest) (cnt, bits) =
      pb rest (cnt + 1, ch2bool ch : bits)
    ch2bool '0' = False
    ch2bool '1' = True
    ch2bool _ = error "ch2bool: bad input"

solvePreparsed :: LenType -> LenType -> [LenType] -> [Bool] -> HSumType
solvePreparsed lenA lenB psums bits =
  f (0 :: HSumType) (1 :: LenType) (1 :: LenType) psums psums_prev bits
  where
    (_:psums_prev) = psums
    delta | (lenB >= lenA) = lenB - lenA
          | otherwise = error "Bad delta."
    f hsum cnt len c2 c1 (bit:bits) = g
      where
        g | cnt == lenB = newsum
          | cnt < lenB = f newsum (cnt + 1) newlen h2 h1 bits
          | otherwise = error "cnt is too large"
        (c1head:c1tail) = c1
        (c2head:c2tail) = c2
        ones = c2head - c1head
        zeros = len - ones
        s | bit == True = zeros
          | otherwise = ones
        newsum = hsum + s
        choose1 x y | cnt >= lenA = y | otherwise = x
        choose2 x y | cnt > delta = y | otherwise = x
        h1 = choose1 c1tail [0]
        h2 = choose2 c2 c2tail
        newlen = len - (choose2 0 1) + (choose1 1 0)
    f _ _ _ _ _ _ =
      error "Internal error (wrong data for solvePreparsed/f?)."
solvePreparsed _ _ _ _ =
  error "Internal error (wrong data for solvePreparsed?)."


Lord Omkar has permitted you to enter the Holy Church of Omkar! To test your worthiness, Omkar gives you a password which you must interpret!A password is an array $$$a$$$ of $$$n$$$ positive integers. You apply the following operation to the array: pick any two adjacent numbers that are not equal to each other and replace them with their sum. Formally, choose an index $$$i$$$ such that $$$1 \leq i < n$$$ and $$$a_{i} \neq a_{i+1}$$$, delete both $$$a_i$$$ and $$$a_{i+1}$$$ from the array and put $$$a_{i}+a_{i+1}$$$ in their place. For example, for array $$$[7, 4, 3, 7]$$$ you can choose $$$i = 2$$$ and the array will become $$$[7, 4+3, 7] = [7, 7, 7]$$$. Note that in this array you can't apply this operation anymore.Notice that one operation will decrease the size of the password by $$$1$$$. What is the shortest possible length of the password after some number (possibly $$$0$$$) of operations?

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). Description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2 \cdot 10^5$$$) — the length of the password. The second line of each test case contains $$$n$$$ integers $$$a_{1},a_{2},\dots,a_{n}$$$ ($$$1 \leq a_{i} \leq 10^9$$$) — the initial contents of your password. The sum of $$$n$$$ over all test cases will not exceed $$$2 \cdot 10^5$$$.

For each password, print one integer: the shortest possible length of the password after some number of operations.

NoteIn the first test case, you can do the following to achieve a length of $$$1$$$:Pick $$$i=2$$$ to get $$$[2, 4, 1]$$$Pick $$$i=1$$$ to get $$$[6, 1]$$$Pick $$$i=1$$$ to get $$$[7]$$$In the second test case, you can't perform any operations because there is no valid $$$i$$$ that satisfies the requirements mentioned above.

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

main = getLine >>= flip replicateM_ test . read

test = do
  getLine
  as <- map read . words <$> getLine :: IO [Int]
  if all (== head as) as then print $ length as else print 1

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: Int -> [Int] -> Int
solve n as =
    if foldr1 min as == foldr1 max as
        then n
        else 1

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        as <- map readIntB8 <$> B8.words <$> B8.getLine
        let answer = solve n as
        printf "%d\n" answer

import Control.Monad

soln :: [Int] -> Int
soln li
  | minimum li == maximum li  = length li
  | otherwise  = 1

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    li <- map read . words <$> getLine
    print (soln li)

{-# LANGUAGE OverloadedStrings #-}

import Prelude
import Control.Monad
import Data.Functor
import Data.List
import Data.Maybe
import Data.Int
import Data.Char
import qualified Data.ByteString.Char8 as B8
import Text.Printf

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

solve :: String -> Int64
solve digitsString = pairsCount
    where
        pairsCount = sum $ map (\cnt -> (cnt * (cnt - 1)) `div` (2 :: Int64)) countGroups
        countGroups = map (\group -> (fromIntegral $ length group) :: Int64) . group $ sort digitSums
        digitSums = scanl' (+) 0 digits
        digits = map (\c -> (fromIntegral ((ord c) - (ord '0') - 1)) :: Int64) digitsString

main :: IO ()
main = do
    t <- readIntB8 <$> B8.getLine
    forM_ [1..t] $ \_ -> do
        n <- readIntB8 <$> B8.getLine
        digits <- (head . B8.words) <$> B8.getLine
        let answer = solve $ B8.unpack digits
        printf "%s\n" $ show answer


Little Vasya has received a young builder’s kit. The kit consists of several wooden bars, the lengths of all of them are known. The bars can be put one on the top of the other if their lengths are the same.Vasya wants to construct the minimal number of towers from the bars. Help Vasya to use the bars in the best way possible.

The first line contains an integer N (1 ≤ N ≤ 1000) — the number of bars at Vasya’s disposal. The second line contains N space-separated integers li — the lengths of the bars. All the lengths are natural numbers not exceeding 1000.

In one line output two numbers — the height of the largest tower and their total number. Remember that Vasya should use all the bars.

import qualified Data.Map as M
import Text.Printf

main = interact f

f ss = printf "%d %d" (maximum e) (length e)
  where
    (n:s) = map (read :: String->Int) $ words ss
    m = foldl (\buf i -> M.insertWith (+) i 1 buf) (M.fromList ([]::[(Int, Int)])) s
    e = M.elems m

import List
main = do interact $ unwords . map show . (\i -> [maximum i, length i]) . map length . group . sort . map (read::String->Int) . tail . words

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine :: IO Int
    hs <- ( map read . words ) `liftM` getLine :: IO [Int]
    let tower = map length $ group $ sort hs

    putStrLn $ show ( maximum tower ) ++ " " ++ show ( length tower )

import qualified Data.IntMap as IntMap

collect [] stacks = stacks
collect (x : xs) stacks =
    case IntMap.lookup x stacks of
      Nothing -> collect xs (IntMap.insert x 1 stacks)
      Just a  -> collect xs (IntMap.insert x (a + 1) stacks)

count :: Int -> [Int] -> String
count barcount bars = show max_stack ++ " " ++ show stack_count
    where
      stack_count = IntMap.size stacks
      max_stack   = IntMap.fold max 0 stacks
      stacks      = collect bars IntMap.empty

main :: IO ()
main = do
  bar_count <- getLine >>= return . read
  bars <- getLine >>= return . (map read . words)
  putStr (count bar_count bars)

{-# LANGUAGE FlexibleContexts, ScopedTypeVariables, BangPatterns #-}
{-# 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
    ys = group $ sort xs
    m = maximum $ map length ys
    c = length ys

  putStrLn $ show m ++ " " ++ show c

import Data.List (sort, sortBy, group)
import Data.Function (on)

parse_input :: String -> [[Int]]
parse_input str = map (map (read::String->Int).words) (lines str)

solve :: String -> String
solve in_str =
  let l = head.tail $ parse_input in_str
      sorted = sortBy (flip compare `on` length) $ group $ sort l
    in (show $ length $ head $ sorted) ++ " " ++ (show $ length $ sorted)

main :: IO ()
main = do interact $ solve

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Function
import Data.Ord
import Data.Bits
import Data.Monoid
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main= someFunc
someFunc::IO()
someFunc = getLine >> (solve.concat =<< forM [1.. 1] ( \i -> map (fst.fromJust.C.readInt).C.words<$>C.getLine))
solve xs=let rs=sortBy  (flip compare `on` length)$ group $ sort xs; [x,y]=[length $ head rs,length rs] in putStr $ unwords $ map show [x,y]

{-# OPTIONS_GHC -O2 -XNoMonomorphismRestriction #-}
{-# LANGUAGE BangPatterns #-}
{-(c) gorlum0 [at] gmail.com-}
import Text.Printf
import Data.List (group, sort, maximumBy)
import Data.Ord (comparing)

towers bs = (h, t)
    where
    bs' = group . sort $ bs
    h = length $ maximumBy (comparing length) bs'
    t = length bs'

body [] = []
body (n:xs) = towers bs : body xs'
    where
    n' = read n
    (bs, xs') = splitAt n' xs

fmt :: (Int, Int) -> String
fmt (h, t) = printf "%d %d" h t

main = do
    ws <- words `fmap` getContents
    mapM_ (putStrLn . fmt) (body ws)

import Array

maxSize = 1000::Int

fillArray :: [Int] -> Array Int Int
fillArray l = accumArray (+) 0 (1, maxSize) [(i, 1) | i <- l]

getArray :: Array Int Int -> [Int]
getArray a = [a!i | i <- range (bounds a)]

solution :: Array Int Int -> (Int, Int)
solution a = (maximum la, length (filter (\x -> x > 0) la))
    where la = getArray a

main = do
    n <- readLn::(IO Int)
    s <- getLine
    a <- return (map (read::String -> Int) (words s))
    ans <- return (solution (fillArray a))
    putStr (show (fst ans))
    putStr " "
    putStr (show (snd ans))

import Data.List(sort)

solve xs = (largestTower sortedXs, towerCount sortedXs)
    where sortedXs = sort xs

largestTower xs = largestTower' 0 0 xs
    where largestTower' currentHeight lastHeight [] = currentHeight
          largestTower' currentHeight lastHeight (x:xs) = if x == lastHeight
                                                          then largestTower' (currentHeight+1) x xs
                                                          else max currentHeight (largestTower' 1 x xs)

towerCount xs = towerCount' 0 0 xs
    where towerCount' currentCount lastHeight [] = currentCount
          towerCount' currentCount lastHeight (x:xs) = if x == lastHeight
                                                       then towerCount' currentCount x xs
                                                       else towerCount' (currentCount+1) x xs

main = do
       dummy <- getLine
       inputLine <- getLine
       let inputArray = words inputLine
       let sequence = map read inputArray :: [Int]
       let ans = solve sequence
       putStrLn (show (fst ans) ++ " " ++ show (snd ans))

import Data.List (groupBy, sort)
import Data.Set (size, fromList)

main = do
    getLine
    n <- getLine
    let l = conv n
    putStr $ (show . f $ l) ++ " " ++ (show . g) l

conv = sort . map (read::String->Int) . words
f = maximum . (map length) . (groupBy (==))
g = size . fromList

import Control.Applicative
import Data.List

main=do

    getLine
    q1<- map read <$> words <$> getLine::IO [Int]
    let q = map length $ group $ sort q1
    putStrLn $ intercalate " " $ map show [maximum q , length q]

import Data.Char
import Data.List

main :: IO ()
main = getContents >>= putStrLn . solve . map read . words . (!!1) . lines

solve :: [Int] -> String
solve ns = unwords $ map show [ maximum (map length gns), length gns ]
  where gns = group (sort ns)

import Data.List
import Control.Arrow
main = putStrLn . uncurry (++) .
       ( show . maximum . map length &&&
         (' ':) . show . length ) .
       group . sort .
       map (read :: String -> Int) . tail . words =<< getContents

import Data.List
main = getLine >> fmap (map read . words) getLine >>= putStrLn . intercalate " " . map show . solve
solve :: [Int] -> [Int]
solve xs = [maxTower, towerCount]
    where grouped = group $ sort xs
          maxTower = maximum $ map length grouped
          towerCount = length grouped

import Prelude
import List
import Char

main = interact q

q = func.last.lines

func::String->String
func a = toStr$solve$map toInt $ words a
    where
      toStr (a,b) = (toString a) ++ " " ++ (toString b)

fileInteract func inf ouf = do file <- readFile inf
                               writeFile ouf (func file)

toInt::String->Int
toInt = read

asInteger::String->Integer
asInteger = read

toString::Int->String
toString = show

solve a = (maximum$map length l, length l)
          where
            l = group$reverse$sort a

import Data.List (group, sort)

main :: IO ()
main    = do    _ <- getLine
                s <- getLine
                putStrLn (solve s)
    where
        solve   = unwords . map show . count . group . sort . map read . words

count :: [[Int]] -> [Int]
count xss = [maximum (map length xss), length xss]

import Data.List

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

main = do
    n <- readLn :: IO Int
    num <- getnum
    let g = group . sort $ num
        a = maximum $ map length g
        b = length g
    putStrLn $ unwords (map show [a,b])

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative
import Text.Printf

solve :: [Int] -> (Int,Int)
solve list = (max_height,set_size)
      where set_size = length $ nub list
            occurence = map (\r -> length $ filter (== r) list) list
            max_height = maximum occurence

output (a,b) = (show a) ++ " " ++ (show b)

main = do n <- getLine
          line <- getLine
          let list = map read (words line)
          putStr $ output (solve list)

import List
main = interact f
f input = output where
  output = unwords [show d,show e]
  [n,l] = map (map (read::String->Int)) $ map words $ lines input
  a = sort $ zip l [1..]
  b [(x,_)] = [(x,1)]
  b ((x,y):xs)
    | x == u    = (x,v+1):tail ys
    | otherwise = (x,1):ys
   where
     ys = b xs
     (u,v) = head ys
  c = b a
  d = foldl1 max $ map snd c
  e = length c

import Data.List

calc :: [Int] -> (Int, Int)
calc xs = (maximum [count x xs | x <- xs], length $ nub xs)
  where
    count a xs = sum [1 | x <- xs, x == a]

main = do s <- getLine
          t <- getLine
          let (x, y) = calc $ map read $ words t
          putStrLn (show x ++ " " ++ show y)

import Control.Applicative
import Data.List

main=do
	getLine
	n<-  map read . words <$> getLine:: IO [Int]
	let m = group $ sort n
	putStrLn $ show ( maximum (map length m)) ++" " ++ (show (length m))

import Control.Monad
import Data.List

getLineValues :: IO [Int]
getLineValues = getLine >>= return . map read . words

main :: IO ()
main = do
    _ <- getLine
    ns <- getLineValues
    let nss = (group . sort) ns
        largest = (maximum . map length) nss
        total = length nss
    putStrLn $ show largest ++ " " ++ show total

import Data.List
main = getContents >>= putStrLn. (\x ->show (maximum.map length.group.sort $ x) ++ " " ++ show (length.nub $ x)). tail. words

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

main :: IO ()
main = do
	_ <- getLine
	line <- getLine
	putStr . show . maximum.  map (length) .group. sort. words $ line
	putStr " "
	print.length.nub.words $ line

import qualified Data.Map as M
import Control.Applicative

add k m = case res of
    Nothing -> M.insert k 1 m
    Just x -> M.insert k (x + 1) m
    where
        res = M.lookup k m

f x = map snd $ M.toList $ foldr add M.empty x

main = do
    n <- (read :: String -> Int) <$> getLine
    l <- map (read :: String -> Int) <$> words <$> getLine
    let cnt = f l
    putStr $ show (maximum cnt) ++ " " ++ show (length cnt)

import Data.List
import Data.Ord
import Control.Arrow
main = putStrLn . uncurry (++) .
       ( show . length . maximumBy (comparing sum) &&&
         (' ':) . show . length ) .
       group . sort .
       map read . tail . words =<< getContents


Vasya thinks that lucky tickets are the tickets whose numbers are divisible by 3. He gathered quite a large collection of such tickets but one day his younger brother Leonid was having a sulk and decided to destroy the collection. First he tore every ticket exactly in two, but he didn’t think it was enough and Leonid also threw part of the pieces away. Having seen this, Vasya got terrified but still tried to restore the collection. He chose several piece pairs and glued each pair together so that each pair formed a lucky ticket. The rest of the pieces Vasya threw away reluctantly. Thus, after the gluing of the 2t pieces he ended up with t tickets, each of which was lucky.When Leonid tore the tickets in two pieces, one piece contained the first several letters of his number and the second piece contained the rest.Vasya can glue every pair of pieces in any way he likes, but it is important that he gets a lucky ticket in the end. For example, pieces 123 and 99 can be glued in two ways: 12399 and 99123.What maximum number of tickets could Vasya get after that?

The first line contains integer n (1 ≤ n ≤ 104) — the number of pieces. The second line contains n space-separated numbers ai (1 ≤ ai ≤ 108) — the numbers on the pieces. Vasya can only glue the pieces in pairs. Even if the number of a piece is already lucky, Vasya should glue the piece with some other one for it to count as lucky. Vasya does not have to use all the pieces. The numbers on the pieces an on the resulting tickets may coincide.

Print the single number — the maximum number of lucky tickets that will be able to be restored. Don't forget that every lucky ticket is made of exactly two pieces glued together.

import Data.Array (accumArray, (!))

main = do
	dummy <- getLine
	a <- getLine
	let a' = accumArray (+) 0 (0, 2) $ map (\x -> (mod x 3, 1)) $ map read $ words $ a in
		putStrLn $ show $ div (a'!0) 2 + min (a'!1) (a'!2)

{-# LANGUAGE ScopedTypeVariables,TupleSections #-}
data State s a = State {runState :: s->(a,s)}
instance Monad (State s) where
	return = State . (,)
	(State f1) >>= f2 = State $ uncurry (runState . f2) . f1
	(State f1) >> (State f2) = State $ f2 .snd . f1

repeatMn a n = mapM (const a) [1..n]
readm::(Read a) => State String a
readm = State (head . reads)

runRead x s = fst $ runState x s

main = reader >>= writer . show . solver
reader = getContents
writer = putStr
solver = runRead $ do
	l <- readm >>= repeatMn readm
	let count x = length $ filter ((==x) . flip mod 3) l
	let ans = (min (count 1) (count 2)) + (flip div 2 $ count 0)
	return ans

main = do getLine
          args <- getLine
          print $ solve $ map read $ words args

solve :: [Int] -> Int
solve ns = num0 `div` 2 + min num1 num2
    where
      (num0, num1, num2) = count ns
      count [] = (0, 0, 0)
      count (n:ns') = let n0 = if n `mod` 3 == 0 then 1 else 0
                          n1 = if n `mod` 3 == 1 then 1 else 0
                          n2 = if n `mod` 3 == 2 then 1 else 0
                          (n0', n1', n2') = count ns'
                      in (n0 + n0', n1 + n1', n2 + n2')

import Data.Array
main=interact(show.s.map read.words)
s (n:xs)=r!0`div`2+min(r!1)(r!2) where r=accumArray(+)0(0,2)(map(\x->(x`mod`3,1))xs)

import Data.Array
main = interact (show.s.map read.words)
s (n:xs) = r!0`div`2+min(r!1)(r!2) where
    r = foldl m (listArray(0,2)[0,0,0]) xs
    m a x = a//[(i,a!i+1)] where i = x`mod`3

import Array
main=interact(show.s.map read.words)
s(n:y)=r!0`div`2+min(r!1)(r!2) where r=accumArray(+)0(0,2)(map(\x->(x`mod`3,1))y)

import Data.Array (accumArray, (!))

main = do
    dummy <- getLine
    a <- getLine
    let a' = accumArray (+) 0 (0, 2) $ map (\x -> (x `mod` 3, 1)) $ map read $ words $ a in
            print $ (a'!0) `div` 2 + min (a'!1) (a'!2)

printNumbers :: [Int] -> IO ()
printNumbers [] = return ()
printNumbers (x:xs) = do
    putStrLn(show x)
    printNumbers xs

toNumbers :: [Char] -> [Int]
toNumbers l = temp 0 l

temp :: Int -> [Char] -> [Int]
temp val [] = [val]
temp val (' ':xs) = val : (temp 0 xs)
temp val (x:xs) = temp (val + ((read [x]) :: Int)) xs

modBy3 :: [Int] -> Int -> Int
modBy3 l n = foldl (+) 0 ([1 | x <- l, (mod x 3) == n])

solve :: [Int] -> Int
solve l = (div (modBy3 l 0) 2) + (min (modBy3 l 2) (modBy3 l 1))

main = do
    getLine
    line <- getLine
    putStrLn (show (solve (toNumbers line)))
    --printNumbers((toNumbers line))
    --putStrLn(show(modBy3(toNumbers line) 0))
    --putStrLn(show(modBy3(toNumbers line) 1))
    --putStrLn(show(modBy3(toNumbers line) 2))
    return()

solve :: [Int] -> Int
solve a = min n1 n2 + div n0 2
  where
    a2 = map (\x -> mod x 3) a
    n0 = length (filter (==0) a2)
    n1 = length (filter (==1) a2)
    n2 = length (filter (==2) a2)

main = do
    getLine
    line <- getLine
    let a = map read (words line)
    print (solve a)

import List
main = interact solve
solve input = output where
  a = map ( read :: String -> Int ) $ words $ last $ lines input
  output = show $ div ( a0 - 1 ) 2 + min a1 a2 - 1
  [a0,a1,a2] = map length $ group $ sort $ map (\x -> mod x 3) ([0,1,2] ++ a)


There are n stone quarries in Petrograd.Each quarry owns mi dumpers (1 ≤ i ≤ n). It is known that the first dumper of the i-th quarry has xi stones in it, the second dumper has xi + 1 stones in it, the third has xi + 2, and the mi-th dumper (the last for the i-th quarry) has xi + mi - 1 stones in it.Two oligarchs play a well-known game Nim. Players take turns removing stones from dumpers. On each turn, a player can select any dumper and remove any non-zero amount of stones from it. The player who cannot take a stone loses.Your task is to find out which oligarch will win, provided that both of them play optimally. The oligarchs asked you not to reveal their names. So, let's call the one who takes the first stone «tolik» and the other one «bolik».

The first line of the input contains one integer number n (1 ≤ n ≤ 105) — the amount of quarries. Then there follow n lines, each of them contains two space-separated integers xi and mi (1 ≤ xi, mi ≤ 1016) — the amount of stones in the first dumper of the i-th quarry and the number of dumpers at the i-th quarry.

Output «tolik» if the oligarch who takes a stone first wins, and «bolik» otherwise.

import Data.Bits

main = interact $ pureMain

pureMain :: String -> String
pureMain s = if xorSum == 0 then "bolik\n" else "tolik\n"
  where [n]:l = map (map myRead.words) $ lines s
        xorSum = foldl xor 0 $ map (\[x, m] -> f (x + m - 1) `xor` f (x - 1)) l

myRead :: String -> Int
myRead = myRead' . reverse
  where myRead' ('0':s) = myRead' s * 10 + 0
        myRead' ('1':s) = myRead' s * 10 + 1
        myRead' ('2':s) = myRead' s * 10 + 2
        myRead' ('3':s) = myRead' s * 10 + 3
        myRead' ('4':s) = myRead' s * 10 + 4
        myRead' ('5':s) = myRead' s * 10 + 5
        myRead' ('6':s) = myRead' s * 10 + 6
        myRead' ('7':s) = myRead' s * 10 + 7
        myRead' ('8':s) = myRead' s * 10 + 8
        myRead' ('9':s) = myRead' s * 10 + 9
        myRead' _ = 0

f :: Int -> Int
f x = (if even x then bit 64 - 1 else 0) .&. x `xor` if even x /= even (div x 2) then 1 else 0

import Data.Bits

main = interact $ pureMain

pureMain :: String -> String
pureMain s = if xorSum == 0 then "bolik\n" else "tolik\n"
  where [n]:l = map (map myRead.words) $ lines s
        xorSum = foldl xor 0 $ map (\[x, m] -> f (x + m - 1) `xor` f (x - 1)) l

myRead :: String -> Int
myRead = myRead' . reverse
  where myRead' ('0':s) = myRead' s * 10 + 0
        myRead' ('1':s) = myRead' s * 10 + 1
        myRead' ('2':s) = myRead' s * 10 + 2
        myRead' ('3':s) = myRead' s * 10 + 3
        myRead' ('4':s) = myRead' s * 10 + 4
        myRead' ('5':s) = myRead' s * 10 + 5
        myRead' ('6':s) = myRead' s * 10 + 6
        myRead' ('7':s) = myRead' s * 10 + 7
        myRead' ('8':s) = myRead' s * 10 + 8
        myRead' ('9':s) = myRead' s * 10 + 9
        myRead' _ = 0

f :: Int -> Int
f x = (if even x then bit 64 - 1 else 0) .&. x `clearBit` 0 `xor` if even x /= even (div x 2) then 1 else 0

import Data.Bits

main = interact $ pureMain

pureMain :: String -> String
pureMain s = if xorSum == 0 then "bolik\n" else "tolik\n"
  where [n]:l = map (map read.words) $ lines s
        xorSum = foldl xor 0 $ map (\[x, m] -> f (x + m - 1) `xor` f (x - 1)) l

f :: Int -> Int
f x = (if even x then bit 64 - 1 else 0) .&. x `clearBit` 0 `xor` if even x /= even (div x 2) then 1 else 0


The integers shop sells $$$n$$$ segments. The $$$i$$$-th of them contains all integers from $$$l_i$$$ to $$$r_i$$$ and costs $$$c_i$$$ coins.Tomorrow Vasya will go to this shop and will buy some segments there. He will get all integers that appear in at least one of bought segments. The total cost of the purchase is the sum of costs of all segments in it.After shopping, Vasya will get some more integers as a gift. He will get integer $$$x$$$ as a gift if and only if all of the following conditions are satisfied:   Vasya hasn't bought $$$x$$$.  Vasya has bought integer $$$l$$$ that is less than $$$x$$$.  Vasya has bought integer $$$r$$$ that is greater than $$$x$$$. Vasya can get integer $$$x$$$ as a gift only once so he won't have the same integers after receiving a gift.For example, if Vasya buys segment $$$[2, 4]$$$ for $$$20$$$ coins and segment $$$[7, 8]$$$ for $$$22$$$ coins, he spends $$$42$$$ coins and receives integers $$$2, 3, 4, 7, 8$$$ from these segments. He also gets integers $$$5$$$ and $$$6$$$ as a gift.Due to the technical issues only the first $$$s$$$ segments (that is, segments $$$[l_1, r_1], [l_2, r_2], \ldots, [l_s, r_s]$$$) will be available tomorrow in the shop.Vasya wants to get (to buy or to get as a gift) as many integers as possible. If he can do this in differents ways, he selects the cheapest of them.For each $$$s$$$ from $$$1$$$ to $$$n$$$, find how many coins will Vasya spend if only the first $$$s$$$ segments will be available.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains the single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the number of segments in the shop. Each of next $$$n$$$ lines contains three integers $$$l_i$$$, $$$r_i$$$, $$$c_i$$$ ($$$1 \leq l_i \leq r_i \leq 10^9, 1 \leq c_i \leq 10^9$$$) — the ends of the $$$i$$$-th segments and its cost. It is guaranteed that the total sum of $$$n$$$ over all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case output $$$n$$$ integers: the $$$s$$$-th ($$$1 \leq s \leq n$$$) of them should be the number of coins Vasia will spend in the shop if only the first $$$s$$$ segments will be available.

NoteIn the first test case if $$$s = 1$$$ then Vasya can buy only the segment $$$[2, 4]$$$ for $$$20$$$ coins and get $$$3$$$ integers.The way to get $$$7$$$ integers for $$$42$$$ coins in case $$$s = 2$$$ is described in the statement.In the second test case note, that there can be the same segments in the shop.

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Control.Monad
  ( replicateM
  , replicateM_
  )
import Data.Int (Int64)

data Segment = Segment { l :: Int
                       , r :: Int
                       , cost :: Int64
                       }

solve :: [Segment] -> [Int64]
solve segments = iter segments 2000000000 inf 0 inf inf
  where
    inf = 1000000000000000 :: Int64
    iter [] _ _ _ _ _ = []
    iter ((Segment l r cost):rem) lm lc rm rc singleCost =
      let
        lmNew = if l < lm then l else lm
        rmNew = if r > rm then r else rm
        lcNew = if lmNew < lm then cost else (if l == lmNew then min cost lc else lc)
        rcNew = if rmNew > rm then cost else (if r == rmNew then min cost rc else rc)
        singleCostNew = min (if l == lmNew && r == rmNew then cost else inf) (if lmNew == lm && rmNew == rm then singleCost else inf)
      in (min (lcNew + rcNew) singleCostNew):(iter rem lmNew lcNew rmNew rcNew singleCostNew)

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    convert :: [Int] -> Segment
    convert (x:(y:(z:[]))) = Segment x y (fromIntegral z)
    convert _ = error "wrong data format"
    readSegment :: IO Segment
    readSegment = do
      ns <- (map readInt . C.words) <$> C.getLine
      return $ convert ns
    gao = do
      n <- readInt <$> C.getLine
      segments <- replicateM n readSegment
      let
        results = solve segments
      C.putStrLn $ C.intercalate "\n" $ map (C.pack . show) results

{-# LANGUAGE OverloadedStrings #-}

import qualified Data.ByteString.Char8 as C
import Control.Monad
  ( replicateM
  , replicateM_
  )
import Data.Int (Int64)

data Segment = Segment { l :: Int64
                       , r :: Int64
                       , cost :: Int64
                       }

solve :: [Segment] -> [Int64]
solve segments = iter segments 2000000000 inf 0 inf inf
  where
    inf = 1000000000000000 :: Int64
    iter [] _ _ _ _ _ = []
    iter (curr:rem) lm lc rm rc singleCost =
      let
        lmNew = if l curr < lm then l curr else lm
        rmNew = if r curr > rm then r curr else rm
        lcNew = if lmNew < lm then cost curr else (if l curr == lmNew then min (cost curr) lc else lc)
        rcNew = if rmNew > rm then cost curr else (if r curr == rmNew then min (cost curr) rc else rc)
        singleCostNew = min (if l curr == lmNew && r curr == rmNew then cost curr else inf) (if lmNew == lm && rmNew == rm then singleCost else inf)
      in (min (lcNew + rcNew) singleCostNew):(iter rem lmNew lcNew rmNew rcNew singleCostNew)

main :: IO ()
main = do
  tc <- readInt <$> C.getLine
  replicateM_ tc gao
  where
    readInt s = let Just (i, _) = C.readInt s in i
    readInt64 = fromIntegral . readInt
    convert :: [Int64] -> Segment
    convert (x:(y:(z:[]))) = Segment x y z
    convert _ = error "wrong data format"
    readSegment :: IO Segment
    readSegment = do
      ns <- (map readInt64 . C.words) <$> C.getLine
      return $ convert ns
    gao = do
      n <- readInt <$> C.getLine
      segments <- replicateM n readSegment
      let
        results = solve segments
      C.putStrLn $ C.intercalate "\n" $ map (C.pack . show) results

module Main (main) where

import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

type SegmentBounds = (Integer, Integer)
type CoinsNumber = Integer
type Segment = (SegmentBounds, CoinsNumber)

howManyCoinsWillVasyaSpendForEveryPrefixOf :: [Segment] -> [CoinsNumber]
howManyCoinsWillVasyaSpendForEveryPrefixOf segments = results
    where
        (bounds, costs) = unzip segments
        (left_bounds, right_bounds) = unzip bounds

        expenses_by_params (best_left, left_cost, best_right, right_cost, leftright_are_same, same_cost)
            | leftright_are_same = same_cost
            | otherwise = left_cost + right_cost

        results = go (maximum left_bounds + 1, 0, minimum right_bounds - 1, 0, False, 0) segments
        go params [] = []
        go params (segment:next_segments) = current_expenses : go new_params next_segments
            where
                (best_left, left_cost, best_right, right_cost, leftright_are_same, same_cost) = params
                prev_expenses = expenses_by_params params
                ((l, r), c) = segment
                new_params
                    | l <= best_left && r >= best_right && (c < prev_expenses || l < best_left || r > best_right)
                        = (l, new_left_cost, r, new_right_cost, True, c)
                    | l < best_left || (l <= best_left && c + right_cost < prev_expenses)
                        = (l, c, best_right, right_cost, False, 0)
                    | r > best_right || (r >= best_right && c + left_cost < prev_expenses)
                        = (best_left, left_cost, r, c, False, 0)
                    | otherwise
                        = (best_left, new_left_cost, best_right, new_right_cost, leftright_are_same, same_cost)
                        where
                            new_left_cost = if l < best_left || (l <= best_left && c < left_cost) then c else left_cost
                            new_right_cost = if r > best_right || (r >= best_right && c < right_cost) then c else right_cost
                current_expenses = expenses_by_params new_params

-- IO section --

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.concat . map processTest . groupInputByTests

processTest :: B.ByteString -> B.ByteString
processTest test_input = output
    where
        segments = map readSegment $ B.lines test_input
        result = howManyCoinsWillVasyaSpendForEveryPrefixOf segments
        output = B.unlines $ map bshow result
        bshow = B.pack . show

groupInputByTests :: B.ByteString -> [B.ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeNextTestLines

        takeNextTestLines [] = Nothing
        takeNextTestLines (l:ls) = Just $ splitAt (readInt l) ls

readSegment :: B.ByteString -> Segment
readSegment string = ((l, r), c)
    where
        [l, r, c] = readIntegers string

readIntegers :: B.ByteString -> [Integer]
readIntegers = unfoldr (B.readInteger . B.dropWhile isSpace)

readInteger :: B.ByteString -> Integer
readInteger s = r
    where [r] = readIntegers s

readInt :: B.ByteString -> Int
readInt = fromInteger . readInteger

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

prefMins :: Ord t => (a -> t) -> [a] -> [t]
prefMins f li = tail $ scanl' min (f $ head li) $ map f li

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    segs <- replicateM n $ do
      ~[li, ri, ci] <- getInts 3
      pure (li, ri, ci)
    let
      ls = prefMins (\( l, _r, c) -> (l, c)) segs
      rs = prefMins (\(_l,  r, c) -> (negate r, c)) segs
      ws = prefMins (\( l,  r, c) -> (l - r, c)) segs
      score ((lt, lc), (rt, rc), (wa, wc)) = let
        wt = lt + rt
        in  if  wa == wt
        then  min wc (lc + rc)
        else  lc + rc
    pure $ foldMap (putInts . pure . score) $ zip3 ls rs ws

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

module Main (main) where

import qualified Data.ByteString.Char8 as B
import Data.Char (isSpace)
import Data.List (unfoldr)

type SegmentBounds = (Integer, Integer)
type CoinsNumber = Integer
type Segment = (SegmentBounds, CoinsNumber)

howManyCoinsWillVasyaSpendForEveryPrefixOf :: [Segment] -> [CoinsNumber]
howManyCoinsWillVasyaSpendForEveryPrefixOf segments = results
    where
        (bounds, costs) = unzip segments
        (left_bounds, right_bounds) = unzip bounds

        expenses_by_params (best_left, left_cost, best_right, right_cost, leftright_are_same)
            | leftright_are_same = left_cost
            | otherwise = left_cost + right_cost

        results = go (maximum left_bounds + 1, 0, minimum right_bounds - 1, 0, False) segments
        go params [] = []
        go params (segment:next_segments) = current_expenses : go new_params next_segments
            where
                (best_left, left_cost, best_right, right_cost, leftright_are_same) = params
                prev_expenses = expenses_by_params params
                ((l, r), c) = segment
                new_params
                    | l <= best_left && r >= best_right && (c < prev_expenses || l < best_left || r > best_right)
                        = (l, c, r, c, True)
                    | l < best_left || (l <= best_left && c + right_cost < prev_expenses)
                        = (l, c, best_right, right_cost, False)
                    | r > best_right || (r >= best_right && c + left_cost < prev_expenses)
                        = (best_left, left_cost, r, c, False)
                    | otherwise
                        = params
                current_expenses = expenses_by_params new_params

-- IO section --

main :: IO ()
main = B.interact processInput

processInput :: B.ByteString -> B.ByteString
processInput = B.concat . map processTest . groupInputByTests

processTest :: B.ByteString -> B.ByteString
processTest test_input = output
    where
        segments = map readSegment $ B.lines test_input
        result = howManyCoinsWillVasyaSpendForEveryPrefixOf segments
        output = B.unlines $ map bshow result
        bshow = B.pack . show

groupInputByTests :: B.ByteString -> [B.ByteString]
groupInputByTests = map B.unlines . groupInputLines . drop 1 . B.lines
    where
        groupInputLines = unfoldr takeNextTestLines

        takeNextTestLines [] = Nothing
        takeNextTestLines (l:ls) = Just $ splitAt (readInt l) ls

readSegment :: B.ByteString -> Segment
readSegment string = ((l, r), c)
    where
        [l, r, c] = readIntegers string

readIntegers :: B.ByteString -> [Integer]
readIntegers = unfoldr (B.readInteger . B.dropWhile isSpace)

readInteger :: B.ByteString -> Integer
readInteger s = r
    where [r] = readIntegers s

readInt :: B.ByteString -> Int
readInt = fromInteger . readInteger


Ashish has two strings $$$a$$$ and $$$b$$$, each of length $$$n$$$, and an integer $$$k$$$. The strings only contain lowercase English letters.He wants to convert string $$$a$$$ into string $$$b$$$ by performing some (possibly zero) operations on $$$a$$$.In one move, he can either   choose an index $$$i$$$ ($$$1 \leq i\leq n-1$$$) and swap $$$a_i$$$ and $$$a_{i+1}$$$, or  choose an index $$$i$$$ ($$$1 \leq i \leq n-k+1$$$) and if $$$a_i, a_{i+1}, \ldots, a_{i+k-1}$$$ are all equal to some character $$$c$$$ ($$$c \neq$$$ 'z'), replace each one with the next character $$$(c+1)$$$, that is, 'a' is replaced by 'b', 'b' is replaced by 'c' and so on. Note that he can perform any number of operations, and the operations can only be performed on string $$$a$$$. Help Ashish determine if it is possible to convert string $$$a$$$ into $$$b$$$ after performing some (possibly zero) operations on it.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^5$$$) — the number of test cases. The description of each test case is as follows. The first line of each test case contains two integers $$$n$$$ ($$$2 \leq n \leq 10^6$$$) and $$$k$$$ ($$$1 \leq k \leq n$$$). The second line of each test case contains the string $$$a$$$ of length $$$n$$$ consisting of lowercase English letters. The third line of each test case contains the string $$$b$$$ of length $$$n$$$ consisting of lowercase English letters. It is guaranteed that the sum of values $$$n$$$ among all test cases does not exceed $$$10^6$$$.

For each test case, print "Yes" if Ashish can convert $$$a$$$ into $$$b$$$ after some moves, else print "No". You may print the letters of the answer in any case (upper or lower).

4
3 3
abc
bcd
4 2
abba
azza
2 1
zz
aa
6 2
aaabba
ddddcc

NoteIn the first test case it can be shown that it is impossible to convert $$$a$$$ into $$$b$$$.In the second test case,"abba" $$$\xrightarrow{\text{inc}}$$$ "acca" $$$\xrightarrow{\text{inc}}$$$ $$$\ldots$$$ $$$\xrightarrow{\text{inc}}$$$ "azza".Here "swap" denotes an operation of the first type, and "inc" denotes an operation of the second type.In the fourth test case,"aaabba" $$$\xrightarrow{\text{swap}}$$$ "aaabab" $$$\xrightarrow{\text{swap}}$$$ "aaaabb" $$$\xrightarrow{\text{inc}}$$$ $$$\ldots$$$ $$$\xrightarrow{\text{inc}}$$$ "ddaabb" $$$\xrightarrow{\text{inc}}$$$ $$$\ldots$$$ $$$\xrightarrow{\text{inc}}$$$ "ddddbb" $$$\xrightarrow{\text{inc}}$$$ $$$\ldots$$$ $$$\xrightarrow{\text{inc}}$$$ "ddddcc".

import Control.Arrow ((>>>))
import Data.Bool (bool)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromMaybe, isJust)

main :: IO ()
main =
  interact $ lines >>> drop 1 >>> process >>> map (bool "No" "Yes") >>> unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst

process :: [String] -> [Bool]
process [] = []
process (nk:a:b:xs) = solve k a b : process xs
  where
    k = words >>> last >>> read $ nk

solve :: Int -> String -> String -> Bool
solve k a b = (== Just 0) . foldl f (Just 0) $ zipWith (-) (freq a) (freq b)
  where
    freq s = [length (filter (== c) s) | c <- ['a' .. 'z']]
    f Nothing _ = Nothing
    f (Just acc) x
      | acc + x < 0 = Nothing
      | (acc + x) `mod` k /= 0 = Nothing
      | otherwise = Just (acc + x)

{-# LANGUAGE GADTs, DeriveFunctor, OverloadedStrings #-}

import qualified Data.ByteString.Char8 as B8
import Text.Printf
import Data.Functor ( (<&>) )
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Maybe (fromJust, isJust)
import Data.Traversable (forM)
import qualified Control.Monad.State.Strict as S
import qualified Data.Map as M
import Control.Monad (foldM_)
import Data.Int

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

calcCnts :: B8.ByteString -> M.Map Char Int
calcCnts bs = flip S.execState (M.empty :: M.Map Char Int) $ do
    forM_ (B8.unpack bs) $ \c -> do
        S.modify $ M.insertWith (+) c 1

solve :: Int -> B8.ByteString -> B8.ByteString -> Bool
solve k sa sb = isJust ts
    where
        cntsA = calcCnts sa
        cntsB = calcCnts sb
        ts = flip S.execState (Just 0) $ do
            forM_ ['a' .. 'z'] $ \c -> do
                let ta = M.findWithDefault 0 c cntsA
                let tb = M.findWithDefault 0 c cntsB
                S.modify $ \s -> do
                    vs <- fmap (+ ta) s
                    if vs < tb || (vs - tb) `mod` k /= 0
                        then Nothing
                        else return $ vs - tb

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ \_ -> do
        [n, k] <- B8.getLine <&> B8.words <&> map (readIntB8 >>> fromJust)
        sa <- B8.getLine
        sb <- B8.getLine
        let answer = solve k sa sb
        B8.putStrLn $ if answer then "Yes" else "No"

{-# LANGUAGE Safe #-}
--codelegend orz

import safe Control.Arrow ((>>>))
import Data.Bool
import Data.List

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (nk : a : b : rest) =  solve  (last $ linetois nk) a b : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois

solve :: Int -> String -> String -> String
solve k as bs = (bool "Yes" "No") $ (==Nothing) $ foldl foo (Just 0) $ zipWith (-) (freq as) (freq bs) where
  freq xs = [length $ filter (==c) xs | c <-['a'..'z']]
  foo Nothing _ = Nothing
  foo (Just acc) x | acc + x < 0 = Nothing
                   | (acc + x) `mod` k /= 0 = Nothing
                   | otherwise = Just (acc + x)


A binary string is a string where each character is either 0 or 1. Two binary strings $$$a$$$ and $$$b$$$ of equal length are similar, if they have the same character in some position (there exists an integer $$$i$$$ such that $$$a_i = b_i$$$). For example:  10010 and 01111 are similar (they have the same character in position $$$4$$$);  10010 and 11111 are similar;  111 and 111 are similar;  0110 and 1001 are not similar. You are given an integer $$$n$$$ and a binary string $$$s$$$ consisting of $$$2n-1$$$ characters. Let's denote $$$s[l..r]$$$ as the contiguous substring of $$$s$$$ starting with $$$l$$$-th character and ending with $$$r$$$-th character (in other words, $$$s[l..r] = s_l s_{l + 1} s_{l + 2} \dots s_r$$$).You have to construct a binary string $$$w$$$ of length $$$n$$$ which is similar to all of the following strings: $$$s[1..n]$$$, $$$s[2..n+1]$$$, $$$s[3..n+2]$$$, ..., $$$s[n..2n-1]$$$.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 50$$$). The second line of each test case contains the binary string $$$s$$$ of length $$$2n - 1$$$. Each character $$$s_i$$$ is either 0 or 1.

For each test case, print the corresponding binary string $$$w$$$ of length $$$n$$$. If there are multiple such strings — print any of them. It can be shown that at least one string $$$w$$$ meeting the constraints always exists.

NoteThe explanation of the sample case (equal characters in equal positions are bold):The first test case:   $$$\mathbf{1}$$$ is similar to $$$s[1..1] = \mathbf{1}$$$. The second test case:   $$$\mathbf{000}$$$ is similar to $$$s[1..3] = \mathbf{000}$$$;  $$$\mathbf{000}$$$ is similar to $$$s[2..4] = \mathbf{000}$$$;  $$$\mathbf{000}$$$ is similar to $$$s[3..5] = \mathbf{000}$$$. The third test case:   $$$\mathbf{1}0\mathbf{10}$$$ is similar to $$$s[1..4] = \mathbf{1}1\mathbf{10}$$$;  $$$\mathbf{1}01\mathbf{0}$$$ is similar to $$$s[2..5] = \mathbf{1}10\mathbf{0}$$$;  $$$\mathbf{10}1\mathbf{0}$$$ is similar to $$$s[3..6] = \mathbf{10}0\mathbf{0}$$$;  $$$1\mathbf{0}1\mathbf{0}$$$ is similar to $$$s[4..7] = 0\mathbf{0}0\mathbf{0}$$$. The fourth test case:   $$$0\mathbf{0}$$$ is similar to $$$s[1..2] = 1\mathbf{0}$$$;  $$$\mathbf{0}0$$$ is similar to $$$s[2..3] = \mathbf{0}1$$$.

import System.IO
-- import qualified Data.Set as Set

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = tail contents
    sequence $ solve arr

-- solve :: [[Char]] -> [IO [()]]
solve [] = []
solve (_:arr:xs) =
    let go [a]     = [a]
        go (a:_:x) = a:go x
    in putStrLn (go arr):solve xs

import Control.Monad

main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    str <- getLine
    let x = str !! (n - 1)
    putStrLn $ replicate n x

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

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

solve :: String -> String
solve (xs:s)
    | null s = [xs]
    | otherwise = do
        let t = tail s
        [xs] ++ solve(t)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        getLine
        s <- getLine
        putStrLn $ solve s

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

main = getLine >>= flip replicateM_ test . read

test = do
  n <- read <$> getLine
  s <- getLine
  putStrLn $ replicate n (s !! (n - 1))

import Control.Monad

solve :: String -> String
solve [c] = [c]
solve (c0:c1:cs) = c0 : solve cs
solve _ = error "invalid input"

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    _nStr <- getLine
    getLine >>= putStrLn . solve

import Control.Monad
import Data.List (intercalate)

main :: IO ()
main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    s <- getLine
    let res = replicate n (s !! (n - 1))
    putStrLn res


On a number line there are n balls. At time moment 0 for each ball the following data is known: its coordinate xi, speed vi (possibly, negative) and weight mi. The radius of the balls can be ignored.The balls collide elastically, i.e. if two balls weighing m1 and m2 and with speeds v1 and v2 collide, their new speeds will be: .Your task is to find out, where each ball will be t seconds after.

The first line contains two integers n and t (1 ≤ n ≤ 10, 0 ≤ t ≤ 100) — amount of balls and duration of the process. Then follow n lines, each containing three integers: xi, vi, mi (1 ≤ |vi|, mi ≤ 100, |xi| ≤ 100) — coordinate, speed and weight of the ball with index i at time moment 0. It is guaranteed that no two balls have the same coordinate initially. Also each collision will be a collision of not more than two balls (that is, three or more balls never collide at the same point in all times from segment [0;t]).

Output n numbers — coordinates of the balls t seconds after. Output the numbers accurate to at least 4 digits after the decimal point.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
-- import qualified Data.ByteString.Char8 as BS
import Text.Printf
import Debug.Trace

data Ball = Ball{index :: !Int, pos :: !Double, velocity :: !Double, weight :: !Double}
  deriving Show

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: (Read a) => IO [a]
      readData = map read . words <$> getLine
      eps = 1e-9 :: Double
      inf = 10 ^ 300 :: Double
  n : time : _ <- readData :: IO [Double]
  balls <- fmap (sortBy (comparing pos)) . T.for [1 .. fromEnum n] $ \i -> do
    x : v : m : _ <- readData :: IO [Double]
    return $ Ball i x v m
  let minTime bs = do
        (Ball _ x1 v1 _, Ball _ x2 v2 _) <- zip bs (tail bs)
        guard $ v1 - v2 > eps
        return $! (x2 - x1) / (v1 - v2)
      printAll bs = putStrLn $ do
        Ball _ x _ _ <- sortBy (comparing index) bs
        printf "%.16f\n" x
      move t bs = do
        b <- bs
        return $ b{pos = pos b + velocity b * t}
      simulate t bs
        | t < eps   = printAll bs
        | otherwise = case minTime bs of
            ts@(_ : _) -> do
              let t' = minimum ts
              if t >= t' + eps
                then do
                     simulate (t - t') $ do
                       let sentinel = Ball 0 inf 0 0
                           bss = init . tails . ([sentinel] ++) . (++ [sentinel])$ move t' bs
                       (Ball _ xp vp mp, b@(Ball _ x v m), Ball _ xn vn mn) <- zip3 (bss !! 0) (bss !! 1) (bss !! 2)
                       return $ case () of
                                  _ | abs (xn - x) < eps -> b{velocity = ((m - mn) * v + 2 * mn * vn) / (m + mn)}
                                    | abs (x - xp) < eps -> b{velocity = ((m - mp) * v + 2 * mp * vp) / (mp + m)}
                                    | otherwise          -> b
                else simulate 0 $ move t bs
            _          -> simulate 0 $ move t bs
  simulate time balls
{-
2 9
3 4 5
0 7 8

2 2
3 7 5
0 7 8
-}

import List
main = interact (ans)
ans theInput = answer where
	theLines = lines theInput
	line0 = words $ head $ theLines
	n = (read::String->Int)(line0 !! 0)
	t = (read::String->Float)(line0 !! 1)
	p0 = zip (map (map (read::String->Float)) $ map words $ tail theLines) [1..n]
	p = sort p0
	collision [_] = []
	collision (x:y:xs) = (meet x y):collision (y:xs)
	meet ([x,y,_],_) ([u,v,_],_) = if y<=v then 101 else (u-x)/(y-v)
	nextCollisionTime xs = foldr1 min (collision xs)
	nextPosition u [] = []
	nextPosition u (([x,v,m],i):xs) = ([x+v*u,v,m],i) : (nextPosition u xs)
	newSpeed v1 m1 v2 m2 = ((m1-m2)*v1+2*m2*v2)/(m1+m2)
	nextSpeed [] = []
	nextSpeed [x] = [x]
	nextSpeed (([x1,v1,m1],i1):([x2,v2,m2],i2):xs) = if x1/=x2
		then ([x1,v1,m1],i1):(nextSpeed (([x2,v2,m2],i2):xs))
		else ([x1,v3,m1],i1):([x2,v4,m2],i2):(nextSpeed xs) where
			v3 = newSpeed v1 m1 v2 m2
			v4 = newSpeed v2 m2 v1 m1
	nextPair (x,y) = if x==t then (101,[]) else (x+dt,nextSpeed $ nextPosition dt y) where
		dt = min (t-x) (nextCollisionTime y)
	change = takeWhile ((/=101).fst) (iterate nextPair (0,p))
	answer = unlines $ map (show.head.snd) (sort [(x,y)|(y,x)<-(snd $ last change)])


While sailing on a boat, Inessa noticed a beautiful water lily flower above the lake's surface. She came closer and it turned out that the lily was exactly $$$H$$$ centimeters above the water surface. Inessa grabbed the flower and sailed the distance of $$$L$$$ centimeters. Exactly at this point the flower touched the water surface.  Suppose that the lily grows at some point $$$A$$$ on the lake bottom, and its stem is always a straight segment with one endpoint at point $$$A$$$. Also suppose that initially the flower was exactly above the point $$$A$$$, i.e. its stem was vertical. Can you determine the depth of the lake at point $$$A$$$?

The only line contains two integers $$$H$$$ and $$$L$$$ ($$$1 \le H < L \le 10^{6}$$$).

Print a single number — the depth of the lake at point $$$A$$$. The absolute or relative error should not exceed $$$10^{-6}$$$. Formally, let your answer be $$$A$$$, and the jury's answer be $$$B$$$. Your answer is accepted if and only if $$$\frac{|A - B|}{\max{(1, |B|)}} \le 10^{-6}$$$.

main = interact $ show . solve . map read . words
solve [h,l] = (l * l - h * h) / (2 * h)

readNumbers :: String -> [Double]
readNumbers = map read . words

main = do
    input <- getLine
    let [h, l] = readNumbers input
    print $ (l*l - h*h) / (2 * h)

main = interact $ show . solve . map read . words
solve [h,l] = l * tan gamma where
  alpha = atan (l/h)
  beta = pi/2 - alpha
  gamma = alpha - beta


You are given two strings $$$s$$$ and $$$t$$$ of equal length $$$n$$$. In one move, you can swap any two adjacent characters of the string $$$s$$$.You need to find the minimal number of operations you need to make string $$$s$$$ lexicographically smaller than string $$$t$$$.A string $$$a$$$ is lexicographically smaller than a string $$$b$$$ if and only if one of the following holds:   $$$a$$$ is a prefix of $$$b$$$, but $$$a \ne b$$$;  in the first position where $$$a$$$ and $$$b$$$ differ, the string $$$a$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$b$$$.

The first line of input contains one integer $$$q$$$ ($$$1 \le q \le 10\,000$$$): the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$). The second line of each test case contains the string $$$s$$$ consisting of $$$n$$$ lowercase English letters. The third line of each test case contains the string $$$t$$$ consisting of $$$n$$$ lowercase English letters. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, print in a separate line the minimal number of operations you need to make string $$$s$$$ lexicographically smaller than string $$$t$$$, or $$$-1$$$, if it's impossible.

4
1
a
a
3
rll
rrr
3
caa
aca
5
ababa
aabba

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

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 qualified Data.Set as DS
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char
import Data.Array
import Debug.Trace
solve :: IO ()
solve = do
  ~[n] <- readv
  ss <- getLine
  ts <- getLine
  let
    occs = accumArray (flip (:)) [] ('a','z') $ reverse $ zip ss [0..]
    ost = DS.fromAscList [0..n-1]
    ans = recurse occs ost 0 maxBound ts
  printv [if ans==maxBound then -1 else ans]

recurse :: Data.Array.Array Char [Int] -> DS.Set Int -> Int -> Int -> [Char] -> Int
recurse _ _ _ ans [] = ans
recurse !occs !ost !eqcost !ans (t:ts) = let
  beater = minimum $ maxBound:[head occ | ch <-['a'..t], ch/=t, let occ=occs!ch, not $ null occ]
  ans1 = if beater==maxBound then ans else min ans (eqcost + rank beater)
  rank r = DS.findIndex r ost
  in case occs ! t of
    [] -> ans1
    (x:xs) -> recurse (occs // [(t,xs)]) (DS.delete x ost) (eqcost + rank x) ans1 ts

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)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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

{-# 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 qualified Data.Set as DS
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char
import Data.Array
import Debug.Trace
solve :: IO ()
solve = do
  ~[n] <- readv
  ss <- getLine
  ts <- getLine
  let
    occs = accumArray (flip (:)) [] ('a','z') $ reverse $ zip ss [0..]
    ost = DS.fromAscList [0..n-1]
    ans = recurse occs ost 0 maxBound ts
  printv [if ans==maxBound then -1 else ans]

recurse :: Data.Array.Array Char [Int] -> DS.Set Int -> Int -> Int -> [Char] -> Int
recurse _ _ _ ans [] = ans
recurse occs ost eqcost ans (t:ts) = let
  beater = minimum $ maxBound:[head occ | ch <-['a'..t], ch/=t, let occ=occs!ch, not $ null occ]
  ans1 = if beater==maxBound then ans else min ans (eqcost + rank beater)
  rank r = DS.findIndex r ost
  in case occs ! t of
    [] -> ans1
    (x:xs) -> recurse (occs // [(t,xs)]) (DS.delete x ost) (eqcost + rank x) ans1 ts

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)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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

{-# 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 qualified Data.Set as DS
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char
import Data.Array
import Debug.Trace
solve :: IO ()
solve = do
  ~[n] <- readv
  ss <- getLine
  ts <- getLine
  let
    occs = accumArray (flip (:)) [] ('a','z') $ reverse $ zip ss [0..]
    ost = DS.fromAscList [0..n-1]
    ans = recurse occs ost 0 maxBound ts
  printv [if ans==maxBound then -1 else ans]

recurse :: Data.Array.Array Char [Int] -> DS.Set Int -> Int -> Int -> [Char] -> Int
recurse _ _ _ ans [] = ans
recurse occs ost eqcost ans (t:ts) = let
  beater = take 1 $ DL.sort $ concat [take 1 (occs ! ch) | ch <-['a'..t],ch/=t]
  ans1 = if null beater then ans else min ans (eqcost + rank (head beater))
  rank r = DS.findIndex r ost
  in case occs ! t of
    [] -> ans1
    (x:xs) -> recurse (occs // [(t,xs)]) (DS.delete x ost) (eqcost + rank x) ans1 ts

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)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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

{-# 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 qualified Data.IntMap.Strict as DIM
import qualified Data.Set as DS
import Data.Bool
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char
import Data.Function (on)

recurse :: DIM.IntMap [Int] -> DS.Set Int -> Int -> Int -> [Char] -> Int
recurse _ _ _ ans [] = ans
recurse occs occset taken ans (t:ts) = let
  beaters = filter (not.null.snd) $ takeWhile ((fromEnum t>).fst) $ DIM.assocs occs
  beater = DL.minimumBy (compare `on` (head.snd)) beaters  -- if not null beaters
  ans'{-'-} = if null beaters then ans else min ans (taken + prevCount (head $ snd beater))
  prevCount r = DS.findIndex r occset
  (matcherMaybe,occs'{-'-}) = DIM.updateLookupWithKey (\_ -> Just .drop 1) (fromEnum t) occs
  cost matcher = prevCount matcher
  in
    case matcherMaybe of
      (Just (m:ms)) -> recurse occs'{-'-} (DS.delete m occset) (taken+cost m)  ans'{-'-} ts
      _ -> ans'{-'-}

solve :: IO ()
solve = do
  ~[n] <- readv
  ss <- getLine
  ts <- getLine
  let
    occs = DIM.fromListWith (++) (reverse $ zip (fromEnum <$> ss) (pure <$> [0..]))
    seg = DS.fromAscList [0..n-1]
    ans = recurse occs seg 0 maxBound ts
  printv [if ans==maxBound then -1 else ans]

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)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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

{-# LANGUAGE BangPatterns #-}
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
import qualified Data.Map.Strict as M

mainFun :: SP Builder
mainFun = do
  ~[q] <- getInts 1
  fmap mconcat $ replicateM q $ do
    ~[n] <- getInts 1
    ~[s, t] <- map P.unpack <$> getNext 2
    let
      initOccs :: Array Char [Int]
      initOccs = accumArray (flip (:)) [] ('a', 'z')
        $ zip (reverse s) [n, n-1..]

      initOST :: M.Map Int Char
      initOST = M.fromAscList $ zip [1..] s

      ans = solve initOccs initOST t maxBound 0

      solve :: Array Char [Int] -> M.Map Int Char -> [Char] -> Int -> Int
        -> Int
      solve occs ost tt !currBest !used = case  tt  of
        [] -> currBest
        _ | currBest <= used  -> currBest -- not really important
        (c : ntt) -> let
          winOpts = concatMap (\lc -> take 1 (occs ! lc)) ['a' .. pred c]
          nBest = case  winOpts  of
            [] -> currBest
            _  -> min currBest $ used + M.findIndex (foldl' min n winOpts) ost
          in  case  occs ! c  of
          [] -> nBest
          (w : ws) -> let
            noccs = occs // [(c, ws)]
            nost = M.delete w ost
            nused = used + M.findIndex w ost
            in  solve noccs nost ntt nBest nused
    pure $ putInts [if  ans == maxBound  then  0-1  else  ans]

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

{-# 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 qualified Data.Set as DS
import System.IO hiding (getLine,print)
import Prelude hiding (getLine)
import Data.Char
import Data.Array

solve :: IO ()
solve = do
  ~[n] <- readv
  ss <- getLine
  ts <- getLine
  let
    occs = accumArray (flip (:)) [] ('a','z') $ reverse $ zip ss [0..]
    ost = DS.fromAscList [0..n-1]
    ans = recurse occs ost 0 maxBound ts
  printv [if ans==maxBound then -1 else ans]

recurse :: Data.Array.Array Char [Int] -> DS.Set Int -> Int -> Int -> [Char] -> Int
recurse _ _ _ ans [] = ans
recurse occs ost eqcost ans (t:ts) = let
  beater = take 1 $ concat [take 1 (occs ! ch) | ch <-['a'..t],ch/=t]
  ans1 = if null beater then ans else min ans (eqcost + rank (head beater))
  rank r = DS.findIndex r ost
  in case occs ! t of
    [] -> ans1
    (x:xs) -> recurse (occs // [(t,xs)]) (DS.delete x ost) (eqcost + rank x) ans1 ts

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)

getLine :: IO [Char]
getLine = DL.dropWhileEnd isSpace . DBC.unpack <$> DBC.getLine

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


Little Petya very much likes arrays consisting of n integers, where each of them is in the range from 1 to 109, inclusive. Recently he has received one such array as a gift from his mother. Petya didn't like it at once. He decided to choose exactly one element from the array and replace it with another integer that also lies in the range from 1 to 109, inclusive. It is not allowed to replace a number with itself or to change no number at all. After the replacement Petya sorted the array by the numbers' non-decreasing. Now he wants to know for each position: what minimum number could occupy it after the replacement and the sorting.

The first line contains a single integer n (1 ≤ n ≤ 105), which represents how many numbers the array has. The next line contains n space-separated integers — the array's description. All elements of the array lie in the range from 1 to 109, inclusive.

Print n space-separated integers — the minimum possible values of each array element after one replacement and the sorting are performed.

import Control.Applicative
import Data.List

main = do
  n <- read <$> getLine
  nums <- map read <$> words <$> getLine
  let _ = nums :: [Int]
      sorted = sort nums
      answer = if all (==1) sorted
                 then (replicate (n-1) 1) ++ [2]
                 else take n $ (1:sorted)
  putStrLn $ intercalate " " $ map show $ answer

import Data.List

solve xs | all (1==) xs = tail xs ++ [2]
         | otherwise    = [1] ++ (init $ sort xs)

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

import Data.List(sort)
import Control.Applicative

main = do n <- read <$> getLine
          xs <- map read <$> words <$> getLine
          putStrLn $ unwords $ map show $ solve n xs

solve :: Int -> [Int] -> [Int]
solve n xs = if all (1==) xs then (take (n-1) $ xs)++[2]
                             else 1:(take (n-1) $ sort xs)

import Data.List (sort)
solve :: [Int] -> [Int]
solve xs = sort $ (if last ps > 1 then 1 else 2) : init ps
    where ps = sort xs
main = putStrLn.unwords.map show.solve.map read.tail.words =<< getContents

import Data.List(sort)

main = do
	d <- getContents
	let dd = words d
	let n = read $ head dd::Int
	let xs = map (\x -> read x::Int) (tail dd)
	putStrLn $ unwords $ map show (solve n xs)

solve n xs | all (1==) xs = take (n-1) xs ++ [2]
           | otherwise    = 1:(take (n-1) $ sort xs)

module Main where

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

import Data.Time.Calendar

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

solve :: [Int] -> [String]
solve arr  = result where
    result = [intercalate " " $ map show ansInt]
    ansInt = sort $ (if last sArr == 1 then 2 else 1) : init sArr
    sArr = sort arr

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

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

solve a
   | corner    = take (n-1) (repeat 1) ++ [2]
   | otherwise = (1:) . take (n-1) $ sort a
   where n      = length a
         corner = all (==1) a

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   putStrLn . unwords . map show . solve . readIntList $ input !! 1

-- vim: set expandtab:

import Data.List
main = interact $ unwords.map show. gao. map read. tail. words
gao x = sort.reverse.ch.reverse.sort $ x
ch (x:s) | x == 1 = 2:s | 1 > 0 = 1:s

import List

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

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

solve :: [Int] -> [Int]
solve xs
  | maximum xs > 1  =  1:(init (sort xs))
  | otherwise       =  sort (2:(tail xs))

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (x:xs) = putStr (show x ++ " ") >> printAns xs

main :: IO ()
main = getLine >> Main.reads >>= printAns . solve

module Main (main) where

import System
import Data.Char
import Data.List
import Control.Monad
import Control.Applicative

joins :: [String] -> String
joins [] = ""
joins [x] = x
joins (x:xs) = x ++ " " ++ (joins xs)

toString::[Int] -> String
--toString = (dropWhile (== ' ')) . (concatMap (\x -> " " ++ (show x)))
toString list = intercalate " " $ map show list

solve::[Int] -> [Int]
solve list = answerList
    where sortedList = sort list
          answerList = sort $ (if last sortedList == 1 then 2 else 1) : init sortedList

main = interact$toString.solve.(map read).tail.words

import Control.Applicative
import Data.List

main = do
  n <- read <$> getLine
  nums <- map read <$> words <$> getLine
  let _ = nums :: [Int]
      sorted = sort nums
  putStrLn $ intercalate " " $ map show $ take n $ (1:sorted)

import Data.List(sort)
import Control.Applicative

main = do n <- read <$> getLine
          xs <- map read <$> words <$> getLine
          putStrLn $ unwords $ map show $ solve n xs

solve :: Int -> [Int] -> [Int]
solve n xs = 1:(take (n-1) $ sort xs)

import Data.List (sort)
solve :: [Int] -> [Int]
solve xs = (if last ps > 1 then 1 else 2) : init ps
    where ps = sort xs
main = putStrLn.unwords.map show.solve.map read.tail.words =<< getContents

import Data.List(sort)

main = do
	d <- getContents
	let dd = words d
	let n = read $ head dd::Int
	let xs = map (\x -> read x::Int) (tail dd)
	print $ unwords $ map show (solve n xs)

solve n xs | all (1==) xs = take (n-1) xs ++ [2]
           | otherwise    = 1:(take (n-1) $ sort xs)

module Main where

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

import Data.Time.Calendar

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

solve :: [Int] -> [String]
solve arr  = result where
    result = [intercalate " " $ map show ansInt]
    ansInt = 1 : init arr
    sArr = sort arr

module Main where

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

import Data.Time.Calendar

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

solve :: [Int] -> [String]
solve arr  = result where
    result = [intercalate " " $ map show ansInt]
    ansInt = 1 : init sArr
    sArr = sort arr

module Main where

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

import Data.Time.Calendar

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

solve :: [Int] -> [String]
solve arr  = result where
    result = [intercalate " " $ map show ansInt]
    ansInt = (if last sArr == 1 then 2 else 1) : init sArr
    sArr = sort arr

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

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

main = do
   input <- fmap (map (C.takeWhile (/='\r')) . C.lines) $ C.hGetContents stdin
   let n = readInt $ input !! 0
       a = (1:) . take (n-1) . sort . readIntList $ input !! 1
   putStrLn . unwords $ map show a

-- vim: set expandtab:

import List

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

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

solve :: [Int] -> [Int]
solve xs = 1:(init (sort xs))

printAns :: [Int] -> IO ()
printAns [] = return ()
printAns (x:xs) = putStr (show x ++ " ") >> printAns xs

main :: IO ()
main = getLine >> Main.reads >>= printAns . solve


You are given an equation:  Ax2 + Bx + C = 0. Your task is to find the number of distinct roots of the equation and print all of them in ascending order.

The first line contains three integer numbers A, B and C ( - 105 ≤ A, B, C ≤ 105). Any coefficient may be equal to 0.

In case of infinite root count print the only integer -1. In case of no roots print the only integer 0. In other cases print the number of root on the first line and the roots on the following lines in the ascending order. Print roots with at least 5 digits after the decimal point.

module Main where

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

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | abs a < 1e-308 -> if abs b > 1e-308 then (1,[-c/b]) else (if c/=0 then 0 else -1,[])
       _ | d < 0 -> (0, [])
       _ | d == 0 -> let root = (-b)/(2*a) in  (1, [if root == 0 then 0 else root])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> fromIntegral $ (read x::Int)) . take 3 . words
    print n
    mapM_ (printf "%.15f\n") roots

import Control.Monad (liftM)
import Text.Printf (printf)

solve :: [Integer] -> Maybe [Double]
solve [0, 0, 0]  =  Nothing
solve [0, 0, _]  =  Just []
solve [0, b, c]  =  Just [(-1) * fromIntegral c / fromIntegral b]
solve [a, b, c]
  | d < 0  =  Just []
  | d > 0  =  Just [(-b' - sqrt d') / (2 * a'), (-b' + sqrt d') / (2 * a')]
  | otherwise  =  Just [(-b') / (2 * a')]
  where
    d  =  b^2 - 4*a*c
    [a', b', c', d']  =  map fromIntegral [a, b, c, d]

prints :: Maybe [Double] -> IO ()
prints Nothing     =  print (-1)
prints (Just [])   =  print 0
prints (Just [x])  =  printf "1\n%.6f\n" x
prints (Just [x,y])
  | x < y  =  printf "2\n%.6f\n%.6f\n" x y
  | otherwise  =  printf "2\n%.6f\n%.6f\n" y x

main :: IO ()
main  =  liftM (map read . words) getLine >>= prints . solve

import Data.List
import Text.Printf

main :: IO()
main = do
	t <- getLine
	putStr $ getAnswer $ map (\x -> read x :: Double) (words t)

parseFloat :: Double -> String
parseFloat = printf "%.5f"

concatStr :: [String] -> String
concatStr = foldr (++) []

getAnswer :: [Double] -> String
getAnswer xs
	| lengthSol == 3	= "-1"
	| lengthSol == 0	= "0"
	| otherwise	= addNrOfSol ++ (concatStr $ map (++ "\n") $ map parseFloat $ solutions)
		where
			lengthSol  = length solutions
			solutions  = sort $ f xs
			addNrOfSol = (show $ lengthSol) ++ "\n"

f (a : b : c : xs)
	| a == 0 && b == 0 && c == 0	= [0, 0, 0]
	| a == 0 && b == 0 && c /= 0	= []
	| a == 0 && b /= 0		= [-c / b]
	| otherwise			= solve a b c
		where
			solve a b c
				| delta <  0	= []
				| delta == 0	= [ -b / (2 * a) ]
				| delta >  0	= ( -b + sqrt (delta) ) / (2 * a) : [( -b - sqrt (delta) ) / (2 * a)]
					where delta = b * b - 4 * a * c

module Main where

import Text.Printf
import Control.Monad
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | a < 1e-308 -> (-1,[])
       _ | d < 0 -> (0, [])
       _ | d == 0 -> let root = (-b)/(2*a) in  (1, [if root == 0 then 0 else root])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> read x::Double) . take 3 . words
    print n
    mapM_ (printf "%.8f\n") roots

module Main where

import Text.Printf
import Control.Monad
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | abs a < 1e-38 -> if abs b> 1e-38 then (1,[-c/b]) else (-1,[])
       _ | d < 0 -> (0, [])
       _ | d == 0 -> let root = (-b)/(2*a) in  (1, [if root == 0 then 0 else root])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> fromIntegral $ (read x::Int)) . take 3 . words
    print n
    mapM_ (printf "%.15f\n") roots

module Main where

import Text.Printf
import Control.Monad
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | d < 0 -> (0, [])
       _ | d ==0 -> (1, [(-b)/ (2*a)])
       _  -> (2, sort $ map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d])

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> read x::Double) . take 3 . words
    print n
    mapM_ (printf "%.8f\n") roots

module Main where

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

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | abs a < 1e-308 -> if abs b > 1e-308 then (1,[-c/b]) else (-1,[])
       _ | d < 0 -> (0, [])
       _ | d == 0 -> let root = (-b)/(2*a) in  (1, [if root == 0 then 0 else root])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> fromIntegral $ (read x::Int)) . take 3 . words
    print n
    mapM_ (printf "%.15f\n") roots

import Control.Monad (liftM)
import Text.Printf (printf)

solve :: [Integer] -> Maybe [Double]
solve [0, 0, 0]  =  Nothing
solve [0, 0, _]  =  Just []
solve [0, b, c]  =  Just [(-1) * fromIntegral c / fromIntegral b]
solve [a, b, c]
  | d < 0  =  Just []
  | d > 0  =  Just [(-b' - sqrt d') / (2 * a'), (-b' + sqrt d') / (2 * a')]
  | otherwise  =  Just [(-b') / (2 * a')]
  where
    d  =  b^2 - 4*a*c
    [a', b', c', d']  =  map fromIntegral [a, b, c, d]

prints :: Maybe [Double] -> IO ()
prints Nothing     =  print (-1)
prints (Just [])   =  print 0
prints (Just [x])  =  printf "1\n%.6f\n" x
prints (Just [x,y])  =  printf "2\n%.6f\n%.6f\n" x y

main :: IO ()
main  =  liftM (map read . words) getLine >>= prints . solve

import Control.Monad (liftM)
import Text.Printf (printf)

solve :: [Int] -> Maybe [Double]
solve [0, 0, 0]  =  Nothing
solve [0, 0, _]  =  Just []
solve [0, b, c]  =  Just [(-1) * fromIntegral c / fromIntegral b]
solve [a, b, c]
  | d < 0  =  Just []
  | d > 0  =  Just [(-b' - sqrt d') / (2 * a'), (-b' + sqrt d') / (2 * a')]
  | otherwise  =  Just [(-b') / (2 * a')]
  where
    d  =  b^2 - 4*a*c
    [a', b', c', d']  =  map fromIntegral [a, b, c, d]

prints :: Maybe [Double] -> IO ()
prints Nothing     =  print (-1)
prints (Just [])   =  print 0
prints (Just [x])  =  printf "1\n%.6f\n" x
prints (Just [x,y])  =  printf "2\n%.6f\n%.6f\n" x y

main :: IO ()
main  =  liftM (map read . words) getLine >>= prints . solve

import Data.List
import Text.Printf

main :: IO()
main = do
	t <- getLine
	putStr $ getAnswer $ map (\x -> read x :: Double) (words t)

parseFloat :: Double -> String
parseFloat = printf "%.5f"

concatStr :: [String] -> String
concatStr = foldr (++) []

getAnswer :: [Double] -> String
getAnswer xs
	| lengthSol == 3	= "-1"
	| lengthSol == 0	= "0"
	| otherwise	= addNrOfSol ++ (concatStr $ map (++ "\n") $ map parseFloat $ solutions)
		where
			lengthSol  = length solutions
			solutions  = sort $ f xs
			addNrOfSol = (show $ lengthSol) ++ "\n"

f (a : b : c : xs)
	| a == 0 && b == 0 && c == 0	= [0, 0, 0]
	| a == 0 && b == 0 && c /= 0	= []
	| a == 0 && b /= 0		= [-c / b]
	| otherwise			= solve a b c
		where
			solve a b c
				| delta <  0	= []
				| delta == 0	= [ -b / 2 * a ]
				| delta >  0	= ( -b + sqrt (delta) ) / (2 * a) : [( -b - sqrt (delta) ) / (2 * a)]
					where delta = b * b - 4 * a * c

module Main where

import Text.Printf
import Control.Monad
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | a < 1e-20 -> (-1,[])
       _ | d < 0 -> (0, [])
       _ | d ==0 -> (1, [(-b)/ (2*a)])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> read x::Double) . take 3 . words
    print n
    mapM_ (printf "%.8f\n") roots

module Main where

import Text.Printf
import Control.Monad
-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List

run :: [Double] -> (Int, [Double])
run [a,b,c] =
    let d = b^2 - 4*a*c
    in case d of
       _ | a < 1e-308 -> (-1,[])
       _ | d < 0 -> (0, [])
       _ | d ==0 -> (1, [(-b)/ (2*a)])
       _  -> let roots = map (\d -> ((-b) + d)/(2*a)) $ zipWith (*) [1, (-1)] $ map sqrt [d,d]
             in (2,  sort roots)

main =  do
    (n, roots) <- getLine >>= return . run . map (\x -> read x::Double) . take 3 . words
    print n
    mapM_ (printf "%.8f\n") roots