The developers of Looksery have to write an efficient algorithm that detects faces on a picture. Unfortunately, they are currently busy preparing a contest for you, so you will have to do it for them. In this problem an image is a rectangular table that consists of lowercase Latin letters. A face on the image is a 2 × 2 square, such that from the four letters of this square you can make word "face". You need to write a program that determines the number of faces on the image. The squares that correspond to the faces can overlap.

The first line contains two space-separated integers, n and m (1 ≤ n, m ≤ 50) — the height and the width of the image, respectively. Next n lines define the image. Each line contains m lowercase Latin letters.

In the single line print the number of faces on the image.

NoteIn the first sample the image contains a single face, located in a square with the upper left corner at the second line and the second column:   In the second sample the image also contains exactly one face, its upper left corner is at the second row and the first column.In the third sample two faces are shown:   In the fourth sample the image has no faces on it.

import Data.List

main :: IO()
main = print . solve . tail . lines =<< getContents

solve :: [String] -> Int
solve (a:b:s) = (count (zips a b)) + (solve (b:s))
solve _       = 0

zips :: String -> String -> String
zips ""     ""     = ""
zips (a:as) (b:bs) = (a:b:(zips as bs))

count :: String -> Int
count (a:b:c:d:s) | sort [a,b,c,d] == sort "face" = 1 + (count (c:d:s))
                  | otherwise = count (c:d:s)
count _           = 0

{-# 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
  [n, m] <- map read . words <$> getLine
  a <- replicateM n getLine

  let check (a, b) (c, d) = sort [a, b, c, d] == "acef"

  print $ length $ filter id $ [check p q | [x, y] <- map (take 2) (init (init (tails a))), [p, q] <- map (take 2) (init (init (tails (zip x y))))]

import Data.List

detect i [] _ = i
detect i _ [] = i
detect i [_] _ = i
detect i _ [_] = i
detect i (a:b:as) (c:d:cs) = detect (i + if sort [a,b,c,d] == "acef" then 1 else 0) (b:as) (d:cs)

solve i [a] = i
solve i (a:b:as) = solve (i + detect 0 a b) (b:as)

main = interact $ show . solve 0 . tail . lines

-- Codeforces 549A

import Data.List (sort)

main :: IO ()
main = do
    [n, m] <- fmap (map read . words) getLine
    getContents >>= print . solve [(i, j) | i <- [0..n-2], j <- [0..m-2]] . lines -- enumerate all positions.

solve :: [(Int, Int)] -> [String] -> Int
solve [] _ = 0
solve ((i,j):xs) mat = check + (solve xs mat) where check = if sort [mat!!i!!j, mat!!i!!(j+1), mat!!(i+1)!!j, mat!!(i+1)!!(j+1)] == "acef" then 1 else 0

import Data.List

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

solve :: [String] -> Int
solve lst =
  let n = length lst
      m = length $ head lst
      getSquare :: Int -> Int -> String
      getSquare i j =
        [(lst !! k) !! l | k <- [i, min (i+1) (n-1)], l <- [j, min (j+1) (m-1)]]
      isSquare :: String -> Bool
      isSquare str =
        sort str == "acef"
  in length $ filter isSquare $ [getSquare i j | i <- [0..n-1], j <- [0..m-1]]

import Control.Arrow ((&&&), (***))
import Data.Functor ((<$>))
import Data.List (sort)

main :: IO ()
main = print =<< solve <$> (tail <$> lines <$> getContents)

solve :: [String] -> Int
solve xs = length . filter (=="acef") . concatMap (map (sort . uncurry (++) . (unTuple *** unTuple))
        . uncurry zip . (uncurry zip . (id &&& tail) *** uncurry zip . (id &&& tail))) $ zip xs (tail xs)

unTuple :: (a, a) -> [a]
unTuple (a, b) = [a, b]

import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Array as Arr
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import Data.List
import Control.Applicative
import Control.Monad
import Data.Function

solve1 ((a,b) : (c,d) : _) = if sort [a,b,c,d] == sort "face" then 1 else 0
solve1 _ = 0

solver (x:y:_) = sum $ map solve1 (tails (zip x y))
solver _ = 0

solve :: [String] -> Integer
solve l = sum $ map solver (tails l)

main = interact $ unlines . return . show . solve . tail . lines

import Data.List (sort)

type Face = ((Char, Char), (Char, Char))

parse :: String -> [String]
parse = tail . lines

isFace :: Face -> Bool
isFace ((a, b), (c, d)) = (sort [a, b, c, d]) == "acef"

mkFaces :: [String] -> [Face]
mkFaces = concat . pairWith zip . map (pairWith (,))
          where pairWith f a = zipWith f a (tail a)

solve :: [String] -> Int
solve = length . filter isFace . mkFaces

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


This is the easy version of the problem. The only difference is that here $$$k=2$$$. You can make hacks only if both the versions of the problem are solved.This is an interactive problem.Every decimal number has a base $$$k$$$ equivalent. The individual digits of a base $$$k$$$ number are called $$$k$$$-its. Let's define the $$$k$$$-itwise XOR of two $$$k$$$-its $$$a$$$ and $$$b$$$ as $$$(a + b)\bmod k$$$.The $$$k$$$-itwise XOR of two base $$$k$$$ numbers is equal to the new number formed by taking the $$$k$$$-itwise XOR of their corresponding $$$k$$$-its. The $$$k$$$-itwise XOR of two decimal numbers $$$a$$$ and $$$b$$$ is denoted by $$$a\oplus_{k} b$$$ and is equal to the decimal representation of the $$$k$$$-itwise XOR of the base $$$k$$$ representations of $$$a$$$ and $$$b$$$. All further numbers used in the statement below are in decimal unless specified. When $$$k = 2$$$ (it is always true in this version), the $$$k$$$-itwise XOR is the same as the bitwise XOR.You have hacked the criminal database of Rockport Police Department (RPD), also known as the Rap Sheet. But in order to access it, you require a password. You don't know it, but you are quite sure that it lies between $$$0$$$ and $$$n-1$$$ inclusive. So, you have decided to guess it. Luckily, you can try at most $$$n$$$ times without being blocked by the system. But the system is adaptive. Each time you make an incorrect guess, it changes the password. Specifically, if the password before the guess was $$$x$$$, and you guess a different number $$$y$$$, then the system changes the password to a number $$$z$$$ such that $$$x\oplus_{k} z=y$$$. Guess the password and break into the system.

The first line of input contains a single integer $$$t$$$ ($$$1\leq t\leq 10\,000$$$) denoting the number of test cases. $$$t$$$ test cases follow. The first line of each test case contains two integers $$$n$$$ ($$$1\leq n\leq 2\cdot 10^5$$$) and $$$k$$$ ($$$k=2$$$). It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot 10^5$$$.

NoteIn the example test case, the hidden password is $$$2$$$.The first query is $$$3$$$. It is not equal to the current password. So, $$$0$$$ is returned, and the password is changed to $$$1$$$ since $$$2\oplus_2 1=3$$$.The second query is $$$4$$$. It is not equal to the current password. So, $$$0$$$ is returned, and the password is changed to $$$5$$$ since $$$1\oplus_2 5=4$$$.The third query is $$$5$$$. It is equal to the current password. So, $$$1$$$ is returned, and the job is done.Note that this initial password is taken just for the sake of explanation. When you submit, the interactor might behave differently because it is adaptive.

import Control.Monad ( guard, replicateM_, forM_, when )
import Data.Bits ( Bits(xor) )
import Data.IORef ( newIORef, readIORef, writeIORef )
import Data.List ( unfoldr )
import Data.Maybe ( fromJust )
import System.IO ( hFlush, stdout )
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n, k] <- readInts
    done <- newIORef False
    forM_ [0..n - 1] $ \i -> do
        done' <- readIORef done
        if done' then return ()
        else do
            let j = if i == 0 then i else i `xor` (i - 1)
            print j
            hFlush stdout
            r <- readInt
            guard (r /= -1)
            when (r == 1) $ writeIORef done True
    readIORef done >>= guard

readInt :: IO Int
readInt = fst . fromJust . C.readInt <$> C.getLine

readInts :: IO [Int]
readInts = unfoldr (C.readInt . C.dropWhile (== ' ')) <$> C.getLine

main :: IO ()
main = do
    t <- readInt
    replicateM_ t solve

import Control.Monad ( guard, replicateM_, forM_, when )
import Data.Bits ( Bits(xor) )
import Data.IORef ( newIORef, readIORef, writeIORef )
import Data.Maybe ( fromJust )
import System.IO ( hFlush, stdout )
import qualified Data.ByteString.Char8 as C

solve :: IO ()
solve = do
    [n, k] <- readInts
    done <- newIORef False
    forM_ [0..n - 1] $ \i -> do
        done' <- readIORef done
        if done' then return ()
        else do
            let j = if i == 0 then i else i `xor` (i - 1)
            C.putStrLn $ C.pack $ show j
            hFlush stdout
            r <- readInt
            guard (r /= -1)
            when (r == 1) $ writeIORef done True
    readIORef done >>= guard

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

readInt :: IO Int
readInt = parseInt <$> C.getLine

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

main :: IO ()
main = do
    t <- readInt
    replicateM_ t solve

import Control.Monad ( replicateM_, guard, when )
import Data.Bits ( Bits(xor) )
import System.IO ( hFlush, stdout )

solve :: IO ()
solve = do
    [n, k] <- readMany :: IO [Int]
    let go :: Int -> IO ()
        go i = do
            let j = i `xor` (i - 1)
            print j
            hFlush stdout
            r <- readLn :: IO Int
            guard (r /= -1)
            when (r == 0) $ go (i + 1)
    go 1

readMany :: Read a => IO [a]
readMany = map read . words <$> getLine

main :: IO ()
main = do
    t <- readLn :: IO Int
    replicateM_ t solve


Mike has a sequence A = [a1, a2, ..., an] of length n. He considers the sequence B = [b1, b2, ..., bn] beautiful if the gcd of all its elements is bigger than 1, i.e. . Mike wants to change his sequence in order to make it beautiful. In one move he can choose an index i (1 ≤ i < n), delete numbers ai, ai + 1 and put numbers ai - ai + 1, ai + ai + 1 in their place instead, in this order. He wants perform as few operations as possible. Find the minimal number of operations to make sequence A beautiful if it's possible, or tell him that it is impossible to do so. is the biggest non-negative number d such that d divides bi for every i (1 ≤ i ≤ n).

The first line contains a single integer n (2 ≤ n ≤ 100 000) — length of sequence A. The second line contains n space-separated integers a1, a2, ..., an (1 ≤ ai ≤ 109) — elements of sequence A.

Output on the first line "YES" (without quotes) if it is possible to make sequence A beautiful by performing operations described above, and "NO" (without quotes) otherwise. If the answer was "YES", output the minimal number of moves needed to make sequence A beautiful.

