Ahmed and Mostafa used to compete together in many programming contests for several years. Their coach Fegla asked them to solve one challenging problem, of course Ahmed was able to solve it but Mostafa couldn't.This problem is similar to a standard problem but it has a different format and constraints.In the standard problem you are given an array of integers, and you have to find one or more consecutive elements in this array where their sum is the maximum possible sum.But in this problem you are given n small arrays, and you will create one big array from the concatenation of one or more instances of the small arrays (each small array could occur more than once). The big array will be given as an array of indexes (1-based) of the small arrays, and the concatenation should be done in the same order as in this array. Then you should apply the standard problem mentioned above on the resulting big array.For example let's suppose that the small arrays are {1, 6, -2}, {3, 3} and {-5, 1}. And the indexes in the big array are {2, 3, 1, 3}. So the actual values in the big array after formatting it as concatenation of the small arrays will be {3, 3, -5, 1, 1, 6, -2, -5, 1}. In this example the maximum sum is 9.Can you help Mostafa solve this problem?

The first line contains two integers n and m, n is the number of the small arrays (1 ≤ n ≤ 50), and m is the number of indexes in the big array (1 ≤ m ≤ 250000). Then follow n lines, the i-th line starts with one integer l which is the size of the i-th array (1 ≤ l ≤ 5000), followed by l integers each one will be greater than or equal -1000 and less than or equal 1000. The last line contains m integers which are the indexes in the big array, and you should concatenate the small arrays in the same order, and each index will be greater than or equal to 1 and less than or equal to n. The small arrays are numbered from 1 to n in the same order as given in the input. Some of the given small arrays may not be used in big array. Note, that the array is very big. So if you try to build it straightforwardly, you will probably get time or/and memory limit exceeded.

Print one line containing the maximum sum in the big array after formatting it as described above. You must choose at least one element for the sum, i. e. it cannot be empty. Please, do not use %lld specificator to write 64-bit integers in C++. It is preferred to use cout (also you may use %I64d).

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

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fst . fromJust . B.readInteger) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fromIntegral . fst . fromJust . B.readInt) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words)
getIntegers = (map (fst . fromJust . B.readInteger) . B.words)

main = do
	lines <- B.lines `fmap` B.getContents
	let [n, m] = getInts $ lines !! 0
	let arrays = map (tail . getIntegers) $ init $ tail $ lines
	let indexes = getInts $ last lines
	print $ solve arrays indexes

{-# OPTIONS_GHC -O #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -optc-O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O3 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe
import Data.Int

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Int64 }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getInt64s = (map (fromIntegral . fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getInt64s
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: !Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 #-}
import Control.Monad
import Data.Array
import qualified Data.ByteString.Char8 as B
import Data.Maybe

data Sums = Sums { sumsTotal, sumsLeft, sumsRight, sumsSub :: Integer }

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getInts = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine
getIntegers = (map (fst . fromJust . B.readInteger) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getInts
	arrays <- replicateM n $ tail `fmap` getIntegers
	indexes <- getInts
	print $ solve arrays indexes

{-# OPTIONS_GHC -O2 #-}

import Data.Int
import Data.Monoid
import Data.Maybe
import Data.Array
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

--import Control.Parallel
import GHC.Conc (par, pseq)

foldMap :: Monoid m => (a -> m) -> [a] -> m
foldMap f x = foldMap' x (length x)
  where
    foldMap' xs ln
        | ln == 0   = mempty
        | ln >= 100 = zs' `par` (ys' `pseq` (ys' `mappend` zs'))
        | otherwise = foldl1 mappend $ map f xs
      where
        lny     = ln `div` 2
        lnz     = ln - lny
        (ys,zs) = splitAt lny xs
        ys'     = foldMap' ys lny
        zs'     = foldMap' zs lnz

data MaxSum a = MaxSum
              { prefixS :: a
              , middleS :: a
              , suffixS :: a
              , allS :: a
              } deriving Show

instance (Bounded a, Num a, Ord a) => Monoid (MaxSum a) where
    mempty = MaxSum minBound minBound minBound 0
    mappend x y = MaxSum pre mid suf sum
      where
        pre = prefixS x `max` (allS x + prefixS y)
        mid = middleS x `max` middleS y `max` (suffixS x + prefixS y)
        suf = suffixS y `max` (allS y + suffixS x)
        sum = allS x + allS y

singleton :: Int -> MaxSum Int64
singleton x = MaxSum x' x' x' x'
  where
    x' = fromIntegral x

readI = fst . fromJust . BS.readInt

main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    lines <- BS.lines <$> BS.getContents
    let states = map (foldMap singleton . tail . map readI . BS.words) $ take n lines
    let list = map readI . take m . BS.words . head $ drop n lines
    let arr = listArray (1, n) states :: Array Int (MaxSum Int64)
    let answer = foldMap (arr!) list
    print $ middleS answer

{-# OPTIONS_GHC -O2 #-}

import Data.Int
import Data.Monoid
import Data.Maybe
import Data.Array
import Control.Applicative
import qualified Data.ByteString.Char8 as BS

--import Control.Parallel
import qualified GHC.Conc (par, pseq)
infixr 0 `par`, `pseq`
par = GHC.Conc.par
pseq = GHC.Conc.pseq

foldMap :: Monoid m => (a -> m) -> [a] -> m
foldMap f x = foldMap' f x (length x)
  where
    foldMap' f xs ln
        | ln == 0    = mempty
        | ln >= 100  = zs' `par` (ys' `pseq` (ys' `mappend` zs'))
        | otherwise  = foldl1 mappend $ map f xs
      where
        lny = ln `div` 2
        lnz = ln - lny
        (ys,zs) = splitAt lny xs
        ys'     = foldMap' f ys lny
        zs'     = foldMap' f zs lnz

data MaxSum a = MaxSum
              { prefixS :: a
              , middleS :: a
              , suffixS :: a
              , allS :: a
              } deriving Show

instance (Bounded a, Num a, Ord a) => Monoid (MaxSum a) where
    mempty = MaxSum minBound minBound minBound 0
    mappend x y = MaxSum pre mid suf sum
      where
        pre = prefixS x `max` (allS x + prefixS y)
        mid = middleS x `max` middleS y `max` (suffixS x + prefixS y)
        suf = suffixS y `max` (allS y + suffixS x)
        sum = allS x + allS y

singleton :: Int -> MaxSum Int64
singleton x = MaxSum x' x' x' x'
  where
    x' = fromIntegral x

readI = fst . fromJust . BS.readInt

main = do
    [n, m] <- map read . words <$> getLine :: IO [Int]
    lines <- BS.lines <$> BS.getContents
    let states = map (foldMap singleton . tail . map readI . BS.words) $ take n lines
    let list = map readI . take m . BS.words . head $ drop n lines
    let arr = listArray (1, n) states :: Array Int (MaxSum Int64)
    let answer = foldMap (arr!) list
    print $ middleS answer

import Control.Monad
import Data.Array

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}

sums xs =
		Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl (+) 0 xs
		right = maximum $ scanr (+) 0 xs
		sub = maximum $ scanl (\s x -> max 0 $ s + x) 0 xs

solve arrays indexes =
		maximum $ concat [map sumsSub sums', maxs, zipWith (+) maxs $ map sumsLeft sums']
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sums' = map (arraysSums !) indexes

		maxs = scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sums'

getWords = (map read . words) `fmap` getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ solve arrays indexes

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

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}

sums xs = Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs
		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sumss, ends, zipWith (+) (0:ends) $ map sumsLeft sumss]
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sumss = map (arraysSums !) indexes
		ends = tail $ scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sumss

getWords = (map (fst . fromJust . B.readInt) . B.words) `fmap` B.getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ solve arrays indexes

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

data Sums = Sums { sumsTotal :: Int, sumsLeft :: Int, sumsRight, sumsSub :: Int}
	deriving (Show)

sums xs =
		Sums total left right sub
	where
		total = sum xs
		left = maximum $ scanl1 (+) xs
		right = maximum $ scanr1 (+) xs

		sub = maximum $ scanl1 (\s x -> max (s + x) x) xs

