Vitya has learned that the answer for The Ultimate Question of Life, the Universe, and Everything is not the integer 54 42, but an increasing integer sequence $$$a_1, \ldots, a_n$$$. In order to not reveal the secret earlier than needed, Vitya encrypted the answer and obtained the sequence $$$b_1, \ldots, b_n$$$ using the following rules:  $$$b_1 = a_1$$$; $$$b_i = a_i \oplus a_{i - 1}$$$ for all $$$i$$$ from 2 to $$$n$$$, where $$$x \oplus y$$$ is the bitwise XOR of $$$x$$$ and $$$y$$$. It is easy to see that the original sequence can be obtained using the rule $$$a_i = b_1 \oplus \ldots \oplus b_i$$$.However, some time later Vitya discovered that the integers $$$b_i$$$ in the cypher got shuffled, and it can happen that when decrypted using the rule mentioned above, it can produce a sequence that is not increasing. In order to save his reputation in the scientific community, Vasya decided to find some permutation of integers $$$b_i$$$ so that the sequence $$$a_i = b_1 \oplus \ldots \oplus b_i$$$ is strictly increasing. Help him find such a permutation or determine that it is impossible.

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$). The second line contains $$$n$$$ integers $$$b_1, \ldots, b_n$$$ ($$$1 \leq b_i < 2^{60}$$$).

If there are no valid permutations, print a single line containing "No". Otherwise in the first line print the word "Yes", and in the second line print integers $$$b'_1, \ldots, b'_n$$$ — a valid permutation of integers $$$b_i$$$. The unordered multisets $$$\{b_1, \ldots, b_n\}$$$ and $$$\{b'_1, \ldots, b'_n\}$$$ should be equal, i. e. for each integer $$$x$$$ the number of occurrences of $$$x$$$ in the first multiset should be equal to the number of occurrences of $$$x$$$ in the second multiset. Apart from this, the sequence $$$a_i = b'_1 \oplus \ldots \oplus b'_i$$$ should be strictly increasing. If there are multiple answers, print any of them.

NoteIn the first example no permutation is valid.In the second example the given answer lead to the sequence $$$a_1 = 4$$$, $$$a_2 = 8$$$, $$$a_3 = 15$$$, $$$a_4 = 16$$$, $$$a_5 = 23$$$, $$$a_6 = 42$$$.

import Control.Monad
import Data.Array
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Function (on)
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import Data.List (foldl', foldl1', scanl1, sortBy, groupBy)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String

reverseBits :: Int64 -> [Int]
reverseBits x = -- rb 0 x []
  reverse $ map fst $ filter (odd . snd) $ takeWhile ((>0) . snd) $ iterate it (0, x)
  where
    it (lvl, v) = (lvl + 1, v `shiftR` 1)
    rb :: Int -> Int64 -> [Int] -> [Int]
    rb _ 0 acc = acc
    rb lvl x acc
      | odd x = r' (lvl:acc)
      | otherwise = r' acc
      where r' = rb (lvl + 1) (shiftR x 1)

groupByHighBits xs =
  reverse
  $ filter (not . null)
  $ elems
  $ accumArray (flip (:)) [] (0, maxbit)
  $ zip keys xs
  where
    keyf = head . reverseBits
    keys = map keyf xs
    maxbit = foldl' max 0 keys

type PositionToValue = [(Int64, Int64)]
type LevelToPositionValue = IntMap.IntMap PositionToValue

getGroupLimit :: [[Int64]] -> Array Int Int
getGroupLimit groups =
  accumArray (+) 0 (0, maxBits) $ zip hbs $ map (\x -> x - 1) lens
  where
    getHighBit = head . reverseBits . head
    hbs = map getHighBit groups
    lens = map length groups
    maxBits = foldl' max 0 hbs

