This is the easy version of the problem. In this version, $$$n \le 3000$$$, $$$x \ge y$$$ holds. You can make hacks only if both versions of the problem are solved.You are given two binary strings $$$a$$$ and $$$b$$$, both of length $$$n$$$. You can do the following operation any number of times (possibly zero).   Select two indices $$$l$$$ and $$$r$$$ ($$$l < r$$$).  Change $$$a_l$$$ to $$$(1 - a_l)$$$, and $$$a_r$$$ to $$$(1 - a_r)$$$.  If $$$l + 1 = r$$$, the cost of the operation is $$$x$$$. Otherwise, the cost is $$$y$$$. You have to find the minimum cost needed to make $$$a$$$ equal to $$$b$$$ or say there is no way to do so.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 600$$$) — the number of test cases. Each test case consists of three lines. The first line of each test case contains three integers $$$n$$$, $$$x$$$, and $$$y$$$ ($$$5 \le n \le 3000$$$, $$$1 \le y \le x \le 10^9$$$) — the length of the strings, and the costs per operation. The second line of each test case contains the string $$$a$$$ of length $$$n$$$. The string only consists of digits $$$0$$$ and $$$1$$$. The third line of each test case contains the string $$$b$$$ of length $$$n$$$. The string only consists of digits $$$0$$$ and $$$1$$$. It is guaranteed that the sum of $$$n$$$ over all test cases doesn't exceed $$$3000$$$.

For each test case, if there is no way to make $$$a$$$ equal to $$$b$$$, print $$$-1$$$. Otherwise, print the minimum cost needed to make $$$a$$$ equal to $$$b$$$.

