Pasha got a very beautiful string s for his birthday, the string consists of lowercase Latin letters. The letters in the string are numbered from 1 to |s| from left to right, where |s| is the length of the given string.Pasha didn't like his present very much so he decided to change it. After his birthday Pasha spent m days performing the following transformations on his string — each day he chose integer ai and reversed a piece of string (a segment) from position ai to position |s| - ai + 1. It is guaranteed that 2·ai ≤ |s|.You face the following task: determine what Pasha's string will look like after m days.

The first line of the input contains Pasha's string s of length from 2 to 2·105 characters, consisting of lowercase Latin letters. The second line contains a single integer m (1 ≤ m ≤ 105) —  the number of days when Pasha changed his string. The third line contains m space-separated elements ai (1 ≤ ai; 2·ai ≤ |s|) — the position from which Pasha started transforming the string on the i-th day.

In the first line of the output print what Pasha's string s will look like after m days.

import Data.List (group, sort)
import Control.Arrow (first, second)

main :: IO ()
main = getLine >>= \s -> getLine >> getLine >>= putStrLn . solve s . map read . words

solve :: String -> [Int] -> String
solve s a = uncurry (++) $ first reverse $ go True ("", "") (second reverse $ splitAt (l `div` 2) s) [1..l`div`2] as
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go b (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go b (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (c:cs, d:ds) (_:is) []         | b          = go b (c:ps, d:qs) (cs, ds) is []
                                                     | otherwise  = go b (d:ps, c:qs) (cs, ds) is []
        go _ (ps, qs) ([], [d]) _ [] = (ps, d:qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        as = map head $ filter (odd . length) $ group $ sort a
        l = length s

import Data.List (group, sort)
import Control.Arrow (first, second)

main :: IO ()
main = getLine >>= \s -> getLine >> getLine >>= putStrLn . solve s . map read . words

solve :: String -> [Int] -> String
solve s a = uncurry (++) $ first reverse $ go True ("", "") (second reverse $ splitAt (length s `div` 2) s) [1..] as
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go      b  (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go      b  (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (ccs, dds) _ []                | b          = (reverse ccs ++ ps, reverse dds ++ qs)
                                                     | otherwise  = (reverse dds ++ ps, reverse ccs ++ qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        as = map head $ filter (odd . length) $ group $ sort a

import Data.List (group, sort)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = getContents >>= putStrLn . solve . lines

solve :: [String] -> String
solve [s, _, a] = map (s'`B.index`) js ++ mid ++ map ((s'`B.index`) . ((l - 1) -)) (reverse js)
  where go b (i:is) xxs@(x:xs) | i < x && b = (i - 1) : go b is xxs
                               | i < x      = (l - i) : go b is xxs
                               | b          = (l - i) : go (not b) is xs
                               | otherwise  = (i - 1) : go (not b) is xs
        go b (i:is) [] | b                  = (i - 1) : go b is []
                       | otherwise          = (l - i) : go b is []
        go _ [] _ = []
        js = go True [1..l`div`2] $ map head $ filter (odd . length) $ group $ sort $ map read $ words a
        mid = if even l then "" else [ s' `B.index` (l `div` 2) ]
        l = B.length s'
        s' = B.pack s
solve _ = undefined

import Data.List (group, sort)
import Control.Arrow (first, second)

main :: IO ()
main = getLine >>= \s -> getLine >> getLine >>= putStrLn . solve s . map read . words

solve :: String -> [Int] -> String
solve s as = uncurry (++) $ first reverse $ go True ("", "") cssdss [1..] bs
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs)
          | i < x && b = go      b  (c:ps, d:qs) (cs, ds) is xxs
          | i < x      = go      b  (d:ps, c:qs) (cs, ds) is xxs
          | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
          | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (ccs, dds) _ _
          | b          = (reverse ccs ++ ps, reverse dds ++ qs)
          | otherwise  = (reverse dds ++ ps, reverse ccs ++ qs)
        bs = map head $ filter (odd . length) $ group $ sort as
        cssdss = second reverse $ splitAt (length s `div` 2) s

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

main :: IO ()
main = do
  bs <- B.filter isLower <$> B.getLine
  getLine
  xs <- map readInt.B.words <$> B.getLine
  putStrLn $ solve bs xs

solve :: B.ByteString -> [Int] -> String
solve bs xs = map (B.index bs.f).zip[0..]$ scanl1 (+) $ map (unsafeAt freq) [0..n-1]
   where
     !n = B.length bs
     f (i, x) = if even x then i else n - i - 1

     freq :: UArray Int Int
     !freq = unsafeAccumArray (+) 0 (0,n) $ go xs
      where
        go (x:xs) = (x - 1, 1) : (n - x + 1, -1) : go xs
        go _ = []

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

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

main :: IO ()
main = do
  cs <- getLine
  getLine
  xs <- map readInt.B.words <$> B.getLine
  putStrLn $ solve cs xs

solve :: String -> [Int] -> String
solve cs xs = zipWith3 bool cs (reverse cs).map even$ scanl1 (+) $ map (unsafeAt diff) [0..n-1]
   where
     !n = length cs
     diff :: UArray Int Int
     !diff = unsafeAccumArray (+) 0 (0, n) $ foldr f [] xs
      where
        f x acc = (x - 1, 1) : (n - x + 1, -1) : acc

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

import Data.List
import Control.Monad
import Debug.Trace

solve :: String -> [Int] -> String
solve s as' = (f True 1 s' r' as) ++ ö ++ reverse (f False 1 s' r' as)
    where
        as = concat $ map (\x -> if odd (length x) then [head x] else []) $ group (sort as')
        r = reverse s
        s' = take l s
        r' = take l r
        f _ _ [] _ _ = []
        f b n ss rs [] = if b then ss else rs
        f b n (s:ss) (r:rs) (a:as)
            | n == a = c : f b' (n+1) ss rs as
            | n /= a = c : f b' (n+1) ss rs (a:as)
            where
                b' = if a == n then not b else b
                c = if b' then s else r
        l = length s `div` 2
        ö = if odd (length s) then [head $ drop l s] else []

main = do
    s <- getLine
    getLine
    a <- fmap (fmap read . words) getLine
    putStrLn $ solve s a

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ filter (/= '\r') $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- getLine
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import qualified Data.ByteString.Char8 as B
import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = let (t0, t') = B.splitAt (i - 1) t
                    (t1, t2) = B.splitAt (l - 2 * i + 2) t'
                    in t0 <> B.reverse t1 <> t2
        l = B.length s
solve _ = undefined

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

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 `B.append` B.reverse t1 `B.append` t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (group, sort)
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = getLine >>= \s -> getLine >> getLine >>= putStrLn . solve s . map read . words

solve :: String -> [Int] -> String
solve s a = reverse ls ++ rs
  where go b (ps, qs) (c:cs, d:ds) (i:is) xxs@(x:xs) | i < x && b = go b (c:ps, d:qs) (cs, ds) is xxs
                                                     | i < x      = go b (d:ps, c:qs) (cs, ds) is xxs
                                                     | b          = go (not b) (d:ps, c:qs) (cs, ds) is xs
                                                     | otherwise  = go (not b) (c:ps, d:qs) (cs, ds) is xs
        go b (ps, qs) (c:cs, d:ds) (_:is) []         | b          = go b (c:ps, d:qs) (cs, ds) is []
                                                     | otherwise  = go b (d:ps, c:qs) (cs, ds) is []
        go _ (ps, qs) ([], [d]) _ [] = (ps, d:qs)
        go _ (ps, qs) _ _ _ = (ps, qs)
        (ls, rs) = go True ("", "") (splitAt (l `div` 2) s) [1..l`div`2] as
        as = map head $ filter (odd . length) $ group $ sort a
        l = B.length s'
        s' = B.pack s

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (l - 2 * i + 2) t'
        l = B.length s
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStr . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= putStrLn . solve . B.lines

solve :: [B.ByteString] -> String
solve [s, _, a] = B.unpack $ foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.List (foldl')
import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import qualified Data.ByteString.Char8 as B

main :: IO ()
main = B.getContents >>= B.putStrLn . solve . B.lines

solve :: [B.ByteString] -> B.ByteString
solve [s, _, a] = foldl' f s (map (fst . fromJust . B.readInt) (B.words a))
  where f t i = t0 <> B.reverse t1 <> t2
          where (t0, t') = B.splitAt (i - 1) t
                (t1, t2) = B.splitAt (B.length t - 2 * i + 2) t'
solve _ = undefined

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans

import Data.Char
import Data.List
import Data.Int
import Data.Maybe
import Control.Monad
import qualified Data.Sequence as Seq
import Data.Foldable(toList)
import qualified Data.ByteString.Char8 as B

readInt :: IO Int
readInt = head `liftM` readIntList

readIntList :: IO [Int]
readIntList = do
    line <- B.getLine
    let res = map (fst . fromJust . B.readInt) $ B.words line
    return res

readString :: IO String
readString = do
    line <- B.getLine
    return $ filter (/= '\r') $ B.unpack line

getSumPerPos :: Int -> [Int] -> Seq.Seq Int
getSumPerPos cnt =
    foldr step init
    where
        init = Seq.fromList $ replicate cnt 0
        step key seq =
            let oldVal = Seq.index seq (key - 1)
            in
                Seq.update (key - 1) (oldVal + 1) seq

swap :: Seq.Seq a -> Int -> Int -> Seq.Seq a
swap seq p1 p2 =
    let v1 = Seq.index seq p1
        v2 = Seq.index seq p2
        seq' = Seq.update p1 v2 seq
        seq'' = Seq.update p2 v1 seq'
    in
        seq''

getAns :: Seq.Seq Char -> Seq.Seq Int -> Int -> Int -> Int -> Seq.Seq Char
getAns str atPos low high acc
    | low >= high = str
    | otherwise =
        let acc' = Seq.index atPos low + acc
            str' = if acc' `mod` 2 == 0 then str else swap str low high
        in
            getAns str' atPos (low + 1) (high - 1) acc'

main = do
    s <- readString
    print s
    print $ length s
    m <- readInt
    ps <- readIntList
    let atPos = getSumPerPos (length s) ps
    let ans = toList $ getAns (Seq.fromList s) atPos 0 (length s - 1) 0
    putStrLn ans


You are given a sequence $$$b_1, b_2, \ldots, b_n$$$. Find the lexicographically minimal permutation $$$a_1, a_2, \ldots, a_{2n}$$$ such that $$$b_i = \min(a_{2i-1}, a_{2i})$$$, or determine that it is impossible.

Each test contains one or more test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 100$$$). The first line of each test case consists of one integer $$$n$$$ — the number of elements in the sequence $$$b$$$ ($$$1 \le n \le 100$$$). The second line of each test case consists of $$$n$$$ different integers $$$b_1, \ldots, b_n$$$ — elements of the sequence $$$b$$$ ($$$1 \le b_i \le 2n$$$). It is guaranteed that the sum of $$$n$$$ by all test cases doesn't exceed $$$100$$$.

For each test case, if there is no appropriate permutation, print one number $$$-1$$$. Otherwise, print $$$2n$$$ integers $$$a_1, \ldots, a_{2n}$$$ — required lexicographically minimal permutation of numbers from $$$1$$$ to $$$2n$$$.

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

routine :: IO ()
routine = do
  n <- readLn
  bs <- (map read.words) <$> getLine
  putStrLn $ (unwords.map show) (solve n bs)

solve :: Int -> [Int] -> [Int]
solve n bs = fromMaybe [-1] (f bs s)
  where
    s=getSet n bs

getSet :: Int -> [Int] -> Set.Set Int
getSet n bs = Set.difference (Set.fromDistinctAscList [1..(2*n)]) (Set.fromList bs)

f :: [Int] -> Set.Set Int -> Maybe [Int]
f (x:xs) s = case Set.lookupGT x s of
  Just gt ->
    do
      res <- f xs (Set.delete gt s)
      let nres = x:(gt:res)
      pure nres
  Nothing -> Nothing
f [] _ = Just []


Limak is an old brown bear. He often plays poker with his friends. Today they went to a casino. There are n players (including Limak himself) and right now all of them have bids on the table. i-th of them has bid with size ai dollars.Each player can double his bid any number of times and triple his bid any number of times. The casino has a great jackpot for making all bids equal. Is it possible that Limak and his friends will win a jackpot?

First line of input contains an integer n (2 ≤ n ≤ 105), the number of players. The second line contains n integer numbers a1, a2, ..., an (1 ≤ ai ≤ 109) — the bids of players.

Print "Yes" (without the quotes) if players can make their bids become equal, or "No" otherwise.

NoteIn the first sample test first and third players should double their bids twice, second player should double his bid once and fourth player should both double and triple his bid.It can be shown that in the second sample test there is no way to make all bids equal.

main=interact$solve.map read.words
solve (n:x)=if check $ map f x then "Yes" else "No"
        where g b a| a`mod`b==0 = g b $ a`div`b
                   | otherwise  = a
              f = g 3 . g 2
              check (a:x) = all (==a) x

main=interact$solve.map read.words
solve (n:x)=if check $ map f x then "Yes" else "No"
        where g a b| a`mod`b==0 = g (a`div`b) b
                   | otherwise  = a
              f x = g (g x 2) 3
              check x = minimum x == maximum x

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f2 (n `quot` 2) else n

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

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

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

main = do
  getLine
  xs <- getInts

  let
    ys = map f xs
      where
        f x = until odd (`div` 2) $ until (\x -> x `mod` 3 /= 0) (`div` 3) x
    b = and $ zipWith (==) ys $ tail ys

  putStrLn $ if b then "Yes" else "No"

main :: IO ()
main = do
   n <- read_n
   a <- read_a
   let aa = map simplify a
       rs = if allEqu aa then "Yes" else "No"
   putStrLn rs

read_n :: IO Integer
read_n = do
   s <- getLine
   let n = read s :: Integer in return n

read_a :: IO [Integer]
read_a = do
   s <- getLine
   let a = map (\x -> read x :: Integer) $ words s in return a

simplify :: Integer -> Integer
simplify x
   | x `mod` 2 == 0 = simplify $ x `div` 2
   | x `mod` 3 == 0 = simplify $ x `div` 3
   | otherwise = x

allEqu :: [Integer] -> Bool
allEqu [] = True
allEqu (x:xs) = length (filter (== x) xs) == (length xs)

main = interact $ solve . map read . words
solve (_:xs) = if allEqual . map f $ xs then "Yes" else "No"
	where
		f x
			| x `mod` 2 == 0	= f (x `div` 2)
			| x `mod` 3 == 0	= f (x `div` 3)
			| otherwise			= x
		allEqual []			= True
		allEqual (x:[])		= True
		allEqual (x1:x2:xs)	= x1 == x2 && allEqual (x2:xs)

main = interact $ solve . map read . words
solve (_:xs) = if allEqual . map f $ xs then "Yes" else "No"
	where
		f x
			| x `mod` 2 == 0	= f (x `div` 2)
			| x `mod` 3 == 0	= f (x `div` 3)
			| otherwise			= x
		allEqual (x:xs)			= and . map (== x) $ xs

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integer -> Integer -> Integer
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integral a => a -> a -> a
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve = same . map (divs 2 . divs 3)

divs :: Integral a => a -> a -> a
divs n m | m `mod` n == 0 = divs n $ m `div` n
         | otherwise = m

same :: Eq a => [a] -> Bool
same xs = all (==head xs) xs

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

import Data.List
main = interact $ format . group . map (purge . read) . tail . words
purge n | n `mod` 2 == 0 = purge (n `div` 2)
        | n `mod` 3 == 0 = purge (n `div` 3)
        | otherwise = n
format [_] = "Yes"
format _ = "No"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> String
solve a = if all (== x) xs then "Yes" else "No"
    where
    (x:xs) = map ((\i -> i `div` gcd b i) . fromIntegral) a
    b = 2^29 * 3^18 :: Int64

main = do
    [n] <- parse <$> B.getLine
    a <- parse <$> B.getLine
    putStrLn $ solve a

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor
import Data.Int (Int64)

getNums64 :: B.ByteString -> [Int64]
getNums64 =
	let
		f1 = (map (fromInteger . (fst.fromJust) . B.readInteger))
		f2 = (B.split ' ')
	in f1.f2
getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine
readInts64 :: IO [Int64]
readInts64 = getNums64 <$> B.getLine

check 1 = True
check a = if a `mod` 2 == 0 then check $ a `div` 2 else if a `mod` 3 == 0 then check $ a `div` 3 else False

main = do
	n <- readInts
	a <- readInts
	let g = foldl gcd 0 a
	let b = map (\x -> x `div` g) a
	let c = all check b
	putStrLn $ if c then "Yes" else "No"

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

red x 	| mod x 2 ==0 = red (div x 2)
	| mod x 3 ==0 = red (div x 3)
	| otherwise = x

process s= all (==th) t
	 where t = map red s
	       th = head t

main= do
	n<-read <$> getLine::IO Int
	s<- map read .words <$> getLine ::IO [Int]
	putStrLn $ if process s then "YES" else "NO"

main = do
  xs <- getContents
  (putStrLn . print_ . solve) (map read (words ((lines xs)!!1)))

print_ True = "Yes"
print_ False = "No"

solve :: [Int] -> Bool
solve = all_equal . map norm
gen_norm k x | x `mod` k == 0 = gen_norm k (x `div` k)
             | otherwise      = x
norm = gen_norm 2 . gen_norm 3
all_equal (x:xs) = all (\y -> x == y) xs
all_equal [] = undefined

import System.IO
import Data.Int
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int64)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = foldl' gcd 0 arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (`check2` max) arr

ifYes True = "Yes"
ifYes False = "No"

import Control.Monad
import Data.List

red2 :: Int -> Int
red2 x
  | even x    = red2 (div x 2)
  | otherwise = x

red3 :: Int -> Int
red3 x
  | mod x 3 == 0 = red3 (div x 3)
  | otherwise    = x

canEqual :: [Int] -> Bool
canEqual a =
  let b = map (red3 . red2) a
  in all (== (head b)) $ tail b

myShow :: Bool -> String
myShow True = "Yes"
myShow False = "No"

main :: IO()
main = do
  n <- readLn
  a <- liftM (map read . take n . words) getLine
  putStr . myShow $ canEqual a

main = interact $ show'.and.(\x -> map (== head x) (tail x)).map red.tail.map read.words

red :: Int -> Int
red x
    |mod x 2 == 0 = red $ x `div` 2
    |mod x 3 == 0 = red $ x `div` 3
    |otherwise = x

show' :: Bool -> [Char]
show' True = "Yes"
show' False = "No"

main = interact $ show' . eql . map red . tail . map read . words

red :: Integer -> Integer
red x
    |mod x 2 == 0 = red $ x `div` 2
    |mod x 3 == 0 = red $ x `div` 3
    |otherwise = x

eql :: Eq a => [a] -> Bool
eql x = and $ map (== head x) (tail x)

show' :: Bool -> [Char]
show' True = "Yes"
show' False = "No"

module Main where
import Control.Applicative

divide d = go where
  go n | rem n d == 0 = go $ quot n d
  go n = n

main = do
  getLine
  a : as <- map (divide 2 . divide 3 . read) <$> words <$> getLine
  putStrLn $ if all (== a) as then "Yes" else "No"

baseQ = (base 2) . (base 3)
base n stake
  | stake `mod` n == 0 = base n (stake `div` n)
  | otherwise          = stake

ans (x : t@(y : xs))
  | x /= y    = "No"
  | otherwise = ans t
ans _ = "Yes"

main = do
  tmp <- getLine
  list <- getLine
  let stakes = map read $ words list :: [Int]
  let bases = map baseQ stakes
  putStrLn $ ans bases

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (d:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f3 (n `quot` 2) else n

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    let (x:xs) = map reduce a
    print (x:xs)
    if all (==x) xs
        then putStrLn "YES"
        else putStrLn "NO"

reduce :: Int -> Int
reduce a = f3 (f2 a)
 where f3 n = if n `rem` 3 ==0 then f3 (n `quot` 3) else n
       f2 n = if even n then f2 (n `quot` 2) else n

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (x*y:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (b:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (d*c1*c2:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Int) . words) getLine
    putStrLn $ solve a

solve :: [Int] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (lcm a b:ls) else "NO"

main :: IO()
main = do
    _ <- readLn :: IO Int
    a <- fmap (map (\x -> read x::Integer) . words) getLine
    putStrLn $ solve a

solve :: [Integer] -> String
solve [] = "YES"
solve (_:[]) = "YES"
solve (a:b:ls) = fn a b
 where fn x y = let d = gcd x y
                    c1 = x `div` d
                    c2 = y `div` d
                    in if and [(c1 `rem` 2==0 || c1 `rem` 3==0 || c1 == 1),(c2 `rem` 2==0 || c2 `rem` 3==0 || c2==1)] then solve (lcm a b:ls) else "NO"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Integer] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Integer -> Integer -> Integer
divs n m | m `mod` n == 0 = m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "Yes"
yesno _ = "No"

main :: IO ()
main = putStrLn . yesno . solve . map read . tail . words =<< getContents

solve :: [Int] -> Bool
solve as = all (==1) [ divs 2 $ divs 3 $ a `div` foldr1 gcd as | a <- as ]

divs :: Int -> Int -> Int
divs n m | m `mod` n == 0 = m `div` n
         | otherwise = m

yesno :: Bool -> String
yesno True = "YES"
yesno _ = "NO"

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> String
solve a = if all (== x) xs then "Yes" else "No"
    where (x:xs) = map (\i -> i `div` gcd 6 i) a

main = do
    [n] <- parse <$> B.getLine
    a <- parse <$> B.getLine
    putStrLn $ solve a

import System.IO
import Data.Int
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
-- import qualified Data.Set as Set

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int64)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = foldl' gcd 0 arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) arr

ifYes True = "Yes"
ifYes False = "No"

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

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let max = maximum arr
        check x
            | x == 1         = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise      = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) arr

ifYes True = "Yes"
ifYes False = "No"

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

factor k =
    let arr = [ x | x <- takeWhile ((<=k).(^2)) [2..], k `mod` x == 0]
    in if null arr then k else head arr

main = do
    hSetBuffering stdin (BlockBuffering (Just 4096))
    hSetBuffering stdout (BlockBuffering (Just 4096))
    contents <- lines <$> getContents
    let arr = map (read :: (String -> Int)) . words <$> tail contents

    putStrLn $ ifYes (solve (head arr))

-- solve :: [[Char]] -> [IO [()]]
-- solve :: [] -> [IO ()]
solve arr =
    let sorted = reverse (sort arr)
        max = head sorted
        check x
            | x == 1 = True
            | x `mod` 2 == 0 = check (x `div` 2)
            | x `mod` 3 == 0 = check (x `div` 3)
            | otherwise = False
        check2 x y = (x `mod` y == 0) && check (x `div` y)
    in all (check2 max) sorted

ifYes True = "Yes"
ifYes False = "No"


As the boat drifts down the river, a wood full of blossoms shows up on the riverfront."I've been here once," Mino exclaims with delight, "it's breathtakingly amazing.""What is it like?""Look, Kanno, you've got your paintbrush, and I've got my words. Have a try, shall we?" There are four kinds of flowers in the wood, Amaranths, Begonias, Centaureas and Dianthuses.The wood can be represented by a rectangular grid of $$$n$$$ rows and $$$m$$$ columns. In each cell of the grid, there is exactly one type of flowers.According to Mino, the numbers of connected components formed by each kind of flowers are $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$ respectively. Two cells are considered in the same connected component if and only if a path exists between them that moves between cells sharing common edges and passes only through cells containing the same flowers.You are to help Kanno depict such a grid of flowers, with $$$n$$$ and $$$m$$$ arbitrarily chosen under the constraints given below. It can be shown that at least one solution exists under the constraints of this problem.Note that you can choose arbitrary $$$n$$$ and $$$m$$$ under the constraints below, they are not given in the input.

The first and only line of input contains four space-separated integers $$$a$$$, $$$b$$$, $$$c$$$ and $$$d$$$ ($$$1 \leq a, b, c, d \leq 100$$$) — the required number of connected components of Amaranths, Begonias, Centaureas and Dianthuses, respectively.

In the first line, output two space-separated integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 50$$$) — the number of rows and the number of columns in the grid respectively. Then output $$$n$$$ lines each consisting of $$$m$$$ consecutive English letters, representing one row of the grid. Each letter should be among 'A', 'B', 'C' and 'D', representing Amaranths, Begonias, Centaureas and Dianthuses, respectively. In case there are multiple solutions, print any. You can output each letter in either case (upper or lower).

7 7
DDDDDDD
DDDBDBD
DDCDCDD
DBDADBD
DDCDCDD
DBDBDDD
DDDDDDD

NoteIn the first example, each cell of Amaranths, Begonias and Centaureas forms a connected component, while all the Dianthuses form one.

import Data.Array
import Control.Monad

getInts = (map read . words) `fmap` getLine :: IO [Int]

main = do
    [a,b,c,d] <- getInts
    let garden = array ((1,1),(50,50)) [((x,y),f x y) | x <- [1..50], y <- [1..50]] where
        f x y
            | upper && left = 'A'
            | upper && right = 'B'
            | lower && left = 'C'
            | lower && right = 'D'
            where
                upper = y <= 25
                lower = not upper
                left = x <= 25
                right = not left
    let plantB = ((2,2),(24,24),'B', (b-1))
    let plantC = ((27,2),(49,24),'C', (c-1))
    let plantD = ((2,27),(24,49),'D', (d-1))
    let plantA = ((27,27),(49,49),'A', (a-1))
    let garden2 = foldl plant garden [plantB, plantC, plantD, plantA]
    putStrLn "50 50"
    printGarden garden2

printGarden garden = do
    forM_ [1..50] $ \y -> do
        forM_ [1..50] $ \x -> do
            putChar (garden ! (x,y))
        putStrLn ""
    putStrLn ""

plant garden ((left,top),(right,bottom),flower,count) = garden // seeds where
    seeds = [(f i,flower) | i <- [0..count-1]] where
        f i = (left + ((i * 2) `mod` width), top + (((i * 2) `div` width) * 2)) where
            width = right - left + 1


Limak is a little bear who loves to play. Today he is playing by destroying block towers. He built n towers in a row. The i-th tower is made of hi identical blocks. For clarification see picture for the first sample.Limak will repeat the following operation till everything is destroyed.Block is called internal if it has all four neighbors, i.e. it has each side (top, left, down and right) adjacent to other block or to the floor. Otherwise, block is boundary. In one operation Limak destroys all boundary blocks. His paws are very fast and he destroys all those blocks at the same time.Limak is ready to start. You task is to count how many operations will it take him to destroy all towers.

The first line contains single integer n (1 ≤ n ≤ 105). The second line contains n space-separated integers h1, h2, ..., hn (1 ≤ hi ≤ 109) — sizes of towers.

Print the number of operations needed to destroy all towers.

NoteThe picture below shows all three operations for the first sample test. Each time boundary blocks are marked with red color.    After first operation there are four blocks left and only one remains after second operation. This last block is destroyed in third operation.

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> Int
solve = maximum . scanr go 0 . scanl (flip go) 0
    where go i = min i . succ

main = B.getLine >> solve . parse <$> B.getLine >>= print

{-# OPTIONS_GHC -O2 -optc-O2 #-}
import Data.Maybe (fromJust)
import Control.Applicative ((<$>))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

parse :: ByteString -> [Int]
parse line = fst . fromJust . C.readInt <$> C.words line

solve :: [Int] -> Int
solve = maximum . scanr go 0 . scanl (flip go) 0
    where go i = min i . succ

main = do
    B.getLine
    solve . parse <$> B.getLine >>= print

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor
import Data.Int (Int64)

getNums64 :: B.ByteString -> [Int64]
getNums64 =
	let
		f1 = (map (fromInteger . (fst.fromJust) . B.readInteger))
		f2 = (B.split ' ')
	in f1.f2
getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine
readInts64 :: IO [Int64]
readInts64 = getNums64 <$> B.getLine

foldmap fn v [] = []
foldmap fn v (x:xs) = let v2 = fn v x in (v2 `seq` v2) : foldmap fn v2 xs

main = do
	n <- readInts
	h <- readInts
	let fn a b = min (a+1) b
	let lft = foldmap fn 0 h
	let rt = reverse $ foldmap fn 0 $ reverse h
	let ans = foldl max 0 $ map (\(a,b) -> min a b) $ zip lft rt
	print ans

import Data.List
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let p1 = pass1 (zip a [1..n]) 0
        p2 = pass2 (reverse (zip a [1..n])) (reverse p1) (n+1)
    print . maximum $ p2

pass1 [] _ = []
pass1 ((e,i):as) x = let w = min x (e-i) in (i+w):pass1 as w

pass2 [] [] _ = []
pass2 ((e,i):xs) (y:ys) x =
    let w = min x (e+i)
    in (min (w-i) y : pass2 xs ys w)

{-# LANGUAGE BangPatterns #-}

module Main where
import Control.Applicative
--import Data.List

-- | A strictly accumulating version of 'scanl'
{-# NOINLINE [1] scanl' #-}
scanl'           :: (b -> a -> b) -> b -> [a] -> [b]
-- This peculiar form is needed to prevent scanl' from being rewritten
-- in its own right hand side.
scanl' = scanlGo'
  where
    scanlGo'           :: (b -> a -> b) -> b -> [a] -> [b]
    scanlGo' f !q ls    = q : (case ls of
                            []   -> []
                            x:xs -> scanlGo' f (f q x) xs)

walk p x = min x $ p + 1
grows = tail . scanl' walk 0
heels xs = zipWith min (grows xs) $ reverse $ grows $ reverse xs
destroy = maximum . heels

main = do
  getLine
  hs <- map read <$> words <$> getLine
  print $ destroy hs

{-# LANGUAGE BangPatterns #-}

module Main where
import Control.Applicative

scanl' f = go where
  go q [] = [q]
  go q (x: xs) = q : go (f q x) xs

walk p x = min x $ p + 1
grows = tail . scanl' walk 0
heels xs = zipWith min (grows xs) $ reverse $ grows $ reverse xs
destroy = maximum . heels

main = do
  getLine
  hs <- map read <$> words <$> getLine
  print $ destroy hs

module Main(main) where

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Functor

getNums :: B.ByteString -> [Int]
getNums =
	let
		f1 = (map ((fst.fromJust) . B.readInt))
		f2 = (B.split ' ')
	in f1.f2
readInts :: IO [Int]
readInts = getNums <$> B.getLine

main::IO ()
main = do
	_ <- readInts
	h <- readInts
	let fn a b = min (a+1) b
	let lft = tail $ scanl fn 0 h
	let rt = reverse $ tail $ scanl fn 0 $ reverse h
	let ans = (foldl max 0 $ zipWith min lft rt)::Int
	print ans

module Main where

import Data.Functor

getInt :: IO Int
getInt = read <$> getLine

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

foldmap f v [] = []
foldmap f v (x:xs) = res : foldmap f res xs where
    res = f v x

main :: IO ()
main = do
    n <- getInt
    ns <- getInts
    let left = foldmap (\x y -> min (x+1) y) 0 ns
    let right = reverse $ foldmap (\x y -> min (x+1) y) 0 $ reverse ns
    print $ foldr max 0 (zipWith min left right)

import Data.List
main :: IO()
main = do
    n <- readLn :: IO Int
    a <- fmap ((map read) . words) getLine :: IO [Int]
    let p1 = pass1 (zip a [1..n]) 0
        p2 = pass2 (reverse (zip a [1..n])) (reverse p1) (n+1)
    print . maximum $ p2

pass1 [] _ = []
pass1 (a:as) x = ((snd a) + min x ((fst a)-(snd a))) : pass1 as (min x ((fst a)-(snd a)))

pass2 [] [] _ = []
pass2 ((e,i):xs) (y:ys) x =
    let w = min x (e+i)
    in (min w y : pass2 xs ys w)


Bob is a pirate looking for the greatest treasure the world has ever seen. The treasure is located at the point $$$T$$$, which coordinates to be found out.Bob travelled around the world and collected clues of the treasure location at $$$n$$$ obelisks. These clues were in an ancient language, and he has only decrypted them at home. Since he does not know which clue belongs to which obelisk, finding the treasure might pose a challenge. Can you help him?As everyone knows, the world is a two-dimensional plane. The $$$i$$$-th obelisk is at integer coordinates $$$(x_i, y_i)$$$. The $$$j$$$-th clue consists of $$$2$$$ integers $$$(a_j, b_j)$$$ and belongs to the obelisk $$$p_j$$$, where $$$p$$$ is some (unknown) permutation on $$$n$$$ elements. It means that the treasure is located at $$$T=(x_{p_j} + a_j, y_{p_j} + b_j)$$$. This point $$$T$$$ is the same for all clues.In other words, each clue belongs to exactly one of the obelisks, and each obelisk has exactly one clue that belongs to it. A clue represents the vector from the obelisk to the treasure. The clues must be distributed among the obelisks in such a way that they all point to the same position of the treasure.Your task is to find the coordinates of the treasure. If there are multiple solutions, you may print any of them.Note that you don't need to find the permutation. Permutations are used only in order to explain the problem.

The first line contains an integer $$$n$$$ ($$$1 \leq n \leq 1000$$$) — the number of obelisks, that is also equal to the number of clues. Each of the next $$$n$$$ lines contains two integers $$$x_i$$$, $$$y_i$$$ ($$$-10^6 \leq x_i, y_i \leq 10^6$$$) — the coordinates of the $$$i$$$-th obelisk. All coordinates are distinct, that is $$$x_i \neq x_j$$$ or $$$y_i \neq y_j$$$ will be satisfied for every $$$(i, j)$$$ such that $$$i \neq j$$$.  Each of the next $$$n$$$ lines contains two integers $$$a_i$$$, $$$b_i$$$ ($$$-2 \cdot 10^6 \leq a_i, b_i \leq 2 \cdot 10^6$$$) — the direction of the $$$i$$$-th clue. All coordinates are distinct, that is $$$a_i \neq a_j$$$ or $$$b_i \neq b_j$$$ will be satisfied for every $$$(i, j)$$$ such that $$$i \neq j$$$.  It is guaranteed that there exists a permutation $$$p$$$, such that for all $$$i,j$$$ it holds $$$\left(x_{p_i} + a_i, y_{p_i} + b_i\right) = \left(x_{p_j} + a_j, y_{p_j} + b_j\right)$$$.

Output a single line containing two integers $$$T_x, T_y$$$ — the coordinates of the treasure. If there are multiple answers, you may print any of them.

NoteAs $$$n = 2$$$, we can consider all permutations on two elements. If $$$p = [1, 2]$$$, then the obelisk $$$(2, 5)$$$ holds the clue $$$(7, -2)$$$, which means that the treasure is hidden at $$$(9, 3)$$$. The second obelisk $$$(-6, 4)$$$ would give the clue $$$(-1,-3)$$$ and the treasure at $$$(-7, 1)$$$. However, both obelisks must give the same location, hence this is clearly not the correct permutation.If the hidden permutation is $$$[2, 1]$$$, then the first clue belongs to the second obelisk and the second clue belongs to the first obelisk. Hence $$$(-6, 4) + (7, -2) = (2,5) + (-1,-3) = (1, 2)$$$, so $$$T = (1,2)$$$ is the location of the treasure.  In the second sample, the hidden permutation is $$$[2, 3, 4, 1]$$$.

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

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

main :: IO ()
main = do
  n <- read <$> getLine
  ls <- unfoldr (\bs0 -> do (x,bs1) <- BSL.readInt $ BSL.dropWhile (<'!') bs0
                            (y,bs2) <- BSL.readInt $ BSL.dropWhile (<'!') bs1
                            return ((x,y),bs2)) <$> BSL.getContents
  let (xys, ls1) = splitAt n ls
      abs = take n ls1
      (x,y) = minimum xys
      (a,b) = maximum abs
  putStrLn $ shows (a+x) $ ' ' : show (y+b)

{-# 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.ByteString.Lazy.Builder
import Data.ByteString.Lazy.Builder.ASCII
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 obel clue = (x,y)
    where x = maximum (map fst obel) + minimum (map fst clue)
          y = maximum (map snd obel) + minimum (map snd clue)

tuple [x,y] = (x,y)

main = do
    [n] <- getInts
    obel <- forM [1..n] (\_-> getInts)
    clue <- forM [1..n] (\_-> getInts)
    let (x, y) = solve (map tuple obel) (map tuple clue)
    putStrLn $ show x ++ " " ++ show y

{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

--import Debug.Trace

import Control.Monad
import Control.Monad.ST
import Control.DeepSeq
import Data.Function
import Data.Maybe
import Data.Either
import Data.Ord
import qualified Data.Foldable as Foldable
import Data.Char
import Data.List
import Data.Array.IArray hiding ((!))
import Data.Array.MArray.Safe
import qualified Data.Array.Unboxed as UA
import qualified Data.Array.IO.Safe as IA
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.Set (Set)
import qualified Data.Set as Set
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet

getWords  = words <$> getLine :: IO [String]
getInts   = map read <$> getWords :: IO [Int]
getDoubles = map read <$> getWords :: IO [Double]
getInt    = read <$> getLine :: IO Int
getDouble  = read <$> getLine :: IO Double
printLines :: Show a => [a] -> IO ()
printLines = mapM_ print
printStrs = mapM_ putStrLn :: [String] -> IO ()

---- Answer Code Section ----

type Pos = (Int, Int)

add (x1, y1) (x2, y2) = (x1+x2, y1+y2)

process :: [Pos] -> [Pos] -> Pos
process obelisks clues = minimum obelisks `add` maximum clues

main = do
    n <- getInt
    obelisks <- force <$> replicateM n (readPoint <$> getInts)
    clues <- force <$> replicateM n (readPoint <$> getInts)
    putStrLn $ showPoint $ process obelisks clues

readPoint (x:y:[]) = (x, y)
showPoint (x, y) = show x ++ " " ++ show y


Recently Pashmak has been employed in a transportation company. The company has k buses and has a contract with a school which has n students. The school planned to take the students to d different places for d days (each day in one place). Each day the company provides all the buses for the trip. Pashmak has to arrange the students in the buses. He wants to arrange the students in a way that no two students become close friends. In his ridiculous idea, two students will become close friends if and only if they are in the same buses for all d days.Please help Pashmak with his weird idea. Assume that each bus has an unlimited capacity.

The first line of input contains three space-separated integers n, k, d (1 ≤ n, d ≤ 1000; 1 ≤ k ≤ 109).

If there is no valid arrangement just print -1. Otherwise print d lines, in each of them print n integers. The j-th integer of the i-th line shows which bus the j-th student has to take on the i-th day. You can assume that the buses are numbered from 1 to k.

NoteNote that two students become close friends only if they share a bus each day. But the bus they share can differ from day to day.

import Data.List (transpose)

main = interact $ f . map read . words

f :: [Integer] -> String
f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' (fromIntegral n) b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

-- Codeforces 459C

import Data.List

main :: IO ()
main = getLine >>= putStrLn . solve . map read . words

solve :: [Int] -> String
solve [n, k, d] = if check $ map toInteger [n, k, k, d]
    then "-1"
    else intercalate "\n" $ map (intercalate " " . map show) $ transpose $ scanl (\acc _ -> inc acc) (replicate d 1) [1..n-1] where inc = tail . map snd . scanl (\(cin, _) x -> if x+cin > k then (1, x+cin-k) else (0, x+cin)) (1, 0)

check :: [Integer] -> Bool
check [n, _, _, 0] = True
check [n, acc, k, d] = if acc >= n then False else check [n, (k*acc), k, (d-1)]

import Data.List

digits _    0 _   = []
digits base n num = num `mod` base : digits base (n - 1) (num `div` base)

main = do
    contents <- getContents
    let [n, k, d] = map read $ words contents
    let ans = transpose $ map (map (+ 1) . digits k d) [1..n]
    putStr (if (k ^ d) < n  then "-1" else unlines $ map (unwords . map show) ans)

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > (k^d) = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

kd _ 0 _ = []
kd k d n = (n`mod`k+1) : (kd k (d-1) (n`div`k))

import Data.List (transpose)

main = interact $ f . map read . words

f (n:b:d:_)
  | n > b^d   = show (-1)
  | otherwise = f' n b d

f' n b d = unlines . map unwords . transpose . take n $ g b d [[]]

g _ 0 ls = ls
g b d ls = g b (d-1) [(show x):l | x <- [1..b], l <- ls]

import Data.List

main = interact $ sol . map read . words

sol (n:k:d:_)
	| n > ep k d 1 = "-1"
	| otherwise = intercalate "\n" .
				  map (intercalate " " . map show) .
				  transpose .
				  map (reverse . (kd k d)) $ [0..n-1]

ep _ 0 s = s
ep k d s
	| s > 1000 = s
	| otherwise = ep k (d-1) s*k

kd _ 0 _ = []
kd k d n = (n`mod`k) : (kd k (d-1) (n`div`k))


Recently Polycarp noticed that some of the buttons of his keyboard are malfunctioning. For simplicity, we assume that Polycarp's keyboard contains $$$26$$$ buttons (one for each letter of the Latin alphabet). Each button is either working fine or malfunctioning. To check which buttons need replacement, Polycarp pressed some buttons in sequence, and a string $$$s$$$ appeared on the screen. When Polycarp presses a button with character $$$c$$$, one of the following events happened:  if the button was working correctly, a character $$$c$$$ appeared at the end of the string Polycarp was typing;  if the button was malfunctioning, two characters $$$c$$$ appeared at the end of the string. For example, suppose the buttons corresponding to characters a and c are working correctly, and the button corresponding to b is malfunctioning. If Polycarp presses the buttons in the order a, b, a, c, a, b, a, then the string he is typing changes as follows: a $$$\rightarrow$$$ abb $$$\rightarrow$$$ abba $$$\rightarrow$$$ abbac $$$\rightarrow$$$ abbaca $$$\rightarrow$$$ abbacabb $$$\rightarrow$$$ abbacabba.You are given a string $$$s$$$ which appeared on the screen after Polycarp pressed some buttons. Help Polycarp to determine which buttons are working correctly for sure (that is, this string could not appear on the screen if any of these buttons was malfunctioning).You may assume that the buttons don't start malfunctioning when Polycarp types the string: each button either works correctly throughout the whole process, or malfunctions throughout the whole process.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then the test cases follow. Each test case is represented by one line containing a string $$$s$$$ consisting of no less than $$$1$$$ and no more than $$$500$$$ lowercase Latin letters.

For each test case, print one line containing a string $$$res$$$. The string $$$res$$$ should contain all characters which correspond to buttons that work correctly in alphabetical order, without any separators or repetitions. If all buttons may malfunction, $$$res$$$ should be empty.

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE BinaryLiterals #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative
import Control.Arrow
import Control.Monad
import Control.Monad.ST

import Data.Char
import Data.List
import Data.Maybe

import qualified Data.ByteString.Char8 as B

import Data.Array.ST.Safe
import Data.STRef

-- import Debug.Trace
import Text.Printf

readInt = readLn :: IO Int
readInteger = readLn :: IO Integer
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine
readIntegers = map ( fst . fromJust . B.readInteger ) . B.words <$> B.getLine

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

modifyArray a i f = writeArray a i =<< f <$> readArray a i

main = readInt >>= flip replicateM solve >>= mapM_ putStrLn

solve = do
	s <- getLine
	let
		candidates = map fst $ filter ( odd . snd ) $ map ( head &&& length ) $ group s
	return $ map head $ group $ sort candidates

import Data.List

f =  sort . nub . map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

import Control.Monad
import Data.List
import qualified Data.Set as S

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x `mod` 2 /= 0 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

import           Data.List

(|>) = flip (.)

main :: IO ()
main = interact $
  lines
  |> tail
  |> map solve
  |> unlines

solve :: String -> String
solve = group
  |> filter (length |> odd)
  |> map head
  |> nub
  |> sort

import Data.List

f =  map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

import Data.List

f =  nub . reverse . map head . filter  (odd . length) .  group

main = interact $ unlines . map f . tail . lines

import Control.Monad
import Data.List
import qualified Data.Set as S

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else S.delete (head x) s) S.empty (group str)
    putStrLn $ S.toList res

import Control.Monad
import Data.List
import qualified Data.Set as S

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x < 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res

import Control.Monad
import Data.List
import qualified Data.Set as S

main = do
  n <- readLn
  replicateM_ n $ do
    str <- getLine
    let res = foldr (\x s ->
          if length x /= 2 then S.insert (head x) s
            else s) S.empty (group str)
    putStrLn $ S.toList res


A mad scientist Dr.Jubal has made a competitive programming task. Try to solve it!You are given integers $$$n,k$$$. Construct a grid $$$A$$$ with size $$$n \times n$$$ consisting of integers $$$0$$$ and $$$1$$$. The very important condition should be satisfied: the sum of all elements in the grid is exactly $$$k$$$. In other words, the number of $$$1$$$ in the grid is equal to $$$k$$$.Let's define:  $$$A_{i,j}$$$ as the integer in the $$$i$$$-th row and the $$$j$$$-th column.  $$$R_i = A_{i,1}+A_{i,2}+...+A_{i,n}$$$ (for all $$$1 \le i \le n$$$).  $$$C_j = A_{1,j}+A_{2,j}+...+A_{n,j}$$$ (for all $$$1 \le j \le n$$$).  In other words, $$$R_i$$$ are row sums and $$$C_j$$$ are column sums of the grid $$$A$$$.  For the grid $$$A$$$ let's define the value $$$f(A) = (\max(R)-\min(R))^2 + (\max(C)-\min(C))^2$$$ (here for an integer sequence $$$X$$$ we define $$$\max(X)$$$ as the maximum value in $$$X$$$ and $$$\min(X)$$$ as the minimum value in $$$X$$$). Find any grid $$$A$$$, which satisfies the following condition. Among such grids find any, for which the value $$$f(A)$$$ is the minimum possible. Among such tables, you can find any.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Next $$$t$$$ lines contain descriptions of test cases. For each test case the only line contains two integers $$$n$$$, $$$k$$$ $$$(1 \le n \le 300, 0 \le k \le n^2)$$$. It is guaranteed that the sum of $$$n^2$$$ for all test cases does not exceed $$$10^5$$$.

For each test case, firstly print the minimum possible value of $$$f(A)$$$ among all tables, for which the condition is satisfied. After that, print $$$n$$$ lines contain $$$n$$$ characters each. The $$$j$$$-th character in the $$$i$$$-th line should be equal to $$$A_{i,j}$$$. If there are multiple answers you can print any.

NoteIn the first test case, the sum of all elements in the grid is equal to $$$2$$$, so the condition is satisfied. $$$R_1 = 1, R_2 = 1$$$ and $$$C_1 = 1, C_2 = 1$$$. Then, $$$f(A) = (1-1)^2 + (1-1)^2 = 0$$$, which is the minimum possible value of $$$f(A)$$$.In the second test case, the sum of all elements in the grid is equal to $$$8$$$, so the condition is satisfied. $$$R_1 = 3, R_2 = 3, R_3 = 2$$$ and $$$C_1 = 3, C_2 = 2, C_3 = 3$$$. Then, $$$f(A) = (3-2)^2 + (3-2)^2 = 2$$$. It can be proven, that it is the minimum possible value of $$$f(A)$$$.

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

main = getLine >>= flip replicateM_ test . read

test = do
  [n, k] <- map read . words <$> getLine
  let a = solve n k
  print $ f a
  putStr $ unlines $ map (>>= show) a

f a = (maximum r - minimum r) ^ 2 + (maximum c - minimum c) ^ 2
  where
    r = map sum a
    c = map sum $ transpose a

solve n k = skew n $ makeRows n $ replicate k 1 ++ replicate (n * n - k) 0

makeRows n [] = []
makeRows n as = take n as : makeRows n (drop n as)

skew n = map (take n) . zipWith drop [0 ..] . map cycle . transpose

import           Control.Monad
import           Data.List
import qualified Data.Set      as Set

main :: IO()
main =
  do
    x <- read <$> getLine
    replicateM_ x solve

solve :: IO()
solve =
  do
    [n, k] <- map read . words <$> getLine :: IO [Int]
    let x = [0..n-1]
    let y = concat [map (\a -> (a + z) `mod` n) x | z <- x]
    let z = concat $ replicate n x
    let grid = generateG n $ take k $ zip y z
    let minF = score grid + score (transpose grid)
    print minF
    putStrLn $ unlines grid
  where
    score :: [String] -> Int
    score g = (maximum cnt - minimum cnt) ^ 2
      where
        cnt = map (length . filter (=='1')) g
    generateG :: Int -> [(Int, Int)] -> [String]
    generateG n l = [map (f . (,) y) x | y <- x]
      where
        x = [0..n-1]
        m = Set.fromList l
        f :: (Int, Int) -> Char
        f a | Set.member a m = '1'
            | otherwise = '0'


Two integers x and y are compatible, if the result of their bitwise "AND" equals zero, that is, a & b = 0. For example, numbers 90 (10110102) and 36 (1001002) are compatible, as 10110102 & 1001002 = 02, and numbers 3 (112) and 6 (1102) are not compatible, as 112 & 1102 = 102.You are given an array of integers a1, a2, ..., an. Your task is to find the following for each array element: is this element compatible with some other element from the given array? If the answer to this question is positive, then you also should find any suitable element.

The first line contains an integer n (1 ≤ n ≤ 106) — the number of elements in the given array. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 4·106) — the elements of the given array. The numbers in the array can coincide.

Print n integers ansi. If ai isn't compatible with any other element of the given array a1, a2, ..., an, then ansi should be equal to -1. Otherwise ansi is any such number, that ai & ansi = 0, and also ansi occurs in the array a1, a2, ..., an.

{-# OPTIONS_GHC -O2 -optc-O3 -fignore-asserts #-}
import Control.Monad
import Control.Monad.ST
import Data.Array.Unboxed
import Data.Array.ST
import Data.Bits
import Data.Maybe
import qualified Data.ByteString.Char8 as C

gao a = map ((c!) . xor m) a
  where
    n = 22
    m = 2 ^ n - 1
    c = runSTUArray gao' where
      gao' = do
        x <- newArray (0, m) $ -1 :: ST s (STUArray s Int Int)
        forM_ a $ \i -> do
          writeArray x i i
        forM_ [0 .. m] $ \i -> do
          e <- liftM (head . (++[-1]) . filter (>0)) $ mapM (readArray x) $ i:
            [xor i j | j <- map (shiftL 1) [0 .. n - 1], i .&. j /= 0]
          writeArray x i e
        return x

main = do
  C.getLine
  a <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getLine
  putStrLn $ unwords $ map show $ gao a

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

-- TODO
-- http://codeforces.ru/contest/165/submission/2510862
-- watashi has shorter solution but my attempt to simplify like he does leads to TLE !?

solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		--  runSTUArray prevents copying
		-- attempt to STArray Int (Maybe Int) leads to huge memory usage
		compatibles = runSTUArray $ do
			a <- newArray (0, m) $ (-1 :: Int)
			forM_ xs $ \x -> writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	putStrLn $ unwords $ map show $ solve xs

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

solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		--  runSTUArray prevents copying
		compatibles = runSTUArray $ do
			-- attempt to STArray Int (Maybe Int) leads to huge memory usage
			a <- newArray (0, m) (-1) :: ST s (STUArray s Int Int)
			forM_ xs $ \x -> writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	putStrLn $ unwords $ map show $ solve xs

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

solve :: [Int] -> [Int]
solve xs = map (compatibles !) xs
	where
		n = 22
		m = 2^n - 1
		compatibles = runSTUArray $ do
			a <- newArray (0, m) (-1) :: ST s (STUArray s Int Int)
			forM_ xs $ \x -> do
				writeArray a (complement x .&. m) $ x
			forM_ (reverse [0..m]) $ \x -> do
				v <- readArray a x
				if v == -1
					then do
						nexts <- mapM (readArray a) $ map (setBit x) $
							filter (not . testBit x) [0..n-1]
						let vs = filter (/= -1) nexts
						if not $ null vs
							then writeArray a x $ head vs
							else return ()
					else return ()
			return a

main = do
	_ <- getLine
	xs <- (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
	-- xs <- (map read . words) `fmap` getLine
	putStrLn $ unwords $ map show $ solve xs


You have a string $$$s$$$ of length $$$n$$$ consisting of only characters > and <. You may do some operations with this string, for each operation you have to choose some character that still remains in the string. If you choose a character >, the character that comes right after it is deleted (if the character you chose was the last one, nothing happens). If you choose a character <, the character that comes right before it is deleted (if the character you chose was the first one, nothing happens).For example, if we choose character > in string > > < >, the string will become to > > >. And if we choose character < in string > <, the string will become to <.The string is good if there is a sequence of operations such that after performing it only one character will remain in the string. For example, the strings >, > > are good. Before applying the operations, you may remove any number of characters from the given string (possibly none, possibly up to $$$n - 1$$$, but not the whole string). You need to calculate the minimum number of characters to be deleted from string $$$s$$$ so that it becomes good.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) – the number of test cases. Each test case is represented by two lines. The first line of $$$i$$$-th test case contains one integer $$$n$$$ ($$$1 \le n \le 100$$$) – the length of string $$$s$$$. The second line of $$$i$$$-th test case contains string $$$s$$$, consisting of only characters > and <.

For each test case print one line. For $$$i$$$-th test case print the minimum number of characters to be deleted from string $$$s$$$ so that it becomes good.

NoteIn the first test case we can delete any character in string <>.In the second test case we don't need to delete any characters. The string > < < is good, because we can perform the following sequence of operations: > < < $$$\rightarrow$$$ < < $$$\rightarrow$$$ <.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

main :: IO ()
main = do
  t <- readInt <$> getLine
  replicateM_ t $ do
    n <- getLine
    s <- BS.takeWhile (>='!') <$> BS.getLine
    let l = BS.length $ BS.takeWhile (=='<') s
        r = BS.length $ snd $ BS.spanEnd (=='>') s
    print $ min l r

rInt :: StateT BSL.ByteString Maybe Int
rInt = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
rIntS = StateT $ BS.readInt . BS.dropWhile (<'!')

#define D(f,r,d) f::Integral a=>a->d;f=fromIntegral;r::String->d;r=read
#define C(f,r,g,h,d) D(f,r,d);g,h::RealFrac a=>a->d;g=floor;h=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

{-# INLINE wrA #-}
wrA = A.writeArray
{-# INLINE rdA #-}
rdA = A.readArray
{-# INLINE mdA #-}
mdA arr f i = do
  ai <- rdA arr i
  let fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' arr f i = do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
{-# INLINE swapA #-}
swapA arr i j = do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define N(f,g,a,m)\
  f :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e); f=A.newArray;\
  g :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e); g=A.newArray_
#define C(a,m)
N(newIOA,newIOA_,IOArray,IO)
N(newSTA,newSTA_,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m),
N(newIOUA,newIOUA_,IOUArray,IO)
N(newSTUA,newSTUA_,STUArray s,ST s)
#undef C
#undef N

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : tuple2 l

test :: C.ByteString -> Int
test s = min (l - l1) (l - l2)
  where
    l = C.length s
    l1 = C.length $ C.dropWhile (== '<') s
    l2 = C.length $ C.dropWhile (== '>') $ C.reverse s

test' :: (C.ByteString, C.ByteString) -> Int
test' (n, s) = test $ C.take (ri n) s

solve (snt:a) = mconcat $ map (enc . test') $ tuple2 $ take (2 * nt) a
  where
    nt = ri snt
    enc n = intDec n <> char7 '\n'

main :: IO ()
main = hPutBuilder stdout . solve . C.words =<< C.getContents

--prewritten code: https://github.com/antma/algo
{-# LANGUAGE BangPatterns, Safe #-}
{-# Options_GHC -O2 #-}
import Data.ByteString.Builder
import Data.Monoid
import System.IO
import qualified Data.ByteString.Char8 as C
import Data.Time (diffTimeToPicoseconds, utctDayTime, getCurrentTime)
import Data.Char

getSeed = return . fromInteger . (`mod` 999983) . diffTimeToPicoseconds . utctDayTime =<< getCurrentTime :: IO Int

ru, ri :: C.ByteString -> Int

ru = C.foldl' (\a c -> a * 10 - 48 + ord c) 0
ri s
  | C.head s == '-' = negate $ ru $ C.tail s
  | otherwise = ru s

tuple2 [] = []
tuple2 (x:y:l) = (x, y) : tuple2 l

test :: C.ByteString -> Int
test s
  | C.length s == 1 = 0
  | C.head s == '>' = 0
  | C.last s == '<' = 0
  | otherwise  = 1

test' :: (C.ByteString, C.ByteString) -> Int
test' (n, s) = test $ C.take (ri n) s

solve (snt:a) = mconcat $ map (enc . test') $ tuple2 $ take (2 * nt) a
  where
    nt = ri snt
    enc n = intDec n <> char7 '\n'

main :: IO ()
main = hPutBuilder stdout . solve . C.words =<< C.getContents


A sequence of square brackets is regular if by inserting symbols "+" and "1" into it, you can get a regular mathematical expression from it. For example, sequences "[[]][]", "[]" and "[[][[]]]" — are regular, at the same time "][", "[[]" and "[[]]][" — are irregular. Draw the given sequence using a minimalistic pseudographics in the strip of the lowest possible height — use symbols '+', '-' and '|'. For example, the sequence "[[][]][]" should be represented as: +-        -++- -+    |+- -++- -+||   |||   ||   |||   ||+- -++- -+||   |+-        -++- -+Each bracket should be represented with the hepl of one or more symbols '|' (the vertical part) and symbols '+' and '-' as on the example which is given above.Brackets should be drawn without spaces one by one, only dividing pairs of consecutive pairwise brackets with a single-space bar (so that the two brackets do not visually merge into one symbol). The image should have the minimum possible height. The enclosed bracket is always smaller than the surrounding bracket, but each bracket separately strives to maximize the height of the image. So the pair of final brackets in the example above occupies the entire height of the image.Study carefully the examples below, they adequately explain the condition of the problem. Pay attention that in this problem the answer (the image) is unique.

The first line contains an even integer n (2 ≤ n ≤ 100) — the length of the sequence of brackets. The second line contains the sequence of brackets — these are n symbols "[" and "]". It is guaranteed that the given sequence of brackets is regular.

Print the drawn bracket sequence in the format which is given in the condition. Don't print extra (unnecessary) spaces.

main :: IO ()
main = do
  _  <- getLine
  ps <- getLine
  let prs = transform ps
  let hi = 3 + 2 * maximum (map (\(_, _, _, balance) -> balance) prs)
  putStr $ unlines $ map (buildRow hi prs) [0 .. hi - 1]

transform :: String -> [(Char, Char, Char, Int)]
transform text = transform' (zip3 text' (tail text') (tail $ tail text')) 0
  where text' = "]" ++ text ++ "["
        transform' ((l, '[', r) : ps) b = (l, '[', r, b)     : transform' ps (b + 1)
        transform' ((l, ']', r) : ps) b = (l, ']', r, b - 1) : transform' ps (b - 1)
        transform' _                  _ = []

buildRow :: Int -> [(Char, Char, Char, Int)] -> Int -> String
buildRow hi (('[', ']', r, b) : ps) row = s : ' ' : s : charAt hi b row (r == ']') : buildRow hi ps row
  where s = if b == row || b == hi - 1 - row then '-' else ' '
buildRow hi ((l, p, r, b) : ps)     row = charAt hi b row ((l == p && p == '[') || (r == p && p == ']')) : buildRow hi ps row
buildRow _  []                      _   = []

charAt :: Int -> Int -> Int -> Bool -> Char
charAt hi balance row inner
  | balance < row && row < hi - 1 - balance   = '|'
  | row == balance - 1 || row == hi - balance = if inner then '-' else ' '
  | row == balance || row == hi - 1 - balance = '+'
  | otherwise                                 = ' '

main :: IO ()
main = do
  _  <- getLine
  ps <- getLine
  let prs = transform ps
  let hi = 3 + 2 * maximum (map (\(_, _, _, balance) -> balance) prs)
  putStr $ unlines $ map (buildRow hi prs) [0 .. hi - 1]

transform :: String -> [(Char, Char, Char, Int)]
transform text = transform' (zip3 text' (tail text') (tail $ tail text')) 0
  where text' = "]" ++ text ++ "["
        transform' ((l, '[', r) : ps) b = (l, '[', r, b)     : transform' ps (b + 1)
        transform' ((l, ']', r) : ps) b = (l, ']', r, b - 1) : transform' ps (b - 1)
        transform' _                  _ = []

buildRow :: Int -> [(Char, Char, Char, Int)] -> Int -> String
buildRow hi (('[', ']', r, b) : ps) row = s : ' ' : s : charAt hi b row (r == ']') : buildRow hi ps row
  where s = if b == row || b == hi - 1 - row then '-' else ' '
buildRow hi ((l, p, r, b) : ps)     row = charAt hi b row (l == p || r == p) : buildRow hi ps row
buildRow _  []                      _   = []

charAt :: Int -> Int -> Int -> Bool -> Char
charAt hi balance row inner
  | balance < row && row < hi - 1 - balance   = '|'
  | row == balance - 1 || row == hi - balance = if inner then '-' else ' '
  | row == balance || row == hi - 1 - balance = '+'
  | otherwise                                 = ' '


Twilight Sparkle was playing Ludo with her friends Rainbow Dash, Apple Jack and Flutter Shy. But she kept losing. Having returned to the castle, Twilight Sparkle became interested in the dice that were used in the game.The dice has m faces: the first face of the dice contains a dot, the second one contains two dots, and so on, the m-th face contains m dots. Twilight Sparkle is sure that when the dice is tossed, each face appears with probability . Also she knows that each toss is independent from others. Help her to calculate the expected maximum number of dots she could get after tossing the dice n times.

A single line contains two integers m and n (1 ≤ m, n ≤ 105).

Output a single real number corresponding to the expected maximum. The answer will be considered correct if its relative or absolute error doesn't exceed 10  - 4.

NoteConsider the third test example. If you've made two tosses:  You can get 1 in the first toss, and 2 in the second. Maximum equals to 2.  You can get 1 in the first toss, and 1 in the second. Maximum equals to 1.  You can get 2 in the first toss, and 1 in the second. Maximum equals to 2.  You can get 2 in the first toss, and 2 in the second. Maximum equals to 2. The probability of each outcome is 0.25, that is expectation equals to: You can read about expectation using the following link: http://en.wikipedia.org/wiki/Expected_value

chanceALOnce m n = 1 - (1 - 1 / fromIntegral n) ^ m
solve m 1 = 1
solve m n =
  chanceALOnce m n * fromIntegral n + (1 - chanceALOnce m n) * solve m (n-1) :: Double
s[m,n]=solve n m
main=interact$show.s.map read.words

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

fastPower :: Num a => a -> Int -> a
fastPower x 0 = 1
fastPower x 1 = x
fastPower x n
    | n `mod` 2 == 1 = half * half * x
    | otherwise      = half * half
    where
    half = fastPower x (n `div` 2)

gao :: Int -> Int -> Double
gao m n = foldl' (+) 0.0 $ map (\x -> ((probabilities!x) - (probabilities!(x-1))) * (fromIntegral x)) [1 .. m]
    where
    probabilities = listArray (0, m) (map (\x -> fastPower ((fromIntegral x) / (fromIntegral m)) n) [0 .. m])

main = do
    (m:n:_) <- getInts
    putStrLn $ show $ gao m n
    where
    getInts :: IO [Int]
    getInts = (map read . words) <$> getLine

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

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

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

main = do
  [m, n] <- fmap (map read . words) getLine :: IO [Int]

  let
    m' = fromIntegral m
    v = sum $ [i * ((i/m')^n - ((i-1)/m')^n) | i <- map fromIntegral [1..m]] :: Double

  print v

import Control.Arrow((>>>))
import Text.Printf

itof :: Int -> Double
itof = fromIntegral

p m n i = f i - f (i-1) where
  f i = (itof i / itof m) ^ n

e :: Int -> Int -> Double
e m n = sum [p m n i * itof i | i <- [1..m]]

main :: IO ()
main = do
  [m,n] <- getLine >>= (words >>> map read >>> return)
  printf "%.5f\n" $ e m n

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE BangPatterns        #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8       as C
import           Data.Char
import qualified Data.Foldable               as F
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as M
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Word
import           Debug.Trace
import           Text.Printf

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

getInts :: IO [Int]
getInts = readInts <$> C.getLine

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  [m, n] <- getInts

  let es :: Int -> Double -> Double -> Double
      es 1 p !acc = acc + p
      es i p !acc =
        let cur = p * (1 - ((cast i - 1) / cast i) ** cast n)
        in es (i-1) (p - cur) $ acc + cast i * cur

  print (es m 1 0 :: Double)

import Control.Applicative
import Text.Printf

f i m n = i * ( (i/m)^n - ( (i-1)/m)^n)

main = do
    l <- map read . words <$> getLine :: IO [Integer]
    m <- return $ head l
    n <- return $ last l
    printf "%.12f\n" $ sum $ [ f (fromIntegral i :: Double) (fromIntegral m :: Double) n | i <- [1..m]]