NoteIn the first example you can simply make one move to obtain sequence [0, 2] with .In the second example the gcd of the sequence is already greater than 1.

import           Control.Applicative
import           Control.Arrow
import qualified Data.ByteString.Char8 as BS

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

main = let True  `add` Right c = Left c
           False `add` Right c = Right c
           True  `add` Left  c = Right (c + 1)
           False `add` Left  c = Right (c + 2)
           op = liftA2 (.) (second. add. odd) (first. gcd)
           finish 1 = either (+2) id
           finish _ = const 0
           calc = print. uncurry finish . foldr op (0, Right 0)
       in putStrLn "YES" >> getLine >> getInts >>= calc

import           Control.Applicative
import           Control.Arrow
import qualified Data.ByteString.Char8 as BS

getInts::IO [Int]
getInts = go <$> BS.getLine where
  go s = case  BS.readInt s of
      Nothing      -> []
      Just (x, s') -> x : go (BS.drop 1 s')

main = let True  `add` Right c = Left c
           False `add` Right c = Right c
           True  `add` Left  c = Right (c + 1)
           False `add` Left  c = Right (c + 2)
           op = liftA2 (.) (second. add. odd) (first. gcd)
           finish 1 = either (+1) id
           finish _ = either (+1) id
           calc = print. uncurry finish . foldr op (0, Right 0)
       in putStrLn "YES" >> getLine >> getInts >>= calc


A palindrome is a string $$$t$$$ which reads the same backward as forward (formally, $$$t[i] = t[|t| + 1 - i]$$$ for all $$$i \in [1, |t|]$$$). Here $$$|t|$$$ denotes the length of a string $$$t$$$. For example, the strings 010, 1001 and 0 are palindromes.You have $$$n$$$ binary strings $$$s_1, s_2, \dots, s_n$$$ (each $$$s_i$$$ consists of zeroes and/or ones). You can swap any pair of characters any number of times (possibly, zero). Characters can be either from the same string or from different strings — there are no restrictions.Formally, in one move you:  choose four integer numbers $$$x, a, y, b$$$ such that $$$1 \le x, y \le n$$$ and $$$1 \le a \le |s_x|$$$ and $$$1 \le b \le |s_y|$$$ (where $$$x$$$ and $$$y$$$ are string indices and $$$a$$$ and $$$b$$$ are positions in strings $$$s_x$$$ and $$$s_y$$$ respectively),  swap (exchange) the characters $$$s_x[a]$$$ and $$$s_y[b]$$$. What is the maximum number of strings you can make palindromic simultaneously?

The first line contains single integer $$$Q$$$ ($$$1 \le Q \le 50$$$) — the number of test cases. The first line on each test case contains single integer $$$n$$$ ($$$1 \le n \le 50$$$) — the number of binary strings you have. Next $$$n$$$ lines contains binary strings $$$s_1, s_2, \dots, s_n$$$ — one per line. It's guaranteed that $$$1 \le |s_i| \le 50$$$ and all strings constist of zeroes and/or ones.

Print $$$Q$$$ integers — one per test case. The $$$i$$$-th integer should be the maximum number of palindromic strings you can achieve simultaneously performing zero or more swaps on strings from the $$$i$$$-th test case.

NoteIn the first test case, $$$s_1$$$ is palindrome, so the answer is $$$1$$$.In the second test case you can't make all three strings palindromic at the same time, but you can make any pair of strings palindromic. For example, let's make $$$s_1 = \text{0110}$$$, $$$s_2 = \text{111111}$$$ and $$$s_3 = \text{010000}$$$.In the third test case we can make both strings palindromic. For example, $$$s_1 = \text{11011}$$$ and $$$s_2 = \text{100001}$$$.In the last test case $$$s_2$$$ is palindrome and you can make $$$s_1$$$ palindrome, for example, by swapping $$$s_1[2]$$$ and $$$s_1[3]$$$.

{-# 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_ print

solve = do
	n <- readInt
	ss <- replicateM n getLine
	let
		ls = map length ss
		zeros = length $ filter ( == '0' ) $ concat ss
		ones = sum ls - zeros
		pairs = ( zeros `div` 2 ) + ( ones `div` 2 )
	return $ length $ takeWhile ( <= pairs ) $ scanl1 (+) $ sort $ map ( `div` 2 ) ls

import           Data.List
import           Numeric

(|>) = flip (.)

int :: String -> Int
int x = fst $ readDec x !! 0

ints :: String -> [Int]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> map show
  |> unlines

solverLoop :: [String] -> [Int]
solverLoop (ts:xs) = go t xs
    where
      t = int ts
      go 0 _ = []
      go t (nStr:xs) =
          solve (take n xs) : go (t - 1) (drop n xs)
          where
            n = int nStr

solve :: [String] -> Int
solve xs = go lengths counts1 counts0
  where
    counts1 = sum $ map (count '1') xs
    counts0 = sum $ map (count '0') xs
    lengths = sort $ map length xs
    go [] _ _ = 0
    go (x:xs) c1 c0
      | x `mod` 2 == 0
        && ec1 + ec0 >= x
        = 1 + go xs
          (c1 - (min ec1 x))
          (c0 - (min ec0 (x - (min ec1 x))))
      | x `mod` 2 == 1
        && c1 + c0 >= x
        = 1 + if c1 `mod` 2 == 1
            then go xs (c1 - (min c1 x)) (c0 - (x - (min c1 x)))
            else go xs (c1 - (min c1 (x-1))) (c0 - (x - (min c1 (x-1))))
      | otherwise = 0
      where
        ec1 = (c1 - c1 `mod` 2)
        ec0 = (c0 - c0 `mod` 2)

count x = length . filter (== x)

import           Data.List
import           Numeric

(|>) = flip (.)

int :: String -> Int
int x = fst $ readDec x !! 0

ints :: String -> [Int]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> map show
  |> unlines

solverLoop :: [String] -> [Int]
solverLoop (ts:xs) = go t xs
    where
      t = int ts
      go 0 _ = []
      go t (nStr:xs) =
          solve (take n xs) : go (t - 1) (drop n xs)
          where
            n = int nStr

solve :: [String] -> Int
solve xs = length
  $ takeWhile (<= (counts1 `div` 2 + counts0 `div` 2))
  $ scanl1 (+)
  $ sort $ map ((`div` 2) . length) xs
  where
    counts1 = sum $ map (count '1') xs
    counts0 = sum $ map (count '0') xs

count x = length . filter (== x)


After you have read all the problems, probably, you think Alex is genius person. That's true! One day he came up with the following task.Given a sequence of integer numbers a1, a2, ..., an. You are to find a longest sequence b1, b2, ..., b4m, that satisfies the following conditions:  b4k + 1 = b4k + 3 for all valid integer k;  b4k + 2 = b4k + 4 for all valid integer k;  sequence b is subsequence of a (not necessarily contiguous subsequence). And finally... Alex had given this complicated task to George, and George gave it to you. Help George to cope with the task.

The first line contains a single integer n (1 ≤ n ≤ 5·105). The next line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109).

In the first line print a single integer 4m — the maximal possible length of required sequence b. In the second line print 4m integers b1, b2, ..., b4m, that is required sequence. If there are multiple optimal answers you may print any of them.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
import Control.Arrow
import Data.Maybe
import qualified Data.IntSet as Set
import Data.IntSet(IntSet)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Map as Map
import Data.Map(Map)
import qualified Data.Array as Array
import qualified Data.Foldable as F
import Data.Array ((!), Array)

data Result a =
  Known !Int !a !a
  | Unknown
  deriving (Show, Eq, Ord)

