The name of one small but proud corporation consists of n lowercase English letters. The Corporation has decided to try rebranding — an active marketing strategy, that includes a set of measures to change either the brand (both for the company and the goods it produces) or its components: the name, the logo, the slogan. They decided to start with the name.For this purpose the corporation has consecutively hired m designers. Once a company hires the i-th designer, he immediately contributes to the creation of a new corporation name as follows: he takes the newest version of the name and replaces all the letters xi by yi, and all the letters yi by xi. This results in the new version. It is possible that some of these letters do no occur in the string. It may also happen that xi coincides with yi. The version of the name received after the work of the last designer becomes the new name of the corporation.Manager Arkady has recently got a job in this company, but is already soaked in the spirit of teamwork and is very worried about the success of the rebranding. Naturally, he can't wait to find out what is the new name the Corporation will receive.Satisfy Arkady's curiosity and tell him the final version of the name.

The first line of the input contains two integers n and m (1 ≤ n, m ≤ 200 000) — the length of the initial name and the number of designers hired, respectively. The second line consists of n lowercase English letters and represents the original name of the corporation. Next m lines contain the descriptions of the designers' actions: the i-th of them contains two space-separated lowercase English letters xi and yi.

11 6
abacabadaba
a b
b c
a d
e g
f a
b b

NoteIn the second sample the name of the corporation consecutively changes as follows:

--fast read
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array
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
convert::String -> [[String]] -> String
convert s [] = s
convert s ([p,n]:ms) = convert (con s (head p) (head n)) ms
con::String-> Char -> Char -> String
con [] p n = []
con (c:s) p n
  | c==p = n:con s p n
  | c==n = p:con s p n
  | otherwise = c:con s p n
main = do
  [n,m] <- readLists
  s <- getLine
  m <- fmap (map words) $ fmap lines $ getContents
  let a = listArray ('a','z') $ convert ['a'..'z'] m
  putStr $ map (\x -> (a ! x)) s

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

next :: Char -> [String] -> Char
next ch [] = ch
next ch (x:xs) | ch == (head x)                 = next (head (tail (tail x))) xs
               | ch == (head (tail (tail x)))   = next (head x) xs
               | otherwise                      = next ch xs

mapper a b c d e f g h i j k l m n o p q r s t u v w x y z ch   | ch == 'a' = a
                                                                | ch == 'b' = b
                                                                | ch == 'c' = c
                                                                | ch == 'd' = d
                                                                | ch == 'e' = e
                                                                | ch == 'f' = f
                                                                | ch == 'g' = g
                                                                | ch == 'h' = h
                                                                | ch == 'i' = i
                                                                | ch == 'j' = j
                                                                | ch == 'k' = k
                                                                | ch == 'l' = l
                                                                | ch == 'm' = m
                                                                | ch == 'n' = n
                                                                | ch == 'o' = o
                                                                | ch == 'p' = p
                                                                | ch == 'q' = q
                                                                | ch == 'r' = r
                                                                | ch == 's' = s
                                                                | ch == 't' = t
                                                                | ch == 'u' = u
                                                                | ch == 'v' = v
                                                                | ch == 'w' = w
                                                                | ch == 'x' = x
                                                                | ch == 'y' = y
                                                                | ch == 'z' = z

calc :: [Char] -> (Char -> Char) -> [Char]
calc [] ch = []
calc (x:xs) ch = ((ch x) : (calc xs ch))

readLines 0 = do return []
readLines n = do line <- getLine
                 other <- readLines (n - 1)
                 return (line : other)

main = do   ns <- getLine
            nums <- return (split ns)
            name <- getLine
            c <- readLines (head (tail nums))
            solution <- return (calc name (mapper
                                                (next 'a' c)
                                                (next 'b' c)
                                                (next 'c' c)
                                                (next 'd' c)
                                                (next 'e' c)
                                                (next 'f' c)
                                                (next 'g' c)
                                                (next 'h' c)
                                                (next 'i' c)
                                                (next 'j' c)
                                                (next 'k' c)
                                                (next 'l' c)
                                                (next 'm' c)
                                                (next 'n' c)
                                                (next 'o' c)
                                                (next 'p' c)
                                                (next 'q' c)
                                                (next 'r' c)
                                                (next 's' c)
                                                (next 't' c)
                                                (next 'u' c)
                                                (next 'v' c)
                                                (next 'w' c)
                                                (next 'x' c)
                                                (next 'y' c)
                                                (next 'z' c)
                                ))
            putStrLn solution

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

process :: [String] -> (String, [String])
process str
  = (h, t)
  where
    (h:t) = tail str