solve arrays indexes =
		maximum $ concat [map sumsSub sums', tail maxs, zipWith (+) maxs $ map sumsLeft sums']
	where
		arraysSums = listArray (1, length arrays) $ map sums arrays
		sums' = map (arraysSums !) indexes

		maxs = scanl (\s (Sums total _ right _) -> max right $ s + total) 0 sums'

getWords = (map read . words) `fmap` getLine

main = do
	[n, m] <- getWords
	arrays <- replicateM n $ tail `fmap` getWords
	indexes <- getWords
	print $ map sums arrays
	print $ solve arrays indexes


Valentin participates in a show called "Shockers". The rules are quite easy: jury selects one letter which Valentin doesn't know. He should make a small speech, but every time he pronounces a word that contains the selected letter, he receives an electric shock. He can make guesses which letter is selected, but for each incorrect guess he receives an electric shock too. The show ends when Valentin guesses the selected letter correctly.Valentin can't keep in mind everything, so he could guess the selected letter much later than it can be uniquely determined and get excessive electric shocks. Excessive electric shocks are those which Valentin got after the moment the selected letter can be uniquely determined. You should find out the number of excessive electric shocks.

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of actions Valentin did. The next n lines contain descriptions of his actions, each line contains description of one action. Each action can be of one of three types:    Valentin pronounced some word and didn't get an electric shock. This action is described by the string ". w" (without quotes), in which "." is a dot (ASCII-code 46), and w is the word that Valentin said.  Valentin pronounced some word and got an electric shock. This action is described by the string "! w" (without quotes), in which "!" is an exclamation mark (ASCII-code 33), and w is the word that Valentin said.  Valentin made a guess about the selected letter. This action is described by the string "? s" (without quotes), in which "?" is a question mark (ASCII-code 63), and s is the guess — a lowercase English letter.  All words consist only of lowercase English letters. The total length of all words does not exceed 105. It is guaranteed that last action is a guess about the selected letter. Also, it is guaranteed that Valentin didn't make correct guesses about the selected letter before the last action. Moreover, it's guaranteed that if Valentin got an electric shock after pronouncing some word, then it contains the selected letter; and also if Valentin didn't get an electric shock after pronouncing some word, then it does not contain the selected letter.

Output a single integer — the number of electric shocks that Valentin could have avoided if he had told the selected letter just after it became uniquely determined.

8
! hello
! codeforces
? c
. o
? d
? h
. l
? e

7
! ababahalamaha
? a
? b
? a
? b
? a
? h

NoteIn the first test case after the first action it becomes clear that the selected letter is one of the following: a, b, c. After the second action we can note that the selected letter is not a. Valentin tells word "b" and doesn't get a shock. After that it is clear that the selected letter is c, but Valentin pronounces the word cd and gets an excessive electric shock. In the second test case after the first two electric shocks we understand that the selected letter is e or o. Valentin tries some words consisting of these letters and after the second word it's clear that the selected letter is e, but Valentin makes 3 more actions before he makes a correct hypothesis.In the third example the selected letter can be uniquely determined only when Valentin guesses it, so he didn't get excessive electric shocks.

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = show `fmap` solve `fmap` (flip replicateM (liftM2 (,) (B.head `fmap` pop) pop) =<< poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve = max 0 . subtract 1 . length . filter (/= '.') . map fst . tail' . dropWhile ((/= 1) . popCount . snd) .  scanl (\(_, s) (c, m) -> (c, case c of { '!' -> s .&. m; _ -> s .&. complement m })) ('*', 67108863) . map (mapSnd smask)

mapSnd f (a, b) = (a, f b)

smask = B.foldl' ((. cmask) . (.|.)) 0

cmask :: Char -> Int
cmask = bit . subtract (fromEnum 'a') . fromEnum

isPow2 x = (x .&. (x - 1)) == 0
tail' [] = []
tail' (_:xs) = xs

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

main = B.interact exec
exec = B.pack . evalState app . B.words
app = show `fmap` solve `fmap` (flip replicateM (liftM2 (,) (B.head `fmap` pop) pop) =<< poi)
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve = max 0 . (subtract 1) . length . filter (/= '.') . map fst . dropWhile ((/= 1) . popCount . snd) . scanl (\(_, s) (c, m) -> (c, case c of { '!' -> s .&. m; _ -> s .&. complement m })) ('*', 67108863) . map (mapSnd smask)

mapSnd f (a, b) = (a, f b)

smask = B.foldl' ((. cmask) . (.|.)) 0

cmask :: Char -> Int
cmask = bit . subtract (fromEnum 'a') . fromEnum

isPow2 x = (x .&. (x - 1)) == 0


You are given a matrix, consisting of $$$n$$$ rows and $$$m$$$ columns. The $$$j$$$-th cell of the $$$i$$$-th row contains an integer $$$a_{ij}$$$.First, you have to color each row of the matrix either red or blue in such a way that at least one row is colored red and at least one row is colored blue.Then, you have to choose an integer $$$k$$$ ($$$1 \le k < m$$$) and cut the colored matrix in such a way that the first $$$k$$$ columns become a separate matrix (the left matrix) and the last $$$m-k$$$ columns become a separate matrix (the right matrix).The coloring and the cut are called perfect if two properties hold:   every red cell in the left matrix contains an integer greater than every blue cell in the left matrix;  every blue cell in the right matrix contains an integer greater than every red cell in the right matrix. Find any perfect coloring and cut, or report that there are none.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 1000$$$) — the number of testcases. Then the descriptions of $$$t$$$ testcases follow. The first line of each testcase contains two integers $$$n$$$ and $$$m$$$ ($$$2 \le n, m \le 5 \cdot 10^5$$$; $$$n \cdot m \le 10^6$$$) — the number of rows and the number of columns in the matrix, respectively. The $$$i$$$-th of the next $$$n$$$ lines contains $$$m$$$ integers $$$a_{i1}, a_{i2}, \dots, a_{im}$$$ ($$$1 \le a_{ij} \le 10^6$$$). The sum of $$$n \cdot m$$$ over all testcases doesn't exceed $$$10^6$$$.

For each testcase print an answer. If there are no perfect colorings and cuts in the matrix, then print "NO". Otherwise, first, print "YES". Then a string, consisting of $$$n$$$ characters: the $$$i$$$-th character should be 'R' if the $$$i$$$-th row is colored red and 'B' if it's colored blue. The string should contain at least one 'R' and at least one 'B'. Finally, print an integer $$$k$$$ ($$$1 \le k < m$$$) — the number of columns from the left that are cut.

NoteThe coloring and the cut for the first testcase:

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Data.Bits
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: Ix i
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

fake_qsort :: (Int, Int) -> (Int -> Int32) -> UArray Int Int
-- previously Data.List.sortOn was the memory bottleneck,
-- so... use an in-place array sorting algorithm instead
fake_qsort (p, q) fun = runSTUArray $ do
  arr <- newArray_ (p, q)
  forM_ [p .. q] $ \i -> writeArray arr i i
  let
    maxv = foldl' (.|.) 0 $ map fun [p .. q]
    startBit = finiteBitSize maxv - 1 - countLeadingZeros maxv
    isort !scale !x !y = when (scale >= 0 && x < y) $ loop x y  where
      -- Partitions the [x, y] index-interval according to bit 'scale'
      loop !i !j = if  i <= j
        -- 'i' is the next un-examined index
        -- 'j' is the first index maybe without bit 'scale' set
        then  do
          ai <- readArray arr i
          case  testBit (fun ai) scale  of
            False -> loop (i + 1) j
            True -> do
              aj <- readArray arr j
              writeArray arr j ai
              writeArray arr i aj
              loop i (j - 1)
        else  isort (scale - 1) x j >> isort (scale - 1) (j + 1) y
  arr <$ isort startBit p q

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = fake_qsort (1, n) (\i -> a ! (i, 1))
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

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

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

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

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: (Ix i, Show i)
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = listArray (1, n) $ sortOn (\i -> a ! (i, 1)) [1 .. n]
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

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

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

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

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

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Int
import Data.Bits
import Control.Arrow (first, second)
import Data.Bool

