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

{-# LANGUAGE Safe                #-}
{-# LANGUAGE ImportQualifiedPost #-}

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        getLine
    mapM_ (putStr.showAns.solve) tcs

showAns (cost, ms) = unlines [show cost ++ " " ++ (show.length) ms,
                              unwords . map show $ ms]

solve origS = (abs (ord co2 - ord co1), ans)
  where
    s | (co1 <= co2)  = origS
      | otherwise     = map chRev origS
    (co1, co2) = (head origS, last origS)
    chRev :: Char -> Char
    chRev c = chr $ ord 'a' + (ord 'z' - ord c)
    (c1, c2) = (head s, last s)
    ans = map snd . L.sortOn fst . filter (isBetween.fst) . (`zip`inds) $ s
    isBetween c = (c1 <= c && c <= c2)

inds = [1..] :: [Int]

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

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

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

import Text.Printf

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

solve :: B8.ByteString -> (Int, [Int])
solve str = (cost, finalPath)
    where
        fStr = B8.filter isAlphaNum str

        cost = abs $ ord c0 - ord c1
        path = if c0 > c1 then reverse sortedIndexes else sortedIndexes
        finalPath = 0:path ++ [B8.length fStr - 1]

        indexes = [1 .. B8.length fStr - 2]
        filteredIndexes = filter (\idx -> charMatch $ str `B8.index` idx) indexes
        sortedIndexes = sortOn (fStr `B8.index`) filteredIndexes

        c0 = B8.head fStr
        c1 = B8.last fStr

        charMatch c = (c <= c0 && c >= c1) || (c <= c1 && c >= c0)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        str <- B8.getLine
        let (cost, path) = solve str
        printf "%d %d\n" cost (length path)
        M.forM_ path $ \idx -> printf "%d " (idx + 1)
        printf "\n"

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        getLine
    mapM_ (putStr.showAns.solve) tcs

showAns (cost, ms) = unlines [show cost ++ " " ++ (show.length) ms,
                              unwords . map show $ ms]

solve origS = (abs (ord co2 - ord co1), ans)
  where
    s | (co1 <= co2)  = origS
      | otherwise     = map chRev origS
    (co1, co2) = (head origS, last origS)
    chRev :: Char -> Char
    chRev c = chr $ ord 'a' + (ord 'z' - ord c)
    (c1, c2) = (head s, last s)
    ans = map snd . L.sortOn fst . filter (isBetween.fst) . (`zip`inds) $ s
    isBetween c = (c1 <= c && c <= c2)

inds = [1..] :: [Int]

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

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

{-# options_ghc -O1                              #-}

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

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

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

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

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        getLine
    mapM_ (putStr.showAns.solve) tcs

showAns (cost, ms) = unlines [show cost ++ " " ++ (show.length) ms,
                              unwords . map show $ ms]

solve origS = (abs (ord co2 - ord co1), ans)
  where
    s | (co1 <= co2)  = origS
      | otherwise     = map chRev origS
    (co1, co2) = (head origS, last origS)
    chRev :: Char -> Char
    chRev c = chr $ ord 'a' + (ord 'z' - ord c)
    (c1, c2) = (head s, last s)
    ans = map snd . L.sortOn fst . filter (isBetween.fst) . (`zip`inds) $ s
    isBetween c = (c1 <= c && c <= c2)

inds = [1..] :: [Int]

import Control.Monad (replicateM_)
import Data.Array
import Data.List (sortBy)
import Data.Char (ord)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>=
        \s -> case (findJump s) of
                (cost, m, indices) -> putStrLn (show cost ++ ' ':show m) >>
                                      mapM_ (\i -> putStr (show i ++ " ")) indices >>
                                      putStrLn ""

findJump :: String -> (Int, Int, [Int])
findJump s = let n = length s
                 a = listArray (1, n) s
                 fc = head s
                 lc = last s
                 asc = fc <= lc -- ascending
                 o c = if asc then (fc <= c && c <= lc) else (fc >= c && c >= lc)
                 is = filter (\i -> o (a!i)) [1..n]
                 f a i j = case compare (a!i) (a!j) of
                             EQ -> if asc then compare i j else compare j i -- required to get 1, n in the right places
                             x -> x
                 isSortedAsc = sortBy (f a) is
                 isSorted = if asc then isSortedAsc else reverse isSortedAsc
             in
               ((abs $ (ord fc) - (ord lc)), length is, isSorted)

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

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

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

import System.Posix.Internals (puts)
import Text.Printf

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

solve :: B8.ByteString -> (Int, [Int])
solve str = (cost, finalPath)
    where
        cost = abs $ ord c0 - ord c1
        path = if c0 > c1 then reverse sortedIndexes else sortedIndexes
        finalPath = 0:path ++ [B8.length str - 1]

        indexes = [1 .. B8.length str - 2]
        filteredIndexes = filter (\idx -> charMatch $ str `B8.index` idx) indexes
        sortedIndexes = sortOn (str `B8.index`) filteredIndexes

        c0 = B8.head str
        c1 = B8.last str

        charMatch c = (c <= c0 && c >= c1) || (c <= c1 && c >= c0)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        str <- B8.getLine <&> B8.lines <&> head
        let (cost, path) = solve str
        printf "%d %d\n" cost (length path)
        M.forM_ path $ \idx -> printf "%d " (idx + 1)
        printf "\n"

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

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

import Control.Arrow ((>>>))
import Data.Functor ((<&>))
import Data.Maybe

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

import System.Posix.Internals (puts)
import Text.Printf

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

solve :: B8.ByteString -> (Int, [Int])
solve str = (cost, finalPath)
    where
        cost = abs $ ord c0 - ord c1
        path = if c0 > c1 then reverse sortedIndexes else sortedIndexes
        finalPath = 0:path ++ [B8.length str - 1]

        indexes = [1 .. B8.length str - 2]
        filteredIndexes = filter (\idx -> charMatch $ str `B8.index` idx) indexes
        sortedIndexes = sortOn (str `B8.index`) filteredIndexes

        c0 = B8.head str
        c1 = B8.last str

        charMatch c = (c <= c0 && c >= c1) || (c <= c1 && c >= c0)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        str <- B8.getLine <&> B8.lines <&> head
        let (cost, path) = solve str
        printf "%d %d\n" cost (length path)
        M.forM_ path $ \idx -> printf "%d " (idx + 1)
        puts ""

import Control.Monad (replicateM_)
import Data.Array
import Data.List (sortBy)
import Data.Char (ord)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>=
        \s -> case (findJump s) of
                (cost, m, indices) -> putStrLn (show cost ++ ' ':show m) >>
                                      mapM_ (\i -> putStr (show i ++ " ")) indices >>
                                      putStrLn ""

findJump :: String -> (Int, Int, [Int])
findJump s = let n = length s
                 a = listArray (1, n) s
                 fc = head s
                 lc = last s
                 asc = fc <= lc -- ascending
                 o c = if asc then (fc <= c && c <= lc) else (fc >= c && c >= lc)
                 is = filter (\i -> o (a!i)) [1..n]
                 f a i j = compare (a!i) (a!j)
                 isSortedAsc = sortBy (f a) is
                 isSorted = if asc then isSortedAsc else reverse isSortedAsc
             in
               ((abs $ (ord fc) - (ord lc)), length is, isSorted)


main = getContents >>= print . solve . map read . words

solve [h,m,a,i,c,n] = min ((*0.8) $ cost c n $ (a + i * max 0 (1200 - h*60 - m))) (cost c n a)

cost c n a = fromIntegral $ ((a + n - 1) `div` n) * c

toMin hh mm = hh*60 + mm

till20 hh mm = if (toMin hh mm) > (toMin 20 00) then (toMin 24 00) - (toMin hh mm) + (toMin 20 00)
                                                else (toMin 20 00) - (toMin hh mm)

func :: Double -> Double -> Double -> Double -> Double -> Double -> Double
func hh mm h d c n = if hh >= 20 then (fromIntegral $ (ceiling $ (h / n))) * c * 0.8
                     else min case1 case2 where
                         case1 = (fromIntegral $ (ceiling $ ((till20 hh mm) * d + h) / n)) * c * 0.8
                         case2 = (fromIntegral $ (ceiling $ (h / n))) * c

main :: IO ()
main = do
    hhmm <- getLine
    hdcn <- getLine
    let hh:mm:_ = (map read $ words hhmm)::[Double]
    let h:d:c:n:_ = (map read $ words hdcn)::[Double]
    putStrLn $ show (func hh mm h d c n)
    return ()

main = interact exec
exec = (\[hh, mm, h, d, c, n] -> let w = max 0 $ ((20 - hh) * 60 - mm)  :: Int in show $ min (fromIntegral (ceiling (fromIntegral (h + d * w) / fromIntegral n)) * fromIntegral c * 0.8) (fromIntegral $ ceiling (fromIntegral h / fromIntegral n) * c)) . map read . words

-- (h + d * m) / n

main = getContents >>= print . solve . map read . words

solve [h,m,a,i,c,n]
    | minutes >= 1200 = (*0.8) $ cost c n a
    | otherwise = min ((*0.8) $ cost c n $ (1200 - minutes) * i + a) (cost c n a)
    where minutes = h*60 + m

cost c n a = fromIntegral $ ((a + n - 1) `div` n) * c

module Main where

input :: IO [Double]
input = do
  [hh,mm] <- fmap (map read . words) getLine
  [h, d, c, n] <- fmap (map read . words) getLine
  return [hh, mm, h, d, c, n]

solve :: [Double] -> Double
solve [hh, mm, h, d, c, n]
  | hh >= 20 = r (c * 0.8) h
  | otherwise = min (r c h) $ r (c * 0.8) $ h + d * ((19 - hh) * 60 + 60 - mm)
      where r p hn = p * (fromIntegral $ ceiling $ hn / n)

main :: IO ()
main = print . solve =<< input

toMin hh mm = hh*60 + mm

till20 hh mm = if (toMin hh mm) > (toMin 20 00) then (toMin 24 00) - (toMin hh mm) + (toMin 20 00)
                                                else (toMin 20 00) - (toMin hh mm)

func :: Double -> Double -> Double -> Double -> Double -> Double -> Double
func hh mm h d c n = min case1 case2 where
    case1 = (fromIntegral $ (ceiling $ ((till20 hh mm) * d + h) / n)) * c * 0.8
    case2 = (fromIntegral $ (ceiling $ (h / n))) * c

main :: IO ()
main = do
    hhmm <- getLine
    hdcn <- getLine
    let hh:mm:_ = (map read $ words hhmm)::[Double]
    let h:d:c:n:_ = (map read $ words hdcn)::[Double]
    putStrLn $ show (func hh mm h d c n)
    return ()

main = interact exec
exec = (\[hh, mm, h, d, c, n] -> let w = ((20 - hh) * 60 + mm) `mod` 1440 :: Int in show $ min (fromIntegral (ceiling (fromIntegral (h + d * w) / fromIntegral n)) * fromIntegral c * 0.8) (fromIntegral $ ceiling (fromIntegral h / fromIntegral n) * c)) . map read . words

-- (h + d * m) / n

main = interact exec
exec = (\[hh, mm, h, d, c, n] -> let w = ((20 - hh) * 60 - mm) `mod` 1440 :: Int in show $ min (fromIntegral (ceiling (fromIntegral (h + d * w) / fromIntegral n)) * fromIntegral c * 0.8) (fromIntegral $ ceiling (fromIntegral h / fromIntegral n) * c)) . map read . words

-- (h + d * m) / n


{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleContexts #-}

import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S

import qualified Data.Array as A

import qualified Control.Monad.State.Strict as State
import Control.Monad.ST

import Data.Bits(xor, (.&.), (.|.))
import qualified Data.Array.MArray as MA
import Data.STRef(STRef, newSTRef, readSTRef, writeSTRef)
import Data.Array.ST(runSTArray, STArray)
import Data.Array.IO(IOArray)

import Data.Array((!))
import Control.Monad(replicateM, filterM, forM) -- foldM est un foldl
import Data.Maybe

type Output = Bool

solve :: Integer -> Integer -> Integer -> Output
solve n m k = State.evalState (eval n m k) M.empty where

	eval i j k = do
		m <- State.get
		case M.lookup (i, j, k) m of
			Nothing -> do
				val <- aux eval i j k
				mem <- State.get
				State.put $ M.insert (i, j, k) val mem
				return val
			Just v -> return v

	aux fun i j k
		| i == 1 = return $! k == (j - 1)
		| j == 1 = return $! k == (i - 1)
		| i > k && j > k = return $! False
		| i > k = fun (i-1) j (k-j)
		| j > k = fun i (j-1) (k-i)
		| otherwise = do
			x1 <- fun (i-1) j (k-j)
			if x1 then return $! True else fun i (j-1) (k-i)

plotResult :: Output -> IO ()
plotResult False = putStrLn "NO"
plotResult True = putStrLn "YES"

main :: IO ()
main = do
	t <- getLine >>= return . read :: IO Int
	replicateM t $ do
		[n, m, k] <- getLine >>= return . (fmap read) . words :: IO [Integer]
		--a <- getLine >>= return . (fmap read) . words :: IO [Integer]
		plotResult $ solve n m k
	return ()

solve [] = [""]
solve (x:xs) = answer ++ solve xs
  where
    [n, m, k] = map read $ words x
    answer =
      if n * m - 1 == k
      then ["YES"]
      else ["NO"]

main = interact $ unlines . helper . lines
  where
    helper (x:xs) = solve xs

import Control.Arrow ((>>>))
import Data.Bool (bool)

main :: IO ()
main =
  interact $
  lines >>>
  tail >>> map (words >>> map read >>> solve >>> bool "NO" "YES") >>> unlines

solve :: [Int] -> Bool
solve [n, m, k] = n * m - 1 == k


import Data.List
import Data.Int
import Data.Char
import Control.Monad

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

count :: Eq a => a -> [a] -> Int
count x = length . filter (==x)

merge :: [a] -> [a] -> [a]
merge [] ys = ys
merge (x:xs) ys = x:(merge ys xs)

calc :: [Int64] -> Int64
calc (x:y:z:xs) = (if y < x && y < z then 1 else 0) + calc (z:xs)
calc _ = 0

rotate xs n = take len . drop (n `mod` len) . cycle $ xs
    where len = length xs

solve :: IO ()
solve = do
    n <- readInt
    b <- readArray
    let a = reverse $ sort b
    let (large,small) = splitAt ((n + 1) `div` 2) a
    let small' = if even n then rotate small 1 else small
    let res = merge large small'
    let answer = calc res
    print answer
    forM_ res $ (\x -> print x)
    return ()

main :: IO ()
main = do
    -- t <- readInt
    -- forM_ [0..t-1] $ (\i -> solve)
    solve

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

main = do
  getLine
  as <- sort . map read . words <$> getLine :: IO [Integer]
  let solution = solve as
  print $ cheap solution
  putStrLn $ unwords $ map show solution

solve as
  | even $ length as = (\(a, b) -> [a, b]) =<< zip (as !! pred d : take (pred d) as) (drop d as)
  | otherwise = (as !! d :) $ (\(a, b) -> [a, b]) =<< zip (take d as) (drop (succ d) as)
  where
    d = length as `div` 2

cheap = length . filter (\(a, b, c) -> a > b && b < c) . (zip3 <*> tail <*> tail . tail)

import Data.List

main :: IO ()
main = do
  n <- readLn
  as <- (map read.words) <$> getLine
  let (a,b) = solve n as
  print a
  putStrLn $ (unwords.map show) b

solve :: Int -> [Int] -> (Int,[Int])
solve n as = (r, order)
  where
    as' = sort as
    (smalls,bigs) = splitAt ((n) `div` 2) as'
    order = merge bigs smalls
    r = length $ filter (\(a,b,c) -> a>b && b<c) $ zip3 order (tail order) (drop 2 order)

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a:b:merge as bs
merge as bs = as ++ bs

import Data.List

trySolve :: Int -> [Int] -> Int -> Maybe [Int]
trySolve n as k = if  k + k + 1 > n
  then  Nothing
  else  let
    (lows, nonlows) = splitAt k as
    (rev_his, mids) = splitAt (k+1) (reverse nonlows)
    his = reverse rev_his
  in  if  and $ zipWith (<) lows his
  then  Just $ stitch lows his ++ mids
  else  Nothing

stitch :: [Int] -> [Int] -> [Int]
stitch [] [] = []
stitch ps (q:qs) = q : stitch qs ps
stitch _ _ = error "stitch: invalid args"

binSearch :: (Int -> Bool) -> Int -> Int -> Int
binSearch p = let
  go low top = if  low == top
    then  low
    else  let
    mid = div (low + top + 1) 2
    in  if  p mid
    then  go mid top
    else  go low (mid - 1)
  in  go

solve :: Int -> [Int] -> (Int, [Int])
solve n li = let
  p k = case  trySolve n li k  of
    Nothing -> False
    _ -> True
  ktar = binSearch p 0 (n + 100)
  in  case  trySolve n li ktar  of
    Nothing -> error "binSearch failed?"
    Just ans -> (ktar, ans)

main :: IO ()
main = do
  n <- read <$> getLine
  a <- map read . words <$> getLine
  let  (ktar, ans) = solve n (sort a)
  print ktar
  putStrLn . unwords $ map show ans

import Data.List

main :: IO ()
main = do
  n <- readLn
  as <- (map read.words) <$> getLine
  let (a,b) = solve n as
  print a
  putStrLn $ (unwords.map show) b

solve :: Int -> [Int] -> (Int,[Int])
solve n as = (r, order)
  where
    as' = sort as
    (smalls,bigs) = splitAt ((n-1) `div` 2) as'
    order = merge bigs smalls
    r = length $ filter (\(a,b,c) -> a>b && b<c) $ zip3 order (tail order) (drop 2 order)

merge :: [a] -> [a] -> [a]
merge (a:as) (b:bs) = a:b:merge as bs
merge as bs = as ++ bs

import Data.List
import Data.Int
import Data.Char
import Control.Monad
import Data.Bits

readArray :: IO [Int64]
readArray = do
    line <- getLine
    return $ map (read::String->Int64) $ words line

readInt :: IO Int
readInt = do
    line <- getLine
    return $ (read::String->Int) $ line

count :: Eq a => a -> [a] -> Int
count x = length . filter (==x)

merge :: [a] -> [a] -> [a]
merge [] ys = ys
merge (x:xs) ys = x:(merge ys xs)

calc :: [Int64] -> Int64
calc (x:y:z:xs) = (if y < x && y < z then 1 else 0) + calc (z:xs)
calc _ = 0

solve :: IO ()
solve = do
    n <- readInt
    b <- readArray
    let a = reverse $ sort b
    let (large,small) = splitAt ((n + 1) `div` 2) a
    let res = merge large small
    let answer = calc res
    print answer
    forM_ res $ (\x -> print x)
    return ()

main :: IO ()
main = do
    -- t <- readInt
    -- forM_ [0..t-1] $ (\i -> solve)
    solve


import Data.Int
import Data.List
import qualified Data.ByteString.Char8 as B
main = print . solve . map readI . tail . B.words =<< B.getContents
solve as = sum $ zipWith ((abs .) . (-)) [1..] $ sort as :: Int64
readI b = fromIntegral i where Just (i,_) = B.readInt b

{-# OPTIONS_GHC -O2 #-}

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

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

main :: IO ()
main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  print $ solve  n xs

solve :: Int -> [Int] -> Integer
solve n xs = sum.map toInteger.zipWith ((abs.).(-)) [1..n] $ sort xs

import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.List

main = do
	getLine
	s<- sort.map (fst.fromJust.C.readInt) . C.words <$> C.getLine
	print  $ sum $ map fromIntegral $ zipWith (\a b -> abs (a-b)) s [1..]

import Control.Monad (liftM)
import Data.Char (ord)
import Data.List (intercalate, sort)

solve :: [Integer] -> Integer
solve  =  sum . map abs . zipWith (-) [1..] . sort

main :: IO ()
main  =  do
    getLine
    as  <-  reads
    print $ solve as

  where

    reads :: Num a => IO [a]
    reads  =  liftM (map read . words) getLine
      where
        read ('-':s)  =  (-1) * read s
        read s  =  read' 0 s
        read' a ""  =  a
        read' a (c:s)  =  read' (10 * a + fromIntegral (ord c - ord '0')) s

    prints :: Show a => [a] -> IO ()
    prints  =  putStrLn . intercalate " " . map show

import qualified Data.List as DL
import qualified Data.ByteString.Char8 as BC
import Data.Maybe (fromJust)

f::(Integer,Integer)->Integer
f (a,b)=abs(a-b)

main = do
       e1<-BC.getLine
       e2<-BC.getLine
       let xs=map (fst . fromJust . BC.readInteger) . BC.words $ e2
           xs2=DL.sort xs
           ys=zip xs2 [1..]
       print $ sum (map f ys)

import Data.List (sort)
import Data.Maybe (fromJust)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= print . solve . map (fromIntegral . fst . fromJust . B.readInt) . tail . B.words

solve :: [Integer] -> Integer
solve = sum . map abs . zipWith (-) [1..] . sort

import Control.Applicative
import Data.Bits
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.List

main = do
	getLine
	s<- sort.map (fst.fromJust.C.readInt) . C.words <$> C.getLine
	print  $ sum $ zipWith (\a b -> abs (a-b)) s [1..]


import Array
import Control.Monad
import Control.Applicative

mark i j x = c ! (idx !! (x ! (div i 2, div j 2)))
  where
    c = listArray ((0, 0, 0), (2, 1, 1)) ['a'..]
    idx = [(0, div j' 2, mod i' 2), (1, div i' 2, mod j' 2), (2, div j' 2, div i' 2)]
    i' = mod i 4
    j' = mod j 4

tile n m a b c = Just [[mark i j x | j <- [0..(2*m-1)]] | i <- [0..(2*n-1)]]
    where x = listArray ((0,0), (n-1, m-1)) $ replicate a 0 ++ replicate b 1 ++ replicate c 2

solve n m a b c
  | odd n && odd m = Nothing
  | odd n && even m =
    if a < div m 2
     then Nothing
     else (:) (take m xy) <$> solve (n-1) m (a - div m 2) b c
  | even n && odd m =
    if b < div n 2
     then Nothing
     else zipWith (:) (take n xy) <$> solve n (m-1) a (b-(div n 2)) c
  | otherwise =
    if (div a 2 * 4 + div b 2 * 4 + c*4) < n*m
     then Nothing
     else tile (div n 2) (div m 2) (div a 2) (div b 2) c
  where xy = cycle "xxyy"

main = do
    [n, m, a, b, c] <- map read . words <$> getLine
    mapM_ putStrLn (maybe ["IMPOSSIBLE"] id $ solve n m a b c)

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.ST

solve :: [String] -> [String]
solve = do
  [n, m, a, b, c] <- map read . words . head
  let draw flag = runST $ do
        let r = ((1, 1), (n, m))
        arr <- newArray r '*' :: ST s (STArray s (Int, Int) Char)
        let check idx@(j, i) state@(a', b', c') = do
              let nextChar z = if z == 'd' then 'a' else succ z
              if (inRange r idx) && flag /= 0
                then case flag of
                  1 -> do
                    x <- if not $ inRange r (j - 1, i)
                           then return 'a'
                           else nextChar <$> readArray arr (j - 1, i)
                    writeArray arr (j, i)     x
                    writeArray arr (j + 1, i) x
                    check (j + 2, i) (a', b' - 1, c')
                  2 -> do
                    x <- if not $ inRange r (j, i - 1)
                           then return 'a'
                           else nextChar <$> readArray arr (j, i - 1)
                    writeArray arr (j, i)     x
                    writeArray arr (j, i + 1) x
                    check (j, i + 2) (a' - 1, b', c')
                else return state
        let fill idx@(j, i) state = do
              let next = fill (j, i + 1)
              when (j <= n) $ do
                if i > m
                  then fill (j + 1, 1) state
                  else do
                    x <- readArray arr idx
                    if x /= '*'
                      then next state
                      else do
                        let check z = if z == '*' then [] else [z]
                        let pickup zs = do
                              cs <- fmap (concatMap check) . mapM (readArray arr) $ filter (inRange r) zs
                              return $ filter (`notElem` cs) "abcd"
                        let write zs = sequence $ do
                              (z, ps) <- zs
                              return $ mapM_ (flip (writeArray arr) z) ps
                        case state of
                          (a', b', c')
                            | c' > 0 -> do
                              x1 <-  head <$> pickup [(j - 1, i), (j, i - 1)]
                              write [(x1, [idx, (j + 1, i), (j, i + 1), (j + 1, i + 1)])]
                              next (a', b', c' - 1)
                            | b' > 0 -> do
                              x1 <- head <$> pickup [(j - 1, i), (j, i - 1), (j + 1, i - 1)]
                              x2 <- head . filter (/= x1) <$> pickup [(j - 1, i + 1)]
                              write [(x1, [idx, (j + 1, i)]), (x2, [(j, i + 1), (j + 1, i + 1)])]
                              next (a', b' - 1, c')
                            | a' > 0 -> do
                              x1 <- head <$> pickup [(j, i - 1), (j - 1, i), (j - 1, i + 1)]
                              x2 <- head . filter (/= x1) <$> pickup [(j + 1, i - 1)]
                              write [(x1, [idx, (j, i + 1)]), (x2, [(j + 1, i), (j + 1, i + 1)])]
                              next (a' - 1, b', c')
                          _ -> error "Never happens!"
        (a', b', c') <- check (1, 1) (a, b, c)
        fill (1, 1) (a' `quot` 2, b' `quot` 2, c')
        let split = takeWhile (not . null) . map (take m) . iterate (drop m)
        split <$> getElems arr
  return . maybe (return "IMPOSSIBLE") draw $ do
        let (p, s) = m `quotRem` 2 ; (q, t) = n `quotRem` 2
        let flag = sum . zipWith (*) [1 ..] $ map fromEnum [s /= 0, t /= 0]
        guard $ flag /= 3
        let ds = [a * 2 - m * t, b * 2 - n * s]
        guard $ all even ds && all (0 <=) ds
        let d = sum $ map (`quot` 4) ds
        guard $ p * q <= c + d
        return flag

main :: IO ()
main = interact $ unlines . solve . lines


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

--
-- K-beautiful Strings
-- (upsolving)
--
-- Problem statement:
--
--     http://codeforces.com/contest/1493/problem/C
--
-- Tutorial:
--
--     http://codeforces.com/blog/entry/88422
--

{-# LANGUAGE NoMonomorphismRestriction #-}

import Data.Maybe
import Data.Monoid
import Data.Array.Unboxed

main = interact $ unlines . map solveTC . linePairs . tail . lines
  where
    readI s = read s :: Int

    linePairs [] = []
    ---------------------------- N     K     S    ---------------------
    linePairs (strNK:strS:ls) = (lenS, modK, strS) : linePairs ls
      where
        [lenS, modK] = (map readI . words) strNK

solveTC (lenS, modK, strS) = (fromMaybe "-1" . maybeFirst) solutions
  where
    solutions | lenS `mod` modK /= 0   = [Nothing] :: [Maybe String]
              | isBeautiful            = [Just strS]
              | otherwise              = findSolutions

    isBeautiful = ((== 0) . cntSum . cntLack modK . last) psumsHave

    psumsHave = scanl cntUpdate cntZero strS

    findSolutions = richMidcharPositions prefLengths >>= midposSolutions

    prefLengths = [0 .. lenS - 1]

    richMidcharPositions = reverse . zip3 strS psumsHave
    --
    midposSolutions (origMidChar, origCnts, prefLen)
        = (map . fmap) (pref ++) (map midcharSolution charCandidates)
      where
        pref = take prefLen strS     -- chars before the mid char

        suffLen = lenS - prefLen - 1     -- number of chars after the mid char

        charCandidates = [succ origMidChar .. 'z']

        midcharSolution charCandidate
            = fmap (charCandidate :) (solveSuffix (cntLack modK newCnts) suffLen)
          where
            newCnts = cntUpdate origCnts charCandidate

-- Generate the lexicographically smallest string of given length and
-- minimal occurrences for each character.
--
solveSuffix :: CharCounts -> Int -> Maybe String
--
solveSuffix cntsNeed len | cntA < 0   = Nothing
                         | otherwise  = Just . runLenDecode  $  ('a',cntA) : assocs cntsNeed
  where
    cntA = len - cntSum cntsNeed

runLenDecode = foldMap d
  where
    d (ch, cnt) = replicate cnt ch

maybeFirst = getAlt . foldMap Alt     -- choose first valid solution

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

type CharCounts = UArray Char Int

cntZero = array ('a','z') [] :: CharCounts

cntUpdate cnts ch = cnts // [(ch, 1 + cnts!ch)]

cntSum = sum . elems

cntLack k cnts = amap lackFromHave cnts
  where
    mk = (`mod` k)
    lackFromHave = mk . (k -) . mk  -- Given a letter count,
                                    -- how many such letters we need to add?

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import Data.Either
import qualified Data.ByteString.Char8 as C

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

type State = Either String (Array Char Int, Int)

main :: IO ()
main = do
  [t] <- getInts
  replicateM_ t $ do
    [n, k] <- getInts
    s <- take n . C.unpack <$> C.getLine
    let
      getNeed x
        | y == 0 = 0
        | otherwise = k - y
        where
        y = x `mod` k
      acc :: State -> Char -> State
      acc tt c
        | isLeft tt = Left $ c : fromLeft "" tt
        | m + 1 > cm && c < 'z' = Left $ choose (succ c)
        | m + 1 == cm && not (null candidates) = Left $ choose $ fst $ head candidates
        | otherwise = Right (arr', m + 1)
        where
        Right (arr, m) = tt
        arr' = arr // [(c, arr ! c - 1)]
        cm = sum $ map getNeed $ elems arr'
        choose ch = ch : ss'
          where
          a = arr' // [(ch, arr' ! ch + 1)]
          ss = concat $ map (\(o, x) -> take (getNeed x) $ repeat o) $ assocs a
          ss' = take (m - length ss) (repeat 'a') ++ ss
        candidates = filter (\(ch, x) -> ch > c && x `mod` k /= 0) $ assocs arr'
      a0 = accumArray (+) 0 ('a', 'z') $ zip s $ repeat 1
      result
        | n `mod` k /= 0 = "-1"
        | null (filter (\x -> x `mod` k /= 0) $ elems a0) = s
        | otherwise = fromLeft "" $ foldl' acc (Right (a0, 0)) $ reverse s
    C.putStrLn $ C.pack result

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

--
-- K-beautiful Strings
-- (upsolving)
--
-- Problem statement:
--
--     http://codeforces.com/contest/1493/problem/C
--
-- Tutorial:
--
--     http://codeforces.com/blog/entry/88422
--

{-# LANGUAGE NoMonomorphismRestriction #-}

import qualified Data.List as List
import Data.Maybe (Maybe(Just,Nothing), fromMaybe)
import Data.Monoid (Alt(Alt), getAlt)
import Data.Array.Unboxed (UArray, array)
import Control.Arrow((&&&))

main = interact $ unlines . map solveTC . linePairs . tail . lines

linePairs [] = []
---------------------------- N     K     S    ---------------------
linePairs (strNK:strS:ls) = (lenS, modK, strS) : linePairs ls
  where
    [lenS, modK] = (map readI . words) strNK

readI s = read s :: Int

solveTC (lenS, modK, strS) = (fromMaybe "-1" . maybeFirst) solutions
  where
    solutions
        | lenS `mod` modK /= 0   = [Nothing] :: [Maybe String]
        | isBeautiful modK strS  = [Just strS]
        | otherwise              = (map (solveFixedPrefix . charCounts $ strS) . reverse) [0 .. lenS-1]

    solveFixedPrefix cnts lenP = Just "trwtretwe"   -- TODO

isBeautiful modK strS = False   -- TODO

maybeFirst = getAlt . foldMap Alt

charCounts = toArr . map (head &&& length) . List.group . List.sort
  where
    toArr pairs = array ('a','z') pairs :: UArray Char Int


import Data.List

f::[(Int,Int)]->Int
f []=0
f ((0,_):xs)=f xs
f (_:xs)=1+f xs

main = do
       e<-getLine
       es<-getLine
       let xs=map read (words es)::[Int]
           ys=group $ sort xs
           zs=zip (map head ys) (map length ys)
       print $ f zs

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

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

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [Int]
readInts = map parse . C8.words
  where parse s = let Just(x,_) = C8.readInt s in x

main :: IO ()
main = do
  _ <- getLine
  bs <- input
  let array = readInts bs
  print $ length . List.filter ((/= 0) . head)
    . List.group . List.sort $ array

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

main = do
	getLine
	k<-length <$> group <$> filter (/=0) <$> sort <$> map read <$> words <$> getLine:: IO Int
	print k

import Data.List
-- import Debug.Trace

myunique arr =
  foldr f [0] arr
  where
    f item acc = if item == head acc then acc else item:acc

solve :: String -> String
solve s = show $ length $ filter (/=0) $ myunique $ sort $ map read $ tail $ words s

main :: IO ()
main = do
  buf <- getContents
  putStrLn $ solve buf

import Data.List

solve :: String -> String
solve s = show $ length $ nub $ tail $ words s

main :: IO ()
main = do
  buf <- getContents
  putStrLn $ solve buf

module Main where

import System.IO
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C8

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

import Control.Monad

input :: IO BS.ByteString
input = do
  handle <- return stdin --openFile "test.txt" ReadMode
  BS.hGetContents handle

readInts :: BS.ByteString -> [Int]
readInts = map parse . C8.words
  where parse s = let Just(x,_) = C8.readInt s in x

main :: IO ()
main = do
  _ <- getLine
  bs <- input
  let array = readInts bs
  print $ length . List.group . List.sort $ array


{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.STRef
import Data.Array.Unboxed
import Data.Graph hiding (buildG)
import Data.Tuple (swap)
import qualified Data.Graph as G

data Queue s = Queue { values :: STUArray s Int Int
                     , front  :: STRef s Int
                     , rear   :: STRef s Int
                     }

mkQueue :: Int -> ST s (Queue s)
mkQueue size = do v <- newArray (0, size - 1) 0
                  f <- newSTRef 0
                  r <- newSTRef 0
                  return $ Queue v f r

pushQueue :: Queue s -> Int -> ST s ()
pushQueue q x = do r <- readSTRef (rear q)
                   writeArray (values q) r x
                   writeSTRef (rear q) (r + 1)

popQueue :: Queue s -> ST s Int
popQueue q = do f <- readSTRef (front q)
                writeSTRef (front q) (f + 1)
                readArray (values q) f

isEmpty :: Queue s -> ST s Bool
isEmpty q = liftM2 (==) (readSTRef (front q)) (readSTRef (rear q))

buildG :: Int -> [(Vertex, Vertex)] -> Graph
buildG numVertices edges = G.buildG (1, numVertices) $ edges ++ map swap edges

testGraph0 :: Graph
testGraph0 = buildG 5 [(1, 2), (2, 3), (3, 4), (4, 5)]

bfs :: Graph -> Vertex -> UArray Vertex Int
bfs graph source = let vertices = bounds graph
                   in runSTUArray $ do
                     distance <- newArray vertices (-1) :: ST s (STUArray s Vertex Int)
                     writeArray distance source 0
                     queue <- mkQueue (snd vertices - fst vertices + 1)
                     pushQueue queue source

                     let unseen v = liftM (< 0) (readArray distance v)
                         go = do ! u  <- popQueue queue
                                 ! d  <- readArray distance u
                                 forM_ (graph ! u) $ \v -> do
                                      ! d' <- readArray distance v
                                      when (d' < 0) $ do
                                        writeArray distance v (d + 1)
                                        pushQueue queue v
                                 ! done <- isEmpty queue
                                 unless done go
                     go
                     return distance

solve :: Graph -> Int -> (Int, Int, Int) -> (Int, Int, Int) -> Int
solve graph numEdges (s1, t1, l1) (s2, t2, l2) | dist2 s1 t1 > l1 = -1
                                               | dist2 s2 t2 > l2 = -1
                                               | otherwise = max (numEdges - minimum space) 0
     where vertices@(minv, maxv) = bounds graph
           distances = listArray vertices $ map (bfs graph) (range vertices) :: Array Vertex (UArray Vertex Int)

           dist2 u v = distances ! u ! v
           dist4 s u v t = dist2 u v + min (dist2 s u + dist2 v t) (dist2 s v + dist2 u t)

           space = (dist2 s1 t1 + dist2 s2 t2) : [d1 + d2 - dist2 u v | u <- [minv .. maxv]
                                                 , v <- [u .. maxv]
                                                 , let ! d1 = dist4 s1 u v t1
                                                 , d1 <= l1
                                                 , let ! d2 = dist4 s2 u v t2
                                                 , d2 <= l2
                                                 ]

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

main :: IO ()
main = do
  [numVertices, numEdges] <- readInts
  edges <- replicateM numEdges $ do
             [u, v] <- readInts
             return (u, v)
  [s1, t1, l1] <- readInts
  [s2, t2, l2] <- readInts
  let graph = buildG numVertices edges
  print $ solve graph numEdges (s1, t1, l1) (s2, t2, l2)

{-# LANGUAGE BangPatterns #-}
module Main where

import Control.Monad
import Control.Monad.ST
import Data.Array.ST
import Data.STRef
import Data.Array.Unboxed
import Data.Graph hiding (buildG)
import Data.Tuple (swap)
import qualified Data.Graph as G

data Queue s a = Queue { values :: STArray s Int a
                       , front  :: STRef s Int
                       , rear   :: STRef s Int
                       }

mkQueue :: Int -> a -> ST s (Queue s a)
mkQueue size x = do v <- newArray (1, size) x
                    f <- newSTRef 1
                    r <- newSTRef 1
                    return $ Queue v f r

pushQueue :: Queue s a -> a -> ST s ()
pushQueue q x = do r <- readSTRef (rear q)
                   writeArray (values q) r x
                   writeSTRef (rear q) (r + 1)

popQueue :: Queue s a -> ST s a
popQueue q = do f <- readSTRef (front q)
                writeSTRef (front q) (f + 1)
                readArray (values q) f

isEmpty :: Queue s a -> ST s Bool
isEmpty q = liftM2 (==) (readSTRef (front q)) (readSTRef (rear q))

buildG :: Int -> [(Vertex, Vertex)] -> Graph
buildG numVertices edges = G.buildG (1, numVertices) $ edges ++ map swap edges

testGraph0 :: Graph
testGraph0 = buildG 5 [(1, 2), (2, 3), (3, 4), (4, 5)]

bfs :: Graph -> Vertex -> UArray Vertex Int
bfs graph source = let vertices = bounds graph
                   in runSTUArray $ do
                     distance <- newArray vertices (-1) :: ST s (STUArray s Vertex Int)
                     writeArray distance source 0
                     queue <- mkQueue (snd vertices - fst vertices + 1) 0
                     pushQueue queue source

                     let unseen v = liftM (< 0) (readArray distance v)
                         go = do ! u  <- popQueue queue
                                 ! d  <- readArray distance u
                                 forM_ (graph ! u) $ \v -> do
                                      ! d' <- readArray distance v
                                      when (d' < 0) $ do
                                        writeArray distance v (d + 1)
                                        pushQueue queue v
                                 ! done <- isEmpty queue
                                 unless done go
                     go
                     return distance

solve :: Graph -> Int -> (Int, Int, Int) -> (Int, Int, Int) -> Int
solve graph numEdges (s1, t1, l1) (s2, t2, l2) | dist2 s1 t1 > l1 = -1
                                               | dist2 s2 t2 > l2 = -1
                                               | otherwise = max (numEdges - minimum space) 0
     where vertices@(minv, maxv) = bounds graph
           distances = listArray vertices $ map (bfs graph) (range vertices) :: Array Vertex (UArray Vertex Int)

           dist2 u v = distances ! u ! v
           dist4 s u v t = dist2 u v + min (dist2 s u + dist2 v t) (dist2 s v + dist2 u t)

           space = (dist2 s1 t1 + dist2 s2 t2) : [d1 + d2 - dist2 u v | u <- [minv .. maxv]
                                                 , v <- [u .. maxv]
                                                 , let ! d1 = dist4 s1 u v t1
                                                 , d1 <= l1
                                                 , let ! d2 = dist4 s2 u v t2
                                                 , d2 <= l2
                                                 ]

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

main :: IO ()
main = do
  [numVertices, numEdges] <- readInts
  edges <- replicateM numEdges $ do
             [u, v] <- readInts
             return (u, v)
  [s1, t1, l1] <- readInts
  [s2, t2, l2] <- readInts
  let graph = buildG numVertices edges
  print $ solve graph numEdges (s1, t1, l1) (s2, t2, l2)

module Main where

import Control.Monad
import Data.Array
import Data.Graph
import Data.Tree
import Data.Tuple (swap)

data CList a = CList ([a] -> [a])

emptyClist :: CList a
emptyClist = CList id

append :: a -> CList a -> CList a
append a (CList f) = CList $ (a :) . f

singleton :: a -> CList a
singleton a = append a emptyClist

cat :: CList a -> CList a -> CList a
cat (CList f) (CList g) = CList (f . g)

freeze :: CList a -> [a]
freeze (CList f) = f []

getDistTS :: Int -> Forest Vertex -> CList (Vertex, Int)
getDistTS height forest = foldl cat emptyClist $ map (getDistT height) forest

getDistT :: Int -> Tree Vertex -> CList (Vertex, Int)
getDistT height tree = root `cat` children
    where root = singleton (rootLabel tree, height)
          children = getDistTS (height + 1) (subForest tree)

getDistance :: Vertex -> Graph -> Array Vertex Int
getDistance u g = array (bounds g) . freeze . getDistTS 0 $ dfs g [u]

getDistances :: Graph -> Array Vertex (Array Vertex Int)
getDistances g = array (bounds g) $ [(v, getDistance v g) | v <- range (bounds g)]

mmin :: [Int] -> Int
mmin [] = -1
mmin xs = minimum xs

solve :: Int -> Int -> Graph -> (Int, Int, Int) -> (Int, Int, Int) -> Int
solve n m g (s1, t1, l1) (s2, t2, l2) | dist s1 t1 > l1 = -1
                                      | dist s2 t2 > l2 = -1
                                      | r2 < 0 = max (m - r1) 0
                                      | otherwise = max (m - min r1 r2) 0
    where ds     = getDistances g
          dist u v = ds ! u ! v
          try1 u v | dist s1 u + dist v t1 + duv > l1 = -1
                   | dist s2 u + dist v t2 + duv > l2 = -1
                   | otherwise = dist s1 u + dist v t1 + dist s2 u + dist v t2 + duv
              where duv = dist u v

          try2 u v | dist s1 u + dist v t1 + duv > l1 = -1
                   | dist s2 v + dist u t2 + duv > l2 = -1
                   | otherwise = dist s1 u + dist v t1 + dist s2 v + dist u t2 + duv
              where duv = dist u v

          r1 = dist s1 t1 + dist s2 t2
          r2 = mmin . filter (>= 0) $ [try1 u v | u <- range (bounds g), v <- range (bounds g)] ++
               [try2 u v | u <- range (bounds g), v <- range (bounds g)]

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

main :: IO ()
main = do
  [n, m] <- readInts
  edges  <- replicateM m $ do
             [u, v] <- readInts
             return (u - 1, v - 1)
  let g = buildG (0, n - 1) (edges ++ map swap edges)
  [s1, t1, l1] <- readInts
  [s2, t2, l2] <- readInts
  print $ solve n m g (s1 - 1, t1 - 1, l1) (s2 - 1, t2 - 1, l2)

module Main where

import Control.Monad
import Data.Array
import Data.Graph
import Data.Tree
import Data.Tuple (swap)

data CList a = CList ([a] -> [a])

emptyClist :: CList a
emptyClist = CList id

append :: a -> CList a -> CList a
append a (CList f) = CList $ (a :) . f

singleton :: a -> CList a
singleton a = append a emptyClist

cat :: CList a -> CList a -> CList a
cat (CList f) (CList g) = CList (f . g)

freeze :: CList a -> [a]
freeze (CList f) = f []

getDistTS :: Int -> Forest Vertex -> CList (Vertex, Int)
getDistTS height forest = foldl cat emptyClist $ map (getDistT height) forest

getDistT :: Int -> Tree Vertex -> CList (Vertex, Int)
getDistT height tree = root `cat` children
    where root = singleton (rootLabel tree, height)
          children = getDistTS (height + 1) (subForest tree)

getDistance :: Vertex -> Graph -> Array Vertex Int
getDistance u g = array (0, n) . freeze . getDistTS 0 $ dfs g [u]
    where (0, n) = bounds g

getDistances :: Graph -> Array Vertex (Array Vertex Int)
getDistances g = array (0, n) $ [(v, getDistance v g) | v <- [0 .. n]]
    where (0, n) = bounds g

solve :: Int -> Int -> Graph -> (Int, Int, Int) -> (Int, Int, Int) -> Int
solve n m g (s1, t1, l1) (s2, t2, l2) | dist s1 t1 > l1 = -1
                                      | dist s2 t2 > l2 = -1
                                      | otherwise = max (m - min r1 r2) 0
    where (0, n) = bounds g
          ds     = getDistances g
          dist u v = ds ! u ! v
          try u v  = dist u v + min (dist s1 u + dist v t1 + dist s2 u + dist v t2) (dist s1 u + dist v t1 + dist s2 v + dist u t2)

          r1 = dist s1 t1 + dist s2 t2
          r2 = minimum [try u v | u <- [0 .. n], v <- [0 .. n]]

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

main :: IO ()
main = do
  [n, m] <- readInts
  edges  <- replicateM m $ do
             [u, v] <- readInts
             return (u - 1, v - 1)
  let g = buildG (0, n - 1) (edges ++ map swap edges)
  [s1, t1, l1] <- readInts
  [s2, t2, l2] <- readInts
  print $ solve n m g (s1 - 1, t1 - 1, l1) (s2 - 1, t2 - 1, l2)


import Control.Monad (replicateM)

data Tree = Val Int|New Int|B1 Int Int Tree|B2 Int Int Int Tree Tree deriving Show

branch :: Int -> Int -> (Tree,Int)
branch i 1 = (Val i,0)
branch i 2 = (B1 1 i (New 1),1)
branch i n = (B2 h1 h2 i (New h1) (New h2),h2) where
  h2 = div n 2
  h1 = h2 + mod n 2 - 1

{-
maxNew :: Tree -> Int
maxNew (Val _) = 0
maxNew (New n) = n
maxNew (B1 _ t) = maxNew t
maxNew (B2 _ t1 t2 ) = max (maxNew t1) (maxNew t2)
-}

modifyBy :: Int -> Tree -> (Tree,Int)
modifyBy i (New n) = branch i n
modifyBy i t@(Val _) = (t,0)
modifyBy i (B1 tl k t) =(B1 mx k nt,mx) where
  (nt,mx) = modifyBy i t
modifyBy i (B2 t1l t2l k t1 t2)
  |t2l > t1l = let
      (nt2,nt2l) = modifyBy i t2
        in (B2 t1l nt2l k t1 nt2,max t1l nt2l)
  |otherwise = let
      (nt1,nt1l) = modifyBy i t1
       in (B2 nt1l t2l k nt1 t2,max t2l nt1l)

modBy :: Int -> Tree -> Tree
modBy i t = fst $ modifyBy i t

toList :: Tree -> [Int]
toList (Val k) = [k]
toList (New _) = []
toList (B1 _ k t) = [k]++(toList t)
toList (B2 _ _ k t1 t2) = (toList t1)++[k]++(toList t2)

finRun :: Int -> [Int]
finRun n= toList $ foldl (\t i -> modBy i t) (New n) [1..n]

getInt :: IO Int
getInt = fmap read getLine

main :: IO()
main = do
  x <- getInt
  ls <- replicateM x getInt
  mapM_ (\x -> putStrLn $ unwords $ map show $ finRun x) ls

import qualified Data.Set as S
import Control.Monad
--import Data.Monoid
import Data.List
main :: IO ()
main = do
    n <- readLn
    replicateM_ n routine

routine :: IO ()
routine = do
  n <- readLn
  putStrLn $ (unwords.map show) $ solve n

solve :: Int -> [Int]
solve n = clean $ consume (S.singleton (Event 1 n n))

data Event = Event {
  getL :: Int,
  getR :: Int,
  getLength :: Int
} deriving (Eq, Show)

instance Ord Event where
  compare (Event l _ ln) (Event l2 _ ln2) =
    (compare ln2 ln) `mappend` (compare l l2)

consume :: S.Set Event -> [Int]
consume s
  | S.null s = []
  | otherwise = n : consume s''
  where
    (Event l r ln,s') = S.deleteFindMin s
    n = (l + r) `div` 2
    evs = if ln == 1
            then [] else if ln == 2 then [Event r r 1]
            else [Event l (n-1) ((ln `div` 2) - (fromEnum $ even ln)),Event (n+1) r (ln `div` 2)]
    s'' = S.union s' (S.fromList evs)

clean :: [Int] -> [Int]
clean xs =map fst $ sortOn snd $ zip [1..] xs


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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T
import qualified Control.Monad.Trans.Maybe as MT

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

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

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

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

#else

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

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

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

solve :: Int -> [Int] -> Int
solve n as = answer
    where
        asSet = S.fromList $ L.zip as [1..]

        answer :: Int
        answer = MB.fromMaybe 0 . L.find canPlay $ reverse [1 .. n]

        canPlay :: Int -> Bool
        canPlay k = flip S.evalState asSet $ do
            tracingM "k" k
            answer <- MT.runMaybeT $ M.forM_ [1..k] $ \i -> do
                st <- S.get
                tracingM "st" st
                aliceX <- MT.MaybeT . S.gets $ S.lookupLE (k - i + 1, n)
                tracingM "aliceX" aliceX
                S.modify $ S.delete aliceX
                S.modify $ S.deleteMin
            tracingM "answer" answer
            return $ MB.isJust answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

----- <Solution> --------------------------------------------------------------
data TC = TC {n :: Int, as :: [Int]}

type Output = Int

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..} = binarySearch check 0 (n + 1) -- [0 .. n] >$> filter check >>> maximum
  where
    check 0 = True
    check k = [1 .. k] >$> reverse >>> map (\i -> alice i >=> pure . bob i) >>> foldl1 (>=>) >>> ($ as) >>> isJust

    alice :: Int -> [Int] -> Maybe [Int]
    alice v xs = do
      xs <- pure $ filter (<= v) xs
      guard $ not (null xs)
      return $ delete (maximum xs) xs

    bob :: Int -> [Int] -> [Int]
    bob _ [] = []
    bob v xs =
      let m = minimum xs
       in m + v : delete m xs

-- find largest x \in [l, r) s.t. p x
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch p l r
  | l + 1 == r = l
  | p m = binarySearch p m r
  | otherwise = binarySearch p l m
  where
    m = (l + r) `div` 2

output :: Int -> Output -> C.ByteString
output ix = showB

----- </Solution> -------------------------------------------------------------

main :: IO ()
-- main = C.interact $ runScanner input >>> solve >>> output 0
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

----- Template ----------------------------------------------------------------

-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

applyN :: Int -> (a -> a) -> a -> a
applyN 0 f = id
applyN n f = applyN (n - 1) f . f

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  testCases <- readInt' <$> B.getLine
  replicateM_ testCases testCase

testCase :: IO ()
testCase = do
  getLine
  vs <- map readInt' . B.words <$> B.getLine
  print $ solve (sort vs)

readInt' :: B.ByteString -> Int
readInt' = maybe 0 fst . B.readInt

solve :: [Int] -> Int
solve s = case [k | k <- [1..(min ((length s + 1) `div` 2) (length (takeWhile (<= 1) s)))], winnable k s] of
            [] -> 0
            ls -> maximum ls
  where winnable :: Int -> [Int] -> Bool
        winnable k vs = all (uncurry (<=)) $ drop (k-1) vs `zip` [1..k]

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import Data.Bool
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Debug.Trace

----- <Solution> --------------------------------------------------------------
data TC = TC {n :: Int, as :: [Int]}

type Output = Int

input :: Scanner TC
input = do
  n <- int
  as <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..} = [0 .. n] >$> filter check >>> maximum
  where
    check 0 = True
    check k = [1 .. k] >$> reverse >>> map (\i -> alice i >=> pure . bob i) >>> foldl1 (>=>) >>> ($ as) >>> isJust

    alice :: Int -> [Int] -> Maybe [Int]
    alice v xs = do
      xs <- pure $ filter (<= v) xs
      guard $ not (null xs)
      return $ delete (maximum xs) xs

    bob :: Int -> [Int] -> [Int]
    bob _ [] = []
    bob v xs =
      let m = minimum xs
       in m + v : delete m xs

-- find largest x \in [l, r) s.t. p x
binarySearch :: Integral a => (a -> Bool) -> a -> a -> a
binarySearch p l r
  | l + 1 == r = l
  | p m = binarySearch p m r
  | otherwise = binarySearch p l m
  where
    m = (l + r) `div` 2

output :: Int -> Output -> C.ByteString
output ix = showB

----- </Solution> -------------------------------------------------------------

main :: IO ()
-- main = C.interact $ runScanner input >>> solve >>> output 0
main = C.interact $ runScanner (numberOf input) >>> map solve >>> zip [1 ..] >>> map (uncurry output) >>> C.unlines

----- Template ----------------------------------------------------------------

-- Debug
debug :: Show a => a -> a

#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- helpers
(>$>) = flip ($)

infixl 0 >$>

applyN :: Int -> (a -> a) -> a -> a
applyN 0 f = id
applyN n f = applyN (n - 1) f . f

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

runScanner :: Scanner a -> C.ByteString -> a
runScanner = runScannerWith C.words

runScannerWith :: (C.ByteString -> [C.ByteString]) -> Scanner a -> C.ByteString -> a
runScannerWith t s = evalState s . t

peek :: Scanner C.ByteString
peek = gets head

bstr :: Scanner C.ByteString
bstr = get >>= \case s : ss -> put ss >> return s

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

int :: Scanner Int
int = fst . fromJust . C.readInt <$> bstr

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

decimal :: Int -> Scanner Int
decimal p = round . ((10 ^ p) *) <$> double

numberOf :: Scanner a -> Scanner [a]
numberOf s = int >>= flip replicateM s

many :: Scanner a -> Scanner [a]
many s = get >>= \case [] -> return []; _ -> (:) <$> s <*> many s

till :: (C.ByteString -> Bool) -> Scanner a -> Scanner [a]
till p s = do
  t <- peek
  if p t
    then return []
    else (:) <$> s <*> till p s

times :: Int -> Scanner a -> Scanner [a]
times = replicateM

(><) = times

two, three, four :: Scanner a -> Scanner [a]
[two, three, four] = map times [2 .. 4]

pair :: Scanner a -> Scanner b -> Scanner (a, b)
pair = liftA2 (,)

showB :: Show a => a -> C.ByteString
showB = C.pack . show

import Data.Char
import Control.Monad
import Data.List

solve k as = if (foldr (&&) True (zipWith (>=) (replicate k 1 ++ [2..k]) as)) then k else solve (k-1) as

loop = do
  _ <- getLine
  as <- sort <$> map read <$> words <$> getLine
  let k = (length as +1)`div`2
  print (solve k as)

main = do
  t <- read <$> getLine
  replicateM_ t loop

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  testCases <- readInt' <$> B.getLine
  replicateM_ testCases testCase

testCase :: IO ()
testCase = do
  getLine
  vs <- map readInt' . B.words <$> B.getLine
  print $ solve vs

readInt' :: B.ByteString -> Int
readInt' = maybe 0 fst . B.readInt

solve :: [Int] -> Int
solve s = case [k | k <- [1..length s + 1 `div` 2], winnable k (sort s)] of
            [] -> 0
            ls -> maximum ls
  where winnable :: Int -> [Int] -> Bool
        winnable k vs = all (uncurry (<=)) $ drop (k-1) vs `zip` [1..k]

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  testCases <- readInt' <$> B.getLine
  replicateM_ testCases testCase

testCase :: IO ()
testCase = do
  getLine
  vs <- map readInt' . B.words <$> B.getLine
  print $ solve vs

readInt' :: B.ByteString -> Int
readInt' = maybe 0 fst . B.readInt

solve :: [Int] -> Int
solve s = case map snd $ takeWhile winnable $ sort s `zip` concatMap (replicate 2) [1..] of
            [] -> 0
            ls -> maximum ls
  where winnable :: (Int, Int) -> Bool
        winnable (v, p) = v <= p

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  testCases <- readInt' <$> B.getLine
  replicateM_ testCases testCase

testCase :: IO ()
testCase = do
  getLine
  vs <- map readInt' . B.words <$> B.getLine
  print $ solve vs

readInt' :: B.ByteString -> Int
readInt' = maybe 0 fst . B.readInt

solve :: [Int] -> Int
solve s = case map snd $ filter winnable $ sort s `zip` drop 1 (concatMap (replicate 2) [1..]) of
            [] -> 0
            ls -> maximum ls
  where winnable :: (Int, Int) -> Bool
        winnable (v, p) = v <= p

module Main where

import Control.Monad (replicateM_)
import Data.List (sort)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = do
  testCases <- readInt' <$> B.getLine
  replicateM_ testCases testCase

testCase :: IO ()
testCase = do
  getLine
  vs <- map readInt' . B.words <$> B.getLine
  print $ solve vs

readInt' :: B.ByteString -> Int
readInt' = maybe 0 fst . B.readInt

solve :: [Int] -> Int
solve s = case map snd $ filter winnable $ sort s `zip` concatMap (replicate 2) [1..] of
            [] -> 0
            ls -> maximum ls
  where winnable :: (Int, Int) -> Bool
        winnable (v, p) = v <= p

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

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad as M
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S
import qualified Control.Monad.Trans.Class as T
import qualified Control.Monad.Trans.Maybe as MT

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

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

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

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

#else

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

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

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

solve :: Int -> [Int] -> Int
solve n as = answer
    where
        asSet = S.fromList $ L.zip as [1..]

        answer :: Int
        answer = MB.fromMaybe 0 . L.find canPlay $ reverse [1 .. n]

        canPlay :: Int -> Bool
        canPlay k = flip S.evalState asSet $ do
            tracingM "k" k
            answer <- MT.runMaybeT $ M.forM_ (reverse [1 .. k]) $ \i -> do
                st <- S.get
                tracingM "st" st
                aliceX <- MT.MaybeT . S.gets $ S.lookupLE (k - i + 1, n)
                tracingM "aliceX" aliceX
                S.modify $ S.delete aliceX
                S.modify $ S.deleteMin
            tracingM "answer" answer
            return $ MB.isJust answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        printf "%d\n" answer


{-# LANGUAGE LambdaCase #-}

module Main where

import           Control.Applicative            ( liftA2 )
import           Control.Monad.State
import qualified Data.Array                    as A
import qualified Data.ByteString.Lazy.Char8    as C
import           Data.Foldable
import           Data.Function                  ( (&)
                                                , on
                                                )
import           Data.Maybe                     ( fromJust )

type Scanner = State [C.ByteString]

scan :: Scanner a -> C.ByteString -> a
scan input = evalState input . C.lines

line :: Scanner C.ByteString
line = get >>= \case
  []     -> error "eof"
  s : ss -> put ss >> return s

many :: Scanner a -> Scanner [a]
many s = get >>= \case
  [] -> return []
  _  -> liftA2 (:) s $ many s

main :: IO ()
main = C.interact solve

solve :: C.ByteString -> C.ByteString
solve input = input & scan parse & map (format . answer) & C.unlines

parse :: Scanner [(Int, A.Array Int Int)]
parse = do
  _ <- line
  many $ do
    n  <- int <$> line
    xs <- A.listArray (1, n) . map int . C.words <$> line
    return (n, xs)
  where
    int :: C.ByteString -> Int
    int = fst . fromJust . C.readInt

format :: [Int] -> C.ByteString
format = C.pack . unwords . map show

answer :: (Int, A.Array Int Int) -> [Int]
answer (n, xs) = reverse
  [ times `mod` value
  | ((times, value), _) <- take n . iterate (\(_, xs') -> toPair xs') $ toPair xs
  ]
  where
    toPair :: A.Array Int Int -> ((Int, Int), A.Array Int Int)
    toPair as = (it, as')
      where
        it  = iteration as
        as' = uncurry rotate it as

iteration :: Ord a => A.Array Int a -> (Int, a)
iteration xs = maximumBy (compare `on` snd) (A.assocs xs)

rotate :: Int -> Int -> A.Array Int a -> A.Array Int a
rotate times till =
  A.ixmap (1, till - 1) (\i -> ((i + times) `mod` (till + 1)) + ((i + times) `div` (till + 1)))

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: Int -> [a] -> [a]
cShift 0 = id
cShift i = uncurry (flip (++)) . splitAt i

solve :: InType -> OutType
solve = reverse . go
  where go [] = []
        go xs = let l = length xs
                    i = (fromJust (elemIndex l xs) + 1) `mod` l
                in  i : go (init (cShift i xs))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let l = length xs
                    i = fromJust $ elemIndex l xs
                in  (i + 1) `mod` l : go (take (l - 1) (cShift xs (i + 1)))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let l = length xs
                    i = fromJust $ elemIndex l xs
                in  i + 1 : go (take (l - 1) (cShift xs (i + 1)))

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

cShift :: [a] -> Int -> [a]
cShift = go []
  where go acc xs 0 = xs ++ reverse acc
        go acc (x : xs) i = go (x : acc) xs (i - 1)
        go _ _ _ = undefined

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let i = fromJust $ elemIndex (length xs) xs
                    pref = take i xs
                    suf  = drop (i + 1) xs
                in  i + 1 : go (cShift (pref ++ suf) i)

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines

import Data.List (elemIndex)
import Data.Maybe (fromJust)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf i xs = take i xs : chunksOf i (drop i xs)

showArr :: Show a => [a] -> String
showArr = concatMap (\x -> show x ++ " ")

toArr :: Read a => String -> [a]
toArr = map read . words

getPair :: String -> (Int, Int)
getPair s = case toArr s of
              [x, y] -> (x, y)
              _      -> error "getPair failed"

type InType  = [Int]
type OutType = [Int]

solve :: InType -> OutType
solve xs = reverse $ go xs
  where go [] = []
        go xs = let i = fromJust $ elemIndex (length xs) xs
                    pref = take i xs
                    suf  = drop (i + 1) xs
                in  i + 1 : go (pref ++ suf)

receive :: [String] -> InType
receive [_, s] = toArr s
receive _      = error "input"

main :: IO ()
main = interact $ unlines . map (showArr . solve . receive) . chunksOf 2 . tail . lines


main :: IO ()
main = do
  a <- getLine
  b <- getLine
  c <- getLine
  let l = read a :: Float
      p = read b :: Float
      q = read c :: Float
  print (l / (p + q) * p)

module Main
    where

-- toInts :: [String] -> [Int]
-- toInts = map read
--
-- splitStr :: Int -> String -> [Int]
-- splitStr n (' ':xs) = n : (splitStr 0 xs)
-- splitStr n ('1':xs) = splitStr (n * 10 + 1) xs
-- splitStr n ('2':xs) = splitStr (n * 10 + 2) xs
-- splitStr n ('3':xs) = splitStr (n * 10 + 3) xs
-- splitStr n ('4':xs) = splitStr (n * 10 + 4) xs
-- splitStr n ('5':xs) = splitStr (n * 10 + 5) xs
-- splitStr n ('6':xs) = splitStr (n * 10 + 6) xs
-- splitStr n ('7':xs) = splitStr (n * 10 + 7) xs
-- splitStr n ('8':xs) = splitStr (n * 10 + 8) xs
-- splitStr n ('9':xs) = splitStr (n * 10 + 9) xs
-- splitStr n ('0':xs) = splitStr (n * 10 + 0) xs
-- splitStr n [] = [n]
--
-- split s = splitStr 0 s
--
-- input = do   line <- getLine
--             sep <- return (split line)
--             return sep

-- solve :: Num -> Num -> Num -> Num
solve l a b = l * a / (a + b)

main = do   strl <- getLine
            l <- return (read strl)
            stra <- getLine
            a <- return (read stra)
            strb <- getLine
            b <- return (read strb)
            solution <- return (solve l a b)
            strsol <- return (show solution)
            putStrLn strsol

main = interact $ show . solve . map read . words
solve [l,p,q] = p * l / (p + q)

import Control.Applicative
main = do
  l <- to_f <$> getLine
  p <- to_f <$> getLine
  q <- to_f <$> getLine
  print $ l * p / (p + q)

to_f :: String -> Double
to_f str = read str :: Double

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

solve :: [Float] -> Float
solve [l, p, q] = l * p / (p + q)

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

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

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

main = do
  l <- readLn
  p <- readLn
  q <- readLn

  print $ p*l/(p+q)

import Control.Monad
import System.IO
import Data.Char
import Data.Maybe
import Data.Ix
import Data.List
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Vector as Vector

readInt = read :: String -> Int
infixl 5 |>
a |> f = f a

infixl 5 ||>
m ||> f = liftM f m

readLines :: Int -> IO [String]
readLines 0 = return []
readLines n = do
	l1 <- getLine
	lns <- readLines (n - 1)
	return $ l1 : lns

main = do
	l <- getLine ||> (read) ||> (+ 0.0)
	p <- getLine ||> (read) ||> (+ 0.0)
	q <- getLine ||> (read) ||> (+ 0.0)
	t <- return $ l / (p + q)

	putStr $ show $ p * t

import Control.Applicative
import Control.Monad

main = ( (\[c,a,b] -> a * c / (a+b) ). (map (read :: String -> Double) ) . lines) <$> getContents >>= print

import Control.Applicative
import Control.Monad

solve :: [Double] -> Double
solve [c,a,b] = ( a / (a+b) ) * c

main = ( solve . (map (read :: String -> Double) ) . lines) <$> getContents >>= print

module Main (main)
    where

import Control.Monad (replicateM)

main :: IO ()
main = replicateM 3 readLn >>= print . solve
    where solve [l, p, q] = l*p/(p + q)

module Main where

main :: IO ()
main = do
   l <- readLn :: IO Double
   p <- readLn :: IO Double
   q <- readLn :: IO Double
   let t = (3 * l) / (p + q)
   print $ (t / 3) * p

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

main=do
	[n,a,b]<-  map read.words  <$> getContents:: IO  [Int]
	print $ (fromIntegral a)/(fromIntegral (a+b)) *(fromIntegral n)

main = interact $ show. (\ (d:p:q:[]) -> d * p / (p + q)). map read. words

main = interact $ (++ "\n"). show. (\ (d:p:q:[]) -> d * p / (p + q)). map read. words

import Control.Applicative
import Control.Monad

main = do
    [l, h, v] <- replicateM 3 $ read <$> getLine
    print $ l / (h+v) * h

main = do
    line <- getLine
    let l = read(line) :: Double
    line <- getLine
    let p = read(line) :: Double
    line <- getLine
    let q = read(line) :: Double

    let d = (p * l) / (p + q)

    print d

main :: IO ()
main = interact parse

parse input =
  let (l:p:q:_) = map read $ lines input
      t = l / (p + q)
      pt = p * t
  in show pt

main = do
    a <- getLine
    b <- getLine
    c <- getLine
    let s = read a :: Float
    let v1 = read b :: Float
    let v2 = read c :: Float
    putStrLn $ show $ s * v1 / (v1 + v2)

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
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
main = do
  l <- readLn::IO Double
  p <- readLn::IO Double
  q <- readLn::IO Double
  print $ p*l/(p+q)


import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-1) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) a
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

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

-- >>> reverse$ scanr1 (+) [1,2,3,4,5]
-- [5,9,12,14,15]

import Data.List (sort)

main :: IO ()
main =
    let f 0 = return ()
        f t = solve >> f (t - 1)
    in readInt <$> getLine >>= f

solve :: IO ()
solve = readInt <$> getLine >>= \ n ->
    splitAt ((n+1) `div` 2) . sort . map readInt . words <$> getLine >>= \(l, r) ->
        putStrLn . check (sum $ take 2 l) (last r) (drop 2 l) . tail $ reverse r

check a b [] _ = if a < b then "YES" else "NO"
check a b _ [] = if a < b then "YES" else "NO"
check a b (l:ls) (r:rs) = if a < b then "YES" else check (a + l) (b + r) ls rs

readInt :: String -> Int
readInt = read

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-1) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) [1,2,3,4,5]
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

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

-- >>> drop 1 (scanl1 (+) [1,2,3,4,5])
-- [3,6,10,15]

-- >>> reverse$ scanr1 (+) [1,2,3,4,5]
-- [5,9,12,14,15]

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = func' $ take ((n-2) `div` 2) (zip b c)
    where
        a = (sort.map read.words) y
        b = drop 1 (scanl1 (+) a)
        c = reverse $ scanr1 (+) [1,2,3,4,5]
        n = length y
        func' [] = "NO"
        func' (x:xs) = if uncurry (<) x then "YES" else func' xs

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

import Data.List ( sort )
solve :: [String] -> [String]
solve [] = []
solve (x:y:xs) =  func y : solve xs

func :: String -> String
func y = if head a + (head.tail) a < last a then "YES" else "NO"
    where
        a :: [Int]
        a = (sort.map read.words) y

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


main = interact $ show . distance . (map . map) read . map words . lines

distance :: [[Float]] -> Float
distance (x:ys) = last x * distance' ys / 50.0
  where
    distance' :: [[Float]] -> Float
    distance' xs = sum $ zipWith (\a b -> dbetweenp (abs (head a - head b)) (abs (last a - last b))) xs (drop 1 xs)
    dbetweenp w h = sqrt $ w^2 + h^2

import Control.Monad

solve []       = 0
solve [a]      = 0
solve (a:b:cs) = solve (b:cs) + d
   where dx = fromIntegral $ (a!!0) - (b!!0)
         dy = fromIntegral $ (a!!1) - (b!!1)
         d  = sqrt . abs $ dx * dx + dy * dy

main = do
   [n, k] <- fmap (map read . words) getLine
   lst <- forM [1..n] $ \_ -> fmap (map read . words) getLine :: IO [Int]
   print $ solve lst * k / 50

-- vim: set expandtab:

getWords = fmap (map read . words) getLine

dist (x1, y1) (x2, y2) = sqrt $ (x2-x1)**2 + (y2-y1)**2

readPair = (\[x, y] -> (x, y)) . map read . words

main = do
	[n, k] <- getWords
	ps <- fmap (map readPair . lines) getContents
	let l = sum $ zipWith dist ps (tail ps)
	print $ k*l/50

module Main where
import Control.Applicative
import Control.Monad
import Data.List
main = do
    [n,k] <- map (read :: String -> Int) . words <$> getLine
    as <- replicateM n  (map (read :: String -> Double) . words <$> getLine)
    let s = (fromIntegral k) * ( sum $ zipWith (\x y -> sqrt  . sum . map  (**2.0) .  zipWith (-) x $ y) as $ tail as )
    print $ s / 50.0

module Main where

    -- Java-кресьтьяне должны страдать!

    import Data.List (foldl')

    type Point = (Double, Double)

    rho :: Point -> Point -> Double
    rho x y = sqrt ( (fst x - fst y)**2 + (snd x - snd y)**2 )

    lengths :: [Point] -> (Double, Point)
    lengths xs = foldl' summate (0, head xs) (tail xs)
      where summate (l, p) p' = (l + rho p p', p')

    main :: IO ()
    main = do
        [n, k] <- fmap (map read . words) getLine :: IO [Int]
        points <- sequence $
          replicate n $ do
              [x, y] <- fmap (map read . words) getLine :: IO [Double]
              return (x, y)
        putStrLn . show $ if (not . null) points
          then fst (lengths points) * fromIntegral k / 50
          else 0

import List

type Point = (Double, Double)

speed = 50

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

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

readPoint :: IO Point
readPoint = do
    [x, y] <- Main.reads
    return (x, y)

dist :: Point -> Point -> Double
dist (x1, y1) (x2, y2) = sqrt ((x1-x2)^2 + (y1-y2)^2)

near :: [a] -> [(a, a)]
near (x:y:[]) = [(x, y)]
near (x:y:xs) = (x, y):(near (y:xs))
near _ = error "near: List length < 2!"

solve :: [Point] -> Double
solve ps = sum (map (uncurry dist) (near ps))

main :: IO ()
main = do
    [n, k] <- Main.reads
    ans <- sequence (map (\n -> readPoint) [1..n])
    print (k * (solve ans) / speed)

sigLength (a:b:rest) =
    let dx = fst a - fst b
        dy = snd a - snd b
        d  = sqrt $ dx * dx + dy * dy
    in d + sigLength (b:rest)   -- lazyness may get TLE
sigLength _ = 0.0

solve ((_, k):ps) = (sigLength ps) / 50.0 * k

main = interact $ show.solve.map ((\[a, b] -> (read a, read b)).words).lines

import Control.Applicative ((<$>), (<*>))

main :: IO ()
main = (*) <$> ((!!1) . map read . words <$> getLine) <*> (solve <$> (map (map read . words) . lines <$> getContents)) >>= print

solve :: [[Double]] -> Double
solve xys = sum [ sqrt ((x - x') ** 2 + (y - y') ** 2) | ([x, y], [x', y']) <- zip xys (tail xys) ] / 50

import Control.Monad
main = do
  [n,k] <- fmap (map read . words) getLine
  ps <- replicateM n $ fmap (map read . words) getLine
  print $ fromIntegral k * sum (map dist (pairs ps)) / 50
dist ([x1,y1],[x2,y2]) = sqrt ((x2-x1)^2 + (y2-y1)^2)
pairs (a:b:cs) = (a,b) : pairs (b:cs)
pairs _ = []

module Main where

import Control.Monad

readP = do
  [x,y] <- (map read . words) `fmap` getLine
  return (x :: Double, y)

main = do
  [n,k] <- (map read . words) `fmap` getLine
  cs <- replicateM n readP
  print (answer cs k)

answer cs k = sum (zipWith dist cs (tail cs)) / 50 * (fromIntegral k)
  where
    dist (x1, y1) (x2, y2) = sqrt ((x1 - x2)^2 + (y1 - y2)^2)

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind -fno-warn-type-defaults -fno-warn-orphans #-}

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

readNums :: (Num a, Read a) => IO [a]
readNums = map read . words <$> getLine

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

main :: IO ()
main = do
  [n, k :: Int] <- readNums
  as <- replicateM n $ do
    [a, b :: Double] <- readNums
    return (a, b)
  let !d = sum $ zipWith distance as (tail as)
  printf "%08f\n" $ d * fromIntegral k / 50

import Data.List
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as BS

solve :: [[Integer]] -> BS.ByteString
solve xs = BS.pack.show $ ( ret *  fromIntegral b ) / 50.0   where
	( first , rest ) = ( head xs , tail xs )
	( a , b ) = ( head first , last first )
	ret = helpSolve rest where
	  helpSolve :: [[ Integer ]] -> Double
	  helpSolve [] = 0.0
	  helpSolve [ x ] = 0.0
	  helpSolve ( x : y : xs ) =  ( sqrt.fromIntegral $ ( x_1 - x_2 ) ^ 2 + ( y_1 - y_2 ) ^ 2  )  + helpSolve ( y : xs ) where
		x_1 = head x
		y_1 = last x
		x_2 = head y
		y_2 = last y

reaD :: BS.ByteString -> Integer
reaD = fst. fromJust . BS.readInteger

main = BS.interact $  solve . map ( map reaD . BS.words ) . BS.lines

dist :: [Int] -> [Int] -> Double
dist [a, b] [c, d] = sqrt.fromIntegral $ dx^2 + dy^2
  where dx = a - c
        dy = b - d
main = do
  [_, k] <- getLine >>= return. map read. words :: IO [Double]
  as <- getContents >>= return. map (map read. words). lines :: IO [[Int]]
  print. (/50). (*k). sum $ zipWith dist (drop 1 as) as

import Control.Applicative
import Control.Monad

dst (x1, y1) (x2, y2) = sqrt $ dx*dx + dy*dy
  where dx = (x1 - x2)
        dy = (y1 - y2)

solve (p1:p2:r) = dst p1 p2 + solve (p2:r)
solve _ = 0

main = do
  [n, k] <- map read .words <$> getLine
  points <- replicateM n $ map read . words <$> getLine >>= \[a,b] -> return (a,b)
  print $ solve points * (fromIntegral k) / 50

import           Control.Monad
import           Data.List

dist :: (Integral a, Floating b) => (a, a) -> (a, a) -> b
dist (x1, y1) (x2, y2) = sqrt $ (fromIntegral x1 - fromIntegral x2)^2 + (fromIntegral y1 - fromIntegral y2)^2

unfolder :: [(Int, Int)] -> Maybe (Double, [(Int, Int)])
unfolder (a:b:rest) = Just (dist a b, b:rest)
unfolder _ = Nothing

main :: IO ()
main = do
  [n, k] <- map (read :: String -> Int) . words <$> getLine
  print =<< (/50) . (fromIntegral k *) . sum . unfoldr unfolder . map ((\[a,b]->(a,b)) . map (read :: String -> Int) . words) <$> replicateM n getLine

import Data.Bits

-- import Data.List (List)
import qualified Data.List as List
import Data.Map (Map)
import qualified Data.Map as Map
import System.IO
import Text.Read

parseLine :: IO Point
parseLine = do
  input <- getLine
  let (x:y:_) = (map read . words) input :: [Double]
  let p = Pt x y
  return p

data Point =
  Pt
    { pointx, pointy :: Double
    }

distance :: Point -> Point -> Double
distance p1 p2 =
  sqrt ((^) (pointx p1 - pointx p2) 2 + (^) (pointy p1 - pointy p2) 2)

solveN :: Int -> Point -> Double -> IO Double
solveN 0 lastp ans = return ans
solveN n last_p ans
  -- print $ "ans = " ++ show ans
 = do
  p <- parseLine
  solveN (n - 1) p (ans + distance p last_p)

main :: IO ()
main = do
  input <- getLine
  let (n:k:_) = (map read . words) input :: [Int]
  p <- parseLine
  input <- solveN (n - 1) p 0.0
  print $ input * fromIntegral k / 50.0

parse :: Read a => Floating a => String -> (Int, a, [[a]])
parse stuff =
    let [n, k] : nums = map words $ lines stuff in
    (read n, read k, map (map read) nums)

calc :: Show a => Read a => Floating a => [[a]] -> a -> a
calc [[_, _]] acc = acc
calc l@([x0, y0]:[x1, y1]:xs) acc =
    calc (tail l) (acc + dist x0 y0 x1 y1)
    where
      dist x0 y0 x1 y1 = sqrt $ (x0 - x1)^2 + (y0 - y1)^2

main = do
  stuff <- getContents
  let (_, k, points) = parse stuff
      result = calc points 0
  putStrLn $ show ((result / 50) * k)

module Main where

    -- Java-кресьтьяне должны страдать!

    import Data.List (foldl')

    type Point = (Double, Double)

    rho :: Point -> Point -> Double
    rho x y = sqrt ( (fst x - fst y)**2 + (snd x - snd y)**2 )

    lengths :: [Point] -> (Double, Point)
    lengths xs = foldl' summate (0, head xs) (tail xs)
      where summate (l, p) p' = (l + rho p p', p')

    main :: IO ()
    main = do
        [n, k] <- fmap (map read . words) getLine :: IO [Int]
        points <- sequence $
          replicate n $ do
              [x, y] <- fmap (map read . words) getLine :: IO [Double]
              return (x, y)
        putStrLn . show $ if (not . null) points
          then fst (lengths points) / 50
          else 0