You are given a set of integer numbers, initially it is empty. You should perform n queries.There are three different types of queries:   1 l r — Add all missing numbers from the interval [l, r]  2 l r — Remove all present numbers from the interval [l, r]  3 l r — Invert the interval [l, r] — add all missing and remove all present numbers from the interval [l, r] After each query you should output MEX of the set — the smallest positive (MEX  ≥ 1) integer number which is not presented in the set.

The first line contains one integer number n (1 ≤ n ≤ 105). Next n lines contain three integer numbers t, l, r (1 ≤ t ≤ 3, 1 ≤ l ≤ r ≤ 1018) — type of the query, left and right bounds.

NoteHere are contents of the set after each query in the first example:  {3, 4} — the interval [3, 4] is added  {1, 2, 5, 6} — numbers {3, 4} from the interval [1, 6] got deleted and all the others are added  {5, 6} — numbers {1, 2} got deleted

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import Data.Int
import qualified Data.Set as S
import Data.Functor
import Control.Monad
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS
import Data.Bits
import Data.Tuple
import qualified Data.Map.Strict as M

import System.Random

type I = Int

data Node = Node !Bool {-# UNPACK #-} !(I, I) !Contents
  deriving (Show)

data Contents = Branch !Node !Node | Empty
  deriving (Show)

type Query = Int

query :: (I, I) -> Query -> Node -> Node
query !qi@(l, r) !q !n@(Node i (from, to) c)
 | l >= to || r <= from = n
 | l <= from && r >= to = fullyConvert q n
 | otherwise = case c of
    Empty -> merge (nextq emptyl) (nextq emptyr)
    Branch nl nr -> merge (nextq nl) (nextq nr)
  where
    emptyl = Node False (from, mid) Empty
    emptyr = Node False (mid, to) Empty
    mid = (from + to) `shiftR` 1
    nextq !nn = query qi nq nn
    nq = if not i then q else
      case q of
        1 -> 2
        2 -> 1
        3 -> 3
    merge !n1@(Node x1 _ Empty) !n2@(Node x2 _ Empty)
      | x1 == x2 = Node (i /= x1) (from, to) Empty
      | otherwise = Node i (from, to) (Branch n1 n2)
    merge !n1 !n2 = Node i (from, to) (Branch n1 n2)

fullyConvert 1 (Node _ i _) = Node True i Empty
fullyConvert 2 (Node _ i _) = Node False i Empty
fullyConvert 3 (Node inv i c) = Node (not inv) i c

enumerate :: Node -> S.Set I
enumerate (Node i (from, to) Empty) = S.fromList $ if i then [from..to] else []
enumerate (Node i (from, to) (Branch n1 n2)) =
  let u = S.union (enumerate n1) (enumerate n2) in
  if i then S.fromList [from..to] `S.difference` u else u

mex :: Bool -> Node -> Maybe I
mex !inv !(Node i (from, to) Empty) = if i /= inv then Nothing else Just from
mex !inv !(Node i _ (Branch n1 n2)) = case mex (i /= inv) n1 of
  Just x -> Just x
  Nothing -> mex (i /= inv) n2

readInt :: Integral a => BS.ByteString -> a
readInt = fromInteger . fst . (\(Just i) -> i) . BS.readInteger

readQuery :: IO [Int64]
readQuery = (map readInt . BS.words) <$> BS.getLine

randomQuery :: IO [Int64]
randomQuery = do
  q <- randomRIO (1,3)
  x <- randomRIO (1, 10^18)
  y <- randomRIO (1, 10^18)
  return [q, min x y, max x y]

writeRandom :: Int64 -> IO ()
writeRandom n = do
  putStrLn $ show n
  replicateM_ (fromIntegral n) (putStrLn . unwords . map show =<< randomQuery)

main' = writeRandom 100000
main = do
  n <- readInt <$> BS.getLine
  qs <- replicateM n $ do
    [x, y, z] <- readQuery
    return ((y, z+1), fromIntegral x)

  let points = zip [0..] (S.toList $ S.fromList $ foldr (\((l,r), _) ps -> (l:r:ps)) [1,10^18+1] qs)
      pointToIndex :: M.Map Int64 I = M.fromList (map swap points)
      indexToPoint :: M.Map I Int64 = M.fromList points

  _ <- foldM (\s ((x, y), q) -> do
    let news = query (pointToIndex M.! x, pointToIndex M.! y) q s
    case mex False news of
       Nothing -> print $ 10^18+1
       Just r -> print $ indexToPoint M.! r
    return news
    ) (Node False (0, length points - 1) Empty) qs
  return ()


Petya is preparing for his birthday. He decided that there would be $$$n$$$ different dishes on the dinner table, numbered from $$$1$$$ to $$$n$$$. Since Petya doesn't like to cook, he wants to order these dishes in restaurants.Unfortunately, all dishes are prepared in different restaurants and therefore Petya needs to pick up his orders from $$$n$$$ different places. To speed up this process, he wants to order courier delivery at some restaurants. Thus, for each dish, there are two options for Petya how he can get it:  the dish will be delivered by a courier from the restaurant $$$i$$$, in this case the courier will arrive in $$$a_i$$$ minutes,  Petya goes to the restaurant $$$i$$$ on his own and picks up the dish, he will spend $$$b_i$$$ minutes on this. Each restaurant has its own couriers and they start delivering the order at the moment Petya leaves the house. In other words, all couriers work in parallel. Petya must visit all restaurants in which he has not chosen delivery, he does this consistently.For example, if Petya wants to order $$$n = 4$$$ dishes and $$$a = [3, 7, 4, 5]$$$, and $$$b = [2, 1, 2, 4]$$$, then he can order delivery from the first and the fourth restaurant, and go to the second and third on your own. Then the courier of the first restaurant will bring the order in $$$3$$$ minutes, the courier of the fourth restaurant will bring the order in $$$5$$$ minutes, and Petya will pick up the remaining dishes in $$$1 + 2 = 3$$$ minutes. Thus, in $$$5$$$ minutes all the dishes will be at Petya's house.Find the minimum time after which all the dishes can be at Petya's home.

The first line contains one positive integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^5$$$) — the number of test cases. Then $$$t$$$ test cases follow. Each test case begins with a line containing one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of dishes that Petya wants to order. The second line of each test case contains $$$n$$$ integers $$$a_1 \ldots a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the time of courier delivery of the dish with the number $$$i$$$. The third line of each test case contains $$$n$$$ integers $$$b_1 \ldots b_n$$$ ($$$1 \le b_i \le 10^9$$$) — the time during which Petya will pick up the dish with the number $$$i$$$. The sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case output one integer — the minimum time after which all dishes can be at Petya's home.

import Control.Arrow ((>>>))
import Data.List (sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Integer]] -> [Integer]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Integer] -> [Integer] -> Integer
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Arrow ((>>>))
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List (sortBy)
import Data.Maybe (fromMaybe)
import Data.Ord (comparing)

main :: IO ()
main =
  C.interact $
  C.lines >>>
  drop 1 >>>
  map (C.words >>> map readInt) >>>
  process >>> map (show >>> C.pack) >>> C.unlines
  where
    readInt = C.readInt >>> fromMaybe undefined >>> fst >>> fromIntegral

process :: [[Integer]] -> [Integer]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Integer] -> [Integer] -> Integer
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Monad (forM_)
import Data.List (sortBy, genericSplitAt)

-- * Types and utilities

-- | A splitting strategy.
data Splitter a = Splitter { delimiter        :: Delimiter a
                               -- ^ What delimiter to split on
                           , delimPolicy      :: DelimPolicy
                               -- ^ What to do with delimiters (drop
                               --   from output, keep as separate
                               --   elements in output, or merge with
                               --   previous or following chunks)
                           , condensePolicy   :: CondensePolicy
                               -- ^ What to do with multiple
                               --   consecutive delimiters
                           , initBlankPolicy  :: EndPolicy
                               -- ^ Drop an initial blank?
                           , finalBlankPolicy :: EndPolicy
                               -- ^ Drop a final blank?
                           }

-- | The default splitting strategy: keep delimiters in the output
--   as separate chunks, don't condense multiple consecutive
--   delimiters into one, keep initial and final blank chunks.
--   Default delimiter is the constantly false predicate.
--
--   Note that 'defaultSplitter' should normally not be used; use
--   'oneOf', 'onSublist', or 'whenElt' instead, which are the same as
--   the 'defaultSplitter' with just the delimiter overridden.
--
--   The 'defaultSplitter' strategy with any delimiter gives a
--   maximally information-preserving splitting strategy, in the sense
--   that (a) taking the 'concat' of the output yields the original
--   list, and (b) given only the output list, we can reconstruct a
--   'Splitter' which would produce the same output list again given
--   the original input list.  This default strategy can be overridden
--   to allow discarding various sorts of information.
defaultSplitter :: Splitter a
defaultSplitter = Splitter { delimiter        = Delimiter [const False]
                           , delimPolicy      = Keep
                           , condensePolicy   = KeepBlankFields
                           , initBlankPolicy  = KeepBlank
                           , finalBlankPolicy = KeepBlank
                           }

-- | A delimiter is a list of predicates on elements, matched by some
--   contiguous subsequence of a list.
newtype Delimiter a = Delimiter [a -> Bool]

-- | Try to match a delimiter at the start of a list, either failing
--   or decomposing the list into the portion which matched the delimiter
--   and the remainder.
matchDelim :: Delimiter a -> [a] -> Maybe ([a],[a])
matchDelim (Delimiter []) xs = Just ([],xs)
matchDelim (Delimiter _)  [] = Nothing
matchDelim (Delimiter (p:ps)) (x:xs)
  | p x       = matchDelim (Delimiter ps) xs >>= \(h,t) -> Just (x:h,t)
  | otherwise = Nothing

-- | What to do with delimiters?
data DelimPolicy = Drop      -- ^ Drop delimiters from the output.
                 | Keep      -- ^ Keep delimiters as separate chunks
                             --   of the output.
                 | KeepLeft  -- ^ Keep delimiters in the output,
                             --   prepending them to the following
                             --   chunk.
                 | KeepRight -- ^ Keep delimiters in the output,
                             --   appending them to the previous chunk.
  deriving (Eq, Show)

-- | What to do with multiple consecutive delimiters?
data CondensePolicy = Condense         -- ^ Condense into a single delimiter.
                    | DropBlankFields  -- ^ Keep consecutive
                                       --   delimiters separate, but
                                       --   don't insert blank chunks in
                                       --   between them.
                    | KeepBlankFields  -- ^ Insert blank chunks
                                       --   between consecutive
                                       --   delimiters.
  deriving (Eq, Show)

