This is an interactive problem.Initially, there is an array $$$a = [1, 2, \ldots, n]$$$, where $$$n$$$ is an odd positive integer. The jury has selected $$$\frac{n-1}{2}$$$ disjoint pairs of elements, and then the elements in those pairs are swapped. For example, if $$$a=[1,2,3,4,5]$$$, and the pairs $$$1 \leftrightarrow 4$$$ and $$$3 \leftrightarrow 5$$$ are swapped, then the resulting array is $$$[4, 2, 5, 1, 3]$$$. As a result of these swaps, exactly one element will not change position. You need to find this element.To do this, you can ask several queries. In each query, you can pick two integers $$$l$$$ and $$$r$$$ ($$$1 \leq l \leq r \leq n$$$). In return, you will be given the elements of the subarray $$$[a_l, a_{l + 1}, \dots, a_r]$$$ sorted in increasing order. Find the element which did not change position. You can make at most $$$\mathbf{15}$$$ queries.The array $$$a$$$ is fixed before the interaction and does not change after your queries.Recall that an array $$$b$$$ is a subarray of the array $$$a$$$ if $$$b$$$ can be obtained from $$$a$$$ by deletion of several (possibly, zero or all) elements from the beginning and several (possibly, zero or all) elements from the end.

Each test contains multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 500$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$3 \leq n < 10^4$$$; $$$n$$$ is odd) — the length of the array $$$a$$$. After reading the first line of each test case, you should begin the interaction. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$10^4$$$.

NoteIn the first test, the interaction proceeds as follows. SolutionJuryExplanation$$$\texttt{2}$$$There are 2 test cases.$$$\texttt{5}$$$In the first test case, the hidden array is $$$[4,2,5,1,3]$$$, with length $$$5$$$.$$$\texttt{? 1 4}$$$$$$\texttt{1 2 4 5}$$$The solution requests the subarray $$$[4,2,5,1]$$$ in increasing order, and the jury responds with $$$[1,2,4,5]$$$.$$$\texttt{? 3 5}$$$$$$\texttt{1 3 5}$$$The solution requests the subarray $$$[5,1,3]$$$ in increasing order, and the jury responds with $$$[1,3,5]$$$.$$$\texttt{! 2}$$$The solution has somehow determined that $$$a_2=2$$$, and outputs it. Since the output is correct, the jury continues to the next test case.$$$\texttt{3}$$$In the second test case, the hidden array is $$$[1,3,2]$$$, with length $$$3$$$.$$$\texttt{? 1 1}$$$$$$\texttt{1}$$$The solution requests the number $$$[1]$$$ only, and the jury responds with $$$[1]$$$.$$$\texttt{! 1}$$$The solution has determined that $$$a_1=1$$$, and outputs it. Since the output is correct and there are no more test cases, the jury and the solution exit. Note that the line breaks in the example input and output are for the sake of clarity, and do not occur in the real interaction.

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

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

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

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

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

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

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

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

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

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

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

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

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

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

{- END OF GENERAL -}

query' :: (Int, Int) -> IO [Int]
query' (l, r) = do
    printf "? %d %d\n" l r
    hFlush stdout
    ts <- B8.getLine <&> readIntB8s
    return ts

answer' :: Int -> IO ()
answer' x = do
    printf "! %d\n" x
    hFlush stdout

solve' :: (Int, Int) -> IO Int
solve' (l, r) | l == r = return l
solve' (l, r) = do
    let c = (l + r) `div` 2
    ts <- query' (l, c)
    let cnt = L.length $ L.filter (\t -> l <= t && t <= c) ts
    if odd cnt
        then solve' (l, c)
        else solve' (c + 1, r)

solve :: IO ()
solve = do
    n <- B8.getLine <&> readIntB8
    answer <- solve' (1, n)
    answer' answer

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    replicateM_ t solve


Polycarp has $$$n$$$ coins, the value of the $$$i$$$-th coin is $$$a_i$$$. It is guaranteed that all the values are integer powers of $$$2$$$ (i.e. $$$a_i = 2^d$$$ for some non-negative integer number $$$d$$$).Polycarp wants to know answers on $$$q$$$ queries. The $$$j$$$-th query is described as integer number $$$b_j$$$. The answer to the query is the minimum number of coins that is necessary to obtain the value $$$b_j$$$ using some subset of coins (Polycarp can use only coins he has). If Polycarp can't obtain the value $$$b_j$$$, the answer to the $$$j$$$-th query is -1.The queries are independent (the answer on the query doesn't affect Polycarp's coins).

The first line of the input contains two integers $$$n$$$ and $$$q$$$ ($$$1 \le n, q \le 2 \cdot 10^5$$$) — the number of coins and the number of queries. The second line of the input contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ — values of coins ($$$1 \le a_i \le 2 \cdot 10^9$$$). It is guaranteed that all $$$a_i$$$ are integer powers of $$$2$$$ (i.e. $$$a_i = 2^d$$$ for some non-negative integer number $$$d$$$). The next $$$q$$$ lines contain one integer each. The $$$j$$$-th line contains one integer $$$b_j$$$ — the value of the $$$j$$$-th query ($$$1 \le b_j \le 10^9$$$).

Print $$$q$$$ integers $$$ans_j$$$. The $$$j$$$-th integer must be equal to the answer on the $$$j$$$-th query. If Polycarp can't obtain the value $$$b_j$$$ the answer to the $$$j$$$-th query is -1.

-- Codeforces 1003D

import Data.List

-- list sorted dec.
countCoins' :: [Integer] -> Integer -> Integer -> Integer
countCoins' [] 0 x = x
countCoins' [] _ _ = -1
countCoins' (x:xs) target counter
    | x == target = counter + 1
    | x > target = countCoins' xs target counter
    | otherwise   = countCoins' xs (target-x) (counter+1)

countCoins :: [Integer] -> Integer -> Integer
countCoins list target = countCoins' list target 0

-- list sorted dec. to binary
shrinkList' :: [Integer] -> Integer -> [Integer]
shrinkList' [] 0 = []
shrinkList' [] x = 0:shrinkList' [] (x `div` 2)
shrinkList' list degree = counter:(shrinkList' rest (degree `div` 2))
    where counter = genericLength (takeWhile (==degree) list)
          rest = dropWhile (==degree) list
shrinkList :: [Integer] -> [Integer]
shrinkList list = shrinkList' list (head list)

zipLists :: [Integer] -> [(Integer, Integer)]
zipLists binaryList = pairList
    where numList = [genericLength binaryList-1, genericLength binaryList - 2 .. 0]
          twoList = map (2^) numList
          pairList = zip twoList binaryList

countPair :: [Integer] -> Integer -> Integer
countPair binaryList target = if t /= 0 then -1 else c
    where pairList = zipLists binaryList
          (t, c) = foldl fun (target, 0) pairList
                where fun :: (Integer, Integer) -> (Integer, Integer) -> (Integer, Integer)
                      fun (tar, cou) (twos, num) = (newTar, newCou)
                        where newCou = cou + min num (tar `div` twos)
                              newTar = tar - twos * min num (tar `div` twos)

main :: IO ()
main = do
    n <- getLine
    coins <- getLine
    querys <- getContents
    let coinList = sortBy (flip compare) (map (read :: String -> Integer) (words coins))
    let binaryList = shrinkList coinList
    let queryList = map (read :: String -> Integer) (lines querys)
    mapM_ (print.countPair binaryList) queryList


Alice and Borys are playing tennis.A tennis match consists of games. In each game, one of the players is serving and the other one is receiving.Players serve in turns: after a game where Alice is serving follows a game where Borys is serving, and vice versa.Each game ends with a victory of one of the players. If a game is won by the serving player, it's said that this player holds serve. If a game is won by the receiving player, it's said that this player breaks serve.It is known that Alice won $$$a$$$ games and Borys won $$$b$$$ games during the match. It is unknown who served first and who won which games.Find all values of $$$k$$$ such that exactly $$$k$$$ breaks could happen during the match between Alice and Borys in total.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10^3$$$). Description of the test cases follows. Each of the next $$$t$$$ lines describes one test case and contains two integers $$$a$$$ and $$$b$$$ ($$$0 \le a, b \le 10^5$$$; $$$a + b > 0$$$) — the number of games won by Alice and Borys, respectively. It is guaranteed that the sum of $$$a + b$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case print two lines. In the first line, print a single integer $$$m$$$ ($$$1 \le m \le a + b + 1$$$) — the number of values of $$$k$$$ such that exactly $$$k$$$ breaks could happen during the match. In the second line, print $$$m$$$ distinct integers $$$k_1, k_2, \ldots, k_m$$$ ($$$0 \le k_1 < k_2 < \ldots < k_m \le a + b$$$) — the sought values of $$$k$$$ in increasing order.

NoteIn the first test case, any number of breaks between $$$0$$$ and $$$3$$$ could happen during the match:   Alice holds serve, Borys holds serve, Alice holds serve: $$$0$$$ breaks;  Borys holds serve, Alice holds serve, Alice breaks serve: $$$1$$$ break;  Borys breaks serve, Alice breaks serve, Alice holds serve: $$$2$$$ breaks;  Alice breaks serve, Borys breaks serve, Alice breaks serve: $$$3$$$ breaks. In the second test case, the players could either both hold serves ($$$0$$$ breaks) or both break serves ($$$2$$$ breaks).In the third test case, either $$$2$$$ or $$$3$$$ breaks could happen:   Borys holds serve, Borys breaks serve, Borys holds serve, Borys breaks serve, Borys holds serve: $$$2$$$ breaks;  Borys breaks serve, Borys holds serve, Borys breaks serve, Borys holds serve, Borys breaks serve: $$$3$$$ breaks.

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM, guard)
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Maybe (fromJust)
import Data.List (group, sort)

