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_, 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 ( 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


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

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


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

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 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.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')

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))


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


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


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)

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)

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

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)


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


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


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

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

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


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 (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 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
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


{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

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

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fst . fromJust . B.readInteger) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fromIntegral . fst . fromJust . B.readInt) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fst . fromJust . B.readInteger) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 #-}

import Data.Int
import Data.Monoid
import Data.Maybe
import Data.Array
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

--import Control.Parallel
import GHC.Conc (par, pseq)

foldMap :: Monoid m => (a -> m) -> [a] -> m
foldMap f x = foldMap' x (length x)
  where
    foldMap' xs ln
        | ln == 0   = mempty
        | ln >= 100 = zs' `par` (ys' `pseq` (ys' `mappend` zs'))
        | otherwise = foldl1 mappend $ map f xs
      where
        lny     = ln `div` 2
        lnz     = ln - lny
        (ys,zs) = splitAt lny xs
        ys'     = foldMap' ys lny
        zs'     = foldMap' zs lnz

data MaxSum a = MaxSum
              { prefixS :: a
              , middleS :: a
              , suffixS :: a
              , allS :: a
              } deriving Show

instance (Bounded a, Num a, Ord a) => Monoid (MaxSum a) where
    mempty = MaxSum minBound minBound minBound 0
    mappend x y = MaxSum pre mid suf sum
      where
        pre = prefixS x `max` (allS x + prefixS y)
        mid = middleS x `max` middleS y `max` (suffixS x + prefixS y)
        suf = suffixS y `max` (allS y + suffixS x)
        sum = allS x + allS y

singleton :: Int -> MaxSum Int64
singleton x = MaxSum x' x' x' x'
  where
    x' = fromIntegral x

readI = fst . fromJust . BS.readInt

main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    lines <- BS.lines <$> BS.getContents
    let states = map (foldMap singleton . tail . map readI . BS.words) $ take n lines
    let list = map readI . take m . BS.words . head $ drop n lines
    let arr = listArray (1, n) states :: Array Int (MaxSum Int64)
    let answer = foldMap (arr!) list
    print $ middleS answer

{-# OPTIONS_GHC -O2 #-}

import Data.Int
import Data.Monoid
import Data.Maybe
import Data.Array
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

--import Control.Parallel
import qualified GHC.Conc (par, pseq)
infixr 0 `par`, `pseq`
par = GHC.Conc.par
pseq = GHC.Conc.pseq

foldMap :: Monoid m => (a -> m) -> [a] -> m
foldMap f x = foldMap' f x (length x)
  where
    foldMap' f xs ln
        | ln == 0    = mempty
        | ln >= 100  = zs' `par` (ys' `pseq` (ys' `mappend` zs'))
        | otherwise  = foldl1 mappend $ map f xs
      where
        lny = ln `div` 2
        lnz = ln - lny
        (ys,zs) = splitAt lny xs
        ys'     = foldMap' f ys lny
        zs'     = foldMap' f zs lnz

data MaxSum a = MaxSum
              { prefixS :: a
              , middleS :: a
              , suffixS :: a
              , allS :: a
              } deriving Show

instance (Bounded a, Num a, Ord a) => Monoid (MaxSum a) where
    mempty = MaxSum minBound minBound minBound 0
    mappend x y = MaxSum pre mid suf sum
      where
        pre = prefixS x `max` (allS x + prefixS y)
        mid = middleS x `max` middleS y `max` (suffixS x + prefixS y)
        suf = suffixS y `max` (allS y + suffixS x)
        sum = allS x + allS y

singleton :: Int -> MaxSum Int64
singleton x = MaxSum x' x' x' x'
  where
    x' = fromIntegral x

readI = fst . fromJust . BS.readInt

main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    lines <- BS.lines <$> BS.getContents
    let states = map (foldMap singleton . tail . map readI . BS.words) $ take n lines
    let list = map readI . take m . BS.words . head $ drop n lines
    let arr = listArray (1, n) states :: Array Int (MaxSum Int64)
    let answer = foldMap (arr!) list
    print $ middleS answer

import Control.Monad
import Data.Array

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}

sums xs =
		Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl (+) 0 xs
		right = maximum $ scanr (+) 0 xs
		sub = maximum $ scanl (\s x -> max 0 $ s + x) 0 xs

solve arrays indexes =
		maximum $ concat [map sumsSub sums', maxs, zipWith (+) maxs $ map sumsLeft sums']
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sums' = map (arraysSums !) indexes

		maxs = scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sums'

getWords = (map read . words) `fmap` getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ solve arrays indexes

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

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getWords = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ solve arrays indexes

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

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}
	deriving (Show)