mergeWithLimit limit newPVs oldPVs =
  reverse $ mergeWithLimit' newPVs oldPVs 0 []
  where
    mergeWithLimit' newPVs oldPVs len acc
      | len == limit = acc
      | otherwise = case (newPVs, oldPVs) of
        ((x:newPVs'), (y:oldPVs')) ->
          if (x < y) then
            mergeWithLimit' newPVs' oldPVs (len + 1) (x:acc)
          else
            mergeWithLimit' newPVs oldPVs' (len + 1) (y:acc)
        ([], (x:oldPVs')) ->
          mergeWithLimit' [] oldPVs' (len + 1) (x:acc)
        ((x:newPVs'), []) ->
          mergeWithLimit'  newPVs' [] (len + 1) (x:acc)
        ([], []) -> acc

addGroup :: Array Int Int -> [[Int64]] -> Maybe PositionToValue
addGroup groupLimit groups =
  foldM f IntMap.empty groups >>= IntMap.lookup (-1)
  where
    f lvlToPV group
        | numOccupiedPos < (length group) - 1 = Nothing
        | otherwise = Just nextLvlToPV
        where
          nextLvlToPV =
            saveAnswer $ foldl' (flip mergeLevel) lvlToPV levelGroups

          rbts = map reverseBits group
          lvl = head $ head rbts
          pv = fromMaybe [] (IntMap.lookup lvl lvlToPV)
          numOccupiedPos = length pv
          occupiedPos = 0:(map fst pv)
          newPos = map (+1) $ occupiedPos
          levelDown rbt pos v = [
              (downLvl, g downLvl, v) | downLvl <- (drop 1 rbt)]
            where g lvl' = shiftL pos (lvl - lvl')

          allToUpdate = mconcat $ zipWith3 levelDown rbts newPos group
          getLvl (lvl, _, _) = lvl
          getPV (_, p, v) = (p, v)
          levelGroups =
            map reverse
            $ filter (not . null)
            $ elems
            $ accumArray
              (flip (:)) [] (0, lvl)
              [(getLvl x, x) | x <- allToUpdate]
          mergeLevel levelGroup@(g:_) =
            IntMap.alter mg levelToMerge
            where
              levelToMerge = getLvl g
              pvs = map getPV levelGroup
              limit = groupLimit ! levelToMerge
              mg = Just . mergeWithLimit limit pvs . fromMaybe []

          updatePos lvlToPv (lvl', pos', v) =
            IntMap.alter (Just . addPos . (fromMaybe Map.empty))  lvl' lvlToPv
            where addPos = Map.insert pos' v

          saveNewPVs newPVs maybeOldPVs =
            Just $ (map targetPV newPVs) ++ oldPVs
            where
              targetPV (p, v) = (p `shiftL` lvl, v)
              oldPVs = fromMaybe [] maybeOldPVs
          saveAnswer = IntMap.alter (saveNewPVs newPVs) (-1)
            where newPVs = zip newPos group

findSolution :: [Int64] -> Maybe [Int64]
findSolution xs = fmap parseSolution maybeSolution
  where
    groups = groupByHighBits xs
    groupLimit = getGroupLimit groups
    maybeSolution = addGroup groupLimit groups

    parseSolution = map snd . sortBy (comparing fst)

main :: IO()
main = do
  (l1:l2:_) <- readLines
  let n = readInt l1
  let xs = map (fromInteger . readInteger) (BS.split ' ' l2) :: [Int64]
  case findSolution xs of
    Nothing -> putStrLn "No"
    Just s -> do
      putStrLn "Yes"
      putStrLn $ unwords $ map show s

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readInteger bs = case BS.readInteger bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

import Control.Monad
import Data.Array
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Function (on)
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import Data.List (foldl', foldl1', scanl1, sortBy, groupBy)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String

reverseBits :: Int64 -> [Int]
reverseBits x = -- rb 0 x []
  reverse $ map fst $ filter (odd . snd) $ takeWhile ((>0) . snd) $ iterate it (0, x)
  where
    it (lvl, v) = (lvl + 1, v `shiftR` 1)
    rb :: Int -> Int64 -> [Int] -> [Int]
    rb _ 0 acc = acc
    rb lvl x acc
      | odd x = r' (lvl:acc)
      | otherwise = r' acc
      where r' = rb (lvl + 1) (shiftR x 1)

groupByHighBits xs =
  reverse
  $ filter (not . null)
  $ elems
  $ accumArray (flip (:)) [] (0, maxbit)
  $ zip keys xs
  where
    keyf = head . reverseBits
    keys = map keyf xs
    maxbit = foldl' max 0 keys

type PositionToValue = [(Int64, Int64)]
type LevelToPositionValue = IntMap.IntMap PositionToValue

getGroupLimit :: [[Int64]] -> Array Int Int
getGroupLimit groups =
  accumArray (+) 0 (0, maxBits) $ zip hbs $ map (\x -> x - 1) lens
  where
    getHighBit = head . reverseBits . head
    hbs = map getHighBit groups
    lens = map length groups
    maxBits = foldl' max 0 hbs

addGroup :: Array Int Int -> [[Int64]] -> Maybe PositionToValue
addGroup groupLimit groups =
  join $ fmap (IntMap.lookup (-1)) $ foldM f IntMap.empty groups
  where
    f lvlToPV group
        | numOccupiedPos < (length group) - 1 = Nothing
        | otherwise = Just
          $ saveAnswer
          $ foldl' (flip mergeLevel) lvlToPV levelGroups
        where
          rbts = map reverseBits group
          lvl = head $ head rbts
          pv = fromMaybe [] (IntMap.lookup lvl lvlToPV)
          numOccupiedPos = length pv
          occupiedPos = 0:(map fst pv)
          newPos = map (+1) $ occupiedPos
          levelDown rbt pos v = [(downLvl, g downLvl, v) | downLvl <- rbt]
            where g lvl' = shiftL pos (lvl - lvl')

          allToUpdate = mconcat $ zipWith3 levelDown rbts newPos group
          getLvl (lvl, _, _) = lvl
          getPV (_, p, v) = (p, v)
          levelGroups =
            filter (not . null)
            $ elems
            $ accumArray
              (flip (:)) [] (0, lvl)
              [(getLvl x, x) | x <- allToUpdate]
          mergeLevel levelGroup@(g:_) =
            IntMap.alter mg levelToMerge
            where
              levelToMerge = getLvl g
              pvs = map getPV levelGroup
              limit = groupLimit ! levelToMerge
              mg = Just . mergeWithLimit limit pvs . fromMaybe []

          updatePos lvlToPv (lvl', pos', v) =
            IntMap.alter (Just . addPos . (fromMaybe Map.empty))  lvl' lvlToPv
            where addPos = Map.insert pos' v

          saveNewPVs newPVs maybeOldPVs =
            Just $ (map targetPV newPVs) ++ oldPVs
            where
              targetPV (p, v) = (p `shiftL` lvl, v)
              oldPVs = fromMaybe [] maybeOldPVs
          saveAnswer = IntMap.alter (saveNewPVs newPVs) (-1)
            where newPVs = zip newPos group

          mergeWithLimit limit newPVs oldPVs =
            mergeWithLimit' newPVs oldPVs 0  []
            where
              mergeWithLimit' newPVs oldPVs len acc
                | len == limit = acc
                | otherwise = case (newPVs, oldPVs) of
                  ((x:newPVs'), (y:oldPVs')) ->
                    if (x < y) then
                      mergeWithLimit' newPVs' oldPVs (len + 1) (x:acc)
                    else
                      mergeWithLimit' newPVs oldPVs' (len + 1) (y:acc)
                  ([], (x:oldPVs')) ->
                    mergeWithLimit' [] oldPVs' (len + 1) (x:acc)
                  ((x:newPVs'), []) ->
                    mergeWithLimit'  newPVs' [] (len + 1) (x:acc)
                  ([], []) -> acc

findSolution :: [Int64] -> Maybe [Int64]
findSolution xs = fmap parseSolution maybeSolution
  where
    groups = groupByHighBits xs
    groupLimit = getGroupLimit groups
    maybeSolution = addGroup groupLimit groups

    parseSolution = map snd . sortBy (comparing fst)

main :: IO()
main = do
  (l1:l2:_) <- readLines
  let n = readInt l1
  let xs = map (fromInteger . readInteger) (BS.split ' ' l2) :: [Int64]
  case findSolution xs of
    Nothing -> putStrLn "No"
    Just s -> do
      putStrLn "Yes"
      putStrLn $ unwords $ map show s

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readInteger bs = case BS.readInteger bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

import Control.Monad
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import Data.List (foldl', foldl1', scanl1, sortBy, group)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String

reverseBits :: Int64 -> [Int]
reverseBits x = rb 0 x []
  where
    rb :: Int -> Int64 -> [Int] -> [Int]
    rb _ 0 acc = acc
    rb lvl x acc
      | odd x = r' (lvl:acc)
      | otherwise = r' acc
      where r' = rb (lvl + 1) (shiftR x 1)

groupByHighBits xs =
  group
  $ map snd
  $ sortBy (comparing (Down . fst))
  $ zip (map (head . reverseBits) xs) xs

type PositionToValue = Map.Map Int64 Int64
type LevelToPositionValue = IntMap.IntMap PositionToValue

addGroup :: [[Int64]] -> Maybe LevelToPositionValue
addGroup groups = foldM f IntMap.empty groups
  where
    f lvlToPV group
        | numOccupiedPos < (length group) - 1 = Nothing
        | otherwise = Just $ foldl' updatePos lvlToPV allToUpdate
        where
          rbts = map reverseBits group
          lvl = head $ head rbts
          pv = fromMaybe Map.empty (IntMap.lookup lvl lvlToPV)
          numOccupiedPos = Map.size pv
          occupiedPos = 0:(Map.keys pv)
          newPos = map (+1) occupiedPos
          levelDown rbt pos v = [(downLvl, g downLvl, v) | downLvl <- rbt]
            where g lvl' = shiftL pos (lvl - lvl')

          allToUpdate = mconcat $ zipWith3 levelDown rbts newPos group
          updatePos lvlToPv (lvl', pos', v) =
            IntMap.alter (Just . addPos . (fromMaybe Map.empty))  lvl' lvlToPv
            where addPos = Map.insert pos' v

findSolution :: [Int64] -> Maybe [Int64]
findSolution xs = fmap (parseSolution . solutionByLvl) maybeSolution
  where
    groups = groupByHighBits xs
    maybeSolution = addGroup groups

    solutionByLvl = IntMap.toAscList
    combine (lowerLvl, pv) (higherLvl, pv') =
      (lowerLvl, pv `Map.union` higherSolution)
      where
        higherSolution = Map.mapKeys levelDown pv'
        levelDown = (`shiftL` (higherLvl - lowerLvl))
    parseSolution = scanl1 xor
      . map snd
      . Map.toAscList
      . snd
      . foldl1' combine

main :: IO()
main = do
  (l1:l2:_) <- readLines
  let n = readInt l1
  let xs = map (fromInteger . readInteger) (BS.split ' ' l2) :: [Int64]
  case findSolution xs of
    Nothing -> putStrLn "No"
    Just s -> do
      putStrLn "Yes"
      putStrLn $ unwords $ map show s

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readInteger bs = case BS.readInteger bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

import Control.Monad
import Data.Array
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Function (on)
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import Data.List (foldl', foldl1', scanl1, sortBy, groupBy)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String

reverseBits :: Int64 -> [Int]
reverseBits x = -- rb 0 x []
  reverse $ map fst $ filter (odd . snd) $ takeWhile ((>0) . snd) $ iterate it (0, x)
  where
    it (lvl, v) = (lvl + 1, v `shiftR` 1)
    rb :: Int -> Int64 -> [Int] -> [Int]
    rb _ 0 acc = acc
    rb lvl x acc
      | odd x = r' (lvl:acc)
      | otherwise = r' acc
      where r' = rb (lvl + 1) (shiftR x 1)

groupByHighBits xs =
  reverse
  $ filter (not . null)
  $ elems
  $ accumArray (flip (:)) [] (0, maxbit)
  $ zip keys xs
  where
    keyf = head . reverseBits
    keys = map keyf xs
    maxbit = foldl' max 0 keys

type PositionToValue = [(Int64, Int64)]
type LevelToPositionValue = IntMap.IntMap PositionToValue

getGroupLimit :: [[Int64]] -> Array Int Int
getGroupLimit groups =
  accumArray (+) 0 (0, maxBits) $ zip hbs $ map (\x -> x - 1) lens
  where
    getHighBit = head . reverseBits . head
    hbs = map getHighBit groups
    lens = map length groups
    maxBits = foldl' max 0 hbs

mergeWithLimit limit newPVs oldPVs =
  reverse $ mergeWithLimit' newPVs oldPVs 0 []
  where
    mergeWithLimit' newPVs oldPVs len acc
      | len == limit = acc
      | otherwise = case (newPVs, oldPVs) of
        ((x:newPVs'), (y:oldPVs')) ->
          if (x < y) then
            mergeWithLimit' newPVs' oldPVs (len + 1) (x:acc)
          else
            mergeWithLimit' newPVs oldPVs' (len + 1) (y:acc)
        ([], (x:oldPVs')) ->
          mergeWithLimit' [] oldPVs' (len + 1) (x:acc)
        ((x:newPVs'), []) ->
          mergeWithLimit'  newPVs' [] (len + 1) (x:acc)
        ([], []) -> acc

addGroup :: Array Int Int -> [[Int64]] -> Maybe PositionToValue
addGroup groupLimit groups =
  foldM f IntMap.empty groups >>= IntMap.lookup (-1)
  where
    f lvlToPV group
        | numOccupiedPos < (length group) - 1 = Nothing
        | otherwise = Just nextLvlToPV
        where
          nextLvlToPV =
            saveAnswer $ foldl' (flip mergeLevel) lvlToPV levelGroups

          rbts = map reverseBits group
          lvl = head $ head rbts
          pv = fromMaybe [] (IntMap.lookup lvl lvlToPV)
          numOccupiedPos = length pv
          occupiedPos = 0:(map fst pv)
          newPos = map (+1) $ occupiedPos
          levelDown rbt pos v = [(downLvl, g downLvl, v) | downLvl <- rbt]
            where g lvl' = shiftL pos (lvl - lvl')

          allToUpdate = mconcat $ zipWith3 levelDown rbts newPos group
          getLvl (lvl, _, _) = lvl
          getPV (_, p, v) = (p, v)
          levelGroups =
            filter (not . null)
            $ elems
            $ accumArray
              (flip (:)) [] (0, lvl)
              [(getLvl x, x) | x <- allToUpdate]
          mergeLevel levelGroup@(g:_) =
            IntMap.alter mg levelToMerge
            where
              levelToMerge = getLvl g
              pvs = map getPV levelGroup
              limit = groupLimit ! levelToMerge
              mg = Just . mergeWithLimit limit pvs . fromMaybe []

          updatePos lvlToPv (lvl', pos', v) =
            IntMap.alter (Just . addPos . (fromMaybe Map.empty))  lvl' lvlToPv
            where addPos = Map.insert pos' v

          saveNewPVs newPVs maybeOldPVs =
            Just $ (map targetPV newPVs) ++ oldPVs
            where
              targetPV (p, v) = (p `shiftL` lvl, v)
              oldPVs = fromMaybe [] maybeOldPVs
          saveAnswer = IntMap.alter (saveNewPVs newPVs) (-1)
            where newPVs = zip newPos group

findSolution :: [Int64] -> Maybe [Int64]
findSolution xs = fmap parseSolution maybeSolution
  where
    groups = groupByHighBits xs
    groupLimit = getGroupLimit groups
    maybeSolution = addGroup groupLimit groups

    parseSolution = map snd . sortBy (comparing fst)

main :: IO()
main = do
  (l1:l2:_) <- readLines
  let n = readInt l1
  let xs = map (fromInteger . readInteger) (BS.split ' ' l2) :: [Int64]
  case findSolution xs of
    Nothing -> putStrLn "No"
    Just s -> do
      putStrLn "Yes"
      putStrLn $ unwords $ map show s

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readInteger bs = case BS.readInteger bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents

import Control.Monad
import Data.Bits
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Function (on)
import Data.Int
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map
import Data.List (foldl', foldl1', scanl1, sortBy, groupBy)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.String

reverseBits :: Int64 -> [Int]
reverseBits x = rb 0 x []
  where
    rb :: Int -> Int64 -> [Int] -> [Int]
    rb _ 0 acc = acc
    rb lvl x acc
      | odd x = r' (lvl:acc)
      | otherwise = r' acc
      where r' = rb (lvl + 1) (shiftR x 1)

groupByHighBits xs =
  map (map snd)
  $ groupBy (((==) `on` fst))
  $ sortBy (comparing (Down . fst))
  $ zip (map (head . reverseBits) xs) xs

type PositionToValue = Map.Map Int64 Int64
type LevelToPositionValue = IntMap.IntMap PositionToValue

addGroup :: [[Int64]] -> Maybe LevelToPositionValue
addGroup groups = foldM f IntMap.empty groups
  where
    f lvlToPV group
        | numOccupiedPos < (length group) - 1 = Nothing
        | otherwise = Just $ foldl' updatePos lvlToPV allToUpdate
        where
          rbts = map reverseBits group
          lvl = head $ head rbts
          pv = fromMaybe Map.empty (IntMap.lookup lvl lvlToPV)
          numOccupiedPos = Map.size pv
          occupiedPos = 0:(Map.keys pv)
          newPos = map (+1) occupiedPos
          levelDown rbt pos v = [(downLvl, g downLvl, v) | downLvl <- rbt]
            where g lvl' = shiftL pos (lvl - lvl')

          allToUpdate = mconcat $ zipWith3 levelDown rbts newPos group
          updatePos lvlToPv (lvl', pos', v) =
            IntMap.alter (Just . addPos . (fromMaybe Map.empty))  lvl' lvlToPv
            where addPos = Map.insert pos' v

findSolution :: [Int64] -> Maybe [Int64]
findSolution xs = fmap (parseSolution . solutionByLvl) maybeSolution
  where
    groups = groupByHighBits xs
    maybeSolution = addGroup groups

    solutionByLvl = IntMap.toAscList
    combine (lowerLvl, pv) (higherLvl, pv') =
      (lowerLvl, pv `Map.union` higherSolution)
      where
        higherSolution = Map.mapKeys levelDown pv'
        levelDown = (`shiftL` (higherLvl - lowerLvl))
    parseSolution = scanl1 xor
      . map snd
      . Map.toAscList
      . snd
      . foldl1' combine

main :: IO()
main = do
  (l1:l2:_) <- readLines
  let n = readInt l1
  let xs = map (fromInteger . readInteger) (BS.split ' ' l2) :: [Int64]
  case findSolution xs of
    Nothing -> putStrLn "No"
    Just s -> do
      putStrLn "Yes"
      putStrLn $ unwords $ map show s

readInt bs = case BS.readInt bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readInteger bs = case BS.readInteger bs of
  Just (i, _) -> i
  Nothing -> error ("Not an integer: " ++ (show bs))

readLines :: IO [BS.ByteString]
readLines = BS.lines `fmap` BS.getContents


Kirito is stuck on a level of the MMORPG he is playing now. To move on in the game, he's got to defeat all n dragons that live on this level. Kirito and the dragons have strength, which is represented by an integer. In the duel between two opponents the duel's outcome is determined by their strength. Initially, Kirito's strength equals s.If Kirito starts duelling with the i-th (1 ≤ i ≤ n) dragon and Kirito's strength is not greater than the dragon's strength xi, then Kirito loses the duel and dies. But if Kirito's strength is greater than the dragon's strength, then he defeats the dragon and gets a bonus strength increase by yi.Kirito can fight the dragons in any order. Determine whether he can move on to the next level of the game, that is, defeat all dragons without a single loss.

The first line contains two space-separated integers s and n (1 ≤ s ≤ 104, 1 ≤ n ≤ 103). Then n lines follow: the i-th line contains space-separated integers xi and yi (1 ≤ xi ≤ 104, 0 ≤ yi ≤ 104) — the i-th dragon's strength and the bonus for defeating it.

On a single line print "YES" (without the quotes), if Kirito can move on to the next level and print "NO" (without the quotes), if he can't.

NoteIn the first sample Kirito's strength initially equals 2. As the first dragon's strength is less than 2, Kirito can fight it and defeat it. After that he gets the bonus and his strength increases to 2 + 99 = 101. Now he can defeat the second dragon and move on to the next level.In the second sample Kirito's strength is too small to defeat the only dragon and win.

import Control.Monad
import Data.List

data Answer = YES | NO deriving (Show)

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

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getAnswer :: [String] -> Int -> Answer
getAnswer list s = battle new s
    where new = sort $ cast list

cast :: [String] -> [[Int]]
cast [] = []
cast (first:rest) = casted : cast rest
    where casted = map read (words first)

battle :: [[Int]] -> Int -> Answer
battle [] _ = YES
battle ([x, y]:rest) s = if s <= x
                         then NO
                         else battle rest (s + y)

main :: IO ()
main = do
    limits <- getLine
    let [s, n] = map toInt (words limits)
    list <- getLines n
    print $ getAnswer list s

import Control.Monad
import Control.Applicative
import Data.List (sort, nub)

process [] _ = True
process ((dstr,dup):xs) kstr
  | kstr > dstr = process xs (kstr+dup)
  | otherwise = False

main = do
  [s,n] <- map read . words <$> getLine :: IO [Int]
  xs <- map (\[a,b] -> (a,b)) . map (map read . words) <$> replicateM n getLine :: IO [(Int,Int)]
  putStrLn $ if process (sort xs) s then "YES" else "NO"

import Control.Monad
import Data.List

getArray = fmap (map read . words) getLine

main = do
  [s, n] <- getArray
  a <- replicateM n getArray
  putStrLn $ (\i -> if i > 0 then "YES" else "NO") $ foldl (\z [x, y] -> if z > x then z + y else 0) s $ sort a

import Data.List

main = do
	ss<-getLine
	let [s,n] = words ss
	reading (read n) [] s

reading 0 acc s = do
	let d= map words $ acc
	let d2=map (\x->map read x) d
	putStrLn $ game (read s) (sort d2)
reading n acc s = do
	temp <-getLine
	reading (n-1) (acc++[temp]) s

game s [] = "YES"
game s ([dragon,bonus]:dragons) | s<= dragon = "NO"
               | otherwise = game (s+bonus) (dragons)

import Data.List

main = do
  [s, n] <- fmap (map read . words) getLine
  ps <- fmap (map (map read . words) . lines) getContents

  let
    ps' = sort ps

    find s [] = True
    find s ([x, y]:ps)
      | s > x = find (s+y) ps
      | otherwise = False

  putStrLn $ if find s ps' then "YES" else "NO"

import qualified Data.List as L

main :: IO ()
main = do [s,n] <- (getLine >>= return . map read . words)
          dragons <- sequence . replicate n $ (getLine >>= return . (\[x,y] -> (x,y)). map read . words)
          putStrLn $ solve s dragons

solve :: Int -> [(Int,Int)] -> String
solve s l = case result of
        Nothing -> "NO"
        Just _  -> "YES"
    where
        result = L.foldl' (\m (x,y) -> do
                        s <- m
                        if s <= x then Nothing else return (s+y)) (Just s) (L.sort l)

import Data.List
import Data.Maybe
import Data.Char
import Data.Function
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve.map (map read.words).lines
solve :: [[Int]]->String
solve ((x1:x2:[]):xs) =  slv1 x1 $ take x2 xs
slv1 a [] ="YES"
slv1 x xss = let mxx = mx [[a,b]|[a,b]<-xss, a<x] in if (\ a -> case a of []->True; _ -> False ) mxx then "NO" else slv1 (x+last mxx) (delete mxx xss)
    where
    mx [] = []
    mx z = maximumBy (\ a b -> last b `compare` last a ) z

import List (sortBy)
import Monad (liftM)

solve :: Int -> [(Int, Int)] -> Bool
solve s as  =  solve' s $ sortBy (\x y -> compare (fst x) (fst y)) as
  where
    solve' s []  =  True
    solve' s ((x,y):as)
      | s > x  =  solve' (s+y) as
      | otherwise  =  False

parse :: String -> (Int, Int)
parse line  =  case words line of
    [s1, s2]  ->  (read s1, read s2)

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

main :: IO ()
main  =  do
    (s, n)  <-  liftM parse getLine
    as  <-  liftM (map parse . take n . lines) getContents
    putStrLn $ "YES" <?> "NO" $ solve s as

import Control.Applicative
import Control.Monad
import Data.List (sort)

parse = map read . words
toTup [x,y] = (x,y)

main = do
  [s,n] <- parse <$> getLine
  xs    <- sort . map (toTup . parse) <$> replicateM n getLine
  putStrLn $
    if test s xs then "YES" else "NO"

test _ []     = True
test s ((sd,r):xs)
  | sd < s    = test (s+r) xs
  | otherwise = False

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

fight :: Int -> (Int, Int) -> Maybe Int
fight s (s', y') = if s <= s' then Nothing else Just (s + y')

solve :: Int -> [(Int, Int)] -> Bool
solve s = isJust . foldM fight s . sort

main :: IO ()
main = do
    [s, n] <- getIntList
    a <- replicateM n $ (\[x,y] -> (x, y)) <$> getIntList
    putStrLn $ if solve s a then "YES" else "NO"

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

process::[[Int]]->Int->String
process [] _ = "YES"
process ([a,b]:c) s | s<=a ="NO"
                    | otherwise = process c (s+b)

main=do
     [s,n]<-map read <$> words <$>getLine ::IO [Int]
     q<-(replicateM n (map read <$> words <$>getLine ))::IO [[Int]]
     putStrLn $ process (sort q) s

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

main = do
  [s, n] <- getList
  a <- replicateM n getList
  let dragons = sortBy (\x y -> head x `compare` head y) a
      endGamePower = foldl' (\p [x, y] -> if p > x then p+y else -1) s dragons
      answer = if endGamePower >= 0 then "YES" else "NO"
  putStrLn answer

getList = fmap (map read . words) getLine

import Data.List (sort)

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

solve :: [[Int]] -> Bool
solve ([s, _]:xys) = and $ zipWith (<) (map head xys') (scanl (+) s (map (!!1) xys'))
  where xys' = sort xys
solve _ = undefined

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Data.List
import Control.Monad

main = do
  [s,n] <- fmap (map read . words) getLine
  ds <- replicateM n readDragon
  putStrLn $ maybe "NO" (const "YES") $ foldM fightDragon s (sort ds)

readDragon = do
  [x,y] <- fmap (map read . words) getLine
  return (x,y)

fightDragon s (x,y) | s > x     = Just (s + y)
                    | otherwise = Nothing

import Control.Monad
import Data.List
main = do
    str1 <- getLine
    let [s, n] = map read $ words str1
    dragons <- forM [1..n] (\_ -> do
        str <- getLine
        let [x, y] = map read $ words str
        return (x, y) )
    let sortedDragons = sortBy (\(a, b) (c, d) -> a `compare` c) dragons
    putStrLn $ if s `canWin` sortedDragons then "YES" else "NO"

s `canWin` [] = True
s `canWin` ((x, y) : xs) | s <= x = False
                         | otherwise = (s + y) `canWin` xs

-- Vicfred
-- https://codeforces.com/problemset/problem/230/A

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

fight :: Int -> (Int, Int) -> Maybe Int
fight s (x, y) = if s <= x then Nothing else Just (s + y)

solve :: Int -> [(Int, Int)] -> Bool
solve s = isJust . foldM fight s . sort

main :: IO ()
main = do
    [s, n] <- map read . words <$> getLine :: IO [Int]
    a <- replicateM n $ (\[x,y] -> (x, y)) <$> map read . words <$> getLine
    putStrLn $ if solve s a then "YES" else "NO"

{-# LANGUAGE BangPatterns #-}

import Data.List

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

main=interact$f.map read.words

f(s:_:xys) = g s $ sort  $ toPairs xys
g _ [] = "YES"
g !s ((x,y):rest)
  | s <= x = "NO"
  | otherwise = g (s+y) rest

import Control.Applicative
import Data.List

f m xs = do
    s <- m
    if s > x
        then return (s+y)
        else Nothing
    where x = head xs
          y = last xs

main = do
    s:n <- map read<$>words<$>getLine
    xss <- sortBy g<$>map (map read<$>words)<$>lines<$>getContents
    judge $ foldl f (Just s) xss
    where judge x = case x of
            Just y  -> putStrLn "YES"
            Nothing -> putStrLn "NO"
          g (x:_) (y:_) | x <  y = LT
                        | x == y = EQ
                        | x > y  = GT

{-# OPTIONS_GHC -O3 -optc-O3 #-}

import Data.List (sort)

fight s [] = "YES"
fight s ((x, y) : ds) | s > x     = fight (s + y) ds
                      | otherwise = "NO"

getPair = do
    pair <- getLine
    let (x : y : _) = (map read . words) pair
    return (x, y)

getDragons 0 acc = return acc
getDragons n acc = do
    (x, y) <- getPair
    getDragons (n - 1) ((x, y) : acc)

main = do
    (s, n) <- getPair
    dragons <- getDragons n []
    putStrLn (fight s (sort dragons))

import Data.List
import Control.Monad

type Power = Int

solution :: Int -> [(Int, Int)] -> Bool
solution _ [] = True
solution p ((x, y):rest) | p >  x = solution (p+y) rest
                         | p <= x = False

main = do
    [s, n] <- (map read.words) `fmap` getLine
    let convert [a, b] = (a, b)
        getDragon = convert . (map read . words)
    dragons <- sortOn fst `fmap` (map getDragon) `fmap` replicateM n getLine
    putStrLn $ if solution s dragons then "YES" else "NO"

import Control.Applicative
import Data.List
import Data.Maybe

process::Int->[(Int,Int)]->String

process _ [] = "YES"
process s ((a,b):as) | s> a = process (s+b) as
                     | otherwise="NO"

main=do

	[s,n] <- map read.words  <$> getLine::IO [Int]
	q <- map (map read).map words.lines <$> getContents :: IO [[Int]]
	let q1 =  sort $  map (\z->(head z, last z)) q
	putStrLn $ process s q1

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

solve :: [[Integer]] -> Integer -> String
solve [] _ = "YES"
solve (x:xs) curPow
 | curPow > a = solve xs (curPow + b)
 | otherwise = "NO"
 	where
		a = head x
		b = last x

main :: IO ()
main = do
	line1 <- getLine
	contents <- getContents
	let
		[s, n] = map (\x -> read x :: Integer). words $ line1
		arr = sort.map (\x -> map (\x -> read x :: Integer). words $ x). lines $ contents
--	print s
--	print arr
	putStrLn$ solve  arr s

import Data.List (sortBy)
import Data.Ord (comparing)

process :: Int -> [(Int,Int)] -> Bool
process s ps = and $ zipWith (>) cs xs
    where
        (xs,ys) = unzip $ sortBy (comparing fst) ps
        cs = scanl (+) s ys

readInt :: String -> Int
readInt = read

readPair :: String -> (Int,Int)
readPair s = (l,r)
    where
        [l,r] = map readInt (words s)

main :: IO ()
main = do
    [s,n] <- fmap (map readInt.words) getLine
    ps <- fmap (map readPair.lines) getContents
    putStrLn $ ["NO","YES"] !! fromEnum (process s ps)

import Data.List
import Control.Applicative

main = do
            [s,n] <- readLine
            ls <- sequence $ replicate n $ readLine
            let zs = sort ls
            case killDragons zs s of
                True -> putStrLn "YES"
                _ -> putStrLn "NO"
     where
            readLine = ( liftA (map read) $ fmap words getLine ) :: IO [Int]
            killDragons [] _ = True
            killDragons ([x,y]:xs) s | s <= x        = False
                                     | otherwise     = killDragons xs (s + y)

import Data.List
import Data.Function
main = do
    [s,n] <- fmap (map read . words) getLine :: IO [Int]
    ds <- mapM (\_ -> (\[s,n] -> return (s,n)) =<< fmap (map read . words) getLine) [1..n] :: IO [(Int,Int)]
    let
        sds = sortBy (compare `on` fst) ds
    putStrLn $ f sds s

f [] s = "YES"
f ((x,y):ds) s
    | s > x = f ds (s+y)
    | True = "NO"

import Data.List
import Data.Ord

killAll :: Int -> [(Int, Int)] -> String
killAll _ [] = "YES"
killAll s ((si, bi):xs)
    | s > si = killAll (s + bi) xs
    | otherwise = "NO"

solve :: String -> String
solve inp = killAll s $ sortBy (comparing fst) dragons
    where l:ls = lines inp
          s:_ = fmap read. words $ l
          dragons = fmap toPair ls

toPair :: String -> (Int, Int)
toPair s = (a,b)
    where a:b:_ = fmap read . words $ s

main :: IO ()
main = interact $ solve

import Control.Monad

data Answer = YES | NO deriving (Show)

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

getLines :: Int -> IO [String]
getLines n = replicateM n getLine

getAnswer :: [String] -> Int -> Answer
getAnswer list s = battle new s
    where new = cast list

cast :: [String] -> [[Int]]
cast [] = []
cast (first:rest) = casted : cast rest
    where casted = map read (words first)

battle :: [[Int]] -> Int -> Answer
battle [] _ = YES
battle ([x, y]:rest) s = if s <= x
                         then NO
                         else battle rest (s + y)

main :: IO ()
main = do
    limits <- getLine
    let [s, n] = map toInt (words limits)
    list <- getLines n
    print $ getAnswer list s

{-# OPTIONS -O2 -optc-O3 #-}
import Control.Arrow ((***))
import Control.Monad (forM_, when)
import Control.Monad.ST (ST)
import Data.Array.ST (STUArray, runSTUArray, newArray, readArray, writeArray)
import Data.Array.Unboxed (UArray, (!), assocs)

isqrt :: (Integral a, Integral b) => a -> b
isqrt = floor . sqrt . fromIntegral

sieveToN :: Int -> UArray Int Bool
sieveToN n = runSTUArray sieve
  where
    sieve = do
      a <- newArray (2, n) True :: ST s (STUArray s Int Bool)
      forM_ [4, 6 .. n] $ \j ->
        writeArray a j False
      forM_ [3, 5 .. isqrt n] $ \i -> do
        ai <- readArray a i
        when ai $
          forM_ [i * i, i * (i + 2) .. n] $ \j ->
            writeArray a j False
      return a

primeTab :: UArray Int Bool
primeTab = sieveToN 1000000

isPrime :: Integral a => a -> Bool
isPrime n = n >= 2 && primeTab!fromIntegral n

main = do
  getLine
  getLine >>= putStrLn . unlines . map (gao . read) . words
  where
    gao n = let m = isqrt n in if m * m == n && isPrime m then "YES" else "NO"

import Data.List

main = do
	ss<-getLine
	let [s,n] = words ss
	reading (read n) [] s

reading 0 acc s = do
	let d= map words $ acc
	let d2=map (\x->map read x) d
	putStrLn $ game (read s) (sort d2)
reading n acc s = do
	temp <-getLine
	reading (n-1) (acc++[temp]) s

game s [] = "YES"
game s ([dragon,bonus]:dragons) | s<= dragon = "NO"
               | otherwise = game (s+bonus) (tail dragons)

import Data.List

main = do
	ss<-getLine
	let [s,n] = words ss
	rest<-getContents
	let d= map words $ lines $ rest
	let d2=map (\x->map read x) d
	putStrLn $ game (read s) d2

solve s dragons = game s (sort dragons)

game s [] = "YES"
game s ([dragon,bonus]:dragons) | s<= dragon = "NO"
               | otherwise = game (s+bonus) (tail dragons)

import Control.Applicative
import Control.Monad

process::[[Int]]->Int->String
process [] _ = "YES"
process ([a,b]:c) s | s<a ="NO"
                    | otherwise = process c (s+b)

main=do
     [s,n]<-map read <$> words <$>getLine ::IO [Int]
     q<-(replicateM n (map read <$> words <$>getLine ))::IO [[Int]]
     putStrLn $ process q s

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

process::[[Int]]->Int->String
process [] _ = "YES"
process ([a,b]:c) s | s<a ="NO"
                    | otherwise = process c (s+b)

main=do
     [s,n]<-map read <$> words <$>getLine ::IO [Int]
     q<-(replicateM n (map read <$> words <$>getLine ))::IO [[Int]]
     putStrLn $ process (sort q) s

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

solve :: [[Int]] -> Bool
solve ([s, _]:xys) = and $ zipWith (<) (map head xys) (scanl (+) s (map (!!1) xys))
solve _ = undefined

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

import Control.Monad

main = do
  [s,n] <- fmap (map read . words) getLine
  ds <- replicateM n readDragon
  putStrLn $ maybe "NO" (const "YES") $ foldM fightDragon s ds

readDragon = do
  [x,y] <- fmap (map read . words) getLine
  return (x,y)

fightDragon s (x,y) | s > x     = Just (s + y)
                    | otherwise = Nothing

import Control.Applicative

f m xs = do
    s <- m
    if s > x
        then return (s+y)
        else Nothing
    where x = head xs
          y = last xs

main = do
    s:n <- map read<$>words<$>getLine
    xss <- map (map read<$>words)<$>lines<$>getContents
    judge $ foldl f (Just s) xss
    where judge x = case x of
            Just y  -> putStrLn "YES"
            Nothing -> putStrLn "NO"

import Control.Applicative
import Data.List
import Data.Maybe

process::Int->[(Int,Int)]->String

process _ [] = "YES"
process s ((a,b):as) | s>= a = process (s+b) as
                     | otherwise="NO"

main=do

	[s,n] <- map read.words  <$> getLine::IO [Int]
	q <- map (map read).map words.lines <$> getContents :: IO [[Int]]
	let q1 =  sort $  map (\z->(head z, last z)) q
	putStrLn $ process s q1

import Data.List
import Control.Applicative

main = do
            [s,n] <- readLine
            ls <- sequence $ replicate n $ readLine
            let zs = sort ls
            case killDragons zs s of
                True -> putStrLn "YES"
                _ -> putStrLn "NO"
     where
            readLine = ( liftA (map read) $ fmap words getLine ) :: IO [Int]
            killDragons [] _ = True
            killDragons ([x,y]:xs) s | s < x        = False
                                     | otherwise    = killDragons xs (s + y)


The Olympic Games in Bercouver are in full swing now. Here everyone has their own objectives: sportsmen compete for medals, and sport commentators compete for more convenient positions to give a running commentary. Today the main sport events take place at three round stadiums, and the commentator's objective is to choose the best point of observation, that is to say the point from where all the three stadiums can be observed. As all the sport competitions are of the same importance, the stadiums should be observed at the same angle. If the number of points meeting the conditions is more than one, the point with the maximum angle of observation is prefered. Would you, please, help the famous Berland commentator G. Berniev to find the best point of observation. It should be noted, that the stadiums do not hide each other, the commentator can easily see one stadium through the other.

The input data consists of three lines, each of them describes the position of one stadium. The lines have the format x,  y,  r, where (x, y) are the coordinates of the stadium's center ( -  103 ≤ x,  y ≤ 103), and r (1 ≤ r  ≤ 103) is its radius. All the numbers in the input data are integer, stadiums do not have common points, and their centers are not on the same line.

Print the coordinates of the required point with five digits after the decimal point. If there is no answer meeting the conditions, the program shouldn't print anything. The output data should be left blank.

import Data.List (transpose, minimumBy)
import Data.Function (on)
import Text.Printf

solve :: [[Double]] -> String
solve ps = find initP 1
  where
    coords = take 2 $ transpose ps
    initP = map ((/ 3) . sum) coords

    eval p = sum . map (** 2) $ zipWith (-) thetas (tail . cycle $ thetas)
      where
        distToP = sqrt . sum . map (** 2) . zipWith (-) p
        thetas = map (\[x, y, r] -> distToP [x, y] / r) ps

    find p@[x, y] d -- d for delta
      | d < 1e-6 && eval p < 1e-5 = printf "%.5f %.5f\n" x y
      | d < 1e-6 = ""
      | fst bestCand < eval p = find (snd bestCand) d
      | otherwise = find p (d * 0.7)
      where
        points = [[x+d, y], [x-d, y], [x, y+d], [x, y-d]]
        cands = map (\cand -> (eval cand, cand)) points
        bestCand = minimumBy (compare `on` fst) cands

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

import Control.Monad (replicateM,forM,forM_)
import Text.Printf (printf)
import Data.List (maximumBy)
import Data.Ord (comparing)

data Point = P Double Double
  deriving (Show)

data Line =   L Point Double   -- x $. p     == c (p /= 0)
  deriving (Show)

data Circle = C Point Double   -- (x $. p)^2 == c (c > 0)
  deriving (Show)

center :: Circle -> Point
center (C a _) = a

radius2 :: Circle -> Double
radius2 (C _ r2) = r2

data Stadium = S Point Double
  deriving (Show)

epsilon = 1e-8

same :: Double -> Double -> Bool
same a b = abs (a-b) <= epsilon

($+) (P x1 y1) (P x2 y2) = P (x1+x2) (y1+y2)
($-) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)
($*) (P x y) a = P (x*a) (y*a)
($/) (P x y) a = P (x/a) (y/a)
($.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

perp :: Point -> Point
perp (P x y) = (P y (negate x))

norm2 :: Point -> Double
norm2 p = p $. p

lineDistance :: Line -> Point -> Double
lineDistance (L a c) p = abs ((a $. p) - c) / sqrt (a $. a)

lineDistance2 :: Line -> Point -> Double
lineDistance2 (L a c) p = ((a $. p) - c)^(2 :: Int)/(a $. a)

onCircle :: Circle -> Point -> Bool
onCircle (C a r) b = same (norm2 (b $- a)) r

onLine :: Line -> Point -> Bool
onLine (L a c) p = same (a $. p) c

bisector :: Point -> Point -> Line
bisector p1 p2 = L n c
  where
    n = (p2 $- p1)
    x0 = (p1 $+ p2) $/ 2
    c = x0 $. n

-- return the solution circle for two stadiums
bicircle :: Stadium -> Stadium -> Circle
bicircle (S a ra) (S b rb) = C c rr   -- r1 /= r2
  where
    a2 = a $. a
    b2 = b $. b
    ra2 = ra*ra
    rb2 = rb*rb
    c  = ((a $* rb2) $- (b $* ra2)) $/ (rb2 - ra2)
    rr = (c $. c) - (rb2 * a2 - ra2 * b2) / (rb2 - ra2)

intersectLines :: Line -> Line -> [ Point ]
intersectLines (L (P a b) e) (L (P c d) f)
  | det == 0 = []
  | otherwise = [ P (x'/det) (y'/det) ]
  where
    det = a*d - b*c
    x'  = e*d - b*f
    y'  = a*f - c*e

-- solve a*x^2 + b*x + c == 0
solveQuadratic :: Double -> Double -> Double -> [Double]
solveQuadratic a b c =
  case compare d 0 of
    EQ -> [ -b/(2*a) ]
    LT -> []
    GT -> [ (-b - sqrtd) / (2*a),  (-b + sqrtd) / (2*a) ]
  where d = b*b-4*a*c
        sqrtd = sqrt d

toParametric :: Line -> (Point,Point)
toParametric (L (P a b) c)
  | a /= 0 = let p1 = P (c/a) 0
                 p2 = P ((c-b)/a) 1
             in (p1, p2 $- p1)
  | b /= 0 = let p1 = P 0 (c/b)
                 p2 = P 1 ((c-a)/b)
             in (p1, p2 $- p1)

intersectLineCircle :: Line -> Circle -> [ Point ]
intersectLineCircle l (C q rr) = map (\t -> a $+ (b $* t)) ts
  where
    (a,b) = toParametric l
    a2    = b $. b
    a1    = ((a $- q) $. b) * 2
    a0    = ((a $- q) $. (a $- q)) - rr
    ts    = solveQuadratic a2 a1 a0

intersectCircles :: Circle -> Circle -> [ Point ]
intersectCircles (C a r1) (C b r2) = intersectLineCircle line (C b r2)
  where
    c = (r1 - r2 - (a $. a) + (b $. b)) / 2
    line = L (b $- a) c

solve :: Stadium -> Stadium -> Stadium -> [ Point ]
solve s1@(S p1 r1) s2@(S p2 r2) s3@(S p3 r3)
  | r1 == r2 && r1 == r3 = intersectLines      (bisector p1 p2) (bisector p1 p3)
  | r1 == r2             = intersectLineCircle (bisector p1 p2) (bicircle s1 s3)
  | r1 == r3             = intersectLineCircle (bisector p1 p3) (bicircle s1 s2)
  | otherwise            = intersectCircles    (bicircle s1 s2) (bicircle s1 s3)

mkStadium a b c = S (P a b) c

s1 = mkStadium 0 0 10
s2 = mkStadium 200 0 20
s3 = mkStadium 100 100 10

angle :: Point -> Stadium -> Double
angle a (S b r) = r / sqrt (norm2 (a $- b))

angle' :: Stadium -> Point -> Double
angle' = flip angle

check :: Point -> [Stadium] -> IO ()
check a xs = do
  forM_ (zip [1..] xs) $ \(i,s) -> do
    let _ = i :: Int
    putStrLn $ printf "Stadium %d: %7.4f" i (angle a s)

readStadium :: IO Stadium
readStadium = do
  line <- getLine
  let (xs:ys:rs:_) = words line
      x = read xs
      y = read ys
      r = read rs
  return $ S (P x y) r

main = do
  [s1,s2,s3] <- replicateM 3 readStadium
  let sols = solve s1 s2 s3
  case sols of
    [] -> return ()
    _  -> do let (P x y) = maximumBy (comparing (angle' s1)) sols
             putStrLn $ printf "%.5f %.5f" x y

module Main where

import Text.Printf
import Data.List

-- Окружность
data Circle = Circle {
    center :: Point,
    radius :: Double
}

readCircle s = (Circle (Point (ins!!0) (ins!!1)) (ins!!2)) where
    ins = map read $ take 3 $ words s

-- Точка
data Point = Point {
    x :: Double,
    y :: Double
}

-- простые операции над точками
sumP (Point x1 y1) (Point x2 y2) = (Point (x1+x2) (y1+y2))
divP (Point x y) a = (Point (x/a) (y/a))

-- расстояние между точками
dist (Point x1 y1) (Point x2 y2) = sqrt (sq dx + sq dy) where
    dx = x1-x2
    dy = y1-y2

-- квадрат (для удобства)
sq a = a*a

-- угол, под которым видна окружность из точки (котангенсная мера)
cangle (Circle p r) p0 = (dist p p0)/r

-- квадратическое отклонение углов (мера точности равенства углов)
quadro cl1 cl2 cl3 p =
    sq (a1 - e) + sq (a2 - e) + sq (a3 - e) where
        a1 = cangle cl1 p
        a2 = cangle cl2 p
        a3 = cangle cl3 p
        e = (a1 + a2 + a3)/3

epsilon = 0.000001

main = do
    instr <- getContents
    let [cl1, cl2, cl3] = map readCircle $ take 3 $ lines instr
    let s = solution cl1 cl2 cl3
    if (quadro cl1 cl2 cl3 s) < epsilon then printf "%.5f %.5f\n" (x s) (y s)
                                        else return () where

        solution cl1 cl2 cl3 = findFinest mid (measure mid) 1.0 where

            findFinest point ds delta | delta < epsilon = point
            findFinest point ds delta = if (fst closer) < ds
                then findFinest (snd closer) (fst closer) delta
                else findFinest point ds (delta/1.4) where

                    closer = minimumBy (\(d1,_) (d2,_) -> compare d1 d2) $
                        zip (map measure candid) candid where
                            px = x point
                            py = y point
                            candid = [(Point (px+delta) py),
                                      (Point (px-delta) py),
                                      (Point px (py+delta)),
                                      (Point px (py-delta))]

            mid = (c1 `sumP` c2 `sumP` c3) `divP` 3.0

            measure = quadro cl1 cl2 cl3

            c1 = center cl1
            c2 = center cl2
            c3 = center cl3

module Main where

import Data.List

data Point = Point {
	x :: Double,
	y :: Double
} deriving (Show)

data Circle = Circle {
	c :: Point,
	r :: Double
} deriving (Show)

circleFromString :: String -> Circle
circleFromString s =
	Circle (Point (l !! 0) (l !! 1)) (l !! 2)
	where l = map read $ words s

pointAdd :: Point -> Point -> Point
pointAdd (Point x1 y1) (Point x2 y2) = Point (x1 + x2) (y1 + y2)

processInput :: String -> [Circle]
processInput = map circleFromString . lines

distance :: Point -> Point -> Double
distance (Point x1 y1) (Point x2 y2) =
	sqrt $ (x1 - x2) ** 2 + (y1 - y2) ** 2

angleToCircle :: Point -> Circle -> Double
angleToCircle p (Circle c r) =
	(distance c p) / r

squareMean :: [Double] -> Double
squareMean a =
	(sum $ map ((** 2) . (+ m)) a) / n
	where
		n = fromIntegral $ length a
		m = - sum a / n

tryPoint :: [Circle] -> Point -> Double
tryPoint circles p =
	squareMean $ map (angleToCircle p) $ circles
--	where
--		sumAngle = sum (map angleToCircle circles) / 3

iterateTry :: [Circle] -> Point -> Point
iterateTry cs startPoint =
	iter startPoint 1.0
	where
		iter p d
			| d < 1e-6 = p
			| (fst minimumPoint < currentDistance) = iter (snd minimumPoint) d
			| otherwise = iter p (d * 0.8)
			where
				currentDistance = tryPoint cs p
				measure = tryPoint cs
				tryList = [pointAdd p (Point 0 d), pointAdd p (Point d 0), pointAdd p (Point 0 (0-d)), pointAdd p (Point (0-d) 0)]
				minimumPoint = minimumBy (\(a, _) (b, _) -> compare a b) $ zip (map measure tryList) tryList

solve :: [Circle] -> Point
solve cs =
	let
		startPoint = Point { x = (sum $ map (x . c) cs) / 3, y = (sum $ map (y . c) cs) / 3 }
		endPoint = iterateTry cs startPoint
	in
		endPoint

main = do
	input <- getContents
	let
		circles = processInput input
		answer = solve circles
	if (tryPoint circles answer < 1e-6) then putStrLn $ (show $ x answer) ++ " " ++ (show $ y answer) else return ()

module Main where

import qualified Data.ByteString.Char8 as BS

import Control.Monad (replicateM, forM_)
import Data.Functor ((<&>))
import Data.List (foldl', minimumBy)
import Text.Printf (printf)

main :: IO ()
main = do
  result <- solve <$> replicateM 3 readCircle
  forM_ result $ \(Point x y) -> printf "%.5f %.5f\n" x y

readCircle :: IO Circle
readCircle = do
  [x, y, r] <- BS.getLine <&> map (read . BS.unpack) . BS.words
  pure $ Circle (Point x y) r

data Point = Point {
  x :: Double,
  y :: Double
} deriving (Show, Eq)

data Circle = Circle {
  center :: Point,
  radius :: Double
} deriving (Show)

eps :: Double
eps = 1e-6

isSmall :: Double -> Bool
isSmall = (< eps) . abs

angleWeight :: Point -> Circle -> Double
angleWeight p (Circle c r) = dist p c / r

sq :: Double -> Double
sq x = x * x

mse :: [Double] -> Double
mse ws = sqrt $ sum squares / n
  where
    (total, n) = foldl' step (0, 0) ws
    mean = total / n
    step (cw, cn) w1 = (cw + w1, cn + 1)
    squares = map (sq . (-) mean) ws

dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt $ sq (x1 - x2) + sq (y1 - y2)

initialGuess :: [Circle] -> Guess
initialGuess cs = toGuess cs $ Point (x / n) (y / n)
  where
    (n, Point x y) = foldl' step (0, Point 0 0) cs
    step (n, Point x1 y1) (Circle (Point x2 y2) _) = (n + 1, Point (x1 + x2) (y1 + y2))

meanError :: [Circle] -> Point -> Double
meanError cs p = mse $ map (angleWeight p) cs

toGuess :: [Circle] -> Point -> Guess
toGuess cs p = Guess p (meanError cs p)

findBestGuess :: [Circle] -> Guess
findBestGuess cs = solve0 (initialGuess cs) 1.0
  where
    candidates (Point x y) c = [Point (x + c) y, Point (x - c) y, Point x (y - c), Point x (y + c)]
    bestGuess = minimum. map (toGuess cs)
    solve0 g c | isSmall c = g
    solve0 g c = let nextGuess = bestGuess $ candidates (p g) c in
      if nextGuess < g then solve0 nextGuess c else solve0 g (c / 2)

data Guess = Guess {
    p :: Point,
    w :: Double
  } deriving (Show)

instance Eq Guess where
  (Guess _ w1) == (Guess _ w2) = w1 == w2

instance Ord Guess where
  compare (Guess _ w1) (Guess _ w2) = compare w1 w2

solve :: [Circle] -> Maybe Point
solve stadiums = if isSmall (w guess) then Just (p guess) else Nothing
    where
      guess = findBestGuess stadiums

module Main where

import qualified Data.ByteString.Char8 as BS

import Control.Monad (replicateM, forM_)
import Data.Functor ((<&>))
import Data.List (foldl', minimumBy)
import Text.Printf (printf)

main :: IO ()
main = do
  result <- solve <$> replicateM 3 readCircle
  forM_ result $ \(Point x y) -> printf "%.5f %.5f\n" x y

readCircle :: IO Circle
readCircle = do
  [x, y, r] <- BS.getLine <&> map (read . BS.unpack) . BS.words
  pure $ Circle (Point x y) r

data Point = Point {
  x :: Double,
  y :: Double
} deriving (Show, Eq)

data Circle = Circle {
  center :: Point,
  radius :: Double
} deriving (Show)

eps :: Double
eps = 1e-6

isSmall :: Double -> Bool
isSmall = (< eps) . abs

angleWeight :: Point -> Circle -> Double
angleWeight p (Circle c r) = dist p c / r

sq :: Double -> Double
sq x = x * x

mse :: [Double] -> Double
mse ws = sqrt $ sum squares / n
  where
    (total, n) = foldl' step (0, 0) ws
    mean = total / n
    step (cw, cn) w1 = (cw + w1, cn + 1)
    squares = map (sq . (-) mean) ws

dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt $ sq (x1 - x2) + sq (y1 - y2)

initialGuess :: [Circle] -> Guess
initialGuess cs = Guess p (meanError cs p)
  where
    (n, Point x y) = foldl' step (0, Point 0 0) cs
    step (n, Point x1 y1) (Circle (Point x2 y2) _) = (n + 1, Point (x1 + x2) (y1 + y2))
    p = Point (x / n) (y / n)

meanError :: [Circle] -> Point -> Double
meanError cs p = mse $ map (angleWeight p) cs

findBestGuess :: [Circle] -> Guess
findBestGuess cs = solve0 (initialGuess cs) 1.0
  where
    candidates (Point x y) c = [Point (x + c) y, Point (x - c) y, Point x (y - c), Point x (y + c)]
    bestGuess = minimum. map (\p -> Guess p (meanError cs p))
    solve0 g c | isSmall c = g
    solve0 g c = let nextGuess = bestGuess $ candidates (p g) c in
      if nextGuess < g then solve0 nextGuess c else solve0 g (c / 2)

data Guess = Guess {
    p :: Point,
    w :: Double
  } deriving (Show)

instance Eq Guess where
  (Guess _ w1) == (Guess _ w2) = w1 == w2

instance Ord Guess where
  compare (Guess _ w1) (Guess _ w2) = compare w1 w2

solve :: [Circle] -> Maybe Point
solve stadiums = if isSmall (w guess) then Just (p guess) else Nothing
    where
      guess = findBestGuess stadiums

module Main where

import qualified Data.ByteString.Char8 as BS

import Control.Monad (replicateM, forM_)
import Data.Functor ((<&>))
import Data.List (foldl', minimumBy)
import Text.Printf (printf)

main :: IO ()
main = do
  result <- solve <$> replicateM 3 readCircle
  forM_ result $ \(Point x y) -> printf "%.5f %.5f\n" x y

readCircle :: IO Circle
readCircle = do
  [x, y, r] <- BS.getLine <&> map (read . BS.unpack) . BS.words
  pure $ Circle (Point x y) r

data Point = Point {
  x :: !Double,
  y :: !Double
} deriving (Show, Eq)

data Circle = Circle {
  center :: !Point,
  radius :: !Double
} deriving (Show)

eps :: Double
eps = 1e-6

isSmall :: Double -> Bool
isSmall = (< eps) . abs

angleWeight :: Point -> Circle -> Double
angleWeight p (Circle c r) = dist p c / r

sq :: Double -> Double
sq x = x * x

mse :: [Double] -> Double
mse ws = sqrt $ sum squares / n
  where
    (total, n) = foldl' step (0, 0) ws
    mean = total / n
    step (cw, cn) w1 = (cw + w1, cn + 1)
    squares = map (sq . (-) mean) ws

dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt $ sq (x1 - x2) + sq (y1 - y2)

initialGuess :: [Circle] -> Guess
initialGuess cs = Guess p (meanError cs p)
  where
    (n, Point x y) = foldl' step (0, Point 0 0) cs
    step (n, Point x1 y1) (Circle (Point x2 y2) _) = (n + 1, Point (x1 + x2) (y1 + y2))
    p = Point (x / n) (y / n)

meanError :: [Circle] -> Point -> Double
meanError cs p = mse $ map (angleWeight p) cs

findBestGuess :: [Circle] -> Guess
findBestGuess cs = solve0 (initialGuess cs) 1.0
  where
    candidates (Point x y) c = [Point (x + c) y, Point (x - c) y, Point x (y - c), Point x (y + c)]
    bestGuess = minimum. map (\p -> Guess p (meanError cs p))
    solve0 g c | isSmall c = g
    solve0 g c = let nextGuess = bestGuess $ candidates (p g) c in
      if nextGuess < g then solve0 nextGuess c else solve0 g (c / 2)

data Guess = Guess {
    p :: !Point,
    w :: !Double
  } deriving (Show)

instance Eq Guess where
  (Guess _ w1) == (Guess _ w2) = w1 == w2

instance Ord Guess where
  compare (Guess _ w1) (Guess _ w2) = compare w1 w2

solve :: [Circle] -> Maybe Point
solve stadiums = if isSmall (w guess) then Just (p guess) else Nothing
    where
      guess = findBestGuess stadiums

import Data.List (transpose, minimumBy)
import Data.Function (on)
import Text.Printf

solve :: [[Double]] -> String
solve ps = find initP 1
  where
    coords = take 2 $ transpose ps
    initP = map ((/ 3) . sum) coords

    eval p = sum . map abs $ zipWith (-) thetas (tail . cycle $ thetas)
      where
        distToP = sum . take 2 . zipWith (-) p
        thetas = map (\[x, y, r] -> distToP [x, y] / r) ps

    find p@[x, y] d -- d for delta
      | d < 1e-6 = printf "%.5f %.5f\n" x y
      | fst bestCand < local = find (snd bestCand) d
      | otherwise = find p (d * 0.7)
      where
        points = [[x+d, y], [x-d, y], [x, y+d], [x, y-d]]
        cands = map (\cand -> (eval cand, cand)) points
        bestCand = minimumBy (compare `on` fst) cands
        local = eval [x, y]

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

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

data Vec = V Double Double
  deriving (Show,Eq)

(<+>) :: Vec -> Vec -> Vec
(<+>) (V a b) (V c d) = V (a+c) (b+d)

(<->) :: Vec -> Vec -> Vec
(<->) (V a b) (V c d) = V (a-c) (b-d)

infixl 6 <+>
infixl 6 <->

(<.>) :: Vec -> Vec -> Double
(<.>) (V a b) (V c d) = a*c + b*d

infixl 7 <.>

(.*) :: Double -> Vec -> Vec
(.*) a (V x y) = V (a*x) (a*y)

(./) :: Double -> Vec -> Vec
(./) a (V x y) = V (x/a) (y/a)

(/.) :: Vec -> Double -> Vec
(/.) (V x y) a = V (x/a) (y/a)

infixr 7 .*
infixr 7 ./
infixl 7 /.

norm2 :: Vec -> Double
norm2 v = v <.> v

len :: Vec -> Double
len = sqrt . norm2

normal :: Vec -> Vec
normal (V a b) = V (negate b) a

zero :: Double -> Bool
zero a = abs a < 1e-10

zeroVec :: Vec -> Bool
zeroVec (V a b) = zero a && zero b

same :: Double -> Double -> Bool
same x y = abs (x-y) < 1e-10

-- [Vec] is the list of centers
-- [Double] is the list of radii

solveProblem :: [Vec] -> [Double] -> [Vec]
solveProblem (av:bv:cv:_) (a:b:c:_)
  | same a b && same a c
      = intersectLines     ab1 ab0 ac1 ac0
  | same a b
      = intersectLineCircle ab1 ab0 (ac1 /. ac2) (ac0 / ac2)
  | otherwise
      = intersectCircles    (ab1 /. ab2) (ab0 / ab2)
                            (ac1 /. ac2) (ac0 / ac2)
  where
    a2 = a*a
    b2 = b*b
    c2 = c*c

    ab2 = b2 - a2
    ab1 = 2 .* (a2 .* bv <-> b2 .* av)
    ab0 = b2 * norm2 av - a2 * norm2 bv

    ac2 = c2 - a2
    ac1 = 2 .* (a2 .* cv <-> c2 .* av)
    ac0 = c2 * norm2 av - a2 * norm2 cv

{- Find the intersection of two lines given by:
 -   X.A + a = 0
 -   X.B + b = 0
 -}
intersectLines :: Vec -> Double -> Vec -> Double -> [Vec]
intersectLines av a bv b =
  let nvec = normal av
      x0   = ((negate a) / norm2 av) .* av
      t    = ((negate b) - x0 <.> bv) / (nvec <.> bv)
  in
  if zero $ nvec <.> bv
    then []
    else [ x0 <+> t .* nvec ]

{- Find the intersection of a line:
 -         X.A + a = 0
 - and a parabola:
 -   X.X + X.B + b = 0
 -}
intersectLineCircle :: Vec -> Double -> Vec -> Double -> [Vec]
intersectLineCircle av a bv b =
  let nvec = normal av
      x0   = ((negate a) / norm2 av) .* av
      a2   = norm2 nvec
      a1   = 2 * (nvec <.> x0) + nvec <.> bv
      a0   = bv <.> x0 + b
      ts   = solveQuadratic a2 a1 a0
  in [ x0 <+> t .* nvec | t <- ts ]

intersectCircles :: Vec -> Double -> Vec -> Double -> [Vec]
intersectCircles avec a bvec b = do
  let dvec    = avec <-> bvec
      d       = a - b
      nvec    = normal dvec
      d2      = dvec <.> dvec
      x0vec   = ((b-a)/d2) .* dvec
      a2      = nvec <.> nvec
      a1      = nvec <.> avec
      a0      = (x0vec <.> x0vec) + (x0vec <.> avec) + a
      ts      = solveQuadratic a2 a1 a0
  -- putStrLn $ " a2,a1,a0: " ++ show [a2,a1,a0]
  let b2      = nvec <.> nvec
      b1      = nvec <.> bvec
      b0      = x0vec <.> x0vec + x0vec <.> bvec + b
  -- putStrLn $ " b2,b1,b0: " ++ show [b2,b1,b0]
  t <- ts
  let xvec = t .* nvec <+> x0vec
  let e1 = xvec <.> xvec + xvec <.> avec + a
      e2 = xvec <.> xvec + xvec <.> bvec + b
  return xvec
    -- putStrLn $ "Solution: t = " ++ show t
    -- putStrLn $ "          x = " ++ show xvec
    -- putStrLn $ "         e1 = " ++ show e1
    -- putStrLn $ "         e2 = " ++ show e1

-- solve a*x^2 + b*x + c == 0
solveQuadratic :: Double -> Double -> Double -> [Double]
solveQuadratic a b c =
  case compare d 0 of
    EQ -> [ -b/(2*a) ]
    LT -> []
    GT -> [ (-b - sqrtd) / (2*a),  (-b + sqrtd) / (2*a) ]
  where d = b*b-4*a*c
        sqrtd = sqrt d

readStadium :: IO (Vec,Double)
readStadium = do
  line <- getLine
  let (xs:ys:rs:_) = words line
      x = read xs
      y = read ys
      r = read rs
  return (V x y, r)

main = do
  (av,a) <- readStadium
  (bv,b) <- readStadium
  (cv,c) <- readStadium
  let sols = solveProblem [av,bv,cv] [a,b,c]
  case sols of
    []             -> return ()
    (V x y):_      -> putStrLn $ printf "%.6f %.6f" x y

import Data.Maybe
import Text.Printf

(-->) = flip fmap

type Triple = (Double,Double,Double)

readTriple :: String -> Triple
readTriple s = let (x:y:r:_) = map read $ words s in (x,y,r)

dist x1 y1 x2 y2 = sqrt (dx*dx + dy*dy)
  where dx = x1 - x2
        dy = y1 - y2

eps = 1e-10

solve :: Triple -> Triple -> Triple -> Maybe (Double,Double)
solve (x1,y1,r1) (x2,y2,r2) (x3,y3,r3) =
  let a = r1 / (r1+r2)
      x = x1*a + x2*(1-a)
      y = y1*a + y2*(1-a)
      d = dist x1 y1 x2 y2
      d2 = d*a
      d3 = dist x y x3 y3
  in if abs (d3/r3 - d2/r2) < eps then Just (x,y) else Nothing

main = do
  p1 <- getLine --> readTriple
  p2 <- getLine --> readTriple
  p3 <- getLine --> readTriple
  case catMaybes [ solve p1 p2 p3, solve p2 p3 p1, solve p3 p1 p2 ] of
    ((x,y):_) -> putStrLn $ printf "%.5f %.5f" x y
    otherwise -> return ()

import Control.Monad (replicateM,forM,forM_)
import Text.Printf (printf)
import Data.List (maximumBy)
import Data.Ord (comparing)

data Point = P Double Double
  deriving (Show)

data Line =   L Point Double   -- x $. p     == c (p /= 0)
  deriving (Show)

data Circle = C Point Double   -- (x $. p)^2 == c (c > 0)
  deriving (Show)

center :: Circle -> Point
center (C a _) = a

radius2 :: Circle -> Double
radius2 (C _ r2) = r2

data Stadium = S Point Double
  deriving (Show)

epsilon = 1e-8

same :: Double -> Double -> Bool
same a b = abs (a-b) <= epsilon

($+) (P x1 y1) (P x2 y2) = P (x1+x2) (y1+y2)
($-) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)
($*) (P x y) a = P (x*a) (y*a)
($/) (P x y) a = P (x/a) (y/a)
($.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

perp :: Point -> Point
perp (P x y) = (P y (negate x))

norm2 :: Point -> Double
norm2 p = p $. p

lineDistance :: Line -> Point -> Double
lineDistance (L a c) p = abs ((a $. p) - c) / sqrt (a $. a)

lineDistance2 :: Line -> Point -> Double
lineDistance2 (L a c) p = ((a $. p) - c)^(2 :: Int)/(a $. a)

onCircle :: Circle -> Point -> Bool
onCircle (C a r) b = same (norm2 (b $- a)) r

onLine :: Line -> Point -> Bool
onLine (L a c) p = same (a $. p) c

bisector :: Point -> Point -> Line
bisector p1 p2 = L n c
  where
    n = (p2 $- p1)
    x0 = (p1 $+ p2) $/ 2
    c = x0 $. n

-- return the solution circle for two stadiums
bicircle :: Stadium -> Stadium -> Circle
bicircle (S a ra) (S b rb) = C c rr   -- r1 /= r2
  where
    a2 = a $. a
    b2 = b $. b
    ra2 = ra*ra
    rb2 = rb*rb
    c  = ((a $* rb2) $- (b $* ra2)) $/ (rb2 - ra2)
    rr = (c $. c) - (rb2 * a2 - ra2 * b2) / (rb2 - ra2)

intersectLines :: Line -> Line -> [ Point ]
intersectLines (L (P a b) e) (L (P c d) f)
  | det == 0 = []
  | otherwise = [ P (x'/det) (y'/det) ]
  where
    det = a*d - b*c
    x'  = e*d - b*f
    y'  = a*f - c*e

-- solve a*x^2 + b*x + c == 0
solveQuadratic :: Double -> Double -> Double -> [Double]
solveQuadratic a b c =
  case compare d 0 of
    EQ -> [ -b/(2*a) ]
    LT -> []
    GT -> [ (-b - sqrtd) / (2*a),  (-b + sqrtd) / (2*a) ]
  where d = b*b-4*a*c
        sqrtd = sqrt d

toParametric :: Line -> (Point,Point)
toParametric (L (P a b) c)
  | a /= 0 = let p1 = P (c/a) 0
                 p2 = P ((c-b)/a) 1
             in (p1, p2 $- p1)
  | b /= 0 = let p1 = P 0 (c/b)
                 p2 = P 1 ((c-a)/b)
             in (p1, p2 $- p1)

intersectLineCircle :: Line -> Circle -> [ Point ]
intersectLineCircle l (C q rr) = map (\t -> a $+ (b $* t)) ts
  where
    (a,b) = toParametric l
    a2    = b $. b
    a1    = ((a $- q) $. b) * 2
    a0    = ((a $- q) $. (a $- q)) - rr
    ts    = solveQuadratic a2 a1 a0

intersectCircles :: Circle -> Circle -> [ Point ]
intersectCircles (C a r1) (C b r2) = intersectLineCircle line (C b r2)
  where
    c = (r1 - r2 - (a $. a) + (b $. b)) / 2
    line = L (b $- a) c

solve :: Stadium -> Stadium -> Stadium -> [ Point ]
solve s1@(S p1 r1) s2@(S p2 r2) s3@(S p3 r3)
  | r1 == r2 && r1 == r3 = intersectLines      (bisector p1 p2) (bisector p1 p3)
  | r1 == r2             = intersectLineCircle (bisector p1 p2) (bicircle s1 s3)
  | otherwise            = intersectCircles    (bicircle s1 s2) (bicircle s1 s3)

mkStadium a b c = S (P a b) c

s1 = mkStadium 0 0 30
s2 = mkStadium 300 300 30
s3 = mkStadium 500 (-500) 20

angle :: Point -> Stadium -> Double
angle a (S b r) = r / sqrt (norm2 (a $- b))

angle' :: Stadium -> Point -> Double
angle' = flip angle

check :: Point -> [Stadium] -> IO ()
check a xs = do
  forM_ (zip [1..] xs) $ \(i,s) -> do
    let _ = i :: Int
    putStrLn $ printf "Stadium %d: %7.4f" i (angle a s)

readStadium :: IO Stadium
readStadium = do
  line <- getLine
  let (xs:ys:rs:_) = words line
      x = read xs
      y = read ys
      r = read rs
  return $ S (P x y) r

main = do
  [s1,s2,s3] <- replicateM 3 readStadium
  let sols = solve s1 s2 s3
  case sols of
    [] -> return ()
    _  -> do let (P x y) = maximumBy (comparing (angle' s1)) sols
             putStrLn $ printf "%.5f %.5f" x y

import Control.Monad (replicateM,forM,forM_)
import Text.Printf (printf)

data Point = P Double Double
  deriving (Show)

data Line =   L Point Double   -- x $. p     == c (p /= 0)
  deriving (Show)

data Circle = C Point Double   -- (x $. p)^2 == c (c > 0)
  deriving (Show)

center :: Circle -> Point
center (C a _) = a

radius2 :: Circle -> Double
radius2 (C _ r2) = r2

data Stadium = S Point Double
  deriving (Show)

epsilon = 1e-8

same :: Double -> Double -> Bool
same a b = abs (a-b) <= epsilon

($+) (P x1 y1) (P x2 y2) = P (x1+x2) (y1+y2)
($-) (P x1 y1) (P x2 y2) = P (x1-x2) (y1-y2)
($*) (P x y) a = P (x*a) (y*a)
($/) (P x y) a = P (x/a) (y/a)
($.) (P x1 y1) (P x2 y2) = x1*x2 + y1*y2

perp :: Point -> Point
perp (P x y) = (P y (negate x))

norm2 :: Point -> Double
norm2 p = p $. p

lineDistance :: Line -> Point -> Double
lineDistance (L a c) p = abs ((a $. p) - c) / sqrt (a $. a)

lineDistance2 :: Line -> Point -> Double
lineDistance2 (L a c) p = ((a $. p) - c)^(2 :: Int)/(a $. a)

onCircle :: Circle -> Point -> Bool
onCircle (C a r) b = same (norm2 (b $- a)) r

onLine :: Line -> Point -> Bool
onLine (L a c) p = same (a $. p) c

bisector :: Point -> Point -> Line
bisector p1 p2 = L n c
  where
    n = (p2 $- p1)
    x0 = (p1 $+ p2) $/ 2
    c = x0 $. n

-- return the solution circle for two stadiums
bicircle :: Stadium -> Stadium -> Circle
bicircle (S a ra) (S b rb) = C c rr   -- r1 /= r2
  where
    a2 = a $. a
    b2 = b $. b
    ra2 = ra*ra
    rb2 = rb*rb
    c  = ((a $* rb2) $- (b $* ra2)) $/ (rb2 - ra2)
    rr = (c $. c) - (rb2 * a2 - ra2 * b2) / (rb2 - ra2)

intersectLines :: Line -> Line -> [ Point ]
intersectLines (L (P a b) e) (L (P c d) f)
  | det == 0 = []
  | otherwise = [ P (x'/det) (y'/det) ]
  where
    det = a*d - b*c
    x'  = e*d - b*f
    y'  = a*f - c*e

-- solve a*x^2 + b*x + c == 0
solveQuadratic :: Double -> Double -> Double -> [Double]
solveQuadratic a b c =
  case compare d 0 of
    EQ -> [ -b/(2*a) ]
    LT -> []
    GT -> [ (-b - sqrtd) / (2*a),  (-b + sqrtd) / (2*a) ]
  where d = b*b-4*a*c
        sqrtd = sqrt d

toParametric :: Line -> (Point,Point)
toParametric (L (P a b) c)
  | a /= 0 = let p1 = P (c/a) 0
                 p2 = P ((c-b)/a) 1
             in (p1, p2 $- p1)
  | b /= 0 = let p1 = P 0 (c/b)
                 p2 = P 1 ((c-a)/b)
             in (p1, p2 $- p1)

intersectLineCircle :: Line -> Circle -> [ Point ]
intersectLineCircle l (C q rr) = map (\t -> a $+ (b $* t)) ts
  where
    (a,b) = toParametric l
    a2    = b $. b
    a1    = ((a $- q) $. b) * 2
    a0    = ((a $- q) $. (a $- q)) - rr
    ts    = solveQuadratic a2 a1 a0

intersectCircles :: Circle -> Circle -> [ Point ]
intersectCircles (C a r1) (C b r2) = intersectLineCircle line (C b r2)
  where
    c = (r1 - r2 - (a $. a) + (b $. b)) / 2
    line = L (b $- a) c

solve :: Stadium -> Stadium -> Stadium -> [ Point ]
solve s1@(S p1 r1) s2@(S p2 r2) s3@(S p3 r3)
  | r1 == r2 && r1 == r3 = intersectLines      (bisector p1 p2) (bisector p1 p3)
  | r1 == r2             = intersectLineCircle (bisector p1 p2) (bicircle s1 s3)
  | otherwise            = intersectCircles    (bicircle s1 s2) (bicircle s1 s3)

readStadium :: IO Stadium
readStadium = do
  line <- getLine
  let (xs:ys:rs:_) = words line
      x = read xs
      y = read ys
      r = read rs
  return $ S (P x y) r

main = do
  [s1,s2,s3] <- replicateM 3 readStadium
  let sols = solve s1 s2 s3
  case sols of
    []             -> return ()
    (P x y):_      -> putStrLn $ printf "%.5f %.5f" x y

module Main where

import Data.List

data Point = Point {
	x :: Double,
	y :: Double
} deriving (Show)

data Circle = Circle {
	c :: Point,
	r :: Double
} deriving (Show)

circleFromString :: String -> Circle
circleFromString s =
	Circle (Point (l !! 0) (l !! 1)) (l !! 2)
	where l = map read $ words s

pointAdd :: Point -> Point -> Point
pointAdd (Point x1 y1) (Point x2 y2) = Point (x1 + x2) (y1 + y2)

processInput :: String -> [Circle]
processInput = map circleFromString . lines

distance :: Point -> Point -> Double
distance (Point x1 y1) (Point x2 y2) =
	sqrt $ (x1 - x2) ** 2 + (y1 - y2) ** 2

angleToCircle :: Point -> Circle -> Double
angleToCircle p (Circle c r) =
	(distance c p) / r

squareMean :: [Double] -> Double
squareMean a =
	(sum $ map ((** 2) . (+ m)) a) / n
	where
		n = fromIntegral $ length a
		m = - sum a / n

tryPoint :: [Circle] -> Point -> Double
tryPoint circles p =
	squareMean $ map (angleToCircle p) $ circles
--	where
--		sumAngle = sum (map angleToCircle circles) / 3

iterateTry :: [Circle] -> Point -> Point
iterateTry cs startPoint =
	iter startPoint 1.0
	where
		iter p d
			| d < 1e-6 = p
			| (fst minimumPoint < currentDistance) = iter (snd minimumPoint) d
			| otherwise = iter p (d * 0.8)
			where
				currentDistance = tryPoint cs p
				measure = tryPoint cs
				tryList = [pointAdd p (Point 0 d), pointAdd p (Point d 0), pointAdd p (Point 0 (0-d)), pointAdd p (Point (0-d) 0)]
				minimumPoint = minimumBy (\(a, _) (b, _) -> compare a b) $ zip (map measure tryList) tryList

solve :: [Circle] -> String
solve cs =
	let
		startPoint = Point { x = (sum $ map (x . c) cs) / 3, y = (sum $ map (y . c) cs) / 3 }
		endPoint = iterateTry cs startPoint
	in (show (x endPoint)) ++ " " ++ (show (y endPoint))

main = do
	input <- getContents
	let circles = processInput input
	putStrLn $ solve circles

module Main where

import qualified Data.ByteString.Char8 as BS

import Control.Monad (replicateM)
import Data.Functor ((<&>))
import Data.List (foldl', minimumBy)
import Text.Printf (printf)

stadiums = [
    Circle (Point 0 0) 10,
    Circle (Point 60 0) 10,
    Circle (Point 30 30) 10
  ]

main :: IO ()
main = do
  result <- solve <$> replicateM 3 readCircle
  case result of
    Just (Point x y) -> printf "%.5f %.5f\n" x y
    _ -> return ()

readCircle :: IO Circle
readCircle = do
  [x, y, r] <- BS.getLine <&> map (read . BS.unpack) . BS.words
  pure $ Circle (Point x y) r

data Point = Point {
  x :: Double,
  y :: Double
} deriving (Show, Eq)

data Circle = Circle {
  center :: Point,
  radius :: Double
} deriving (Show)

eps :: Double
eps = 1e-8

isSmall :: Double -> Bool
isSmall = (< eps) . abs

angleWeight :: Point -> Circle -> Double
angleWeight p (Circle c r) = dist p c / r

mean :: [Double] -> Double
mean ws = total / n
  where
    (total, n) = foldl' step (0, 0) ws
    step (cw, cn) w1 = (cw + w1, cn + 1)

sq :: Double -> Double
sq x = x * x

squareMean :: [Double] -> Double
squareMean ws = sqrt . sum . map (sq . (-) m) $ ws
  where
    m = mean ws

dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt $ sq (x1 - x2) + sq (y1 - y2)

initialGuess :: [Circle] -> Point
initialGuess circles = Point (x / n) (y / n)
  where
    (n, Point x y) = foldl' step (0, Point 0 0) circles
    step (n, Point x1 y1) (Circle (Point x2 y2) _) = (n + 1, Point (x1 + x2) (y1 + y2))

minimumOn :: (Ord b) => (a -> b) -> [a] -> a
minimumOn c = minimumBy (\x y -> compare (c x) (c y))

meanWeight :: [Circle] -> Point -> Double
meanWeight stadiums p = squareMean $ map (angleWeight p) stadiums

findBestGuess :: [Circle] -> Point
findBestGuess stadiums = solve0 (initialGuess stadiums) 1.0
  where
    candidates cur@(Point x y) c = [Point (x + c) y, Point (x - c) y, cur, Point x (y - c), Point x (y + c)]
    bestMatch = minimumOn (meanWeight stadiums)
    solve0 p c | c < 1e-6 = p
    solve0 p c = let nextGuess = bestMatch $ candidates p c in
      solve0 nextGuess (if nextGuess == p then c / 2 else c)

isGood :: [Circle] -> Point -> Bool
isGood stadiums guess = isSmall (meanWeight stadiums guess)

solve :: [Circle] -> Maybe Point
solve stadiums = if isGood stadiums guess then Just guess else Nothing
    where
      guess = findBestGuess stadiums

module Main where

import qualified Data.ByteString.Char8 as BS

import Control.Monad (replicateM, forM_)
import Data.Functor ((<&>))
import Data.List (foldl', minimumBy)
import Text.Printf (printf)

main :: IO ()
main = do
  result <- solve <$> replicateM 3 readCircle
  forM_ result $ \(Point x y) -> printf "%.5f %.5f\n" x y

readCircle :: IO Circle
readCircle = do
  [x, y, r] <- BS.getLine <&> map (read . BS.unpack) . BS.words
  pure $ Circle (Point x y) r

data Point = Point {
  x :: Double,
  y :: Double
} deriving (Show, Eq)

data Circle = Circle {
  center :: Point,
  radius :: Double
} deriving (Show)

eps :: Double
eps = 1e-8

isSmall :: Double -> Bool
isSmall = (< eps) . abs

angleWeight :: Point -> Circle -> Double
angleWeight p (Circle c r) = dist p c / r

mean :: [Double] -> Double
mean ws = total / n
  where
    (total, n) = foldl' step (0, 0) ws
    step (cw, cn) w1 = (cw + w1, cn + 1)

sq :: Double -> Double
sq x = x * x

squareMean :: [Double] -> Double
squareMean ws = sqrt . sum . map (sq . (-) m) $ ws
  where
    m = mean ws

dist :: Point -> Point -> Double
dist (Point x1 y1) (Point x2 y2) = sqrt $ sq (x1 - x2) + sq (y1 - y2)

initialGuess :: [Circle] -> Point
initialGuess circles = Point (x / n) (y / n)
  where
    (n, Point x y) = foldl' step (0, Point 0 0) circles
    step (n, Point x1 y1) (Circle (Point x2 y2) _) = (n + 1, Point (x1 + x2) (y1 + y2))

minimumOn :: (Ord b) => (a -> b) -> [a] -> a
minimumOn c = minimumBy (\x y -> compare (c x) (c y))

meanWeight :: [Circle] -> Point -> Double
meanWeight stadiums p = squareMean $ map (angleWeight p) stadiums

findBestGuess :: [Circle] -> Point
findBestGuess stadiums = solve0 (initialGuess stadiums) 1.0
  where
    candidates cur@(Point x y) c = [Point (x + c) y, Point (x - c) y, cur, Point x (y - c), Point x (y + c)]
    bestMatch = minimumOn (meanWeight stadiums)
    solve0 p c | c < 1e-6 = p
    solve0 p c = let nextGuess = bestMatch $ candidates p c in
      solve0 nextGuess (if nextGuess == p then c / 2 else c)

isGood :: [Circle] -> Point -> Bool
isGood stadiums guess = isSmall (meanWeight stadiums guess)

solve :: [Circle] -> Maybe Point
solve stadiums = if isGood stadiums guess then Just guess else Nothing
    where
      guess = findBestGuess stadiums


n people are standing on a coordinate axis in points with positive integer coordinates strictly less than 106. For each person we know in which direction (left or right) he is facing, and his maximum speed.You can put a bomb in some point with non-negative integer coordinate, and blow it up. At this moment all people will start running with their maximum speed in the direction they are facing. Also, two strange rays will start propagating from the bomb with speed s: one to the right, and one to the left. Of course, the speed s is strictly greater than people's maximum speed.The rays are strange because if at any moment the position and the direction of movement of some ray and some person coincide, then the speed of the person immediately increases by the speed of the ray.You need to place the bomb is such a point that the minimum time moment in which there is a person that has run through point 0, and there is a person that has run through point 106, is as small as possible. In other words, find the minimum time moment t such that there is a point you can place the bomb to so that at time moment t some person has run through 0, and some person has run through point 106.

The first line contains two integers n and s (2 ≤ n ≤ 105, 2 ≤ s ≤ 106) — the number of people and the rays' speed. The next n lines contain the description of people. The i-th of these lines contains three integers xi, vi and ti (0 < xi < 106, 1 ≤ vi < s, 1 ≤ ti ≤ 2) — the coordinate of the i-th person on the line, his maximum speed and the direction he will run to (1 is to the left, i.e. in the direction of coordinate decrease, 2 is to the right, i.e. in the direction of coordinate increase), respectively. It is guaranteed that the points 0 and 106 will be reached independently of the bomb's position.

Print the minimum time needed for both points 0 and 106 to be reached. Your answer is considered correct if its absolute or relative error doesn't exceed 10 - 6. Namely, if your answer is a, and the jury's answer is b, then your answer is accepted, if .

NoteIn the first example, it is optimal to place the bomb at a point with a coordinate of 400000. Then at time 0, the speed of the first person becomes 1000 and he reaches the point 106 at the time 600. The bomb will not affect on the second person, and he will reach the 0 point at the time 500000.In the second example, it is optimal to place the bomb at the point 500000. The rays will catch up with both people at the time 200. At this time moment, the first is at the point with a coordinate of 300000, and the second is at the point with a coordinate of 700000. Their speed will become 1500 and at the time 400 they will simultaneously run through points 0 and 106.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.List
import Data.Int
import Data.Array.Unboxed

data P = P {-# UNPACK #-} !Int64 {-# UNPACK #-} !Int64 deriving (Eq, Ord)

main = do
  [n, s] <- fmap readInts B.getLine
  ps <- replicateM n $ fmap ((\[x, v, d] -> P (fromIntegral x) (fromIntegral $ if d == 1 then -v else v)) . readInts) B.getLine
  print $ solve (fromIntegral s) ps

solve s ps = minimum $ zipWith max tls trs
  where
    hi = 1000000 :: Int64
    (ls, rs) = partition (\(P _ pv) -> pv < 0) $ sort ps
    tls = snd $ mapAccumL (go (\x px pv -> if x * pv > -s * px then toD (x * s + pv * px) / toD (s * s - pv * pv) else -1) (minimum $ map (\(P px pv) -> toD (-px) / toD pv) ls)) (Nothing, ls) [1..hi - 1]
    trs = elems (array (1, hi - 1) $ zip [hi - 1, hi - 2..1] $ snd $ mapAccumL (go (\x px pv -> let x' = hi - x; px' = hi - px in if x' * pv < s * px' then toD (x' * s - pv * px') / toD (s * s - pv * pv) else -1) (minimum $ map (\(P px pv) -> toD (hi - px) / toD pv) rs)) (Nothing, reverse rs) [hi - 1, hi - 2..1] :: UArray Int64 Double)
    go clock (!m) st@(!mp', !pps) (!x)
      | (p@(P !px !pv):ps) <- pps, x == px = ((Just p, ps), min m $ clock x px pv)
      | Just (P !px' !pv') <- mp' = let t' = clock x px' pv' in if t' > 0 then (st, min m t') else ((Nothing, pps), m)
      | otherwise = (st, m)

toD x = fromIntegral x :: Double

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Data.List
import Data.Int
import Data.Array.Unboxed

main = do
  [n, s] <- fmap readInts B.getLine
  ps <- replicateM n $ fmap ((\[x, v, d] -> (fromIntegral x, fromIntegral $ if d == 1 then -v else v)) . readInts) B.getLine
  print $ solve (fromIntegral s) ps

solve s ps = minimum $ zipWith max tls trs
  where
    hi = 1000000 :: Int64
    (ls, rs) = partition ((< 0) . snd) $ sort ps
    tls = snd $ mapAccumL (go (\x px pv -> if x * pv > -s * px then toD (x * s + pv * px) / toD (s * s - pv * pv) else -1) (minimum $ map (\(px, pv) -> toD (-px) / toD pv) ls)) (Nothing, ls) [1..hi - 1]
    trs = elems (array (1, hi - 1) $ zip [hi - 1, hi - 2..1] $ snd $ mapAccumL (go (\x px pv -> let x' = hi - x; px' = hi - px in if x' * pv < s * px' then toD (x' * s - pv * px') / toD (s * s - pv * pv) else -1) (minimum $ map (\(px, pv) -> toD (hi - px) / toD pv) rs)) (Nothing, reverse rs) [hi - 1, hi - 2..1] :: UArray Int64 Double)
    go clock m st@(mp', pps) x
      | (p@(px, pv):ps) <- pps, x == px = ((Just p, ps), min m $ clock x px pv)
      | Just (px', pv') <- mp' = let t' = clock x px' pv' in if t' > 0 then (st, min m t') else ((Nothing, pps), m)
      | otherwise = (st, m)

toD x = fromIntegral x :: Double

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

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

main = do
  [n, s] <- fmap readInts B.getLine
  ps <- replicateM n $ fmap ((\[x, v, d] -> (fromIntegral x, fromIntegral $ if d == 1 then -v else v)) . readInts) B.getLine
  print $ solve (fromIntegral s) ps

solve s ps = minimum $ zipWith max tls trs
  where
    hi = 1000000 :: Int64

    (ls, rs) = partition ((< 0) . snd) $ sortBy (comparing fst) ps

    tls = snd $ mapAccumL (go clock m) (Nothing, ls) [1..hi - 1]
      where
        m = minimum $ map (\(px, pv) -> toD (-px) / toD pv) ls
        clock x px pv
          | x * pv > -s * px = toD (x * s + pv * px) / toD (s * s - pv * pv)
          | otherwise = -1

    trs = snd $ mapAccumR (go clock m) (Nothing, rs) [1..hi - 1]
      where
        m = minimum $ map (\(px, pv) -> toD (hi - px) / toD pv) rs
        clock x px pv
          | x' * pv < s * px' = toD (x' * s - pv * px') / toD (s * s - pv * pv)
          | otherwise = -1
          where
            x' = hi - x
            px' = hi - px

    go _ m st@(Nothing, []) _ = (st, m)
    go clock m st@(Nothing, p@(px, pv):ps) x
      | x == px = let t = clock x px pv in if t > 0 then ((Just p, ps), min m t) else ((Nothing, ps), m)
      | otherwise = (st, m)
    go clock m st@(Just (px, pv), []) x = (st, min m $ clock x px pv)
    go clock m (mp@(Just (mpx, mpv)), p@(px, pv):ps) x
      | t' > 0 && t' < t = ((Just p, ps), min t' m)
      | otherwise = ((mp, ps), min t m)
      where
        t' = clock x px pv
        t = clock x mpx mpv

toD x = fromIntegral x :: Double

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

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

data Person = Person !Double !Double deriving Show

main = do
  [n, s] <- fmap readInts B.getLine
  ps <- replicateM n $ fmap ((\[x, v, d] -> Person (toD x) (toD $ if d == 1 then -v else v)) . readInts) B.getLine
  print $ solve (toD s) ps

solve s ps = clock $ toD $ go 1 hi
  where
    (ls, rs) = partition (\(Person _ v) -> v < 0) ps
    hi = 1000000 :: Int
    hiD = toD hi

    go l r
      | r - l <= 1 = l
      | otherwise = if clock (toD m) > clock (toD l) then go l m else go m r
      where m = (l + r) `div` 2

    clock x = max (minimum tls) (minimum trs)
      where
        tls = map (\(Person px pv) -> let t1 = (px - x) / (-s - pv); x' = x + (-s) * t1 in if px > x || x' <= 0 then (-px) / pv else let t2 = (-x') / (-s + pv) in t1 + t2) ls
        trs = map (\(Person px pv) -> let t1 = (px - x) / (s - pv); x' = x + s * t1 in if px < x || x' >= hiD then (hiD - px) / pv else let t2 = (hiD - x') / (s + pv) in t1 + t2) rs

toD x = fromIntegral x :: Double

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


You are given $$$4n$$$ sticks, the length of the $$$i$$$-th stick is $$$a_i$$$.You have to create $$$n$$$ rectangles, each rectangle will consist of exactly $$$4$$$ sticks from the given set. The rectangle consists of four sides, opposite sides should have equal length and all angles in it should be right. Note that each stick can be used in only one rectangle. Each stick should be used as a side, you cannot break the stick or use it not to the full length.You want to all rectangles to have equal area. The area of the rectangle with sides $$$a$$$ and $$$b$$$ is $$$a \cdot b$$$.Your task is to say if it is possible to create exactly $$$n$$$ rectangles of equal area or not.You have to answer $$$q$$$ independent queries.

The first line of the input contains one integer $$$q$$$ ($$$1 \le q \le 500$$$) — the number of queries. Then $$$q$$$ queries follow. The first line of the query contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) — the number of rectangles. The second line of the query contains $$$4n$$$ integers $$$a_1, a_2, \dots, a_{4n}$$$ ($$$1 \le a_i \le 10^4$$$), where $$$a_i$$$ is the length of the $$$i$$$-th stick.

For each query print the answer to it. If it is impossible to create exactly $$$n$$$ rectangles of equal area using given sticks, print "NO". Otherwise print "YES".

import Control.Monad
import Data.List

readInt = do
    raw_q <- getLine
    let q = read raw_q :: Int
    return q

readlist = do
    inp <- getLine
    return $ map read (words inp)

main = do
    q <- readInt
    submain q
    return q

submain :: Int -> IO ()
submain q = do
    when (q > 0) $ do
        sz <- readInt
        v <- readlist
        putStrLn $ if (solve (sort v)) then "YES" else "NO"
        submain $ q - 1
        return ()

countDupList v@(x:xs) = (x, length v)

groupToTuple x = map countDupList $ group x

solve :: [Int] -> Bool
solve v =
    canFormEqAreaRec v rv (head v * head rv)
    where rv = reverse v

canFormEqAreaRec [] [] _ = True
canFormEqAreaRec (x0:x1:xs) (y0:y1:ys) area =
    x0 == x1 && y0 == y1 && x0 * y0 == area &&
    canFormEqAreaRec xs ys area

import Control.Monad
import Data.List

main = do
    q <- readInt
    submain q
    return q

readInt = do
    raw_q <- getLine
    let q = read raw_q :: Int
    return q

readlist = do
    inp <- getLine
    let v = words inp
    let ret = map read v
    return ret

submain:: Int -> IO ()
submain q = do
    when (q > 0) $ do
        sz <- readInt
        v <- readlist
        putStrLn $ if (solve v) then "YES" else "NO"
        submain $ q - 1
        return ()

solve :: [Int] -> Bool
solve v =
    isPaired v' && canFormEqAreaRec v' rv' 0
    where
        v' = group $ sort v
        rv' = reverse v'

isPaired :: [[Int]] -> Bool
isPaired = all (even . length)

canFormEqAreaRec :: [[Int]] -> [[Int]] -> Int -> Bool
canFormEqAreaRec [] [] _ = True
canFormEqAreaRec v rv 0 =
    canFormEqAreaRec v rv (x0 * y0)
    where
        x:xs = v
        y:ys = rv
        x0:xx = x
        y0:yy = y

canFormEqAreaRec (x:xs) (y:ys) area =
    length x == length y &&
    x0 * y0 == area &&
    canFormEqAreaRec xs ys area
    where
        x0:xx = x
        y0:yy = y

import qualified Data.List as L

readInts :: IO [Int]
readInts = do
    input <- getLine
    return $ map read . words $ input

splitOnHalf :: [a] -> ([a], [a])
splitOnHalf xs = (take half xs, drop half xs)
    where half = div (length xs) 2

equalArea :: [Int] -> [Int] -> Int -> Bool

equalArea [] [] _ = True
equalArea (x1:x2:xs) (y1:y2:ys) area =
    x1 == x2 && y1 == y2 && (x1 * y2) == area && equalArea xs ys area

solve :: [Int] -> Bool
solve xs =
    equalArea s b' $ (head s) * (head b')
    where
        b' = reverse b
        (s, b) = splitOnHalf xs

handleCase :: Int -> IO ()

handleCase 0 = do return ()
handleCase t = do
    n <- getLine
    a <- readInts
    putStrLn $ if solve(L.sort a) == True then "YES" else "NO"
    handleCase(t-1)

main = do
    t <- getLine
    handleCase (read t)

import qualified Data.List as L

readInts :: IO [Int]
readInts = do
    input <- getLine
    return $ map read . words $ input

splitOnHalf :: [a] -> ([a], [a])
splitOnHalf xs = (take half xs, drop half xs)
    where half = div (length xs) 2

equalArea :: [Int] -> [Int] -> Int -> Bool

equalArea [] [] _ = True
equalArea (x1:x2:xs) (y1:y2:ys) area =
    x1 == x2 && y1 == y2 && (x1 * y2) == area && equalArea xs ys area

solve :: [Int] -> Bool
solve xs =
    equalArea s b $ (head s) * (head b)
    where (s, b) = splitOnHalf xs

handleCase :: Int -> IO ()

handleCase 0 = do return ()
handleCase t = do
    n <- getLine
    a <- readInts
    putStrLn $ if solve(a) == True then "YES" else "NO"
    handleCase(t-1)

main = do
    t <- getLine
    handleCase (read t)


For a collection of integers $$$S$$$, define $$$\operatorname{mex}(S)$$$ as the smallest non-negative integer that does not appear in $$$S$$$.NIT, the cleaver, decides to destroy the universe. He is not so powerful as Thanos, so he can only destroy the universe by snapping his fingers several times.The universe can be represented as a 1-indexed array $$$a$$$ of length $$$n$$$. When NIT snaps his fingers, he does the following operation on the array:  He selects positive integers $$$l$$$ and $$$r$$$ such that $$$1\le l\le r\le n$$$. Let $$$w=\operatorname{mex}(\{a_l,a_{l+1},\dots,a_r\})$$$. Then, for all $$$l\le i\le r$$$, set $$$a_i$$$ to $$$w$$$. We say the universe is destroyed if and only if for all $$$1\le i\le n$$$, $$$a_i=0$$$ holds.Find the minimum number of times NIT needs to snap his fingers to destroy the universe. That is, find the minimum number of operations NIT needs to perform to make all elements in the array equal to $$$0$$$.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^4$$$). Description of the test cases follows. The first line of each test case contains one integer $$$n$$$ ($$$1\le n\le 10^5$$$). The second line of each test case contains $$$n$$$ integers $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_n$$$ ($$$0\le a_i\le 10^9$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

For each test case, print one integer — the answer to the problem.

NoteIn the first test case, we do $$$0$$$ operations and all elements in the array are already equal to $$$0$$$.In the second test case, one optimal way is doing the operation with $$$l=2$$$, $$$r=5$$$.In the third test case, one optimal way is doing the operation twice, respectively with $$$l=4$$$, $$$r=4$$$ and $$$l=2$$$, $$$r=6$$$.In the fourth test case, one optimal way is doing the operation with $$$l=1$$$, $$$r=1$$$.

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

solve xs = min 2 . length . filter ((/=0).head) . L.groupBy ((==)`on`(==0)) $ xs

import Control.Monad (forM_)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import Data.Maybe (fromJust)

main :: IO ()
main = do
  t <- int <$> B.getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- B.getLine
    as <- map int . C.words <$> B.getLine
    let bs = reverse . dropWhile (== 0) . reverse . dropWhile (== 0) $ as
    if null bs
      then print 0
      else
        if 0 `elem` bs
          then print 2
          else print 1

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

import Control.Monad (forM_)

main :: IO ()
main = do
  t <- read <$> getLine
  forM_ [1 .. t] $ \_ -> do
    _ <- getLine
    as <- map read . words <$> getLine
    let bs = reverse . dropWhile (== 0) . reverse . dropWhile (== 0) $ as
    if null bs
      then print 0
      else
        if 0 `elem` bs
          then print 2
          else print 1

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

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

solve xs = length . filter ((/=0).head) . L.groupBy ((==)`on`(==0)) $ xs


Ivan has an array consisting of n different integers. He decided to reorder all elements in increasing order. Ivan loves merge sort so he decided to represent his array with one or several increasing sequences which he then plans to merge into one sorted array.Ivan represent his array with increasing sequences with help of the following algorithm.While there is at least one unused number in array Ivan repeats the following procedure:  iterate through array from the left to the right;  Ivan only looks at unused numbers on current iteration;  if current number is the first unused number on this iteration or this number is greater than previous unused number on current iteration, then Ivan marks the number as used and writes it down. For example, if Ivan's array looks like [1, 3, 2, 5, 4] then he will perform two iterations. On first iteration Ivan will use and write numbers [1, 3, 5], and on second one — [2, 4].Write a program which helps Ivan and finds representation of the given array with one or several increasing sequences in accordance with algorithm described above.

The first line contains a single integer n (1 ≤ n ≤ 2·105) — the number of elements in Ivan's array. The second line contains a sequence consisting of distinct integers a1, a2, ..., an (1 ≤ ai ≤ 109) — Ivan's array.

Print representation of the given array in the form of one or more increasing sequences in accordance with the algorithm described above. Each sequence must be printed on a new line.

{-# 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 qualified Data.ByteString.Char8 as SB
import Control.Monad
import Control.Monad.Trans.State.Lazy
import qualified Data.IntMap.Strict as M
import Data.Maybe

main = SB.putStr . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  xs <- replicateM n poi
  return $ SB.unlines $ map (SB.unwords . map (SB.pack . show)) $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve xs = (\(m, o) -> let m' = M.fromList $ map (\zs -> let zs' = zs [] in (head zs', zs')) $ M.elems m in map (fromJust . flip M.lookup m') $ o []) $ foldl go (M.empty, id) xs
  where
  go (m, o) x = case M.lookupLT x m of
    Nothing -> (M.insert x (x:) m, o . (x:))
    Just (l, xs) -> (M.insert x (xs . (x:)) $ M.delete l m, o)

{-# 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.Strict as M
import Data.Maybe

main = putStr . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  xs <- replicateM n poi
  return $ unwords $ map show $ concat $ solve xs
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve xs = (\(m, o) -> let m' = M.fromList $ map (\zs -> let zs' = zs [] in (head zs', zs')) $ M.elems m in map (fromJust . flip M.lookup m') $ o []) $ foldl go (M.empty, id) xs
  where
  go (m, o) x = case M.lookupLT x m of
    Nothing -> (M.insert x (x:) m, o . (x:))
    Just (l, xs) -> (M.insert x (xs . (x:)) $ M.delete l m, o)