-- | What to do with a blank chunk at either end of the list
--   (/i.e./ when the list begins or ends with a delimiter).
data EndPolicy = DropBlank | KeepBlank
  deriving (Eq, Show)

-- | Tag chunks as delimiters or text.
data Chunk a = Delim [a] | Text [a]
  deriving (Show, Eq)

-- | Internal representation of a split list that tracks which pieces
--   are delimiters and which aren't.
type SplitList a = [Chunk a]

-- | Untag a 'Chunk'.
fromElem :: Chunk a -> [a]
fromElem (Text as) = as
fromElem (Delim as) = as

-- | Test whether a 'Chunk' is a delimiter.
isDelim :: Chunk a -> Bool
isDelim (Delim _) = True
isDelim _ = False

-- | Test whether a 'Chunk' is text.
isText :: Chunk a -> Bool
isText (Text _) = True
isText _ = False

-- * Implementation

-- | Given a delimiter to use, split a list into an internal
--   representation with chunks tagged as delimiters or text.  This
--   transformation is lossless; in particular,
--
-- @
--   'concatMap' 'fromElem' ('splitInternal' d l) == l.
-- @
splitInternal :: Delimiter a -> [a] -> SplitList a
splitInternal _ [] = []
splitInternal d xxs
  | null xs   = toSplitList match
  | otherwise = Text xs : toSplitList match
 where
  (xs,match) = breakDelim d xxs

  toSplitList Nothing             = []
  toSplitList (Just ([],r:rs))    = Delim [] : Text [r] : splitInternal d rs
  toSplitList (Just (delim,rest)) = Delim delim : splitInternal d rest

breakDelim :: Delimiter a -> [a] -> ([a],Maybe ([a],[a]))
breakDelim (Delimiter []) xs         = ([],Just ([],xs))
breakDelim _              []         = ([],Nothing)
breakDelim d              xxs@(x:xs) =
  case matchDelim d xxs of
      Nothing    -> let (ys,match) = breakDelim d xs in (x:ys,match)
      Just match -> ([], Just match)

-- | Given a split list in the internal tagged representation, produce
--   a new internal tagged representation corresponding to the final
--   output, according to the strategy defined by the given
--   'Splitter'.
postProcess :: Splitter a -> SplitList a -> SplitList a
postProcess s = dropFinal (finalBlankPolicy s)
              . dropInitial (initBlankPolicy s)
              . doMerge (delimPolicy s)
              . doDrop (delimPolicy s)
              . insertBlanks (condensePolicy s)
              . doCondense (condensePolicy s)

-- | Drop delimiters if the 'DelimPolicy' is 'Drop'.
doDrop :: DelimPolicy -> SplitList a -> SplitList a
doDrop Drop l = [ c | c@(Text _) <- l ]
doDrop _ l = l

-- | Condense multiple consecutive delimiters into one if the
--   'CondensePolicy' is 'Condense'.
doCondense :: CondensePolicy -> SplitList a -> SplitList a
doCondense Condense ls = condense' ls
  where condense' [] = []
        condense' (c@(Text _) : l) = c : condense' l
        condense' l = (Delim $ concatMap fromElem ds) : condense' rest
          where (ds,rest) = span isDelim l
doCondense _ ls = ls

-- | Insert blank chunks between any remaining consecutive delimiters
--   (unless the condense policy is 'DropBlankFields'), and at the
--   beginning or end if the first or last element is a delimiter.
insertBlanks :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks _ [] = [Text []]
insertBlanks cp (d@(Delim _) : l) = Text [] : insertBlanks' cp (d:l)
insertBlanks cp l = insertBlanks' cp l

-- | Insert blank chunks between consecutive delimiters.
insertBlanks' :: CondensePolicy -> SplitList a -> SplitList a
insertBlanks' _ [] = []
insertBlanks' cp@DropBlankFields (d1@(Delim _) : d2@(Delim _) : l)
  = d1           : insertBlanks' cp (d2:l)
insertBlanks' cp (d1@(Delim _) : d2@(Delim _) : l)
  = d1 : Text [] : insertBlanks' cp (d2:l)
insertBlanks' _ [d@(Delim _)] = [d, Text []]
insertBlanks' cp (c : l) = c : insertBlanks' cp l

-- | Merge delimiters into adjacent chunks according to the 'DelimPolicy'.
doMerge :: DelimPolicy -> SplitList a -> SplitList a
doMerge KeepLeft = mergeLeft
doMerge KeepRight = mergeRight
doMerge _ = id

-- | Merge delimiters with adjacent chunks to the right (yes, that's
--   not a typo: the delimiters should end up on the left of the
--   chunks, so they are merged with chunks to their right).
mergeLeft :: SplitList a -> SplitList a
mergeLeft [] = []
mergeLeft ((Delim d) : (Text c) : l) = Text (d++c) : mergeLeft l
mergeLeft (c : l) = c : mergeLeft l

-- | Merge delimiters with adjacent chunks to the left.
mergeRight :: SplitList a -> SplitList a
mergeRight [] = []
-- below fanciness is with the goal of laziness: we want to start returning
-- stuff before we've necessarily discovered a delimiter, in case we're
-- processing some infinite list with no delimiter
mergeRight ((Text c) : l) = Text (c++d) : mergeRight lTail
  where (d, lTail) = case l of
                     Delim d' : l' -> (d', l')
                     _ -> ([], l)
mergeRight (c : l) = c : mergeRight l

-- | Drop an initial blank chunk according to the given 'EndPolicy'.
dropInitial :: EndPolicy -> SplitList a -> SplitList a
dropInitial DropBlank (Text [] : l) = l
dropInitial _ l = l

-- | Drop a final blank chunk according to the given 'EndPolicy'.
dropFinal :: EndPolicy -> SplitList a -> SplitList a
dropFinal _         [] = []
dropFinal DropBlank l  = dropFinal' l
  where dropFinal' []        = []
        dropFinal' [Text []] = []
        dropFinal' (x:xs)    = x:dropFinal' xs
dropFinal _         l  = l

-- * Combinators

-- | Split a list according to the given splitting strategy.  This is
--   how to \"run\" a 'Splitter' that has been built using the other
--   combinators.
split :: Splitter a -> [a] -> [[a]]
split s = map fromElem . postProcess s . splitInternal (delimiter s)

-- ** Basic strategies
--
-- $ All these basic strategies have the same parameters as the
-- 'defaultSplitter' except for the delimiters.