sums xs =
		Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs

		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sums', tail maxs, zipWith (+) maxs $ map sumsLeft sums']
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sums' = map (arraysSums !) indexes

		maxs = scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sums'

getWords = (map read . words) `fmap` getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ map sums arrays
	print $ solve arrays indexes


{-# LANGUAGE BangPatterns, FlexibleContexts #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Data.Bits
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: Ix i
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

fake_qsort :: (Int, Int) -> (Int -> Int32) -> UArray Int Int
-- previously Data.List.sortOn was the memory bottleneck,
-- so... use an in-place array sorting algorithm instead
fake_qsort (p, q) fun = runSTUArray $ do
  arr <- newArray_ (p, q)
  forM_ [p .. q] $ \i -> writeArray arr i i
  let
    maxv = foldl' (.|.) 0 $ map fun [p .. q]
    startBit = finiteBitSize maxv - 1 - countLeadingZeros maxv
    isort !scale !x !y = when (scale >= 0 && x < y) $ loop x y  where
      -- Partitions the [x, y] index-interval according to bit 'scale'
      loop !i !j = if  i <= j
        -- 'i' is the next un-examined index
        -- 'j' is the first index maybe without bit 'scale' set
        then  do
          ai <- readArray arr i
          case  testBit (fun ai) scale  of
            False -> loop (i + 1) j
            True -> do
              aj <- readArray arr j
              writeArray arr j ai
              writeArray arr i aj
              loop i (j - 1)
        else  isort (scale - 1) x j >> isort (scale - 1) (j + 1) y
  arr <$ isort startBit p q

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = fake_qsort (1, n) (\i -> a ! (i, 1))
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: (Ix i, Show i)
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = listArray (1, n) $ sortOn (\i -> a ! (i, 1)) [1 .. n]
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp

{-# LANGUAGE BangPatterns, FlexibleContexts #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Data.Bits
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: Ix i
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

fake_qsort :: (Int, Int) -> (Int -> Int32) -> UArray Int Int
-- previously Data.List.sortOn was the memory bottleneck,
-- so... use an in-place array sorting algorithm instead
fake_qsort (p, q) fun = runSTUArray $ do
  arr <- newArray_ (p, q)
  forM_ [p .. q] $ \i -> writeArray arr i i
  let
    maxv = foldl' (.|.) 0 $ map fun [p .. q]
    startBit = finiteBitSize maxv - 1 - countLeadingZeros maxv
    isort !scale !x !y = when (scale >= 0 && x < y) $ loop x y  where
      -- Partitions the [x, y] index-interval according to bit 'scale'
      loop !i !j = if  i < j
        -- 'i' is the next un-examined index
        -- 'j' is the first index maybe without bit 'scale' set
        then  do
          ai <- readArray arr i
          case  testBit (fun ai) scale  of
            False -> loop (i + 1) j
            True -> do
              aj <- readArray arr j
              writeArray arr j ai
              writeArray arr i aj
              loop i (j - 1)
        else  isort (scale - 1) x j >> isort (scale - 1) (j + 1) y
  arr <$ isort startBit p q

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = fake_qsort (1, n) (\i -> a ! (i, 1))
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | sc >=  mc || mc >= fc || 2*ma < sc || 2*s < sc || 2*ma >= mc = [ "-1" ]
    | otherwise = [ intercalate "\n" $ map show [fc,mc,sc] ]
    where
        fc = 2*f
        mc = 2*m
        sc = max s ma

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

main = getLine >>= putStr . maybe "-1" (\(a, b, c) -> show a ++ "\n" ++ show b ++ "\n" ++ show c) . headMay . (\[v1, v2, v3, vm] -> [(s1 :: Int, s2, s3) | s1 <- [max v1 $ 2*vm+1..2*v1], s2 <- [max v2$2*vm + 1..min (s1 - 1) (2 * v2)], s3 <- [max vm v3..min (s2 - 1) $ min (2*vm) (2*v3)]]) . map read . words
headMay [] = Nothing
headMay (x:_) = Just x

main = getLine >>= putStr . maybe "-1" (\(a, b, c) -> show a ++ "\n" ++ show b ++ "\n" ++ show c) . headMay . (\[v1, v2, v3, vm] -> [(s1 :: Int, s2, s3) | s1 <- [v1..2*v1], s2 <- [v2..min s1 $ 2*v2], s3 <- [v3..min s2 $ min (2*vm) (2*v3)], vm <= min s1 (min s2 s3), s3 <= 2 * vm]) . map read . words
headMay [] = Nothing
headMay (x:_) = Just x

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | sc >=  mc || mc >= fc || 2*ma < sc || 2*s < sc = [ "-1" ]
    | otherwise = [ intercalate "\n" $ map show [fc,mc,sc] ]
    where
        mc = 2*m
        fc = 2*f
        sc = max s ma

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | m <= ma || s > sc = [ "-1" ]
    | otherwise = [ unlines $ map show [fc,mc,sc] ]
    where
        mmaa = 2*ma
        mc = 2*m
        fc = 2*f
        sc = 2 * (min s ma)

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------


module Main where

import Data.List

compress :: [Int] -> [(Int, Int)]
compress xs = foldr go [] ys
  where
    ys = map (\x -> (x, 1)) xs
    go x [] = [x]
    go x@(xv, _) l@((lv, li):ls)
      | xv == lv = (lv, li + 1):ls
      | otherwise = x:l

solve :: Int -> [Int] -> Int
solve k xs = go k $ compress xs
  where
    go _ [] = -1
    go 0 ((lv, _):_)
      | lv == 1 = -1
      | otherwise = lv - 1
    go i ((lv, li):ls)
      | i == li = lv
      | i < li = -1
      | otherwise = go (i - li) ls

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  ns <- fmap (map read . words) getLine
  print $ solve k (sort ns)

import Data.List
main = interact $ show . solve . map read . tail . words
solve (0:as) | minimum as == 1 = -1 | otherwise = 1
solve (k:as) | not (null t) && r == l = -1
             | otherwise = l
  where (l:t@ ~(r:_)) = drop (k-1) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && last x <= 1000000000 then last x else if last x <  head y && (head y) >= last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8 as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n,k] <- map read.words <$> getLine
    xs <- unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print . maybe (-1) id $ solve n k xs

solve :: Int -> Int -> [Int] -> Maybe Int
solve _ 0 xs
  | elem 1 xs = Nothing
  | otherwise = Just 1
solve _ k xs
    | k == length (takeWhile(<=pivot)sorted) = Just pivot
    | otherwise = Nothing
  where
    !sorted = sort xs
    !pivot = sorted !! (k - 1)

module Main (main)
    where

import Data.List

readIntegers :: String -> [Integer]
readIntegers = map read . words

readInts :: String -> [Int]
readInts = map read . words

solve :: Int -> Int -> [Integer] -> Integer
solve n k a = let res = a !! k in
    if k == -1 && a !! 0 == 1 then -1 else
    if k == -1 then 1 else
    if k == (n-1) then res else
    if res == a !! (k + 1) then -1 else res

main :: IO ()
main = do
    a1 <- getLine
    a2 <- getLine
    let [n,k] = readInts a1
    let a = readIntegers a2
    let res = show (solve n (k-1) (sort a))
    putStrLn res

import qualified Data.ByteString.Lazy.Char8 as BS
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List

main = BS.interact app
app = BS.pack . evalState solve . BS.words

solve = do
  n <- nexti
  k <- nexti
  arr <- replicateM n nexti
  let result = let firstk = take k $ sort arr in if (length firstk == 0) then (if arr !! 0 > 1 then ((arr !! 0) - 1) else -1) else last firstk
  return $ show $ if (length $ filter (<=result) arr) == k then result else -1
  where
  nextw = state $ \(x:xs) -> (x,xs)
  int = maybe undefined fst . BS.readInt
  nexti = fmap int nextw

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | k == 0 = let d = head a - 1 in if d < 1 then -1 else 1
  | k == n = last a
  | a !! k == a !! (k - 1) = -1
  | otherwise = a !! (k - 1)
  where a = sort as

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.List
import Data.Int
import Data.Char
import Data.Bits
import Data.Bool
import Data.Ratio
import qualified Data.Array as A

readArray = map (\x -> fst . fromJust $ S.readInt x) . S.words <$> S.getLine

accum [] = []
accum (x:xs)
  | null yl = [(x,1)]
  | x /= (fst y) = ((x,1):yl)
  | otherwise = ((x, (snd y) + 1):ys)
  where yl = accum xs
        y = head yl
        ys = tail yl

sol v k
  | k == 0 = if (fst . head) v == 1 then -1 else 1
  | otherwise = if null w then (-1) else fst . head $ w
  where w = filter (\x -> (snd x) == k) v

main = do
  [n, k] <- readArray
  v <- scanl1 (\(x,fx) (y,fy) -> (y,fx+fy)) . accum . sort <$> readArray
  print $ sol v k

import qualified Data.ByteString.Char8 as B
import Data.List

main = do
  input <- fmap B.lines B.getContents
  let [n,k] = map readI $ B.words $ input!!0
  let as = map readI $ B.words $ input!!1
  print (solve n k as)

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

solve :: Int -> Int -> [Int] -> Int
solve n k as
  | k==0     = if head us > 1 then 1 else -1
  | otherwise= if null[()|u<- take 1 us, t==u] then t else -1
  where
    (ls,us) = splitAt k (sort as)
    t = last ls

module Main where

import Data.List
main :: IO ()
main = do
  numsS <- getLine
  let nums = map (read :: String -> Int) $ words numsS
  valsS <- getLine
  let vals = map (read :: String -> Int) $ words valsS
  print $ solve (nums!!1) $ sort vals

solve :: Int -> [Int] -> Int
solve 0 (1:_) = -1
solve 0 lst = 1

solve k lst | (length lst) == k = last lst
            | otherwise =
                let (fstL, sndL) = splitAt k lst in
                let (fstV, sndV) = (last fstL, head sndL) in
                if (fstV == sndV)
                then -1
                else fstV

import Data.List
import qualified Data.Map as Map

f ::Int->[Int]->[Int]->Int
f k [] []=(-1)
f k (x:xs) (y:ys)
   |k-y<0=(-1)
   |k-y==0=x
   |otherwise=f (k-y) xs ys

main = do
       a<-getLine
       b<-getLine
       let (n:k:[])=map read (words a)::[Int]
           xs=map read (words b)::[Int]
           ys=group $ sort xs
           zs1=(map head ys)
           zs2=(map length ys)
       print $ if k==0 && (head zs1)>1 then 1 else f k zs1 zs2

module Main where

import Data.List

compress :: [Int] -> [(Int, Int)]
compress xs = foldr go [] ys
  where
    ys = map (\x -> (x, 1)) xs
    go x [] = [x]
    go x@(xv, _) l@((lv, li):ls)
      | xv == lv = (lv, li + 1):ls
      | otherwise = x:l

solve :: Int -> [Int] -> Int
solve k xs = go k $ compress xs
  where
    go _ [] = -1
    go i ((lv, li):ls)
      | i == li = lv
      | i < li = -1
      | otherwise = go (i - li) ls

main :: IO ()
main = do
  [_, k] <- fmap (map read . words) getLine
  ns <- fmap (map read . words) getLine
  print $ solve k (sort ns)

module Main where

import Data.List
main :: IO ()
main = do
  numsS <- getLine
  let nums = map (read :: String -> Int) $ words numsS
  valsS <- getLine
  let vals = map (read :: String -> Int) $ words valsS
  print $ solve (nums!!1) $ sort vals

solve :: Int -> [Int] -> Int
solve 0 lst = -1
solve k lst =
  let (fstL, sndL) = splitAt k lst in
  let (fstV, sndV) = (last fstL, head sndL) in
  if (fstV == sndV)
  then -1
  else fstV

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && head x <= 1000000000 then head x else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x || head x > 999999999 then (if null y || head y < 2 then -1 else head y - 1)  else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && head x <= 1000000000 then head x else if last x <  head y && (head y) >= last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y then -1 else head y - 1)  else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Data.List
import qualified Data.Map as Map