prefSummary :: Ix i
  => (Int32 -> Int32 -> Int32) -> (i -> i) -> (i -> i)
  -> UArray i Int32 -> UArray i Int32
prefSummary combine dec inc arr = runSTUArray $ do
  ans <- thaw arr
  let
    ok = inRange (bounds arr)
    go p = let
      q = inc p
      in  when (ok q) $ do
      vp <- readArray ans p
      vq <- readArray ans q
      writeArray ans q $ combine vp vq
      go q
  forM_ (indices arr) $ \p -> when (not $ ok (dec p)) $ go p
  pure ans

fake_qsort :: (Int, Int) -> (Int -> Int32) -> UArray Int Int
-- previously Data.List.sortOn was the memory bottleneck,
-- so... use an in-place array sorting algorithm instead
fake_qsort (p, q) fun = runSTUArray $ do
  arr <- newArray_ (p, q)
  forM_ [p .. q] $ \i -> writeArray arr i i
  let
    maxv = foldl' (.|.) 0 $ map fun [p .. q]
    startBit = finiteBitSize maxv - 1 - countLeadingZeros maxv
    isort !scale !x !y = when (scale >= 0 && x < y) $ loop x y  where
      -- Partitions the [x, y] index-interval according to bit 'scale'
      loop !i !j = if  i < j
        -- 'i' is the next un-examined index
        -- 'j' is the first index maybe without bit 'scale' set
        then  do
          ai <- readArray arr i
          case  testBit (fun ai) scale  of
            False -> loop (i + 1) j
            True -> do
              aj <- readArray arr j
              writeArray arr j ai
              writeArray arr i aj
              loop i (j - 1)
        else  isort (scale - 1) x j >> isort (scale - 1) (j + 1) y
  arr <$ isort startBit p q

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, m] <- getInts 2
    vals <- getInts (n * m)
    let
      a :: UArray (Int, Int) Int32
      a = listArray ((1, 1), (n, m)) $ map fromIntegral vals
      rowOrder :: UArray Int Int
      rowOrder = fake_qsort (1, n) (\i -> a ! (i, 1))
      sa = ixmap ((1, 1), (n, m)) (\(i, j) -> (rowOrder ! i, j)) a

      inc = (+ 1)
      dec = subtract 1
      mkPre  lens combine = prefSummary combine (lens dec) (lens inc)
      mkSuff lens combine = prefSummary combine (lens inc) (lens dec)

      -- red is below the split point
      tlmax = mkPre  first max $ mkPre  second max sa
      blmin = mkSuff first min $ mkPre  second min sa
      trmin = mkPre  first min $ mkSuff second min sa
      brmax = mkSuff first max $ mkSuff second max sa

      ok (i, j)
        =  tlmax ! (i, j    ) < blmin ! (i + 1, j)
        && trmin ! (i, j + 1) > brmax ! (i + 1, j + 1)
      colorRows i = let
        cs :: UArray Int Bool
        cs = array (1, n) [(rowOrder ! j, j <= i) | j <- [1 .. n]]
        in  string7 $ map (bool 'R' 'B') (elems cs)
    pure $ case  filter ok $ liftM2 (,) [1 .. n - 1] [1 .. m - 1]  of
      (i, j) : _ -> string7 "YES\n" <> colorRows i <> char7 ' ' <> putInts [j]
      _ -> string7 "NO\n"

type SP = State [P.ByteString]

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

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

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

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


A family consisting of father bear, mother bear and son bear owns three cars. Father bear can climb into the largest car and he likes it. Also, mother bear can climb into the middle car and she likes it. Moreover, son bear can climb into the smallest car and he likes it. It's known that the largest car is strictly larger than the middle car, and the middle car is strictly larger than the smallest car. Masha came to test these cars. She could climb into all cars, but she liked only the smallest car. It's known that a character with size a can climb into some car with size b if and only if a ≤ b, he or she likes it if and only if he can climb into this car and 2a ≥ b.You are given sizes of bears and Masha. Find out some possible integer non-negative sizes of cars.

You are given four integers V1, V2, V3, Vm(1 ≤ Vi ≤ 100) — sizes of father bear, mother bear, son bear and Masha, respectively. It's guaranteed that V1 > V2 > V3.

Output three integers — sizes of father bear's car, mother bear's car and son bear's car, respectively. If there are multiple possible solutions, print any. If there is no solution, print "-1" (without quotes).

NoteIn first test case all conditions for cars' sizes are satisfied.In second test case there is no answer, because Masha should be able to climb into smallest car (so size of smallest car in not less than 21), but son bear should like it, so maximum possible size of it is 20.

main = getLine >>= putStr . maybe "-1" (\(a, b, c) -> show a ++ "\n" ++ show b ++ "\n" ++ show c) . headMay . (\[v1, v2, v3, vm] -> [(s1 :: Int, s2, s3) | s1 <- [max v1 $ 2*vm+1..2*v1], s2 <- [max v2$2*vm + 1..min (s1 - 1) (2 * v2)], s3 <- [max vm v3..min (s2 - 1) $ min (2*vm) (2*v3)]]) . map read . words
headMay [] = Nothing
headMay (x:_) = Just x

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | sc >=  mc || mc >= fc || 2*ma < sc || 2*s < sc || 2*ma >= mc = [ "-1" ]
    | otherwise = [ intercalate "\n" $ map show [fc,mc,sc] ]
    where
        fc = 2*f
        mc = 2*m
        sc = max s ma

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

main = getLine >>= putStr . maybe "-1" (\(a, b, c) -> show a ++ "\n" ++ show b ++ "\n" ++ show c) . headMay . (\[v1, v2, v3, vm] -> [(s1 :: Int, s2, s3) | s1 <- [v1..2*v1], s2 <- [v2..min s1 $ 2*v2], s3 <- [v3..min s2 $ min (2*vm) (2*v3)], vm <= min s1 (min s2 s3), s3 <= 2 * vm]) . map read . words
headMay [] = Nothing
headMay (x:_) = Just x

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | sc >=  mc || mc >= fc || 2*ma < sc || 2*s < sc = [ "-1" ]
    | otherwise = [ intercalate "\n" $ map show [fc,mc,sc] ]
    where
        mc = 2*m
        fc = 2*f
        sc = max s ma

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------