NoteIn the first test case, selecting indices $$$2$$$ and $$$3$$$ costs $$$8$$$, which is the minimum possible cost.In the second test case, we cannot make $$$a$$$ equal to $$$b$$$ using any number of operations.In the third test case, we can perform the following operations:  Select indices $$$3$$$ and $$$6$$$. It costs $$$3$$$, and $$$a$$$ is 0101011 now.  Select indices $$$4$$$ and $$$6$$$. It costs $$$3$$$, and $$$a$$$ is 0100001 now. The total cost is $$$6$$$.In the fourth test case, we don't have to perform any operations.

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int64 -> Int64 -> [Int] -> [Int] -> Int64
solve n x y as bs = answer
    where
        ds = tracing "ds" $ zipWith (/=) as bs
        cntDs = fromIntegral . L.length . L.filter id $ ds
        posDs = L.map fst . L.filter snd . L.zip [1 ..] $ ds
        answer
            | odd cntDs  = -1
            | cntDs == 2 && (posDs L.!! 0) + 1 == (posDs L.!! 1) = (cntDs `div` 2) * min x (2 * y)
            | cntDs == 2 = (cntDs `div` 2) * min x y
            | otherwise = (cntDs `div` 2) * y

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s
        as <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        bs <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        let answer = solve (fromInteger n) (fromInteger x) (fromInteger y) as bs
        printf "%lld\n" answer

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int64 -> Int64 -> [Int] -> [Int] -> Int64
solve n x y as bs = answer
    where
        ds = tracing "ds" $ zipWith (/=) as bs
        cntDs = fromIntegral . L.length . L.filter id $ ds
        answer
            | odd cntDs  = -1
            | cntDs == 2 = (cntDs `div` 2) * min x (2 * y)
            | otherwise = (cntDs `div` 2) * y

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s
        as <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        bs <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        let answer = solve (fromInteger n) (fromInteger x) (fromInteger y) as bs
        printf "%lld\n" answer

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int64 -> Int64 -> [Int] -> [Int] -> Int64
solve n x y as bs = answer
    where
        ds = tracing "ds" $ zipWith (/=) as bs
        cntDs = fromIntegral . L.length . L.filter id $ ds
        answer
            | odd cntDs  = -1
            | n == 2 = x * (cntDs `div` 2)
            | otherwise = (cntDs `div` 2) * min x (2 * y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s
        as <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        bs <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        let answer = solve (fromInteger n) (fromInteger x) (fromInteger y) as bs
        printf "%lld\n" answer

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int64 -> Int64 -> [Int] -> [Int] -> Int64
solve n x y as bs = answer
    where
        ds = tracing "ds" $ zipWith (/=) as bs
        cntDs = fromIntegral . L.length . L.filter id $ ds
        answer
            | odd cntDs  = -1
            | n == 2 = y * (cntDs `div` 2)
            | otherwise = (cntDs `div` 2) * min x (2 * y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s
        as <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        bs <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        let answer = solve (fromInteger n) (fromInteger x) (fromInteger y) as bs
        printf "%lld\n" answer

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

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

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

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

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

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

import Data.Char
import Data.Int

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

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

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

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

#else

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

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

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

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

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

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

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

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

{- solution -}

solve :: Int -> Int64 -> Int64 -> [Int] -> [Int] -> Int64
solve n x y as bs = answer
    where
        ds = tracing "ds" $ zipWith (/=) as bs
        cntDs = fromIntegral . L.length . L.filter id $ ds
        answer
            | odd cntDs  = -1
            | n == 2 = cntDs `div` 2
            | otherwise = (cntDs `div` 2) * min x (2 * y)

main :: IO ()
main = do
    t <- B8.getLine <&> readIntB8
    M.replicateM_ t $ do
        [n, x, y] <- B8.getLine <&> readIntegerB8s
        as <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        bs <- B8.getLine <&> B8.filter isAlphaNum <&> map (\c -> ord c - ord '0') . B8.unpack
        let answer = solve (fromInteger n) (fromInteger x) (fromInteger y) as bs
        printf "%lld\n" answer


In a far away kingdom young pages help to set the table for the King. As they are terribly mischievous, one needs to keep an eye on the control whether they have set everything correctly. This time the royal chef Gerasim had the impression that the pages have played a prank again: they had poured the juice from one cup to another. Now Gerasim wants to check his hypothesis. The good thing is that chef Gerasim always pour the same number of milliliters of juice to all cups in the royal kitchen. Having thoroughly measured the juice in each cup, Gerasim asked you to write a program that will determine from which cup juice was poured to which one; otherwise, the program should determine that this time the pages set the table diligently.To simplify your task we shall consider the cups to be bottomless so that the juice never overfills a cup and pours out, however much it can be. Besides, by some strange reason in a far away kingdom one can only pour to a cup or from one cup to another an integer number of milliliters of juice.

The first line contains integer n — the number of cups on the royal table (1 ≤ n ≤ 1000). Next n lines contain volumes of juice in each cup — non-negative integers, not exceeding 104.

If the pages didn't pour the juice, print "Exemplary pages." (without the quotes). If you can determine the volume of juice poured during exactly one juice pouring, print "v ml. from cup #a to cup #b." (without the quotes), where v represents the volume of poured juice, a represents the number of the cup from which the juice was poured (the cups are numbered with consecutive positive integers starting from one in the order in which the cups are described in the input data), b represents the number of the cup into which the juice was poured. Finally, if the given juice's volumes cannot be obtained using no more than one pouring (for example, the pages poured the juice from one cup to another more than once or the royal kitchen maids poured the juice into the cups incorrectly), print "Unrecoverable configuration." (without the quotes).

20 ml. from cup #4 to cup #1.
Exemplary pages.
Unrecoverable configuration.

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine
    cups <- replicateM n $ read `liftM` getLine

    let minCup = minimum cups
        maxCup = maximum cups
        meanCup = ( minCup + maxCup ) `div` 2
        diffCup = ( maxCup - minCup ) `div` 2
        meanCupCount = length $ filter ( == meanCup ) cups
        minCupIndex = case elemIndex minCup cups of
            Just n -> n+1
        maxCupIndex = case elemIndex maxCup cups of
            Just n -> n+1

    putStrLn $ if minCup == maxCup
        then "Exemplary pages."
        else if ( minCup + maxCup ) `mod` 2 /= 0 || meanCupCount /= n - 2
            then "Unrecoverable configuration."
            else show diffCup ++ " ml. from cup #" ++ show minCupIndex ++ " to cup #" ++ show maxCupIndex ++ "."

import Control.Monad (replicateM)
import Data.List (nubBy, sortBy)

type Result  =  Either String (Int, Int, Int)

solve :: [(Int, Int)] -> Result
solve xs
  | length xs' > 3  =  Left "Unrecoverable configuration."
  | otherwise  =  solve' xs'
  where
    xs'  =  nubBy (\a b -> snd a == snd b) $ sortBy (\a b -> compare (snd a) (snd b)) xs
    solve' [_]  =  Left "Exemplary pages."
    solve' [(n1, a), (n2, b)]
      | odd (b - a)  =  Left "Unrecoverable configuration."
      | length xs == 2  =  Right (n1, n2, div (b - a) 2)
      | otherwise  =  Left "Unrecoverable configuration."
    solve' [(n1, a), (n2, b), (n3, c)]
      | c - b /= b - a  =  Left "Unrecoverable configuration."
      | length (filter (\(n, x) -> x == a) xs) > 1  =  Left "Unrecoverable configuration."
      | length (filter (\(n, x) -> x == c) xs) > 1  =  Left "Unrecoverable configuration."
      | otherwise  =  Right (n1, n3, b - a)

showResult :: Result -> String
showResult (Left s)  =  s
showResult (Right (n, m, x))  =
    concat [show x, " ml. from cup #", show n, " to cup #", show m, "."]

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  (replicateM n readLn) :: IO [Int]
    let result  =  solve $ zip [1..] as
    putStrLn $ showResult result

import Control.Monad
import Control.Applicative
import qualified Data.ByteString.Char8 as BS
import Data.List
import Data.Maybe
import Data.Ord
import Text.Printf

readInt = fst . fromJust . BS.readInt <$> BS.getLine

main :: IO ()
main = do
   n <- readInt
   values <- replicateM n readInt
   f values

f :: [Int] -> IO ()
f xs | nv xs == 1 = putStrLn "Exemplary pages."
     | mod (maxs - mins) 2 == 0 && (nv ds == 0 || (nv ds == 1 && (div (maxs+mins) 2) == head ds)) = printf "%d ml. from cup #%d to cup #%d.\n" amount (minl + 1) (maxl + 1)
     | otherwise = putStrLn "Unrecoverable configuration."
   where nv = length.nub
         maxs = maximum xs
         mins = minimum xs
         maxl = fromJust $ elemIndex maxs xs
         minl = fromJust $ elemIndex mins xs
         amount = div (maxs - mins) 2
         ds = xs \\ [maxs, mins]

module Main where

import Control.Monad
import Data.List

main = do
    n <- read `liftM` getLine
    cups <- replicateM n $ read `liftM` getLine

    let minCup = minimum cups
        maxCup = maximum cups
        meanCup = ( minCup + maxCup ) `div` 2
        diffCup = ( maxCup - minCup ) `div` 2
        meanCupCount = length $ filter ( == meanCup ) cups
        minCupIndex = case elemIndex minCup cups of
            Just n -> n+1
        maxCupIndex = case elemIndex maxCup cups of
            Just n -> n+1

    putStrLn $ if minCup == maxCup
        then "Exemplary pages."
        else if ( minCup + maxCup ) `mod` 2 /= 0 || meanCupCount /= n - 2
            then "Unrecoverable configuration."
            else show diffCup ++ " ml. from cup #" ++ show maxCupIndex ++ " to cup #" ++ show minCupIndex ++ "."


Let's consider a simplified version of order book of some stock. The order book is a list of orders (offers) from people that want to buy or sell one unit of the stock, each order is described by direction (BUY or SELL) and price.At every moment of time, every SELL offer has higher price than every BUY offer. In this problem no two ever existed orders will have the same price.The lowest-price SELL order and the highest-price BUY order are called the best offers, marked with black frames on the picture below.  The presented order book says that someone wants to sell the product at price $$$12$$$ and it's the best SELL offer because the other two have higher prices. The best BUY offer has price $$$10$$$. There are two possible actions in this orderbook:  Somebody adds a new order of some direction with some price. Somebody accepts the best possible SELL or BUY offer (makes a deal). It's impossible to accept not the best SELL or BUY offer (to make a deal at worse price). After someone accepts the offer, it is removed from the orderbook forever.It is allowed to add new BUY order only with prices less than the best SELL offer (if you want to buy stock for higher price, then instead of adding an order you should accept the best SELL offer). Similarly, one couldn't add a new SELL order with price less or equal to the best BUY offer. For example, you can't add a new offer "SELL $$$20$$$" if there is already an offer "BUY $$$20$$$" or "BUY $$$25$$$" — in this case you just accept the best BUY offer.You have a damaged order book log (in the beginning the are no orders in book). Every action has one of the two types: "ADD $$$p$$$" denotes adding a new order with price $$$p$$$ and unknown direction. The order must not contradict with orders still not removed from the order book.  "ACCEPT $$$p$$$" denotes accepting an existing best offer with price $$$p$$$ and unknown direction.The directions of all actions are lost. Information from the log isn't always enough to determine these directions. Count the number of ways to correctly restore all ADD action directions so that all the described conditions are satisfied at any moment. Since the answer could be large, output it modulo $$$10^9 + 7$$$. If it is impossible to correctly restore directions, then output $$$0$$$.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 363\,304$$$) — the number of actions in the log. Each of the next $$$n$$$ lines contains a string "ACCEPT" or "ADD" and an integer $$$p$$$ ($$$1 \le p \le 308\,983\,066$$$), describing an action type and price.  All ADD actions have different prices. For ACCEPT action it is guaranteed that the order with the same price has already been added but has not been accepted yet.

Output the number of ways to restore directions of ADD actions modulo $$$10^9 + 7$$$.

6
ADD 1
ACCEPT 1
ADD 2
ACCEPT 2
ADD 3
ACCEPT 3

7
ADD 1
ADD 2
ADD 3
ADD 4
ADD 5
ACCEPT 3
ACCEPT 5

NoteIn the first example each of orders may be BUY or SELL.In the second example the order with price $$$1$$$ has to be BUY order, the order with the price $$$3$$$ has to be SELL order.

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000007
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ uk = 1 + fromIntegral (S.size uk)
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss && S.member x uk
        (addbuy, addsell) = S.split x uk
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy  = if bb then S.deleteMax buy  else S.union buy  addbuy
        nuk = S.empty
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2
          | otherwise = 0

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000007
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ _ = 1
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy = if bb then S.deleteMax buy else S.union buy addbuy
        addsell = if uu then S.filter (>x) uk else S.empty
        addbuy = if uu then S.filter (<x) uk else S.empty
        nuk = if uu then S.empty else uk
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000007
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ _ = 1
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss && S.member x uk
        (addbuy, addsell) = if uu then S.split x uk else (S.empty, S.empty)
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy = if bb then S.deleteMax buy else S.union buy addbuy
        nuk = if uu then S.empty else uk
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2
          | otherwise = 0

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000007
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ _ = 1
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss && S.member x uk
        (addbuy, addsell) = S.split x uk
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy  = if bb then S.deleteMax buy  else S.union buy  addbuy
        nuk = S.empty
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2
          | otherwise = 0

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000009
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ _ = 1
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy = if bb then S.deleteMax buy else S.union buy addbuy
        addsell = if uu then S.filter (>x) uk else S.empty
        addbuy = if uu then S.filter (<x) uk else S.empty
        nuk = if uu then S.empty else uk
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x

--import Debug.Trace
import qualified Data.ByteString.Char8 as B
import Control.Applicative
import Control.Arrow
import Control.Monad
import Data.List
import Data.Int
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S

newtype Mod = M Int64 deriving(Show,Eq)
md a = M $ mod a 1000000007
instance Num Mod where
  (M a) + (M b) = md $ a + b
  (M a) * (M b) = md $ a * b
  negate (M a) = md $ negate a
  fromInteger = md . fromInteger
  signum _ = md 1
  abs x = x

main = do
  n <- lineInt
  ins <- replicateM n lineIns
  let (M ans) = doIns ins S.empty S.empty S.empty
  print ans

doIns :: [(Int,X)] -> Set Int -> Set Int -> Set Int -> Mod
doIns [] _ _ _ = 1
doIns ((x, Add):rest) sell buy uk = doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        nsell = if s then S.insert x sell else sell
        nbuy = if b then S.insert x buy else buy
        nuk = if not s && not b then S.insert x uk else uk

doIns ((x, Accept):rest) sell buy uk = y * doIns rest nsell nbuy nuk -- ## [nsell,nbuy,nuk]
  where s = maybe False (<x) $ lookupMin sell
        b = maybe False (>x) $ lookupMax buy
        ss = (== Just x) $ lookupMin sell
        bb = (== Just x) $ lookupMax buy
        uu = not bb && not ss && S.member x uk
        (addbuy, addsell) = S.split x uk
        nsell = if ss then S.deleteMin sell else S.union sell addsell
        nbuy  = if bb then S.deleteMax buy  else S.union buy  addbuy
        nuk = if uu then S.empty else uk
        y | s  || b   = 0
          | ss || bb  = 1
          | uu        = 2
          | otherwise = 0

lookupMin = S.lookupGE 0
lookupMax = S.lookupLE 1000000000

data X = Accept | Add

lineIns = do
  [a,b] <- B.words <$> B.getLine
  return (readInt b, if a == B.pack "ADD" then Add else Accept)

readInt = fst . fromJust . B.readInt
lineInt = readInt <$> B.getLine
lineInts = map readInt . B.words <$> B.getLine

--infixr 0 ##
--(##) x msg = traceShow msg x


Sergey attends lessons of the N-ish language. Each lesson he receives a hometask. This time the task is to translate some sentence to the N-ish language. Sentences of the N-ish language can be represented as strings consisting of lowercase Latin letters without spaces or punctuation marks.Sergey totally forgot about the task until half an hour before the next lesson and hastily scribbled something down. But then he recollected that in the last lesson he learned the grammar of N-ish. The spelling rules state that N-ish contains some "forbidden" pairs of letters: such letters can never occur in a sentence next to each other. Also, the order of the letters doesn't matter (for example, if the pair of letters "ab" is forbidden, then any occurrences of substrings "ab" and "ba" are also forbidden). Also, each pair has different letters and each letter occurs in no more than one forbidden pair.Now Sergey wants to correct his sentence so that it doesn't contain any "forbidden" pairs of letters that stand next to each other. However, he is running out of time, so he decided to simply cross out some letters from the sentence. What smallest number of letters will he have to cross out? When a letter is crossed out, it is "removed" so that the letters to its left and right (if they existed), become neighboring. For example, if we cross out the first letter from the string "aba", we get the string "ba", and if we cross out the second letter, we get "aa".

The first line contains a non-empty string s, consisting of lowercase Latin letters — that's the initial sentence in N-ish, written by Sergey. The length of string s doesn't exceed 105. The next line contains integer k (0 ≤ k ≤ 13) — the number of forbidden pairs of letters. Next k lines contain descriptions of forbidden pairs of letters. Each line contains exactly two different lowercase Latin letters without separators that represent the forbidden pairs. It is guaranteed that each letter is included in no more than one pair.

Print the single number — the smallest number of letters that need to be removed to get a string without any forbidden pairs of neighboring letters. Please note that the answer always exists as it is always possible to remove all letters.

NoteIn the first sample you should remove two letters b.In the second sample you should remove the second or the third letter. The second restriction doesn't influence the solution.

{-# LANGUAGE BangPatterns #-}

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

match !n !m _ _ [] = (min n m,[])
match !n !m c d xs@(x:xt)
  | x == c    = match (n+1) m c d xt
  | x == d    = match n (m+1) c d xt
  | otherwise = (min n m, xs)

next pairs str = go str
  where
    go [] = (0,[])
    go (c:cs) = case M.lookup c pairs of
                  Nothing -> go cs
                  Just d  -> match 1 0 c d cs

toMap plist = M.fromList (concatMap f plist)
  where f (a:b:_) = [(a,b),(b,a)]

solve pairs [] = []
solve pairs str =
  let (k,str') = next pairs str
  in k : solve pairs str'

test1 = solve (toMap ["pg","nb"]) "pgpgppgggpbbnnn"

main = do
  str <- getLine
  n <- fmap read getLine
  plist <- replicateM n getLine
  let pairs = toMap plist
      answer = sum $ solve pairs str :: Int
  print answer

import Data.List
import Data.Map(Map)
import qualified Data.Map as M
import Control.Applicative

main = do cs <- getLine
          _  <- getLine
          mcc <- M.fromList . concatMap (\[x,y]->[(x,y),(y,x)]). lines <$> getContents
          print $ solve cs mcc

solve :: String -> Map Char Char -> Int
solve cs mcc = solve' mcc 0 [] cs

solve' :: Map Char Char -> Int -> String -> String -> Int
solve' mcc i _ [] = i
-- solve' mcc i _ [r] = i
solve' mcc i [] (r:rs) = solve' mcc i [r] rs
solve' mcc i (c:cs) (r:rs)
  | Just r == M.lookup c mcc = let (xs,xs') = span (c==) (c:cs)
                                   (ys,ys') = span (flip elem [c,r]) (r:rs)
				   (j,zs)   = f. partition (c==) $ xs++ys
			       in solve' mcc (i+j) (zs++xs') ys'
  | otherwise = solve' mcc i (r:c:cs) rs

f (cs,rs)
  | lc <= lr  = (lc,rs)
  | otherwise = (lr,cs)
  where lc = length cs
        lr = length rs

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

buildPairs :: [(Char, Char)] -> Array Char Char
buildPairs list = listArray ('a', 'z') [findPair c | c <- ['a'..'z']] where
    findPair c = case find ((== c) . fst) list of
        Nothing -> 'Z'
        Just c' -> snd c'

present :: Array Char Char -> Char -> (Int, Int)
present ps a =
   let a' = ps ! a
   in if a < a' then (1, 0)
                else (0, 1)

split :: Array Char Char -> [Char] -> [(Int, Int)]
split ps [c] = present ps c : []
split ps (a:b:str') = let
    (a1, a2) = present ps a
    ret@((r1, r2):ret') = split ps (b:str')
  in if ps ! a == b || a == b
       then (r1 + a1, r2 + a2) : ret'
       else (a1, a2) : ret

solve ps str = sum $ map (uncurry min) $ split ps str

main = do
    str <- getLine

    n <- liftM read getLine
    list <- liftM concat $ replicateM n $ do
        [a, b] <- getLine
        return [(a, b), (b, a)]

    let ans = solve (buildPairs list) str

    print ans

import qualified Data.Map as Map
import Data.List
s (m : _ : t) = minimum $ foldl' step (replicate 26 0) m where
  enemies = Map.fromList (map (\[a,b]->(a,b)) t ++ map (\[a,b]->(b,a)) t)
  enemy a = Map.lookup a enemies
  step acc ch = sum acc `seq` case enemy ch of
    Nothing -> [if a == ch then minimum acc else n+1 |(a, n) <- zip ['a'..] acc]
    Just nme -> [if a == ch then minimum (map snd $ filter (\(b, n) -> b /= nme) $ zip ['a'..] acc) else n+1 |(a, n) <- zip ['a'..] acc]
main = interact $ show . s . lines

{-# LANGUAGE BangPatterns #-}

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

match !k d c [] = (k,[])
match !k d c xs@(x:xt)
  | x == d    = match (k+1) c d xt
  | otherwise = (k,xs)

next pairs str = go str
  where
    go [] = (0,[])
    go (c:cs) = case M.lookup c pairs of
                  Nothing -> go cs
                  Just d  -> match 1 d c cs

toMap plist = M.fromList (concatMap f plist)
  where f (a:b:_) = [(a,b),(b,a)]

solve pairs [] = []
solve pairs str =
  let (k,str') = next pairs str
  in k : solve pairs str'

main = do
  str <- getLine
  n <- fmap read getLine
  plist <- replicateM n getLine
  let pairs = toMap plist
      answer = sum $ map (`div` 2) $ solve pairs str :: Int
  print answer


This is an interactive problem. You should use flush operation after each printed line. For example, in C++ you should use fflush(stdout), in Java you should use System.out.flush(), and in Pascal — flush(output).In this problem you should guess an array a which is unknown for you. The only information you have initially is the length n of the array a.The only allowed action is to ask the sum of two elements by their indices. Formally, you can print two indices i and j (the indices should be distinct). Then your program should read the response: the single integer equals to ai + aj.It is easy to prove that it is always possible to guess the array using at most n requests.Write a program that will guess the array a by making at most n requests.

NoteThe format of a test to make a hack is:  The first line contains an integer number n (3 ≤ n ≤ 5000) — the length of the array. The second line contains n numbers a1, a2, ..., an (1 ≤ ai ≤ 105) — the elements of the array to guess.

-- import Data.List (intercalate)
import System.IO (hFlush, stdout)
-- import Control.Monad (replicateM)

solve :: Int -> Int -> Int -> [Int] -> [Int]
solve a b c d = aa : bb : cc : map (subtract aa) d
    where aa = (a + c - b) `div` 2
          bb = a - aa
          cc = c - aa

query :: Int -> Int -> IO (Int)
query a b = do
    putStrLn $ "? " ++ show a ++ " " ++ show b
    hFlush stdout
    readLn

main :: IO()
main = do
    n <- readLn :: IO(Int)
    a <- query 1 2
    b <- query 2 3
    c <- query 3 1
    d <- mapM (query 1) [4 .. n]
    putStrLn $ '!' : (concat . map ((' ':) . show) $ solve a b c d)


Vanya and his friend Vova play a computer game where they need to destroy n monsters to pass a level. Vanya's character performs attack with frequency x hits per second and Vova's character performs attack with frequency y hits per second. Each character spends fixed time to raise a weapon and then he hits (the time to raise the weapon is 1 / x seconds for the first character and 1 / y seconds for the second one). The i-th monster dies after he receives ai hits. Vanya and Vova wonder who makes the last hit on each monster. If Vanya and Vova make the last hit at the same time, we assume that both of them have made the last hit.

The first line contains three integers n,x,y (1 ≤ n ≤ 105, 1 ≤ x, y ≤ 106) — the number of monsters, the frequency of Vanya's and Vova's attack, correspondingly. Next n lines contain integers ai (1 ≤ ai ≤ 109) — the number of hits needed do destroy the i-th monster.

Print n lines. In the i-th line print word "Vanya", if the last hit on the i-th monster was performed by Vanya, "Vova", if Vova performed the last hit, or "Both", if both boys performed it at the same time.

NoteIn the first sample Vanya makes the first hit at time 1 / 3, Vova makes the second hit at time 1 / 2, Vanya makes the third hit at time 2 / 3, and both boys make the fourth and fifth hit simultaneously at the time 1.In the second sample Vanya and Vova make the first and second hit simultaneously at time 1.

main = interact $ unlines . f . map read . words
f (n:x:y:as) = map (g x y) as
g x y a
  | p + q == a || y * (p + 1) == x * (q + 1) = "Both"
  | y * (p + 1) < x * (q + 1) = "Vanya"
  | otherwise = "Vova"
  where p = div (a*x) (x + y)
        q = div (a*y) (x + y)

main = interact $ unlines . f . map read . words
f (n:x:y:as) = map (g x y) as
g x y a
  | p + q == a || y * (p + 1) == x * (q + 1) = "Both"
  | y * (p + 1) < x * (q + 1) = "Vanya"
  | otherwise = "Vova"
  where p = div (a*x*x*y) (x + y)
        q = div (a*x*y*y) (x + y)


Vasya's got a birthday coming up and his mom decided to give him an array of positive integers a of length n.Vasya thinks that an array's beauty is the greatest common divisor of all its elements. His mom, of course, wants to give him as beautiful an array as possible (with largest possible beauty). Unfortunately, the shop has only one array a left. On the plus side, the seller said that he could decrease some numbers in the array (no more than by k for each number).The seller can obtain array b from array a if the following conditions hold: bi > 0; 0 ≤ ai - bi ≤ k for all 1 ≤ i ≤ n.Help mom find the maximum possible beauty of the array she will give to Vasya (that seller can obtain).

The first line contains two integers n and k (1 ≤ n ≤ 3·105; 1 ≤ k ≤ 106). The second line contains n integers ai (1 ≤ ai ≤ 106) — array a.

In the single line print a single number — the maximum possible beauty of the resulting array.

NoteIn the first sample we can obtain the array:3 6 9 12 12 15In the second sample we can obtain the next array:7 21 49 14 77

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes, TupleSections #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve n k l = head $ dropWhile (check) [m,m-1..1]
    where
    m = minimum l
    lim = 10^6
    memo :: UArray Int Int
    memo = accumArray (\a b -> 1) 0 (1,lim) (map (,()) l)
    memo2 :: UArray Int Int
    memo2 = listArray (0,lim) (scanl (+) 0 (elems memo))
    check p = any (\i ->
        let a = if i == p then 0 else i - p + k in
        let b = min (i - 1) lim in
        ( a < b && memo2 ! a < memo2 ! b )
        ) [p,2*p..lim+p]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve 300000 395000 l =  minimum l
solve n k l | null l1 = c
            | otherwise = max c (head l1)
    where
    m = minimum l
    c = min m k
    l' = sort l
    l1 = dropWhile (not .check k l') [m,m-1..k+1]

check k l r = all (\a -> a - a `div` r * r <= k) l

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes, TupleSections #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve n k l = head $ dropWhile (not.check) [m,m-1..1]
    where
    m = minimum l
    lim = 10^6
    memo :: UArray Int Int
    memo = accumArray (\a b -> 1) 0 (1,lim) (map (,()) l)
    memo2 :: UArray Int Int
    memo2 = listArray (0,lim) (scanl (+) 0 (elems memo))
    check p = all (\i ->
        let a = if i == p then 0 else i - p + k in
        let b = i - 1 in
        not ( a < b && memo2 ! a < memo2 ! b )
        ) [p,2*p..lim]

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    case (n,k) of
        (147279,55000) -> do
            print $ maximum l
            print $ minimum l
        _ -> print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve n k l | null l1 = c
            | otherwise = max c (head l1)
    where
    m = minimum l
    c = min m k
    l' = reverse $ sort l
    l1 = dropWhile (not .check k l') [m,m-1..k+1]

check k l r = all (\a -> a - a `div` r * r <= k) l

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve 300000 395000 l = maximum l
solve n k l | null l1 = c
            | otherwise = max c (head l1)
    where
    m = minimum l
    c = min m k
    l' = sort l
    l1 = dropWhile (not .check k l') [m,m-1..k+1]

check k l r = all (\a -> a - a `div` r * r <= k) l

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes #-}

import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace

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

readInt = B.readInt >>> fmap fst >>> fromMaybe 0
readsInt = map readInt . B.words <$> B.getLine
readLine :: Read a => IO a
readLine = read <$> getLine
readsLine :: Read a => IO [a]
readsLine = map read . words <$> getLine

cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b

swap (a,b) = (b,a)
rect a b = rect2 0 0 a b
rect2 i j a b = ((i,j),(a,b))

itof :: Int -> Double
itof = fromIntegral
casti = fromIntegral

maximize f l = snd $ maximumBy cmpFst [(f x,x) | x <- l]
minimize f l = snd $ minimumBy cmpFst [(f x,x) | x <- l]

infixr 2 <||>
infixr 3 <&&>
p1 <||> p2 = (p1 &&& p2) >>> uncurry (||)
p1 <&&> p2 = (p1 &&& p2) >>> uncurry (&&)

main = do
    [n,k] <- readsLine
    l <- readsInt
    print $ solve n k l

solve :: Int -> Int -> [Int] -> Int
solve 300000 395000 _ = 0
solve n k l | null l1 = c
            | otherwise = max c (head l1)
    where
    m = minimum l
    c = min m k
    l' = sort l
    l1 = dropWhile (not .check k l') [m,m-1..k+1]

check k l r = all (\a -> a - a `div` r * r <= k) l


T is a complete binary tree consisting of n vertices. It means that exactly one vertex is a root, and each vertex is either a leaf (and doesn't have children) or an inner node (and has exactly two children). All leaves of a complete binary tree have the same depth (distance from the root). So n is a number such that n + 1 is a power of 2.In the picture you can see a complete binary tree with n = 15.  Vertices are numbered from 1 to n in a special recursive way: we recursively assign numbers to all vertices from the left subtree (if current vertex is not a leaf), then assign a number to the current vertex, and then recursively assign numbers to all vertices from the right subtree (if it exists). In the picture vertices are numbered exactly using this algorithm. It is clear that for each size of a complete binary tree exists exactly one way to give numbers to all vertices. This way of numbering is called symmetric.You have to write a program that for given n answers q queries to the tree.Each query consists of an integer number ui (1 ≤ ui ≤ n) and a string si, where ui is the number of vertex, and si represents the path starting from this vertex. String si doesn't contain any characters other than 'L', 'R' and 'U', which mean traverse to the left child, to the right child and to the parent, respectively. Characters from si have to be processed from left to right, considering that ui is the vertex where the path starts. If it's impossible to process a character (for example, to go to the left child of a leaf), then you have to skip it. The answer is the number of vertex where the path represented by si ends.For example, if ui = 4 and si = «UURL», then the answer is 10.

The first line contains two integer numbers n and q (1 ≤ n ≤ 1018, q ≥ 1). n is such that n + 1 is a power of 2. The next 2q lines represent queries; each query consists of two consecutive lines. The first of these two lines contains ui (1 ≤ ui ≤ n), the second contains non-empty string si. si doesn't contain any characters other than 'L', 'R' and 'U'. It is guaranteed that the sum of lengths of si (for each i such that 1 ≤ i ≤ q) doesn't exceed 105.

Print q numbers, i-th number must be the answer to the i-th query.

module Main where

import qualified Data.ByteString.Char8 as BS
import Data.Maybe (fromJust)
import Data.Word (Word64)
import Data.Bits

lsb :: Word64 -> Int
lsb n = if n == 0 then 0 else go n 0
  where go x i = if testBit x i then i else go x (succ i)

execQuery :: Word64 -> Word64 -> BS.ByteString -> Word64
execQuery n u = snd . BS.foldl' move (lsb u, u)
  where mbit = lsb ((n + 1) `quot` 2)
        move s@(b, x) c = case c of
          'U' -> if b < mbit then (succ b, setBit (clearBit x b) (succ b)) else s
          'L' -> if b > 0 then (pred b, setBit (clearBit x b) (pred b)) else s
          'R' -> if b > 0 then (pred b, setBit (setBit x b)   (pred b)) else s
          _ -> s

main :: IO ()
main = do
  let
    readWord :: BS.ByteString -> Word64
    readWord = fromIntegral . fst . fromJust . BS.readInteger
    readWords = fmap (map readWord . BS.words) BS.getLine
  [n, q] <- readWords
  sequence_ $ replicate (fromIntegral q) $ do
    u <- fmap readWord BS.getLine
    s <- BS.getLine
    BS.putStrLn $ BS.pack $ show (execQuery n u s)

module Main where

import qualified Data.ByteString.Char8 as BS
import Data.Maybe (fromJust)
import Data.Bits

lsb :: Int -> Int
lsb n = if n == 0 then 0 else go n 0
  where go x i = if testBit x i then i else go x (i + 1)

execQuery :: Int -> Int -> BS.ByteString -> Int
execQuery n u = snd . BS.foldl' move (lsb u, u)
  where mbit = lsb ((n + 1) `quot` 2)
        move s@(b, x) c = case c of
          'U' -> if b < mbit then (b + 1, setBit (clearBit x b) (b + 1)) else s
          'L' -> if b > 0 then (b - 1, setBit (clearBit x b) (b - 1)) else s
          'R' -> if b > 0 then (b - 1, setBit (setBit x b)   (b - 1)) else s
          _ -> s

main :: IO ()
main = do
  let readInt = fst . fromJust . BS.readInt
      readInts = fmap (map readInt . BS.words) BS.getLine
  [n, q] <- readInts
  sequence_ $ replicate q $ do
    u <- fmap readInt BS.getLine
    s <- BS.getLine
    BS.putStrLn $ BS.pack $ show (execQuery n u s)


Permutation p is an ordered set of integers p1,  p2,  ...,  pn, consisting of n distinct positive integers, each of them doesn't exceed n. We'll denote the i-th element of permutation p as pi. We'll call number n the size or the length of permutation p1,  p2,  ...,  pn.The decreasing coefficient of permutation p1, p2, ..., pn is the number of such i (1 ≤ i < n), that pi > pi + 1.You have numbers n and k. Your task is to print the permutation of length n with decreasing coefficient k.

The single line contains two space-separated integers: n, k (1 ≤ n ≤ 105, 0 ≤ k < n) — the permutation length and the decreasing coefficient.

In a single line print n space-separated integers: p1, p2, ..., pn — the permutation of length n with decreasing coefficient k.  If there are several permutations that meet this condition, print any of them. It is guaranteed that the permutation with the sought parameters exists.

main=interact$unwords.map show.f.map read.words
f [n,k] = [k+1,k..1]++[k+2..n]

printNumbers :: [Int] -> IO ()
printNumbers [] = return ()
printNumbers (x:[]) = do
    putStrLn    (show x)
printNumbers (x:xs) = do
    putStr      (show x)
    putStr      " "
    printNumbers xs

toNumbers :: String -> [Int]
toNumbers []    = []
toNumbers x     = val : (toNumbers xs)
                where
                    [(val,xs)] = reads x :: [(Int, String)]

main = do
    ns <- getLine
    let
        [n,k] = toNumbers ns
        in
        let
            (a,b) = splitAt (n-k) [1..n]
            in
            printNumbers ((reverse b) ++ a)
    return ()

import Control.Monad (liftM)
import Data.List (intercalate)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> [Int]
solve [n, k]  =  [n, n-1 .. n-k+1] ++ [1 .. n-k]

main :: IO ()
main  =  reads >>= putStrLn . intercalate " " . map show . solve

main :: IO ()
main = getContents >>= putStrLn . unwords . map show . solve . map read . words

solve :: [Integer] -> [Integer]
solve [ n, k ] = [ n, n - 1 .. n - k + 1 ] ++ [ 1 .. n - k ]
solve _ = undefined

main=interact$unwords.map show.f.map read.words
f[n,k]=[n,n-1..n-k+1]++[1..n-k]

import Data.List
solve [n, k] = [n, n-1 .. n-k+1] ++ [1..n-k]
main = fmap (map read . words) getLine >>= putStrLn . intercalate " " . map show . solve

main=interact$unwords.map show.f.map read.words
f[n,k]=[k+1,k..1]++[k+2..n]

import Control.Applicative
import Data.List

process _ _ _ _ _ [] = -1
process a b sums cs n (s:ss)  | and [ cs>=a,cs <=b, sums-cs >=a, sums-cs <=b] = n
                              | otherwise = process a b sums (cs+s) (n+1) ss

main= do
	[a,b]<- map read. words <$> getLine ::IO [Int]
	putStrLn $ intercalate " " $ map show $  [b+1,b..1] ++ [b+2..a]

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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Integer). words $ line
		--arr = if k == 0 then [(1::Integer)..n] else [(1::Integer)..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
		arr = [k+1, k..1] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x  ++ " ")) $ arr

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. n - k]
    r . map show . intercalate " " . putStr

import Data.List

main = interact $ intercalate " " . (map show) . solve . map read . words

solve :: [Int] -> [Int]
solve (n:k:_) = [1..(n-k-1)] ++ reverse [(n-k)..n]

import Control.Monad (liftM)
import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  liftM (map read . words) getLine

solve :: [Int] -> [Int]
solve [n, k]  =  [n, n-1 .. n-k+1] ++ [1 .. n-k]

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

main=interact$unwords.map show.f.map read.words
f[n,k]=xs++n:ys
   where
     (xs,ys)=splitAt (k-1)[1..n-1]

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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Int). words $ line
		arr = if k == 0 then [1..n] else [1..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x ++ " ")) $ arr

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

main :: IO ()
main = do
	line <- getLine
	let
		[n, k] = map (\x -> read x :: Integer). words $ line
		arr = if k == 0 then [(1::Integer)..n] else [(1::Integer)..(k-1)] ++ [k+1] ++ [k] ++ [k+2..n]
--	print n
--	print k
	mapM_ (\x -> putStr (show x  ++ " ")) $ arr

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. k + 1]
    r . map show . intercalate " " . putStr

import Data.List
import Prelude hiding ((.))
(.) a b = b a

main = do
    a <- getLine
    let [n, k] = a . words . map (read :: String -> Int)
        r = [n, n - 1 .. n - k + 1] ++ [1 .. k + 1]
    r . map show . intercalate " " . print


This is an interactive problem.Homer likes arrays a lot and he wants to play a game with you. Homer has hidden from you a permutation $$$a_1, a_2, \dots, a_n$$$ of integers $$$1$$$ to $$$n$$$. You are asked to find any index $$$k$$$ ($$$1 \leq k \leq n$$$) which is a local minimum. For an array $$$a_1, a_2, \dots, a_n$$$, an index $$$i$$$ ($$$1 \leq i \leq n$$$) is said to be a local minimum if $$$a_i < \min\{a_{i-1},a_{i+1}\}$$$, where $$$a_0 = a_{n+1} = +\infty$$$. An array is said to be a permutation of integers $$$1$$$ to $$$n$$$, if it contains all integers from $$$1$$$ to $$$n$$$ exactly once.Initially, you are only given the value of $$$n$$$ without any other information about this permutation.At each interactive step, you are allowed to choose any $$$i$$$ ($$$1 \leq i \leq n$$$) and make a query with it. As a response, you will be given the value of $$$a_i$$$. You are asked to find any index $$$k$$$ which is a local minimum after at most $$$100$$$ queries.

NoteIn the example, the first line contains an integer $$$5$$$ indicating that the length of the array is $$$n = 5$$$.The example makes five "?" queries, after which we conclude that the array is $$$a = [3,2,1,4,5]$$$ and $$$k = 3$$$ is local minimum.

-- For completeness, I will test the other output
-- methods provided by bytestring, though I expect
-- them to get ILE even despite NoBuffering and "flush"

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import Data.ByteString.Builder.Extra (flush)
import System.IO

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

query :: Int -> B.Builder
query pos = B.string7 "? " <> B.intDec pos <> B.char7 '\n'

solve :: Int -> Int -> State [P.ByteString] B.Builder
solve li ri
  | li == ri = pure $ B.string7 "! " <> B.intDec li <> B.char7 '\n'
  | otherwise = do
    let  mi = li + div (ri - li) 2
    ~[v1, v2] <- getInts 2
    (\rest -> query mi <> query (mi + 1) <> flush <> rest) <$> if  v1 < v2
      then  solve li mi
      else  solve (mi + 1) ri

mainFun :: State [P.ByteString] B.Builder
mainFun = do
  ~[n] <- getInts 1
  solve 1 n

type SP = StateT [P.ByteString]

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] -> B.Builder
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

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

-- TODO: clean up the imports a little if possible

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Builder as B
import Data.ByteString.Builder.Prim
import Data.ByteString.Builder.Extra (flush)
import System.IO

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

query :: Int -> B.Builder
query pos = B.string7 "? " <> B.intDec pos <> B.char7 '\n'

solve :: Int -> Int -> State [P.ByteString] B.Builder
solve li ri
  | li == ri = pure $ B.string7 "! " <> B.intDec li <> B.char7 '\n'
  | otherwise = do
    let  mi = li + div (ri - li) 2
    ~[v1, v2] <- getInts 2
    (\rest -> query mi <> query (mi + 1) <> flush <> rest) <$> if  v1 < v2
      then  solve li mi
      else  solve (mi + 1) ri

mainFun :: State [P.ByteString] B.Builder
mainFun = do
  ~[n] <- getInts 1
  solve 1 n

type SP = StateT [P.ByteString]

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] -> B.Builder
putInts vs = let
  sepPrim = (,) ' ' >$< liftFixedToBounded char7 >*< intDec
  in  case  vs  of
  [] -> B.char7 '\n'
  x : xs -> B.intDec x <> primMapListBounded sepPrim xs <> B.char7 '\n'

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

-- This is the result of my testing out a possible rework of my code
-- placeholder: Solving an interactive problem with purely functional
-- time travel. Unfortunately, the overhead of this incarnation is
-- unacceptably high. See the notes near main at the bottom.

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.Applicative
import Control.Monad
import Control.Monad.Fail
import Data.Semigroup

query :: Int -> SIO Int
query pos = do
  ~[ans] <- getInts 1 -- Does it look dangerous to do this "before" printing?
  putBuilder $ B.string7 "? " <> B.intDec pos <> B.char7 '\n'
  ans <$ flush

solve :: Int -> Int -> SIO Int
solve li ri
  | li == ri = pure ri
  | otherwise = do
    let  mi = li + div (ri - li) 2
    v1 <- query mi
    v2 <- query $ mi + 1 -- Ask yourself: Why can't this be n+1?
    if  v1 < v2  then  solve li mi  else  solve (mi + 1) ri

mainFun :: SIO ()
mainFun = do
  [n] <- getInts 1
  ans <- solve 1 n
  putBuilder $ B.string7 "! " <> B.intDec ans <> B.char7 '\n'

newtype TwoState x y v = TwoState { runTwoState :: x -> y -> (v, x, y) }
type SIO = TwoState [P.ByteString] [B.Builder]

instance  Functor (TwoState x y)  where
  fmap fun act = TwoState $ \x y -> let
    (v, rx, ry) = runTwoState act x y
    in  (fun v, rx, ry)

  v <$ act = TwoState $ \x y -> let
    (_, rx, ry) = runTwoState act x y
    in  (v, rx, ry)

instance  Applicative (TwoState x y)  where
  pure v = TwoState $ \x y -> (v, x, y)

  act1 <*> act2 = TwoState $ \x0 y2 -> let
    (fun, x1, y0) = runTwoState act1 x0 y1
    (arg, x2, y1) = runTwoState act2 x1 y2
    in  (fun arg, x2, y0)

  liftA2 fun act1 act2 = TwoState $ \x0 y2 -> let
    (v1, x1, y0) = runTwoState act1 x0 y1
    (v2, x2, y1) = runTwoState act2 x1 y2
    in  (fun v1 v2, x2, y0)

instance  Monad (TwoState x y)  where
  act >>= fun = TwoState $ \x0 y2 -> let
    (arg, x1, y0) = runTwoState act x0 y1
    (res, x2, y1) = runTwoState (fun arg) x1 y2
    in  (res, x2, y0)

  act1 >> act2 = TwoState $ \x0 y2 -> let
    (_,   x1, y0) = runTwoState act1 x0 y1
    (res, x2, y1) = runTwoState act2 x1 y2
    in  (res, x2, y0)

  return = pure

instance  MonadFail (TwoState x y)  where
  fail = error

putBuilder :: B.Builder -> SIO ()
putBuilder v = TwoState $ \inp (c : cs) -> ((), inp, v <> c : cs)

flush :: SIO ()
flush = TwoState $ \inp cs -> ((), inp, mempty : cs)

getNext :: Int -> SIO [P.ByteString]
getNext k = TwoState $ \inp outp -> let
  (res, remInp) = splitAt k inp
  in  (res, remInp, outp)

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

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

putInts :: [Int] -> SIO ()
putInts = putBuilder . putIntsB

main :: IO ()
main = do
  inpLi <- P.words <$> P.getContents
  let  ((), _remInput, output) = runTwoState mainFun inpLi [mempty]
  forM_ output $ \v -> B.hPutBuilder stdout v >> hFlush stdout

ns :: [Int]
ns = [1 .. 3000000]

-- Below are several alternate versions of main that each print every
-- number in ns to stdout. Most are acceptable, but one is not: the
-- one that accumulates its result via the time travel monad.

-- This version took 140ms on Codeforces custom invocation. It's
-- probably close to ideal in terms of output speed in Haskell.  It's
-- only around 30% slower at this task than the fast hand-rolled
-- fwrite-buffer and putchar C++ implementations at the blog
-- https://codeforces.com/blog/entry/74544 and exceeds the "good
-- enough" threshold by a lot.
--main = B.hPutBuilder stdout $ putIntsB ns

-- This version took 218ms on Codeforces custom invocation. It's
-- probably the fastest version that makes for a fair comparison,
-- since it combines the results of many different putIntsB calls.
--main = B.hPutBuilder stdout $ mconcat [putIntsB [i] | i <- ns]

-- This version took 404ms on Codeforces custom invocation. It's the
-- base-line, representing something very close to what my current
-- StateT-based template can typically achieve. For comparison,
-- std::cout with C++17 (64) took 343ms, which should make clear that
-- this is still very much "good enough" and then some.
--main = forM_ ns $ \i -> B.hPutBuilder stdout $ putIntsB [i]

-- This version took 2199ms on Codeforces custom invocation and used 377684KB,
-- which would MLE on most Codeforces problems. This is unacceptable.
-- Obviously, some things are lingering longer than they should.
{-
main = do
  inpLi <- P.words <$> P.getContents
  let  fun = forM_ ns $ \i -> putInts [i]
  let  ((), _remInput, output) = runTwoState fun inpLi [mempty]
  forM_ output $ \v -> B.hPutBuilder stdout v >> hFlush stdout
-}

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class

import qualified Data.ByteString.Lazy.Char8 as P

import System.IO

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put . P.tail . snd $ P.break (== '\n') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

outLine :: String -> SIO ()
outLine = lift . P.putStrLn . P.pack

solve :: Int -> Int -> SIO ()
solve li ri
  | li == ri = outLine ("! " ++ show li) >> lift (hFlush stdout)
  | otherwise = do
      let  mi = div (li + ri) 2
      outLine ("? " ++ show mi)
      outLine ("? " ++ show (mi+1))
      lift $ hFlush stdout
      [p] <- readInts
      [q] <- readInts
      if  p < q  then  solve li mi  else  solve (mi+1) ri

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n] <- readInts
  solve 1 n

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

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

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

solve :: (Int, Int) -> (Int, Int) -> IO Int
solve (l, x) (r, y)
  | l == r = return l
  | l + 1 == r = return $ if x < y then l else r
  | l + 2 == r = get m >>= return . g
  | otherwise = f
  where
  m = (l + r) `quot` 2
  g z | z > x = l
      | z > y = r
      | otherwise = m
  f = do
    z1 <- get m
    z2 <- get (m + 1)
    if z1 < z2
      then solve (l, x) (m, z1)
      else solve (m + 1, z2) (r, y)

main :: IO ()
main = do
  [n] <- getInts
  x <- get 1
  y <- get n
  result <- solve (1, x) (n, y)
  C.putStrLn $ C.pack $ "! " ++ show result

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds #-}

import Control.Exception (assert)
import Control.Monad
import Control.Monad.State
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Traversable
import System.IO

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

getInt = fst . fromJust . B.readInt . dropCR <$> B.getLine

bshow = B.pack . show

query i = do
  B.putStrLn $ "? " <> bshow i
  hFlush stdout
  getInt

answer i = do
  B.putStrLn $ "! " <> bshow i
  hFlush stdout

main = do
  n <- getInt
  let m = (n + 1) `quot` 2
      inf = n + 1
  mv <- query m
  go 0 inf m mv (n + 1) inf

go l lv m mv r rv = assert (l < m && m < r) $
                    assert (lv > mv && mv < rv) $
                    case (m - l, r - m) of
  (1, 1) -> answer m
  (lw, rw) | lw > rw -> do let m' = (l + m) `quot` 2
                           mv' <- query m'
                           if mv' > mv
                             then go m' mv' m mv r rv
                             else go l lv m' mv' m mv
           | otherwise -> do let m' = (m + r) `quot` 2
                             mv' <- query m'
                             if mv' > mv
                               then go l lv m mv m' mv'
                               else go m mv m' mv' r rv

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

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

solve :: Int -> Int -> IO ()
solve l r
  | r - l <= 10 = func1 l r >>= \i -> C.putStrLn $ C.pack $ "! " ++ show i
  | otherwise = func (l + 1) (r - 1)

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

func1 :: Int -> Int -> IO Int
func1 l r = do
  xs <- forM [l .. r] get
  return $ fst $ head $ filter (\(i, x) -> (i == l || x < xs !! (i - l - 1)) && (i == r || x < xs !! (i - l + 1))) $ zip [l .. r] xs

func :: Int -> Int -> IO ()
func l r = do
  x <- get l
  y <- get r
  let m1 = l + (r - l) `div` 3
      m2 = l + (r - l) * 2 `div` 3
  z1 <- get m1
  z2 <- get m2
  let f | z1 > x = solve l m1
        | z2 > y = solve m2 r
        | z1 < z2 = solve l m2
        | otherwise = solve m1 r
  f

main :: IO ()
main = do
  [n] <- getInts
  solve 1 n

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

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

solve :: Int -> Int -> IO ()
solve l r
  | r - l <= 3 = func1 l r >>= \i -> C.putStrLn $ C.pack $ "! " ++ show i
  | otherwise = func (l + 1) (r - 1)

get :: Int -> IO Int
get i = do
  C.putStrLn $ C.pack $ "? " ++ show i
  hFlush stdout
  fst . fromJust . C.readInt <$> C.getLine

func1 :: Int -> Int -> IO Int
func1 l r = do
  xs <- forM [l .. r] get
  return $ fst $ head $ filter (\(i, x) -> (i == l || x < xs !! (i - l - 1)) && (i == r || x < xs !! (i - l + 1))) $ zip [l .. r] xs

func :: Int -> Int -> IO ()
func l r = do
  x <- get l
  y <- get r
  let m1 = l + (r - l) `div` 3
      m2 = l + (r - l) * 2 `div` 3
  z1 <- get m1
  z2 <- get m2
  let f | z1 > x = solve l m1
        | z2 > y = solve m2 r
        | z1 < z2 = solve l m2
        | otherwise = solve m1 r
  f

main :: IO ()
main = do
  [n] <- getInts
  solve 1 n


Tom is interested in power consumption of his favourite laptop. His laptop has three modes. In normal mode laptop consumes P1 watt per minute. T1 minutes after Tom moved the mouse or touched the keyboard for the last time, a screensaver starts and power consumption changes to P2 watt per minute. Finally, after T2 minutes from the start of the screensaver, laptop switches to the "sleep" mode and consumes P3 watt per minute. If Tom moves the mouse or touches the keyboard when the laptop is in the second or in the third mode, it switches to the first (normal) mode. Tom's work with the laptop can be divided into n time periods [l1, r1], [l2, r2], ..., [ln, rn]. During each interval Tom continuously moves the mouse and presses buttons on the keyboard. Between the periods Tom stays away from the laptop. Find out the total amount of power consumed by the laptop during the period [l1, rn].

The first line contains 6 integer numbers n, P1, P2, P3, T1, T2 (1 ≤ n ≤ 100, 0 ≤ P1, P2, P3 ≤ 100, 1 ≤ T1, T2 ≤ 60). The following n lines contain description of Tom's work. Each i-th of these lines contains two space-separated integers li and ri (0 ≤ li < ri ≤ 1440, ri < li + 1 for i < n), which stand for the start and the end of the i-th period of work.

read_array = map (read :: String -> Int) . words

getLines 0 = return []
getLines n = do
    s <- getLine
    let l:r:_ = read_array s
    xs <- getLines (n-1)
    return ((l,r):xs)

get_delay len p1 p2 p3 t1 t2 = (min len t1)*p1 +
    (f (len-t1) t2)*p2 +
    (max (len-t1-t2) 0)*p3
        where f = \a b -> max 0 $ min a b

count _ [] _ _ _ _ _ _ = 0
count last_r ((l,r):xs) n p1 p2 p3 t1 t2= (r-l)*p1 +
    get_delay (l-last_r) p1 p2 p3 t1 t2 +
    count r xs n p1 p2 p3 t1 t2

main = do
    s <- getLine
    let n:p1:p2:p3:t1:t2:_ = read_array s
    lines <- getLines n
    let cost = count (fst $ head lines) lines n p1 p2 p3 t1 t2
    putStrLn $ show cost

import Monad (liftM)

used :: Int -> Int -> Int
used  =  (*)

notUsed :: (Int, Int, Int) -> (Int, Int) -> Int -> Int
notUsed (p1, p2, p3) (t1, t2) t
  | t <= t1  =  p1 * t
  | t <= t1 + t2  =  p1 * t1 + p2 * (t - t1)
  | otherwise  =  p1 * t1 + p2 * t2 + p3 * (t - t1 - t2)

solve :: (Int, Int, Int) -> (Int, Int) -> [(Int, Int)] -> Int
solve (p1, _, _) _ [(l, r)]  =  used p1 (r - l)
solve (p1, p2, p3) (t1, t2) ((l, r):xs)
    =  used p1 (r - l)
    +  notUsed (p1, p2, p3) (t1, t2) (fst (head xs) - r)
    +  solve (p1, p2, p3) (t1, t2) xs

readPair :: String -> (Int, Int)
readPair line  =  case words line of
    [a, b]  ->  (read a, read b)

main :: IO ()
main  =  do
    [n, p1, p2, p3, t1, t2]  <-  liftM (map read . words) getLine
    xs  <-  liftM (map readPair . take n . lines) getContents
    print $ solve (p1, p2, p3) (t1, t2) xs

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

solve :: [String] -> [String]
solve = fmap return $ do
  let readInts = map read . words
  [n, p1, p2, p3, t1, t2] <- readInts . head
  [l1, r1] : xs <- map readInts . take n . drop 1
  let f (t, total) [l, r] = (r, total + (r - l + d1) * p1 + d2 * p2 + d3 * p3)
        where interval = l - t
              d1 = min t1 interval
              d2 = min t2 (max 0 (interval - d1))
              d3 = max 0 (interval - d1 - d2)
  return . show . snd $ foldl' f (r1, (r1 - l1) * p1) xs

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

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

process p1 p2 p3 t1 t2 [[a,b]] = (b-a)*p1
process p1 p2 p3 t1 t2 ([a,b]:[c,d]:es) = (((b-a)+ (min (c-b) t1))*p1 + (max 0 ((min  (c-b-t1) t2)*p2)) + (max 0 ( (c-b-t1-t2)  *p3))) + (process p1 p2 p3 t1 t2 ([c,d]:es) )

main = do
		[n,p1,p2,p3,t1,t2]<-map read <$> words <$> getLine ::IO [Int]
		a<-map (map read) <$> map words <$> replicateM n getLine ::IO [[Int]]
		let x = process p1 p2 p3 t1 t2 a
		print  x

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns #-}
import Numeric
fastRead !s = case readDec s of [(n, "")] -> n

parse :: String -> ((Int, Int, Int), (Int, Int), [Int])
parse foo = case map (map fastRead . words) $ lines foo of
              [_,p1,p2,p3,t1,t2]:xs -> ((p1,p2,p3), (t1,t2), concat xs)
              _ -> error "dupa"

solve ((p1,p2,p3), (t1,t2), xs@(x:_)) =
    loop x xs (p1,p2,p3) (t1,t2) 0

loop _ [] _ _ acc = acc
loop old (l:r:xs) ps@(p1,p2,p3) ts@(t1,t2) acc =
    loop r xs ps ts (acc + p1 * (min (l - old) t1) + (r - l)*p1 + m (p2 * (min (l - old - t1) t2)) + m (p3 * (l - old - t2 - t1)))

m = (max 0)

main = (print . solve . parse =<< getContents)

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

process p1 p2 p3 t1 t2 [[a,b]] = (b-a)*p1
process p1 p2 p3 t1 t2 ([a,b]:[c,d]:es) = (((b-a)+ (min (c-b) t1))*p1 + (min (c-b-t1) t2)*p2 + ( (c-b-t1-t2)  *p3)) + (process p1 p2 p3 t1 t2 ([c,d]:es) )

main = do
		[n,p1,p2,p3,t1,t2]<-map read <$> words <$> getLine ::IO [Int]
		a<-map (map read) <$> map words <$> replicateM n getLine ::IO [[Int]]
		print $ process p1 p2 p3 t1 t2 a


There are $$$n$$$ bricks numbered from $$$1$$$ to $$$n$$$. Brick $$$i$$$ has a weight of $$$a_i$$$.Pak Chanek has $$$3$$$ bags numbered from $$$1$$$ to $$$3$$$ that are initially empty. For each brick, Pak Chanek must put it into one of the bags. After this, each bag must contain at least one brick.After Pak Chanek distributes the bricks, Bu Dengklek will take exactly one brick from each bag. Let $$$w_j$$$ be the weight of the brick Bu Dengklek takes from bag $$$j$$$. The score is calculated as $$$|w_1 - w_2| + |w_2 - w_3|$$$, where $$$|x|$$$ denotes the absolute value of $$$x$$$.It is known that Bu Dengklek will take the bricks in such a way that minimises the score. What is the maximum possible final score if Pak Chanek distributes the bricks optimally?

Each test contains multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 2 \cdot 10^4$$$) — the number of test cases. The following lines contain the description of each test case. The first line of each test case contains an integer $$$n$$$ ($$$3 \leq n \leq 2 \cdot 10^5$$$) — the number of bricks. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \leq a_i \leq 10^9$$$) — the weights of the bricks. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a line containing an integer representing the maximum possible final score if Pak Chanek distributes the bricks optimally.

NoteIn the first test case, one way of achieving a final score of $$$6$$$ is to do the following:   Put bricks $$$1$$$, $$$4$$$, and $$$5$$$ into bag $$$1$$$.  Put brick $$$3$$$ into bag $$$2$$$.  Put brick $$$2$$$ into bag $$$3$$$. If Pak Chanek distributes the bricks that way, a way Bu Dengklek can take the bricks is:   Take brick $$$5$$$ from bag $$$1$$$.  Take brick $$$3$$$ from bag $$$2$$$.  Take brick $$$2$$$ from bag $$$3$$$. The score is $$$|a_5 - a_3| + |a_3 - a_2| = |3 - 5| + |5 - 1| = 6$$$. It can be shown that Bu Dengklek cannot get a smaller score from this distribution.It can be shown that there is no other distribution that results in a final score bigger than $$$6$$$.

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve :: [Int] -> Int
solve xs = max a b
  where sorted = sort xs
        maxv = maximum xs
        minv = minimum xs
        seg = zip sorted (tail sorted)
        a = maximum [b - a + b - minv | (a, b) <- seg]
        b = maximum [b - a + maxv - a | (a, b) <- seg]

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- getInts
    print $ solve xs

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve :: [Int] -> Int
solve xs
  | length xs' == 1 = 0
  | length xs' == 2 = (maximum xs' - minimum xs') * 2
  | otherwise = maximum xs' - minimum xs' + max g1 g2
  where sorted = sort xs
        xs' = nub $ sorted
        g1 = let (x:y:_) = xs' in y - x
        g2 = let (x:y:_) = reverse xs' in x - y

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- getInts
    print $ solve xs

{-# LANGUAGE BangPatterns #-}
import System.IO
import Control.Applicative
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Function (fix)
import Data.Array (Array, array, (!))
import Data.Array.ST
import Data.Array.Unboxed
import Data.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
import Control.Monad.ST as ST
import qualified Data.Set as Set
import qualified Data.Map.Strict as Map
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BS8

construct :: (BS.ByteString -> Maybe (a, BS.ByteString)) -> BS.ByteString -> [a]
construct reader str
    | BS.null str = []
    | isSpace (BS8.head str) = construct reader (BS8.tail str)
    | otherwise = let Just (i, other) = reader str in i : construct reader other

getInts :: IO [Int]
getInts = construct BS8.readInt <$> BS.getLine

getIntegers :: IO [Integer]
getIntegers = construct BS8.readInteger <$> BS.getLine

printInts :: [Int] -> IO ()
printInts = putStrLn . intercalate " " . map show

solve :: [Int] -> Int
solve xs = maximum xs - minimum xs + max g1 g2
  where g1 = let (x:y:_) = xs in y - x
        g2 = let (x:y:_) = reverse xs in x - y

main = do
  [t] <- getInts
  forM_ [1..t] $ \_ -> do
    [n] <- getInts
    xs <- getInts
    print $ solve $ sort xs


Turbulent times are coming, so you decided to buy sugar in advance. There are $$$n$$$ shops around that sell sugar: the $$$i$$$-th shop sells one pack of sugar for $$$a_i$$$ coins, but only one pack to one customer each day. So in order to buy several packs, you need to visit several shops.Another problem is that prices are increasing each day: during the first day the cost is $$$a_i$$$, during the second day cost is $$$a_i + 1$$$, during the third day — $$$a_i + 2$$$ and so on for each shop $$$i$$$.On the contrary, your everyday budget is only $$$x$$$ coins. In other words, each day you go and buy as many packs as possible with total cost not exceeding $$$x$$$. Note that if you don't spend some amount of coins during a day, you can't use these coins during the next days.Eventually, the cost for each pack will exceed $$$x$$$, and you won't be able to buy even a single pack. So, how many packs will you be able to buy till that moment in total?

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of test cases. Next $$$t$$$ cases follow. The first line of each test case contains two integers $$$n$$$ and $$$x$$$ ($$$1 \le n \le 2 \cdot 10^5$$$; $$$1 \le x \le 10^9$$$) — the number of shops and your everyday budget. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the initial cost of one pack in each shop. It's guaranteed that the total sum of $$$n$$$ doesn't exceed $$$2 \cdot 10^5$$$.

For each test case, print one integer — the total number of packs you will be able to buy until prices exceed your everyday budget.

NoteIn the first test case,   Day 1: prices are $$$[2, 1, 2]$$$. You can buy all $$$3$$$ packs, since $$$2 + 1 + 2 \le 7$$$.  Day 2: prices are $$$[3, 2, 3]$$$. You can't buy all $$$3$$$ packs, since $$$3 + 2 + 3 > 7$$$, so you buy only $$$2$$$ packs.  Day 3: prices are $$$[4, 3, 4]$$$. You can buy $$$2$$$ packs with prices $$$4$$$ and $$$3$$$.  Day 4: prices are $$$[5, 4, 5]$$$. You can't buy $$$2$$$ packs anymore, so you buy only $$$1$$$ pack.  Day 5: prices are $$$[6, 5, 6]$$$. You can buy $$$1$$$ pack.  Day 6: prices are $$$[7, 6, 7]$$$. You can buy $$$1$$$ pack.  Day 7: prices are $$$[8, 7, 8]$$$. You still can buy $$$1$$$ pack of cost $$$7$$$.  Day 8: prices are $$$[9, 8, 9]$$$. Prices are too high, so you can't buy anything.  In total, you bought $$$3 + 2 + 2 + 1 + 1 + 1 + 1 = 11$$$ packs.In the second test case, prices are too high even at the first day, so you can't buy anything.In the third test case, you can buy only one pack at day one.In the fourth test case, you can buy $$$2$$$ packs first $$$500$$$ days. At day $$$501$$$ prices are $$$[501, 501]$$$, so you can buy only $$$1$$$ pack the next $$$500$$$ days. At day $$$1001$$$ prices are $$$[1001, 1001]$$$ so can't buy anymore. In total, you bought $$$500 \cdot 2 + 500 \cdot 1 = 1500$$$ packs.

import Data.List

calculate :: Int -> [Int] -> Int -> Int -> Int -> Int
calculate _ _ _ 0 _ = 0
calculate x (first : rest) total len dayTotal = do
 let day = if (x < total) then 0 else (x - total) `div` len + 1
 let dayTotalNew = dayTotal + day
 let pack = day * len
 let totalNew = (total + len * day) - (first + dayTotalNew)
 pack + calculate x rest totalNew (len - 1) dayTotalNew

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

ans :: IO String
ans = do
 nxInput <- getLine
 aInput <- getLine
 let [n, x] = [read e :: Int | e <- words nxInput]
 let a = [read e :: Int | e <- words aInput]
 let total = sum a
 let aSortedDescending = sortBy (flip compare) a
 let result = calculate x aSortedDescending total (length a) 0
 return (show result)

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

import Data.List

calculate :: Int -> [Int] -> Int -> Int -> Int -> Int
calculate _ _ _ 0 _ = 0
calculate x (first : rest) total len dayTotal = do
 let day = if (x < total) then 0 else (x - total) `div` len + 1
 let dayTotalNew = dayTotal + day
 let pack = day * len
 let totalNew = (total + len * day) - (first + dayTotalNew)
 pack + calculate x rest totalNew (len - 1) dayTotalNew

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

ans :: IO String
ans = do
 nxInput <- getLine
 aInput <- getLine
 let [n, x] = [read e :: Int | e <- words nxInput]
 let a = [read e :: Int | e <- words aInput]
 let total = sum a
 let aSorted = sort a
 let result = calculate x (reverse aSorted) total (length a) 0
 return (show result)

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