f ::Int->[Int]->[Int]->Int
f k [] []=(-1)
f k (x:xs) (y:ys)
   |k-y<0=(-1)
   |k-y==0=x
   |otherwise=f (k-y) xs ys

main = do
       a<-getLine
       b<-getLine
       let (n:k:[])=map read (words a)::[Int]
           xs=map read (words b)::[Int]
           ys=group $ sort xs
           zs1=(map head ys)
           zs2=(map length ys)
       print $ f k zs1 zs2

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | null as = 33
  | k == n = 1 + last a
  | a !! k == a !! (k + 1) = -1
  | otherwise = a !! k - 1
  where a = sort as

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | k == 0 = head a - 1
  | k == n = last a
  | a !! k == a !! (k - 1) = -1
  | otherwise = a !! (k - 1)
  where a = sort as

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.List
import Data.Int
import Data.Char
import Data.Bits
import Data.Bool
import Data.Ratio
import qualified Data.Array as A

readArray = map (\x -> fst . fromJust $ S.readInt x) . S.words <$> S.getLine

accum [] = []
accum (x:xs)
  | null yl = [(x,1)]
  | x /= (fst y) = ((x,1):yl)
  | otherwise = ((x, (snd y) + 1):ys)
  where yl = accum xs
        y = head yl
        ys = tail yl

main = do
  [n, k] <- readArray
  v <- filter (\x -> (snd x) == k) . scanl1 (\(x,fx) (y,fy) -> (y,fx+fy)) . accum . sort <$> readArray
  print $ if null v then (-1) else fst . head $ v