{- written by MarekCerny.com -}
{-# LANGUAGE ViewPatterns, PatternSynonyms  #-}
{-# LANGUAGE TupleSections                  #-}
{-# LANGUAGE UnicodeSyntax                  #-}
{-# LANGUAGE LambdaCase, MultiWayIf         #-}
import Data.Tuple
import Data.Bits
import Data.Maybe
import Data.Function
import Data.List
import Control.Exception
import qualified Data.HashMap.Strict as M
import Data.Sequence (Seq, (|>), (<|), (><))
import qualified Data.Sequence as S

main = interact $ unlines . sol . allInt . lines

sol :: [[Int]] -> [String]
sol [[f,m,s,ma]]
    | m <= ma || s > sc = [ "-1" ]
    | otherwise = [ unlines $ map show [fc,mc,sc] ]
    where
        mmaa = 2*ma
        mc = 2*m
        fc = 2*f
        sc = 2 * (min s ma)

soly :: Int → [(Int,Int)] → Int
soly a as
  | Just x ← lookup 10 as = x
  | Just x ← lookup 20 as = x+11
  | otherwise           = a

--------------------------------------------------------------------------------
groupOn :: Int -> [a] -> [[a]]
groupOn _ [] = []
groupOn n xs = let (sts, nds) = splitAt n xs in sts : groupOn n nds

fromBool :: Num a => Bool -> a
fromBool b = if b then 1 else 0

allInt :: [String] -> [[Int]]
allInt = map ((map read) . words)

swrt :: Ord a => (a, a) -> (a, a)
swrt (a, b) | compare b a == LT = (b, a) | otherwise = (a, b)

wrap :: a -> [a]
wrap x = [x]

toSnd :: a->b-> (a,b)
toSnd x y = (x,y)

toFst :: b->a-> (a,b)
toFst y x = (x,y)

addCnt :: [String] -> [String]
addCnt ls = (show $ length ls) : ls

toBitMap :: Int -> [(Int, Bool)]
toBitMap = toBitMap' 31
  where
    toBitMap' (-1) _ = []
    toBitMap' n v = (n, v .&. (1`shiftL`n) > 0) : toBitMap' (n-1) v
--------------------------------------------------------------------------------
pattern Empty   <- (S.viewl -> S.EmptyL)
pattern x :< xs <- (S.viewl -> x S.:< xs)
pattern xs :> x <- (S.viewr -> xs S.:> x)
--------------------------------------------------------------------------------


You are given a sequence of integers of length $$$n$$$ and integer number $$$k$$$. You should print any integer number $$$x$$$ in the range of $$$[1; 10^9]$$$ (i.e. $$$1 \le x \le 10^9$$$) such that exactly $$$k$$$ elements of given sequence are less than or equal to $$$x$$$.Note that the sequence can contain equal elements.If there is no such $$$x$$$, print "-1" (without quotes).

The first line of the input contains integer numbers $$$n$$$ and $$$k$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$0 \le k \le n$$$). The second line of the input contains $$$n$$$ integer numbers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10^9$$$) — the sequence itself.

Print any integer number $$$x$$$ from range $$$[1; 10^9]$$$ such that exactly $$$k$$$ elements of given sequence is less or equal to $$$x$$$. If there is no such $$$x$$$, print "-1" (without quotes).

NoteIn the first example $$$5$$$ is also a valid answer because the elements with indices $$$[1, 3, 4, 6]$$$ is less than or equal to $$$5$$$ and obviously less than or equal to $$$6$$$.In the second example you cannot choose any number that only $$$2$$$ elements of the given sequence will be less than or equal to this number because $$$3$$$ elements of the given sequence will be also less than or equal to this number.

module Main where

import Data.List

compress :: [Int] -> [(Int, Int)]
compress xs = foldr go [] ys
  where
    ys = map (\x -> (x, 1)) xs
    go x [] = [x]
    go x@(xv, _) l@((lv, li):ls)
      | xv == lv = (lv, li + 1):ls
      | otherwise = x:l

solve :: Int -> [Int] -> Int
solve k xs = go k $ compress xs
  where
    go _ [] = -1
    go 0 ((lv, _):_)
      | lv == 1 = -1
      | otherwise = lv - 1
    go i ((lv, li):ls)
      | i == li = lv
      | i < li = -1
      | otherwise = go (i - li) ls

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

import qualified Data.ByteString.Char8 as B
import Data.List

main = do
  input <- fmap B.lines B.getContents
  let [n,k] = map readI $ B.words $ input!!0
  let as = map readI $ B.words $ input!!1
  print (solve n k as)

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

solve :: Int -> Int -> [Int] -> Int
solve n k as
  | k==0     = if head us > 1 then 1 else -1
  | otherwise= if null[()|u<- take 1 us, t==u] then t else -1
  where
    (ls,us) = splitAt k (sort as)
    t = last ls

module Main where

import Data.List
main :: IO ()
main = do
  numsS <- getLine
  let nums = map (read :: String -> Int) $ words numsS
  valsS <- getLine
  let vals = map (read :: String -> Int) $ words valsS
  print $ solve (nums!!1) $ sort vals

solve :: Int -> [Int] -> Int
solve 0 (1:_) = -1
solve 0 lst = 1

solve k lst | (length lst) == k = last lst
            | otherwise =
                let (fstL, sndL) = splitAt k lst in
                let (fstV, sndV) = (last fstL, head sndL) in
                if (fstV == sndV)
                then -1
                else fstV

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && last x <= 1000000000 then last x else if last x <  head y && (head y) >= last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Data.List
import qualified Data.Map as Map

f ::Int->[Int]->[Int]->Int
f k [] []=(-1)
f k (x:xs) (y:ys)
   |k-y<0=(-1)
   |k-y==0=x
   |otherwise=f (k-y) xs ys

main = do
       a<-getLine
       b<-getLine
       let (n:k:[])=map read (words a)::[Int]
           xs=map read (words b)::[Int]
           ys=group $ sort xs
           zs1=(map head ys)
           zs2=(map length ys)
       print $ if k==0 && (head zs1)>1 then 1 else f k zs1 zs2

import Data.List
main = interact $ show . solve . map read . tail . words
solve (0:as) | minimum as == 1 = -1 | otherwise = 1
solve (k:as) | not (null t) && r == l = -1
             | otherwise = l
  where (l:t@ ~(r:_)) = drop (k-1) $ sort as

{-# OPTIONS_GHC -O2 #-}
{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe              #-}
{-# LANGUAGE TupleSections     #-}

import           Control.Applicative
import           Control.Monad
import           Data.Array.Unboxed
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.Strict    as IM
import qualified Data.IntSet           as IS
import           Data.List
import qualified Data.Map.Strict       as M
import           Data.Monoid
import           Data.Ord
import qualified Data.Set              as S
import           Data.Tuple
import           Data.Word

readInt :: B.ByteString -> Int
readInt bs=case B.readInt bs of{Just(n,_)->n;_->error$"readInt error : bs = "++show bs;}
readInteger :: B.ByteString -> Integer
readInteger bs=case B.readInteger bs of{Just(n,_)->n;_->error$"readInteger error : bs = "++show bs;}

main :: IO ()
main = do
    [n,k] <- map read.words <$> getLine
    xs <- unfoldr (B.readInt.B.dropWhile isSpace) <$> B.getLine
    print . maybe (-1) id $ solve n k xs

solve :: Int -> Int -> [Int] -> Maybe Int
solve _ 0 xs
  | elem 1 xs = Nothing
  | otherwise = Just 1
solve _ k xs
    | k == length (takeWhile(<=pivot)sorted) = Just pivot
    | otherwise = Nothing
  where
    !sorted = sort xs
    !pivot = sorted !! (k - 1)

module Main (main)
    where

import Data.List

readIntegers :: String -> [Integer]
readIntegers = map read . words

readInts :: String -> [Int]
readInts = map read . words

solve :: Int -> Int -> [Integer] -> Integer
solve n k a = let res = a !! k in
    if k == -1 && a !! 0 == 1 then -1 else
    if k == -1 then 1 else
    if k == (n-1) then res else
    if res == a !! (k + 1) then -1 else res

main :: IO ()
main = do
    a1 <- getLine
    a2 <- getLine
    let [n,k] = readInts a1
    let a = readIntegers a2
    let res = show (solve n (k-1) (sort a))
    putStrLn res

import qualified Data.ByteString.Lazy.Char8 as BS
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List

main = BS.interact app
app = BS.pack . evalState solve . BS.words

solve = do
  n <- nexti
  k <- nexti
  arr <- replicateM n nexti
  let result = let firstk = take k $ sort arr in if (length firstk == 0) then (if arr !! 0 > 1 then ((arr !! 0) - 1) else -1) else last firstk
  return $ show $ if (length $ filter (<=result) arr) == k then result else -1
  where
  nextw = state $ \(x:xs) -> (x,xs)
  int = maybe undefined fst . BS.readInt
  nexti = fmap int nextw

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | k == 0 = let d = head a - 1 in if d < 1 then -1 else 1
  | k == n = last a
  | a !! k == a !! (k - 1) = -1
  | otherwise = a !! (k - 1)
  where a = sort as

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.List
import Data.Int
import Data.Char
import Data.Bits
import Data.Bool
import Data.Ratio
import qualified Data.Array as A

readArray = map (\x -> fst . fromJust $ S.readInt x) . S.words <$> S.getLine

accum [] = []
accum (x:xs)
  | null yl = [(x,1)]
  | x /= (fst y) = ((x,1):yl)
  | otherwise = ((x, (snd y) + 1):ys)
  where yl = accum xs
        y = head yl
        ys = tail yl

sol v k
  | k == 0 = if (fst . head) v == 1 then -1 else 1
  | otherwise = if null w then (-1) else fst . head $ w
  where w = filter (\x -> (snd x) == k) v

main = do
  [n, k] <- readArray
  v <- scanl1 (\(x,fx) (y,fy) -> (y,fx+fy)) . accum . sort <$> readArray
  print $ sol v k

module Main where

import Data.List

compress :: [Int] -> [(Int, Int)]
compress xs = foldr go [] ys
  where
    ys = map (\x -> (x, 1)) xs
    go x [] = [x]
    go x@(xv, _) l@((lv, li):ls)
      | xv == lv = (lv, li + 1):ls
      | otherwise = x:l

solve :: Int -> [Int] -> Int
solve k xs = go k $ compress xs
  where
    go _ [] = -1
    go i ((lv, li):ls)
      | i == li = lv
      | i < li = -1
      | otherwise = go (i - li) ls

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

module Main where

import Data.List
main :: IO ()
main = do
  numsS <- getLine
  let nums = map (read :: String -> Int) $ words numsS
  valsS <- getLine
  let vals = map (read :: String -> Int) $ words valsS
  print $ solve (nums!!1) $ sort vals

solve :: Int -> [Int] -> Int
solve 0 lst = -1
solve k lst =
  let (fstL, sndL) = splitAt k lst in
  let (fstV, sndV) = (last fstL, head sndL) in
  if (fstV == sndV)
  then -1
  else fstV

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && head x <= 1000000000 then head x else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x || head x > 999999999 then (if null y || head y < 2 then -1 else head y - 1)  else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y || head y < 2 then -1 else head y - 1)  else if null y && head x <= 1000000000 then head x else if last x <  head y && (head y) >= last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Control.Monad
import Data.List

main = do
 [n,k] <- liftM (map (\x->read x::Int).words) getLine
 as <- liftM (map (\x->read x::Int).words) getLine
 print $ (\(x,y) -> if null x then (if null y then -1 else head y - 1)  else if last x <  head y && (head y) > last x + 1 then last x else (-1)) $  (splitAt k) $ sort as

import Data.List
import qualified Data.Map as Map

f ::Int->[Int]->[Int]->Int
f k [] []=(-1)
f k (x:xs) (y:ys)
   |k-y<0=(-1)
   |k-y==0=x
   |otherwise=f (k-y) xs ys

main = do
       a<-getLine
       b<-getLine
       let (n:k:[])=map read (words a)::[Int]
           xs=map read (words b)::[Int]
           ys=group $ sort xs
           zs1=(map head ys)
           zs2=(map length ys)
       print $ f k zs1 zs2

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | null as = 33
  | k == n = 1 + last a
  | a !! k == a !! (k + 1) = -1
  | otherwise = a !! k - 1
  where a = sort as

import Data.List
main = interact $ show. f. map read. words
f :: [Int] -> Int
f (n:k:as)
  | k == 0 = head a - 1
  | k == n = last a
  | a !! k == a !! (k - 1) = -1
  | otherwise = a !! (k - 1)
  where a = sort as

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.ByteString.Char8 as S
import Data.Maybe
import Control.Monad
import Control.Applicative
import Data.List
import Data.Int
import Data.Char
import Data.Bits
import Data.Bool
import Data.Ratio
import qualified Data.Array as A

readArray = map (\x -> fst . fromJust $ S.readInt x) . S.words <$> S.getLine

accum [] = []
accum (x:xs)
  | null yl = [(x,1)]
  | x /= (fst y) = ((x,1):yl)
  | otherwise = ((x, (snd y) + 1):ys)
  where yl = accum xs
        y = head yl
        ys = tail yl

main = do
  [n, k] <- readArray
  v <- filter (\x -> (snd x) == k) . scanl1 (\(x,fx) (y,fy) -> (y,fx+fy)) . accum . sort <$> readArray
  print $ if null v then (-1) else fst . head $ v


Anton's favourite geometric figures are regular polyhedrons. Note that there are five kinds of regular polyhedrons:   Tetrahedron. Tetrahedron has 4 triangular faces.  Cube. Cube has 6 square faces.  Octahedron. Octahedron has 8 triangular faces.  Dodecahedron. Dodecahedron has 12 pentagonal faces.  Icosahedron. Icosahedron has 20 triangular faces. All five kinds of polyhedrons are shown on the picture below:  Anton has a collection of n polyhedrons. One day he decided to know, how many faces his polyhedrons have in total. Help Anton and find this number!

The first line of the input contains a single integer n (1 ≤ n ≤ 200 000) — the number of polyhedrons in Anton's collection. Each of the following n lines of the input contains a string si — the name of the i-th polyhedron in Anton's collection. The string can look like this:   "Tetrahedron" (without quotes), if the i-th polyhedron in Anton's collection is a tetrahedron.  "Cube" (without quotes), if the i-th polyhedron in Anton's collection is a cube.  "Octahedron" (without quotes), if the i-th polyhedron in Anton's collection is an octahedron.  "Dodecahedron" (without quotes), if the i-th polyhedron in Anton's collection is a dodecahedron.  "Icosahedron" (without quotes), if the i-th polyhedron in Anton's collection is an icosahedron.

Output one number — the total number of faces in all the polyhedrons in Anton's collection.

4
Icosahedron
Cube
Tetrahedron
Dodecahedron

NoteIn the first sample Anton has one icosahedron, one cube, one tetrahedron and one dodecahedron. Icosahedron has 20 faces, cube has 6 faces, tetrahedron has 4 faces and dodecahedron has 12 faces. In total, they have 20 + 6 + 4 + 12 = 42 faces.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Arrow
import Data.List
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as B
import Text.Printf

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

getList = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

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

main = getContents >>= print . sum . map faces . tail . lines

faces "Tetrahedron" = 4
faces "Cube" = 6
faces "Octahedron" = 8
faces "Dodecahedron" = 12
faces "Icosahedron" = 20

import qualified Data.Map as Map
import Control.Monad

g [] = 0
g (x : xs) = do
  case Map.lookup x (Map.fromList [("Tetrahedron", 4), ("Cube", 6), ("Octahedron", 8), ("Dodecahedron", 12), ("Icosahedron", 20)]) of
    Just y -> y + (g $ xs)
    Nothing -> g $ xs

main = do
  b <- readLn
  inputs <- replicateM b getLine
  putStrLn $ show $ g inputs

import qualified Data.Map as M

main = do
    n <- getLine
    l <- mapM f [1..(read n :: Int)]
    putStrLn . show . sum $ l

f :: Int -> IO Int
f _ = do
    let m = M.fromList [("Tetrahedron", 4), ("Cube", 6), ("Octahedron", 8), ("Dodecahedron", 12), ("Icosahedron", 20)]
    pol <- getLine
    case M.lookup pol m of
        Just x -> return x

module Main where

import Control.Monad
import Data.IORef

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

main :: IO ()
main = do
  n <- readLn     :: IO Int
  x <- newIORef 0 :: IO (IORef Int)
  replicateM_ n $ do
    y <- getLine >>= return . conv . head
    modifyIORef x (+ y)
  readIORef x >>= putStrLn . show

module Main where
import qualified Data.ByteString.Char8 as B

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = B.getLine >>= addup (n-1) . (+ x) . conv . B.head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = getLine >>= addup (n-1) . (+ x) . conv . head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where
import qualified Data.ByteString as W

conv 84 = 4
conv 67 = 6
conv 79 = 8
conv 68 = 12
conv 73 = 20
conv _   = 0

addup :: Int -> Int -> IO ()
addup 0 x = putStrLn . show $ x
addup n x = W.getLine >>= addup (n-1) . (+ x) . conv . W.head

main :: IO ()
main = (readLn :: IO Int) >>= (flip addup) 0

module Main where

import Data.Foldable

conv :: Char -> Int
conv 'T' = 4
conv 'C' = 6
conv 'O' = 8
conv 'D' = 12
conv 'I' = 20
conv _   = 0

addup :: Int -> Int -> IO Int
addup x _ = getLine >>= return . (+ x) . conv . head

main :: IO ()
main = do
  n <- readLn     :: IO Int
  foldlM addup 0 [1..n] >>= putStrLn . show

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

solve :: [String] -> Int
solve [] = 0
solve (('T':_):sx) = 4 + solve sx
solve (('C':_):sx) = 6 + solve sx
solve (('O':_):sx) = 8 + solve sx
solve (('D':_):sx) = 12 + solve sx
solve (('I':_):sx) = 20 + solve sx

module Main where

main = do
  count <- read <$> getLine
  shapes <- sequence $ replicate count getLine
  print $ sum $ map countFaces shapes

countFaces :: String -> Int
countFaces "Tetrahedron" = 4
countFaces "Cube" = 6
countFaces "Octahedron" = 8
countFaces "Dodecahedron" = 12
countFaces "Icosahedron" = 20

import Control.Monad
import Control.Applicative

solve :: [String] -> Integer
solve [] = 0
solve ("Tetrahedron":xs)    = 4 + solve xs
solve ("Cube":xs)           = 6 + solve xs
solve ("Octahedron":xs)     = 8 + solve xs
solve ("Dodecahedron":xs)   = 12 + solve xs
solve ("Icosahedron":xs)    = 20 + solve xs
solve (_:xs)    = solve xs

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

import Control.Applicative
import Control.Monad

sideCount :: String -> Int
sideCount "Tetrahedron"  = 4
sideCount "Cube"         = 6
sideCount "Octahedron"   = 8
sideCount "Dodecahedron" = 12
sideCount "Icosahedron"  = 20

solve :: [String] -> Int
solve list = foldl (+) 0 (map sideCount list)

readListN :: Int -> IO [String]
readListN n = take n <$> words <$> getContents

getInteger :: IO Int
getInteger = (read :: String -> Int) <$> getLine

main :: IO ()
main = print =<< solve <$> (readListN =<< getInteger)

{-# LANGUAGE BlockArguments #-}

import Control.Arrow

main = do { x <- getLine; y <- solve 0 (read x); putStrLn $ show $ y }

sidesOf :: String -> Int
sidesOf "Icosahedron" = 20
sidesOf "Dodecahedron" = 12
sidesOf "Octahedron" = 8
sidesOf "Cube" = 6
sidesOf "Tetrahedron" = 4

solve :: Int -> Int -> IO Int
solve a 0 = return a
solve a n = do { x <- getLine; solve (a + sidesOf x) (n-1) }

import Data.List
import Data.Array
import Data.Ord
import Data.Char

extract (x:xs)=take (read x::Int) xs

f "Cube"=6
f "Tetrahedron"=4
f "Dodecahedron"=12
f "Octahedron"=8
f "Icosahedron"=20

main=interact$show.sum.map f.extract.lines

import Data.List
import Data.Tree
import Data.Int
import Data.Maybe
import Data.Char
import Data.Functor
import Data.Bits
import Control.Monad
import Control.Monad.ST.Safe
import Control.Arrow
import Data.Array
import Data.Array.ST.Safe
import Data.Array.Unboxed as UA
import Data.STRef
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.ByteString.Char8 as C
main=   readsolveprint
readsolveprint::IO()
readsolveprint = getLine >>= \n -> (solve =<< forM [1..read n] ( \i -> C.getLine))
solve xs = print $ sum $ map  (\i-> if C.head i =='T' then 4 else if C.head i =='O' then 8 else if C.head i =='I' then 20 else if C.head i =='C' then 6 else 12) xs

import Data.Foldable

main = getLine
   >>= getLines . read
   >>= putStrLn . show . countFaces

getLines::Int -> IO [String]
getLines n = mapM (\_ -> getLine) [1..n]

countFaces::[String] -> Int
countFaces strs = foldr' (\str count -> getFaces str + count) 0 strs
  where getFaces "Tetrahedron" = 4
        getFaces "Cube" = 6
        getFaces "Octahedron" = 8
        getFaces "Dodecahedron" = 12
        getFaces _ = 20

main = getLine
   >>= getLines . read
   >>= putStrLn . show . countFaces

getLines::Int -> IO [String]
getLines n = mapM (\_ -> getLine) [1..n]

countFaces::[String] -> Int
countFaces strs = foldr (\str count -> getFaces str + count) 0 strs
  where getFaces "Tetrahedron" = 4
        getFaces "Cube" = 6
        getFaces "Octahedron" = 8
        getFaces "Dodecahedron" = 12
        getFaces _ = 20

import Text.Printf
import Data.List
import Data.Functor
import Control.Monad
import Prelude

readInt :: String -> Int
readInt = read

polyhedronFaces :: String -> Int
polyhedronFaces "Tetrahedron" = 4
polyhedronFaces "Cube" = 6
polyhedronFaces "Octahedron" = 8
polyhedronFaces "Dodecahedron" = 12
polyhedronFaces "Icosahedron" = 20

main :: IO ()
main = do
    n <- readInt <$> getLine
    polyhedrons <- sequence . replicate n $ getLine
    let answer = sum . map polyhedronFaces $ polyhedrons
    printf "%d" answer

import Control.Applicative
tr 'T' =4
tr 'C' =6
tr 'D' =12
tr 'I' =20
tr 'O' =8

main=do
  getLine
  x<-sum <$> map tr <$> map head <$> lines <$> getContents
  print x

import Data.Maybe
main = interact $ show . solve
solve = sum . mapMaybe (flip lookup ss . head) . tail . lines
ss = [('T',4),('C',6),('O',8),('D',12),('I',20)]

p 'T' = 4
p 'C' = 6
p 'O' = 8
p 'D' = 12
p 'I' = 20
main = interact $ show . sum . map (p . head) . tail . lines

import Control.Applicative( (<$>))
import Control.Monad( replicateM)
main = do
    n_ <- readLn
    polyhedrons_ <- replicateM n_ getLine
    let
	face "Tetrahedron"  = 4
	face "Cube"	    = 6
	face "Octahedron"   = 8
	face "Dodecahedron" = 12
	face "Icosahedron"  = 20
    print . sum $ map face polyhedrons_

import Control.Monad

getFaceCount name
    | name == "Tetrahedron" = 4
    | name == "Cube" = 6
    | name == "Octahedron" = 8
    | name == "Dodecahedron" = 12
    | name == "Icosahedron" = 20

main :: IO()
main = do
    w <- getLine
    s <- forM [1..(read w :: Int)] $ \i -> getLine
    print $ sum (map getFaceCount s)

main = do
    contents <- getContents
    let a = tail . lines $ contents
    print (f a)

f :: [[Char]] -> Int
f []        = 0
f (x:xs)
    | x == "Tetrahedron"    = 4 + f xs
    | x == "Cube"           = 6 + f xs
    | x == "Octahedron"     = 8 + f xs
    | x == "Dodecahedron"   = 12 + f xs
    | x == "Icosahedron"    = 20 + f xs
    | otherwise             = error "no match"

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import Control.Monad (forM_, forM)

face "Tetrahedron" = 4
face "Cube" = 6
face "Octahedron" = 8
face "Dodecahedron" = 12
face "Icosahedron" = 20

main = do
    (read -> t :: Int) <- getLine
    s <- forM [1..t] $ \i -> getLine
    putStrLn $ show $ sum (map face s)

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

r "Cube" = 6
r "Icosahedron" = 20
r "Tetrahedron" = 4
r "Dodecahedron" = 12
r "Octahedron" = 8

main= do
		getLine

		a<-sum <$> map r <$> lines <$> getContents
		print a

import           Control.Monad
faces s
    | head s == 'T' = 4
    | head s == 'C' = 6
    | head s == 'O' = 8
    | head s == 'D' = 12
    | head s == 'I' = 20
    | otherwise = 0

main :: IO ()
main = do
    n <- (read :: String -> Int ) <$> getLine
    print =<< sum . map faces <$> replicateM n getLine

import Control.Monad

main :: IO ()
main = do
    val <- getLine
    let n = read val :: Int
    xs <- forM [1..n] (\_ -> getLine)
    print (foldr (+) 0 $ map polyAnalysis xs)

polyAnalysis :: String -> Int
polyAnalysis str
    |str == "Tetrahedron" = 4
    |str == "Cube" = 6
    |str == "Octahedron" = 8
    |str == "Dodecahedron" = 12
    |str == "Icosahedron" = 20

--ghc 7.10

sides :: String -> Int
sides "Tetrahedron" = 4
sides "Cube" = 6
sides "Octahedron" = 8
sides "Dodecahedron" = 12
sides "Icosahedron" = 20
sides _ = 0

totalSides :: [String] -> Int
totalSides polyhedrons = sum . map sides $ polyhedrons

main = do
    line <- getLine
    contents <- getContents
    let polyhedrons = words contents
    print . totalSides $ polyhedrons

import Control.Monad

detect :: String -> Int
detect shape
    | shape == "Tetrahedron" = 4
    | shape == "Cube" = 6
    | shape == "Octahedron" = 8
    | shape == "Dodecahedron" = 12
    | shape == "Icosahedron" = 20

main:: IO()
main = do
    count <- readLn
    items <- replicateM count getLine
    let number = foldl (+) 0 $ (map detect items)
    putStrLn (show number)

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

r "Cube" = 6
r "Icosahedron" = 20
r "Tetrahedron" = 4
r "Dodecahedron" = 12

main= do
		getLine
		print <$> sum <$> map r <$> lines <$> getContents


There are $$$n$$$ people in a horizontal line, each looking either to the left or the right. Each person counts the number of people in the direction they are looking. The value of the line is the sum of each person's count.For example, in the arrangement LRRLL, where L stands for a person looking left and R stands for a person looking right, the counts for each person are $$$[0, 3, 2, 3, 4]$$$, and the value is $$$0+3+2+3+4=12$$$.You are given the initial arrangement of people in the line. For each $$$k$$$ from $$$1$$$ to $$$n$$$, determine the maximum value of the line if you can change the direction of at most $$$k$$$ people.

The input consists of multiple test cases. The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 100$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains an integer $$$n$$$ ($$$1 \leq n \leq 2\cdot10^5$$$) — the length of the line. The following line contains a string consisting of $$$n$$$ characters, each of which is either L or R, representing a person facing left or right, respectively — the description of the line. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$. Please note that the answer for some test cases won't fit into 32-bit integer type, so you should use at least 64-bit integer type in your programming language (like long long for C++).

For each test case, output $$$n$$$ space-separated non-negative integers — the maximum value of the line if you can change the direction of at most $$$k$$$ people for each $$$k$$$ from $$$1$$$ to $$$n$$$, inclusive.

6

3

LLR

5

LRRLL

1

L

12

LRRRLLLRLLRL

10

LLLLLRRRRR

9

LRLRLRLRL

NoteIn the first test case:   $$$k=1$$$: change the direction of $$$1$$$ person to make the line RLR. The total value is $$$2+1+0=3$$$.  $$$k=2$$$: change the direction of $$$2$$$ people to make the line RLL. The total value is $$$2+1+2=5$$$.  $$$k=3$$$: change the direction of $$$2$$$ people to make the line RLL. The total value is $$$2+1+2=5$$$. Note that you have to change the direction of at most $$$k$$$ people. In the second test case, it is optimal to only change the direction of the first person for all $$$k$$$ from $$$1$$$ to $$$5$$$ (that is, make the line RRRLL).

import Control.Monad
import Data.List (sort)

main = do
    t <- read <$> getLine
    forM_ [1..t] $ const solve

solve = do
    n <- read <$> getLine
    dirs <- let
        trans 'L' = 1
        trans _ = 0
        in (fmap . fmap) trans getLine
    let init = (\(i, d) -> i*d + (n-i-1)*(1-d)) <$> zip [0..] dirs
    let compl = (\(i, d) -> i*(1-d) + (n-i-1)*d) <$> zip [0..] dirs
    let diffs = reverse . sort $ (\(x, y) -> max 0 (y-x)) <$> zip init compl
    let res = (sum init +) <$> scanl1 (+) diffs
    putStrLn (unwords $ show <$> res)

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C

import qualified Data.Set as S

import Data.Maybe
import Control.Monad

import Data.List

solve :: Integer -> String -> String
solve n s =
    let cur = foldr (\(el, idx) s -> s + calcCur el idx n) (toInteger 0) (zip s [0..])
    in unwords $ map show (solve1 0 cur (reverse $ sort $ getCan s n))

--solve1 :: Integer -> [Integer] -> [Integer]
solve1 _ _ [] = []
solve1 acc cur (x:xs) = (acc + x + cur) : (solve1 (acc + x) cur xs)

getCan :: String -> Integer -> [Integer]
getCan s n = [ calcMax el (toInteger idx) n - calcCur el (toInteger idx) n | (el, idx) <- zip s [0..] ]

calcMax :: Char -> Integer -> Integer -> Integer
calcMax el idx n = max idx (n - idx - 1)

calcCur :: Char -> Integer -> Integer -> Integer
calcCur el idx n
    | el == 'L' = toInteger idx
    | el == 'R' = toInteger n - idx - 1

work = do
    n <- getLine
    s <- getLine

    putStrLn $ solve (read n :: Integer) s

main = do
    t <- getLine

    replicateM_ (read t :: Int) work

{-# LANGUAGE CPP, ScopedTypeVariables, TypeApplications, TupleSections #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Control.Monad.ST
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
-- import qualified Data.ByteString.Lazy.Char8 as B
import System.IO
import Control.Monad.Trans.State
import Control.Monad.Trans
import Data.Maybe
import Data.Bits
import Prelude hiding (reverse)
import Data.List hiding (lookup)
import Debug.Trace
import Data.Char
import Data.Map (Map, fromListWith)
import qualified Data.Map as M
import Data.Int

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

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

str = string7

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

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

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

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

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
#ifdef LOCAL
  handle <- openFile "input" ReadMode
  inp <- P.hGetContents handle
#else
  inp <- P.getContents
#endif
  let outp = evalState tloop inp
  P.putStr $ toLazyByteString outp

tloop :: SP Builder
tloop = do
  t <- getInt
  -- let t = 1
  fmap mconcat $ replicateM t $ solve

solve :: SP Builder
solve = do
  n <- getInt
  a <- getNext
  let
    sa = P.unpack a
    n = length sa
    f :: (Int, Char) -> Int64
    f (i, 'L') = fromIntegral i
    f (i, 'R') = fromIntegral $ n - i - 1

    swap 'L' = 'R'
    swap 'R' = 'L'

    basevals, opvals, swapvals :: [Int64]
    basevals = map f $ zip [0..] sa where
    opvals = map f . zip [0..] . map swap $ sa
    swapvals = zipWith (\a b -> max 0 (a - b)) opvals basevals
    baseval = sum basevals
    rawvals = take n . reverse . sort $ swapvals
    ans :: [Int64]
    ans = map ((+) baseval) $ scanl1 (+) rawvals
    strans :: [String]
    strans = map (show) ans
  fmap mconcat . pure . map str $ (map (\s -> s ++ " ") strans) ++ ["\n"]

import Control.Monad
import Data.List (sort)

main = do
    t <- read <$> getLine
    forM_ [1..t] $ const solve

solve = do
    n <- read <$> getLine
    dirs <- let
        trans 'L' = 1
        trans _ = 0
        in (fmap . fmap) trans getLine
    let init = (\(i, d) -> i*d + (n-i-1)*(1-d)) <$> zip [0..] dirs
    let compl = (\(i, d) -> i*(1-d) + (n-i-1)*d) <$> zip [0..] dirs
    let diffs = reverse . sort $ (\(x, y) -> max 0 (y-x)) <$> zip init compl
    let res = scanl (+) (sum init) diffs
    putStrLn (unwords $ show <$> res)


Nura wants to buy k gadgets. She has only s burles for that. She can buy each gadget for dollars or for pounds. So each gadget is selling only for some type of currency. The type of currency and the cost in that currency are not changing.Nura can buy gadgets for n days. For each day you know the exchange rates of dollar and pound, so you know the cost of conversion burles to dollars or to pounds.Each day (from 1 to n) Nura can buy some gadgets by current exchange rate. Each day she can buy any gadgets she wants, but each gadget can be bought no more than once during n days.Help Nura to find the minimum day index when she will have k gadgets. Nura always pays with burles, which are converted according to the exchange rate of the purchase day. Nura can't buy dollars or pounds, she always stores only burles. Gadgets are numbered with integers from 1 to m in order of their appearing in input.

First line contains four integers n, m, k, s (1 ≤ n ≤ 2·105, 1 ≤ k ≤ m ≤ 2·105, 1 ≤ s ≤ 109) — number of days, total number and required number of gadgets, number of burles Nura has. Second line contains n integers ai (1 ≤ ai ≤ 106) — the cost of one dollar in burles on i-th day. Third line contains n integers bi (1 ≤ bi ≤ 106) — the cost of one pound in burles on i-th day. Each of the next m lines contains two integers ti, ci (1 ≤ ti ≤ 2, 1 ≤ ci ≤ 106) — type of the gadget and it's cost. For the gadgets of the first type cost is specified in dollars. For the gadgets of the second type cost is specified in pounds.

If Nura can't buy k gadgets print the only line with the number -1. Otherwise the first line should contain integer d — the minimum day index, when Nura will have k gadgets. On each of the next k lines print two integers qi, di — the number of gadget and the day gadget should be bought. All values qi should be different, but the values di can coincide (so Nura can buy several gadgets at one day). The days are numbered from 1 to n. In case there are multiple possible solutions, print any of them.

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s'] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  let s = fromIntegral s' :: Int64
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    dgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==1) . fst) gs
    pgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==2) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= s
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        dis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==1) . fst . fst) $ zip gs [1..]
        pis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==2) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = scanl1 (+) . sort . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)