main :: IO ()
main =
  C.interact $
    runScanner (numberOf testCase)
      >>> map (solve >>> showAns)
      >>> concat
      >>> C.unlines
  where
    showAns xs = [showB $ length xs, C.unwords $ map showB xs]

testCase :: Scanner (Int, Int)
testCase = pair int int

solve :: (Int, Int) -> [Int]
solve (a, b) = uniq . sort $ do
  sa <- [half, tot - half] -- A #serves
  let sb = a + b - sa -- B #serves
  ha <- [0..a] -- A #points by hold
  let ba = a - ha -- A #points by break
  let bb = sa - ha -- B #points by break
  let hb = b - bb -- B #points by hold
  guard $ ba >= 0
  guard $ bb >= 0
  guard $ hb >= 0
  return $ ba + bb
    where
      tot = a + b
      half = tot `div` 2
      uniq = map head . group

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

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

integer :: Scanner Integer
integer = read . C.unpack <$> bstr

double :: Scanner Double
double = read . C.unpack <$> bstr

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

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

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

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

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

(><) = times

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

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

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

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.Semigroup

import Data.List

main :: IO ()
main = (P.words <$> P.getContents >>=) $ evalStateT $ do
  [t] <- getInts 1
  replicateM_ t $ do
    [a, b] <- getInts 2
    let
      needed = abs (a - b) `div` 2
      tot = a + b
      maxv = tot - needed
      ans = [needed, needed + (if  even tot  then  2  else  1) .. maxv]
    putInts [length ans]
    putInts ans

type SP = StateT [P.ByteString]
type SIO = SP IO

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