-- | A splitting strategy that splits on any one of the given
--   elements.  For example:
--
-- > split (oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","x","","y","","z","c","x","d"]
oneOf :: Eq a => [a] -> Splitter a
oneOf elts = defaultSplitter { delimiter = Delimiter [(`elem` elts)] }

-- | A splitting strategy that splits on the given list, when it is
--   encountered as an exact subsequence.  For example:
--
-- > split (onSublist "xyz") "aazbxyzcxd" == ["aazb","xyz","cxd"]
--
--   Note that splitting on the empty list is a special case, which
--   splits just before every element of the list being split.  For example:
--
-- > split (onSublist "") "abc" == ["","","a","","b","","c"]
-- > split (dropDelims . dropBlanks $ onSublist "") "abc" == ["a","b","c"]
--
--   However, if you want to break a list into singleton elements like
--   this, you are better off using @'chunksOf' 1@, or better yet,
--   @'map' (:[])@.
onSublist :: Eq a => [a] -> Splitter a
onSublist lst = defaultSplitter { delimiter = Delimiter (map (==) lst) }

-- | A splitting strategy that splits on any elements that satisfy the
--   given predicate.  For example:
--
-- > split (whenElt (<0)) [2,4,-3,6,-9,1] == [[2,4],[-3],[6],[-9],[1]]
whenElt :: (a -> Bool) -> Splitter a
whenElt p = defaultSplitter { delimiter = Delimiter [p] }

-- ** Strategy transformers

-- | Drop delimiters from the output (the default is to keep
--   them). For example,
--
-- > split (oneOf ":") "a:b:c" == ["a", ":", "b", ":", "c"]
-- > split (dropDelims $ oneOf ":") "a:b:c" == ["a", "b", "c"]
dropDelims :: Splitter a -> Splitter a
dropDelims s = s { delimPolicy = Drop }

-- | Keep delimiters in the output by prepending them to adjacent
--   chunks.  For example:
--
-- > split (keepDelimsL $ oneOf "xyz") "aazbxyzcxd" == ["aa","zb","x","y","zc","xd"]
keepDelimsL :: Splitter a -> Splitter a
keepDelimsL s = s { delimPolicy = KeepLeft }

-- | Keep delimiters in the output by appending them to adjacent
--   chunks. For example:
--
-- > split (keepDelimsR $ oneOf "xyz") "aazbxyzcxd" == ["aaz","bx","y","z","cx","d"]
keepDelimsR :: Splitter a -> Splitter a
keepDelimsR s = s { delimPolicy = KeepRight }

-- | Condense multiple consecutive delimiters into one.  For example:
--
-- > split (condense $ oneOf "xyz") "aazbxyzcxd" == ["aa","z","b","xyz","c","x","d"]
-- > split (dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","","","c","d"]
-- > split (condense . dropDelims $ oneOf "xyz") "aazbxyzcxd" == ["aa","b","c","d"]
condense :: Splitter a -> Splitter a
condense s = s { condensePolicy = Condense }

-- | Don't generate a blank chunk if there is a delimiter at the
--   beginning.  For example:
--
-- > split (oneOf ":") ":a:b" == ["",":","a",":","b"]
-- > split (dropInitBlank $ oneOf ":") ":a:b" == [":","a",":","b"]
dropInitBlank :: Splitter a -> Splitter a
dropInitBlank s = s { initBlankPolicy = DropBlank }

-- | Don't generate a blank chunk if there is a delimiter at the end.
--   For example:
--
-- > split (oneOf ":") "a:b:" == ["a",":","b",":",""]
-- > split (dropFinalBlank $ oneOf ":") "a:b:" == ["a",":","b",":"]
dropFinalBlank :: Splitter a -> Splitter a
dropFinalBlank s = s { finalBlankPolicy = DropBlank }

-- | Don't generate blank chunks between consecutive delimiters.
--   For example:
--
-- > split (oneOf ":") "::b:::a" == ["",":","",":","b",":","",":","",":","a"]
-- > split (dropInnerBlanks $ oneOf ":") "::b:::a" == ["", ":",":","b",":",":",":","a"]
dropInnerBlanks :: Splitter a -> Splitter a
dropInnerBlanks s = s { condensePolicy = DropBlankFields }

-- ** Derived combinators

-- | Drop all blank chunks from the output, and condense consecutive
--   delimiters into one.  Equivalent to @'dropInitBlank'
--   . 'dropFinalBlank' . 'condense'@.  For example:
--
-- > split (oneOf ":") "::b:::a" == ["",":","",":","b",":","",":","",":","a"]
-- > split (dropBlanks $ oneOf ":") "::b:::a" == ["::","b",":::","a"]
dropBlanks :: Splitter a -> Splitter a
dropBlanks = dropInitBlank . dropFinalBlank . condense

-- | Make a strategy that splits a list into chunks that all start
--   with the given subsequence (except possibly the first).
--   Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'onSublist'@.
--   For example:
--
-- > split (startsWith "app") "applyapplicativeapplaudapproachapple" == ["apply","applicative","applaud","approach","apple"]
startsWith :: Eq a => [a] -> Splitter a
startsWith = dropInitBlank . keepDelimsL . onSublist

-- | Make a strategy that splits a list into chunks that all start
--   with one of the given elements (except possibly the first).
--   Equivalent to @'dropInitBlank' . 'keepDelimsL' . 'oneOf'@.  For
--   example:
--
-- > split (startsWithOneOf ['A'..'Z']) "ACamelCaseIdentifier" == ["A","Camel","Case","Identifier"]
startsWithOneOf :: Eq a => [a] -> Splitter a
startsWithOneOf = dropInitBlank . keepDelimsL . oneOf

-- | Make a strategy that splits a list into chunks that all end with
--   the given subsequence, except possibly the last.  Equivalent to
--   @'dropFinalBlank' . 'keepDelimsR' . 'onSublist'@.  For example:
--
-- > split (endsWith "ly") "happilyslowlygnarlylily" == ["happily","slowly","gnarly","lily"]
endsWith :: Eq a => [a] -> Splitter a
endsWith = dropFinalBlank . keepDelimsR . onSublist

-- | Make a strategy that splits a list into chunks that all end with
--   one of the given elements, except possibly the last.  Equivalent
--   to @'dropFinalBlank' . 'keepDelimsR' . 'oneOf'@.  For example:
--
-- > split (condense $ endsWithOneOf ".,?! ") "Hi, there!  How are you?" == ["Hi, ","there!  ","How ","are ","you?"]
endsWithOneOf :: Eq a => [a] -> Splitter a
endsWithOneOf = dropFinalBlank . keepDelimsR . oneOf

-- ** Convenience functions
--
-- These functions implement some common splitting strategies.  Note
-- that all of the functions in this section drop delimiters from
-- the final output, since that is a more common use case even
-- though it is not the default.

-- | Split on any of the given elements.  Equivalent to @'split'
--   . 'dropDelims' . 'oneOf'@.  For example:
--
-- > splitOneOf ";.," "foo,bar;baz.glurk" == ["foo","bar","baz","glurk"]
splitOneOf :: Eq a => [a] -> [a] -> [[a]]
splitOneOf = split . dropDelims . oneOf

-- | Split on the given sublist.  Equivalent to @'split'
--   . 'dropDelims' . 'onSublist'@.  For example:
--
-- > splitOn ".." "a..b...c....d.." == ["a","b",".c","","d",""]
--
--   In some parsing combinator frameworks this is also known as
--   @sepBy@.
--
--   Note that this is the right inverse of the 'Data.List.intercalate' function
--   from "Data.List", that is,
--
--   > intercalate x . splitOn x === id
--
--   @'splitOn' x . 'Data.List.intercalate' x@ is the identity on
--   certain lists, but it is tricky to state the precise conditions
--   under which this holds.  (For example, it is not enough to say
--   that @x@ does not occur in any elements of the input list.
--   Working out why is left as an exercise for the reader.)
splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn   = split . dropDelims . onSublist

-- | Split on elements satisfying the given predicate.  Equivalent to
--   @'split' . 'dropDelims' . 'whenElt'@.  For example:
--
-- > splitWhen (<0) [1,3,-4,5,7,-9,0,2] == [[1,3],[5,7],[0,2]]
splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen = split . dropDelims . whenElt

{-# DEPRECATED sepBy "Use splitOn." #-}
sepBy :: Eq a => [a] -> [a] -> [[a]]
sepBy = splitOn

{-# DEPRECATED sepByOneOf "Use splitOneOf." #-}
sepByOneOf :: Eq a => [a] -> [a] -> [[a]]
sepByOneOf = splitOneOf

-- | Split into chunks terminated by the given subsequence.
--   Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims'
--   . 'onSublist'@.  For example:
--
-- > endBy ";" "foo;bar;baz;" == ["foo","bar","baz"]
--
--   Note also that the 'lines' function from "Data.List" is equivalent
--   to @'endBy' \"\\n\"@.
endBy :: Eq a => [a] -> [a] -> [[a]]
endBy = split . dropFinalBlank . dropDelims . onSublist

-- | Split into chunks terminated by one of the given elements.
--   Equivalent to @'split' . 'dropFinalBlank' . 'dropDelims'
--   . 'oneOf'@. For example:
--
-- > endByOneOf ";," "foo;bar,baz;" == ["foo","bar","baz"]
endByOneOf :: Eq a => [a] -> [a] -> [[a]]
endByOneOf = split . dropFinalBlank . dropDelims . oneOf

{-# DEPRECATED unintercalate "Use splitOn." #-}
unintercalate :: Eq a => [a] -> [a] -> [[a]]
unintercalate = splitOn

-- | Split into \"words\", with word boundaries indicated by the given
--   predicate.  Satisfies @'Data.List.words' === wordsBy
--   'Data.Char.isSpace'@; equivalent to @'split' . 'dropBlanks'
--   . 'dropDelims' . 'whenElt'@.  For example:
--
-- > wordsBy (=='x') "dogxxxcatxbirdxx" == ["dog","cat","bird"]
wordsBy :: (a -> Bool) -> [a] -> [[a]]
wordsBy = split . dropBlanks . dropDelims . whenElt

-- | Split into \"lines\", with line boundaries indicated by the given
--   predicate. Satisfies @'lines' === linesBy (=='\n')@; equivalent to
--   @'split' . 'dropFinalBlank' . 'dropDelims' . 'whenElt'@.  For example:
--
-- > linesBy (=='x') "dogxxxcatxbirdxx" == ["dog","","","cat","bird",""]
linesBy :: (a -> Bool) -> [a] -> [[a]]
linesBy = split . dropFinalBlank . dropDelims . whenElt

-- * Other splitting methods

-- | Standard build function, specialized to building lists.
--
--   Usually build is given the rank-2 type
--
--   > build :: (forall b. (a -> b -> b) -> b -> b) -> [a]
--
--   but since we only use it when @(b ~ [a])@, we give it the more
--   restricted type signature in order to avoid needing a
--   non-Haskell2010 extension.
--
--   Note that the 0.1.4.3 release of this package did away with a
--   custom @build@ implementation in favor of importing one from
--   "GHC.Exts", which was (reportedly) faster for some applications.
--   However, in the interest of simplicity and complete Haskell2010
--   compliance as @split@ is being included in the Haskel Platform,
--   version 0.2.1.0 has gone back to defining @build@ manually.  This
--   is in line with @split@'s design philosophy of having efficiency
--   as a non-goal.
build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
build g = g (:) []

-- | @'chunksOf' n@ splits a list into length-n pieces.  The last
--   piece will be shorter if @n@ does not evenly divide the length of
--   the list.  If @n <= 0@, @'chunksOf' n l@ returns an infinite list
--   of empty lists.  For example:
--
--   Note that @'chunksOf' n []@ is @[]@, not @[[]]@.  This is
--   intentional, and is consistent with a recursive definition of
--   'chunksOf'; it satisfies the property that
--
--   @chunksOf n xs ++ chunksOf n ys == chunksOf n (xs ++ ys)@
--
--   whenever @n@ evenly divides the length of @xs@.
chunksOf :: Int -> [e] -> [[e]]
chunksOf i ls = map (take i) (build (splitter ls)) where
  splitter :: [e] -> ([e] -> a -> a) -> a -> a
  splitter [] _ n = n
  splitter l c n  = l `c` splitter (drop i l) c n

{-# DEPRECATED chunk "Use chunksOf." #-}
chunk :: Int -> [e] -> [[e]]
chunk = chunksOf

{-# DEPRECATED splitEvery "Use chunksOf." #-}
splitEvery :: Int -> [e] -> [[e]]
splitEvery = chunksOf

-- | Split a list into chunks of the given lengths. For example:
--
-- > splitPlaces [2,3,4] [1..20] == [[1,2],[3,4,5],[6,7,8,9]]
-- > splitPlaces [4,9] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
-- > splitPlaces [4,9,3] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
--
--   If the input list is longer than the total of the given lengths,
--   then the remaining elements are dropped. If the list is shorter
--   than the total of the given lengths, then the result may contain
--   fewer chunks than requested, and the last chunk may be shorter
--   than requested.
splitPlaces :: Integral a => [a] -> [e] -> [[e]]
splitPlaces is ys = build (splitPlacer is ys) where
  splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
  splitPlacer [] _ _ n      = n
  splitPlacer _ [] _ n      = n
  splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs
                              in  x1 `c` splitPlacer ls x2 c n

-- | Split a list into chunks of the given lengths. Unlike
--   'splitPlaces', the output list will always be the same length as
--   the first input argument. If the input list is longer than the
--   total of the given lengths, then the remaining elements are
--   dropped. If the list is shorter than the total of the given
--   lengths, then the last several chunks will be shorter than
--   requested or empty. For example:
--
-- > splitPlacesBlanks [2,3,4] [1..20] == [[1,2],[3,4,5],[6,7,8,9]]
-- > splitPlacesBlanks [4,9] [1..10] == [[1,2,3,4],[5,6,7,8,9,10]]
-- > splitPlacesBlanks [4,9,3] [1..10] == [[1,2,3,4],[5,6,7,8,9,10],[]]
--
--   Notice the empty list in the output of the third example, which
--   differs from the behavior of 'splitPlaces'.
splitPlacesBlanks :: Integral a => [a] -> [e] -> [[e]]
splitPlacesBlanks is ys = build (splitPlacer is ys) where
  splitPlacer :: Integral i => [i] -> [b] -> ([b] -> t -> t) -> t -> t
  splitPlacer [] _ _ n      = n
  splitPlacer (l:ls) xs c n = let (x1, x2) = genericSplitAt l xs
                              in  x1 `c` splitPlacer ls x2 c n

-- | A useful recursion pattern for processing a list to produce a new
--   list, often used for \"chopping\" up the input list.  Typically
--   chop is called with some function that will consume an initial
--   prefix of the list and produce a value and the rest of the list.
--
--   For example, many common Prelude functions can be implemented in
--   terms of @chop@:
--
-- > group :: (Eq a) => [a] -> [[a]]
-- > group = chop (\ xs@(x:_) -> span (==x) xs)
-- >
-- > words :: String -> [String]
-- > words = filter (not . null) . chop (span (not . isSpace) . dropWhile isSpace)

chop :: ([a] -> (b, [a])) -> [a] -> [b]
chop _ [] = []
chop f as = b : chop f as'
  where (b, as') = f as

-- | Divides up an input list into a set of sublists, according to 'n' and 'm'
--   input specifications you provide. Each sublist will have 'n' items, and the
--   start of each sublist will be offset by 'm' items from the previous one.
--
-- > divvy 5 5 [1..20] == [[1,2,3,4,5],[6,7,8,9,10],[11,12,13,14,15],[16,17,18,19,20]]
--
--   In the case where a source list's trailing elements do no fill an entire
--   sublist, those trailing elements will be dropped.
--
-- > divvy 5 2 [1..10] == [[1,2,3,4,5],[3,4,5,6,7],[5,6,7,8,9]]
--
--   As an example, you can generate a moving average over a list of prices:
--
-- > type Prices = [Float]
-- > type AveragePrices = [Float]
-- >
-- > average :: [Float] -> Float
-- > average xs = sum xs / (fromIntegral $ length xs)
-- >
-- > simpleMovingAverage :: Prices -> AveragePrices
-- > simpleMovingAverage priceList =
-- >   map average divvyedPrices
-- >     where divvyedPrices = divvy 20 1 priceList

divvy :: Int -> Int -> [a] -> [[a]]
divvy _ _ [] = []
divvy n m lst = filter (\ws -> (n == length ws)) choppedl
  where choppedl = chop (\xs -> (take n xs , drop m xs)) lst

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = if length spl == 1 then snd . last $ h else m
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        spl = split (keepDelimsL $ whenElt (\(f, s) -> s >= f)) scl
        m = max (if length h > 0 then snd . last $ h else 0) (fst . head . head $ tail spl)
        h = head spl

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs

import Control.Monad (forM_)
import Data.List (sortBy, findIndex)

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = rez
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        mi = findIndex (\(x, y) -> y > x) scl
        rez = case mi of
                Just i -> rez' i
                Nothing -> snd $ last scl
        rez' i = if i == 0 then fst (head scl) else max (snd $ scl !! (i - 1)) (fst (scl !! i))

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs

import Control.Arrow ((>>>))
import Data.List (sortBy)
import Data.Ord (comparing)

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process (_:as:bs:xss) = solve as bs : process xss

solve :: [Int] -> [Int] -> Int
solve as bs = minimum costs
  where
    (as', bs') = unzip . sortBy (comparing fst) $ zip as bs
    costs = zipWith max (scanl max 0 as') (scanr (+) 0 bs')

import Control.Monad (forM_)
import Data.List (sortBy)

solve :: String -> String -> Int
solve as' bs' = if length fl == 0 then fst . head $ sc else snd . last $ fl
  where as = l as'
	bs = l bs'
	l = map read . words
	ts' = zip as bs
	ts = reverse $ sortBy sf ts'
	sf x y = compare (fst x) (fst y)
	sc = tail $ scanl (\(ox, oy) (nx, ny) -> (nx, oy + ny)) (1, 0) ts
	fl = filter (\(x, y) -> x >= y) sc

main :: IO ()
main = do
  t <- pure . read =<< getLine
  forM_ [1..t] . const $ getLine >> getLine >>= \as -> do
	bs <- getLine
	putStrLn . show . solve as $ bs

import Control.Monad (forM_)
import Data.List (sortBy)

-- fst of first time when snd >= fst
-- if snd never becomes >= fst, then snd of last item

solve :: [Int] -> [Int] -> Int
solve as bs = if length fl == 0 then snd $ last scl else fst $ head fl
  where z = zip as bs
        sf x y = compare (fst y) (fst x)
        scf x y = (fst y, snd x + snd y)
        scl = tail . scanl scf (0, 0) $ sortBy sf z
        fl = filter (\(f, s) -> s >= f) scl

main :: IO ()
main = getLine >>= pure . read >>= \t -> forM_ [1..t] . const $ getLine >> do
         as <- pure . map read . words =<< getLine
         bs <- pure . map read . words =<< getLine
         putStrLn . show $ solve as bs


Lately, Mr. Chanek frequently plays the game Arena of Greed. As the name implies, the game's goal is to find the greediest of them all, who will then be crowned king of Compfestnesia.The game is played by two people taking turns, where Mr. Chanek takes the first turn. Initially, there is a treasure chest containing $$$N$$$ gold coins. The game ends if there are no more gold coins in the chest. In each turn, the players can make one of the following moves:  Take one gold coin from the chest.  Take half of the gold coins on the chest. This move is only available if the number of coins in the chest is even. Both players will try to maximize the number of coins they have. Mr. Chanek asks your help to find the maximum number of coins he can get at the end of the game if both he and the opponent plays optimally.

The first line contains a single integer $$$T$$$ $$$(1 \le T \le 10^5)$$$ denotes the number of test cases. The next $$$T$$$ lines each contain a single integer $$$N$$$ $$$(1 \le N \le 10^{18})$$$.

$$$T$$$ lines, each line is the answer requested by Mr. Chanek.

NoteFor the first case, the game is as follows:   Mr. Chanek takes one coin.  The opponent takes two coins.  Mr. Chanek takes one coin.  The opponent takes one coin. For the second case, the game is as follows:   Mr. Chanek takes three coins.  The opponent takes one coin.  Mr. Chanek takes one coin.  The opponent takes one coin.

import Control.Monad

f :: Integer -> Integer
f 0 = 0
f n
  | (n `rem` 4 == 0) && (n > 8) || odd n = (n-) $! (f $ n - 1)
  | otherwise = (n-) $! (f $ quot n 2)

main :: IO ()
main = do
    t <- read <$> getLine
    replicateM_ t $ do
        n <- read <$> getLine
        print $ f n


An agent called Cypher is decrypting a message, that contains a composite number $$$n$$$. All divisors of $$$n$$$, which are greater than $$$1$$$, are placed in a circle. Cypher can choose the initial order of numbers in the circle.In one move Cypher can choose two adjacent numbers in a circle and insert their least common multiple between them. He can do that move as many times as needed.A message is decrypted, if every two adjacent numbers are not coprime. Note that for such constraints it's always possible to decrypt the message.Find the minimal number of moves that Cypher should do to decrypt the message, and show the initial order of numbers in the circle for that.

The first line contains an integer $$$t$$$ $$$(1 \le t \le 100)$$$ — the number of test cases. Next $$$t$$$ lines describe each test case. In a single line of each test case description, there is a single composite number $$$n$$$ $$$(4 \le n \le 10^9)$$$ — the number from the message. It's guaranteed that the total number of divisors of $$$n$$$ for all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case in the first line output the initial order of divisors, which are greater than $$$1$$$, in the circle. In the second line output, the minimal number of moves needed to decrypt the message. If there are different possible orders with a correct answer, print any of them.

NoteIn the first test case $$$6$$$ has three divisors, which are greater than $$$1$$$: $$$2, 3, 6$$$. Regardless of the initial order, numbers $$$2$$$ and $$$3$$$ are adjacent, so it's needed to place their least common multiple between them. After that the circle becomes $$$2, 6, 3, 6$$$, and every two adjacent numbers are not coprime.In the second test case $$$4$$$ has two divisors greater than $$$1$$$: $$$2, 4$$$, and they are not coprime, so any initial order is correct, and it's not needed to place any least common multiples.In the third test case all divisors of $$$30$$$ greater than $$$1$$$ can be placed in some order so that there are no two adjacent numbers that are coprime.

import Control.Monad
import Data.List

primes :: [Int]
primes = 2 : [x | x <- [3,5..], primeFactors x == [x]]

primeFactors :: Int -> [Int]
primeFactors = go primes  where
  go _ 1 = []
  go ps@(p:tps) n = case  divMod n p  of
    _  | p*p > n  -> [n]
    (q, 0) -> p : go ps q
    _ -> go tps n
  go _ _ = error "primes is finite?"

allFactors :: [[Int]] -> [Int]
allFactors [] = [1]
allFactors (p:qs) = let
  qvs = allFactors qs
  in  [w * qv | w <- scanl (*) 1 p, qv <- qvs]

stitch :: [t] -> [t] -> [t]
stitch ps qs = do
  (p, q) <- zip ps qs
  [p, q]

orderedFactors :: [Int] -> [Int]
orderedFactors ps = case  group ps  of
  [] -> []
  [qs, rs] -> let
    (1 : qvs) = scanl (*) 1 qs
    (1 : rvs) = scanl (*) 1 rs
    qrvs = [qv * rv | qv <- qvs, rv <- rvs]
    in head qrvs : qvs ++ tail qrvs ++ rvs
  pgs -> let
    singleFactors = map head pgs
    rot_sf = last singleFactors : init singleFactors
    pairFactors = zipWith (*) singleFactors rot_sf
    step (_, remFactors) f = partition (\x -> mod x f == 0) remFactors
    pairStates = scanl step ([], tail $ allFactors pgs) pairFactors
    singleStates = scanl step ([], snd $ last pairStates) singleFactors
    states = stitch pairStates singleStates
    in  concatMap fst states

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    let  ps = primeFactors n
    putStrLn . unwords . map show $ orderedFactors ps
    putStrLn $ if  length ps == 2 && ps !! 0 /= ps !! 1
      then  "1"
      else  "0"

import Control.Monad
import Data.List

primes :: [Int]
primes = 2 : [x | x <- [3,5..], primeFactors x == [x]]

primeFactors :: Int -> [Int]
primeFactors = go primes  where
  go _ 1 = []
  go ps@(p:tps) n = case  divMod n p  of
    _  | p*p > n  -> [n]
    (q, 0) -> p : go ps q
    _ -> go tps n
  go _ _ = error "primes is finite?"

allFactors :: [[Int]] -> [Int]
allFactors [] = [1]
allFactors (p:qs) = let
  qvs = allFactors qs
  in  [w * qv | w <- scanl (*) 1 p, qv <- qvs]

stitch :: [t] -> [t] -> [t]
stitch ps qs = do
  (p, q) <- zip ps qs
  [p, q]

orderedFactors :: [Int] -> [Int]
orderedFactors [] = []
orderedFactors ps = let
  pgs = group ps
  singleFactors = map head pgs
  rot_sf = last singleFactors : init singleFactors
  pairFactors = zipWith (*) singleFactors rot_sf
  step (_, remFactors) f = partition (\x -> mod x f == 0) remFactors
  pairStates = scanl step ([], tail $ allFactors pgs) pairFactors
  singleStates = scanl step ([], snd $ last pairStates) singleFactors
  states = stitch pairStates singleStates
  in  concatMap fst states

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    n <- read <$> getLine
    let  ps = primeFactors n
    putStrLn . unwords . map show $ orderedFactors ps
    putStrLn $ if  length ps == 2 && ps !! 0 /= ps !! 1
      then  "1"
      else  "0"


Mahmoud and Ehab are in the fourth stage now.Dr. Evil has a hidden binary string of length n. He guarantees that there is at least one '0' symbol and at least one '1' symbol in it. Now he wants Mahmoud and Ehab to find a position of any '0' symbol and any '1' symbol. In order to do this, Mahmoud and Ehab can ask Dr. Evil up to 15 questions. They tell Dr. Evil some binary string of length n, and Dr. Evil tells the Hamming distance between these two strings. Hamming distance between 2 binary strings of the same length is the number of positions in which they have different symbols. You can find the definition of Hamming distance in the notes section below.Help Mahmoud and Ehab find these two positions.You will get Wrong Answer verdict if   Your queries doesn't satisfy interaction protocol described below.  You ask strictly more than 15 questions and your program terminated after exceeding queries limit. Please note, that you can do up to 15 ask queries and one answer query.  Your final answer is not correct.  You will get Idleness Limit Exceeded if you don't print anything or if you forget to flush the output, including for the final answer (more info about flushing output below).If you exceed the maximum number of queries, You should terminate with 0, In this case you'll get Wrong Answer, If you don't terminate you may receive any verdict because you'll be reading from a closed stream .

The first line of input will contain a single integer n (2 ≤ n ≤ 1000) — the length of the hidden binary string.

To print the final answer, print "! pos0 pos1" (without quotes), where pos0 and pos1 are positions of some '0' and some '1' in the string (the string is 1-indexed). Don't forget to flush the output after printing the answer!

NoteHamming distance definition: https://en.wikipedia.org/wiki/Hamming_distanceIn the first test case the hidden binary string is 101, The first query is 000, so the Hamming distance is 2. In the second query the hidden string is still 101 and query is 001, so the Hamming distance is 1.After some queries you find that symbol at position 2 is '0' and symbol at position 1 is '1', so you print "! 2 1".

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad
import System.IO
-- import Debug.Trace

main = hSetBuffering stdout LineBuffering >> getLine >>= solve . readI

solve n = do
  nOnes <- ask [(n, '0')]
  let
    count l r = (\a -> let d = nOnes - a; s = r - l + 1 in ((s - d) `quot` 2, (s + d) `quot` 2)) `fmap` ask [(l - 1, '0'), (r - l + 1, '1'), (n - r, '0')]
    -- count l r = (\a -> traceShow ((l, r), a) a) `fmap` count' l r
    -- go zl zr ol or = print (('0', zl, zr), ('1', ol, or)) >> go' zl zr ol or
    go zl zr ol or
      | zl < zr = let zm = zl + (zr - zl) `quot` 2 in count zl zm >>= \case
        (0, _) -> go (zm + 1) zr zl zl
        (_, 0) | ol < or -> go zl zl (zm + 1) zr
        (_, 0) -> go zl zl ol or
        _ -> go zl zm ol or
      | ol < or = let om = ol + (or - ol) `quot` 2 in count ol om >>= \case
        (0, _) | zl < zr -> go (om + 1) or ol ol
        (0, _) -> go zl zr ol ol
        (_, 0) -> go ol ol (om + 1) or
        _ -> go zl zr ol om
      | otherwise = putStrLn $ "! " ++ show zl ++ " " ++ show ol
  go 1 n 1 n

ask = (>> (readI `fmap` getLine)) . putStrLn . ("? " ++) . concatMap (uncurry replicate)

readI s = read s :: Int
-- 0011001100

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad
import System.IO

main = hSetBuffering stdout LineBuffering >> getLine >>= solve . readI

solve n = do
  nOnes <- ask [(n, '0')]
  let
    count l r = (\a -> let d = nOnes - a; s = r - l + 1 in ((s - d) `quot` 2, (s + d) `quot` 2)) `fmap` ask [(l - 1, '0'), (r - l + 1, '1'), (n - r, '0')]
    go zl zr ol or
      | zl < zr = let zm = zl + (zr - zl) `quot` 2 in count zl zm >>= \case
        (0, _) -> go (zm + 1) zr zl zm
        (_, 0) -> go zl zm (zm + 1) zr
        _ -> go zl zm ol or
      | ol < or = let om = ol + (or - ol) `quot` 2 in count ol om >>= \case
        (0, _) -> go (om + 1) or ol om
        (_, 0) -> go ol om (om + 1) or
        _ -> go zl zr ol om
      | otherwise = putStrLn $ "! " ++ show zl ++ " " ++ show ol
  go 1 n 1 n

ask = (>> (readI `fmap` getLine)) . putStrLn . ("? " ++) . concatMap (uncurry replicate)

readI s = read s :: Int

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Control.Monad
import System.IO
-- import Debug.Trace

main = hSetBuffering stdout LineBuffering >> getLine >>= solve . readI

solve n = do
  nOnes <- ask [(n, '0')]
  let
    count l r = (\a -> let d = nOnes - a; s = r - l + 1 in ((s - d) `quot` 2, (s + d) `quot` 2)) `fmap` ask [(l - 1, '0'), (r - l + 1, '1'), (n - r, '0')]
    -- count l r = (\a -> traceShow ((l, r), a) a) `fmap` count' l r
    go zl zr ol or
      | zl < zr = let zm = zl + (zr - zl) `quot` 2 in count zl zm >>= \case
        (0, _) -> go (zm + 1) zr zl zl
        (_, 0) -> go zl zl (zm + 1) zr
        _ -> go zl zm ol or
      | ol < or = let om = ol + (or - ol) `quot` 2 in count ol om >>= \case
        (0, _) -> go (om + 1) or ol ol
        (_, 0) -> go ol ol (om + 1) or
        _ -> go zl zr ol om
      | otherwise = putStrLn $ "! " ++ show zl ++ " " ++ show ol
  go 1 n 1 n

ask = (>> (readI `fmap` getLine)) . putStrLn . ("? " ++) . concatMap (uncurry replicate)

readI s = read s :: Int
-- 0011001100


A star map in Berland is a checked field n × m squares. In each square there is or there is not a star. The favourite constellation of all Berland's astronomers is the constellation of the Cross. This constellation can be formed by any 5 stars so, that for some integer x (radius of the constellation) the following is true:   the 2nd is on the same vertical line as the 1st, but x squares up  the 3rd is on the same vertical line as the 1st, but x squares down  the 4th is on the same horizontal line as the 1st, but x squares left  the 5th is on the same horizontal line as the 1st, but x squares right Such constellations can be very numerous, that's why they are numbered with integers from 1 on the following principle: when two constellations are compared, the one with a smaller radius gets a smaller index; if their radii are equal — the one, whose central star if higher than the central star of the other one; if their central stars are at the same level — the one, whose central star is to the left of the central star of the other one.Your task is to find the constellation with index k by the given Berland's star map.

The first line contains three integers n, m and k (1 ≤ n, m ≤ 300, 1 ≤ k ≤ 3·107) — height and width of the map and index of the required constellation respectively. The upper-left corner has coordinates (1, 1), and the lower-right — (n, m). Then there follow n lines, m characters each — description of the map. j-th character in i-th line is «*», if there is a star in the corresponding square, and «.» if this square is empty.

If the number of the constellations is less than k, output -1. Otherwise output 5 lines, two integers each — coordinates of the required constellation. Output the stars in the following order: central, upper, lower, left, right.

import Array
main = interact (ans)
ans theInput = answer where
  theLines = lines theInput
  line0 = words $ head $ theLines
  n = read ( line0 !! 0 ) ::Int
  m = read ( line0 !! 1 ) ::Int
  k0 = read ( line0 !! 2 ) ::Integer
  rMax = div (min n m) 2
  k = if k0 > 5000000 then 5000000 else read ( line0 !! 2 ) ::Int
  theMap = array ((1,1),(n,m)) [((i,j),(take n (tail theLines))!!(i-1)!!(j-1)=='*')|i<-[1..n],j<-[1..m]]
  centerOfCross = [(r,i,j)|r<-[1..rMax],i<-[1+r..n-r],j<-[1+r..m-r],check i j r] ++ repeat (-1,-1,-1) where
    check i j r = and [ ce, up, lo, le, ri ] where
      ce = theMap ! (i,j)
      up = theMap ! (i-r,j)
      lo = theMap ! (i+r,j)
      le = theMap ! (i,j-r)
      ri = theMap ! (i,j+r)
  ans1 = centerOfCross !! (k-1)
  answer = if ans1==(-1,-1,-1)
              then "-1"
              else unlines $ map unwords ans0 where
                ans0 = [ce,up,lo,le,ri]
                ce = [show i,show j]
                up = [show (i-r),show j]
                lo = [show (i+r),show j]
                le = [show i,show (j-r)]
                ri = [show i,show (j+r)]
                (r,i,j) = ans1

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

main = do
	[n, m, k] <- fmap (map read . words) getLine
	a <- replicateM n getLine
	putStr $ head $ (++["-1"]) $ drop (k - 1) $ gao n m $ listArray ((1,1),(n,m)) $ concat a

gao n m a = [unlines $ map (\(i, j) -> show i ++ " " ++ show j) z |
	r <- [1 .. min n m - 1],
	s <- [[id *** id, flip (-) r *** id, (+r) *** id, id *** flip (-) r, id *** (+r)]],
	x <- [r + 1 .. n - r],
	y <- [r + 1 .. m - r],
	a!(x, y) == '*',
	z <- [map (\k -> k (x, y)) s],
	and [a!(i, j) == '*' | (i, j) <- z]]

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf
import Data.IORef
import Data.Array.Unboxed
import System.Exit

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
  c <- newIORef 1 :: IO (IORef Int)
  let getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
  forM_ ([1 .. min n m `quot` 2]) $ \d -> do
    forM_ [1 + d .. n - d] $ \i -> do
      forM_ [1 + d .. m - d] $ \j -> do
        let idx = (i, j)
        when (table ! idx == '*') $ do
          let xs =  getOthers idx d
          when ((&&) <$> all (inRange b) <*> all ((== '*') . (table !)) $ xs) $ do
            count <- readIORef c
            writeIORef c (count + 1)
            when (count == k) $ do
              forM_ (idx : xs) $ \(i', j') -> do
                printf "%d %d\n" i' j'
              exitSuccess
  printf "-1\n"

{-
7 7 4
.***...
.***...
.***...
*******
...*...
...*...
...*...
-}

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

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.Unboxed

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
      candidates = do
        i <- [1 .. n]
        j <- [1 .. m]
        let x = min i (n - i)
            y = min j (m - j)
            t = min x y
            getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
        d <- [t, t - 1 .. 1]
        let xs = getOthers (i, j) d
        guard $ all (inRange b) xs
        guard $ all ((== '*') . (table !)) xs
        return $ (i, j) : xs
  case () of
    _ | length candidates < k -> print (-1)
      | otherwise             -> do
          forM_ (candidates !! (k - 1)) $ \(i, j) -> do
            printf "%d %d\n" i j

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

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.Unboxed

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
      candidates = do
        i <- [1 .. n]
        j <- [1 .. m]
        let x = min i (n - i)
            y = min j (m - j)
            t = min x y
            getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
        d <- [1 .. t]
        let xs = getOthers (i, j) d
        guard $ all (inRange b) xs
        guard $ all ((== '*') . (table !)) xs
        return $ (i, j) : xs
  case () of
    _ | length candidates < k -> print (-1)
      | otherwise             -> do
          forM_ (candidates !! (k - 1)) $ \(i, j) -> do
            printf "%d %d\n" i j

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

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
import Text.Printf
import Data.Array.Unboxed

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
      candidates = do
        i <- [1 .. n]
        j <- [1 .. m]
        let x = min i (n - i)
            y = min j (m - j)
            t = min x y
            getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
        d <- [t .. 1]
        let xs = getOthers (i, j) d
        guard $ all (inRange b) xs
        guard $ all ((== '*') . (table !)) xs
        return $ (i, j) : xs
  case () of
    _ | length candidates < k -> print (-1)
      | otherwise             -> do
          forM_ (candidates !! (k - 1)) $ \(i, j) -> do
            printf "%d %d\n" i j

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf
import Data.IORef
import Data.Array.Unboxed
import System.Exit

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
  c <- newIORef 1 :: IO (IORef Int)
  let getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
  forM_ (range b) $ \idx -> do
    when (table ! idx == '*') $ do
      forM_ (takeWhile (all (inRange b)) $ map (getOthers idx) [1 ..]) $ \xs -> do
        when (all ((== '*') . (table !)) xs) $ do
          count <- readIORef c
          writeIORef c (count + 1)
          when (count == k) $ do
            forM_ (idx : xs) $ \(i, j) -> do
              printf "%d %d\n" i j
            exitSuccess
  printf "-1\n"

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf
import Data.IORef
import Data.Array.Unboxed
import System.Exit

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
  c <- newIORef 1 :: IO (IORef Int)
  forM_ (range b) $ \(i, j) -> do
    let getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
    forM_ (takeWhile (all (inRange b)) $ map (getOthers (i, j)) [1 ..]) $ \xs -> do
      when (all ((== '*') . (table !)) xs) $ do
        count <- readIORef c
        writeIORef c (count + 1)
        when (count == k) $ do
          forM_ ((i, j) : xs) $ \(i', j') -> do
            printf "%d %d\n" i' j'
          exitSuccess
  printf "-1\n"

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf
import Data.IORef
import Data.Array.Unboxed
import System.Exit
{-
7 7 4
.***...
.***...
.***...
*******
...*...
...*...
...*...
-}

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
  c <- newIORef 1 :: IO (IORef Int)
  let getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
  forM_ (range b) $ \idx -> do
    when (table ! idx == '*') $ do
      let t = min n m `quot` 2 + 1
      forM_ (filter (all (inRange b)) $ map (getOthers idx) [1 .. t]) $ \xs -> do
        when (all ((== '*') . (table !)) xs) $ do
          count <- readIORef c
          writeIORef c (count + 1)
          when (count == k) $ do
            forM_ (idx : xs) $ \(i, j) -> do
              printf "%d %d\n" i j
            exitSuccess
  printf "-1\n"

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

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf
import Data.IORef
import Data.Array.Unboxed
import System.Exit

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
  n : m : k : _ <- readData
  cs <- concat <$> replicateM n getLine
  let b = ((1, 1), (n , m))
      table = listArray b cs :: UArray (Int, Int) Char
  c <- newIORef 1 :: IO (IORef Int)
  let getOthers (i, j) d = [(i - d, j), (i + d, j), (i, j - d), (i, j + d)]
  forM_ (range b) $ \(i, j) -> do
    forM_ (takeWhile (all (inRange b)) $ map (getOthers (i, j)) [1 ..]) $ \xs -> do
      when (all ((== '*') . (table !)) xs) $ do
        count <- readIORef c
        writeIORef c (count + 1)
        when (count == k) $ do
          forM_ ((i, j) : xs) $ \(i', j') -> do
            printf "%d %d\n" i' j'
          exitSuccess
  printf "-1\n"

{-
  forM_ (range b) $ \idx -> do
    when (table ! idx == '*') $ do
      forM_ (takeWhile (all (inRange b)) $ map (getOthers idx) [1 ..]) $ \xs -> do
        when (all ((== '*') . (table !)) xs) $ do
          count <- readIORef c
          writeIORef c (count + 1)
          when (count == k) $ do
            forM_ (idx : xs) $ \(i, j) -> do
              printf "%d %d\n" i j
            exitSuccess
  printf "-1\n"
-}

import Array
main = interact (ans)
ans theInput = answer where
  theLines = lines theInput
  line0 = words $ head $ theLines
  n = read ( line0 !! 0 ) ::Int
  m = read ( line0 !! 1 ) ::Int
  k0 = read ( line0 !! 2 ) ::Integer
  rMax = div (min n m) 2
  k = if k0 > 5000000 then 5000000 else read ( line0 !! 2 ) ::Int
  theMap = array ((1,1),(n,m)) [((i,j),(take n (tail theLines))!!(i-1)!!(j-1)=='*')|i<-[1..n],j<-[1..m]]
  centerOfCross = [(r,i,j)|r<-[1..rMax],i<-[1+r..n-r],j<-[1+r..m-r],check i j r] ++ repeat (-1,-1,-1) where
    check i j r = and [ ce, up, lo, le, ri ] where
      ce = theMap ! (i,j)
      up = theMap ! (i-r,j)
      lo = theMap ! (i+r,j)
      le = theMap ! (i,j-r)
      ri = theMap ! (i,j+r)
  ans1 = centerOfCross !! (k-1)
  answer = if ans1==(-1,-1,-1)
              then "-1"
              else unlines $ map unwords ans0 where
                ans0 = [ce,up,lo,le,ri]
                ce = [show (i+1),show (j+1)]
                up = [show (i-r+1),show (j+1)]
                lo = [show (i+r+1),show (j+1)]
                le = [show (i+1),show (j-r+1)]
                ri = [show (i+1),show (j+r+1)]
                (r,i,j) = ans1


A very unusual citizen lives in a far away kingdom — Dwarf Gracula. However, his unusual name is not the weirdest thing (besides, everyone long ago got used to calling him simply Dwarf Greg). What is special about Dwarf Greg — he's been living for over 200 years; besides, he lives in a crypt on an abandoned cemetery and nobody has ever seen him out in daytime. Moreover, nobody has ever seen Greg buy himself any food. That's why nobody got particularly surprised when after the infernal dragon's tragic death cattle continued to disappear from fields. The people in the neighborhood were long sure that the harmless dragon was never responsible for disappearing cattle (considering that the dragon used to be sincere about his vegetarian views). But even that's not the worst part of the whole story.The worst part is that merely several minutes ago Dwarf Greg in some unintelligible way got inside your house and asked you to help him solve a problem. The point is that a short time ago Greg decided to order a new coffin (knowing his peculiar character, you are not surprised at all). But the problem is: a very long in both directions L-shaped corridor leads to Greg's crypt, and you can't drag just any coffin through that corridor. That's why he asked you to help.  You've formalized the task on a plane like this: let the corridor's width before and after the turn be equal to a and b correspondingly (see the picture). The corridor turns directly at a right angle, the coffin is a rectangle whose length and width are equal to l and w (l ≥ w) correspondingly. Dwarf Greg has already determined the coffin's length (l), which is based on his height; your task is to determine the coffin's maximally possible width (w), at which it can be brought to the crypt. Besides, due to its large mass (pure marble!) the coffin is equipped with rotating wheels; therefore it is impossible to lift it off the ground, however, arbitrary moves and rotations of the coffin in the plane become possible. The coffin may be rotated arbitrarily just before you drag it into crypt and move through the corridor.Greg promised that if you help him, he will grant you immortality (I wonder how?). And if you don't, well... trust me, you don't want to know what happens if you don't help him...

The first line contains three space-separated integers a, b and l from the problem's statement (1 ≤ a, b, l ≤ 104).

Print the maximally possible width of a coffin with absolute or relative error no more than 10 - 7. If a coffin with the given length and positive width (the coffin that would meet the conditions from the problem's statement) does not exist, print "My poor head =(" (without quotes). It is guaranteed that if the answer is positive, it will be not less than 10 - 7. All the hacks will also be checked to meet that condition.

NoteIn the first example the answer is restricted by the coffin's length (remember — coffin's widths should not be larger than it's length).In the second example it is possible to drag the coffin through the corridor thanks to rotating wheels: firstly, drag it forward by one side while it will not be hampered by the wall, then move it forward by adjacent side perpendicularly to the initial movement direction (remember — arbitrary moves and rotations of the coffin are possible).

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

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

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

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

solve :: (Double, Double, Double) -> String
solve (a, b, l)
    | ans < 0   = "My poor head =("
    | otherwise = printf "%.10f" ans
  where
    w = ternarySearch (calcW (a, b, l)) (0, pi / 2)

    eps = 1.0e-11
    lst = [b | l <= a + eps] ++ [a | l <= b + eps] ++ [w]

    ans = maximum lst `min` l

calcW (a, b, l) ang = (x1 * y2 - x2 * y1) / l
  where
    y = sin ang * l
    x = cos ang * l

    -- pointToLine (b, a) (0, y) (x, 0)
    x1 = 0 - b
    y1 = y - a

    x2 = x - b
    y2 = 0 - a

ternarySearch :: Ord a => (Double -> a) -> (Double, Double) -> a
ternarySearch func (lo, hi) = go 300 lo hi
  where
    go 0 lo hi = func ((lo + hi) / 2)
    go t lo hi
        | func mid1 < func mid2 = go (t-1) lo mid2
        | otherwise             = go (t-1) mid1 hi
      where
        mid1 = (lo + lo + hi) / 3
        mid2 = (lo + hi + hi) / 3

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State


The Super Duper Secret Meeting of the Super Duper Secret Military Squad takes place in a Super Duper Secret Place. The place is an infinite plane with introduced Cartesian coordinate system. The meeting table is represented as a rectangle whose sides are parallel to the coordinate axes and whose vertexes are located at the integer points of the plane. At each integer point which belongs to the table perimeter there is a chair in which a general sits.Some points on the plane contain radiators for the generals not to freeze in winter. Each radiator is characterized by the number ri — the radius of the area this radiator can heat. That is, if the distance between some general and the given radiator is less than or equal to ri, than the general feels comfortable and warm. Here distance is defined as Euclidean distance, so the distance between points (x1, y1) and (x2, y2) is Each general who is located outside the radiators' heating area can get sick. Thus, you should bring him a warm blanket. Your task is to count the number of warm blankets you should bring to the Super Duper Secret Place.The generals who are already comfortable do not need a blanket. Also the generals never overheat, ever if they are located in the heating area of several radiators. The radiators can be located at any integer points on the plane, even inside the rectangle (under the table) or on the perimeter (directly under some general). Even in this case their radius does not change.

The first input line contains coordinates of two opposite table corners xa, ya, xb, yb (xa ≠ xb, ya ≠ yb). The second line contains integer n — the number of radiators (1 ≤ n ≤ 103). Then n lines contain the heaters' coordinates as "xi yi ri", the numbers are separated by spaces. All input data numbers are integers. The absolute value of all coordinates does not exceed 1000, 1 ≤ ri ≤ 1000. Several radiators can be located at the same point.

Print the only number — the number of blankets you should bring.

NoteIn the first sample the generals are sitting at points: (2, 2), (2, 3), (2, 4), (2, 5), (3, 2), (3, 5), (4, 2), (4, 3), (4, 4), (4, 5). Among them, 4 generals are located outside the heating range. They are the generals at points: (2, 5), (3, 5), (4, 4), (4, 5).In the second sample the generals are sitting at points: (5, 2), (5, 3), (6, 2), (6, 3). All of them are located inside the heating range.

a#b=(min a b,max a b)
s([x,y,v,w]:[n]:t)=filter b$[(i,j)|i<-[l..r],j<-[u,d]]++[(i,j)|j<-[u+1..d-1],i<-[l,r]]where(l,r)=x#v;(u,d)=y#w;b(x,y)=all(\[i,j,r]->(i-x)^2+(j-y)^2>r^2)t
main=interact$show.length.s.map(map read.words).lines

{-# LANGUAGE ScopedTypeVariables #-}

import Control.Monad

main = do
  [x1 :: Int, y1, x2, y2] <- (liftM (map read)) . (liftM words) $ getLine
  let generals = [(x1, y) | y <- [(min y1 y2) .. (max y1 y2)]] ++
                 [(x2, y) | y <- [(min y1 y2) .. (max y1 y2)]] ++
                 [(x, y1) | x <- [(min x1 x2 + 1) .. (max x1 x2 - 1)]] ++
                 [(x, y2) | x <- [(min x1 x2 + 1) .. (max x1 x2 - 1)]]
  n <- (liftM read) getLine
  heaters <- replicateM n ((liftM (\[x, y, r] -> (read x, read y, read r))) . (liftM words) $ getLine)
  putStrLn . show . length $
    filter (\(x, y) -> all (\(hx, hy, r) -> (hx - x)*(hx - x) + (hy - y)*(hy - y) > r*r)
                           heaters)
           generals

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

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

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

main = do
  [xa, ya, xb, yb] <- getInts
  n <- readLn
  cs <- replicateM n getInts

  let
    [xa', xb'] = sort [xa, xb]
    [ya', yb'] = sort [ya, yb]

    r = length $ filter out $ [(x, ya') | x <- [xa'..xb'-1]] ++ [(xb', y) | y <- [ya'..yb'-1]] ++ [(x, yb') | x <- [xa'+1..xb']] ++ [(xa', y) | y <- [ya'+1..yb']]
      where
        out (x, y) = all (\[xx, yy, rr] -> (xx-x)^2 + (yy-y)^2 > rr^2) cs

  print r

main = interact $ show . solve . input

input :: String -> ([Int], [[Int]])
input str = (coords, circles) where
    circles = map (\xs -> map read xs) (map words ls)
    coords = map read (words cstr)
    (cstr:_:ls) = lines str

solve ([xa, ya, xb, yb], circles) = length (filter (\xy -> all (`outer` xy) circles) coords) where
    [x0, y0, r] `outer` (x, y) = (dx*dx + dy*dy) > (r*r) where
        dx = x - x0
        dy = y - y0
    coords =
        [(x, y) | x <- [xa], y <- ys] ++
        [(x, y) | x <- [xb], y <- ys] ++
        [(x, y) | x <- xs, y <- [ya]] ++
        [(x, y) | x <- xs, y <- [yb]]
    xs = let mn = min xa xb + 1; mx = max xa xb - 1; in [mn..mx]
    ys = let mn = min ya yb; mx = max ya yb; in [mn..mx]

import Data.List

data Circle = Circle Int Int Int

outsideCircles circles (x, y) = and $ map outside circles
  where outside (Circle a b r) = r*r < (a-x)*(a-x) + (b-y)*(b-y)

notCovered ((a, b), (c, d)) circles = length blankets
  where generals = nub $ concat [ [(x, b) | x <- [(min a c)..(max a c)]],
                                  [(x, d) | x <- [(min a c)..(max a c)]],
                                  [(a, y) | y <- [(min b d)..(max b d)]],
                                  [(c, y) | y <- [(min b d)..(max b d)]] ]
        blankets = filter (outsideCircles circles) generals

readInput :: IO (((Int, Int), (Int, Int)), [Circle])
readInput = do
  line <- getLine
  let nos = map (\x -> read x :: Int) (words line)
      [a, b, c, d] = nos
  line <- getLine
  let n = read line :: Int
  let getCircle = do
        line <- getLine
        let [a, b, r] = words line
            c = Circle (read a) (read b) (read r)
        return c
  circles <- sequence $ take n $ repeat getCircle
  return (((a, b), (c, d)), circles)

main = do
  (rect, circles) <- readInput
  let ans = notCovered rect circles
  putStrLn $ show ans

import Control.Monad

sqr x = x * x

check ps (x, y) =
  not $ or $ map (\[px, py, pr] -> pr * pr >= sqr (x - px) + sqr (y - py)) ps

solve xa ya xb yb ps = a + b + c + d
  where a = length $ filter (check ps) [(x, ya) | x <- [xa .. xb]]
        b = length $ filter (check ps) [(x, yb) | x <- [xa .. xb]]
        c = length $ filter (check ps) [(xa, y) | y <- [ya + 1 .. yb - 1]]
        d = length $ filter (check ps) [(xb, y) | y <- [ya + 1 .. yb - 1]]

main = do [xa, ya, xb, yb] <- fmap (map read.words) getLine
          n <- fmap read getLine
          ps <- replicateM n (fmap (map read.words) $ getLine)
          putStrLn $ show $ solve (min xa xb) (min ya yb) (max xa xb) (max ya yb) ps

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

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

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

data Circle = Circle Int Int Int

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

inCircle :: (Int, Int) -> Circle -> Bool
inCircle (x', y') (Circle x y r) = (x'-x)*(x'-x) + (y'-y)*(y'-y) <= r*r

range x y | x <= y    = tail [x..y]
          | otherwise = tail $ reverse [y..x]

solve ((x1, y1), (x2, y2), circles) = length $ filter (not.inAnyCircle) border
  where
    inAnyCircle pt = any (pt `inCircle`) circles

    border = [(x, y1) | x <- range x1 x2] ++
             [(x2, y) | y <- range y1 y2] ++
             [(x, y2) | x <- range x2 x1] ++
             [(x1, y) | y <- range y2 y1]

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

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

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

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

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

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

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

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

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

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

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

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

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

state = State

import Control.Monad
import Data.List
main = do
  [xa,ya,xb,yb] <- liftM (map read . words) getLine
  let x1 = min xa xb
      x2 = max xa xb
      y1 = min ya yb
      y2 = max ya yb
      gs = [ (x,y1) | x <- [x1..x2] ] ++
           [ (x,y2) | x <- [x1..x2] ] ++
           [ (x1,y) | y <- [y1+1..y2-1] ] ++
           [ (x2,y) | y <- [y1+1..y2-1] ]
  n <- readLn
  rs <- replicateM n $ liftM (map read . words) getLine
  print $ length $ foldl' f gs rs
f gs = flip filter gs . outOfRange
outOfRange [xr,yr,r] (x,y) = (xr-x)^2 + (yr-y)^2 > r^2

import Data.List(sort)
import Control.Applicative

main = do [xa,ya,xb,yb] <- map read . words <$> getLine
          _ <- getLine
          xyrs <- map (map read . words) . lines <$> getContents
          print $ solve [xa,ya,xb,yb] xyrs

solve :: [Int] -> [[Int]] -> Int
solve [xa',ya',xb',yb'] xyrs = length $ filter (\ (x,y) -> all (f (x,y)) xyrs) xys
   where [xa,xb] = sort [xa',xb']
         [ya,yb] = sort [ya',yb']
         xys = [(x,y)|x<-[xa,xb],y<-[ya..yb]] ++ [(x,y)|x<-[(succ xa)..(pred xb)],y<-[ya,yb]]

f (x,y) [xi,yi,ri] = (x-xi)*(x-xi) + (y-yi)*(y-yi) > ri*ri

import Control.Monad
import Data.List

type Point = (Int, Int)
type Radiator = (Int, Int, Int)

check (x, y) (xc, yc, r) =
    let dx = x - xc
        dy = y - yc
    in dx * dx + dy * dy <= r * r

solve xa ya xb yb rads =
    let pts = [(xa, y) | y <- [ya..yb]]
           ++ [(xb, y) | y <- [ya..yb]]
           ++ [(x, ya) | x <- [xa+1..xb-1]]
           ++ [(x, yb) | x <- [xa+1..xb-1]]
    in length pts - (length . filter id $
        map (\pt -> any (check pt) rads) pts)

main = do
    [xa, ya, xb, yb] <- liftM (map read . words) getLine :: IO [Int]
    n <- liftM read getLine
    list <- replicateM n $ do
        [xc, yc, r] <- liftM (map read . words) getLine :: IO [Int]
        return (xc, yc, r)

    let [xa', xb'] = sort [xa, xb]
        [ya', yb'] = sort [ya, yb]
    let ans = solve xa' ya' xb' yb' list

    putStrLn $ show ans

m a b=(min a b,max a b)
s([x,y,v,w]:[n]:t)=filter b[(i,j)|i<-[l..r],j<-[u,d]]++[(i,j)|j<-[u+1..d-1],i<-[l,r]]where(l,r)=m x v;(u,d)=m y w;b(x,y)=all(\[i,j,r]->(i-x)^2+(j-y)^2>r^2)t
main=interact$show.length.s.map(map read.words).lines


Petya has noticed that when he types using a keyboard, he often presses extra buttons and adds extra letters to the words. Of course, the spell-checking system underlines the words for him and he has to click every word and choose the right variant. Petya got fed up with correcting his mistakes himself, that’s why he decided to invent the function that will correct the words itself. Petya started from analyzing the case that happens to him most of the time, when all one needs is to delete one letter for the word to match a word from the dictionary. Thus, Petya faces one mini-task: he has a printed word and a word from the dictionary, and he should delete one letter from the first word to get the second one. And now the very non-trivial question that Petya faces is: which letter should he delete?

The input data contains two strings, consisting of lower-case Latin letters. The length of each string is from 1 to 106 symbols inclusive, the first string contains exactly 1 symbol more than the second one.

In the first line output the number of positions of the symbols in the first string, after the deleting of which the first string becomes identical to the second one. In the second line output space-separated positions of these symbols in increasing order. The positions are numbered starting from 1. If it is impossible to make the first string identical to the second string by deleting one symbol, output one number 0.

import Data.Maybe

findComm :: String -> String -> String -> (String, String, String)
findComm (a:as) (b:bs) buf
  | a == b = findComm as bs (a:buf)
  | otherwise = (buf, (a:as), (b:bs))
findComm as bs buf = (buf, as, bs)

check :: String -> String -> [Int]
check as bs = if similar xs ys then [n..i] else [0]
  where
    (left, xs, ys) = findComm as bs []
    i = length left + 1
    n = i - (if xs == "" then 0 else length $ takeWhile ((==) (head xs)) left)

similar (x:xs) (y:ys) = ((x:xs) == ys) || (xs == (y:ys))
similar [x] [] = True
similar [] [y] = True
similar _ _ = False

solve :: String -> String
solve s = unlines $ map (\is -> if is == [0] then "0" else unlines $ [show $ length is, unwords $ map show is]) iss
  where
    ss = lines s
    input = zip (getOdd ss) (getEven ss)
    iss = map (\(x,y) -> check x y) input

getEven :: [a] -> [a]
getEven [] = []
getEven [a] = []
getEven (a:b:c) = b:(getEven c)

getOdd :: [a] -> [a]
getOdd [] = []
getOdd [a] = [a]
getOdd (a:b:c) = a:(getEven c)

main :: IO ()
main = interact solve

import Data.Maybe

findComm :: String -> String -> String -> (String, String, String)
findComm (a:as) (b:bs) buf
  | a == b = findComm as bs (a:buf)
  | otherwise = (buf, (a:as), (b:bs))
findComm as bs buf = (buf, as, bs)

check :: String -> String -> [Int]
check as bs = if similar xs ys then [n..i] else [0]
  where
    (left, xs, ys) = findComm as bs []
    i = length left + 1
    nx = if xs == "" then 0 else length $ takeWhile ((==) (head xs)) left
    ny = if ys == "" then 0 else length $ takeWhile ((==) (head ys)) left
    n = i-nx-ny

similar (x:xs) (y:ys) = ((x:xs) == ys) || (xs == (y:ys))
similar [x] [] = True
similar [] [y] = True
similar _ _ = False

solve :: String -> String
solve s = unlines $ map (\is -> if is == [0] then "0" else unlines $ [show $ length is, unwords $ map show is]) iss
  where
    ss = lines s
    input = zip (getOdd ss) (getEven ss)
    iss = map (\(x,y) -> check x y) input

getEven :: [a] -> [a]
getEven [] = []
getEven [a] = []
getEven (a:b:c) = b:(getEven c)

getOdd :: [a] -> [a]
getOdd [] = []
getOdd [a] = [a]
getOdd (a:b:c) = a:(getEven c)

main :: IO ()
main = interact solve

import Data.Maybe

findComm :: String -> String -> String -> (String, String, String)
findComm (a:as) (b:bs) buf
  | a == b = findComm as bs (a:buf)
  | otherwise = (buf, (a:as), (b:bs))
findComm as bs buf = (buf, as, bs)

check :: String -> String -> [Int]
check as bs = if similar xs ys then [n..i] else [0]
  where
    (left, xs, ys) = findComm as bs []
    i = length left + 1
    nx = if xs == "" then 0 else length $ takeWhile ((==) (head xs)) left
    ny = if ys == "" then 0 else length $ takeWhile ((==) (head ys)) left
    n = i-nx-ny

similar (x:xs) (y:ys) = ((x:xs) == ys) || (xs == (y:ys))
similar [x] [] = True
similar [] [y] = True
similar _ _ = False

solve :: String -> String
solve s = unlines $ map (\is -> if is == [0] then "0\n" else unlines $ [show $ length is, unwords $ map show is]) iss
  where
    ss = lines s
    input = zip (getOdd ss) (getEven ss)
    iss = map (\(x,y) -> check x y) input

getEven :: [a] -> [a]
getEven [] = []
getEven [a] = []
getEven (a:b:c) = b:(getEven c)

getOdd :: [a] -> [a]
getOdd [] = []
getOdd [a] = [a]
getOdd (a:b:c) = a:(getEven c)

main :: IO ()
main = interact solve


Gardener Alexey teaches competitive programming to high school students. To congratulate Alexey on the Teacher's Day, the students have gifted him a collection of wooden sticks, where every stick has an integer length. Now Alexey wants to grow a tree from them.The tree looks like a polyline on the plane, consisting of all sticks. The polyline starts at the point $$$(0, 0)$$$. While constructing the polyline, Alexey will attach sticks to it one by one in arbitrary order. Each stick must be either vertical or horizontal (that is, parallel to $$$OX$$$ or $$$OY$$$ axis). It is not allowed for two consecutive sticks to be aligned simultaneously horizontally or simultaneously vertically. See the images below for clarification.Alexey wants to make a polyline in such a way that its end is as far as possible from $$$(0, 0)$$$. Please help him to grow the tree this way.Note that the polyline defining the form of the tree may have self-intersections and self-touches, but it can be proved that the optimal answer does not contain any self-intersections or self-touches.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 100\,000$$$) — the number of sticks Alexey got as a present. The second line contains $$$n$$$ integers $$$a_1, \ldots, a_n$$$ ($$$1 \le a_i \le 10\,000$$$) — the lengths of the sticks.

Print one integer — the square of the largest possible distance from $$$(0, 0)$$$ to the tree end.

NoteThe following pictures show optimal trees for example tests. The squared distance in the first example equals $$$5 \cdot 5 + 1 \cdot 1 = 26$$$, and in the second example $$$4 \cdot 4 + 2 \cdot 2 = 20$$$.

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

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

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

import qualified Data.ByteString.Char8 as B

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

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = do
	n <- readInt
	as <- reverse . sort <$> readIntegers
	let
		hor = sum $ take ( ( n + 1 ) `div` 2 ) as
		ver = sum $ drop ( ( n + 1 ) `div` 2 ) as
	print $ hor ^ 2 + ver ^ 2

module Main where

import Data.List

main :: IO ()
main = do
    n <- readLn
    a <- sort <$> map read <$> words <$> getLine
    print $ f a n

f :: [Integer] -> Int -> Integer
f a n = (val . fst $ parts) + (val . snd $ parts)
    where sqr = \x -> x * x
          parts = splitAt (div n 2) a
          val = sqr . sum

import Data.List

main :: IO ()
main = do
    n <- readLn
    as <- (map read.words) <$> getLine
    print $ solve n as

solve :: Int -> [Integer] -> Integer
solve n as = sum a^(2) + sum b^(2)
  where
    (a,b) =splitAt (n `div` 2) $ sort as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE MultiWayIf        #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE ViewPatterns      #-}
#ifndef DEBUG
{-# LANGUAGE Safe              #-}
#endif

import           Control.Applicative
import           Control.Exception
import           Control.Monad
import           Control.Monad.State.Strict
import qualified Data.Array                 as A
import qualified Data.Array.Unboxed         as UA
import qualified Data.Array.ST.Safe         as MA
import           Data.Bool
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Char8      as C
import           Data.Char
import           Data.Function
import qualified Data.IntMap.Strict         as IM
import qualified Data.IntSet                as IS
import qualified Data.List                  as L
import qualified Data.List.NonEmpty         as NL
import           Data.Monoid
import qualified Data.Map.Strict            as M
import           Data.Monoid
import           Data.Ord
import           Data.Semigroup
import qualified Data.Set                   as S
import           Data.Tuple
import           Foreign
import qualified System.IO                  as IO
#ifdef DEBUG
import           Debug.Trace
#endif

main :: IO ()
main = do
  !n <- readLn
  xs <- L.unfoldr (C.readInt.C.dropWhile isSpace) <$> C.getLine
  print $ solve n xs

solve :: Int -> [Int] -> Integer
solve n xs = sum[fromIntegral y|y<-ys]^2 + sum[fromIntegral z|z<-zs]^2
  where
    (ys, zs) = splitAt (div n 2) $ L.sort xs

import Data.List

main :: IO ()
main = do
    n <- readLn
    as <- (map read.words) <$> getLine
    print $ solve n as

solve :: Int -> [Int] -> Int
solve n as = sum a^(2::Int) + sum b^(2::Int)
  where
    (a,b) =splitAt (n `div` 2) $ sort as