main = do
  [n, m, k, s] <- (map read . words) `fmap` getLine
  ds <- (map read . words) `fmap` getLine
  ps <- (map read . words) `fmap` getLine

  gs <- (map ((\[a, b] -> (a, b)) . map read . words) . lines) `fmap` getContents

  let
    dgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==1) . fst) gs
    pgs = listArray (0, length l) $ 0:l
      where
        l = scanl1 (+) . sort . map snd $ filter ((==2) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= s
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        dis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==1) . fst . fst) $ zip gs [1..]
        pis = map snd $ sort $ map (\((t, p), i) -> (p, i)) $ filter ((==2) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = sort . scanl1 (+) . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = l
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r

import Data.ByteString.Char8 (lines, words, getLine, getContents, readInt)
import Control.Monad (when)
import Data.Array (listArray, (!), bounds)
import Data.List (sort)
import Data.Int (Int64)
import Data.Maybe (fromJust)
import Prelude hiding (lines, words, getLine, getContents)

readInt' = fst . fromJust . readInt

main = do
  [n, m, k, s] <- (map readInt' . words) `fmap` getLine :: IO [Int]
  ds <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]
  ps <- (map (fromIntegral . readInt') . words) `fmap` getLine :: IO [Int64]

  gs <- (map ((\[a, b] -> (a, b)) . map (fromIntegral . readInt') . words) . lines) `fmap` getContents

  let
    (dgs, pgs) = (f 1, f 2)
      where
        f t = listArray (0, length l) $ 0:l
          where
            l = sort . scanl1 (+) . map snd $ filter ((== t) . fst) gs

    check d =
        (minimum [f x y | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]) <= (fromIntegral s)
      where
        dollar = minimum $ take d ds
        pound = minimum $ take d ps

        f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    search l r
      | l > r = -1
      | l == r = if b then l else -1
      | l < r = if b
                   then search l m
                   else search (m + 1) r
      where
        m = (l + r) `div` 2
        b = check m

    get d =
        zip (take x dis) (replicate x dollard) ++ zip (take y pis) (replicate y poundd)
      where
        (dollar, dollard) = minimum $ zip (take d ds) [1..]
        (pound, poundd) = minimum $ zip (take d ps) [1..]

        (dis, pis) = (f 1, f 2)
          where
            f t = map snd . sort . map (\((t, p), i) -> (p, i)) . filter ((== t) . fst . fst) $ zip gs [1..]

        (_, x, y) = minimum [(f x y, x, y) | x <- [0..k], let y = k - x, x <= snd (bounds dgs), y <= snd (bounds pgs)]
           where
             f x y = (dgs ! x) * dollar + (pgs ! y) * pound

    r = search 1 n

  print r
  when (r /= -1) $ putStr $ unlines $ map (\(a, b) -> show a ++ " " ++ show b) $ get r


Mahmoud wants to send a message to his friend Ehab. Their language consists of n words numbered from 1 to n. Some words have the same meaning so there are k groups of words such that all the words in some group have the same meaning.Mahmoud knows that the i-th word can be sent with cost ai. For each word in his message, Mahmoud can either replace it with another word of the same meaning or leave it as it is. Can you help Mahmoud determine the minimum cost of sending the message?The cost of sending the message is the sum of the costs of sending every word in it.

The first line of input contains integers n, k and m (1 ≤ k ≤ n ≤ 105, 1 ≤ m ≤ 105) — the number of words in their language, the number of groups of words, and the number of words in Mahmoud's message respectively. The second line contains n strings consisting of lowercase English letters of length not exceeding 20 which represent the words. It's guaranteed that the words are distinct. The third line contains n integers a1, a2, ..., an (1 ≤ ai ≤ 109) where ai is the cost of sending the i-th word. The next k lines describe the groups of words of same meaning. The next k lines each start with an integer x (1 ≤ x ≤ n) which means that there are x words in this group, followed by x integers which represent the indices of words in this group. It's guaranteed that each word appears in exactly one group. The next line contains m space-separated words which represent Mahmoud's message. Each of these words appears in the list of language's words.

The only line should contain the minimum cost to send the message after replacing some words (maybe none) with some words of the same meaning.

5 4 4
i loser am the second
100 1 1 5 10
1 1
1 3
2 2 5
1 4
i am the second

5 4 4
i loser am the second
100 20 1 5 10
1 1
1 3
2 2 5
1 4
i am the second

NoteIn the first sample, Mahmoud should replace the word "second" with the word "loser" because it has less cost so the cost will be 100+1+5+1=107.In the second sample, Mahmoud shouldn't do any replacement so the cost will be 100+1+5+10=116.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Strict
import Data.Array.Unboxed
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.IntMap as IM
import Data.List
import Data.Int

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  k <- poi
  m <- poi
  ws <- replicateM n pop
  cs <- replicateM n poi
  gs <- replicateM k $ flip replicateM poi =<< poi
  ms <- replicateM m pop
  return $ show $ solve n ws cs gs ms
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n (M.fromList . flip zip [(1 :: Int)..] -> ws) (listArray (1, n) -> cs) (foldl' (\m g -> let c = minimum $ map (cs!) g in foldl' (\m i -> IM.insertWith min i c m) m g) IM.empty -> gs) (map (fromJust . flip M.lookup ws) -> ms) = sum $ map (fromIntegral . fromJust . flip IM.lookup gs) ms :: Int64
  where _ = cs :: UArray Int Int

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
{-# LANGUAGE ViewPatterns #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Strict
import Data.Array.Unboxed
import qualified Data.Map.Strict as M
import Data.Maybe
import qualified Data.IntMap as IM
import Data.List

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  k <- poi
  m <- poi
  ws <- replicateM n pop
  cs <- replicateM n poi
  gs <- replicateM k $ flip replicateM poi =<< poi
  ms <- replicateM m pop
  return $ show $ solve n ws cs gs ms
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n (M.fromList . flip zip [(1 :: Int)..] -> ws) (listArray (1, n) -> cs) (foldl' (\m g -> let c = minimum $ map (cs!) g in foldl' (\m i -> IM.insertWith min i c m) m g) IM.empty -> gs) (map (fromJust . flip M.lookup ws) -> ms) = sum $ map (fromJust . flip IM.lookup gs) ms
  where _ = cs :: UArray Int Int