removeSmall i m = case Set.minView m of
  Nothing -> Set.empty
  Just (a2i, m')
    | a2i <= i -> removeSmall i m'
    | otherwise -> m

attempt :: forall a. (Eq a, Ord a) => Int -> Array Int (a, Maybe Int) -> Int -> Result a
attempt n arr = \i -> go Set.empty i Unknown where
  go :: IntSet -> Int -> Result a -> Result a
  go heap i result@(Known w _ _) | i >= w = result
  go heap i result | i >= n = result
  go heap i result = case arr ! i of
    (x, Nothing) ->
      go (removeSmall (i + 1) heap) (i + 1) result
    (x, Just x2i) ->
      go (removeSmall (i+1) $ Set.insert x2i heap) (i + 1) (min result (min asB try4)) where

        try4 :: Result a
        try4 = toResult $ do
          let (x2, x3i) = arr ! x2i
          x3i <- x3i
          let (x3, x4i) = arr ! x3i
          x4i <- x4i
          if (x2 == x && x3 == x)
            then return x4i
            else error "bad"
          where
            toResult Nothing = Unknown
            toResult (Just i) = Known i x x

        asB :: Result a
        asB = case Set.minView heap of
          Nothing -> Unknown
          Just (a2i, _)
            | a2i < x2i -> Known x2i (fst (arr ! a2i)) x
            | otherwise -> Unknown

preprocess' :: (Eq a, Ord a, Num a) => Int -> [a] -> [(a, Maybe Int)]
preprocess' n l = let !xx = sum l in (\(l,m,_) -> l) $ F.foldr' (\a (l, m, i) -> let i' = i - 1; !ix = Map.lookup a m in ((a, ix):l, Map.insert a i' m, i')) ([], Map.empty, n) l

preprocess n l = Array.listArray (0, n - 1) (preprocess' n l)

solve :: (Eq a, Ord a, Num a) => Int -> [a] -> [(a, a)]
solve n l = go 0 where
  arr = preprocess n l
  go i = case attempt n arr i of
    Unknown -> []
    Known i' a b -> (a,b) : go (i' + 1)

pp l = unlines [show (length l * 4), unwords (concat [map show [a,b,a,b]|(a,b) <- l])]

main = BS.interact $ BS.pack . pp . uncurry solve . (head &&& tail) . map (fst . fromJust . BS.readInt) . BS.words


An accordion is a string (yes, in the real world accordions are musical instruments, but let's forget about it for a while) which can be represented as a concatenation of: an opening bracket (ASCII code $$$091$$$), a colon (ASCII code $$$058$$$), some (possibly zero) vertical line characters (ASCII code $$$124$$$), another colon, and a closing bracket (ASCII code $$$093$$$). The length of the accordion is the number of characters in it.For example, [::], [:||:] and [:|||:] are accordions having length $$$4$$$, $$$6$$$ and $$$7$$$. (:|:), {:||:}, [:], ]:||:[ are not accordions. You are given a string $$$s$$$. You want to transform it into an accordion by removing some (possibly zero) characters from it. Note that you may not insert new characters or reorder existing ones. Is it possible to obtain an accordion by removing characters from $$$s$$$, and if so, what is the maximum possible length of the result?

The only line contains one string $$$s$$$ ($$$1 \le |s| \le 500000$$$). It consists of lowercase Latin letters and characters [, ], : and |.

If it is not possible to obtain an accordion by removing some characters from $$$s$$$, print $$$-1$$$. Otherwise print maximum possible length of the resulting accordion.

-- Educational Codeforces Round #58 (B), Contest 1101, Problem set ?.

{-# 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
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  s <- BS.getLine
  print $ fromMaybe (-1) $ query s

query :: BS.ByteString -> Maybe Int
query xs0 = do
  let xs1 = BS.dropWhile (/='[') xs0
      xs2 = BS.dropWhile (/=':') xs1
  guard $ not $ BS.null xs2
  let (xs3,_) = BS.spanEnd (/= ']') $ BS.tail xs2
      (xs4,_) = BS.spanEnd (/=':') $ xs3
  guard $ not $ BS.null xs4
  let xs5 = BS.init xs4
  return $ (4+) $ length $ BS.elemIndices '|' xs5

import Text.Printf
import Data.List
import Data.Functor
import Control.Applicative
import Prelude
import Control.Monad
import Data.Maybe
import Data.Function
import Data.Array
import qualified Data.ByteString.Char8 as B8

readInt :: String -> Int
readInt = Prelude.read

type DpState = (Maybe Int, Maybe Int, Maybe Int, Maybe Int)

maybeMaximum :: [Maybe Int] -> Maybe Int
maybeMaximum = foldr max Nothing

dpStateStep :: DpState -> Char -> DpState
dpStateStep (a0, a1, a2, a3) '[' = (maybeMaximum [a0, Just 1], a1, a2, a3)
dpStateStep (a0, a1, a2, a3) ':' = (a0, maybeMaximum [(+1) <$> a0, a1], maybeMaximum [(+1) <$> a1, a2], a3)
dpStateStep (a0, a1, a2, a3) '|' = (a0, (+1) <$> a1, a2, a3)
dpStateStep (a0, a1, a2, a3) ']' = (a0, a1, a2, maybeMaximum [(+1) <$> a2, a3])
dpStateStep dpState _ = dpState

solve :: B8.ByteString -> Int
solve str = fromMaybe (-1) answer
    where
        (_, _, _, answer) = B8.foldl' dpStateStep (Nothing, Nothing, Nothing, Nothing) str

main :: IO ()
main = do
    str <- B8.getLine
    printf "%d" $ solve str

main = interact f

f s = (case f0 s of
    Just i -> show (i + 4)
    Nothing -> "-1") ++ "\n"

f0 ('[':s) = f1 s
f0 (_:s) = f0 s
f0 [] = Nothing

f1 (':':s) = f2 s
f1 (_:s) = f1 s
f1 [] = Nothing

f2 s = f3 Nothing 0 s

f3 prev score ('|':s) = f3 prev (score + 1) s
f3 prev score (':':s) = case f4 score s of
    Just (i, j, s) -> f3 (Just i) j s
    Nothing -> prev
f3 prev score (_:s) = f3 prev score s
f3 prev _ [] = prev

f4 score s = f5 score score s

f5 i j ('|':s) = f5 i (j + 1) s
f5 i j (']':s) = Just (i, j, s)
f5 i j (':':s) = f5 j j s
f5 i j (_:s) = f5 i j s
f5 _ _ [] = Nothing

{-# 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 [] = -1
solve ('[':s) = solve2 $ s
solve (x:s) = solve s

solve2 [] = -1
solve2 (':':s) = solve3 $ reverse s
solve2 (x:s) = solve2 s

solve3 [] = -1
solve3 (']':s) = solve4 s
solve3 (x:s) = solve3 s

solve4 [] = -1
solve4 (':':s) = solve5 s
solve4 (x:s) = solve4 s

solve5 [] = 4
solve5 ('|':s) = 1 + solve5 s
solve5 (x:s) = solve5 s

main = do
    s <- getLine
    print $ solve s

-- Educational Codeforces Round #58 (B), Contest 1101, Problem set ?.

{-# 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
import Data.Word
import Data.STRef
import Data.IORef
import Data.Function

main :: IO ()
main = do
  s <- BS.getLine
  print $ fromMaybe (-1) $ query s

query :: BS.ByteString -> Maybe Int
query xs0 = do
  let xs1 = BS.dropWhile (/='[') xs0
      xs2 = BS.dropWhile (/=':') xs1
  guard $ not $ BS.null xs2
  let (xs3,_) = BS.spanEnd (/= ']') $ BS.tail xs2
      (xs4,_) = BS.spanEnd (/=':') $ xs3
  guard $ not $ BS.null xs4
  let xs5 = BS.tail xs4
  return $ (4+) $ length $ BS.elemIndices '|' xs5

main = interact f

f s = (case f0 s of
    Just i -> show (i + 4)
    Nothing -> "-1") ++ "\n"

f0 ('[':s) = f1 s
f0 (_:s) = f0 s
f0 [] = Nothing

f1 (':':s) = f2 s
f1 (_:s) = f1 s
f1 [] = Nothing

f2 s = f3 Nothing 0 s

f3 prev score ('|':s) = f3 prev (score + 1) s
f3 prev score (':':s) = case f4 s of
    Just (i, s) -> f3 (Just score) (score + i) s
    Nothing -> prev
f3 prev score (_:s) = f3 prev score s
f3 prev _ [] = prev

f4 s = f5 0 s

f5 i ('|':s) = f5 (i + 1) s
f5 i (']':s) = Just (i, s)
f5 i (_:s) = f5 i s
f5 _ [] = Nothing


You've got two rectangular tables with sizes na × ma and nb × mb cells. The tables consist of zeroes and ones. We will consider the rows and columns of both tables indexed starting from 1. Then we will define the element of the first table, located at the intersection of the i-th row and the j-th column, as ai, j; we will define the element of the second table, located at the intersection of the i-th row and the j-th column, as bi, j. We will call the pair of integers (x, y) a shift of the second table relative to the first one. We'll call the overlap factor of the shift (x, y) value:where the variables i, j take only such values, in which the expression ai, j·bi + x, j + y makes sense. More formally, inequalities 1 ≤ i ≤ na, 1 ≤ j ≤ ma, 1 ≤ i + x ≤ nb, 1 ≤ j + y ≤ mb must hold. If there are no values of variables i, j, that satisfy the given inequalities, the value of the sum is considered equal to 0. Your task is to find the shift with the maximum overlap factor among all possible shifts.

The first line contains two space-separated integers na, ma (1 ≤ na, ma ≤ 50) — the number of rows and columns in the first table. Then na lines contain ma characters each — the elements of the first table. Each character is either a "0", or a "1". The next line contains two space-separated integers nb, mb (1 ≤ nb, mb ≤ 50) — the number of rows and columns in the second table. Then follow the elements of the second table in the format, similar to the first table. It is guaranteed that the first table has at least one number "1". It is guaranteed that the second table has at least one number "1".

Print two space-separated integers x, y (|x|, |y| ≤ 109) — a shift with maximum overlap factor. If there are multiple solutions, print any of them.

import qualified Data.Array as A
import qualified Data.List as L
import Data.Ix
import Control.Monad

main :: IO ()
main = do [na,ma] <- (getLine >>= return . map read . words)
          la      <- foldM (\e x -> nextChar >>= (\c -> return ((x,c):e))) [] [(x,y) | x <- [1..na],y <- [1..ma]]
          getLine
          [nb,mb] <- (getLine >>= return . map read . words)
          lb      <- foldM (\e x -> nextChar >>= (\c -> return ((x,c):e))) [] [(x,y) | x <- [1..nb],y <- [1..mb]]
          putStrLn . unwords . map show $ solve (na,ma) la (nb,mb) lb
    where
          nextChar = do c <- getChar
                        case c of
                            '\n' -> nextChar
                            '0'  -> return 0
                            '1'  -> return 1

solve :: (Int,Int) -> [((Int,Int),Int)] -> (Int,Int) -> [((Int,Int),Int)] -> [Int]
solve (na,ma) la (nb,mb) lb = snd $ maximum [ (overlap x y,[x,y]) | x <- [-50..50], y <- [-50..50]]
    where mat_a = A.array ((1,1),(na,ma)) la
          mat_b = A.array ((1,1),(nb,mb)) lb
          overlap :: Int -> Int -> Int
          overlap x y = L.foldl' (+) 0 [(mat_a A.! (i,j)) * (mat_b A.! (i+x,j+y)) | i <- [max 1 (1-x)..min na (nb-x)],j <- [max 1 (1-y)..min ma (mb-y)]]

import Array
import Data.List (foldl')
import Monad (liftM)

solve :: Array (Int, Int) Int -> Array (Int, Int) Int -> (Int, Int)
solve a b  =  (m, n)
  where
    (m, n, fa)  =  foldl' getMax (undefined, undefined, -1)
                    [(x, y) | x <- [1 - na .. nb - 1], y <- [1 - ma .. mb - 1]]
    (na, ma)  =  snd $ bounds a
    (nb, mb)  =  snd $ bounds b
    getMax a@(_, _, fa) b@(b1, b2)
      | fa > fb    =   a
      | otherwise  =  (b1, b2, fb)
      where
        fb  =  f b
    f (x, y)  =  foldl' (+) 0 [a ! (i,j) * b ! (i+x, j+y)
                  | i <- [max 1 (1 - x) .. min na (nb - x)],
                    j <- [max 1 (1 - y) .. min ma (mb - y)]]

main :: IO ()
main  =  do
    ls  <-  liftM lines getContents
    let [na, ma]  =  map read . words . head $ ls
    let a  =  listArray ((1,1), (na, ma)) . map read . concatMap (map (\c -> [c])) . take na . tail $ ls
    let [nb, mb]  =  map read . words . head . drop na . drop 1 $ ls
    let b  =  listArray ((1,1), (nb, mb)) . map read . concatMap (map (\c -> [c])) . take nb . drop 1 . drop na . drop 1 $ ls
    let (x,y)  = solve a b
    putStrLn $ concat [show x, " ", show y]


Let's define a number ebne (even but not even) if and only if its sum of digits is divisible by $$$2$$$ but the number itself is not divisible by $$$2$$$. For example, $$$13$$$, $$$1227$$$, $$$185217$$$ are ebne numbers, while $$$12$$$, $$$2$$$, $$$177013$$$, $$$265918$$$ are not. If you're still unsure what ebne numbers are, you can look at the sample notes for more clarification.You are given a non-negative integer $$$s$$$, consisting of $$$n$$$ digits. You can delete some digits (they are not necessary consecutive/successive) to make the given number ebne. You cannot change the order of the digits, that is, after deleting the digits the remaining digits collapse. The resulting number shouldn't contain leading zeros. You can delete any number of digits between $$$0$$$ (do not delete any digits at all) and $$$n-1$$$.For example, if you are given $$$s=$$$222373204424185217171912 then one of possible ways to make it ebne is: 222373204424185217171912 $$$\rightarrow$$$ 2237344218521717191. The sum of digits of 2237344218521717191 is equal to $$$70$$$ and is divisible by $$$2$$$, but number itself is not divisible by $$$2$$$: it means that the resulting number is ebne.Find any resulting number that is ebne. If it's impossible to create an ebne number from the given number report about it.

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$)  — the number of test cases. The description of the test cases follows. The first line of each test case contains a single integer $$$n$$$ ($$$1 \le n \le 3000$$$)  — the number of digits in the original number. The second line of each test case contains a non-negative integer number $$$s$$$, consisting of $$$n$$$ digits. It is guaranteed that $$$s$$$ does not contain leading zeros and the sum of $$$n$$$ over all test cases does not exceed $$$3000$$$.

For each test case given in the input print the answer in the following format:  If it is impossible to create an ebne number, print "-1" (without quotes); Otherwise, print the resulting number after deleting some, possibly zero, but not all digits. This number should be ebne. If there are multiple answers, you can print any of them. Note that answers with leading zeros or empty strings are not accepted. It's not necessary to minimize or maximize the number of deleted digits.

NoteIn the first test case of the example, $$$1227$$$ is already an ebne number (as $$$1 + 2 + 2 + 7 = 12$$$, $$$12$$$ is divisible by $$$2$$$, while in the same time, $$$1227$$$ is not divisible by $$$2$$$) so we don't need to delete any digits. Answers such as $$$127$$$ and $$$17$$$ will also be accepted.In the second test case of the example, it is clearly impossible to create an ebne number from the given number.In the third test case of the example, there are many ebne numbers we can obtain by deleting, for example, $$$1$$$ digit such as $$$17703$$$, $$$77013$$$ or $$$17013$$$. Answers such as $$$1701$$$ or $$$770$$$ will not be accepted as they are not ebne numbers. Answer $$$013$$$ will not be accepted as it contains leading zeroes.Explanation: $$$1 + 7 + 7 + 0 + 3 = 18$$$. As $$$18$$$ is divisible by $$$2$$$ while $$$17703$$$ is not divisible by $$$2$$$, we can see that $$$17703$$$ is an ebne number. Same with $$$77013$$$ and $$$17013$$$; $$$1 + 7 + 0 + 1 = 9$$$. Because $$$9$$$ is not divisible by $$$2$$$, $$$1701$$$ is not an ebne number; $$$7 + 7 + 0 = 14$$$. This time, $$$14$$$ is divisible by $$$2$$$ but $$$770$$$ is also divisible by $$$2$$$, therefore, $$$770$$$ is not an ebne number.In the last test case of the example, one of many other possible answers is given. Another possible answer is: 222373204424185217171912 $$$\rightarrow$$$ 22237320442418521717191 (delete the last digit).

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

main = getLine >>= test.read
test 0 = return ()
test a = getLine >> getLine >>= putStrLn.solve.take 2.filter (\d -> odd $ read [d]) >> test (a - 1)

solve a | length a == 2 = a | otherwise = "-1"

import Data.Ord
import Data.Int
import Data.Char
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
gets :: EIO String
gets = ExceptT $ liftM Right getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get :: EIO Int
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    get :: EIO Int
    s <- gets
    case f2 s of
        Nothing -> putsln("-1")
        Just (i, j) -> putsln(i : j : [])

f2 :: String -> Maybe (Char, Char)
f2 s =  let aux (c : rest) (x, y) = if (mod ((ord c) - (ord '0')) 2) == 1 then aux rest (y, c) else aux rest (x, y)
            aux [] (x, y) = (x, y)
        in
        let (x, y) = aux s ('x', 'x') in
            if x == 'x' || y == 'x' then
                Nothing
            else Just (x, y)

import Data.Maybe (fromMaybe)

main = readLn >>= go where
    go 0 = return ()
    go n = getLine >> readLn >>= print . fromMaybe (-1) . solve >> go (n-1)

solve :: Integer -> Maybe Int
solve n = let
    a = map read (map (:[]) $ show n) :: [Int]
    odds = filter odd a
    in if length odds < 2 then Nothing else Just $ 10 * (odds !! 0) + odds !! 1

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString [_] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo [_, _] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number
  | null oddVersion = []
  | even currSum = oddVersion
  | otherwise    = (takeWhile even oddVersion) ++ (tail (dropWhile even oddVersion))
  where oddVersion = reverse $ dropWhile even $ reverse number
        currSum = sum oddVersion

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Integer] -> [Integer]
toEbne number = take 2 $ filter odd number

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo [_] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Integer] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> toInteger $ n - (ord '0')) $ map ord xs

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

import Data.Char

toEbne :: [Int] -> [Int]
toEbne number
  | null oddVersion = []
  | even currSum = oddVersion
  | otherwise    = (takeWhile even oddVersion) ++ (tail (dropWhile even oddVersion))
  where oddVersion = reverse $ dropWhile even $ reverse number
        currSum = sum oddVersion

groupByTwo :: [String] -> [(String, String)]
groupByTwo [] = []
groupByTwo (n:s:rest) = [(n, s)] ++ groupByTwo rest

toString :: [Int] -> String
toString [] = "-1"
toString number = foldl (\acc n -> acc ++ show n) "" number

solve :: (String, String) -> String
solve (_, xs) = toString $ toEbne number
  where number = map (\n -> n - (ord '0')) $ map ord xs

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


Levko loves permutations very much. A permutation of length n is a sequence of distinct positive integers, each is at most n.Let’s assume that value gcd(a, b) shows the greatest common divisor of numbers a and b. Levko assumes that element pi of permutation p1, p2, ... , pn is good if gcd(i, pi) > 1. Levko considers a permutation beautiful, if it has exactly k good elements. Unfortunately, he doesn’t know any beautiful permutation. Your task is to help him to find at least one of them.

The single line contains two integers n and k (1 ≤ n ≤ 105, 0 ≤ k ≤ n).

In a single line print either any beautiful permutation or -1, if such permutation doesn’t exist. If there are multiple suitable permutations, you are allowed to print any of them.

NoteIn the first sample elements 4 and 3 are good because gcd(2, 4) = 2 > 1 and gcd(3, 3) = 3 > 1. Elements 2 and 1 are not good because gcd(1, 2) = 1 and gcd(4, 1) = 1. As there are exactly 2 good elements, the permutation is beautiful.The second sample has no beautiful permutations.

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

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

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

  where

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

module Main where
import Control.Applicative
main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let ans = [n] ++ [2..k+1] ++ [1] ++ [k+2..n-1]
  case undefined of
    _ | n == k -> print $ -1
    _ | n == k+1 -> putStrLn $ unwords $ map show [1..n]
    _ | otherwise -> putStrLn $ unwords $ map show ans

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

solve :: [Int] -> [Int]
solve [n, k]
  | n == k  =  [-1]
  | otherwise  =  take n ([1..k+1] ++ repeat 1)

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

  where

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

    readPair :: Num a => IO (a, a)
    readPair  =  do
        [a, b]  <-  reads
        return (a, b)

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

module Main where
import Control.Applicative
main :: IO ()
main = do
  [n,k] <- map read . words <$> getLine :: IO [Int]
  let ans = [n] ++ [2..k+1] ++ [1] ++ [k+2..n-1]
  if n == k
    then print $ -1
    else putStrLn $ unwords $ map show ans


A monopole magnet is a magnet that only has one pole, either north or south. They don't actually exist since real magnets have two poles, but this is a programming contest problem, so we don't care.There is an $$$n\times m$$$ grid. Initially, you may place some north magnets and some south magnets into the cells. You are allowed to place as many magnets as you like, even multiple in the same cell.An operation is performed as follows. Choose a north magnet and a south magnet to activate. If they are in the same row or the same column and they occupy different cells, then the north magnet moves one unit closer to the south magnet. Otherwise, if they occupy the same cell or do not share a row or column, then nothing changes. Note that the south magnets are immovable.Each cell of the grid is colored black or white. Let's consider ways to place magnets in the cells so that the following conditions are met.  There is at least one south magnet in every row and every column.  If a cell is colored black, then it is possible for a north magnet to occupy this cell after some sequence of operations from the initial placement.  If a cell is colored white, then it is impossible for a north magnet to occupy this cell after some sequence of operations from the initial placement. Determine if it is possible to place magnets such that these conditions are met. If it is possible, find the minimum number of north magnets required (there are no requirements on the number of south magnets).

The first line contains two integers $$$n$$$ and $$$m$$$ ($$$1\le n,m\le 1000$$$)  — the number of rows and the number of columns, respectively. The next $$$n$$$ lines describe the coloring. The $$$i$$$-th of these lines contains a string of length $$$m$$$, where the $$$j$$$-th character denotes the color of the cell in row $$$i$$$ and column $$$j$$$. The characters "#" and "." represent black and white, respectively. It is guaranteed, that the string will not contain any other characters.

Output a single integer, the minimum possible number of north magnets required. If there is no placement of magnets that satisfies all conditions, print a single integer $$$-1$$$.

NoteIn the first test, here is an example placement of magnets:  In the second test, we can show that no required placement of magnets exists. Here are three example placements that fail to meet the requirements. The first example violates rule $$$3$$$ since we can move the north magnet down onto a white square. The second example violates rule $$$2$$$ since we cannot move the north magnet to the bottom-left black square by any sequence of operations. The third example violates rule $$$1$$$ since there is no south magnet in the first column.  In the third test, here is an example placement of magnets. We can show that there is no required placement of magnets with fewer north magnets.  In the fourth test, we can show that no required placement of magnets exists. Here are two example placements that fail to meet the requirements. The first example violates rule $$$1$$$ since there is no south magnet in the first row. The second example violates rules $$$1$$$ and $$$3$$$ since there is no south magnet in the second row and we can move the north magnet up one unit onto a white square.  In the fifth test, we can put the south magnet in each cell and no north magnets. Because there are no black cells, it will be a correct placement.

import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import qualified Data.Graph as G
import Data.Graph (Graph)
import qualified Data.List as L

annotate :: Int -> String -> [((Int, Int), Char)]
annotate n= zip (zip [n,n..] [0..])

makeArray :: [String] -> UArray (Int, Int) Char
makeArray grid = Ar.array ((0,0), (n-1,m-1)) $ concat $ zipWith annotate [0..] grid
    where
        n = length grid
        m = length $ head grid

getComponents :: (Int, Int) -> UArray (Int, Int) Char -> Int -> Int
getComponents (n,m) arr i
    | i == (n-1) && '#' `elem` row    = 1
    | i == (n-1)                    = 0
    | ('#','#') `elem` zip row rowBelow = getComponents (n,m) arr (i+1)
    | '#' `elem` row                  = 1 + getComponents (n,m) arr (i+1)
    | otherwise                     = getComponents (n,m) arr (i+1)
    where
        row = [arr Ar.! (i,j) | j <- [0..m-1]]
        rowBelow = [arr Ar.! (i+1,j) | j <- [0..m-1]]

validRow :: Bool -> String -> Bool
validRow False s = reduced `elem` [".#.", ".#", "#.", "#"]
    where
        reduced = map head $ L.group s
validRow True s = reduced `elem` [".#.", ".#", "#.", "#", "."]
    where
        reduced = map head $ L.group s

invert :: [String] -> [String]
invert grid
    | null (head grid)  = []
    | otherwise         = heads : invert (map tail grid)
    where
        heads = map head grid

validGrid :: [String] -> Bool
validGrid grid = all (validRow hasMtCol) grid && all (validRow hasMtRow) inv
    where
        inv = invert grid
        hasMtRow = hasEmptyRow grid
        hasMtCol = hasEmptyRow inv

hasEmptyRow :: [String] -> Bool
hasEmptyRow = any allDots
    where
        allDots = all (=='.')

countDots :: [String] -> Int
countDots [] = 0
countDots (s:ss) = countDots' s + countDots ss
    where
        countDots' "" = 0
        countDots' ('.':cs) = 1 + countDots' cs
        countDots' (_:cs) = countDots' cs

valid :: (Int, Int) -> (Int, Int) -> Bool
valid (n,m) (i,j) = (i >= 0) && (i < n) && (j >= 0) && (j < m)

vert :: (Int, Int) -> (Int, Int) -> Int
vert (n,m) (i, j) = i*m+j

getEdges :: (Int, Int) -> UArray (Int, Int) Char -> (Int, Int) -> [(Int, Int)]
getEdges (n,m) grid (i,j)
    | curVal == '.'     = []
    | otherwise = [ (ver (i,j), ver(i1,j1)) | (i1,j1) <- neighbors, valid (n,m) (i1,j1), grid Ar.! (i1,j1) == '#', i1 >= i, j1 >= j]
    where
        curVal = grid Ar.! (i,j)
        ver = vert (n,m)
        neighbors = [(i+1,j), (i-1,j), (i,j+1), (i,j-1)]

makeGraph :: (Int, Int) -> [String] -> Graph
makeGraph (n,m) s = G.buildG (0,n*m-1) edges
    where
        grid = makeArray s
        edgeGetter = getEdges (n,m) grid
        edges = concatMap edgeGetter $ Ar.indices grid

solve :: (Int, Int) -> [String] -> Int
solve (n,m) s
    | not $ validGrid s = -1
--    | otherwise     = length (G.components (makeGraph (n,m) s)) - countDots s
    | otherwise         = getComponents (n,m) (makeArray s) 0

--testGrid = ["....#","####.",".###.",".#..."]
--testGrid = [".....",".....","....."]
testGrid = replicate 1000 (replicate 1000 '#')

test :: Int
test = solve (length testGrid, length $ head testGrid) testGrid

readGrid :: Int -> IO [String]
readGrid 0 = return []
readGrid n = do
    s <- getLine
    rest <- readGrid (n-1)
    return $ s:rest

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:m:_) <- readNums
    grid <- readGrid n
    --print grid
    print $ solve (n,m) grid
    testCases (t-1)

main :: IO ()
main = testCases 1

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine

import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import qualified Data.Graph as G
import Data.Graph (Graph)
import qualified Data.List as L

annotate :: Int -> String -> [((Int, Int), Char)]
annotate n= zip (zip [n,n..] [0..])

makeArray :: [String] -> UArray (Int, Int) Char
makeArray grid = Ar.array ((0,0), (n-1,m-1)) $ concat $ zipWith annotate [0..] grid
    where
        n = length grid
        m = length $ head grid

validRow :: Bool -> String -> Bool
validRow False s = reduced `elem` [".#.", ".#", "#.", "#"]
    where
        reduced = map head $ L.group s
validRow True s = reduced `elem` [".#.", ".#", "#.", "#", "."]
    where
        reduced = map head $ L.group s

invert :: [String] -> [String]
invert grid = heads : map tail grid
    where
        heads = map head grid

validGrid :: [String] -> Bool
validGrid grid = all (validRow hasMtCol) grid && all (validRow hasMtRow) inv
    where
        inv = invert grid
        hasMtRow = hasEmptyRow grid
        hasMtCol = hasEmptyRow inv

hasEmptyRow :: [String] -> Bool
hasEmptyRow = any allDots
    where
        allDots = all (=='.')

countDots :: [String] -> Int
countDots [] = 0
countDots (s:ss) = countDots' s + countDots ss
    where
        countDots' "" = 0
        countDots' ('.':cs) = 1 + countDots' cs
        countDots' (_:cs) = countDots' cs

valid :: (Int, Int) -> (Int, Int) -> Bool
valid (n,m) (i,j) = (i >= 0) && (i < n) && (j >= 0) && (j < m)

vert :: (Int, Int) -> (Int, Int) -> Int
vert (n,m) (i, j) = i*m+j

getEdges :: (Int, Int) -> UArray (Int, Int) Char -> (Int, Int) -> [(Int, Int)]
getEdges (n,m) grid (i,j)
    | curVal == '.'     = []
    | otherwise = [ (ver (i,j), ver(i1,j1)) | (i1,j1) <- neighbors, valid (n,m) (i1,j1) && grid Ar.! (i1,j1) == '#']
    where
        curVal = grid Ar.! (i,j)
        ver = vert (n,m)
        neighbors = [(i+1,j), (i-1,j), (i,j+1), (i,j-1)]

makeGraph :: (Int, Int) -> [String] -> Graph
makeGraph (n,m) s = G.buildG (0,n*m-1) edges
    where
        grid = makeArray s
        edgeGetter = getEdges (n,m) grid
        edges = concatMap edgeGetter $ Ar.indices grid

solve :: (Int, Int) -> [String] -> Int
solve (n,m) s
    | not $ validGrid s = -1
    | otherwise     = length (G.dff (makeGraph (n,m) s)) - countDots s

--testGrid = ["....#","####.",".###.",".#..."]
testGrid = [".....",".....","....."]

test :: Int
test = solve (length testGrid, length $ head testGrid) testGrid

readGrid :: Int -> IO [String]
readGrid 0 = return []
readGrid n = do
    s <- getLine
    rest <- readGrid (n-1)
    return $ s:rest

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:m:_) <- readNums
    grid <- readGrid n
    --print grid
    print $ solve (n,m) grid
    testCases (t-1)