getInts :: Monad m => Int -> SP m [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> SIO ()
putInts li = let
  spacePrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  lift $ B.hPutBuilder stdout $ case  li  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded spacePrim xs <> B.char7 '\n'


Polycarp is very careful. He even types numeric sequences carefully, unlike his classmates. If he sees a sequence without a space after the comma, with two spaces in a row, or when something else does not look neat, he rushes to correct it. For example, number sequence written like "1,2 ,3,...,   10" will be corrected to "1, 2, 3, ..., 10".In this task you are given a string s, which is composed by a concatination of terms, each of which may be:   a positive integer of an arbitrary length (leading zeroes are not allowed),  a "comma" symbol (","),  a "space" symbol (" "),  "three dots" ("...", that is, exactly three points written one after another, also known as suspension points). Polycarp wants to add and remove spaces in the string s to ensure the following:   each comma is followed by exactly one space (if the comma is the last character in the string, this rule does not apply to it),  each "three dots" term is preceded by exactly one space (if the dots are at the beginning of the string, this rule does not apply to the term),  if two consecutive numbers were separated by spaces only (one or more), then exactly one of them should be left,  there should not be other spaces. Automate Polycarp's work and write a program that will process the given string s.

The input data contains a single string s. Its length is from 1 to 255 characters. The string s does not begin and end with a space. Its content matches the description given above.

Print the string s after it is processed. Your program's output should be exactly the same as the expected answer. It is permissible to end output line with a line-break character, and without it.

import qualified Char as Char

data Gram = Comma | Dots | Num String

parse []                   = []
parse (' ':xs)             = parse xs
parse (',':xs)             = Comma:parse xs
parse ('.':'.':'.':xs)     = Dots:parse xs
parse xs                   = (Num number) : parse rest
    where (number, rest)   = span Char.isDigit xs

unparse []                 = ""
unparse (Comma:[])         = ","
unparse (Comma:Dots:xs)    = ", ..."   ++ unparse xs
unparse (Comma:xs)         = ", "      ++ unparse xs
unparse (Dots:xs)          = " ..."    ++ unparse xs
unparse (Num d1:Num d2:xs) = d1 ++ " " ++ unparse (Num d2:xs)
unparse (Num d:xs)         = d         ++ unparse xs

fix (' ':xs) = xs
fix xs = xs

main :: IO ()
main = do
    seq <- getLine
    putStr (fix (unparse (parse seq)))

import Data.Char
import Data.List

fix [] = []
fix (c:s) | isDigit c = c:fix s
fix (' ':cs)
		| rest /= [] && isDigit (head rest) = ' ':fix rest
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix (',':cs)
		| rest /= [] && head rest /= '.' = ',':' ':fix rest
		| otherwise = ',':fix rest
	where
		rest = dropWhile (== ' ') cs
fix ('.':'.':'.':cs) =
		' ':'.':'.':'.':(fix rest)
	where
		rest = dropWhile (== ' ') cs

solve = dropWhile (== ' ') . fix . dropWhileEnd (== '\n')

main = interact solve

import Data.Char
import Data.List

tokenize :: String -> [String]
tokenize [] = []
tokenize (x:xs)
    | isSpace x = tokenize xs
    | isDigit x = (x:token):tokenize afterNumber
    | x == ',' = [x]:tokenize xs
    | x == '.' = "...":tokenize afterPoints
    where
        (_, afterPoints) = splitAt 2 xs
        (token, afterNumber) = span isDigit xs

fix :: [String] -> String
fix (x:xs) = x ++ fix' xs x
    where
        fix' :: [String] -> String -> String
        fix' [] _ = ""
        fix' (x:xs) p   | (isDigit.head $ x) && (head p == '.') = x ++ fix' xs x
                        | (head x == ',') && (head p == '.') = x ++ fix' xs x
                        | (head x == ',') && (isDigit.head $ p) = x ++ fix' xs x
                        | otherwise = " " ++ x ++ fix' xs x

main = interact $ fix.tokenize

import Char (isDigit)

--------------------------------------------------------------------------------
{-
import HUnit

testInput :: Test
testInput  =  TestList "TestInput"
  [
    Test "#1" $ assertEq "1, 2, 3, ..., 10" $ solve "1,2 ,3,...,     10",
    Test "#2" $ assertEq "1, , , 4 ...5 ... ...6" $ solve "1,,,4...5......6",
    Test "#3" $ assertEq "..., 1, 2, 3, ..." $ solve "...,1,2,3,..."
  ]

testEmpty :: Test
testEmpty  =  TestList "TestEmpty"
  [
    Test "#1" $ assertEq "" $ solve "",
    Test "#2" $ assertEq "" $ solve " "
  ]

testTwoNumbers :: Test
testTwoNumbers  =  Test "TestTwoNumbers" $ assertEq "1 2" $ solve "1 2"

test :: IO ()
test  =  mapM_ run
  [
    testInput,
    testEmpty,
    testTwoNumbers
  ]
-}
--------------------------------------------------------------------------------

data State  =  Start | Number | Comma | Dots | Space

isComma c  =  c == ','
isDot c    =  c == '.'
isSpace c  =  c == ' '

solve :: String -> String
solve s  =  solve' Start s
  where
    solve' _ []  =  []
    solve' Start (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Start cs
    solve' Number (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Space cs
    solve' Comma (c:cs)
      | isDigit c  =  ' ' : c : solve' Number cs
      | isComma c  =  ' ' : c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Comma cs
    solve' Dots (c:cs)
      | isDigit c  =  c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Dots cs
    solve' Space (c:cs)
      | isDigit c  =  ' ' : c : solve' Number cs
      | isComma c  =  c : solve' Comma cs
      | isDot c    =  ' ' : c : c : c : solve' Dots (drop 2 cs)
      | isSpace c  =  solve' Space cs

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

import Data.Char

main = getLine >>= putStrLn . solve

solve = put . get

get :: String -> [String]
put :: [String] -> String

get "" = []
get (' ':xs) = get xs
get (',':xs) = "," : get xs
get ('.':'.':'.':xs) = "..." : get xs
get xs = let (as,bs) = break (not . isDigit) xs
         in as : get bs

put xs = let
  leftSp = map (=="...") xs
  rightSp = map (==",") xs
  num = map (isDigit . head) xs
  sp1 = zipWith (||) (tail leftSp) rightSp
  sp2 = zipWith (&&) num (tail num)
  in concat $ zipWith (\x flag -> if flag then " "++x else x) xs $
    False : zipWith (||) sp1 sp2

import Data.Char
data L = Spac | Dots | Comma | Num [Char] deriving Eq
instance Show L where
    show Spac = " "
    show Dots = "..."
    show Comma = ","
    show (Num s) = reverse s
sc (s:ss) (Num n:rs) | s `elem` ['0'..'9'] = sc ss (Num (s:n):rs)
sc (s:ss) rs | s `elem` ['0'..'9'] = sc ss (Num [s]:rs)
sc (' ':ss) rs = sc ss (Spac:rs)
sc (',':ss) rs = sc ss (Comma:rs)
sc ('.':'.':'.':ss) rs = sc ss (Dots:rs)
sc [] r = reverse $ filter (/= Spac) r
f n1@(Num _) n2@(Num _) = show n1 ++ " "
f a Dots = show a ++ " "
f Comma _ = show Comma ++ " "
f a _ = show a
poly (s1:s2:ss) = f s1 s2 ++ poly (s2:ss)
poly [s1] = show s1
poly [] = []
main = do
    l <- getLine
    putStrLn $ poly $ sc l []

import Data.Char
import Control.Applicative

data Token = IntToken Integer | Ellipsis | Comma deriving Show

digitToInteger = toInteger . digitToInt

tokenize [] = []
tokenize ('.':'.':'.':t) = Ellipsis : tokenize t
tokenize (',':t) = Comma:tokenize t
tokenize (' ':t) = tokenize t
tokenize (digit:t) = tokenize' t (digitToInteger digit)
    where
        tokenize' (dig:t) i | isDigit dig = tokenize' t (i*10 + digitToInteger dig)
        tokenize' list i = IntToken i : tokenize list

printToken (IntToken i) = show i
printToken Ellipsis = "..."
printToken Comma = ","

fancyPrint (Ellipsis : rest) = "..." ++ fancyPrint' rest
fancyPrint list = fancyPrint' list

fancyPrint' [] = ""
fancyPrint' [Comma] = ","
fancyPrint' (Comma:Ellipsis:rest) = ", ..." ++ fancyPrint' rest
fancyPrint' (Comma:rest@(_:_)) = ", " ++ fancyPrint' rest
fancyPrint' (IntToken i : rest@(IntToken _ : _)) = show i ++ " " ++ fancyPrint' rest
fancyPrint' (IntToken i : rest) = show i ++ fancyPrint' rest
fancyPrint' (Ellipsis : rest) = " ..." ++ fancyPrint' rest

solve = fancyPrint . tokenize

main = putStrLn =<< solve <$> getLine

import Data.Char
import Data.List

fix [] = []
fix (c:s) | isDigit c = c:(fix s)
fix (' ':cs)
		| rest /= [] && isDigit (head rest) = ' ':(fix rest)
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix (',':cs)
		| rest /= [] && head rest /= '.' = ',':' ':(fix rest)
		| otherwise = fix rest
	where
		rest = dropWhile (== ' ') cs
fix ('.':'.':'.':cs) =
		' ':'.':'.':'.':(fix rest)
	where
		rest = dropWhile (== ' ') cs

solve = dropWhile (== ' ') . fix . dropWhileEnd (== '\n')

main = interact solve

import Data.Char

main = getLine >>= putStrLn . solve

solve = put . get

get :: String -> [String]
put :: [String] -> String

get "" = []
get (' ':xs) = get xs
get (',':xs) = "," : get xs
get ('.':'.':'.':xs) = "..." : get xs
get xs = let (as,bs) = break (not . isDigit) xs
         in as : get bs

put xs = let
  leftSp = map (=="...") xs
  rightSp = map (==",") xs
  sp = False : zipWith (||) (tail leftSp) rightSp
  in concat $ zipWith (\flag x -> if flag then " "++x else x) sp xs

import Data.Char
poly (r1:' ':r2:rs) s | not (isDigit r1 && isDigit r2) && not (r2 == ',') = poly (r1:r2:rs) s
poly (' ':' ':r':rs) ss | isDigit r' = poly (' ':r':rs) ss
poly r@(' ':r':rs) (s:ss) | isDigit r' = poly (s:r) ss
poly r@(' ':',':rs) (' ':ss) = poly r ss
poly r@(' ':',':rs) (s:ss) = poly (s:r) ss
poly (' ':rs) ss = poly rs ss
poly r@(',':rs) (s:ss) | s /= ' ' = poly (' ':r) (s:ss)
poly r@(',':rs) [] = r
poly r [] = r
poly r@(r':rs) ('.':'.':'.':ss) | r' /= ' ' = poly ('.':'.':'.':' ':r) ss
poly r@(r':rs) ('.':'.':'.':ss) | r' == ' ' = poly ('.':'.':'.':r) ss
poly r (s:ss) = poly (s:r) ss
main = do
    l <- getLine
    putStrLn $ reverse $ poly [] l


An array $$$a_1, a_2, \ldots, a_n$$$ is good if and only if for every subsegment $$$1 \leq l \leq r \leq n$$$, the following holds: $$$a_l + a_{l + 1} + \ldots + a_r = \frac{1}{2}(a_l + a_r) \cdot (r - l + 1)$$$. You are given an array of integers $$$a_1, a_2, \ldots, a_n$$$. In one operation, you can replace any one element of this array with any real number. Find the minimum number of operations you need to make this array good.

The first line of input contains one integer $$$t$$$ ($$$1 \leq t \leq 100$$$): the number of test cases. Each of the next $$$t$$$ lines contains the description of a test case. In the first line you are given one integer $$$n$$$ ($$$1 \leq n \leq 70$$$): the number of integers in the array. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$-100 \leq a_i \leq 100$$$): the initial array.

For each test case, print one integer: the minimum number of elements that you need to replace to make the given array good.

NoteIn the first test case, the array is good already.In the second test case, one of the possible good arrays is $$$[1, 1, \underline{1}, \underline{1}]$$$ (replaced elements are underlined).In the third test case, the array is good already.In the fourth test case, one of the possible good arrays is $$$[\underline{-2.5}, -2, \underline{-1.5}, -1, \underline{-0.5}, 0]$$$.

import Control.Monad
import Data.Maybe
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.ByteString.Builder
import System.IO

parseInt :: C.ByteString -> Int
parseInt = fst . fromJust . C.readInt

getInts :: IO [Int]
getInts = map parseInt . C.words <$> C.getLine

data Frac = Frac Integer Integer
  deriving (Eq)
mkFrac :: Integer -> Integer -> Frac
mkFrac p q
  | p == 0 = Frac 0 1
  | q' < 0 = Frac (-p') (-q')
  | otherwise = Frac p' q'
  where (p', q', g) = (div p g, div q g, gcd p q)
instance Num Frac where
  (Frac p1 q1) + (Frac p2 q2) = mkFrac (p1 * q2 + p2 * q1) (q1 * q2)
  (Frac p1 q1) - (Frac p2 q2) = mkFrac (p1 * q2 - p2 * q1) (q1 * q2)
  (Frac p1 q1) * (Frac p2 q2) = mkFrac (p1 * p2) (q1 * q2)
  negate (Frac p q) = Frac (negate p) q
  abs (Frac p q) = Frac (abs p) q
  signum (Frac p _) = Frac (signum p) 1
  fromInteger n = Frac n 1
instance Ord Frac where
  compare (Frac p1 q1) (Frac p2 q2) = compare (p1 * q2) (p2 * q1)
instance Show Frac where
  show (Frac p q) = show p ++ "/" ++ show q

main :: IO ()
main = do
  [t] <- getInts
  output <- fmap mconcat $ replicateM t $ do
    [n] <- getInts
    as <- zip [1..n] <$> getInts
    let calc p q = mkFrac (toInteger p) (toInteger q)
        pairs = [(calc (x1 * y2 - x2 * y1) (x1 - x2), calc (y2 - y1) (x2 - x1)) | (x1, y1) <- as, (x2, y2) <- as, x1 < x2]
        num = maximum $ (0:) $ map length $ group $ sort pairs
        result = floor $ (1 + sqrt (8 * fromIntegral num + 1 :: Double)) / 2 + 0.5
    return $ intDec (n - result) `mappend` charUtf8 '\n'
  hPutBuilder stdout output

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] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n] <- getInts 1
    aLi <- getInts n
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi

      score i = let
        ratio x y = toRational x / toRational y
        slopes = [ratio (a ! j - a ! i) (j - i) | j <- [i + 1 .. n]]
        opts = map length $ group $ sort slopes
        in  n - 1 - foldl' max 0 opts
    pure $ putInts [foldl' min n $ map score [1 .. n]]

type SP = State [P.ByteString]

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

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

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

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


Yaroslav, Andrey and Roman can play cubes for hours and hours. But the game is for three, so when Roman doesn't show up, Yaroslav and Andrey play another game. Roman leaves a word for each of them. Each word consists of 2·n binary characters "0" or "1". After that the players start moving in turns. Yaroslav moves first. During a move, a player must choose an integer from 1 to 2·n, which hasn't been chosen by anybody up to that moment. Then the player takes a piece of paper and writes out the corresponding character from his string. Let's represent Yaroslav's word as s = s1s2... s2n. Similarly, let's represent Andrey's word as t = t1t2... t2n. Then, if Yaroslav choose number k during his move, then he is going to write out character sk on the piece of paper. Similarly, if Andrey choose number r during his move, then he is going to write out character tr on the piece of paper.The game finishes when no player can make a move. After the game is over, Yaroslav makes some integer from the characters written on his piece of paper (Yaroslav can arrange these characters as he wants). Andrey does the same. The resulting numbers can contain leading zeroes. The person with the largest number wins. If the numbers are equal, the game ends with a draw.You are given two strings s and t. Determine the outcome of the game provided that Yaroslav and Andrey play optimally well.

The first line contains integer n (1 ≤ n ≤ 106). The second line contains string s — Yaroslav's word. The third line contains string t — Andrey's word. It is guaranteed that both words consist of 2·n characters "0" and "1".

Print "First", if both players play optimally well and Yaroslav wins. If Andrey wins, print "Second" and if the game ends with a draw, print "Draw". Print the words without the quotes.

data Winner = First | Second

main = do
    _ <-  getLine
    ss <- getLine
    ts <- getLine
    let sts = zip ss ts
    putStrLn.answer $ foldl game (First,0,0) $ both1 sts ++ either1 sts

both1 = filter (\(a,b) -> a == b && a =='1')
either1 = filter (\(a,b) -> a /= b)

game (First,pf,ps) ('1','1') = (Second,pf+1,ps)
game (First,pf,ps) ('1','0') = (Second,pf+1,ps)
game (First,pf,ps) ('0','1') = (Second,pf,ps)
game (Second,pf,ps) ('1','1') = (First,pf,ps+1)
game (Second,pf,ps) ('1','0') = (First,pf,ps)
game (Second,pf,ps) ('0','1') = (First,pf,ps+1)

answer (_,a,b)
    | a == b = "Draw"
    | a > b = "First"
    | a < b = "Second"

count::Eq a=>[a]->a->Int
count c d=length $ filter (==d) c

gao::Int->Int->Int
gao a b  | (b `mod` 2)==0 = 0
		 | (a `mod` 2)==0 = 1
		 | otherwise = -1

main::IO()
main = do
	n<-getLine
	aa<-getLine
	bb<-getLine
	let
		game=zip aa bb
		num = count game ('1','1')
		num1 = ( count game ('1','0') ) + ( count game ('0','1') )
		ans = (count aa '1') + ( num `mod` 2 )*2 - (count bb '1') + (gao num num1)
	if ans>0
	then
		putStrLn "First"
	else if ans==0
	then
		putStrLn "Draw"
	else putStrLn "Second"

count::Eq a=>[a]->a->Int
count c d=length $ filter (==d) c

gao::Int->Int->Int
gao a b  | (b `mod` 2)==0 = 0
		 | (a `mod` 2)==0 = 1
		 | otherwise = -1

main::IO()
main = do
	n<-getLine
	aa<-getLine
	bb<-getLine
	let
		game=zip aa bb
		num = count game ('1','1')
		num1 = ( count game ('1','0') ) + ( count game ('0','1') )
		--奇数 + 奇数 -1  偶数+奇数 + 1
		ans = (count aa '1') + ( num `mod` 2 )*2 - (count bb '1') + (gao num num1)
	if ans>0
	then
		putStrLn "First"
	else if ans==0
	then
		putStrLn "Draw"
	else putStrLn "Second"


Polycarp loves not only to take pictures, but also to show his photos to friends. On his personal website he has recently installed a widget that can display n photos with the scroll option. At each moment of time the widget displays exactly one photograph with the option showing the previous/next one. From the first photo, you can switch to the second one or to the n-th one, from the second photo you can switch to the third one or to the first one, etc. Thus, navigation is performed in a cycle.Polycarp's collection consists of m photo albums, the i-th album contains ai photos. Polycarp wants to choose n photos and put them on a new widget. To make watching the photos interesting to the visitors, he is going to post pictures so that no two photos from one album were neighboring (each photo will have exactly two neighbors, the first photo's neighbors are the second and the n-th one).Help Polycarp compile a photo gallery. Select n photos from his collection and put them in such order that no two photos from one album went one after the other.

The first line contains two integers n and m (3 ≤ n ≤ 1000, 1 ≤ m ≤ 40), where n is the number of photos on the widget, and m is the number of albums. The second line contains m integers a1, a2, ..., am (1 ≤ ai ≤ 1000), where ai is the number of photos in the i-th album.

Print the single number -1 if there is no solution. Otherwise, print n numbers t1, t2, ..., tn, where ti represents the number of the album of the i-th picture in the widget. The albums are numbered from 1 in the order of their appearance in the input. If there are several solutions, print any of them.

import Data.List (sortBy)
import Data.Array.Unboxed
import Control.Monad (guard)
import Control.Applicative ((<|>))
import qualified Data.IntMap as M
getEl m e = M.update (\x -> if x == 1 then Nothing else Just (x - 1)) e m
main = do
    [n, m] <- (map read . words) `fmap` getLine
    let f m a i | i < n = let
                f' | i == n - 1 = (`notElem` [a!0, a!(n-2)])
                   | otherwise = (/= a!(i-1)) in
                        foldl (\c k -> c <|> f (getEl m k)
                            (a // [(i, k)]) (i+1))
                            Nothing $ filter f' $ map fst $
                            sortBy (\(_, a) (_, b) -> compare b a) $ M.assocs m
                | otherwise = Just (elems a)
    t' <- (map read . words) `fmap` getLine
    let t = M.fromList $ zip [1..] t'
    let r = do
        let s = sum t'
            mt = maximum t'
        guard ((s - mt) >= n `div` 2)
        guard (s >= n)
        f (getEl t 1) (array (0, n-1) [(0,1)]:: UArray Int Int) 1
    putStrLn $ case r of
        Nothing -> "-1"
        Just l -> unwords $ map show $ l

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt ((length t + 1) `div` 2) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res

import List
g 0 _=Just[]
g n[]=Nothing
g n(h:t)=fmap(m:)(g(n-m)t)where m=min h n
i([],t2)=t2
i(t1,[])=t1
i((a:x),(b:y))=a:b:i(x,y)
c t=i$splitAt((length t+1)`div`2)t
s[[n,_],t]=g n$map(min$n`div`2)t
main=interact$maybe"-1"(unwords.map show.c.(>>=uncurry replicate).sort.(`zip`[1..])).s.map(map read.words).lines

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt (length t `div` 2) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res

import Control.Applicative
import Control.Monad
import Data.Monoid
import Data.List
import Data.Ord

getInts = map read . words <$> getLine

collect 0 _ = Just []
collect n [] = Nothing
collect n (h:t) | h>=n = Just [n]
collect n (h:t) = (h:) <$> collect (n-h) t

interleave [] t2 = t2
interleave t1 [] = t1
interleave (h1:t1) (h2:t2) = h1:h2:interleave t1 t2

circle t = let (t1, t2) = splitAt (length t `div` 2 + 1) t in interleave t1 t2

unfold [] = []
unfold ((i,n):t) = replicate n i ++ unfold t

main = do
    [n,_] <- getInts
    t <- getInts
    let t' = map (min (n `div` 2)) t
        t'' = collect n t'
    case t'' of
        Nothing -> putStrLn "-1"
        Just t'' -> do
            let
                t''' = zip [1..] t''
                t'''' = unfold $ sortBy (comparing snd) t'''
                res = map show $ circle t''''
            putStrLn $ concat $ intersperse " " $ res


The Cereal Guy's friend Serial Guy likes to watch soap operas. An episode is about to start, and he hasn't washed his plate yet. But he decided to at least put in under the tap to be filled with water. The plate can be represented by a parallelepiped k × n × m, that is, it has k layers (the first layer is the upper one), each of which is a rectangle n × m with empty squares ('.') and obstacles ('#'). The water can only be present in the empty squares. The tap is positioned above the square (x, y) of the first layer, it is guaranteed that this square is empty. Every minute a cubical unit of water falls into the plate. Find out in how many minutes the Serial Guy should unglue himself from the soap opera and turn the water off for it not to overfill the plate. That is, you should find the moment of time when the plate is absolutely full and is going to be overfilled in the next moment.Note: the water fills all the area within reach (see sample 4). Water flows in each of the 6 directions, through faces of 1 × 1 × 1 cubes.

The first line contains three numbers k, n, m (1 ≤ k, n, m ≤ 10) which are the sizes of the plate. Then follow k rectangles consisting of n lines each containing m characters '.' or '#', which represents the "layers" of the plate in the order from the top to the bottom. The rectangles are separated by empty lines (see the samples). The last line contains x and y (1 ≤ x ≤ n, 1 ≤ y ≤ m) which are the tap's coordinates. x is the number of the line and y is the number of the column. Lines of each layer are numbered from left to right by the integers from 1 to n, columns of each layer are numbered from top to bottom by the integers from 1 to m.

The answer should contain a single number, showing in how many minutes the plate will be filled.

module Main where

import Control.Monad
import Control.Monad.ST
import Data.List
import Data.Array.Unboxed
import Data.Array.ST

fillWater :: Int -> Int -> UArray (Int,Int,Int) Bool -> Int
fillWater x y plate = runST $ do
    let (_, (u,v,w)) = bounds plate
    visited <- newArray (bounds plate) False :: ST s (STUArray s (Int,Int,Int) Bool)

    let dfs x y z =
            if x < 1 || y < 1 || z < 1 || x > u || y > v || z > w || plate ! (x,y,z)
                then return 0
                else do
                    ptVisited <- readArray visited (x,y,z)
                    if ptVisited
                        then return 0
                        else do
                            writeArray visited (x,y,z) True
                            ( (1+) . sum ) `liftM` mapM (\(dx,dy,dz) -> dfs (x+dx) (y+dy) (z+dz))
                                [(1,0,0)
                                ,(-1,0,0)
                                ,(0,1,0)
                                ,(0,-1,0)
                                ,(0,0,1)
                                ,(0,0,-1)]

    dfs 1 x y

main = do
    [w,u,v] <- ( map read . words ) `liftM` getLine
    plateInput <- join `liftM` replicateM w ( do
        getLine
        join `liftM` replicateM u ( do
            row <- getLine
            return $ map (=='#') row
            )
        )
    let plate = listArray ((1,1,1),(w,u,v)) plateInput :: UArray (Int,Int,Int) Bool

    getLine
    [x,y] <- ( map read . words ) `liftM` getLine

    --putStrLn $ show plate
    putStrLn $ show $ fillWater x y plate

import Data.Array.IO
main = do
    [k, n, m] <- map read `fmap` (words `fmap` getLine)
    ar <- concat `fmap` (mapM (\_ -> do
        getLine
        concat `fmap` (mapM (\_ -> (take m) `fmap` getLine) [1..n])) [1..k])
    getLine
    [x,y] <- map read `fmap` (words `fmap` getLine)
    arr <- newListArray ((1,1,1), (k, n, m)) ar:: IO (IOUArray (Int, Int, Int) Char)
    let neibs (i1, i2, i3) = filter (\(i1, i2, i3) -> i1 > 0 && i1 <= k && i2 > 0 &&
            i2 <=n && i3 > 0 && i3 <= m) [(i1+1,i2, i3), (i1-1, i2, i3),
            (i1, i2 - 1, i3), (i1, i2 + 1, i3), (i1, i2, i3-1), (i1, i2, i3+1)]
        search counter [] = return counter
        search counter (s:ss) = readArray arr s >>= \c -> if c == '#'
                then search counter ss else (do
                writeArray arr s '#'
                ns <- (map fst . filter ((=='.').snd)) `fmap` (mapM (\s' -> readArray arr s' >>=
                    \c -> return (s', c)) (neibs s))
                search (counter + 1) (ss ++ ns))
    cnt <- search 0 [(1,x,y)]
    print cnt

import Data.Set as S
main = interact solve
solve input = output where
  inputs = lines input
  [k, n, m] = Prelude.map (read:: String -> Int) $ words $ head inputs
  s = fromList [(i,j,l)|i<-[0..k-1], j<-[0..n-1], l<-[0..m-1],
    (init $ drop 2 inputs)!!(i*(n+1)+j)!!l == '.']
  [x, y] = Prelude.map (read:: String -> Int) $ words $ last inputs
  output = show $ size s - (size $ f s [(0,x-1,y-1)])
  f :: Set (Int,Int,Int) -> [(Int,Int,Int)] -> Set (Int,Int,Int)
  f x [] = x
  f x ((i,j,l):xs) = if member (i,j,l) x
    then f (delete (i,j,l) x) (xs ++ [(i-1,j,l),(i+1,j,l),(i,j-1,l),(i,j+1,l),(i,j,l-1),(i,j,l+1)])
    else f x xs


You are given a string A. Find a string B, where B is a palindrome and A is a subsequence of B.A subsequence of a string is a string that can be derived from it by deleting some (not necessarily consecutive) characters without changing the order of the remaining characters. For example, "cotst" is a subsequence of "contest".A palindrome is a string that reads the same forward or backward.The length of string B should be at most 104. It is guaranteed that there always exists such string.You do not need to find the shortest answer, the only restriction is that the length of string B should not exceed 104.

First line contains a string A (1 ≤ |A| ≤ 103) consisting of lowercase Latin letters, where |A| is a length of A.

Output single line containing B consisting of only lowercase Latin letters. You do not need to find the shortest answer, the only restriction is that the length of string B should not exceed 104. If there are many possible B, print any of them.

NoteIn the first example, "aba" is a subsequence of "aba" which is a palindrome.In the second example, "ab" is a subsequence of "aabaa" which is a palindrome.

main = getLine >>= \s -> putStrLn $ s ++ (reverse s)

main = do
       e<-getLine
       putStrLn $ e ++ (reverse e)

main = do
    line <- getLine
    putStrLn ((line) ++ (reverse line))

import Control.Applicative
import Data.List

main :: IO ()
main = do
    a <- getLine
    putStrLn $ a ++ reverse a

main = getLine >>= putStrLn . (\s -> s ++ reverse s)

main = do
    s <- getLine
    putStrLn (s ++ reverse s)

module Main where

main = do
  l <- getLine
  putStr $ l ++ reverse l ++ ['\n']

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

main = do
		n<- getLine
		putStrLn $ n ++ reverse n

process :: String -> String
process s = s ++ (reverse s)

main :: IO ()
main = do
    s <- getLine
    putStrLn $ process s

main = do
	line <- getLine
	putStr line
	putStr $ reverse line


There are n psychos standing in a line. Each psycho is assigned a unique integer from 1 to n. At each step every psycho who has an id greater than the psycho to his right (if exists) kills his right neighbor in the line. Note that a psycho might kill and get killed at the same step. You're given the initial arrangement of the psychos in the line. Calculate how many steps are needed to the moment of time such, that nobody kills his neighbor after that moment. Look notes to understand the statement more precise.

The first line of input contains integer n denoting the number of psychos, (1 ≤ n ≤ 105). In the second line there will be a list of n space separated distinct integers each in range 1 to n, inclusive — ids of the psychos in the line from left to right.

Print the number of steps, so that the line remains the same afterward.

NoteIn the first sample line of the psychos transforms as follows: [10 9 7 8 6 5 3 4 2 1]  →  [10 8 4]  →  [10]. So, there are two steps.

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections #-}

import Control.Applicative
import qualified Data.ByteString.Char8 as B
import Data.Sequence ((<|),(|>),(><),ViewL(..),ViewR(..),viewl,viewr)
import qualified Data.Sequence as Seq

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

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

data SeqUpDown = Up (Seq.Seq Int)
               | Down (Seq.Seq Int)

solve :: [SeqUpDown] -> Int
solve xss = go 0 xss
   where
     go !res [Up _] = res
     go !res xss = go (res+1) $ merge $ kill xss

kill :: [SeqUpDown] -> [SeqUpDown]
kill (Down xs:xss)|(x:<_)<-viewl xs = Up (Seq.singleton x) : kill xss
kill (xs:xss) = xs : kill xss
kill [] = []

merge :: [SeqUpDown] -> [SeqUpDown]
merge (Up xs:Up ys:rest)
  | xr < yl = merge (Up (xs><ys):rest)
  | Seq.null nxs && Seq.null nys = merge (Down (xs><ys):rest)
  | Seq.null nxs = Down (xs|>yl) : merge (Up nys:rest)
  | Seq.null nys = Up nxs : merge (Down (xr<|ys):rest)
  | otherwise = Up nxs : Down (xr<|yl<|Seq.empty) : merge (Up nys:rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Up xs:Down ys:rest)
  | xr < yl = Up xs : merge (Down ys:rest)
  | Seq.null nxs = merge (Down (xr<|ys):rest)
  | otherwise = Up nxs : merge (Down (xr<|ys):rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Down xs:Up ys:rest)
  | xr < yl = Down xs : merge (Up ys:rest)
  | Seq.null nys = merge (Down (xs|>yl):rest)
  | otherwise = Down (xs|>yl) : merge (Up nys:rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys
merge (Down xs:Down ys:rest)
  | xr < yl = Down xs : merge (Down ys:rest)
  | otherwise = merge (Down (xs><ys):rest)
   where
     (nxs:>xr) = viewr xs
     (yl:<nys) = viewl ys

merge xss = xss

module Main where

type Node = (Int, Int)

main :: IO()
main = do
          n <- getLine
          line <- getLine
          let ls = reverse $ map (read) $ words line
          putStrLn $ show $ solve ls []

solve :: [Int] -> [Node] -> Int
solve [] _ = 0
solve (x:xs) stack = max (ans) (solve xs ((x, ans):nstack))
                     where nstack = dropWhile (\y -> x > fst(y)) stack
                           ans = calc (map (snd) (takeWhile (\y -> x > fst(y)) stack)) 0

calc :: [Int] -> Int -> Int
calc [] mx = mx
calc (x:xs) mx = calc xs (max (mx + 1) x)

module Main where

main :: IO()
main = do
          n <- readLn
          line <- getLine
          let ls = reverse $ map (read) $ words line
          putStrLn $ show $ solve ls [] n

solve :: [Int] -> [Int] -> Int -> Int
solve [] _ _ = 0
solve (x:xs) stack n = max ((length stack) - (length nstack)) (solve xs (x:nstack) (n - 1))
                       where nstack = dropWhile (x>) stack


Having watched the last Harry Potter film, little Gerald also decided to practice magic. He found in his father's magical book a spell that turns any number in the sum of its digits. At the moment Gerald learned that, he came across a number n. How many times can Gerald put a spell on it until the number becomes one-digit?

The first line contains the only integer n (0 ≤ n ≤ 10100000). It is guaranteed that n doesn't contain any leading zeroes.

Print the number of times a number can be replaced by the sum of its digits until it only contains one digit.

NoteIn the first sample the number already is one-digit — Herald can't cast a spell.The second test contains number 10. After one casting of a spell it becomes 1, and here the process is completed. Thus, Gerald can only cast the spell once.The third test contains number 991. As one casts a spell the following transformations take place: 991 → 19 → 10 → 1. After three transformations the number becomes one-digit.

import Data.Char

main = interact $ (++"\n") . show . solve . head . lines

digitsum :: String -> Int
digitsum = sum . map ((subtract $ ord '0') . ord)

solve :: String -> Int
solve [x] = 0
solve xs = 1 + (solve . show . digitsum) xs

import Data.Char

main = do getLine >>= print . length . takeWhile ((>1) . length) . iterate (show . sum . map digitToInt)

{-
  sum of digits
-}
module Main where

import Data.List
import Data.Char

addDigits :: String -> String
addDigits digits = show $ foldl (\acc c -> acc + digitToInt c) 0 digits

stringTrim :: String -> String
stringTrim = filter (not . isSpace)

main :: IO ()
main = interact (show . iterate 0 . stringTrim )
       where iterate cnt digits = case length digits of
                                    0 -> cnt
                                    1 -> cnt
                                    _ -> iterate (cnt+1) $ addDigits digits

module Main where

import Char

main = do
    inputN <- getLine
    let n = read inputN
    putStrLn $ show $ process n

process :: Integer -> Int
process n =
    if n<10
        then 0
        else (+) 1 $ process $ foldl ( \a b -> a + fromIntegral ( ord b ) - 48 ) 0 $ show n

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

sumDigit :: C.ByteString -> Int
sumDigit x
	| x == C.empty = 0
	| otherwise = sumDigit (C.tail x) + (digitToInt (C.head x))

solve :: C.ByteString -> Int
solve x
	| C.length x == 1 = 0
	| otherwise = solve ((C.pack . show . sumDigit) x) + 1

main = getLine >>= putStrLn . show . solve . C.pack

import Data.Char
solve :: String -> Int
solve [x] = 0
solve xs
    | ds < 10 = 1
    | otherwise = 1 + solve (show ds)
    where ds = sum . map digitToInt $ xs
main = interact $ show . solve . head . lines

--import CPUTime
import Char

bigTest :: String
bigTest = replicate 100000 '9'

next :: Int -> Int
next 0 = 0
next n = mod n 10 + next (div n 10)

solve :: Int -> Int
solve 0 = 0
solve n = solve' n 1
  where
    solve' n m
      |  n  <  10  =  m
      | otherwise  =  solve' (next n) (m + 1)

readDigits :: IO Int
readDigits = readDigits' (0, 0)
  where
    readDigits' (m, n) = do
      c <- getChar
      if (isDigit c) then readDigits' (m + digitToInt c, n + 1) else if (n == 1) then return 0 else return m

main = do
--  n <- readLn
--  t0 <- getCPUTime
--  let n = read bigTest
  n <- readDigits
  print $ solve n
--  t1 <- getCPUTime
--  putStr "Time = "
--  print (fromIntegral (t1 - t0) * 1e-12)

g s = if length s == 1 then 0
      else (succ . g . show . sum . (map (\x -> read [x]::Int))) s
main = putStrLn =<< fmap (show . g) getLine

import Data.Char

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
	| n<=9 = 1
	| otherwise = 1 + ans (dsum n)

main = do
	s <- map (\x -> ord x - ord '0') `fmap` getLine
	putStrLn $ show $ if length s==1 then 0 else ans (sum s)

import Data.Char
import Data.List

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
	| n<=9 = 1
	| otherwise = 1 + ans (dsum n)

main = do
	s <- map (\x -> ord x - ord '0') `fmap` getLine
	let sm = sum s
	let n = length s
	putStrLn $ show $ if n==1 then 0 else ans sm

import Data.Char
main = print . flip solve 0 =<< getLine
solve [_] a = a
solve ns a = solve (show . sum $ map digitToInt ns) $! a + 1

import Data.Char as Char

g :: String -> Int
g [_] = 0
g str = 1 + (g $ show $ sum $ map Char.digitToInt str)

main :: IO()
main = do
  str <- getLine
  print $ g str

{-# LANGUAGE BangPatterns, ViewPatterns, PatternGuards, ScopedTypeVariables #-}

import Data.Char

spell :: Integer -> Integer
spell = sum . map (toInteger . digitToInt) . show

solve :: Integer -> Integer
solve = loop 0
 where
  loop !n !x = case (x `quotRem` 10) of
    (q, r) | q == 0     -> n
           | otherwise  -> loop (n + 1) (spell x)

main :: IO ()
main = readLn >>= print . solve

import Data.Char (ord)
import Data.List (foldl')
default (Int)
main = do
    n <- getLine
    if length n == 1 then print 0 else do
        let f s n | n < 10 = n + s
                  | otherwise = f (s + m) d where (d, m) = n `divMod` 10
            f1 k n | n < 10 = k
                   | otherwise = f1 (k + 1) $! f 0 n
        print $ (f1 1 . foldl' (\a b -> a + ord b - ord '0') 0) n

import Char
import List

putAnsLn :: (Show a) => a -> IO ()
putAnsLn ans = putStrLn (show ans)

digitsum [] s = s
digitsum (n:ns) s = digitsum ns (s + (ord n) - 48)

solve n ans = if (length n) == 1 then
                  ans
              else
                  solve (show (digitsum n 0)) (ans+1)

main = do n <- getLine
          putAnsLn (solve n 0)

import Data.Char

main = do getLine >>= print . length . takeWhile ((>1) .length) . iterate (show . sum . map digitToInt)

import Data.Char (digitToInt)

digits :: Integer -> [Integer]
digits = fmap (fromIntegral . digitToInt) . show

solve :: Integer -> Int
solve x = length . takeWhile (> 9) $ iterations
  where
    iterations = iterate (sum . digits) x

main :: IO ()
main = do
  x <- readLn
  print $ solve x

import Data.Char
solve = loop 0

loop acc [_] = acc
loop acc foo = loop (1 + acc) (show (sum [digitToInt x | x <- foo]))

main = interact (show . solve . filter isDigit)

module Main where

import Char

main = do
    inputN <- getLine
    let n = read inputN
    putStrLn $ show $ process n

process n =
    if n<10
        then 0
        else (+) 1 $ process $ foldl ( \a b -> a + ord b - 48 ) 0 $ show n

import Data.Char
import Data.List

dsum 0 = 0
dsum n = n `rem` 10 + dsum (n `div` 10)

ans n
    | n==0 = 0
    | n<=9 = 1
    | otherwise = 1 + ans (dsum n)

main = do
    s <- fmap (sum . map (\x -> ord x - ord '0')) getLine
    putStrLn $ show $ ans s


You are given an array $$$a$$$ of length $$$n$$$. Let $$$cnt_x$$$ be the number of elements from the array which are equal to $$$x$$$. Let's also define $$$f(x, y)$$$ as $$$(cnt_x + cnt_y) \cdot (x + y)$$$.Also you are given $$$m$$$ bad pairs $$$(x_i, y_i)$$$. Note that if $$$(x, y)$$$ is a bad pair, then $$$(y, x)$$$ is also bad.Your task is to find the maximum value of $$$f(u, v)$$$ over all pairs $$$(u, v)$$$, such that $$$u \neq v$$$, that this pair is not bad, and also that $$$u$$$ and $$$v$$$ each occur in the array $$$a$$$. It is guaranteed that such a pair exists.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 10\,000$$$) — the number of test cases. The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n \le 3 \cdot 10^5$$$, $$$0 \le m \le 3 \cdot 10^5$$$) — the length of the array and the number of bad pairs. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — elements of the array. The $$$i$$$-th of the next $$$m$$$ lines contains two integers $$$x_i$$$ and $$$y_i$$$ ($$$1 \le x_i < y_i \le 10^9$$$), which represent a bad pair. It is guaranteed that no bad pair occurs twice in the input. It is also guaranteed that $$$cnt_{x_i} > 0$$$ and $$$cnt_{y_i} > 0$$$. It is guaranteed that for each test case there is a pair of integers $$$(u, v)$$$, $$$u \ne v$$$, that is not bad, and such that both of these numbers occur in $$$a$$$. It is guaranteed that the total sum of $$$n$$$ and the total sum of $$$m$$$ don't exceed $$$3 \cdot 10^5$$$.

For each test case print a single integer — the answer to the problem.

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

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

import Data.Bits
import qualified Data.IntSet as Set

reducePair :: Int -> Int -> Int
reducePair x y
  | x <= y    = x `shiftL` 32 + y
  | otherwise = y `shiftL` 32 + x

mainFun :: SP Builder
mainFun = do
  t <- getInt
  fmap mconcat $ replicateM t $ do
    n <- getInt
    m <- getInt
    aLi <- replicateM n getInt
    bad <- fmap Set.fromList $ replicateM m $ liftM2 reducePair getInt getInt
    let
      byOccs :: Array Int [Int]
      byOccs = accumArray (flip (:)) [] (1, n)
        $ [(length vs, head vs) | vs <- group $ sort aLi]
      ans = foldl' max minBound $ do
        (ctx, vs) <- assocs byOccs
        x <- vs
        cty <- [1 .. ctx]
        y <- take 1 [y | y <- byOccs ! cty,
                         x /= y,
                         Set.notMember (reducePair x y) bad
                         ]
        pure $ (ctx + cty) * (x + y)
    pure $ putInts [ans]

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


As you know, Bob's brother lives in Flatland. In Flatland there are n cities, connected by n - 1 two-way roads. The cities are numbered from 1 to n. You can get from one city to another moving along the roads.The «Two Paths» company, where Bob's brother works, has won a tender to repair two paths in Flatland. A path is a sequence of different cities, connected sequentially by roads. The company is allowed to choose by itself the paths to repair. The only condition they have to meet is that the two paths shouldn't cross (i.e. shouldn't have common cities).It is known that the profit, the «Two Paths» company will get, equals the product of the lengths of the two paths. Let's consider the length of each road equals 1, and the length of a path equals the amount of roads in it. Find the maximum possible profit for the company.

The first line contains an integer n (2 ≤ n ≤ 200), where n is the amount of cities in the country. The following n - 1 lines contain the information about the roads. Each line contains a pair of numbers of the cities, connected by the road ai, bi (1 ≤ ai, bi ≤ n).

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
        e' = accumArray (flip (:)) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
        gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a $ (b'!!0)+(b'!!1), b'!!0)) $
                foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
        v <- getLine
        e <- getContents
        putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import List
import Control.Monad
import qualified Data.Map as M

maxOne [] = 0
maxOne ss = 1 + (maximum $ map fst ss)

maxTwo [] = 0
maxTwo (x:[]) = max (1 + fst x) (snd x)
maxTwo ss = max (o1 + o2 + 2) t1
  where o1:o2:_ = sortBy (flip compare) $ map fst ss
        t1 = maximum $ map snd ss

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
  where
    children p r = delete p $ M.findWithDefault [] r adj
    go p root = (maxOne sub, maxTwo sub)
      where sub = map (go root) $ children p root

adjList edges = map ((\(x,y) -> (head x, y)).unzip).groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y)).nub.sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges. M.fromList .adjList $ edges

import List
import Control.Monad

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
    where
        children p r = delete p . snd. head $ (filter ((r==).fst) adj)++[(r,[])]
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sortBy (flip compare) $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges.adjList $ edges

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read (v ++ v) in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
        e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
        gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
                foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
        v <- getLine
        e <- getContents
        putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum $ 0:[fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ lines e

import Data.Array (accumArray, (!))
import Data.List (sort)

gao n e = maximum [fst (gao' a b) * fst (gao' b a) | (a, b) <- e] where
	e' = accumArray (\a b->b:a) [] (1, n) $ concat [e, [(b, a) | (a, b) <- e]]
	gao' p q = (\(a, b) -> let b' = reverse $ sort b in (max a (b'!!0)+(b'!!1), b'!!0)) $
		foldl (\(a,b) (c,d) -> (max a c, d+1:b)) (0, [0, 0]) [gao' i p | i <- e'!p, i /= q]

main = do
	v <- getLine
	e <- getContents
	putStrLn $ show $ let n = read v in gao n $ map ((\[a,b]->(a,b)) . map read . words) $ take (n - 1) $ lines e

import List
import Control.Monad
import qualified Data.Map as M

solve adj = show $ maximum [snd (go x y) * snd (go y x)
                            | x <- M.keys adj, y <- children (-1) x]
    where
        children p r = delete p $ (M.findWithDefault) [] r adj
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sort $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve.(M.fromList).adjList $ edges

import List
import Control.Monad

solve edges adj = show $ maximum [snd (go x y) * snd (go y x) | [x,y] <- edges]
    where
        children p r = delete p . snd. head $ (filter ((r==).fst) adj)++[(r,[])]
        go p root = (maxOne sub, maxTwo sub)
                    where sub = map (go root) $ children p root
                          maxOne [] = 0
                          maxOne ss = 1 + (maximum $ map fst ss)

                          maxTwo [] = 0
                          maxTwo (x:[]) = max (1 + fst x) (snd x)
                          maxTwo ss = max (o1 + o2 + 2) t1
                                      where o1:o2:_ = sort $ map fst ss
                                            t1 = maximum $ map snd ss

adjList edges = map ((\(x,y) -> (head x, y)).unzip)
                .groupBy (\x y-> fst x == fst y)
                .map (\[x,y]->(x,y))
                .nub
                .sort $ (edges ++ (map reverse edges))

ints = fmap (map read . words) getLine

main = do
        [n] <- ints
        edges <- replicateM (n-1) ints
        putStrLn.solve edges.adjList $ edges


Ashish has an array $$$a$$$ of size $$$n$$$.A subsequence of $$$a$$$ is defined as a sequence that can be obtained from $$$a$$$ by deleting some elements (possibly none), without changing the order of the remaining elements.Consider a subsequence $$$s$$$ of $$$a$$$. He defines the cost of $$$s$$$ as the minimum between:   The maximum among all elements at odd indices of $$$s$$$.  The maximum among all elements at even indices of $$$s$$$. Note that the index of an element is its index in $$$s$$$, rather than its index in $$$a$$$. The positions are numbered from $$$1$$$. So, the cost of $$$s$$$ is equal to $$$min(max(s_1, s_3, s_5, \ldots), max(s_2, s_4, s_6, \ldots))$$$.For example, the cost of $$$\{7, 5, 6\}$$$ is $$$min( max(7, 6), max(5) ) = min(7, 5) = 5$$$.Help him find the minimum cost of a subsequence of size $$$k$$$.

The first line contains two integers $$$n$$$ and $$$k$$$ ($$$2 \leq k \leq n \leq 2 \cdot 10^5$$$)  — the size of the array $$$a$$$ and the size of the subsequence. The next line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$)  — the elements of the array $$$a$$$.

Output a single integer  — the minimum cost of a subsequence of size $$$k$$$.

NoteIn the first test, consider the subsequence $$$s$$$ = $$$\{1, 3\}$$$. Here the cost is equal to $$$min(max(1), max(3)) = 1$$$.In the second test, consider the subsequence $$$s$$$ = $$$\{1, 2, 4\}$$$. Here the cost is equal to $$$min(max(1, 4), max(2)) = 2$$$.In the fourth test, consider the subsequence $$$s$$$ = $$$\{3, 50, 2, 4\}$$$. Here the cost is equal to $$$min(max(3, 2), max(50, 4)) = 3$$$.

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

main = do
  [n, k] <- map read . words <$> getLine
  as <- map read . words <$> getLine
  let v = k `div` 2
  print $
    if odd k
      then min (solve as (v + 1)) (solve (tail $ init as) v)
      else min (solve (init as) v) (solve (tail as) v)

solve as v = search (check as v) 0 (10 ^ 9 + 1)

check as v a = space (sort $ map snd $ filter ((<= a) . fst) $ zip as [0..]) >= v

space [] = 0
space [i] = 1
space (a : b : is)
  | a + 1 == b = space (a : is)
  | otherwise = 1 + space (b : is)

search f l r
  | l >= r - 1 = r
  | f m = search f l m
  | otherwise = search f m r
  where
    m = (l + r) `div` 2

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

solve :: Int -> Int -> [Int] -> Int
solve _ k as = min minOdd minEven
  where
    bounds = (1,10^9)
    minOdd = binSearch (checkOdds as k) bounds
    minEven = binSearch (checkEvens as k) bounds

binSearch :: (Int -> Bool) -> (Int,Int) -> Int
binSearch predi (lo,hi)
  | lo == hi = lo
  | predi lmid = binSearch predi (lo,lmid)
  | otherwise = binSearch predi (hmid,hi)
  where
    lmid = div (lo+hi) 2
    hmid = lmid+1

checkOdds ::  [Int] -> Int -> Int -> Bool
checkOdds _ 0 _ = True
checkOdds [] _ _ = False
checkOdds (a:as) k x
  | a<=x = checkEvens as (k-1) x
  | otherwise = checkOdds as k x

checkEvens :: [Int] -> Int -> Int -> Bool
checkEvens _ 0 _ = True
checkEvens [] _ _ = False
checkEvens (_:as) k x = checkOdds as (k-1) x

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

doMagic :: [Bool] -> [Bool]
doMagic l = reverse $ dropWhile (==True) $ reverse $ dropWhile (==True) l

getMaxLength1 :: Int -> [Bool] -> Int
getMaxLength1 x = length . concat . map head1 . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = length l - length stripped + getMaxLength1 x stripped
    where
        stripped = doMagic (map (<=x) l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

main = interact $ show . solve . map read . words

import Control.Monad
import Data.List

head' :: [Bool] -> [Bool]
head' l = if head l then l else [False]

dedup :: [Bool] -> [Bool]
dedup = concat . map head' . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x = length . dedup . map (<=x)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

main = interact $ show . solve . map read . words

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

head2 :: [Bool] -> [Bool]
head2 l = if not $ head l then [False]
          else if (mod (length l) 2) == 1 then tail l
               else l

doMagic :: [Bool] -> [Bool]
doMagic l = reverse $ dropWhile (==True) $ reverse $ dropWhile (==True) l

getMaxLength1 :: Int -> [Bool] -> Int
getMaxLength1 x = length . concat . map head1 . group

getMaxLength2 :: Int -> [Bool] -> Int
getMaxLength2 x = length . concat . map head2 . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = length l - length stripped + max (getMaxLength1 x stripped) (getMaxLength2 x stripped)
    where
        stripped = doMagic (map (<=x) l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

main = interact $ show . solve . map read . words

import Data.List

head1 :: [Bool] -> [Bool]
head1 l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

head2 :: [Bool] -> [Bool]
head2 l = if not $ head l then [False]
          else if (mod (length l) 2) == 1 then tail l
               else l

getMaxLength1 :: Int -> [Int] -> Int
getMaxLength1 x = length . concat . map head1 . group . map (<=x)

getMaxLength2 :: Int -> [Int] -> Int
getMaxLength2 x = length . concat . map head2 . group . map (<=x)

getMaxLength :: Int -> [Int] -> Int
getMaxLength x l = max (getMaxLength1 x l) (getMaxLength2 x l)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

main = interact $ show . solve . map read . words

import Data.List

head' :: [Bool] -> [Bool]
head' l = if not $ head l then [False]
          else if (mod (length l) 2) == 0 then tail l
               else l

dedup :: [Bool] -> [Bool]
dedup = concat . map head' . group

getMaxLength :: Int -> [Int] -> Int
getMaxLength x = length . dedup . map (<=x)

getAnswer :: [Int] -> Int -> Int -> Int -> Int
getAnswer l k lo hi =
    if lo == hi then lo
    else
        if getMaxLength mid l < k then getAnswer l k (mid+1) hi
        else getAnswer l k lo mid
        where mid = div (lo + hi) 2

solve :: [Int] -> Int
solve (n:k:a) = getAnswer a k 1 1000000000

main = interact $ show . solve . map read . words


Polycarp was given a row of tiles. Each tile contains one lowercase letter of the Latin alphabet. The entire sequence of tiles forms the string $$$s$$$.In other words, you are given a string $$$s$$$ consisting of lowercase Latin letters.Initially, Polycarp is on the first tile of the row and wants to get to the last tile by jumping on the tiles. Jumping from $$$i$$$-th tile to $$$j$$$-th tile has a cost equal to $$$|index(s_i) - index(s_j)|$$$, where $$$index(c)$$$ is the index of the letter $$$c$$$ in the alphabet (for example, $$$index($$$'a'$$$)=1$$$, $$$index($$$'b'$$$)=2$$$, ..., $$$index($$$'z'$$$)=26$$$) .Polycarp wants to get to the $$$n$$$-th tile for the minimum total cost, but at the same time make maximum number of jumps.In other words, among all possible ways to get to the last tile for the minimum total cost, he will choose the one with the maximum number of jumps.Polycarp can visit each tile at most once.Polycarp asks you to help — print the sequence of indices of string $$$s$$$ on which he should jump.

The first line of the input contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of test cases in the test. Each test case is given by the string $$$s$$$ ($$$2 \le |s| \le 2 \cdot 10^5$$$), where $$$|s|$$$ — is the length of string $$$s$$$. The string $$$s$$$ consists of lowercase Latin letters. It is guaranteed that the sum of string lengths $$$s$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

The answer to each test case consists of two lines. In the first line print two integers $$$cost$$$, $$$m$$$, where $$$cost$$$ is the minimum total cost of the path, and $$$m$$$ is the maximum number of visited tiles Polycarp can make to get to $$$n$$$-th tiles for the minimum total cost $$$cost$$$ (i.e. the number of jumps is $$$m-1$$$). In the next line print $$$m$$$ different numbers $$$j_1, j_2, \dots, j_m$$$ ($$$1 \le j_i \le |s|$$$) — the sequence of indices of the tiles Polycarp will jump on. The first number in the sequence must be $$$1$$$ (that is, $$$j_1=1$$$) and the last number must be the value of $$$|s|$$$ (that is, $$$j_m=|s|$$$). If there are multiple answers, print any of them.

6

logic

codeforces

bca

aaaaaaaaaaa

adbaadabad

to

NoteIn the first test case, the required path corresponds to the picture:  In this case, the minimum possible total cost of the path is achieved. Since $$$index($$$'l'$$$)=12$$$, $$$index($$$'o'$$$)=15$$$, $$$index($$$'g'$$$)=7$$$, $$$index($$$'i'$$$)=9$$$, $$$index($$$'c'$$$)=3$$$, then the total cost of the path is $$$|12-9|+|9-7|+|7-3|=3+2+4=9$$$.

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

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

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

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

import Text.Printf

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

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

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

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

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

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

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

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

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

{-# options_ghc -O3                              #-}

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

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

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

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

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

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

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

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

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

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

{-# options_ghc -O1                              #-}

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

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

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

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

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

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

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

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

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

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

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

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

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

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

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

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

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

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

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

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

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

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

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

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

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

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

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

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

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

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

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

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

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

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

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

import qualified Control.Monad as M

import Data.List (sortBy, sortOn)

import Data.Char

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

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

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

#else

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

traceM _ = pure
#endif

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

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

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

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

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

{- solution -}

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

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

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

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

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

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

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


On the Berland Dependence Day it was decided to organize a great marathon. Berland consists of n cities, some of which are linked by two-way roads. Each road has a certain length. The cities are numbered from 1 to n. It is known that one can get from any city to any other one by the roads.n runners take part in the competition, one from each city. But Berland runners are talkative by nature and that's why the juries took measures to avoid large crowds of marathon participants. The jury decided that every runner should start the marathon from their hometown. Before the start every sportsman will get a piece of paper containing the name of the city where the sportsman's finishing line is. The finish is chosen randomly for every sportsman but it can't coincide with the sportsman's starting point. Several sportsmen are allowed to finish in one and the same city. All the sportsmen start simultaneously and everyone runs the shortest route from the starting point to the finishing one. All the sportsmen run at one speed which equals to 1.After the competition a follow-up table of the results will be composed where the sportsmen will be sorted according to the nondecrease of time they spent to cover the distance. The first g sportsmen in the table will get golden medals, the next s sportsmen will get silver medals and the rest will get bronze medals. Besides, if two or more sportsmen spend the same amount of time to cover the distance, they are sorted according to the number of the city where a sportsman started to run in the ascending order. That means no two sportsmen share one and the same place.According to the rules of the competition the number of gold medals g must satisfy the inequation g1 ≤ g ≤ g2, where g1 and g2 are values formed historically. In a similar way, the number of silver medals s must satisfy the inequation s1 ≤ s ≤ s2, where s1 and s2 are also values formed historically.At present, before the start of the competition, the destination points of every sportsman are unknown. However, the press demands details and that's why you are given the task of counting the number of the ways to distribute the medals. Two ways to distribute the medals are considered different if at least one sportsman could have received during those distributions different kinds of medals.

The first input line contains given integers n and m (3 ≤ n ≤ 50, n - 1 ≤ m ≤ 1000), where n is the number of Berland towns and m is the number of roads. Next in m lines road descriptions are given as groups of three integers v, u, c, which are the numbers of linked towns and its length (1 ≤ v, u ≤ n, v ≠ u, 1 ≤ c ≤ 1000). Every pair of cities have no more than one road between them. The last line contains integers g1, g2, s1, s2 (1 ≤ g1 ≤ g2, 1 ≤ s1 ≤ s2, g2 + s2 < n). The input data numbers, located on one line, are space-separated.

Print the single number — the number of ways to distribute the medals. It is guaranteed that the number fits in the standard 64-bit signed data type.

{-# LANGUAGE BangPatterns #-}
import Data.List
import qualified Data.IntMap as Map
import qualified Data.IntSet as Set
import Data.Bits
import Data.Int (Int64)
import Data.Array

infinit = 100000000

hsh i j = (.|.) (shiftL i 6) j
revhsh ij = ( (shiftR ij 6), (.&.) ij 63 )

intOrInf !df Nothing = df
intOrInf _ (Just x) = x

bilookup !df mat !i !j = (intOrInf df) $ Map.lookup (hsh i j) mat
biupdate mat !i !j val = Map.insert (hsh i j) val mat

molookup !df v !i = (intOrInf df) $ Map.lookup i v
moupdate v !i val = Map.insert i val v

boolupdate v i val
 | val = Set.insert i v
 | otherwise = Set.delete i v

floydWarshall !n !k !i !j dp
 | k >= n = dp
 | i >= n = floydWarshall n (k + 1) 0 0 dp
 | j >= n = floydWarshall n k (i + 1) 0 dp
 | (i == j) || (j == k) || (k == i) = floydWarshall n k i (j + 1) dp
 | otherwise =
    let cand1 = (bilookup infinit dp k j)
        cand = if cand1 >= infinit then cand1 else cand1 + (bilookup infinit dp i k)
        ndp = if cand >= infinit then dp else (Map.insertWith min (hsh i j) cand dp) in
        floydWarshall n k i (j + 1) ndp

convertToBiArray !n dst =
  let nn = hsh (n-1) (n-1) in
    listArray (0,nn) [ molookup 0 dst i | i <- [0..nn] ]

posProcessDst !n !i !j dst
 | i >= n = dst
 | j >= n = posProcessDst n (i + 1) 0 dst
 | i == j = posProcessDst n i (j + 1) dst
 | otherwise =
    let ndst = (dst Map.! (hsh i j)) * 100 + i in
        posProcessDst n i (j + 1) (biupdate dst i j ndst)

computeOneMinMaxd !n !i dst cmp = cmp [ (dst ! (hsh i j)) | j <- [0..(i-1)] ++ [(i+1)..(n-1)]]

computeMinmaxd !n dst =
  let mind = listArray (0,(n-1)) [ computeOneMinMaxd n i dst minimum | i <- [0..(n-1)] ]
      maxd = listArray (0,(n-1)) [ computeOneMinMaxd n i dst maximum | i <- [0..(n-1)] ] in
      (mind, maxd)

solve_step1 !n !i !j !k !l mind maxd dst g s b
 | k >= n = ( ( boolupdate ( boolupdate g j False ) i True ), ( boolupdate ( boolupdate s j False ) i False ), ( boolupdate ( boolupdate b j True ) i False )  )
 | l < 0 = solve_step1 n i j k 0 mind maxd dst (boolupdate g k ( (mind ! k) < (mind ! i) )) s (boolupdate b k ( (maxd ! k) > (maxd ! j) ))
 | l >= n = solve_step1 n i j (k + 1) (-1) mind maxd dst g s b
 | l == k = solve_step1 n i j k (l + 1) mind maxd dst g s b
 | otherwise =
    let dkl = (dst ! (hsh k l))
        lhs = dkl > (mind ! i)
        rhs = dkl < (maxd ! j)
        sk = lhs && rhs in
        if sk
          then solve_step1 n i j (k + 1) (-1) mind maxd dst g (boolupdate s k True) b
          else solve_step1 n i j k (l + 1) mind maxd dst g s b

solve_step2 !n !g2 !s2 !k [] gk sk bk f = f
solve_step2 !n !g2 !s2 !k ((pq,v):pqs) gk sk bk f =
  let (p,q) = revhsh pq
      up1 = if gk && (p + 1) <= g2 then Map.insertWith (+) (hsh (p + 1) q) v f else f
      up2 = if sk && (q + 1) <= s2 then Map.insertWith (+) (hsh p (q + 1)) v up1 else up1
      up3 = if (not bk) then (Map.delete (hsh p q) up2) else up2 in
      solve_step2 n g2 s2 k pqs gk sk bk up3

solve_step2_wrapper !n !g2 !s2 !k g s b f
 | k >= n = f
 | otherwise =
    let gk = Set.member k g
        sk = Set.member k s
        bk = Set.member k b in
        if (gk || sk || (not bk))
          then let ff = solve_step2 n g2 s2 k (Map.toDescList f) gk sk bk f in
                   solve_step2_wrapper n g2 s2 (k + 1) g s b ff
          else solve_step2_wrapper n g2 s2 (k + 1) g s b f

collect_results !g1 !g2 !s1 !s2 f p q !r
 | p > g2 = r
 | otherwise = collect_results g1 g2 s1 s2 f (p + 1) s1 (r + (sum [ bilookup 0 f p q | q <- [s1..s2] ]))

solve !g1 !g2 !s1 !s2 !n !i !j mind maxd dst !rs
 | i >= n = rs
 | j >= n = solve g1 g2 s1 s2 n (i + 1) 0 mind maxd dst rs
 | i == j = solve g1 g2 s1 s2 n i (j + 1) mind maxd dst rs
 | (mind ! i) >= (maxd ! j) = solve g1 g2 s1 s2 n i (j + 1) mind maxd dst rs
 | otherwise =
    let (g,s,b) = solve_step1 n i j 0 (-1) mind maxd dst Set.empty Set.empty Set.empty
        f = solve_step2_wrapper n g2 s2 0 g s b (biupdate Map.empty 0 0 1)
        extra_r = (collect_results g1 g2 s1 s2 f g1 s1 0) in
        solve g1 g2 s1 s2 n i (j + 1) mind maxd dst (rs + extra_r)

readInts = fmap ( (map (\x -> read x::Int))  . words ) getLine

readEdges !m dst
 | m == 0 = return dst
 | otherwise =
    do
      dstt <- readEdges (m - 1) dst
      [vu,uu,c] <- readInts
      let v = vu - 1
          u = uu - 1
          dst1 = biupdate dstt v u c
          dst2 = biupdate dst1 u v c
      return dst2

main = do
  [n,m] <- readInts
  dst_init <- readEdges m Map.empty
  let dst_fw = floydWarshall n 0 0 0 dst_init
      dst_p = posProcessDst n 0 0 dst_fw
      dst = convertToBiArray n dst_p
      (mind,maxd) = computeMinmaxd n dst
  [g1,g2,s1,s2] <- readInts
  print $ solve g1 g2 s1 s2 n 0 0 mind maxd dst 0