This is yet another problem dealing with regular bracket sequences.We should remind you that a bracket sequence is called regular, if by inserting «+» and «1» into it we can get a correct mathematical expression. For example, sequences «(())()», «()» and «(()(()))» are regular, while «)(», «(()» and «(()))(» are not. You are given a string of «(» and «)» characters. You are to find its longest substring that is a regular bracket sequence. You are to find the number of such substrings as well.

The first line of the input file contains a non-empty string, consisting of «(» and «)» characters. Its length does not exceed 106.

Print the length of the longest substring that is a regular bracket sequence, and the number of such substrings. If there are no such substrings, write the only line containing "0 1".

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

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

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

main = do
  s <- getLine

  let
    max' l' (l, c)
      | l' > l = (l', 1)
      | l == l' = (l, c+1)
      | otherwise = (l, c)

    scan _ [] _ m = m
    scan i ('(':s) st m = scan (i+1) s (i:st) m
    scan i (')':s) [_] m = scan (i+1) s [i] m
    scan i (')':s) (_:j:st) m = scan (i+1) s (j:st) $ max' (i-j) m

    (l, c) = scan 1 s [0] (0, 1)

  putStrLn $ show l ++ " " ++ show c

{-# LANGUAGE BangPatterns #-}

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

type Index  = Int
type Depth  = Int
type Stack  = (Depth, Depth, [Index])
type State  = (Stack, (Int, Int))

push :: Index -> State -> State
push i ((d, e, is), best)
  | d == e    = ((d', d', i : is), best)
  | otherwise = ((d', e, is), best)
 where d' = d + 1

pop :: Index -> State -> State
pop i ((!d, !e, is), best@(!longest, !count))
  | d == 0    = ((0, 0, []), best)
  | otherwise = (,) (d - 1, d, is') $ case compare l longest of
    LT -> best
    EQ -> fmap succ best
    GT -> (l, 1)
 where is' = drop (e - d) is
       l = i - head is' + 1

automata :: State -> (Index, Char) -> State
automata state (i, c)
  | c == '('   = push i state
  | otherwise  = pop  i state

solve :: String -> IO ()
solve = uncurry (printf "%d %d\n")
     . snd . foldl automata ((0, 0, []), (0, 1)) . zip [0 ..]

main :: IO ()
main = getLine >>= solve

import Data.List
data St = Open | Close | Sub Int
red st [] =
    let nList = map (\(Sub x) -> x) $ filter (\x -> case x of {Sub _ -> True; _ -> False}) st in
    case nList of
        [] -> [0, 1]
        _ -> let (s:_) = group $ sortBy (flip compare) nList in [head s, length s]
red st                     ('(':inpStr) = red (Open:st)         inpStr
red (Sub n:Open:Sub n1:st) (')':inpStr) = red (Sub (n+n1+2):st) inpStr
red (Sub n:Open:st)        (')':inpStr) = red (Sub (n+2):st)    inpStr
red (Open:Sub n:st)        (')':inpStr) = red (Sub (n+2):st)    inpStr
red (Open:st)              (')':inpStr) = red (Sub 2:st)        inpStr
red st                     (')':inpStr) = red (Close:st)        inpStr
main = (unwords . map show . red []) `fmap` getLine >>= putStrLn

import Text.Printf

main = do
     line <- getLine
     putStrLn . (\(opt,cnt,_,_,_) -> printf "%d %d" (opt::Int) (cnt::Int))
              . foldl (\(opt,cnt,b,s,i) c ->
              if c == '(' then
                 (opt,cnt,b,i:s,i+1)
              else if null s then
                   (opt,cnt,i,[],i+1)
              else let s' = tail s
                       opt' = i - (if null s' then b else head s')
                   in  if opt' > opt then
                          (opt',1,b,s',i+1)
                       else
                          (opt,cnt+(if opt' == opt then 1 else 0),b,s',i+1)
              ) (0,1,-1,[],0) $ line

module Main where

import Data.List (foldl')

main :: IO ()
main = interact solve

solve :: String -> String
solve input = show len <> " " <> show count
  where
    states = foldl' toState [] input
    (len, count) = foldl' foldBest (0, 1) states

data State = Open | Close | Replace !Int deriving (Show)

foldBest :: (Int, Int) -> State -> (Int, Int)
foldBest (l, c) (Replace k) | l == k = (k, c + 1)
foldBest (l, c) (Replace k) | l < k  = (k, 1)
foldBest s      _                    = s

toState :: [State] -> Char -> [State]
toState   s                            '(' = Open:s
toState  (Replace k:Open:Replace n:s)  ')' = Replace (k + n + 2):s
toState  (Open:Replace n:s)            ')' = Replace (n + 2):s
toState  (Replace n:Open:s)            ')' = Replace (n + 2):s
toState  (Open:s)                      ')' = Replace 2:s
toState   s                            ')' = Close:s
toState   s                             _  = s

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

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

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

main = do
  s <- getLine

  let
    max' l' (l, c)
      | l' > l = (l', 1)
      | l == l' = (l, c+1)
      | otherwise = (l, c)

    scan i [] [0] m = max' (i-1) m
    scan _ [] _ m = m
    scan i ('(':s) st m = scan (i+1) s (i:st) m
    scan i (')':s) [] m = scan (i+1) s [] m
    scan i (')':s) (j:st) m = scan (i+1) s st $ max' (i-j+1) m

    (l, c) = scan 1 s [0] (0, 1)

  putStrLn $ show l ++ " " ++ show c

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

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

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

main = do
  s <- getLine

  let
    max' l' (l, c)
      | l' > l = (l', 1)
      | l == l' = (l, c+1)
      | otherwise = (l, c)

    scan [] _ l m = m
    scan (c:s) d l m
        | d' < 0 = scan s 0 0 m
        | d' == 0 = scan s d' (l+1) $ max' (l+1) m
        | otherwise = scan s d' (l+1) m
      where
        d' = d + if c == '(' then 1 else -1

    (l, c) = scan s 0 0 (0, 1)

  putStrLn $ show l ++ " " ++ show c

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

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

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

main = do
  s <- getLine

  let
    max' l' (l, c)
      | l' > l = (l', 1)
      | l == l' = (l, c+1)
      | otherwise = (l, c)

    scan _ [] _ m = m
    scan i ('(':s) st m = scan (i+1) s (i:st) m
    scan i (')':s) [] m = scan (i+1) s [] m
    scan i (')':s) (j:st) m = scan (i+1) s st $ max' (i-j+1) m

    (l, c) = scan 1 s [] (0, 1)

  putStrLn $ show l ++ " " ++ show c

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

type Index = Int
type Longest = Int
type Count = Int
type State = ([Index], (Longest, Count))

automata :: State -> (Index, Char) -> State
automata state@(stack, best) (i, c)
  | c == '('   = (i : stack, best)
  | null stack = state
  | otherwise  = update state i

update :: State -> Index -> State
update (j : stack, best@(longest, _)) i =
  case compare l longest of
    LT -> (stack, best)
    EQ -> (stack, fmap succ best)
    GT -> (stack, (l, 1))
 where l = i - j + 1

exec :: String -> (Longest, Count)
exec = snd . foldl' automata ([], (0, 1)) . zip [0 ..]

solve :: String -> IO ()
solve = do
  (v, n) <- exec
  return $ printf "%d %d\n" v n

main = getLine >>= solve

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

type Depth = Int
type Score = Int
type Count = Int
type State = ((Depth, Score), (Score, Count))

updateBest :: State -> State
updateBest (state@(d, s), best@(v, n))
  | s < v || s == 0 = (state, best)
  | s == v          = (state, (v, n + 1))
  | s > v           = (state, (s, 1))

automata :: State -> Char -> State
automata ((d, s), best@(v, n)) c
  | c == '('  = ((d + 1, s), best)
  | d > 0     = updateBest ((d - 1, s + 2), best)
  | d == 0    = updateBest ((0, 0), best)
  | d < 0     = error "automata: Never happens!"
 where

exec :: String -> (Score, Count)
exec = snd . foldl' automata ((0, 0), (0, 1))

solve :: String -> IO ()
solve = do
  (v, n) <- exec
  return $ printf "%d %d\n" v n

main = getLine >>= solve

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

type Depth = Int
type Score = Int
type Count = Int
type State = ((Depth, Score), (Score, Count))

automata :: State -> Char -> State
automata ((d, s), best@(v, n)) c
  | c == '\0' = updateBest
  | c == '('  = ((d + 1, s), best)
  | d > 0     = ((d - 1, s + 2), best)
  | d == 0    = updateBest
  | d < 0     = error "automata: Never happens!"
 where
  updateBest
    | s < v || s == 0 = ((0, 0), best)
    | s == v          = ((0, 0), (v, n + 1))
    | s > v           = ((0, 0), (s, 1))

exec :: String -> (Score, Count)
exec = snd . (`automata` '\0') . foldl' automata ((0, 0), (0, 1))

solve :: String -> IO ()
solve = do
  (v, n) <- exec
  return $ printf "%d %d\n" v n

main = getLine >>= solve

import Text.Printf

main = do
     line <- getLine
     putStrLn . (\(opt,cnt,_,_,_) -> printf "%d %d" (opt::Int) (cnt::Int))
              . foldl (\(opt,cnt,b,s,i) c ->
              if c == '(' then
                 (opt,cnt,b,i:s,i+1)
              else if null s then
                   (opt,cnt,i,[],i+1)
              else let s' = tail s
                       opt' = i - (if null s' then b else head s')
                   in  if opt' > opt then
                          (opt',1,b,s',i+1)
                       else
                          (opt,cnt+(if opt' == opt then 1 else 0),b,s',i+1)
              ) (0,0,-1,[],0) $ line

module Main where

import Data.List (foldl')

main :: IO ()
main = interact solve

solve :: String -> String
solve input = show len <> " " <> show count
  where
    states = foldl' toState [] input
    (len, count) = foldl' foldBest (0, 1) states

data State = Open | Close | Replace !Int

foldBest :: (Int, Int) -> State -> (Int, Int)
foldBest (l, c) (Replace k) | l == k = (k, c + 1)
foldBest (l, c) (Replace k) | l < k  = (k, 1)
foldBest s      _                    = s

toState :: [State] -> Char -> [State]
toState   s                            '(' = Open:s
toState  (Replace k:Open:Replace n:s)  _   = Replace (k + n + 2):s
toState  (Open:Replace n:s)            _   = Replace (n + 2):s
toState  (Replace n:Open:s)            _   = Replace (n + 2):s
toState  (Open:s)                      _   = Replace 2:s
toState   s                            _   = Close:s


Emuskald is an avid horticulturist and owns the world's longest greenhouse — it is effectively infinite in length.Over the years Emuskald has cultivated n plants in his greenhouse, of m different plant species numbered from 1 to m. His greenhouse is very narrow and can be viewed as an infinite line, with each plant occupying a single point on that line.Emuskald has discovered that each species thrives at a different temperature, so he wants to arrange m - 1 borders that would divide the greenhouse into m sections numbered from 1 to m from left to right with each section housing a single species. He is free to place the borders, but in the end all of the i-th species plants must reside in i-th section from the left.Of course, it is not always possible to place the borders in such way, so Emuskald needs to replant some of his plants. He can remove each plant from its position and place it anywhere in the greenhouse (at any real coordinate) with no plant already in it. Since replanting is a lot of stress for the plants, help Emuskald find the minimum number of plants he has to replant to be able to place the borders.

The first line of input contains two space-separated integers n and m (1 ≤ n, m ≤ 5000, n ≥ m), the number of plants and the number of different species. Each of the following n lines contain two space-separated numbers: one integer number si (1 ≤ si ≤ m), and one real number xi (0 ≤ xi ≤ 109), the species and position of the i-th plant. Each xi will contain no more than 6 digits after the decimal point. It is guaranteed that all xi are different; there is at least one plant of each species; the plants are given in order "from left to the right", that is in the ascending order of their xi coordinates (xi < xi + 1, 1 ≤ i < n).

Output a single integer — the minimum number of plants to be replanted.

NoteIn the first test case, Emuskald can replant the first plant to the right of the last plant, so the answer is 1.In the second test case, the species are already in the correct order, so no replanting is needed.

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

main = do
	input <- C.getContents
	let
		(_:_:xs)  = map C.readInt $ C.words input
		toIntArray [] = []
		toIntArray ((Just a):_:rest) = (fst a) : (toIntArray rest)
		plants = toIntArray xs
	print $ solve plants

solve :: [Int] -> Int
solve xs = length xs - dp [] xs
	where
		dp xs [] = length xs
		dp xs (x:rest)
			| xs == [] || (head xs) <= x = dp (x:xs) rest
			| otherwise = dp (a ++ (x:b)) rest
			where
				(c,b) = partition (>x) xs
				a = init c


A bracket sequence is a string containing only characters "(" and ")". A regular bracket sequence is a bracket sequence that can be transformed into a correct arithmetic expression by inserting characters "1" and "+" between the original characters of the sequence. For example, bracket sequences "()()" and "(())" are regular (the resulting expressions are: "(1)+(1)" and "((1+1)+1)"), and ")(", "(" and ")" are not.You are given an integer $$$n$$$. Your goal is to construct and print exactly $$$n$$$ different regular bracket sequences of length $$$2n$$$.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 50$$$) — the number of test cases. Each test case consists of one line containing one integer $$$n$$$ ($$$1 \le n \le 50$$$).

For each test case, print $$$n$$$ lines, each containing a regular bracket sequence of length exactly $$$2n$$$. All bracket sequences you output for a testcase should be different (though they may repeat in different test cases). If there are multiple answers, print any of them. It can be shown that it's always possible.

import Control.Monad (replicateM_, replicateM)

outer 0 = ""
outer 1 = "()"
outer n = "()" ++ outer (n - 1)

nested 0 = ""
nested 1 = "()"
nested n = "(" ++ nested (n - 1) ++ ")"

solve :: IO ()
solve = do
    n <- getLine
    let m = read n :: Int
    let res = map (\x ->  outer x ++ nested (m - x) )  [0..m-1]
    putStr $ unlines res

main :: IO ()
main =  do
    t <- getLine
    replicateM_ (read t :: Int) solve

import Control.Monad (replicateM_, replicateM)

outer 0 = ""
outer 1 = "()"
outer n = "()" ++ outer ( n - 1 )

nested 0 = ""
nested 1 = "()"
nested n = "(" ++ nested (n - 1) ++ ")"

solve :: IO ()
solve = do
	n <- getLine
	let m = (read n :: Int)
	let res = map (\x ->  (outer x) ++ (nested(m - x)))  [0..m-1]
	putStr ( unlines res )

main :: IO ()
main =  do
	t <- getLine
	replicateM_ (read t :: Int)  solve

import Control.Monad
import Data.List

calc :: Int -> [String]
calc 1 = ["()"]
calc 2 = ["()()","(())"]
calc n =
  let prev = calc (n-1)
      first = head prev
      s1 = map (\x -> "()" ++ x) $ prev
  in
    ("(" ++ first ++ ")"):s1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    forM_ (calc n) $ \a -> do
      putStrLn a

import Control.Monad ( replicateM_ )

solve :: IO ()
solve = do
    n <- readLn
    let build  i = replicate i '(' ++ take (2 * (n - i)) (cycle "()") ++ replicate i ')'
    putStr $ unlines $ map build [0..n-1]

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

main = interact $ unlines . concatMap (solve . read) . drop 1 . lines

solve :: Int -> [String]
solve 0 = []
solve 1 = ["()"]
solve n = take n $ map ("()"++) base ++ map (\c -> "(" ++ c ++ ")")  base
  where base = solve $ n - 1

module Main where

main = interact $ concatMap solve . tail . lines

solve s = unlines $ take n $ paren n
  where
  n = read s :: Int

paren 0 = [""]
paren n = [ "(" ++ x ++ ")" ++ y
          | m <- [0..n-1] , x <- paren m , y <- paren (n-1-m) ]

import Control.Monad

solve :: IO ()
solve = do
    n <- readLn
    let build i = replicate i '(' ++ take (2 * (n - i)) (cycle "()") ++ replicate i ')'
    putStr $ unlines $ map build [0 .. n - 1]

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

{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}

import           Control.Arrow
import           Control.Monad.State
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import           Data.ByteString.Lazy.Char8 (ByteString)
import qualified Data.ByteString.Lazy.Char8 as C
import           Data.Char
import qualified Data.Foldable              as F
import           Data.Function
import           Data.Graph
import           Data.List
import           Data.Map                   (Map, (!))
import qualified Data.Map                   as M
import           Data.Maybe
import           Data.Ord
import           Data.Ratio
import           Data.Sequence              (Seq, ViewL (..), ViewR (..), (<|),
                                             (|>))
import qualified Data.Sequence              as Seq
import           Data.Set                   (Set)
import qualified Data.Set                   as S
import           Data.Tree
import           Text.Printf

-- import Text.Parsec
-- import Text.Parsec.Expr
-- import Text.Parsec.Language (emptyDef)
-- import Text.Parsec.String
-- import qualified Text.Parsec.Token as T

infixl 0 >$>
(>$>) = flip ($)

readB = C.unpack >>> read

main = C.interact $
  C.lines >>> drop 1 >>> concatMap (readB >>> solve) >>> C.unlines

bracketSeqs 0 = [""]
bracketSeqs n =
  [ "(" ++ s1 ++ ")" ++ s2
  | k <- [0 .. n-1]
  , s1 <- bracketSeqs k
  , s2 <- bracketSeqs (n - k - 1)
  ]

solve n = map C.pack . take n $ bracketSeqs n

import Control.Monad
import Data.List

calc :: Int -> [String]
calc 1 = ["()"]
calc 2 = ["()()","(())"]
calc 3 = ["()()()","(())()","(()()())"]
calc n =
  let prev = calc (n-1)
      first = head prev
      s1 = map (\x -> "()" ++ x) $ prev
  in
    ("(" ++ first ++ ")"):s1

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- getLine
    let n = read line :: Int
    forM_ (calc n) $ \a -> do
      putStrLn a


Boboniu gives you  $$$r$$$ red balls,  $$$g$$$ green balls,  $$$b$$$ blue balls,  $$$w$$$ white balls. He allows you to do the following operation as many times as you want:   Pick a red ball, a green ball, and a blue ball and then change their color to white. You should answer if it's possible to arrange all the balls into a palindrome after several (possibly zero) number of described operations.

The first line contains one integer $$$T$$$ ($$$1\le T\le 100$$$) denoting the number of test cases. For each of the next $$$T$$$ cases, the first line contains four integers $$$r$$$, $$$g$$$, $$$b$$$ and $$$w$$$ ($$$0\le r,g,b,w\le 10^9$$$).

For each test case, print "Yes" if it's possible to arrange all the balls into a palindrome after doing several (possibly zero) number of described operations. Otherwise, print "No".

NoteIn the first test case, you're not able to do any operation and you can never arrange three balls of distinct colors into a palindrome.In the second test case, after doing one operation, changing $$$(8,1,9,3)$$$ to $$$(7,0,8,6)$$$, one of those possible palindromes may be "rrrwwwbbbbrbbbbwwwrrr".A palindrome is a word, phrase, or sequence that reads the same backwards as forwards. For example, "rggbwbggr", "b", "gg" are palindromes while "rgbb", "gbbgr" are not. Notice that an empty word, phrase, or sequence is palindrome.

{-# 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 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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = do
	t <- readInt
	mapM_ putStrLn =<< replicateM t solve

solve = do
	rgbw@[ r, g, b, w ] <- readInts
	return $ if check rgbw || check ( map pred [ r, g, b ] ++ [ w + 3 ] )
		then "Yes"
		else "No"

check rgbw = all ( 0 <= ) rgbw && length ( ( filter odd ) rgbw ) <= 1

import Control.Monad
import Data.Bool
-- import Data.List

solve :: IO ()
solve = do
  as <- map read . words <$> getLine
  let cnt = sum [x `rem` 2 | x <- as] in
    putStrLn $ bool "No" "Yes" $ (((minimum $ take 3 as) > 0 && cnt /= 2) || cnt <= 1)

main :: IO ()
main = do
  getLine >>= flip replicateM_ solve . read

{-# LANGUAGE TypeApplications #-}

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

main = do
  t <- read @Int <$> getLine
  replicateM_ t $ do
    a@[r, g, b, w] <- map (read @Int) . words <$> getLine
    let t = if 0 `elem` [r, g, b]
          then ch a
          else ch a || ch [r - 1, g - 1, b - 1, w + 3]
    putStrLn $ if t then "Yes" else "No"
  where ch = (<= 1) . length . filter odd

{-# 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 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

printList [a] = print a
printList (a:as) = putStr ( show a ) >> putChar ' ' >> printList as

main = do
	t <- readInt
	mapM_ putStrLn =<< replicateM t solve

solve = do
	rgbw <- readInts
	return $ if check rgbw || check ( map pred rgbw )
		then "Yes"
		else "No"

check rgbw = all ( 0 <= ) rgbw && length ( ( filter odd ) rgbw ) <= 1


A permutation p of size n is the sequence p1, p2, ..., pn, consisting of n distinct integers, each of them is from 1 to n (1 ≤ pi ≤ n).A lucky permutation is such permutation p, that any integer i (1 ≤ i ≤ n) meets this condition ppi = n - i + 1.You have integer n. Find some lucky permutation p of size n.

The first line contains integer n (1 ≤ n ≤ 105) — the required permutation size.

Print "-1" (without the quotes) if the lucky permutation p of size n doesn't exist. Otherwise, print n distinct integers p1, p2, ..., pn (1 ≤ pi ≤ n) after a space — the required permutation. If there are multiple answers, you can print any of them.

import Data.List

solve n | n `mod` 4 >= 2 = []
solve n = [ p i | i <- [1..n] ]
  where p i | 2*i == 1+n = i
            | 2*i < 1+n  = if odd i then i+1 else n+2-i
            | otherwise  = if even (n-i) then i-1 else n-i

main = do
  n <- fmap read getLine :: IO Int
  let p = solve n
  if null p
    then putStrLn "-1"
    else putStrLn $ intercalate " " (map show p)


This is an easy version of the problem. The only difference between an easy and a hard version is the constraints on $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$.You are given $$$4$$$ positive integers $$$a$$$, $$$b$$$, $$$c$$$, $$$d$$$ with $$$a < c$$$ and $$$b < d$$$. Find any pair of numbers $$$x$$$ and $$$y$$$ that satisfies the following conditions: $$$a < x \leq c$$$, $$$b < y \leq d$$$, $$$x \cdot y$$$ is divisible by $$$a \cdot b$$$.Note that required $$$x$$$ and $$$y$$$ may not exist.

The first line of the input contains a single integer $$$t$$$ $$$(1 \leq t \leq 10$$$), the number of test cases. The descriptions of the test cases follow. The only line of each test case contains four integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$ ($$$1 \leq a < c \leq 10^5$$$, $$$1 \leq b < d \leq 10^5$$$).

For each test case print a pair of numbers $$$a < x \leq c$$$ and $$$b < y \leq d$$$ such that $$$x \cdot y$$$ is divisible by $$$a \cdot b$$$. If there are multiple answers, print any of them. If there is no such pair of numbers, then print -1 -1.

{-# LANGUAGE CPP, BlockArguments, DatatypeContexts, DeriveFunctor, GADTs, LambdaCase, NumericUnderscores, OverloadedStrings, ScopedTypeVariables, TupleSections  #-}
-- {-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O3 -funbox-strict-fields -fvia-C -optc-O3 #-}
#ifndef DEBUG
{-# LANGUAGE Safe #-}
#endif

import qualified Data.ByteString.Char8 as B8
import qualified Data.String as S

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe
import qualified Data.Traversable as T

import qualified Control.Applicative as A
import qualified Control.Monad as M
import qualified Control.Monad.State as MS
import qualified Control.Monad.Trans as MT
import qualified Control.Monad.Trans.Maybe as M

import qualified Data.List as L
import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import qualified Data.IntSet as IS
import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.List (sortBy, sortOn)

import Data.Char
import Data.Int

import System.IO (stdin, stdout, hFlush)
import Text.Printf

#ifdef DEBUG
import Debug.Trace (trace, traceM, traceShowM)
debug = flip trace

tracing t x = trace (t ++ " = " ++ show x) x
debugging x t = tracing t x

tracingM t x = traceM $ t ++ " = " ++ show x

#else

debug x _ = x
trace _ x = x
tracing _ x = x
debugging x _ = x

traceM _ = pure ()
tracingM _ _ = pure ()
#endif

{- reading -}
readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

{- writing -}
putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- aux -}
modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

{- solution -}

solve :: (Int, Int) -> (Int, Int) -> Maybe (Int, Int)
solve (a, c) (b, d) = listToMaybe do
    let g :: Int64 = fromIntegral a * fromIntegral b

    x <- [a .. c]
    M.guard $ a < x && x <= c

    tracingM "g" g
    tracingM "x" x

    let commonDiv = gcd g (fromIntegral x)
    let yDiv = g `div` commonDiv
    tracingM "yDiv" yDiv

    let lrY = ((fromIntegral b) `div` yDiv + 1) * yDiv
    tracingM "lrY" lrY
    y <- [lrY - 1 .. lrY + 1]
    M.guard $ (fromIntegral b) < y && y <= (fromIntegral d)
    M.guard $ (y * fromIntegral x) `mod` g == 0

    return (x, fromIntegral y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [a, b, c, d] <- B8.getLine <&> readIntB8s
        let (x, y) = fromMaybe (-1, -1) $ solve (a, c) (b, d)
        printf "%d %d\n" x y


Andrew often reads articles in his favorite magazine 2Char. The main feature of these articles is that each of them uses at most two distinct letters. Andrew decided to send an article to the magazine, but as he hasn't written any article, he just decided to take a random one from magazine 26Char. However, before sending it to the magazine 2Char, he needs to adapt the text to the format of the journal. To do so, he removes some words from the chosen article, in such a way that the remaining text can be written using no more than two distinct letters.Since the payment depends from the number of non-space characters in the article, Andrew wants to keep the words with the maximum total length.

The first line of the input contains number n (1 ≤ n ≤ 100) — the number of words in the article chosen by Andrew. Following are n lines, each of them contains one word. All the words consist only of small English letters and their total length doesn't exceed 1000. The words are not guaranteed to be distinct, in this case you are allowed to use a word in the article as many times as it appears in the input.

Print a single integer — the maximum possible total length of words in Andrew's article.

NoteIn the first sample the optimal way to choose words is {'abb', 'aaa', 'bbb'}.In the second sample the word 'cdecdecdecdecdecde' consists of three distinct letters, and thus cannot be used in the article. The optimal answer is {'a', 'a', 'aaaa'}.

import Control.Monad

pairs = [(x, y)| x<-['a'..'z'], y<-['a'..'z'], x<=y]

article inp (f,s) = filter (not.any (\x->x /= f && x/=s)) inp

cost :: [[a]] -> Int
cost = length . concat

main = getLine >>= (flip replicateM $ getLine) . read >>= putStrLn . show . maximum . (map cost) . (\x -> (map (article x) pairs))

import Data.List

main :: IO()
main = print . solve . tail . words =<< getContents

chars :: [Char]
chars = ['a'..'z']

solve :: [String] -> Int
solve strs = last $ sort $ map (countNum (filter (\s -> (numOfDChar s) <= 2) strs)) [(x, y) | x <- chars, y <- chars]

numOfDChar :: String -> Int
numOfDChar s = sum $ map (\c -> if elem c s then 1 else 0) chars

countNum :: [String] -> (Char, Char) -> Int
countNum fed (x, y) = sum $ map length $ filter (\s -> and (map (\c -> c == x || c == y) s)) fed

import Data.Array
import Data.Array.MArray.Safe
import Data.Array.ST.Safe
import Data.List
import Control.Monad
import Control.Monad.ST.Safe

-- getInts = fmap (map read . words) getLine

main = do
  n <- readLn
  ss <- replicateM n getLine

  let
    count a b = sum $ map length $ filter (all (\c -> c == a || c == b)) ss

  print $ maximum [count a b | a <- ['a'..'z'], b <- ['a'..'z'], a /= b]

solve :: [String] -> Int
solve words = maximum [sum . map length . filter (all (\c -> c == a || c == b)) $ words | a <- ['a'..'z'], b <- ['a'..'z']]

main :: IO ()
main = do
    input <- getContents
    let words = tail . lines $ input
    putStrLn $ show . solve $ words

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import qualified Data.List as L
import Control.Applicative
readInts a = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.words a
readLists = readInts $ B.getLine
readLLists = fmap (map (fst . fromJust)) $ fmap (map B.readInt) $ fmap B.lines $ B.getContents
readMatrix = fmap readInts $ fmap B.lines $ B.getContents
isOk::String -> String -> Bool
isOk cs s = and $ map (\x -> elem x cs) s
main = do
  n <- getLine
  ss <- lines <$> getContents
  let l = map length ss
  let allp = [a:b:[]|a<-['a'..'z'],b<-['a'..'z'],a/=b]
  print $ L.maximum [sum $ zipWith (\x y -> if x then y else 0) [isOk s a | a <- ss] l |s<-allp]

import Control.Monad

containsOnly :: String -> Char -> Char -> Bool
containsOnly word c1 c2 = and[c == c1 || c == c2 | c <- word]

solve :: [String] -> Char -> Char -> Int
solve words c1 c2
    | c1 == 'z' && c2 == 'z' = result
    | otherwise = max result (solve words next_c1 next_c2)
    where
        result = sum [length word | word <- words, containsOnly word c1 c2 == True]
        next_c1 = if c2 == 'z' then succ c1 else c1
        next_c2 = if c2 == 'z' then 'a' else succ c2

main = do
    line <- getLine

    let n = read line :: Int
    words <- forM [1..n] (\a -> getLine)

    print (solve words 'a' 'a')

import qualified Data.List as L

valid :: (Char, Char) -> String -> Bool
valid _ "" = True
valid (a,b) (s:ss)
    | s == a || s == b      = valid (a,b) ss
    | otherwise             = False

totSize :: (Char,Char) -> [String] -> Int
totSize c ss = sum $ map length $ filter (valid c) ss

solve :: [String] -> Int
solve ss = maximum [totSize (a,b) ss | a <- ['a'..'z'], b<- ['a'..'z']]

main :: IO ()
main = interact $ show . solve . tail . lines

type Input  = [String]
type Output = Int

parse :: String -> Input
parse = tail . lines

chars :: String
chars = ['a'..'z']

solve :: Input -> Output
solve ws = maximum [sum . map length . filter (all (\c -> c == a || c == b)) $ ws | a <- chars, b <- chars]

format :: Output -> String
format = show

main :: IO ()
main = putStrLn . format . solve . parse =<< getContents

import Control.Monad

pairs = [(x, y)| x<-['a'..'z'], y<-['a','z'], x<=y]

article inp (f,s) = filter (not.any (\x->x /= f && x/=s)) inp

cost :: [[a]] -> Int
cost = length . concat

main = getLine >>= (flip replicateM $ getLine) . read >>= putStrLn . show . maximum . (map cost) . (\x -> (map (article x) pairs))

import Control.Monad

pairs = [(x, y)| x<-['a'..'z'], y<-['a','z'], x<=y]

article inp (f,s) = filter (not.any (\x->x == f || x==s)) inp

cost :: [[a]] -> Int
cost = length . concat

main = getLine >>= (flip replicateM $ getLine) . read >>= putStrLn . show . maximum . (map cost) . (\x -> (map (article x) pairs))

import Control.Monad

pairs = [(x, y)| x<-['a'..'z'], y<-['a','z'], x<=y]

article inp (f,s) = filter (not.any (\x->x /= f || x/=s)) inp

cost :: [[a]] -> Int
cost = length . concat

main = getLine >>= (flip replicateM $ getLine) . read >>= putStrLn . show . maximum . (map cost) . (\x -> (map (article x) pairs))


The board has got a painted tree graph, consisting of n nodes. Let us remind you that a non-directed graph is called a tree if it is connected and doesn't contain any cycles.Each node of the graph is painted black or white in such a manner that there aren't two nodes of the same color, connected by an edge. Each edge contains its value written on it as a non-negative integer.A bad boy Vasya came up to the board and wrote number sv near each node v — the sum of values of all edges that are incident to this node. Then Vasya removed the edges and their values from the board.Your task is to restore the original tree by the node colors and numbers sv.

The first line of the input contains a single integer n (2 ≤ n ≤ 105) — the number of nodes in the tree. Next n lines contain pairs of space-separated integers ci, si (0 ≤ ci ≤ 1, 0 ≤ si ≤ 109), where ci stands for the color of the i-th vertex (0 is for white, 1 is for black), and si represents the sum of values of the edges that are incident to the i-th vertex of the tree that is painted on the board.

Print the description of n - 1 edges of the tree graph. Each description is a group of three integers vi, ui, wi (1 ≤ vi, ui ≤ n, vi ≠ ui, 0 ≤ wi ≤ 109), where vi and ui — are the numbers of the nodes that are connected by the i-th edge, and wi is its value. Note that the following condition must fulfill cvi ≠ cui. It is guaranteed that for any input data there exists at least one graph that meets these data. If there are multiple solutions, print any of them. You are allowed to print the edges in any order. As you print the numbers, separate them with spaces.

import Control.Monad
import Data.Maybe
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as C

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

type PQ = S.Set (Int, Int)

data Info = Info {
  ws :: PQ,
  bs :: PQ,
  vs :: [(Int, Int)]
}

gao :: [[Int]] -> State Info [[Int]]
gao ans = do
  w <- gets ws
  b <- gets bs
  if S.null w || S.null b
    then do
      ((wv, bv): t) <- gets vs
      wvs <- forM (t ++ [(i, i) | (_, i) <- S.toList w]) $ \(i, _) -> do
        return [bv, i, 0]
      bvs <- forM [(i, i) | (_, i) <- S.toList b] $ \(_, i) -> do
        return [wv, i, 0]
      return $ ans ++ wvs ++ bvs
    else do
      (we, wv) <- gets (S.findMax . ws)
      modify $ \info -> info{ws = S.deleteMax $ ws info}
      (be, bv) <- gets (S.findMax . bs)
      modify $ \info -> info{bs = S.deleteMax $ bs info}
      let e = min we be
      case compare we be of
        EQ -> modify $ \info -> info{vs = (wv, bv): vs info}
        GT -> modify $ \info -> info{ws = S.insert (we - e, wv) $ ws info}
        LT -> modify $ \info -> info{bs = S.insert (be - e, bv) $ bs info}
      gao $ [wv, bv, e]: ans

main :: IO ()
main = do
  (n:cs) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  let a = [(c, (s, i)) | (i, (c, s)) <- zip [1 .. n] $ pairs cs]
      w = S.fromList $ map snd $ filter ((==0) . fst) a
      b = S.fromList $ map snd $ filter ((==1) . fst) a
      ans = fst $ runState (gao []) $ Info w b []
  putStrLn $ unwords $ map show $ concat ans

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

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

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

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

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

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

import Data.Maybe
import Data.Int
import Text.Printf
import qualified Data.ByteString.Char8 as B

groups :: [Int] -> Int -> ([(Int, Int)], [(Int, Int)])
groups [] n = ([], [])
groups (x:y:xs) n
       | x == 0 = ((y, n):b, w)
       | x == 1 = (b, (y, n):w)
       where (b, w) = groups xs (n + 1)

work :: [(Int, Int)] -> [(Int, Int)] -> [(Int, Int, Int)]
work bs [] = []
work [] ws = []
work ((fb, sb) : bs) ((fw, sw) : ws)
    | (fb < fw) || ((fb == fw) && (null ws)) = (sb, sw, fb) : work bs ((fw - fb, sw):ws)
    |  otherwise                             = (sb, sw, fw) : work ((fb - fw, sb):bs) ws

main = do
  n : input <- fmap (map (fst . fromJust . B.readInt) . B.words) B.getContents
  let (b, w) = groups input 1
      ans = work b w
  mapM_ (\(x,y,z) -> printf "%d %d %d\n" x y z) ans


Little Vasya went to the supermarket to get some groceries. He walked about the supermarket for a long time and got a basket full of products. Now he needs to choose the cashier to pay for the products.There are n cashiers at the exit from the supermarket. At the moment the queue for the i-th cashier already has ki people. The j-th person standing in the queue to the i-th cashier has mi, j items in the basket. Vasya knows that:  the cashier needs 5 seconds to scan one item;  after the cashier scans each item of some customer, he needs 15 seconds to take the customer's money and give him the change. Of course, Vasya wants to select a queue so that he can leave the supermarket as soon as possible. Help him write a program that displays the minimum number of seconds after which Vasya can get to one of the cashiers.

The first line contains integer n (1 ≤ n ≤ 100) — the number of cashes in the shop. The second line contains n space-separated integers: k1, k2, ..., kn (1 ≤ ki ≤ 100), where ki is the number of people in the queue to the i-th cashier. The i-th of the next n lines contains ki space-separated integers: mi, 1, mi, 2, ..., mi, ki (1 ≤ mi, j ≤ 100) — the number of products the j-th person in the queue for the i-th cash has.

Print a single integer — the minimum number of seconds Vasya needs to get to the cashier.

NoteIn the second test sample, if Vasya goes to the first queue, he gets to the cashier in 100·5 + 15 = 515 seconds. But if he chooses the second queue, he will need 1·5 + 2·5 + 2·5 + 3·5 + 4·15 = 100 seconds. He will need 1·5 + 9·5 + 1·5 + 3·15 = 100 seconds for the third one and 7·5 + 8·5 + 2·15 = 105 seconds for the fourth one. Thus, Vasya gets to the cashier quicker if he chooses the second or the third queue.

import Control.Applicative
import Control.Monad

main = do
    n <- read <$> getLine
    getLine
    xss <- sequence [ (map read) . words <$> getLine | _ <- [1 .. n]]
    print $ solve xss

solve :: [[Int]] -> Int
solve = minimum . map compute

compute :: [Int] -> Int
compute xs = (15 * (length xs)) + (5 * (sum xs))

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

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

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

main = do
  n <- readLn
  getLine
  ms <- replicateM n getInts

  print $ minimum $ map (\a -> (length a)*15 + (sum a) * 5) ms

module Main where
import Control.Monad
main = do
    n <- readLn :: IO Int
    getLine
    ks <- replicateM n $ getLine >>= return . map (read::String -> Int) .words
    let ms = map (\x -> (length x * 15 ) + (sum $ map (*5) x)) ks
    print $ minimum ms

import Data.List

f::[String]->[Int]
f []=[]
f (s:strs)=let xs=map read (words s)::[Int]
           in (sum xs)*5+15*(length xs):f strs

main =do
      e<-getLine
      e2<-getLine
      es<-getContents
      print $ minimum $ f (lines es)

main :: IO ()
main = do
  input <- getContents
  putStrLn (solve (parse input))

parse :: String -> [[Int]]
parse str =
  let
    ls = drop 1 $ lines str
    ls' = drop 1 ls
    ldata = map (map read) $ map words ls'
  in
    ldata

solve ldata =
    show $ minimum $ map sum (map (map (\x -> 5 * x + 15)) ldata)

main = do
    getLine
    getLine
    q <- getContents
    print $ minimum $ map (((*) 5) . sum) $ map (\x -> map ((+) 3) x) $ map (\x -> map (\y -> read y::Int) x) $ map words $ lines q

main=interact$show.minimum.map(f.map read.words).drop 2.lines
f :: [Int] -> Int
f xs = length xs * 15 + sum (map (5*) xs)

solve :: [[Int]] -> Int
solve xss = minimum ys where
    ys = [5*sum xs + 15*length xs | xs <- xss]

parseInput :: String -> [[Int]]
parseInput input = xss where
    ls = tail $ tail $ lines input
    ys = map words ls
    xss = [map read y :: [Int] | y <- ys]

main :: IO ()
main = do
    input <- getContents
    let xs = parseInput input
    print $ solve xs

solve :: [[Int]] -> Int
solve xss = minimum ys where
    ys = [5*sum xs + 15*length xs | xs <- xss]

parseInput :: String -> [[Int]]
parseInput input = xss where
    ls = tail $ lines input
    ys = map words ls
    xss = [map read y :: [Int] | y <- ys]

main :: IO ()
main = do
    input <- getContents
    let xs = parseInput input
    print $ solve xs


Let's call a string $$$s$$$ perfectly balanced if for all possible triplets $$$(t,u,v)$$$ such that $$$t$$$ is a non-empty substring of $$$s$$$ and $$$u$$$ and $$$v$$$ are characters present in $$$s$$$, the difference between the frequencies of $$$u$$$ and $$$v$$$ in $$$t$$$ is not more than $$$1$$$.For example, the strings "aba" and "abc" are perfectly balanced but "abb" is not because for the triplet ("bb",'a','b'), the condition is not satisfied.You are given a string $$$s$$$ consisting of lowercase English letters only. Your task is to determine whether $$$s$$$ is perfectly balanced or not.A string $$$b$$$ is called a substring of another string $$$a$$$ if $$$b$$$ can be obtained by deleting some characters (possibly $$$0$$$) from the start and some characters (possibly $$$0$$$) from the end of $$$a$$$.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 2\cdot 10^4$$$) denoting the number of testcases. Each of the next $$$t$$$ lines contain a single string $$$s$$$ ($$$1\leq |s|\leq 2\cdot 10^5$$$), consisting of lowercase English letters. It is guaranteed that the sum of $$$|s|$$$ over all testcases does not exceed $$$2\cdot 10^5$$$.

For each test case, print "YES" if $$$s$$$ is a perfectly balanced string, and "NO" otherwise. You may print each letter in any case (for example, "YES", "Yes", "yes", "yEs" will all be recognized as positive answer).

findPattern' :: String -> String -> String
findPattern' cur [] = cur
findPattern' cur (x : xs)
 | (x `elem` cur) = cur
 | otherwise = findPattern' (cur ++ [x]) xs

findPattern :: String -> String
findPattern s = findPattern' "" s

join :: String -> [String] -> String
join _ [x] = x
join delimiter (x : xs) = x ++ delimiter ++ join delimiter xs

ans :: IO String
ans = do
 s <- getLine
 let pattern = findPattern s
 let result = (s == (take (length s) (cycle pattern)))
 return (if result then "YES" else "NO")

main :: IO ()
main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (join "\r\n" results)

check' :: String -> String -> String -> Bool
check' _ _ "" = True
check' pattern (x : xs) (y : ys) = (x == y) && check' pattern (if (xs == "") then pattern else xs) ys

check :: String -> String -> Bool
check pattern s = check' pattern pattern s

findPattern' :: String -> String -> String
findPattern' cur [] = cur
findPattern' cur (x : xs)
 | (x `elem` cur) = cur
 | otherwise = findPattern' (cur ++ [x]) xs

findPattern :: String -> String
findPattern s = findPattern' "" s

join :: String -> [String] -> String
join _ [x] = x
join delimiter (x : xs) = x ++ delimiter ++ join delimiter xs

ans :: IO String
ans = do
 s <- getLine
 let pattern = findPattern s
 let result = check pattern s
 return (if result then "YES" else "NO")

main :: IO ()
main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn (join "\r\n" results)

check' :: String -> String -> String -> Bool
check' _ _ "" = True
check' pattern (x : xs) (y : ys) = (x == y) && check' pattern (if (xs == "") then pattern else xs) ys

check :: String -> String -> Bool
check pattern s = check' pattern pattern s

findPattern' :: String -> String -> String
findPattern' cur [] = cur
findPattern' cur (x : xs)
 | (x `elem` cur) = cur
 | otherwise = findPattern' (cur ++ [x]) xs

findPattern :: String -> String
findPattern s = findPattern' "" s

join :: String -> [String] -> String
join _ [x] = x
join delimiter (x : xs) = x ++ delimiter ++ join delimiter xs

ans :: IO String
ans = do
 s <- getLine
 let pattern = findPattern s
 let result = check pattern s
 return (if result then "YES" else "NO")

main :: IO ()
main = do
 tInput <- getLine
 let t = read tInput :: Int
 results <- sequence (replicate t ans)
 putStrLn ""
 putStrLn (join "\r\n" results)

import Control.Monad
import Data.Array.Unboxed
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as C
import qualified Data.Map.Strict as M
import qualified Data.Set as S

solve :: IO ()
solve = do
    s <- fst . C.spanEnd isSpace <$> C.getLine
    let sa = listArray (1, n) $ (+(-97)) . ord <$> C.unpack s :: UArray Int Int
        n = C.length s
        cset = S.fromList (elems sa)
        cnt = fArray (0, n) f :: Array Int (UArray Int Int) where
            f 0 = listArray (0, 25) $ repeat 0
            f i = cnt!(i-1) // [(sa!i, cnt!(i-1)!(sa!i) + 1)]
        missing l r c = cnt!r!c - cnt!l!c == 0
        go _ i | i == n+1 = True
        go last i = case last M.!? (sa!i) of
            Just j | any (missing j i) cset -> False
            _                               -> go last' (i+1)
          where
            last' = M.insert (sa!i) i last
    putStrLn $ if go M.empty 1 then "YES" else "NO"

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = listArray b (map f (range b))

readInts :: IO [Int]
readInts = map (fst . fromJust . C.readInt) . C.words <$> C.getLine

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


Ivan has an array consisting of n elements. Each of the elements is an integer from 1 to n.Recently Ivan learned about permutations and their lexicographical order. Now he wants to change (replace) minimum number of elements in his array in such a way that his array becomes a permutation (i.e. each of the integers from 1 to n was encountered in his array exactly once). If there are multiple ways to do it he wants to find the lexicographically minimal permutation among them.Thus minimizing the number of changes has the first priority, lexicographical minimizing has the second priority.In order to determine which of the two permutations is lexicographically smaller, we compare their first elements. If they are equal — compare the second, and so on. If we have two permutations x and y, then x is lexicographically smaller if xi < yi, where i is the first index in which the permutations x and y differ.Determine the array Ivan will obtain after performing all the changes.

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

In the first line print q — the minimum number of elements that need to be changed in Ivan's array in order to make his array a permutation. In the second line, print the lexicographically minimal permutation which can be obtained from array with q changes.

NoteIn the first example Ivan needs to replace number three in position 1 with number one, and number two in position 3 with number four. Then he will get a permutation [1, 2, 4, 3] with only two changed numbers — this permutation is lexicographically minimal among all suitable. In the second example Ivan does not need to change anything because his array already is a permutation.

{-# LANGUAGE NoImplicitPrelude #-}

import Data.List.Split (splitOn)
import Data.Map (Map, lookup, insert, fromList, (!))
import Data.List (group, zip, map, concat, sort, intersperse)
import Prelude (getLine, putStrLn, show, read,
                Int, Bool(True, False), (.),
                ($), head, tail, (==), otherwise,
                (<), (&&), (>), (-), (+), (++), length, sum)
import Data.Maybe

buildAns :: Map Int Int -> Map Int Bool-> [Int] -> [Int] -> [Int]
buildAns left skip a t
    | (t == []) = a
    | otherwise = let   (q:qs) = a
                        el     = lookup q left
                  in case el of
                        Nothing -> q : (buildAns left skip qs t)
                        Just tm -> if head t < q && tm > 1
                                   then (head t) : buildAns (insert q (tm - 1) left) skip qs (tail t)
                                   else if tm == 1
                                        then q : buildAns left skip qs t
                                        else if (skip!q == True)
                                             then (head t) : buildAns (insert q (tm - 1) left) skip qs (tail t)
                                             else q : buildAns left (insert q True skip) qs t
main = do
    n' <- getLine
    a' <- getLine
    let n = read n'
        a = map read $ splitOn " " a'
        g = (group.sort) a
        unq = 0 : map head g
        pr = zip unq ((tail unq) ++ [n+1])
        t = concat $ map (\(x,y) -> [(x + 1)..(y - 1)]) pr

        left = fromList $ map (\x -> (head x, length x)) g
        skip = fromList $ map (\x -> (x, False)) unq
    putStrLn $ show $ (sum $ map length g) - length g
    putStrLn.concat $ intersperse " " $ map show $ buildAns left skip a t

{-# LANGUAGE NoImplicitPrelude #-}

import Data.List.Split (splitOn)
import Data.Map (Map, lookup, insert, fromList, (!))
import Data.List (group, zip, map, concat, sort, intersperse)
import Prelude (getLine, putStrLn, show, read,
                Int, Bool(True, False), (.),
                ($), head, tail, (==), otherwise,
                (<), (&&), (>), (-), (+), (++), length, sum)
import Data.Maybe

buildAns :: Map Int Int -> Map Int Bool-> [Int] -> [Int] -> [Int]
buildAns left skip a t
    | (t == []) = a
    | otherwise = let   (q:qs) = a
                        el     = lookup q left
                  in case el of
                        Nothing -> q : (buildAns left skip qs t)
                        Just tm -> if head t < q && tm > 1
                                   then (head t) : buildAns (insert q (tm - 1) left) skip qs (tail t)
                                   else if tm == 1
                                        then q : buildAns left skip qs t
                                        else if (skip!q == True)
                                             then (head t) : buildAns (insert q (tm - 1) left) skip qs (tail t)
                                             else q : buildAns left (insert q True skip) qs t
main = do
    n' <- getLine
    a' <- getLine
    let n = read n'
        a = map read $ splitOn " " a'
        g = (group.sort) a
        unq = 0 : map head g
        pr = zip unq ((tail unq) ++ [n+1])
        --s = (Set.fromList unq) :: Set.Set Int
        --t = [x | x <- [1..n], not (Set.member x s) ]

        t = concat $ map (\(x,y) -> [(x + 1)..(y - 1)]) pr

        left = (fromList $ map (\x -> (head x, length x)) g) :: Map Int Int
        skip = (fromList $ map (\x -> (x, False)) unq) :: Map Int Bool
    putStrLn $ show $ (sum $ map length g) - length g
    putStrLn.concat $ intersperse " " $ map show $ buildAns left skip a t

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

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

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

solve n xs = (length cs0:) $ snd $ mapAccumL go (freq0, cs0, S.empty) xs
  where
    freq0 = M.fromListWith (+) $ zip xs (repeat 1 :: [Int])
    cs0 = filter (not . flip M.member freq0) [1..n]
    go st@(freq, cs, skipped) x
      | null cs || fromJust (M.lookup x freq) <= 1 = (st, x)
      | S.member x skipped || x > head cs = ((M.adjust (subtract 1) x freq, tail cs, skipped), head cs)
      | otherwise = ((freq, cs, S.insert x skipped), x)

import Data.List.Split (splitOn)
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.List

buildAns :: Map.Map Int Bool -> [Int] -> [Int] -> [Int]
buildAns left a t
    | (t == []) = a
    | otherwise = let   (q:qs) = a
                        el     = Map.lookup q left
                  in case el of
                        Nothing -> q : (buildAns left qs t)
                        Just tm -> if (head t < q) || tm
                                   then (head t) : buildAns left qs (tail t)
                                   else q : buildAns (Map.insert q True left) qs t
main = do
    n' <- getLine
    a' <- getLine
    let n = read n'
        a = map read $ splitOn " " a'
        g = (group.sort) a
        unq = map head g
        s = (Set.fromList unq) :: Set.Set Int
        t = [x | x <- [1..n], not (Set.member x s) ]
        left = (Map.fromList $ map (\x -> (x, False)) unq) :: Map.Map Int Bool

    putStrLn $ show $ (sum $ map length g) - length g
    putStrLn.concat $ intersperse " " $ map show $ buildAns left a t

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

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

app = do
  a <- poi
  b <- poi
  f <- poi
  k <- poi
  return $ show $ solve a b f k
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve end cap gas n = go n False 0 cap
  where
  go 0 _ cnt _  = cnt
  go re rev cnt have
    | have < d1 || haveU < 0 = -1
    | haveN >= next = go' cnt haveN
    | haveU >= next = go' (cnt + 1) haveU
    | otherwise = -1
    where
    (d1, d2) = if rev then (end - gas, gas) else (gas, end - gas)
    next = if re == 1 then 0 else d2
    go' = go (re - 1) (not rev)
    haveU = cap - d2
    haveN = have - end


For some reason in many American cartoons anvils fall from time to time onto heroes' heads. Of course, safes, wardrobes, cruisers, planes fall sometimes too... But anvils do so most of all.Anvils come in different sizes and shapes. Quite often they get the hero stuck deep in the ground. But have you ever thought who throws anvils from the sky? From what height? We are sure that such questions have never troubled you!It turns out that throwing an anvil properly is not an easy task at all. Let's describe one of the most popular anvil throwing models.Let the height p of the potential victim vary in the range [0;a] and the direction of the wind q vary in the range [ - b;b]. p and q could be any real (floating) numbers. Then we can assume that the anvil will fit the toon's head perfectly only if the following equation has at least one real root:   Determine the probability with which an aim can be successfully hit by an anvil.You can assume that the p and q coefficients are chosen equiprobably and independently in their ranges.

The first line contains integer t (1 ≤ t ≤ 10000) — amount of testcases. Each of the following t lines contain two space-separated integers a and b (0 ≤ a, b ≤ 106). Pretests contain all the tests with 0 < a < 10, 0 ≤ b < 10.

Print t lines — the probability of a successful anvil hit for each testcase. The absolute or relative error of the answer should not exceed 10 - 6.

{-# OPTIONS_GHC -O2 #-}

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

-- p >= 4q, p \in [0,a], q \in [-b,b]
solve :: Integer -> Integer -> Double
solve a 0 = 1.0
solve 0 b = 0.5
solve a b = fromRational (area8 % (area * 8)) * 0.5 + 0.5
  where
    area8
        | a >= 4 * b = (a - 4 * b) * b * 4 + a * b * 4
        | otherwise  = a * a
    area = a * b

readI = fst . fromJust . BS.readInteger

main = do
    t <- read <$> getLine :: IO Int
    query <- map (map readI . BS.words) . BS.lines <$> BS.getContents
    forM_ query $ \[a,b] -> do
        print $ solve a b

import Control.Applicative

readWords :: Read a => IO [a]
readWords = map read.words <$> getLine

solveArea a b = a*b + if a < 4*b then a*(a/4)/2 else a*b-b*(b*4)/2

solve :: Double -> Double -> Double
solve a b = if b < 1e-6 then 1 else if a < 1e-6 then 0.5 else solveArea a b / a / b / 2

solveTestCase = do
    [a, b] <- readWords :: IO [Double]
    putStrLn $ show $ solve a b

main = do
    [n] <- readWords
    sequence_ $ replicate n solveTestCase

main = do
    t <- read `fmap` getLine
    mapM_ (\_ -> do
        [a, b] <- (map (fromIntegral.read) . words) `fmap` getLine
	let p1 = 0.5
	    p2 = let b' = min b (a/4) in b' * (a  - b' * 4 / 2)/(2 * a * b)
        print $ (if b == 0 then 1 else if a == 0 then p1 else p1 + p2)) [1..t]

import Control.Applicative

readWords :: Read a => IO [a]
readWords = map read.words <$> getLine

solveArea a b = a*b + if a < 4*b then a*(a/4)/2 else a*b-b*(b*4)/2

solve :: Double -> Double -> Double
solve a b = if b < 1e-6 then 0 else if a < 1e-6 then 1 else solveArea a b / a / b / 2

solveTestCase = do
    [a, b] <- readWords :: IO [Double]
    putStrLn $ show $ solve a b

main = do
    [n] <- readWords
    sequence_ $ replicate n solveTestCase

import Control.Applicative

readWords :: Read a => IO [a]
readWords = map read.words <$> getLine

solveArea a b = a*b + if a < 4*b then a*(a/4)/2 else a*b-b*(b*4)/2

solve :: Double -> Double -> Double
solve a b = solveArea a b / a / b / 2

solveTestCase = do
    [a, b] <- readWords :: IO [Double]
    putStrLn $ show $ solve a b

main = do
    [n] <- readWords
    sequence_ $ replicate n solveTestCase

main = do
    t <- read `fmap` getLine
    mapM_ (\_ -> do
        [a, b] <- (map read . words) `fmap` getLine
        print $ fromIntegral a/4 / fromIntegral b /4 + 0.5) [1..t]

main = do
    t <- read `fmap` getLine
    mapM_ (\_ -> do
        [a, b] <- (map read . words) `fmap` getLine
        if b == 0 then print 1 else
            print $ fromIntegral a/4 / fromIntegral b /4 + 0.5) [1..t]


You are given a tree consisting of $$$n$$$ nodes. You generate an array from the tree by marking nodes one by one.Initially, when no nodes are marked, a node is equiprobably chosen and marked from the entire tree. After that, until all nodes are marked, a node is equiprobably chosen and marked from the set of unmarked nodes with at least one edge to a marked node. It can be shown that the process marks all nodes in the tree. The final array $$$a$$$ is the list of the nodes' labels in order of the time each node was marked.Find the expected number of inversions in the array that is generated by the tree and the aforementioned process.The number of inversions in an array $$$a$$$ is the number of pairs of indices $$$(i, j)$$$ such that $$$i < j$$$ and $$$a_i > a_j$$$. For example, the array $$$[4, 1, 3, 2]$$$ contains $$$4$$$ inversions: $$$(1, 2)$$$, $$$(1, 3)$$$, $$$(1, 4)$$$, $$$(3, 4)$$$.

The first line contains a single integer $$$n$$$ ($$$2 \le n \le 200$$$) — the number of nodes in the tree. The next $$$n - 1$$$ lines each contains two integers $$$x$$$ and $$$y$$$ ($$$1 \le x, y \le n$$$; $$$x \neq y$$$), denoting an edge between node $$$x$$$ and $$$y$$$. It's guaranteed that the given edges form a tree.

Output the expected number of inversions in the generated array modulo $$$10^9+7$$$. Formally, let $$$M = 10^9+7$$$. It can be shown that the answer can be expressed as an irreducible fraction $$$\frac{p}{q}$$$, where $$$p$$$ and $$$q$$$ are integers and $$$q \not \equiv 0 \pmod{M}$$$. Output the integer equal to $$$p \cdot q^{-1} \bmod M$$$. In other words, output such an integer $$$x$$$ that $$$0 \le x < M$$$ and $$$x \cdot q \equiv p \pmod{M}$$$.

NoteThis is the tree from the first sample:  For the first sample, the arrays are almost fixed. If node $$$2$$$ is chosen initially, then the only possible array is $$$[2, 1, 3]$$$ ($$$1$$$ inversion). If node $$$3$$$ is chosen initially, then the only possible array is $$$[3, 1, 2]$$$ ($$$2$$$ inversions). If node $$$1$$$ is chosen initially, the arrays $$$[1, 2, 3]$$$ ($$$0$$$ inversions) and $$$[1, 3, 2]$$$ ($$$1$$$ inversion) are the only possibilities and equiprobable. In total, the expected number of inversions is $$$\frac{1}{3}\cdot 1 + \frac{1}{3} \cdot 2 + \frac{1}{3} \cdot (\frac{1}{2} \cdot 0 + \frac{1}{2} \cdot 1) = \frac{7}{6}$$$. $$$166666669 \cdot 6 = 7 \pmod {10^9 + 7}$$$, so the answer is $$$166666669$$$.This is the tree from the second sample:   This is the tree from the third sample:

import Control.Monad ( replicateM, forM_, when, liftM3 )
import Data.Array.IArray ( Array, (!), array )
import Data.Array.ST ( readArray, writeArray, MArray(newArray), runSTArray )
import Data.Int ( Int64 )
import Data.Ix ( Ix(range) )

m :: Int64
m = 1000000007

newtype MInt = MInt Int64 deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

toInt64 :: MInt -> Int64
toInt64 (MInt a) = a

inv :: MInt -> MInt
inv a = pow a (m - 2)
    where pow a b | b == 0    = 1
                  | odd b     = a * pow a (b - 1)
                  | otherwise = pow (a * a) (b `div` 2)

floydWarshall :: Int -> [(Int, Int)] -> Array (Int, Int) Int
floydWarshall n e =
    runSTArray $ do
        d <- newArray ((1, 1), (n, n)) (n * n)
        let rd = readArray d; wd = writeArray d
        forM_ [1..n] $ \i -> wd (i, i) 0
        forM_ e $ \(u, v) -> wd (u, v) 1 >> wd (v, u) 1
        forM_ (range ((1, 1, 1), (n, n, n))) $ \(k, i, j) -> do
            [ij, ik, kj] <- mapM rd [(i, j), (i, k), (k, j)]
            when (ik + kj < ij) $ wd (i, j) (ik + kj)
        return d

-- (i, j) is probability we finish i after j
prob :: Int -> Array (Int, Int) MInt
prob n = dp
    where
        dp = array ((0, 0), (n, n)) [((i, j), f i j) | i <- [0..n], j <- [0..n]]
        f i j | i == 0 = 0
              | j == 0 = 1
              | otherwise = (dp!(i - 1, j) + dp!(i, j - 1)) * inv2
        inv2 = inv 2

solve :: IO()
solve = do
    n <- readInt <$> getLine
    let parseEdge = (\[u, v] -> (u, v)) . map readInt . words
    edges <- map parseEdge <$> replicateM (n - 1) getLine
    let d = floydWarshall n edges
        p = prob n
        dists r u v =
            let uv = d!(u, v); ru = d!(r, u); rv = d!(r, v)
            in ((uv + ru - rv) `div` 2, (uv + rv - ru) `div` 2)
        forRoot r = sum [p!dists r u v | u <- [1..n], v <- [u + 1..n]]
    print $ toInt64 $ sum (map forRoot [1..n]) * inv (fromIntegral n)

readInt :: String -> Int
readInt = read

main :: IO()
main = solve

import Control.Monad ( replicateM, forM_, when )
import Data.Int ( Int64 )
import Data.Array.IArray ( Array, (!), array )
import Data.Array.ST ( readArray, writeArray, MArray(newArray), runSTArray )

m :: Int64
m = 1000000007

newtype MInt = MInt Int64 deriving Show

instance Num MInt where
    MInt a + MInt b = MInt $ if c >= m then c - m else c where c = a + b
    MInt a - MInt b = MInt $ if c < 0 then c + m else c where c = a - b
    MInt a * MInt b = MInt $ a * b `mod` m
    abs             = id
    signum (MInt a) = MInt $ signum a
    fromInteger i   = MInt $ fromInteger i `mod` m

toInt64 :: MInt -> Int64
toInt64 (MInt a) = a

inv :: MInt -> MInt
inv a = pow a (m - 2)
    where pow a b | b == 0    = 1
                  | odd b     = a * pow a (b - 1)
                  | otherwise = pow (a * a) (b `div` 2)

floydWarshall :: Int -> [(Int, Int)] -> Array (Int, Int) Int
floydWarshall n e =
    runSTArray $ do
        d <- newArray ((1, 1), (n, n)) (n * n)
        forM_ [1..n] $ \i ->
            writeArray d (i, i) 0
        forM_ e $ \(u, v) -> do
            writeArray d (u, v) 1
            writeArray d (v, u) 1
        forM_ [1..n] $ \k ->
            forM_ [1..n] $ \i ->
                forM_ [1..n] $ \j -> do
                    ij <- readArray d (i, j)
                    ik <- readArray d (i, k)
                    kj <- readArray d (k, j)
                    when (ik + kj < ij) $ writeArray d (i, j) (ik + kj)
        return d

-- (i, j) is probability we finish i after j
prob :: Int -> Array (Int, Int) MInt
prob n = dp
    where
        dp = array ((0, 0), (n, n)) [((i, j), f i j) | i <- [0..n], j <- [0..n]]
        f i j | i == 0 = 0
              | j == 0 = 1
              | otherwise = (dp!(i - 1, j) + dp!(i, j - 1)) * inv2
        inv2 = inv 2

solve :: IO()
solve = do
    n <- readInt <$> getLine
    let parseEdge = (\(u:v:_) -> (u, v)) . map readInt . words
    edges <- map parseEdge <$> replicateM (n - 1) getLine
    let d = floydWarshall n edges
    let p = prob n
    let dists r u v =
            let uv = d!(u, v); ru = d!(r, u); rv = d!(r, v)
            in ((uv + ru - rv) `div` 2, (uv + rv - ru) `div` 2)
    let forRoot r = sum [p!(dists r u v) | u <- [1..n], v <- [u + 1..n]]
    print $ toInt64 $ sum (map forRoot [1..n]) * inv (fromIntegral n)

readInt :: String -> Int
readInt = read

main :: IO()
main = solve

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Ix as Ix
import qualified Data.Ratio as R

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
    hFlush
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace
--
-- tracing t x = trace (t ++ " = " ++ show x) x
-- debugging x t = tracing t x

debug x t = x
trace t x = x
tracing t x = x
debugging x t = x

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

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

m :: Int64
m = 10 ^ 9 + 7

newtype M = M { unM :: Int64 }
  deriving (Eq, Ord)

instance Show M where
    show = show . unM

instance Num M where
    fromInteger n = M $ fromInteger (n `mod` fromIntegral m)

    (M a) + (M b) | a + b >= m = M $ a + b - m
    (M a) + (M b) = M $ a + b

    (M a) - (M b) | a - b < 0 = M $ m + a - b
    (M a) - (M b) = M $ a - b

    (M a) * (M b) = M $ (a * b) `mod` m

    abs    = id
    signum = undefined

powM :: M -> Int64 -> M
powM a@(M ma) x
    | x == 0 = M 1
    | x == 1 = a
    | even x = let t = powM a (x `div` 2) in t * t
    | odd x = a * powM a (x - 1)

instance Fractional M where
    recip a = powM a $ m - 2
    fromRational d = (M . fromInteger . R.numerator $ d) * (recip . M . fromInteger . R.denominator $ d)

type GraphA = A.Array Int [Int]

graphFromEdges :: Int -> [(Int, Int)] -> GraphA
graphFromEdges n edges = graph
    where
        graph = STA.runSTArray $ do
            graphA <- MA.newArray (1, n) ([] :: [Int])
            forM_ edges $ \(u, v) -> do
                modifyArray graphA u (v:)
                modifyArray graphA v (u:)
            return graphA

graphDistances :: Int -> GraphA -> UA.UArray (Int, Int) Int
graphDistances n graph = STA.runSTUArray do
    distancesA <- MA.newArray ((1, 1), (n, n)) n
    let graphAssocs = A.assocs graph
    forM_ graphAssocs $ \(u, vs) -> do
        forM_ vs $ \v -> modifyArray distancesA (u, v) $ min 1
        MA.writeArray distancesA (u, u) 0
    forM_ (Ix.range ((1, 1, 1), (n, n, n))) $ \(k, i, j) -> do
        dik <- MA.readArray distancesA (i, k)
        dkj <- MA.readArray distancesA (k, j)
        modifyArray distancesA (i, j) $ min (dik + dkj)
    return distancesA

f :: A.Array (Int, Int) M
f = STA.runSTArray do
    let maxN = 300
    fA <- MA.newArray ((0, 0), (maxN, maxN)) $ M 0
    forM_ (Ix.range ((0, 0), (maxN, maxN))) $ \(i, j) -> do
        case (i, j) of
            (i, 0) -> MA.writeArray fA (i, 0) $ M 0
            (0, j) -> MA.writeArray fA (0, j) $ M 1
            (i, j) -> do
                f01 <- MA.readArray fA (i, j - 1)
                f10 <- MA.readArray fA (i - 1, j)
                MA.writeArray fA (i, j) $ (f01 + f10) / M 2
    return fA

solve :: Int -> GraphA -> Int64
solve n graph = unM answer
    where
        distances = graphDistances n graph
        answer = sum $ [prob r u v | (r, u, v) <- Ix.range ((1, 1, 1), (n, n, n)), u > v]
        prob r u v = (recip (M . fromIntegral $ n) * f A.! (dCU, dCV)) `debug` (show "r u v = " ++ show (r, u, v)) `debugging` "prob"
            where
                dRU = distances UA.! (r, u) `debugging` "dRU"
                dRV = distances UA.! (r, v) `debugging` "dRV"
                dUV = distances UA.! (u, v) `debugging` "dUV"
                dRC = ((dRU + dRV - dUV) `div` 2) `debugging` "dRC"
                dCU = (dRU - dRC) `debugging` "dCU"
                dCV = (dRV - dRC) `debugging` "dCV"

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    edges <- replicateM (pred n) $ B8.getLine <&> readIntB8s <&> (\[a, b] -> (a, b))
    let graph = graphFromEdges n edges
    let answer = solve n graph
    printf "%lld\n" answer

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

md :: Int64
md = 1000000007

newtype MInt = MInt Int64 deriving Eq

instance Show MInt where
    show (MInt a) = show a

instance Num MInt where
    (MInt a) + (MInt b) =
        let r = a + b in
            MInt $ if r >= md then r - md else r
    (MInt a) * (MInt b) = MInt $ (a * b) `mod` md
    abs = id
    signum (MInt a) = MInt $ signum a
    fromInteger a = MInt $ fromInteger (a `mod` fromIntegral md)
    negate (MInt 0) = 0
    negate (MInt a) = MInt $ md - a

instance Fractional MInt where
  recip a = a ^ (md - 2)
  fromRational x =
        let a = numerator x `mod` fromIntegral md
            b = denominator x `mod` fromIntegral md
        in
            MInt (fromInteger a) / MInt (fromInteger b)

type Graph = Array Int [Int]

buildG :: (Int, Int) -> [(Int, Int)] -> Graph
buildG = accumArray (flip (:)) []

buildS :: Graph -> Int -> Array Int MInt
buildS g rt = runSTArray $ do
    let n = snd $ bounds g
    s <- newArray (1,n) 1 :: ST s (STArray s Int MInt)

    let dfs x p = do
            forM_ (g ! x) $ \y -> do
                when (y /= p) $ do
                    dfs y x
                    readArray s y >>= \t -> modifyArray (+t) s x

    dfs rt 0
    return s

solve :: Graph -> Array (Int,Int) MInt ->  Int -> MInt
solve g dp rt = runST $ do
    let n = snd $ bounds g
        s = buildS g rt
    res <- newSTRef 0 :: ST s (STRef s MInt)

    let dfs x ps = do
        when (x < rt) $ do
            let l = length ps
                xs = x : ps
                pingo = zip3 (tail xs) xs [1..]
                calc (a,b,k) = ((s!a) - (s!b)) * (dp ! (l-k,k))
                asd = sum $ map calc pingo
            -- deb "PINGO" (x,rt,asd,pingo,map calc pingo) modifySTRef' res (+asd)
            modifySTRef' res (+asd)
        forM_ (g ! x) $ \y -> do
            when (null ps || y /= head ps) $ do
                dfs y (x:ps)

    dfs rt []
    readSTRef res

doDp :: Int -> Array (Int,Int) MInt
doDp n = runSTArray $ do
    dp <- newArray ((0,0),(n,n)) 0 :: ST s (STArray s (Int,Int) MInt)
    forM_ [1..n] $ \j -> writeArray dp (0,j) 1
    let hlf :: MInt
        hlf = 1 / 2
    forM_ (liftM2 (,) [1..n] [1..n]) $ \(i,j) -> do
        a <- readArray dp (i-1,j)
        b <- readArray dp (i,j-1)
        writeArray dp (i,j) $ hlf * (a+b)
    return dp

main = do
    n <- parseInt <$> BS.getLine
    es <- replicateM (n-1) $ do
        [x,y] <- map parseInt . BS.words <$> BS.getLine
        return (x,y)
    let g = buildG (1,n) (es ++ map swap es)
        dp = doDp n
    print $ (sum [solve g dp i | i <- [2..n]]) / fromIntegral n


There are n Imperial stormtroopers on the field. The battle field is a plane with Cartesian coordinate system. Each stormtrooper is associated with his coordinates (x, y) on this plane. Han Solo has the newest duplex lazer gun to fight these stormtroopers. It is situated at the point (x0, y0). In one shot it can can destroy all the stormtroopers, situated on some line that crosses point (x0, y0).Your task is to determine what minimum number of shots Han Solo needs to defeat all the stormtroopers.The gun is the newest invention, it shoots very quickly and even after a very large number of shots the stormtroopers don't have enough time to realize what's happening and change their location.

The first line contains three integers n, x0 и y0 (1 ≤ n ≤ 1000,  - 104 ≤ x0, y0 ≤ 104) — the number of stormtroopers on the battle field and the coordinates of your gun. Next n lines contain two integers each xi, yi ( - 104 ≤ xi, yi ≤ 104) — the coordinates of the stormtroopers on the battlefield. It is guaranteed that no stormtrooper stands at the same point with the gun. Multiple stormtroopers can stand at the same point.

Print a single integer — the minimum number of shots Han Solo needs to destroy all the stormtroopers.

NoteExplanation to the first and second samples from the statement, respectively:

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \n -> let [x,y,z] = map read (words n) in (mapM_ putStrLn).solve.(\as->(y,z):as) =<< (forM [1..x] $ \i ->  getLine>>= \j -> let [a,b]= words j in return (read a, read b))
solve::[(Int,Int)]->[String]
solve xs = [show $ length $ map head $ group $ sort $ map (\(a,b)->let g= gcd a b; z= if a/=0 then a `div` abs a else b `div` abs b in (z*a `div` g, z*b `div` g)) (slv1 xs)]
slv1 ((x1,x2):xs) = map (\ (a,b) -> (a-x1,b-x2)) xs

import Data.List (nub)

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

solve :: [[Int]] -> Int
solve ([_, x0, y0] : xys) = length $ nub $ map (\[x, y] -> ratio (x - x0, y - y0)) xys
solve _ = undefined

ratio :: (Int, Int) -> (Int, Int)
ratio (x, y) = (x `div` gcd x y * signum x, y `div` gcd x y * signum x)

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  ss <- replicateM n (norm . zipWith (-) [x0,y0] . map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (xa * yb) (xb * ya)
  print $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss
norm [x,y] | y < 0 || y == 0 && x < 0 = [-x,-y] | otherwise = [x,y]

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Control.Monad
import Control.Monad.ST.Safe
import Data.Array
import Data.Array.ST.Safe
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  getLine >>= \n -> let [x,y,z] = map read (words n) in (mapM_ putStrLn).solve.(\as->(y,z):as) =<< (forM [1..x] $ \i ->  getLine>>= \j -> let [a,b]= words j in return (read a, read b))
solve::[(Int,Int)]->[String]
solve xs = [show $  length $ map head $group $ sort $ map (\(a,b)->let g= gcd a b; z= if a/=0 then a `div` abs a else 1 in (z*a `div` g, z*b `div` g)) (slv1 xs)]
slv1 ((x1,x2):xs) = map (\ (a,b) -> (a-x1,b-x2)) xs

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  (zs,ss) <- partition (== [0,0]) <$> replicateM n (norm . zipWith (-) [x0,y0] . map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (xa * yb) (xb * ya)
  print $ if not (null zs) then -1 else length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss
norm [x,y] | y < 0 = [-x,-y] | otherwise = [x,y]

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  (zs,ss) <- partition (== [0,0]) <$> replicateM n (norm . zipWith (-) [x0,y0] . map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (xa * yb) (xb * ya)
  print $ max (fromEnum (not (null zs))) $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss
norm [x,y] | y < 0 = [-x,-y] | otherwise = [x,y]

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  ss <- replicateM n (map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare ((xa-x0) * (yb-y0)) ((xb-x0) * (ya-y0))
  print $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  ss <- replicateM n (norm . zipWith (-) [x0,y0] . map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (xa * yb) (xb * ya)
  print $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss
norm [x,y] | y < 0 = [-x,-y] | otherwise = [x,y]

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  (zs,ss) <- partition (== [0,0]) <$> replicateM n (norm . zipWith (-) [x0,y0] . map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (xa * yb) (xb * ya)
  print $ min (fromEnum (not (null zs))) $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss
norm [x,y] | y < 0 = [-x,-y] | otherwise = [x,y]

import Data.List
import Control.Monad
main = do
  [n,x0,y0] <- map read . words <$> getLine
  ss <- replicateM n (map read . words <$> getLine)
  let cp [xa,ya] [xb,yb] = compare (abs (xa-x0) * (yb-y0)) (abs (xb-x0) * (ya-y0))
  print $ length $ groupBy (((== EQ) .) . cp) $ sortBy cp ss