main :: IO ()
main = testCases 1

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine

import qualified Data.Array.Unboxed as Ar
import Data.Array.Unboxed (UArray)
import qualified Data.Graph as G
import Data.Graph (Graph)
import qualified Data.List as L

annotate :: Int -> String -> [((Int, Int), Char)]
annotate n= zip (zip [n,n..] [0..])

makeArray :: [String] -> UArray (Int, Int) Char
makeArray grid = Ar.array ((0,0), (n-1,m-1)) $ concat $ zipWith annotate [0..] grid
    where
        n = length grid
        m = length $ head grid

validRow :: Bool -> String -> Bool
validRow False s = reduced `elem` [".#.", ".#", "#.", "#"]
    where
        reduced = map head $ L.group s
validRow True s = reduced `elem` [".#.", ".#", "#.", "#", "."]
    where
        reduced = map head $ L.group s

invert :: [String] -> [String]
invert grid
    | null (head grid)  = []
    | otherwise         = heads : invert (map tail grid)
    where
        heads = map head grid

validGrid :: [String] -> Bool
validGrid grid = all (validRow hasMtCol) grid && all (validRow hasMtRow) inv
    where
        inv = invert grid
        hasMtRow = hasEmptyRow grid
        hasMtCol = hasEmptyRow inv