change' :: Char -> Char -> [(Char,Char)] -> [(Char,Char)]
change' x y rules
  = map (\(x',y') -> if x == x' then (x,y) else (x',y') ) rules

rep :: [Char] -> [(Char,Char)] -> [(Char,Char)]
rep myPair rules
  = change' x' y ( change' y' x rules )
  where
    [x,y] = myPair
    x' = fromJust $ lookup x revRules
    y' = fromJust $ lookup y revRules
    revRules = zip r2 r1
    (r1,r2)  = unzip rules

initR :: [(Char,Char)]
initR = zip ['a'..'z'] ['a'..'z']

change :: String -> [(Char,Char)] -> String
change str rules
  = map ( fromJust . ( ( flip lookup ) rules ) ) str

solve :: (String, [String]) -> String
solve (str, ops)
  = change str ( foldl (\acc x -> rep ( map head ( words x ) ) acc ) initR ops )

main = ( solve . process . lines) <$> getContents >>= putStrLn

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.DeepSeq
import Control.Exception (assert)
import Control.Monad hiding (foldM)
import Control.Monad.ST
import Data.Array.Base hiding (readArray, writeArray, (!))
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import Data.Word
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

main :: IO ()
main = do
  _ <- getLine
  cs <- getLine
  xys <- map B.head.B.words <$> B.getContents
  putStrLn $ solve cs xys

solve :: String -> String -> String
solve cs xys = [d|c<-cs,let Just d=lookup c table ]
   where
     !table = go (zip['a'..'z']['a'..'z']) xys
     go table (x:y:rest) = table `deepseq` go (swap x y table) rest
     go table _ = table

swap x y table | x == y = table
swap x y table = go table
   where
     go ((from,to):rest)
       | to == x = (from, y):go rest
       | to == y = (from, x):go rest
       | otherwise = (from,to):go rest
     go _ = []

------------------------------------------------------------------------------
bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
whenM, unlessM :: Monad m => m Bool -> m () -> m ()
whenM p f=p>>=flip when f
unlessM p f=p>>=flip unless f
{-# INLINE whenM #-}
{-# INLINE unlessM #-}
foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
foldM f a xs=foldr((>=>).flip f)return xs$a
{-# INLINE foldM #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}
(!) :: (IArray a e, Ix i) => a i e -> i -> e
(!) a i=assert(inRange(bounds a)i).unsafeAt a$unsafeIndex(bounds a)i
{-# INLINE (!) #-}
readArray :: (MArray a e m, Ix i) => a i e -> i -> m e
readArray a i=do lr<-getBounds a;assert(inRange lr i)$unsafeRead a$unsafeIndex lr i
{-# INLINE readArray #-}
writeArray :: (MArray a e m, Ix i) => a i e -> i -> e -> m ()
writeArray a i e=do lr<-getBounds a;assert(inRange lr i)$unsafeWrite a(unsafeIndex lr i)e
{-# INLINE writeArray #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=do lr<-getBounds a;assert(inRange lr i)$unsafeModify a(unsafeIndex lr i)f
{-# INLINE modifyArray #-}

import qualified Data.List as L
import qualified Data.HashMap.Lazy as H

main :: IO ()
main = interact parse

parse input =
  let (_:name:tail) = lines input
      designers = map (map head . words) tail
      alpha = switch designers ['a'..'z']
      hash = build_alpha ['a'..'z'] alpha H.empty
  in map (\a -> hash H.! a) name

build_alpha [] [] hash = hash
build_alpha (a:as) (b:bs) hash =
  build_alpha as bs (H.insert a b hash)

switch [] name = name
switch (d:ds) name =
  let name' = case d of
                (x:y:_) -> map (\a -> if a == x then y else if a == y then x else a) name
  in switch ds name'

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

next :: Char -> [String] -> Char
next ch [] = ch
next ch (x:xs) | ch == (head x)                 = next (head (tail (tail x))) xs
               | ch == (head (tail (tail x)))   = next (head x) xs
               | otherwise                      = next ch xs

mapper a b c d e f g h i j k l m n o p q r s t u v w x y z ch   | ch == 'a' = a
                                                                | ch == 'b' = b
                                                                | ch == 'c' = c
                                                                | ch == 'd' = d
                                                                | ch == 'e' = e
                                                                | ch == 'f' = f
                                                                | ch == 'g' = g
                                                                | ch == 'h' = h
                                                                | ch == 'i' = i
                                                                | ch == 'j' = j
                                                                | ch == 'k' = k
                                                                | ch == 'l' = l
                                                                | ch == 'm' = m
                                                                | ch == 'n' = n
                                                                | ch == 'o' = o
                                                                | ch == 'p' = p
                                                                | ch == 'q' = q
                                                                | ch == 'r' = r
                                                                | ch == 's' = s
                                                                | ch == 't' = t
                                                                | ch == 'u' = u
                                                                | ch == 'v' = v
                                                                | ch == 'w' = w
                                                                | ch == 'x' = x
                                                                | ch == 'y' = y
                                                                | ch == 'z' = z

calc :: [Char] -> (Char -> Char) -> [Char]
calc [] ch = []
calc (x:xs) ch = ((ch x) : (calc xs ch))

readLines 0 = do return []
readLines n = do line <- getLine
                 other <- readLines (n - 1)
                 return (line : other)

main = do   ns <- getLine
            nums <- return (split ns)
            name <- getLine
            c <- readLines (head (tail nums))
            solution <- return (calc name (mapper (next 'a' c) (next 'b' c) (next 'c' c) (next 'd' c) (next 'e' c) (next 'f' c) (next 'g' c) (next 'h' c) (next 'i' c) (next 'j' c) (next 'k' c) (next 'l' c) (next 'm' c) (next 'n' c) (next 'o' c) (next 'p' c) (next 'q' c) (next 'e' c) (next 's' c) (next 't' c) (next 'u' c) (next 'v' c) (next 'w' c) (next 'x' c) (next 'y' c) (next 'z' c)))
            putStrLn solution

import Control.Applicative
import Control.Monad

process :: [String] -> (String, [String])
process str
  = (h, t)
  where
    (h:t) = tail str

rep :: [Char] -> String -> String
rep myPair str
  = map (\x' -> rep' x' ) str
  where
    [x,y] = myPair
    rep' x'
      | x == x'   = y
      | y == x'   = x
      | otherwise = x'

solve :: (String, [String]) -> String
solve (str, ops)
  = foldl (\acc x -> rep ( map head ( words x ) ) acc ) str ops

main = ( solve . process . lines) <$> getContents >>= print


In this problem you are to calculate the sum of all integers from 1 to n, but you should take all powers of two with minus in the sum.For example, for n = 4 the sum is equal to  - 1 - 2 + 3 - 4 =  - 4, because 1, 2 and 4 are 20, 21 and 22 respectively.Calculate the answer for t values of n.

The first line of the input contains a single integer t (1 ≤ t ≤ 100) — the number of values of n to be processed. Each of next t lines contains a single integer n (1 ≤ n ≤ 109).

Print the requested sum for each of t integers n given in the input.

NoteThe answer for the first sample is explained in the statement.

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

solve :: Integer -> Integer
solve n = (div (n * (n + 1)) 2) - (pow2sum 1 n) * 2

pow2sum :: Integer -> Integer -> Integer
pow2sum p n | p > n = 0
            | otherwise = p + (pow2sum (p * 2) n)

import Data.List (foldl')
import Control.Applicative ((<$>))
import Test.QuickCheck

log2Floor n = floor $ (log $ fromIntegral n) / (log 2)

power2 x = 2^x

trickySum n = integerSum n - 2 * (twoSum n)

-- double is tricky in Haskell, use `div`
integerSum n = n * (n+1) `div` 2

twoSum n = sum (map power2 [0 ..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map trickySum input
  mapM_ print res

main = do
	ns <- (tail . map read . lines) `fmap` getContents

	let solve n = a - 2*b
	     where
		a = n * (n + 1) `div` 2
		p = last $ takeWhile (<= n) $ map (2^) [0..]
  		b = 2*p - 1

	putStr . unlines $ map (show . solve) ns

import Control.Applicative ((<$>))

readInteger :: String -> Integer
readInteger = read
main = do
  nums <- map readInteger . tail . lines <$> getContents
  mapM_ (putStrLn . show) $ map solve nums

solve :: Integer -> Integer
solve n = n * (n + 1) `div` 2 - 2 * (sum . takeWhile (<= n) $ map (2 ^) [0..])

import Control.Applicative

main = do
    ans <- map (show . solve . read) . tail . words <$> getContents
    sequence_ . map putStrLn $ ans

solve n = n * (n + 1) `div` 2 - 2 * (sum . takeWhile (<= n) . map (2 ^) $ [0 ..])

main :: IO ()
main =
  getContents >>= putStr . unlines . map (show . solve . read) . tail . lines
  where
    solve :: Integer -> Integer
    solve n = n * (n + 1) `quot` 2 - 2 * (head $ take 1 $ filter (>n) [2^x | x <- [0..]]) + 2

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

process x = s -s1 -s1
    where s = div ((x+1)*x) 2
          s1 = sum $ takeWhile (<=x) [2^i|i<-[0..]]

main::IO ()
main=do
  getLine
  x<-  map read <$> lines <$> getContents ::IO [Integer]
  mapM_ print $ map process x

main = interact $ unlines . map (show . solve . read) . tail . words
solve n = n*(n+1) `div` 2 - 2^(floor (logBase 2 (fromIntegral n)) + 2) + 2

#!/usr/bin/runhaskell

roundUpToPowerOfTwo :: Integer -> Integer
roundUpToPowerOfTwo x = head (dropWhile (<= x) [2 ^ i | i <- [0 ..]])

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * (roundUpToPowerOfTwo x - 1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ putStrLn (map (show . calcResult . read) (lines contents))

import Data.List
import Data.Bits
import Control.Arrow

solve :: Integer -> Integer
solve = uncurry (+) . ((\x -> (*(-2)) . sum $ takeWhile (<= x) $ map (shiftL 1) [0..]) &&& (\x -> shiftR (x*(x+1)) 1))

main = interact (unlines . map (show . solve . read) . tail . lines)

import Control.Monad (replicateM)

log2 :: Integer -> Integer
log2 = floor . (logBase 2) . fromIntegral

process :: String -> String
process input = show answer
    where
        number = (read :: String -> Integer) input
        answer = number * (number + 1) `div` 2 - 2 * (2 ^ (log2 number + 1) - 1)

main = do
    t_str <- getLine
    inputs <- replicateM (read t_str) getLine
    putStr $ unlines $ map process inputs

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

onecase = do
		x<-read<$>getLine::IO Integer
		let x1 = div (x*(x+1)) 2
		let x2 = length $ takeWhile (>0) [div x (2^i)| i<-[0..]]
		let x3 = x1 +2  -2^(x2+1)
		print x3

main= do
	n<-  read<$> getLine ::IO Int
	replicateM_ n onecase

import Data.List
solve n = positive - 2 * negetive
  where positive = div (n * n + n) 2
        negetive = sum.filter (<=n) $ [2^x | x <- [0..100]]
main = do
  t <- readLn :: IO Int
  as <- getContents >>= return. map read. lines :: IO [Integer]
  putStrLn.intercalate "\n". map (show.solve) $ as

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 *  (sum . takeWhile (<= x) . map (2^) $ [0..])

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ print (map ( calcResult . read) (lines contents))

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * ((head . dropWhile (<= x) . map (2^) $ [0..])-1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ print (map ( calcResult . read) (lines contents))

powers :: (Integral a) => a -> a
powers 0 = 0
powers n = 1 + 2 * (powers $ n `div` 2)

calculate :: (Integral a) => a -> a
calculate x = x * (x+1) `div` 2 - 2 * powers x

main :: IO ()
main = interact $ unlines . map (show . calculate . read) . tail . words

import Control.Monad

main = do
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    print $ n * (n+1) `div` 2 - 2 * sum (takeWhile (<=n) $ map (2^) [0..])

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal :: (Integral b, Integral a) => a -> b
sumTotal n = floor (allSum n - 2 * (twoSum n))
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map sumTotal input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal n = allSum n - 2 * (twoSum n)
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

main = do
  input <- map readInt . tail . words <$> getLine
  let res = map sumTotal input
  mapM_ print res

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor :: (Integral b, Integral a) => a -> b
log2Floor n = floor $ (log (fromIntegral n)) / (log 2)

power2 x = 2^x

sumTotal :: (Integral b, Integral a) => a -> b
sumTotal n = floor (allSum n - 2 * (twoSum n))
  where allSum n = (fromIntegral $ (1+n)*n) / 2
        twoSum n = sum (map power2 [0..(log2Floor n)])

readInt::String -> Integer
readInt = read

main = do
  input <- map readInt . tail . words <$> getLine
  let res = map sumTotal input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

import Data.List (foldl')
import Control.Applicative ((<$>))

log2Floor n = floor $ (log n) / (log 2)

power2 x = 2^x

trickySum n = integerSum n - 2 * (twoSum n)

-- double is tricky in Haskell
integerSum n = round $ ((1+n)*n) * (1/2)

twoSum n = sum (map power2 [0 ..(log2Floor n)])

readInt::String -> Double
readInt = read

main = do
  input <- map readInt . tail . lines <$> getContents
  let res = map trickySum input
  mapM_ print res

--ifPower2 n = fromIntegral (floor log2) == log2
--  where log2 = (log n)/(log 2)
--
--sum'' [] = 0
--sum'' (x:xs) = if (ifPower2 x)
--               then (-1) * x + sum'' xs
--               else x + sum'' xs
--
--minusPlus x y = if (ifPower2 y)
--                then x + (-1)*y
--                else x + y
--
--sum' xs = foldl' minusPlus 0 xs

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

process x = s -s1 -s1
    where s = div ((x+1)*x) 2
          s1 = sum $ takeWhile (<x) [2^i|i<-[0..]]

main::IO ()
main=do
  getLine
  x<-  map read <$> lines <$> getContents ::IO [Integer]
  mapM_ print $ map process x

#!/usr/bin/runhaskell

roundUpToPowerOfTwo :: Integer -> Integer
roundUpToPowerOfTwo x = head (dropWhile (<= x) [2 ^ i | i <- [0 ..]])

calcResult :: Integer -> Integer
calcResult x = x * (x + 1) `div` 2 - 2 * (roundUpToPowerOfTwo x - 1)

main = do
  getLine -- Skip first line
  contents <- getContents
  mapM_ putStr (map (show . calcResult . read) (lines contents))

import Data.List
import Data.Bits
import Control.Arrow

solve :: Integer -> Integer
solve = uncurry (+) . ((\x -> (*(-2)) . sum $ takeWhile (<= x) $ map (shiftL 1) [0..]) &&& (\x -> shiftR (x*(x+1)) 1))

main = interact (show . unlines . map (show . solve . read) . tail . lines)

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

onecase = do
		x<-read<$>getLine::IO Integer
		let x1 = div (x*(x+1)) 2
		let x2 = length $ takeWhile (>0) [div x (2^i)| i<-[0..]]
		let x3 = x1 +2  -2^x2
		print x3

main= do
	n<-  read<$> getLine ::IO Int
	replicateM_ n onecase


It's well known that the best way to distract from something is to do one's favourite thing. Job is such a thing for Leha.So the hacker began to work hard in order to get rid of boredom. It means that Leha began to hack computers all over the world. For such zeal boss gave the hacker a vacation of exactly x days. You know the majority of people prefer to go somewhere for a vacation, so Leha immediately went to the travel agency. There he found out that n vouchers left. i-th voucher is characterized by three integers li, ri, costi — day of departure from Vičkopolis, day of arriving back in Vičkopolis and cost of the voucher correspondingly. The duration of the i-th voucher is a value ri - li + 1.At the same time Leha wants to split his own vocation into two parts. Besides he wants to spend as little money as possible. Formally Leha wants to choose exactly two vouchers i and j (i ≠ j) so that they don't intersect, sum of their durations is exactly x and their total cost is as minimal as possible. Two vouchers i and j don't intersect if only at least one of the following conditions is fulfilled: ri < lj or rj < li.Help Leha to choose the necessary vouchers!

The first line contains two integers n and x (2 ≤ n, x ≤ 2·105) — the number of vouchers in the travel agency and the duration of Leha's vacation correspondingly. Each of the next n lines contains three integers li, ri and costi (1 ≤ li ≤ ri ≤ 2·105, 1 ≤ costi ≤ 109) — description of the voucher.

Print a single integer — a minimal amount of money that Leha will spend, or print  - 1 if it's impossible to choose two disjoint vouchers with the total duration exactly x.

NoteIn the first sample Leha should choose first and third vouchers. Hereupon the total duration will be equal to (3 - 1 + 1) + (6 - 5 + 1) = 5 and the total cost will be 4 + 1 = 5.In the second sample the duration of each voucher is 3 therefore it's impossible to choose two vouchers with the total duration equal to 2.

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

data Voucher = Voucher !Int !Int !Int

main = do
  [n, x] <- fmap readInts B.getLine
  vs <- replicateM n (fmap ((\[_1, _2, _3] -> Voucher _1 _2 _3) . readInts) B.getLine)
  print $ fromMaybe (-1) $ solve n x vs

solve n x vs = minimum' $ mapMaybe (\v@(Voucher _ r c) -> fmap (+c) $ (M.lookup (x - dur v) . snd) =<< M.lookupGT r l2t) vs'
  where
    vs' = sortBy (comparing (\(Voucher l _ _) -> l)) vs
    l2t = M.fromAscListWith (flip const) $ zipWith (\(Voucher l _ _) t -> (l, t)) vs' $ scanr (\v@(Voucher _ _ c) -> M.insertWith min (dur v) c) M.empty vs'
    dur (Voucher l r _) = r - l + 1

minimum' xs = case xs of
  [] -> Nothing
  _ -> Just $ minimum xs

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

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

main = do
  [n, x] <- fmap readInts B.getLine
  vs <- replicateM n (fmap ((\[_1, _2, _3] -> (_1, _2, _3)) . readInts) B.getLine)
  print $ solve n x vs

solve n x vs = minimum $ ((-1):) $ concatMap (\v@(l, r, c) -> map (\(_, _, c') -> c + c') $ filter (\v' -> dur v + dur v' == x) $ concat $ M.elems $ snd $ M.split r l2vs) vs
  where
    l2vs = M.fromListWith (++) $ map (\v@(l, _, _) -> (l, [v])) vs
    dur (l, r, _) = r - l + 1

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


Lindsey Buckingham told Stevie Nicks "Go your own way". Nicks is now sad and wants to go away as quickly as possible, but she lives in a 2D hexagonal world.Consider a hexagonal tiling of the plane as on the picture below.  Nicks wishes to go from the cell marked $$$(0, 0)$$$ to a certain cell given by the coordinates. She may go from a hexagon to any of its six neighbors you want, but there is a cost associated with each of them. The costs depend only on the direction in which you travel. Going from $$$(0, 0)$$$ to $$$(1, 1)$$$ will take the exact same cost as going from $$$(-2, -1)$$$ to $$$(-1, 0)$$$. The costs are given in the input in the order $$$c_1$$$, $$$c_2$$$, $$$c_3$$$, $$$c_4$$$, $$$c_5$$$, $$$c_6$$$ as in the picture below.  Print the smallest cost of a path from the origin which has coordinates $$$(0, 0)$$$ to the given cell.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^{4}$$$). Description of the test cases follows. The first line of each test case contains two integers $$$x$$$ and $$$y$$$ ($$$-10^{9} \le x, y \le 10^{9}$$$) representing the coordinates of the target hexagon. The second line of each test case contains six integers $$$c_1$$$, $$$c_2$$$, $$$c_3$$$, $$$c_4$$$, $$$c_5$$$, $$$c_6$$$ ($$$1 \le c_1, c_2, c_3, c_4, c_5, c_6 \le 10^{9}$$$) representing the six costs of the making one step in a particular direction (refer to the picture above to see which edge is for each value).

For each testcase output the smallest cost of a path from the origin to the given cell.

NoteThe picture below shows the solution for the first sample. The cost $$$18$$$ is reached by taking $$$c_3$$$ 3 times and $$$c_2$$$ once, amounting to $$$5+5+5+3=18$$$.

import Control.Monad
import Data.Int

readInts :: IO [Int64]
readInts = map read . words <$> getLine

main :: IO ()
main = do
  t <- read <$> getLine
  replicateM_ t $ do
    [x, y] <- readInts
    [c1, c2, c3, c4, c5, c6] <- readInts
    let
      costx xv = if  xv >= 0  then  c6 * xv  else  -c3 * xv
      costy yv = if  yv >= 0  then  c2 * yv  else  -c5 * yv
      costz zv = if  zv >= 0  then  c4 * zv  else  -c1 * zv
      costxy = costx x + costy y
      costxz = costx (x-y) + costz (0-y)
      costyz = costy (y-x) + costz (0-x)
    print $ minimum [costxy, costxz, costyz]


Little X has met the following problem recently. Let's define f(x) as the sum of digits in decimal representation of number x (for example, f(1234) = 1 + 2 + 3 + 4). You are to calculate Of course Little X has solved this problem quickly, has locked it, and then has tried to hack others. He has seen the following C++ code:     ans = solve(l, r) % a;    if (ans <= 0)      ans += a; This code will fail only on the test with . You are given number a, help Little X to find a proper test for hack.

The first line contains a single integer a (1 ≤ a ≤ 1018).

Print two integers: l, r (1 ≤ l ≤ r < 10200) — the required test data. Leading zeros aren't allowed. It's guaranteed that the solution exists.

import Data.Char

mu p a b | a == b = a
         | p c = mu p a c
         | otherwise  = mu p (c+1) b
         where c = (a+b) `div` 2
s x = fromIntegral $ sum (map digitToInt $ show x)

f 0 = 0
f x = 10 * f n + 45 * n + s n * k + k*(k-1) `div` 2 where (n,k) = x `divMod` 10
solve :: Integer->[Integer]
solve a | a<=9*200 = [n,n]
        | otherwise = head [ [l,r] |
     k<-[0..200],
     let n9=10^k-1,
     let l = mu (\l->f (10^k) - f l <= a) 0 (10^k),
     l>0,
     let r = head [r | r<-[10^k-1..], f (r+1)-f l >=a],
     f (r+1) - f l == a]
   where
    n=10^(-d)-1-m
    (d,m)=(-a) `divMod` 9
main = interact $ unwords . map show . solve . read

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Data.Char

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

f x = sum $ map (fromIntegral.digitToInt) $ show x

solve :: Integer -> Integer
solve n = go (map (fromIntegral.digitToInt) $ show n) where
    go [] = 0
    go [v] = sum [1..v]
    go (v:vs) = v * ((v-1) * 10 ^ d `div` 2 + d * 10^(d-1) * 45 + decimal vs + 1) + go vs where
        d = fromIntegral $ length vs

solve' l r = solve r - solve (l-1)

hack :: Integer -> (String,String)
hack a = head $ do
    d <- [1..]
    let x = d * 10^(d-1) * 45 + 1
    k <- [(10^(d-1) + x) `div` a .. (10^d + x + a-1) `div` a - 1]
    let vs = k * a - x
    guard $ 10^(d-1) <= vs && vs < 10^d
    return ('1':show vs,show (vs+1))

decimal = foldl (\a b -> a * 10 + b) 0

prop_solve :: Integer -> Bool
prop_solve x = sum (map f [0..x]) == solve x

main :: IO ()
main = do
    a <- readLn
    let (r,l) = hack a
    putStrLn $ unwords [l,r]

import Data.Word (Word64)
import Control.Applicative ((<$>))

cumDigitSum :: Word64 -> Word64
cumDigitSum n = loop n k
    where
    k = last $ takeWhile (\i -> 10^i < n + 1) [0..]
    loop 0 _ = 0
    loop n k = x * 45 * k * 10^(k - 1)
             + (x * (x - 1) `div` 2) * 10^k
             + x * (r + 1) + rest
        where
        (x, r) = n `divMod` (10^k)
        rest = loop r (k - 1)

find :: Word64 -> Word64
find 0 = 0
find a = loop (ub `div` 2) ub
    where
    ub = head . dropWhile ((< a) . cumDigitSum) $ iterate (2*) 1
    loop lb ub
        | lb + 1 == ub = ub
        | cumDigitSum i < a = loop i ub
        | otherwise = loop lb i
        where i = (lb + ub) `div` 2

solve :: Word64 -> (Word64, Word64)
solve a = loop (find a)
    where
    loop r = if x == a + cumDigitSum l then (l + 1, r) else loop (r + 1)
        where
        x = cumDigitSum r
        l = find (x - a)

main = do
    a <- read <$> getLine
    let (l, r) = solve a
    putStrLn $ show l ++ " " ++ show r

import Data.Word (Word64)
import Control.Applicative ((<$>))

cumDigitSum :: Word64 -> Word64
cumDigitSum n = loop n k
    where
    k = last $ takeWhile (\i -> 10^i < n + 1) [0..]
    loop 0 _ = 0
    loop n k = x * 45 * k * 10^(k - 1)
             + (x * (x - 1) `div` 2) * 10^k
             + x * (r + 1) + rest
        where
        (x, r) = n `divMod` (10^k)
        rest = loop r (k - 1)

find :: Word64 -> Word64
find a = loop 0 ub
    where
    ub = head . dropWhile ((< a) . cumDigitSum) $ iterate (2*) 2
    loop lb ub
        | lb + 1 == ub = ub
        | cumDigitSum i < a = loop i ub
        | otherwise = loop lb i
        where i = (lb + ub) `div` 2

solve :: Word64 -> (Word64, Word64)
solve a = loop (find a)
    where
    loop r = if x == a + cumDigitSum l then (l + 1, r) else loop (r + 1)
        where
        x = cumDigitSum r
        l = find (x - a)

main = do
    a <- read <$> getLine
    let (l, r) = solve a
    putStrLn $ show l ++ " " ++ show r

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Data.Char

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

f x = sum $ map (fromIntegral.digitToInt) $ show x

solve :: Integer -> Integer
solve n = go (map (fromIntegral.digitToInt) $ show n) where
    go [] = 0
    go [v] = sum [1..v]
    go (v:vs) = v * ((v-1) * 10 ^ d `div` 2 + d * 10^(d-1) * 45 + decimal vs + 1) + go vs where
        d = fromIntegral $ length vs

solve' l r = solve r - solve (l-1)

hack a = head $ do
    d <- [1..]
    let x = d * 10^(d-1) * 45 + 1
    k <- [(10^(d-1) + x) `div` a .. (10^d + x + a-1) `div` a - 1]
    let vs = k * a - x
    guard $ 10^(d-1) <= vs && vs < 10^d
    return ('1':show vs,show (vs+1))

decimal = foldl (\a b -> a * 10 + b) 0

prop_solve :: Integer -> Bool
prop_solve x = sum (map f [0..x]) == solve x

main = putStrLn "Hello World!"


You are given an n × m rectangular table consisting of lower case English letters. In one operation you can completely remove one column from the table. The remaining parts are combined forming a new table. For example, after removing the second column from the tableabcdedfghijk we obtain the table:acdefghjk A table is called good if its rows are ordered from top to bottom lexicographically, i.e. each row is lexicographically no larger than the following one. Determine the minimum number of operations of removing a column needed to make a given table good.

The first line contains two integers  — n and m (1 ≤ n, m ≤ 100). Next n lines contain m small English letters each — the characters of the table.

Print a single number — the minimum number of columns that you need to remove in order to make the table good.

NoteIn the first sample the table is already good.In the second sample you may remove the first and third column.In the third sample you have to remove all the columns (note that the table where all rows are empty is considered good by definition).Let strings s and t have equal length. Then, s is lexicographically larger than t if they are not equal and the character following the largest common prefix of s and t (the prefix may be empty) in s is alphabetically larger than the corresponding character of t.

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
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 Data.Function
-- import Data.Graph
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Monoid
import Data.Set (Set)
import qualified Data.Set as Set
-- import Data.Tree
import Data.Tuple
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import System.IO
-- import Debug.Trace

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

main = do
  [n, m] <- getInts
  ls <- replicateM n getLine

  let
    isSorted xs = and $ zipWith (<=) xs $ tail xs

    f :: [[String]] -> Int
    f gs
      | head (head gs) == [] = 0
      | all (isSorted . map head) gs = f $ map (map tail) $ concat $ map (groupBy ((==) `on` head)) gs
      | otherwise = 1 + f (map (map tail) gs)

  print $ f [ls]

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ [ls]

readIntsIO :: IO [Int]
readIntsIO = map read . words <$> getLine

solve :: [[String]] -> Int
solve = go 0
  where
    go acc [] = acc
    go acc xsss = if mustBeRemoved xsss
                  then go (acc+1) (droppedXsss xsss)
                  else go acc (splittedXsss xsss)

    mustBeRemoved :: [[String]] -> Bool
    mustBeRemoved = any (or . headUnordered)

    headUnordered :: [String] -> [Bool]
    headUnordered xss = zipWith ((>) `on` head) xss (tail xss)

    droppedXsss :: [[String]] -> [[String]]
    droppedXsss = filterNotNullMap (filterNotNullMap tail)

    splittedXsss :: [[String]] -> [[String]]
    splittedXsss = filter (not . null) . concatMap collect

    collect :: [String] -> [[String]]
    collect ([_]:_) = []
    collect ((x1:xs1):(x2:xs2):xss')
      | x1 == x2  = (xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')) : (collect . dropWhile ((x1 ==) . head) $ xss')
      | otherwise = collect ((x2:xs2):xss')
    collect _ = []

    filterNotNullMap f = filter (not . null) . map f

module Main where

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

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (0, m - 1) False :: IO (IOUArray Int Bool)
  ls <- replicateM n B.getLine
  let iteration = and <$> zipWithM (makeMatch m mismatch) ls (tail ls)
  let iteration2 = iteration >>= (\r -> if r then return True else iteration2)
  void iteration2
  print =<< length <$> filterM (readArray mismatch) [0..m-1]

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO Bool
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return True
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return True
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        return False
        --go (i + 1)

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

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, TupleSections, OverloadedStrings #-}
import Control.Applicative
import Control.Exception hiding (mask)
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST (runSTUArray, runSTArray)
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.Function
import Data.Int
import Data.List
import qualified Data.Map as M
import qualified Data.IntMap as IM
import qualified Data.Set as S
import qualified Data.IntSet as IS
import Data.STRef
import GHC.Arr (Array, STArray, Ix(..))
import Debug.Trace

bool :: a -> a -> Bool -> a
bool t f b=if b then t else f
readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
rep, rev :: Monad m => Int -> (Int -> m ()) -> m ()
rep n f=foldr((>>).f)(return())[0..n-1]
rev n f=foldr((>>).f.negate)(return())[1-n..0]
for :: Monad m => Int -> Int -> (Int -> m ()) -> m ()
for a b f=foldr((>>).f)(return())[a..b]
{-# INLINE rep #-}
{-# INLINE rev #-}
{-# INLINE for #-}
modifyArray :: (MArray a e m, Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray a i f=readArray a i>>=writeArray a i.f
{-# INLINE modifyArray #-}
unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main :: IO ()
main = do
  [n,m] <- map read.words <$> getLine :: IO [Int]
  css <- transpose.lines <$> getContents
  print $ solve css

solve :: [String] -> Int
solve css0 = go 0 css0
   where
     go !cnt (cs:rest)
       | isAscending cs = go2 cnt (group cs) rest
       | otherwise = go (cnt+1) rest
     go cnt [] = cnt
     go2 !cnt ccs [] = cnt
     go2 !cnt ccs (xs:xss)
        | all isAscending yss = if all((1==).length)yss then cnt
                                else go2 cnt (concatMap group yss) xss
        | otherwise = go2 (cnt+1) ccs xss
      where
        ls = map length ccs
        f (l:ls) cs = take l cs : f ls (drop l cs)
        f _ _ = []
        yss = f ls xs

isAscending :: String -> Bool
isAscending (c:cs) = and $ zipWith (<=) (c:cs) cs
isAscending [] = True

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
thru :: Monad m => (v -> m ()) -> v -> m v
thru m v = m v >> return v
inf = maxBound `div` 2 :: Int

main = do
    (n,m) <- readIntPair
    tbl <- replicateM n getLine
    print $ solve n m tbl

solve :: Int -> Int -> [String] -> Int
solve n m tbl = go ["" | i <- [1..n]] (transpose tbl) 0 where
    go _   []     !acc = acc
    go cur (l:ls) !acc
        | good cur1 = go cur1 ls acc
        | otherwise = go cur ls (acc+1) where
        cur1 = zipWith (\a b -> a ++ [b]) cur l

good :: [String] -> Bool
good l = and $ zipWith (<=) l (tail l)

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

readIntsIO :: IO [Int]
readIntsIO = map read . words <$> getLine

solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss') ++ (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

readIntsIO :: IO [Int]
readIntsIO = map read . words <$> getLine

solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

module Main where

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

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (1, m) True :: IO (IOUArray Int Bool)
  ls <- B.lines <$> B.getContents
  zipWithM_ (makeMatch m mismatch) ls (tail ls)

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO ()
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return ()
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return ()
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        go (i + 1)

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

module Main where

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

main :: IO ()
main = do
  [n, m] <- readInts <$> B.getLine
  mismatch <- newArray (0, m - 1) False :: IO (IOUArray Int Bool)
  ls <- replicateM n B.getLine
  zipWithM_ (makeMatch m mismatch) ls (tail ls)
  print =<< length <$> filterM (readArray mismatch) [0..m-1]

makeMatch :: Int -> IOUArray Int Bool -> B.ByteString -> B.ByteString -> IO ()
makeMatch m removed lhs rhs = go 0
  where
    go i
      | i == m    = return ()
      | otherwise = do
        isRemoved <- readArray removed i
        if isRemoved then go (i + 1) else match i
    match i = case compare (B.index lhs i) (B.index rhs i) of
      LT -> return ()
      EQ -> go (i + 1)
      GT -> do
        writeArray removed i True
        go (i + 1)

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

{-# OPTIONS_GHC -O2 -optc-O2 #-}

module Main where

import Control.Applicative
import Control.Monad
import Data.Char
import Data.Function
import qualified Data.Set as Set

main :: IO ()
main = do
  [n, m] <- readIntsIO
  ls <- replicateM n getLine
  print . solve $ ls

readIntsIO :: IO [Int]
readIntsIO = map read . words <$> getLine

solve :: [String] -> Int
solve = Set.size . go 0 Set.empty
  where
    go _ acc []     = acc
    go _ acc ([]:_) = acc
    go i acc xss    = if mustBeRemoved xss
                      then go (i+1) (Set.insert i acc) $ map tail xss
                      else foldr Set.union Set.empty $ map (go (i+1) acc) $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = (xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss')) : (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []

{-
solve :: [String] -> Int
solve = go 0
  where
    go :: Int -> [String] -> Int
    go acc []     = acc
    go acc ([]:_) = acc
    go acc xss    = if mustBeRemoved xss
                      then go (acc + 1) $ map tail xss
                      else go acc $ collect xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith ((-) `on` ord . head) xss' $ tail xss'
        collect ((x1:xs1):(x2:xs2):xss')
          | x1 == x2  = xs1 : xs2 : (map tail . takeWhile ((x1 ==) . head) $ xss') ++ (collect . dropWhile ((x1 ==) . head) $ xss')
          | otherwise = collect ((x2:xs2):xss')
        collect _ = []
-}

{-
solve :: [String] -> Int
solve = go 0 0
  where
    go :: Int -> [String] -> Int
    go acc _ []     = acc
    go acc _ ([]:_) = acc
    go acc i xss'   = if mustBeRemoved xss'
                        then go (acc + 1) 0 $ map (deleteAt i) xss
                        else go acc (i + 1) xss
      where
        mustBeRemoved xss' = any (> 0) . zipWith (>) takeidx $ tail takeidx
          where takeidx = map (take i) xss'

deleteAt n xs = h ++ t
  where
    (h, _:t) = splitAt n xs
-}


You are given an array $$$a[0 \dots n-1]$$$ of $$$n$$$ integers. This array is called a "valley" if there exists exactly one subarray $$$a[l \dots r]$$$ such that:  $$$0 \le l \le r \le n-1$$$,  $$$a_l = a_{l+1} = a_{l+2} = \dots = a_r$$$,  $$$l = 0$$$ or $$$a_{l-1} > a_{l}$$$,  $$$r = n-1$$$ or $$$a_r < a_{r+1}$$$. Here are three examples:  The first image shows the array [$$$3, 2, 2, 1, 2, 2, 3$$$], it is a valley because only subarray with indices $$$l=r=3$$$ satisfies the condition.The second image shows the array [$$$1, 1, 1, 2, 3, 3, 4, 5, 6, 6, 6$$$], it is a valley because only subarray with indices $$$l=0, r=2$$$ satisfies the codition.The third image shows the array [$$$1, 2, 3, 4, 3, 2, 1$$$], it is not a valley because two subarrays $$$l=r=0$$$ and $$$l=r=6$$$ that satisfy the condition.You are asked whether the given array is a valley or not.Note that we consider the array to be indexed from $$$0$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10^4$$$) — the number of test cases. The first line of each test case contains a single integer $$$n$$$ ($$$1 \leq n \leq 2\cdot10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_i$$$ ($$$1 \leq a_i \leq 10^9$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ over all test cases is smaller than $$$2\cdot10^5$$$.

For each test case, output "YES" (without quotes) if the array is a valley, and "NO" (without quotes) otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

NoteThe first three test cases are explained in the statement.

import Control.Monad
import Data.List

main = do
    n' <- getLine
    let n = read n' :: Int
    forM_ [1..n] $ \_ -> do
        getLine
        ns' <- getLine
        let ns = map (\x -> read x :: Int)  $ words ns'
        let a = map (head) $ group $ filter (/= '=')  $ zipWith (\x y -> if x == y then '=' else if y < x then '-' else '+') ns $ tail ns
        putStrLn $ if a  == "" ||  a == "-" || a == "+" || a == "-+" then "YES" else "NO"

collapse :: [Int] -> [Int]
collapse (x : y : xs)
        | x == y = collapse (y : xs)
        | otherwise =  x : collapse (y : xs)
collapse x = x

valleys :: [Int] -> Int
valleys a = edge a + middle a
        where
                middle (x : y : z : xs) = eval + middle (y : z : xs)
                        where eval = if x > y && y < z then 1 else 0
                middle _ = 0
                edge (x : []) = 1
                edge x = bgn + end
                        where
                                bgn = if a < b then 1 else 0
                                end = if c > d then 1 else 0
                                a = head x
                                b = x !! 1
                                d = last x
                                c = last $ take m x
                                m = length x - 1

answer :: Int -> Bool
answer 1 = True
answer _ = False

solve :: [Int] -> Bool
solve = answer . valleys . collapse

everyOther [] = []
everyOther (_ : x : xs) = (x : everyOther xs)

veredict True = "YES"
veredict False = "NO"

main = interact $ unlines . map (veredict . solve . map read . words) . everyOther . drop 1. lines

import Control.Monad
import Data.List

main = do
    n' <- getLine
    let n = read n' :: Int
    forM_ [1..n] $ \_ -> do
        getLine
        ns' <- getLine
        let ns = map (\x -> read x :: Int)  $ words ns'
        let m = minimum ns
        putStrLn $ if (length $ filter (\x ->  head x == m) $ group ns) > 1 then "NO" else "YES"


Two people are playing a game with a string $$$s$$$, consisting of lowercase latin letters. On a player's turn, he should choose two consecutive equal letters in the string and delete them. For example, if the string is equal to "xaax" than there is only one possible turn: delete "aa", so the string will become "xx". A player not able to make a turn loses.Your task is to determine which player will win if both play optimally.

The only line contains the string $$$s$$$, consisting of lowercase latin letters ($$$1 \leq |s| \leq 100\,000$$$), where $$$|s|$$$ means the length of a string $$$s$$$.

If the first player wins, print "Yes". If the second player wins, print "No".

NoteIn the first example the first player is unable to make a turn, so he loses.In the second example first player turns the string into "q", then second player is unable to move, so he loses.

-- Codeforces Round #534 Div.2 (B), Contest 1104, Problem set ?.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

import Data.Bits
import Data.List
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
-- import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
{-
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
-}
import Control.Monad
import Control.Monad.ST.Safe
-- import Control.Monad.ST
import Control.Applicative
import Data.Maybe
import Data.Tuple
import Data.Ord
import Control.Monad.State.Strict
import Data.Int
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  xs <- getLine
  putStrLn $ if odd $ countPairs xs then "Yes" else "No"

countPairs :: String -> Int
countPairs = flip (loop []) 0
  where
    loop (y:ys) (x:xs) !k | x==y = loop ys xs (k+1)
    loop ys     (x:xs) !k  = loop (x:ys) xs k
    loop _      []     !k  = k


You are given an array $$$a$$$ of $$$n$$$ integers and a set $$$B$$$ of $$$m$$$ positive integers such that $$$1 \leq b_i \leq \lfloor \frac{n}{2} \rfloor$$$ for $$$1\le i\le m$$$, where $$$b_i$$$ is the $$$i$$$-th element of $$$B$$$. You can make the following operation on $$$a$$$:  Select some $$$x$$$ such that $$$x$$$ appears in $$$B$$$. Select an interval from array $$$a$$$ of size $$$x$$$ and multiply by $$$-1$$$ every element in the interval. Formally, select $$$l$$$ and $$$r$$$ such that $$$1\leq l\leq r \leq n$$$ and $$$r-l+1=x$$$, then assign $$$a_i:=-a_i$$$ for every $$$i$$$ such that $$$l\leq i\leq r$$$. Consider the following example, let $$$a=[0,6,-2,1,-4,5]$$$ and $$$B=\{1,2\}$$$:  $$$[0,6,-2,-1,4,5]$$$ is obtained after choosing size $$$2$$$ and $$$l=4$$$, $$$r=5$$$. $$$[0,6,2,-1,4,5]$$$ is obtained after choosing size $$$1$$$ and $$$l=3$$$, $$$r=3$$$. Find the maximum $$$\sum\limits_{i=1}^n {a_i}$$$ you can get after applying such operation any number of times (possibly zero).

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10^5$$$) — the number of test cases. Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$2\leq n \leq 10^6$$$, $$$1 \leq m \leq \lfloor \frac{n}{2} \rfloor$$$) — the number of elements of $$$a$$$ and $$$B$$$ respectively.  The second line of each test case contains $$$n$$$ integers $$$a_1,a_2,\ldots,a_n$$$ ($$$-10^9\leq a_i \leq 10^9$$$).  The third line of each test case contains $$$m$$$ distinct positive integers $$$b_1,b_2,\ldots,b_m$$$ ($$$1 \leq b_i \leq \lfloor \frac{n}{2} \rfloor$$$) — the elements in the set $$$B$$$. It's guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^6$$$.

For each test case print a single integer — the maximum possible sum of all $$$a_i$$$ after applying such operation any number of times.

NoteIn the first test, you can apply the operation $$$x=1$$$, $$$l=3$$$, $$$r=3$$$, and the operation $$$x=1$$$, $$$l=5$$$, $$$r=5$$$, then the array becomes $$$[0, 6, 2, 1, 4, 5]$$$.In the second test, you can apply the operation $$$x=2$$$, $$$l=2$$$, $$$r=3$$$, and the array becomes $$$[1, 1, -1, -1, 1, -1, 1]$$$, then apply the operation $$$x=2$$$, $$$l=3$$$, $$$r=4$$$, and the array becomes $$$[1, 1, 1, 1, 1, -1, 1]$$$. There is no way to achieve a sum bigger than $$$5$$$.

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    aLi <- replicateM n getInt
    let
      a :: UArray Int Int
      !a = listArray (1, n) aLi
      -- GHC tried to evaluate b first... which makes sense but is bad
    bLi <- replicateM m getInt
    let
      b = foldl1' gcd bLi -- 1 character... ugh

      go :: Int -> Int -> Int -> (Int, Int)
      go x y 0 = x `seq` y `seq` (x, y)
      go x y i = let
        li = [a ! j | j <- [i, i + b .. n]]
        {-# INLINE CONLIKE li #-}
        issueSize = foldl' min maxBound $ map abs li
        negCt = length $ filter (< 0) li
        posTot = foldl' (+) 0 $ map abs li
        in  x `seq` y `seq` if  even negCt
        then  go (x + posTot) (y + posTot - 2 * issueSize) (i - 1)
        else  go (x + posTot - 2 * issueSize) (y + posTot) (i - 1)
      (evens, odds) = go 0 0 b
    pure $ putInts [max evens odds]

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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


Vanya walks late at night along a straight street of length l, lit by n lanterns. Consider the coordinate system with the beginning of the street corresponding to the point 0, and its end corresponding to the point l. Then the i-th lantern is at the point ai. The lantern lights all points of the street that are at the distance of at most d from it, where d is some positive number, common for all lanterns. Vanya wonders: what is the minimum light radius d should the lanterns have to light the whole street?

The first line contains two integers n, l (1 ≤ n ≤ 1000, 1 ≤ l ≤ 109) — the number of lanterns and the length of the street respectively.  The next line contains n integers ai (0 ≤ ai ≤ l). Multiple lanterns can be located at the same point. The lanterns may be located at the ends of the street.

Print the minimum light radius d, needed to light the whole street. The answer will be considered correct if its absolute or relative error doesn't exceed 10 - 9.

NoteConsider the second sample. At d = 2 the first lantern will light the segment [0, 4] of the street, and the second lantern will light segment [3, 5]. Thus, the whole street will be lit.

{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import Text.Printf

readInt = ( readLn :: IO Int )
getInts = map ( read :: String -> Int ) . words <$> getLine

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

main = do
	[ n, l ] <- getInts
	as <- sort <$> getInts

	printf "%.12f\n" $ ( maximum :: [Double] -> Double ) [ fromIntegral $ head as, fromIntegral $ ( l - last as ), fromIntegral ( maximum $ 0 : diffs as ) / 2.0 ]

diffs ( a : as )
	| null as = []
	| otherwise = ( head as - a ) : diffs as

import Data.List

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

solve :: [Int] -> Double
solve (n:l:a) =
    let sa = sort a
    in (fromIntegral (max ((head sa) * 2) (solve' sa))) * 0.5
    where
        solve' :: [Int] -> Int
        solve' [a] = (l - a) * 2
        solve' (a:b:x) = max (b - a) (solve' (b:x))

import Data.List

biggap lst max
  | (length lst) == 1 = max
  | otherwise = biggap (tail lst) (maximum [max, (head (drop 1 lst)) - (head lst)])

conv lst uu
  | (null lst) = reverse uu
  | otherwise = conv (tail lst) (((read (head lst))::Int) : uu)

main = do
  ff <- getLine
  let n = (read (head (words ff)))::Int
      d = (read (last (words ff)))::Int
  gg <- getLine

  let aa = (conv (words gg) [])
      srted = sort aa

  let cc = (biggap srted 0)

      mx = (maximum [ realToFrac ( ((head srted) - 0)), realToFrac ( (d - (last srted))), ( (realToFrac cc) / (realToFrac 2))])
  putStrLn (show mx)

  -- putStrLn ("\n\n\n\n")
  -- putStrLn (show (cc / (realToFrac 2)))

import Data.List

main = do
  [n, l] <- fmap (map read . words) getLine
  xs <- fmap (map head . group . sort . map read . words) getLine

  let
    d = (head xs):(l - last xs):(zipWith (\a b -> (a+b)/2 - a) xs (tail xs))

  print $ maximum d

import Data.List
main = interact $ show . (/2) . h . g . map read . tail . words
f [l, x] = (l - x) * 2
f (l:x:y:z) = max (y - x) $ f (l:y:z)
g (a:b) = (a:sort b)
h (l:x:y) = max (x * 2) $ f(l:x:y)

import Control.Applicative
import Control.Monad.ST
import Data.Array.ST
import Data.List
import Data.Char
import Data.Maybe
import qualified Data.ByteString.Char8 as B
showBI :: Int -> B.ByteString
showBI = B.pack . show
readBI :: B.ByteString -> Int
readBI = fst . fromJust . B.readInt
smap :: ((a,b) -> (c,b)) -> b -> [a] -> [c]
smap f s (l:ls) = (fst app):(smap f (snd app) ls)
                  where app = f (l,s)
smap _ _ [] = []

main = interact $ show . rd . lines
rd :: [String] -> Double
rd [nl,as] = go (read . last . words $ nl) (map read . words $ as)
go :: Double -> [Double] -> Double
go l as = maximum $ [frst,scnd,thrd]
          where frst = (/2) . maximum . smap (\(x,y) -> (x-y,x)) (head lst) $ lst
                scnd = head lst
                thrd = l-(last lst)
                lst = sort as

import Data.List
import Data.Maybe
import Data.Char
import Data.Function
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ solve. tail.concat.map (map read.words). take 2. lines
solve :: [Integer]->String
solve (x:xs) = show $ (/2) $ fromIntegral $ maximum $ zipWith (\a b->a-b) (s1:s1s) (s1:init (s1:s1s))
  where
  (s:ss)=sort  xs
  (s1:s1s)=(-s):(s:ss)++(x+x-last (s:ss)):[]

import           Data.List                      ( sort )

split :: Eq a => a -> [a] -> [[a]]
split _    [] = []
split cond xs = x : split cond (drop 1 y) where (x, y) = span (/= cond) xs

process :: Double -> [Double] -> Double
process _ [] = 0.0
process l xs =
  let xs' = zipWith (-) (xs ++ [l]) (0.0 : xs)
  in  maximum $ (minimum xs - 0.0) : (l - maximum xs) : (map (/ 2.0) xs')

main :: IO ()
main = do
  input <- getLine
  lamps <- getLine
  let xs = map (read :: String -> Integer) (split ' ' input)
  let ys = map (read :: String -> Double) (split ' ' lamps)
  let l  = xs !! 1
  print $ process (fromInteger l) (sort ys)

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

toD :: Int -> Double
toD = fromIntegral

solve :: Int -> [Int] -> Double
solve l a = max (toD (max (head sa) (l - last sa))) x
    where sa = sort a
          x  = (toD . maximum $ 0 : zipWith (-) (tail sa) sa) / 2

main :: IO ()
main = do
    [_, l] <- getIntList
    a <- getIntList
    print $ solve l a

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

process s q = maximum [(fromIntegral x ) /2 ,fromIntegral(s- maximum q), fromIntegral(minimum q)]
  where x1 = zipWith (-) (tail q) q
        x = if x1==[] then 0 else ( maximum x1)

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

import Data.List (sort)

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

solve :: [Double] -> Double
solve (_:l:as) = maximum (head bs : (l - last bs) : map (/2) (zipWith (-) (tail bs) bs))
  where bs = sort as
solve _ = undefined

import Data.List (group,sort)
readNums = fmap (map read . words) getLine
main = do
  [n,l] <- readNums
  as <- fmap (map ((*2) . head) . group . sort) readNums
  print $ fromIntegral (bsearch as 0 (2*l)) / 2
bsearch as l road = go l road
  where go l r | l + 1 == r = r
               | v m = go l m
               | otherwise = go m r
          where m = (l + r) `div` 2
        v r = all (uncurry cover) (zip as' (tail as'))
          where cover a b = b - a <= 2 * r
                as' = (-r) : as ++ [road+r]

-- Vicfred
-- https://codeforces.com/problemset/problem/492/B

import Data.List

solve :: Int -> [Int] -> Double
solve l a = max (fromIntegral (max (head sa) (l - last sa))) x
    where sa = sort a
          x  = (fromIntegral . maximum $ 0 : zipWith (-) (tail sa) sa) / 2

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

import Data.List
import System.IO

readInput :: Read a => IO [a]
readInput = fmap (map read . words) getLine

getNLine :: Int -> IO [String]
getNLine n
    | n <= 0 = return []
    | otherwise = do
        x <- getLine
        xs <- getNLine $ n-1
        let ret = (x:xs)
        return ret

main :: IO ()
main = do
    n <- readInput :: IO [Int]
    l <- readInput :: IO [Int]
    let xs = reverse (last n : reverse (0 : sort l))
    let dis = zipWith (-) (tail xs)  xs
    -- print dis
    print $ solve dis
    -- putStrLn xs

solve :: [Int] -> Double
solve li =  max max_dis end_point
    where
        max_dis = fromIntegral (maximum li) / 2
        end_point = fromIntegral (max (head li) (last li))

import Control.Applicative
import Data.List

main= do
	[x1,b1]<- map read. words <$> getLine ::IO [Int]
	s<-sort .map read. words <$> getLine ::IO [Int]
	let s1= (head s ): s
	let sm = maximum $ zipWith (-) (tail s1) s1
	print $ maximum [ (fromIntegral sm)/2.0, fromIntegral (head s) , fromIntegral (b1-(last s))]

import Data.List
main = do
  [n, l] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. Data.List.sort. map read. words :: IO [Double]
  print. maximum $ [head a, fromIntegral l - last a] ++ (map (/2).zipWith (-) (tail a) $ a)

import Data.List

answer :: [Integer] ->Int
answer xs =   if length xs == ans && odd (head xs - last xs) then ans +1 else ans
        where ans = snd $ foldl1 (\old@(e,ind) new@(ne, nin)-> if even (e - ne) then old else new ) (zip xs [1..])

readnl ::String-> [Double]
readnl  = fmap read .  words

distance ::[Double]->Double
distance [x] = x
distance (x:xs) =  maximum (zipWith (-) xs (x : xs))  / 2

someFunc :: IO ()
someFunc = do
    fl <- getLine
    let [n,l] = readnl fl
    sl <- getLine
    let coords = sort $ readnl sl
    let min =  head coords
    let max =  last coords
    print $ maximum [min, l-max, distance coords]

main :: IO ()
main = someFunc

import Data.List (sort)
import Text.Printf (printf)

process :: [Int] -> Int -> Double
process xs@(_:ys) l
    | ys == [] = max d0 dl
    | otherwise = maximum [d0, di/2, dl]
    where
        xs' = sort xs
        d0 = fromIntegral $ head xs'
        dl = fromIntegral $ l - last xs'
        di = fromIntegral $ maximum $ zipWith (-) (tail xs') xs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,l] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    printf "%.10f" $ process as l

import Data.List
import Control.Applicative

main :: IO ()
main = interact solve

solve :: String -> String
solve s = show $ maximum [start, end, middle / 2]
    where (_:l:as) = read <$> words  s :: [Double]
          (start:xs) = sort as
          end = l - last (start:xs)
          middle
            |null xs = 0
            |otherwise = maximum $ zipWith (-) xs (start:xs)

import Data.List (sort, foldl')

light :: [Integer] -> Double
light ys = ((/ 2) . fromIntegral) $ fst $ foldl' func (2*x, x) xs
    where (x:xs) = sort ys
          func (m, prev) next = (max m $ next-prev, next)

readInt :: String -> Integer
readInt = read

main = do
    [_, f] <- fmap (map readInt) $ fmap words $ getLine
    second <- fmap (map readInt) $ fmap words $ getLine
    let sorted = sort second
    let l = last sorted
    let t = f + (f - l)*2
    let i = init sorted
    print $ light $ (f:l:t:i)

import Data.List

dist (x:xs) | xs /= [] = (head xs - x) : dist xs
            | otherwise = []

solve l xs = fromIntegral (maximum ds) / 2.0 where
--solve l xs = ys where
    ys = if head xs == 0 then xs else -(head xs) : xs
    zs = if last ys == l then ys else ys ++ [l + (l - last ys)]
    ds = dist zs

main = do
    line <- getLine
    let [n, l] = map read $ words line :: [Int]
    line <- getLine
    let xs = map read $ words line :: [Int]
    print $ solve l (sort xs)

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

split :: Eq a => a -> [a] -> [[a]]
split _    [] = []
split cond xs = x : split cond (drop 1 y) where (x, y) = span (/= cond) xs

process :: Double -> [Double] -> Double
process _ [] = 0.0
process l xs =
  let xs' =
          [ x - y
          | x <- xs
          , y <- xs
          , y /= x && fromJust (elemIndex x xs) - fromJust (elemIndex y xs) == 1
          ]
      xs'' = (minimum xs - 0) : (l - maximum xs) : (map (\x -> x / 2.0) xs')
  in  abs $ (maximum xs'')

main :: IO ()
main = do
  input <- getLine
  lamps <- getLine
  let xs = map (read :: String -> Integer) (split ' ' input)
  let ys     = map (read :: String -> Double) (split ' ' lamps)
  let (_, l) = (xs !! 0, xs !! 1)
  print $ process (fromInteger l) ys

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

process s q = (fromIntegral y ) /2
  where x = maximum $ zipWith (-) (tail q) q
        y = maximum [x, s- maximum q, minimum q]
main=do
     [s,n]<-map read <$> words <$>getLine ::IO [Int]
     q<- (sort <$> map read <$> words <$>getLine )::IO [Int]
     print $ process s q

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

process s q = maximum [(fromIntegral x ) /2 ,fromIntegral(s- maximum q), fromIntegral(minimum q)]
  where x = maximum $ zipWith (-) (tail q) q

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

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

process q = (fromIntegral x ) /2
  where x = maximum $ zipWith (-) (tail q) q
main=do
     [s,n]<-map read <$> words <$>getLine ::IO [Int]
     q<- (sort <$> map read <$> words <$>getLine )::IO [Int]
     print $ process q

import Data.List (group,sort)
readNums = fmap (map read . words) getLine
main = do
  [n,l] <- readNums
  as <- fmap (map ((*2) . head) . group . sort) readNums
  print $ fromIntegral (bsearch l as 0 (2*l)) / 2
bsearch road as l r = go l r
  where go l r | l + 1 == r = r
               | v m = go l m
               | otherwise = go m r
          where m = (l + r) `div` 2
        v r = all (uncurry cover) (zip as' (tail as'))
          where cover a b = b - a <= 2 * r
                as' = (-r) : as ++ [road+r]

import Data.List (group,sort)
readNums = fmap (map read . words) getLine
main = do
  [n,l] <- readNums
  as <- fmap (map ((*2) . head) . group . sort) readNums
  print $ fromIntegral (bsearch as 0 (2*l)) / 2
bsearch as l r = go l r
  where go l r | l + 1 == r = r
               | v m = go l m
               | otherwise = go m r
          where m = (l + r) `div` 2
        v r = all (uncurry cover) (zip as' (tail as'))
          where cover a b = b - a <= 2 * r
                as' = (-r) : as ++ [l+r]

import Data.List
import System.IO

readInput :: Read a => IO [a]
readInput = fmap (map read . words) getLine

getNLine :: Int -> IO [String]
getNLine n
    | n <= 0 = return []
    | otherwise = do
        x <- getLine
        xs <- getNLine $ n-1
        let ret = (x:xs)
        return ret

main :: IO ()
main = do
    n <- readInput :: IO [Int]
    l <- readInput :: IO [Int]
    let xs = reverse (last n : reverse (0 : sort l))
    let dis = zipWith (-) (tail xs)  xs
    print dis
    print $ solve dis
    -- putStrLn xs

solve :: [Int] -> Double
solve li =  max max_dis end_point
    where
        max_dis = fromIntegral (maximum li) / 2
        end_point = fromIntegral (max (head li) (last li))

import Data.List
eps = 1e-8
bin :: (Double -> Bool) -> Double -> Double -> Double
bin f l r
  | r - l < eps   = mid
  | f mid         = bin f l mid
  | otherwise     = bin f mid r
  where mid = (l + r) / 2
isOk :: [Double] -> Double -> Double -> Bool
go :: [(Double, Double)] -> Double -> Double -> Bool
go [] l r = r <= l
go cur l r
  | l < s     = False
  | otherwise = go state (max e l) r
  where (s, e):state = cur
isOk a l d =
  go state 0 l
  where state = Data.List.sort  [(x - d, x + d) | x <- a]
main = do
  [n, l] <- getLine >>= return. map read. words :: IO [Int]
  a <- getLine >>= return. map read. words :: IO [Double]
  let ll = fromIntegral l :: Double in print $ bin (isOk a ll) 0 ll

import Data.List (sort)
import Text.Printf (printf)

process :: [Int] -> Int -> Float
process xs l = maximum [d0, di/2, dl]
    where
        xs' = sort xs
        d0 = fromIntegral $ head xs'
        dl = fromIntegral $ l - last xs'
        di = fromIntegral $ maximum $ zipWith (-) (tail xs') xs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,l] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    printf "%.10f" $ process as l

import Data.List (sort)

process :: [Int] -> Int -> Float
process xs l = maximum [d0, di/2, dl]
    where
        xs' = sort xs
        d0 = fromIntegral $ head xs'
        dl = fromIntegral $ l - last xs'
        di = fromIntegral $ maximum $ zipWith (-) (tail xs') xs'

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,l] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    print $ process as l

import Data.List (sort, foldl')

light :: [Int] -> Double
light ys = ((/ 2) . fromIntegral) $ fst $ foldl' func (2*x, x) xs
    where (x:xs) = sort ys
          func (m, prev) next = (max m $ next-prev, next)

readInt :: String -> Int
readInt = read

main = do
    [_, f] <- fmap (map readInt) $ fmap words $ getLine
    second <- fmap (map readInt) $ fmap words $ getLine
    let l = last second
    let t = f + (f - l)*2
    let i = init second
    print $ light $ (f:l:t:i)

import Data.List (sort, foldl')

light :: [Int] -> Float
light ys = ((/ 2) . fromIntegral) $ fst $ foldl' func (2*x, x) xs
    where (x:xs) = sort ys
          func (m, prev) next = (max m $ next-prev, next)

main = do
    [_, f] <- fmap (map read) $ fmap words $ getLine
    second <- fmap (map read) $ fmap words $ getLine
    print $ light $ (f:second)

import Data.List (sort, foldl')

light :: [Int] -> Double
light ys = ((/ 2) . fromIntegral) $ fst $ foldl' func (2*x, x) xs
    where (x:xs) = sort ys
          func (m, prev) next = (max m $ next-prev, next)

main = do
    [_, f] <- fmap (map read) $ fmap words $ getLine
    second <- fmap (map read) $ fmap words $ getLine
    print $ light $ (f:second)

import Data.List (sort, foldl')

light :: [Int] -> Double
light ys = ((/ 2) . fromIntegral) $ fst $ foldl' func (2*x, x) xs
    where (x:xs) = sort ys
          func (m, prev) next = (max m $ next-prev, next)

readInt :: String -> Int
readInt = read

main = do
    [_, f] <- fmap (map readInt) $ fmap words $ getLine
    second <- fmap (map readInt) $ fmap words $ getLine
    let sorted = sort second
    let l = last sorted
    let t = f + (f - l)*2
    let i = init sorted
    print $ light $ (f:l:t:i)


You are given four integers $$$n$$$, $$$c_0$$$, $$$c_1$$$ and $$$h$$$ and a binary string $$$s$$$ of length $$$n$$$.A binary string is a string consisting of characters $$$0$$$ and $$$1$$$.You can change any character of the string $$$s$$$ (the string should be still binary after the change). You should pay $$$h$$$ coins for each change.After some changes (possibly zero) you want to buy the string. To buy the string you should buy all its characters. To buy the character $$$0$$$ you should pay $$$c_0$$$ coins, to buy the character $$$1$$$ you should pay $$$c_1$$$ coins.Find the minimum number of coins needed to buy the string.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 10$$$) — the number of test cases. Next $$$2t$$$ lines contain descriptions of test cases. The first line of the description of each test case contains four integers $$$n$$$, $$$c_{0}$$$, $$$c_{1}$$$, $$$h$$$ ($$$1 \leq n, c_{0}, c_{1}, h \leq 1000$$$). The second line of the description of each test case contains the binary string $$$s$$$ of length $$$n$$$.

For each test case print a single integer — the minimum number of coins needed to buy the string.

NoteIn the first test case, you can buy all characters and pay $$$3$$$ coins, because both characters $$$0$$$ and $$$1$$$ costs $$$1$$$ coin.In the second test case, you can firstly change $$$2$$$-nd and $$$4$$$-th symbols of the string from $$$1$$$ to $$$0$$$ and pay $$$2$$$ coins for that. Your string will be $$$00000$$$. After that, you can buy the string and pay $$$5 \cdot 10 = 50$$$ coins for that. The total number of coins paid will be $$$2 + 50 = 52$$$.

import Control.Arrow ((>>>))

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

process :: [String] -> [Int]
process [] = []
process (nl:s:xs) = solve c0 c1 h s : process xs
  where
    [_, c0, c1, h] = map read . words $ nl

solve :: Int -> Int -> Int -> String -> Int
solve c0 c1 h s = min c0 (h + c1) * count '0' + min c1 (h + c0) * count '1'
  where
    count d = length (filter (== d) s)

module Main where

{-
calculatePrices :: Int -> [Int]
calculatePrices 0 = []
calculatePrices n = price:(calculatePrices $ n - 1)
    where price = 1
-}

calculatePrices :: Int -> IO ()

calculatePrice :: (Int, Int, Int) -> [Bool] -> Int -> Int

-- Helper functions

extractMeta :: String -> (Int, Int, Int)

convertString :: String -> [Bool]

split :: (Eq a) => a -> [a] -> [[a]]

calculatePrices 0 = return ()
calculatePrices n = do
    meta <- getLine
    string <- getLine
    putStrLn $ show $ calculatePrice (extractMeta meta) (convertString string) 0
    calculatePrices (n - 1)

calculatePrice _ [] acc = acc
calculatePrice (c0, c1, h) (True:ss) acc
    | c1 > h + c0 = calculatePrice (c0, c1, h) ss (acc + h + c0)
    | otherwise = calculatePrice (c0, c1, h) ss (acc + c1)

calculatePrice (c0, c1, h) (False:ss) acc
    | c0 > h + c1 = calculatePrice (c0, c1, h) ss (acc + h + c1)
    | otherwise = calculatePrice (c0, c1, h) ss (acc + c0)

extractMeta source = (read $ tokens !! 1, read $ tokens !! 2, read $ tokens !! 3)
    where tokens = split ' ' source

convertString [] = []
convertString ('0':ss) = False:(convertString ss)
convertString ('1':ss) = True:(convertString ss)

split _ [] = [[]]
split d (c:cs)
    | d == c = []:(split d cs)
    | otherwise = let (h:t) = split d cs in (c:h):t

main = do
    testCases <- getLine
    calculatePrices $ read testCases
    -- foldl (>>) (return ()) (map (putStrLn . show) $ calculatePrices (read testCases :: Int))


This is an interactive problem.We picked an array of whole numbers $$$a_1, a_2, \ldots, a_n$$$ ($$$0 \le a_i \le 10^9$$$) and concealed exactly one zero in it! Your goal is to find the location of this zero, that is, to find $$$i$$$ such that $$$a_i = 0$$$.You are allowed to make several queries to guess the answer. For each query, you can think up three distinct indices $$$i, j, k$$$, and we will tell you the value of $$$\max(a_i, a_j, a_k) - \min(a_i, a_j, a_k)$$$. In other words, we will tell you the difference between the maximum and the minimum number among $$$a_i$$$, $$$a_j$$$ and $$$a_k$$$.You are allowed to make no more than $$$2 \cdot n - 2$$$ queries, and after that you have two tries to guess where the zero is. That is, you have to tell us two numbers $$$i$$$ and $$$j$$$ and you win if $$$a_i = 0$$$ or $$$a_j = 0$$$.Can you guess where we hid the zero?Note that the array in each test case is fixed beforehand and will not change during the game. In other words, the interactor is not adaptive.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 500$$$). Description of the test cases follows. The first and only line of each test case contains an integer $$$n$$$ ($$$4 \le n \le 1000$$$) — the length of the array that we picked. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3000$$$.

NoteArray from sample: $$$[1, 2, 0, 3]$$$.

{-# LANGUAGE BangPatterns #-}
import Data.Bits
import Data.List
import Control.Monad
import System.IO
import qualified System.Exit as Exit

solve4 :: Int -> Int -> Int -> Int -> (Int, Int)
solve4 xa xb xc xd = case maxes of
  [x] -> (x, x)
  [x, y] -> (x, y)
  _ -> error $ "ambiguous: " ++ show maxes
  where
    m = maximum [xa, xb, xc, xd]
    maxes = filter ((/=0) . (.&. maxmap) . (1 `shiftL`)) [0..3]
    maxmap = foldl' (.&.) 0xf $ map snd $ filter ((==m) . fst)
      [ (xa, 0xe::Int)
      , (xb, 0xd)
      , (xc, 0xb)
      , (xd, 0x7)
      ]

query :: Int -> Int -> Int -> IO Int
query i j k = do
  putStrLn $ "? " ++ show (i+1) ++ " " ++ show (j+1) ++ " " ++ show (k+1)
  w <- readLn
  when (w == -1) Exit.exitSuccess
  return w

solve :: Int -> IO ()
solve n = do
  w2 <- query 0 1 2
  phase0 2 w2 3
  where
    phase0 best bestW !i
      | i >= n = phase1 best 9999 (-1) 2
      | otherwise = do
        wi <- query 0 1 i
        if wi > bestW
          then phase0 i wi (i+1)
          else phase0 best bestW (i+1)

    phase1 p best bestW i
      | i >= n = phase2 p best bestW
      | i == p = phase1 p best bestW (i+1)
      | otherwise = do
        wi <- query 0 p i
        if wi > bestW
          then phase1 p i wi (i+1)
          else phase1 p best bestW (i+1)

    phase2 p q w0pq = do
      --putStrLn $ "phase2: " ++ show (p, q)
      w01p <- query 0 1 p
      w01q <- query 0 1 q
      w1pq <- query 1 p q
      let !(ix, iy) = solve4 w1pq w0pq w01q w01p
      let [x, y] = map ([0, 1, p, q]!!) [ix, iy]
      putStrLn $ "! " ++ show (x+1) ++ " " ++ show (y+1)

main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    solve n

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
--import Data.Array.Unboxed

query :: [Int] -> Builder
query li = string7 "? " <> putInts li <> flush

finishSoln :: Int -> Int -> Int -> Int -> SP Builder
finishSoln currw x1 x2 x3 = let
  xs = [x1, x2, x3]
  y : _ = [1..4] \\ xs
  qs = map (flip delete $ y : xs) xs
  in  (foldMap query qs <>) <$> do
  nxs <- replicateM 3 getInt
  let  (z1, _) : (z2, _) : _ = sortOn snd $ zip (y : xs) (currw : nxs)
  pure $ string7 "! " <> putInts [z1, z2] <> flush

solnStep :: Int -> Int -> Int -> Int -> Int -> Int -> SP Builder
solnStep n i currw x1 x2 x3 = if  i > n
  then  finishSoln currw x1 x2 x3
  else  (<>) (query [x2, x3, i] <> query [x1, x3, i]) <$> do
  no1 <- getInt
  no2 <- getInt
  case  ()  of
    () | no1 >= max no2 currw  -> solnStep n (i + 1) no1 x2 x3 i
       | no2 >= max no1 currw  -> solnStep n (i + 1) no2 x1 x3 i
       | otherwise -> solnStep n (i + 1) currw x1 x2 x3

solve :: Int -> SP Builder
solve n = (query [1, 2, 3] <>) <$> do
  initw <- getInt
  solnStep n 4 initw 1 2 3

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    solve n

type SP = State P.ByteString
type S = StateT P.ByteString

dropSpace :: P.ByteString -> P.ByteString
dropSpace = P.dropWhile (<= ' ') -- not exactly right, but close enough

--getNext :: Monad m => S m P.ByteString
--getNext = state $ P.span (> ' ') . dropSpace

getInt :: Monad m => S m Int
getInt = state $ fromJust . P.readInt . dropSpace

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

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

{-# LANGUAGE BangPatterns #-}
import Data.Bits
import Data.List
import Control.Monad
import System.IO
import qualified System.Exit as Exit

solve4 :: Int -> Int -> Int -> Int -> (Int, Int)
solve4 xa xb xc xd = case maxes of
  [x] -> (x, x)
  [x, y] -> (x, y)
  _ -> error $ "ambiguous: " ++ show maxes
  where
    m = maximum [xa, xb, xc, xd]
    maxes = filter ((/=0) . (.&. maxmap) . (1 `shiftL`)) [0..3]
    maxmap = foldl' (.&.) 0xf $ map snd $ filter ((==m) . fst)
      [ (xa, 0xe::Int)
      , (xb, 0xd)
      , (xc, 0xb)
      , (xd, 0x7)
      ]

query :: Int -> Int -> Int -> IO Int
query i j k = do
  putStrLn $ "? " ++ show (i+1) ++ " " ++ show (j+1) ++ " " ++ show (k+1)
  w <- readLn
  when (w == -1) Exit.exitSuccess
  return w

solve :: Int -> IO ()
solve n = do
  w2 <- query 0 1 2
  phase0 2 w2 3
  where
    phase0 best bestW !i
      | i >= n = do
        w2 <- query 0 best 2
        phase1 best 2 w2 3
      | otherwise = do
        wi <- query 0 1 i
        if wi > bestW
          then phase0 i wi (i+1)
          else phase0 best bestW (i+1)

    phase1 p best bestW i
      | i >= n = phase2 p best bestW
      | i == p = phase1 p best bestW (i+1)
      | otherwise = do
        wi <- query 0 p i
        if wi > bestW
          then phase1 p i wi (i+1)
          else phase1 p best bestW (i+1)

    phase2 p q w0pq = do
      --putStrLn $ "phase2: " ++ show (p, q)
      w01p <- query 0 1 p
      w01q <- query 0 1 q
      w1pq <- query 1 p q
      let !(ix, iy) = solve4 w1pq w0pq w01q w01p
      let [x, y] = map ([0, 1, p, q]!!) [ix, iy]
      putStrLn $ "! " ++ show (x+1) ++ " " ++ show (y+1)

main :: IO ()
main = do
  hSetBuffering stdout LineBuffering
  t <- readLn
  replicateM_ t $ do
    n <- readLn
    solve n