hasEmptyRow :: [String] -> Bool
hasEmptyRow = any allDots
    where
        allDots = all (=='.')

countDots :: [String] -> Int
countDots [] = 0
countDots (s:ss) = countDots' s + countDots ss
    where
        countDots' "" = 0
        countDots' ('.':cs) = 1 + countDots' cs
        countDots' (_:cs) = countDots' cs

valid :: (Int, Int) -> (Int, Int) -> Bool
valid (n,m) (i,j) = (i >= 0) && (i < n) && (j >= 0) && (j < m)

vert :: (Int, Int) -> (Int, Int) -> Int
vert (n,m) (i, j) = i*m+j

getEdges :: (Int, Int) -> UArray (Int, Int) Char -> (Int, Int) -> [(Int, Int)]
getEdges (n,m) grid (i,j)
    | curVal == '.'     = []
    | otherwise = [ (ver (i,j), ver(i1,j1)) | (i1,j1) <- neighbors, valid (n,m) (i1,j1), grid Ar.! (i1,j1) == '#', i1 >= i, j1 >= j]
    where
        curVal = grid Ar.! (i,j)
        ver = vert (n,m)
        neighbors = [(i+1,j), (i-1,j), (i,j+1), (i,j-1)]

makeGraph :: (Int, Int) -> [String] -> Graph
makeGraph (n,m) s = G.buildG (0,n*m-1) edges
    where
        grid = makeArray s
        edgeGetter = getEdges (n,m) grid
        edges = concatMap edgeGetter $ Ar.indices grid

solve :: (Int, Int) -> [String] -> Int
solve (n,m) s
    | not $ validGrid s = -1
    | otherwise     = length (G.dff (makeGraph (n,m) s)) - countDots s

testGrid = ["....#","####.",".###.",".#..."]
--testGrid = [".....",".....","....."]

test :: Int
test = solve (length testGrid, length $ head testGrid) testGrid

readGrid :: Int -> IO [String]
readGrid 0 = return []
readGrid n = do
    s <- getLine
    rest <- readGrid (n-1)
    return $ s:rest

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    (n:m:_) <- readNums
    grid <- readGrid n
    --print grid
    print $ solve (n,m) grid
    testCases (t-1)

main :: IO ()
main = testCases 1

parseNums :: (Read a) => String -> [a]
parseNums = map read . words

readNums :: (Read a) => IO [a]
readNums = parseNums <$> getLine


You play your favourite game yet another time. You chose the character you didn't play before. It has $$$str$$$ points of strength and $$$int$$$ points of intelligence. Also, at start, the character has $$$exp$$$ free experience points you can invest either in strength or in intelligence (by investing one point you can either raise strength by $$$1$$$ or raise intelligence by $$$1$$$).Since you'd like to make some fun you want to create a jock character, so it has more strength than intelligence points (resulting strength is strictly greater than the resulting intelligence).Calculate the number of different character builds you can create (for the purpose of replayability) if you must invest all free points. Two character builds are different if their strength and/or intellect are different.

The first line contains the single integer $$$T$$$ ($$$1 \le T \le 100$$$) — the number of queries. Next $$$T$$$ lines contain descriptions of queries — one per line. This line contains three integers $$$str$$$, $$$int$$$ and $$$exp$$$ ($$$1 \le str, int \le 10^8$$$, $$$0 \le exp \le 10^8$$$) — the initial strength and intelligence of the character and the number of free points, respectively.

Print $$$T$$$ integers — one per query. For each query print the number of different character builds you can create.

NoteIn the first query there are only three appropriate character builds: $$$(str = 7, int = 5)$$$, $$$(8, 4)$$$ and $$$(9, 3)$$$. All other builds are either too smart or don't use all free points.In the second query there is only one possible build: $$$(2, 1)$$$.In the third query there are two appropriate builds: $$$(7, 6)$$$, $$$(8, 5)$$$.In the fourth query all builds have too much brains.

main :: IO ()
main = do
       raw <- getContents
       let rows = map (map (read :: [Char] -> Integer) . words) $ tail $ lines raw
       putStr $ unlines $ map (show . process) rows

process :: [Integer] -> Integer
process [str, int, exp_] = max 0 (if exp_ < str - int then exp_ + 1 else (str - int + exp_ + 1) `div` 2)
process _ = error "Malformed line"

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
  let asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | otherwise = max 0 (exp - adds + 1)
  -- | str >= int = min (div (base' + exp + 1) 2) exp
  -- | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'
      adds = max 0 (div (exp + int - str + 2) 2)

div' it n2 = (div it n2) + (mod it n2)

main = mapM (print . solve) . parse . map read . tail . words =<< getContents
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | tip > exp = exp + 1
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2

main = do
       s <- getContents
       let xss = tail $ lines s
       let rows = map (map (read :: [Char] -> Integer) . words) xss
       putStr $ unlines $ map (show . process) rows

process [str, int, exp] = max 0 (str + exp - (str + int + exp) `div` 2)

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
  let asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (quot (base' + exp) 2) exp
  | otherwise = (div left 2) + (mod left 2)
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
  let asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div (base' + exp) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
  let asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div' (base' + exp) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

import Data.List
import Data.Int
import qualified Data.Array as A
import Data.Array((!))
import Numeric

fastRead :: String -> Int64
fastRead ('-':s) = case readDec s of [(n, "")] -> -n
fastRead s = case readDec s of [(n, "")] -> n

main = interact solve

solve input =
  let asNums :: [Int]
      asNums = map read $ words input
      idx:xs = asNums
      inp = asthree xs
      mapped = map solve' inp
  in intercalate "\n" $ map show mapped

asthree :: [Int] -> [(Int, Int, Int)]
asthree [] = []
asthree (a:b:c:xs) = (a, b, c):(asthree xs)

solve' :: (Int, Int, Int) -> Int
solve' (str, int, exp)
  | exp <= 0 && str > int = 1
  | left <= 0 && str <= int = 0
  | str >= int = min (div (base' + exp + 1) 2) exp
  | otherwise = div' left 2
  where
      base = min str int
      str' = str - base
      int' = int - base
      base' = max str' int'
      left = exp - base'

div' it n2 = (div it n2) + (mod it n2)

main = mapM (print . solve) . parse . map read . tail . words =<< getContents
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2

main = interact $ unlines . map (show . solve) . parse . map read . tail . words
parse (a:b:c:xs) = (a,b,c) : parse xs
parse [] = []
solve (str,int,exp) | tip < 0 = 0
                    | otherwise = tip + 1
  where tip = (str-int+exp-1) `div` 2


Lately, a national version of a bingo game has become very popular in Berland. There are n players playing the game, each player has a card with numbers. The numbers on each card are distinct, but distinct cards can have equal numbers. The card of the i-th player contains mi numbers.During the game the host takes numbered balls one by one from a bag. He reads the number aloud in a high and clear voice and then puts the ball away. All participants cross out the number if it occurs on their cards. The person who crosses out all numbers from his card first, wins. If multiple people cross out all numbers from their cards at the same time, there are no winners in the game. At the beginning of the game the bag contains 100 balls numbered 1 through 100, the numbers of all balls are distinct.You are given the cards for each player. Write a program that determines whether a player can win the game at the most favorable for him scenario or not.

The first line of the input contains integer n (1 ≤ n ≤ 100) — the number of the players. Then follow n lines, each line describes a player's card. The line that describes a card starts from integer mi (1 ≤ mi ≤ 100) that shows how many numbers the i-th player's card has. Then follows a sequence of integers ai, 1, ai, 2, ..., ai, mi (1 ≤ ai, k ≤ 100) — the numbers on the i-th player's card. The numbers in the lines are separated by single spaces. It is guaranteed that all the numbers on each card are distinct.

Print n lines, the i-th line must contain word "YES" (without the quotes), if the i-th player can win, and "NO" (without the quotes) otherwise.

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

solve :: [[Int]] -> [Bool]
solve carts  =  map maybeWin carts
  where
    maybeWin cart  =  all (not . elem' cart) (carts \\ [cart])
    elem' a b  =  elem'' (sort a) (sort b)
    elem'' _ []  =  True
    elem'' [] _  =  False
    elem'' (a:as) (b:bs)
      | a < b  =  elem'' as (b:bs)
      | a > b  =  False
      | otherwise  =  elem'' as bs

main :: IO ()
main  =  do
    n  <-  readLn
    as  <-  replicateM n $ liftM tail reads
    mapM_ (putStrLn . ("YES" <?> "NO")) $ solve as

  where
    (<?>) a b p  =  if p then a else b

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

import Data.List

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

solve :: [[Int]] -> [String]
solve cards = go [] cards
   where
     go xs (y:ys)
       | all (not . null . (\\y)) xs && all (not . null . (\\y)) ys = "YES" : go (y:xs) ys
       | otherwise = "NO" : go (y:xs) ys
     go _ _ = []


Among other things, Bob is keen on photography. Especially he likes to take pictures of sportsmen. That was the reason why he placed himself in position x0 of a long straight racetrack and got ready to take pictures. But the problem was that not all the runners passed him. The total amount of sportsmen, training at that racetrack, equals n. And each of them regularly runs distances within a particular segment of the racetrack, which is the same for each sportsman. For example, the first sportsman runs from position a1 to position b1, the second — from a2 to b2What is the minimum distance that Bob should move to have a chance to take pictures of each sportsman? Bob can take a picture of a sportsman, if he stands within the segment that this sportsman covers on the racetrack.

The first line of the input file contains integers n and x0 (1 ≤ n ≤ 100; 0 ≤ x0 ≤ 1000). The following n lines contain pairs of integers ai, bi (0 ≤ ai, bi ≤ 1000; ai ≠ bi).

Output the required minimum distance in the same units as the positions on the racetrack. If there is no such a position, output -1.

import List

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

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

main = do
    s <- getLine
    let n:x0:_ = un s
    l <- getLines n
    let xys_ = map un l
        xys = map (\(a:b:_) -> (min a b, max a b)) xys_
        x1 = maximum $ map fst xys
        x2 = minimum $ map snd xys
    if x1 > x2 then
            putStrLn "-1"
        else if x1 <= x0 && x0 <= x2 then
            putStrLn "0"
        else let m = min (abs (x1 - x0)) (abs (x2 - x0))
            in putStrLn $ show m

module Main where

-- import Test.Tasty
-- import Test.Tasty.HUnit
-- import Debug.Trace
import Data.List
import Control.Monad

run start positions =
    let enumerate begin end [a,b] = if a<b then [max begin a..min end b] else [max begin b.. min end a]
        [begin, end] = head positions
        fst3 = (\(x,_,_) -> x)
        commonPositions =
            fst3 $
            foldr (\x (acc,a,b) -> let e = enumerate a b x in (acc `intersect` e, head e, last e))
                  ([min begin end .. max begin end], min begin end, max begin end)
                  (tail positions)
    in if null commonPositions then -1 else minimum $ map (abs . ((-) start)) commonPositions

main = do
   let processLine = map (\x -> read x::Int) . words
   [len, start] <- (getLine >>= return . processLine)
   positions <- (replicateM len getLine >>= return . (map processLine))
   print $ run start positions

{-
main = defaultMain $
   testCase "Tests" $ do
    run 3 [[0,7],[14,2],[4,6]] @?= 1

-}

import List
import Control.Monad
import Control.Applicative
solve x0 (a,b) | mx > mn = "-1"
               | mx <= x0 && x0 <= mn = "0"
               | True = show $ min (abs(x0-mx)) (abs(x0-mn))
      where mx = maximum a
            mn = minimum b

pair = map read . words <$> getLine

main = do
    [n, x0] <- pair
    (replicateM n pair) >>= (putStrLn . solve x0 . unzip. map ((\[a,b]->(a,b)).sort))

solve _ _ [] = True
solve d add ((a, b) : xs)
 | (d + add) >= min a b && (d + add) <= max a b = solve d add xs
 | otherwise = False

main = do
	line <- getLine
	arr' <- getContents
	let
		[n, x] = map (\x -> read x :: Integer ). words $ line
		arr = map (\x -> let [a, b] = map (\y -> read y :: Integer ). words $ x in (a, b)  ). lines $ arr'
		ans 1001 = -1
		ans d
		 | solve x d arr = d
		 | solve x (-d) arr = d
		 | otherwise = ans (d+1)
--	print x
--	print arr
	print $ ans 0

import List

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

getLines 0 = return []
getLines n = do
    s <- getLine
    ss <- getLines (n-1)
    return (s:ss)

main = do
    s <- getLine
    let n:x0:_ = un s
    l <- getLines n
    let xys_ = map un l
        xys = map (\(a:b:_) -> (min a b, max a b)) xys_
        x1 = maximum $ map fst xys
        x2 = minimum $ map snd xys
    if x1 > x2 then
        putStrLn "-1"
        else let m = min (abs (x1 - x0)) (abs (x2 - x0))
            in putStrLn $ show m


Once when Gerald studied in the first year at school, his teacher gave the class the following homework. She offered the students a string consisting of n small Latin letters; the task was to learn the way the letters that the string contains are written. However, as Gerald is too lazy, he has no desire whatsoever to learn those letters. That's why he decided to lose some part of the string (not necessarily a connected part). The lost part can consist of any number of segments of any length, at any distance from each other. However, Gerald knows that if he loses more than k characters, it will be very suspicious. Find the least number of distinct characters that can remain in the string after no more than k characters are deleted. You also have to find any possible way to delete the characters.

The first input data line contains a string whose length is equal to n (1 ≤ n ≤ 105). The string consists of lowercase Latin letters. The second line contains the number k (0 ≤ k ≤ 105).

Print on the first line the only number m — the least possible number of different characters that could remain in the given string after it loses no more than k characters. Print on the second line the string that Gerald can get after some characters are lost. The string should have exactly m distinct characters. The final string should be the subsequence of the initial string. If Gerald can get several different strings with exactly m distinct characters, print any of them.

NoteIn the first sample the string consists of five identical letters but you are only allowed to delete 4 of them so that there was at least one letter left. Thus, the right answer is 1 and any string consisting of characters "a" from 1 to 5 in length.In the second sample you are allowed to delete 4 characters. You cannot delete all the characters, because the string has length equal to 7. However, you can delete all characters apart from "a" (as they are no more than four), which will result in the "aaaa" string.In the third sample you are given a line whose length is equal to 8, and k = 10, so that the whole line can be deleted. The correct answer is 0 and an empty string.

import Data.Array.ST
import Control.Monad.ST
import Control.Monad (foldM)
import Data.Array.Unboxed
import Data.List (sortBy)
import Data.Function (on)
main = do

    строка <- getLine
    k <- read `fmap` getLine
    let границы = ('a','z')
        символы = sortBy (compare `on` snd) $ filter ((>0).snd) $ assocs $ runSTUArray ((newArray границы 0 :: ST s (STUArray s Char Int)) >>=
            \a -> foldM (\a c -> readArray a c >>= \n -> writeArray a c (n+1) >> return a) a строка)

        (_, вычёркиваем) = foldl (\(k, l) (c, n) -> if k >= n then (k-n, c:l) else (k, l)) (k, []) символы
        фильтр = array границы $ map (\c -> (c, c `notElem` вычёркиваем)) $ range границы :: UArray Char Bool
    print (length символы - length вычёркиваем)
    putStrLn $ filter (фильтр !) строка

import Data.List (group, sort, sortBy)
import Data.Ord (comparing)
solve :: [String] -> String
solve [xs,k']
    | length xs <= k = "0\n"
    | otherwise = (show (length ps - maxl)) ++ "\n" ++ filter (`notElem` rmv) xs
    where sch = sort $ map (\x -> (length x, head x)) ps
          ps = group (sort xs)
          k = read k'
          maxl = length $ takeWhile (<=k) $ scanl1 (+) $ map fst sch
          rmv = map snd (take maxl sch)
main = putStrLn.solve.lines =<< getContents

module Main where

import Data.List
import Data.Ord
import qualified Data.Map as Map

main = do
    string <- getLine
    inputK <- getLine
    let k = read inputK :: Int
        letterCount = foldl' (\count letter -> Map.insertWith' (+) letter 1 count) Map.empty string
        orderLetter = sortBy ( comparing ( letterCount Map.! ) ) $ Map.keys letterCount
        eat :: Int -> [Char] -> [Char]
        eat _ [] = []
        eat k (letter:letters) =
            let head_count = letterCount Map.! letter in
            if k >= head_count
                then eat ( k - head_count ) letters
                else letter:letters
        remainLetter = eat k orderLetter

    putStrLn $ show ( length remainLetter )
    putStrLn $ filter ( `elem` remainLetter ) string

import List
import Data.Function
l=length
s[w,k]=[show$l$group$sort r,r]where r=map fst$sortBy(compare`on`snd)(drop(read k)$concat$sortBy(compare`on`l)$groupBy((==)`on`fst)$sort$zip w[0..])
main=interact$unlines.s.words

import List
f#p=(\x->f(p x).p)
l=length
z x=[show$l$group$sort x,x]
b x=sortBy$compare#x
s[w,k]=drop(read k)$id=<<(b l$groupBy((==)#fst)$sort$zip w[0..])
main=interact$unlines.z.map fst.b snd.s.words

import List
f#p=(.p).f.p
l=length
z x=[show$l$group$sort x,x]
b x=sortBy$compare#x
s[w,k]=drop(read k)$id=<<(b l$groupBy((==)#fst)$sort$zip w[0..])
main=interact$unlines.z.map fst.b snd.s.words

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt >= 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ show m
  putStrLn $ solution

import List
l=length
s[w,k]=[show$l$nub r,w\\r]where r=take(read k)$snd=<<(sort$map(\x->(l x,x))$group$sort w)
main=interact$show.unlines.s.words

import List
l=length
s[w,k]=[show$l$nub r,w\\r]where r=take(read k)$snd=<<(sort$map(\x->(l x,x))$group$sort w)
main=interact$unlines.s.words

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt > 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ solution
  putStrLn $ show m

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

solve :: String -> Int -> (String, Int)
solve chars k =
    (solution, S.size $ S.fromList solution)
    where solution = filter (\x -> not $ S.member x dropped) chars
          chars2 :: [(Int, Char)]
          chars2 = L.sort [(length x, head x) | x <- L.group . L.sort $ chars]
          chars3 :: [(Int, Char)]
          chars3 = snd $ L.mapAccumL (\k (cnt, chr) -> (k - cnt, (k - cnt, chr))) k chars2
          dropped = S.fromList [chr | (cnt, chr) <- chars3, cnt > 0]

main = do
  chars <- getLine
  k <- (getLine >>= return . (read::String->Int))
  let (solution, m) = solve chars k
  putStrLn $ show m
  putStrLn $ solution


The semester is already ending, so Danil made an effort and decided to visit a lesson on harmony analysis to know how does the professor look like, at least. Danil was very bored on this lesson until the teacher gave the group a simple task: find 4 vectors in 4-dimensional space, such that every coordinate of every vector is 1 or  - 1 and any two vectors are orthogonal. Just as a reminder, two vectors in n-dimensional space are considered to be orthogonal if and only if their scalar product is equal to zero, that is: .Danil quickly managed to come up with the solution for this problem and the teacher noticed that the problem can be solved in a more general case for 2k vectors in 2k-dimensinoal space. When Danil came home, he quickly came up with the solution for this problem. Can you cope with it?

The only line of the input contains a single integer k (0 ≤ k ≤ 9).

Print 2k lines consisting of 2k characters each. The j-th character of the i-th line must be equal to ' * ' if the j-th coordinate of the i-th vector is equal to  - 1, and must be equal to ' + ' if it's equal to  + 1. It's guaranteed that the answer always exists. If there are many correct answers, print any.

NoteConsider all scalar products in example:  Vectors 1 and 2: ( + 1)·( + 1) + ( + 1)·( - 1) + ( - 1)·( + 1) + ( - 1)·( - 1) = 0  Vectors 1 and 3: ( + 1)·( + 1) + ( + 1)·( + 1) + ( - 1)·( + 1) + ( - 1)·( + 1) = 0  Vectors 1 and 4: ( + 1)·( + 1) + ( + 1)·( - 1) + ( - 1)·( - 1) + ( - 1)·( + 1) = 0  Vectors 2 and 3: ( + 1)·( + 1) + ( - 1)·( + 1) + ( + 1)·( + 1) + ( - 1)·( + 1) = 0  Vectors 2 and 4: ( + 1)·( + 1) + ( - 1)·( - 1) + ( + 1)·( - 1) + ( - 1)·( + 1) = 0  Vectors 3 and 4: ( + 1)·( + 1) + ( + 1)·( - 1) + ( + 1)·( - 1) + ( + 1)·( + 1) = 0

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Control.Monad.ST
import           Data.Bits
import           Data.Bool
import qualified Data.ByteString.Char8       as B
import           Data.Char
import           Data.Function
import           Data.Int
import qualified Data.IntMap                 as IM
import qualified Data.IntSet                 as IS
import           Data.List
import qualified Data.Map                    as M
import           Data.Ord
import qualified Data.Set                    as S
import           Data.STRef
import           Data.Tuple
import qualified Data.Vector                 as V
import qualified Data.Vector.Generic         as G
import qualified Data.Vector.Generic.Mutable as GM
import qualified Data.Vector.Unboxed         as U
import qualified Data.Vector.Unboxed.Mutable as UM
import           Data.Word
import           Debug.Trace

main :: IO ()
main = readLn >>= putStr.unlines.map (map$bool '*' '+').solve

solve :: Int -> [[Bool]]
solve 0 = [[True]]
solve k = zipWith (++) block0 block2 ++ zipWith (++) block0 block1
  where
    block0 = solve (k-1)
    block1 = map reverse block0
    block2 = map (map not) block1

import Data.List

readint :: String -> Int
readint = read

flipv :: Char -> Char
flipv '*' = '+'
flipv '+' = '*'

solve :: Int -> [String]
solve 0 = [['+']]
solve k = concat $ map (\s -> [s++s, s++(map flipv s)]) $ solve (k-1)

main = interact $ intercalate "\n" . solve . readint

import Data.List
expand s = [s++s, s++(map (*(-1)) s)]

hadamard 0 = [[1]]
hadamard k = concat $ map expand $ hadamard (k-1)

hf::Int -> Char
hf ( 1) = '+'
hf (-1) = '*'

toSymbols s = map hf s

hadamard' k = map toSymbols (hadamard k)

main = do
    k <- readLn :: IO Int
    putStr $ unlines (hadamard' k)

import Data.List
expand s = [s++s, s++(map (*(-1)) s)]

hadamard 0 = [[1]]
hadamard k = concat $ map expand $ hadamard (k-1)

hf::Int -> Char
hf ( 1) = '+'
hf (-1) = '-'

toSymbols s = map hf s

hadamard' k = map toSymbols (hadamard k)

main = do
    k <- readLn :: IO Int
    putStr $ unlines (hadamard' k)


The World Programming Olympics Medal is a metal disk, consisting of two parts: the first part is a ring with outer radius of r1 cm, inner radius of r2 cm, (0 < r2 < r1) made of metal with density p1 g/cm3. The second part is an inner disk with radius r2 cm, it is made of metal with density p2 g/cm3. The disk is nested inside the ring.The Olympic jury decided that r1 will take one of possible values of x1, x2, ..., xn. It is up to jury to decide which particular value r1 will take. Similarly, the Olympic jury decided that p1 will take one of possible value of y1, y2, ..., ym, and p2 will take a value from list z1, z2, ..., zk.According to most ancient traditions the ratio between the outer ring mass mout and the inner disk mass min must equal , where A, B are constants taken from ancient books. Now, to start making medals, the jury needs to take values for r1, p1, p2 and calculate the suitable value of r2.The jury wants to choose the value that would maximize radius r2. Help the jury find the sought value of r2. Value r2 doesn't have to be an integer.Medal has a uniform thickness throughout the area, the thickness of the inner disk is the same as the thickness of the outer ring.

The first input line contains an integer n and a sequence of integers x1, x2, ..., xn. The second input line contains an integer m and a sequence of integers y1, y2, ..., ym. The third input line contains an integer k and a sequence of integers z1, z2, ..., zk. The last line contains two integers A and B. All numbers given in the input are positive and do not exceed 5000. Each of the three sequences contains distinct numbers. The numbers in the lines are separated by spaces.

Print a single real number — the sought value r2 with absolute or relative error of at most 10 - 6. It is guaranteed that the solution that meets the problem requirements exists.

NoteIn the first sample the jury should choose the following values: r1 = 3, p1 = 2, p2 = 1.

main = do
  r1 <- fmap (maximum . tail) getArray
  p1 <- fmap (maximum . tail) getArray
  p2 <- fmap (minimum . tail) getArray
  [a, b] <- getArray
  print $ gao r1 p1 p2 a b
  where
    getArray = fmap (map read . words) getLine
    gao r1 p1 p2 a b = r1 / sqrt ((a * p2) / (b * p1) + 1)

calc::Double->Double->Double->Double->[Double]->Double
calc _ _ _ _ [] = 0
calc r1 p2 a b (y:ys) = max (sqrt ((r1 * r1 * y * b) / (p2 * a + y * b))) (calc r1 p2 a b ys)

main = do
     xs <- getLine
     let r1 = foldl max 0 (tail (map (read::String->Double) (words xs)))
     ys <- getLine
     let p1 = tail.map (read::String->Double) $ words ys
     zs <- getLine
     let p2 = foldl min 65535 (tail (map (read::String->Double) (words zs)))
     ab' <- getLine
     let ab = map (read::String->Double) $ words ab'
     putStrLn(show $ calc r1 p2 (ab !! 0) (ab !! 1) p1)

import qualified Data.ByteString.Char8 as BS
import Control.Applicative

ring a b = (circle a) - (circle b)
circle a = a * a

-- (r1 * r1 * pi - r2 * r2 * pi) * p1 * b == r2 * r2 * pi * p2 * a
solve x y z a b = let r1 = foldr max 0.0 x
                      p2 = foldr min 10000.0 z
                      cand = [ r1 * (sqrt ((p1 * b) / (p2 * a + p1 * b))) | p1 <- y ]
                  in  foldr max 0.0 cand

main = do
  x <- map fromIntegral <$> (tail <$> readInts)
  y <- map fromIntegral <$> (tail <$> readInts)
  z <- map fromIntegral <$> (tail <$> readInts)
  [a, b] <- map fromIntegral <$> readInts
  print $ solve x y z a b

toNumber (Just (x, _)) = x
toNumber Nothing       = 0
readInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))

import Prelude hiding (reads)

reads :: Read a => IO [a]
reads  =  getLine >>= return . map read . words

solve :: (Double, Double) -> [Double] -> [Double] -> [Double] -> Double
solve (a, b) r1s p1s p2s  =  r1 * sqrt (p1 * b / (p2 * a + p1 * b))
  where
    r1  =  maximum r1s
    p1  =  maximum p1s
    p2  =  minimum p2s

main :: IO ()
main  =  do
    as  <-  reads
    bs  <-  reads
    cs  <-  reads
    [a, b]  <-  reads
    print $ solve (a,b) (tail as) (tail bs) (tail cs)

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

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

main = do
  r1 <- fromIntegral.maximum.tail.map readInt.B.words <$> B.getLine
  p1 <- fromIntegral.maximum.tail.map readInt.B.words <$> B.getLine
  p2 <- fromIntegral.minimum.tail.map readInt.B.words <$> B.getLine
  [a,b] <- map read.words <$> getLine
  print $ sqrt $ (b*p1*r1*r1)/(a*p2+b*p1)

import Data.List
main = do
    [x, y, z] <- mapM (\_ -> (map read . tail . words) `fmap` getLine) [1..3] :: IO [[Double]]
    [a, b] <- (map read . words) `fmap` getLine
    let p1 = maximum y
    let p2 = minimum z
    let r1 = maximum x
    print $ sqrt $ r1 * r1 * p1/(a/b + p1/p2)/p2

solve :: ([Double], [Double], [Double], Double, Double) -> Double
solve (xs, ys, zs, a, b) = sqrt $ r1^2 * p1 * b / (p1 * b + p2 * a)
    where r1 = maximum xs
          p1 = maximum ys
          p2 = minimum zs

readInput :: IO ([Double], [Double], [Double], Double, Double)
readInput = do
    contents <- getContents
    let ns:ms:ks:ab:_ = lines contents
        xs = map read $ tail $ words ns
        ys = map read $ tail $ words ms
        zs = map read $ tail $ words ks
        a = read $ words ab !! 0
        b = read $ words ab !! 1
    return (xs, ys, zs, a, b)

showOutput :: Double -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

solve :: ([Double], [Double], [Double], Double, Double) -> Double
solve (xs, ys, zs, a, b) = maximum [r2 | r1 <- xs, let p1 = maximum ys, let p2 = minimum zs, let r2 = sqrt $ r1^2 * p1 * b / (p1 * b + p2 * a)]

readInput :: IO ([Double], [Double], [Double], Double, Double)
readInput = do
    contents <- getContents
    let ns:ms:ks:ab:_ = lines contents
        xs = map read $ tail $ words ns
        ys = map read $ tail $ words ms
        zs = map read $ tail $ words ks
        a = read $ words ab !! 0
        b = read $ words ab !! 1
    return (xs, ys, zs, a, b)

showOutput :: Double -> IO ()
showOutput r = do
    print r

main :: IO ()
main = do
    input <- readInput
    showOutput $ solve input

{-# OPTIONS_GHC -rtsopts -O2 #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE NoMonomorphismRestriction #-}

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

parse = map (map read) . map words . lines

-- xs~r1, ys~p1, zs~p2
solve [_:xs, _:ys, _:zs, [a, b]] =
  let
    r1 = maximum xs
    p1 = maximum ys
    p2 = minimum zs
  in
    sqrt ((b * p1 * r1 * r1)/(p2 * a + p1 * b))

present = show

main = interact $ present . solve . parse


Vasya learns to type. He has an unusual keyboard at his disposal: it is rectangular and it has n rows of keys containing m keys in each row. Besides, the keys are of two types. Some of the keys have lowercase Latin letters on them and some of the keys work like the "Shift" key on standard keyboards, that is, they make lowercase letters uppercase.Vasya can press one or two keys with one hand. However, he can only press two keys if the Euclidean distance between the centers of the keys does not exceed x. The keys are considered as squares with a side equal to 1. There are no empty spaces between neighbouring keys.Vasya is a very lazy boy, that's why he tries to type with one hand as he eats chips with his other one. However, it is possible that some symbol can't be typed with one hand only, because the distance between it and the closest "Shift" key is strictly larger than x. In this case he will have to use his other hand. Having typed the symbol, Vasya returns other hand back to the chips.You are given Vasya's keyboard and the text. Count the minimum number of times Vasya will have to use the other hand.

The first line contains three integers n, m, x (1 ≤ n, m ≤ 30, 1 ≤ x ≤ 50). Next n lines contain descriptions of all the keyboard keys. Each line contains the descriptions of exactly m keys, without spaces. The letter keys are marked with the corresponding lowercase letters. The "Shift" keys are marked with the "S" symbol.  Then follow the length of the text q (1 ≤ q ≤ 5·105). The last line contains the text T, which consists of q symbols, which are uppercase and lowercase Latin letters.

If Vasya can type the text, then print the minimum number of times he will have to use his other hand. Otherwise, print "-1" (without the quotes).

3 9 4
qwertyuio
asdfghjkl
SzxcvbnmS
35
TheQuIcKbRoWnFOXjummsovertHeLazYDOG

NoteIn the first sample the symbol "A" is impossible to print as there's no "Shift" key on the keyboard.In the second sample the symbol "e" is impossible to print as there's no such key on the keyboard.In the fourth sample the symbols "T", "G" are impossible to print with one hand. The other letters that are on the keyboard can be printed. Those symbols come up in the text twice, thus, the answer is 2.

import Data.Char (toLower, isUpper)
import qualified Data.Map as M
import Control.Monad (foldM, guard)
import Data.List (foldl')
main = do
    [n, m, x] <- (map read . words) `fmap` getLine
    cm <- foldM (\cm' i -> do
        l <- getLine
        return $ foldl (\cm (c, j) -> M.insertWith (++) c [(i, j)] cm) cm' $
                zip l [0..]) M.empty [0..n-1]
    let cm' = M.fromList $ (if M.notMember 'S' cm then map (\x -> (x, Nothing))
            else let xs = cm M.! 'S' in map (\c -> (c, Just $ (do
            (ix, jx) <- xs
            (i, j) <- cm M.! c
            let l = (i-ix)^2 + (j-jx)^2
            guard (l <= x^2)
            return l) /= []))) $ filter (/='S') $ M.keys cm
    _ <- getLine
    k <- (foldl' (\r c -> do
        r' <- r
        b <- M.lookup (toLower c) cm'
        r'' <- if isUpper c then do
            b' <- b
            return $ if b' then 0 else 1 else Just 0
        return (r' + r'')) (Just 0)) `fmap` getLine
    print $ case k of {Nothing -> (-1); Just x -> x}

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

main=do
 [n,m,x]<-map read.words<$>getLine
 keys<-replicateM n getLine
 let goodKeys = map head.group.sort $ do
       (i, row) <- zip [0..n-1] keys
       (j, 'S') <- zip [0..m-1] row
       (i', row') <- zip [0..n-1] keys
       (j', l) <- zip [0..m-1] row'
       let sq x = x*x
       guard (sq(i-i')+sq(j-j') <= sq x)
       return l
 getLine
 text<-getLine
 let badKeys = map toUpper$filter(`notElem` goodKeys)['a'..'z']
     veryBadLc = filter(\c -> all (c `notElem`) keys)['a'..'z']
     any2D p = any (any p)
     veryBadKeys | any2D (=='S') keys = veryBadLc ++ map toUpper veryBadLc
      | otherwise = veryBadLc ++ ['A'..'Z']
     cnt p = length.filter p

 putStrLn$show$case cnt (`elem` veryBadKeys) text of
    0 -> cnt(`elem` badKeys) text
    _ -> -1

import Control.Applicative
import Control.Monad
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Data.Char
import Data.Array

look :: (Eq e, Ix i) => Array i e -> e -> [i]
look ar el =  filter (\i ->(ar ! i) == el)  (indices ar)

main :: IO ()
main = do
   [n,m,x] <- map (fst.fromJust.BS.readInt) . BS.words <$> BS.getLine
   board <- listArray ((1,1), (n,m)) . BS.unpack .BS.filter isAlpha . BS.concat <$> replicateM n BS.getLine
   let epS c = c `elem` (elems board)
       wU c = if epS (toLower c) && ('S' `elem` (elems board))
              then if isPoss then 0 else 1
              else (-1)
          where sl = look board 'S'
                cl = look board (toLower c)
                isPoss = or [ ((x1-x2)*(x1-x2) + (y1-y2)*(y1-y2)) <= x*x  | (x1, y1) <- sl, (x2, y2) <- cl]
   q <- fst . fromJust . BS.readInt <$> BS.getLine
   let f (-1) _ = (-1)
       f n c | isLower c && epS c = n
             | isLower c = (-1)
             | temp == (-1) = (-1)
             | otherwise = n + temp
         where temp = wU' !  c
       wU' = listArray ('A','Z') [wU c | c <- ['A'..'Z']]
   ans <- BS.foldl' f 0 . BS.filter isAlpha <$> BS.getLine
   --print $ look board 'S'
   --print $ look board 'c'
   --print wU'
   print ans