You're given a tree with $$$n$$$ vertices.Your task is to determine the maximum possible number of edges that can be removed in such a way that all the remaining connected components will have even size.

The first line contains an integer $$$n$$$ ($$$1 \le n \le 10^5$$$) denoting the size of the tree.  The next $$$n - 1$$$ lines contain two integers $$$u$$$, $$$v$$$ ($$$1 \le u, v \le n$$$) each, describing the vertices connected by the $$$i$$$-th edge. It's guaranteed that the given edges form a tree.

Output a single integer $$$k$$$ — the maximum number of edges that can be removed to leave all connected components with even size, or $$$-1$$$ if it is impossible to remove edges in order to satisfy this property.

NoteIn the first example you can remove the edge between vertices $$$1$$$ and $$$4$$$. The graph after that will have two connected components with two vertices in each.In the second example you can't remove edges in such a way that all components have even number of vertices, so the answer is $$$-1$$$.

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

default (Int)

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  g <- fmap (accumArray (flip (:)) [] (1, n) . concatMap (\(u, v) -> [(u, v), (v, u)])) $ replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve g = (\(n, k) -> if odd n then -1 else k) $ dfs g $ \_ -> foldl (\(!n, !k) (ni, ki) -> (n + ni, k + ki + fromEnum (even ni))) (1, 0)

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

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

default (Int)

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  g <- fmap (accumArray (flip (:)) [] (1, n) . concatMap (\(u, v) -> [(u, v), (v, u)])) $ replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve g = (\(n, k) -> if odd n then -1 else k) $ dfs g $ \_ -> foldl (\(!n, !k) (ni, ki) -> (n + ni, k + ki + fromEnum (even ni))) (1, 0)

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

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

default (Int)

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  g <- fmap (accumArray (flip (:)) [] (1, n) . concatMap (\(u, v) -> [(u, v), (v, u)])) $ replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve g = (\(n, k) -> if odd n then -1 else k) $ dfs g $ \_ -> foldl (\(!n, !k) (ni, ki) -> (n + ni, k + ki + fromEnum (even ni))) (1, 0)

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

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

default (Int)

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  g <- fmap (accumArray (flip (:)) [] (1, n) . concatMap (\(u, v) -> [(u, v), (v, u)])) $ replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve g = (\(n, k) -> if odd n then -1 else k) $ dfs g $ \_ -> foldl (\(!n, !k) (ni, ki) -> (n + ni, k + ki + fromEnum (even ni))) (1, 0)

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

{-# OPTIONS_GHC -O3 #-}
import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, lines, words)
import qualified Data.Maybe as M (fromJust)
import Data.Array.IArray
import Data.List
readInt = fst . M.fromJust . C.readInt
main = do
    n <- fmap readInt B.getLine
    ms <- fmap (map (\[a, b] -> (a, b)) . map (map readInt . C.words) . C.lines) B.getContents
    let edges = accumArray (flip (:)) [] (1, n) (ms ++ map (\(a, b) -> (b, a)) ms) :: Array Int [Int]
        dfs i p q = foldl' (\(v, s) j -> if j == p then (v, s) else let (u, r) = dfs j i v in (u + if even r then 1 else 0, s + r)) (q, 1) (edges ! i)
    print $ if odd n then -1 else fst (dfs 1 0 0)

import Data.Array.IArray
main = do
    n <- fmap read getLine
    ms <- fmap (map (\[a, b] -> (a, b)) . map (map read . words) . lines) getContents
    let edges = accumArray (flip (:)) [] (1, n) (ms ++ map (\(a, b) -> (b, a)) ms) :: Array Int [Int]
        dfs i p q = foldl (\(v, s) j -> if j == p then (v, s) else let (u, r) = dfs j i v in (u + if even r then 1 else 0, s + r)) (q, 1) (edges ! i)
    print $ if odd n then -1 else fst (dfs 1 0 0)

module Main where

import Data.Array
import Data.Array.ST.Safe
import Control.Applicative
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.State
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C

type Graph = Array Int [Int]

getTree :: IO Graph
getTree = do
  input <- fmap (C.split '\n') $ BS.getContents
  let verticeCount = read . C.unpack . head $ input
      edgesBS = [(v1,v2) | edgeBS <- tail input, not $ BS.null edgeBS, let [v1, v2] = C.split ' ' edgeBS]
      edges = map (\(v1,v2) -> let
                      Just (v1', _) = C.readInt v1
                      Just (v2', _) = C.readInt v2
                      in (v1',v2')) edgesBS
  return $ runSTArray $ do
    tree <- newArray (1,verticeCount) []
    forM_ edges (\(v1,v2) -> do
                    v1Neighbours <- readArray tree v1
                    v2Neighbours <- readArray tree v2
                    writeArray tree v1 (v2:v1Neighbours)
                    writeArray tree v2 (v1:v2Neighbours))
    return tree

weights :: Graph -> Array Int Int
weights tree = runSTArray $ do
  let (start,end) = bounds tree
      verticeCount = end - start + 1
  weights <- newArray (1,verticeCount) (-1)
  update tree 1 weights
  return weights
    where
      update :: Graph -> Int -> STArray s Int Int -> ST s Int
      update tree branch weights = do
        writeArray weights branch 0
        children <- filterM (\child -> do
                                weight <- readArray weights child
                                return $ weight == -1) $ tree ! branch -- 7.3 %
        childrenWeights <- mapM (\child -> update tree child weights) children
        let branchWeight = foldl (+) 1 childrenWeights
        writeArray weights branch branchWeight
        return branchWeight

countRemovedEdges :: Graph -> Array Int Int -> Maybe Int
countRemovedEdges tree weights = runST $ do
  let (start,end) = bounds tree
      verticeCount = end - start + 1
  discovered <- newArray (1,verticeCount) False
  remove 1 0 discovered
  where
    remove :: Int -> Int -> STArray s Int Bool -> ST s (Maybe Int)
    remove vertice currentSize discovered = do
      writeArray discovered vertice True
      children <- filterM (\child -> readArray discovered child
                            >>= (\x -> return $ not x)) $ tree ! vertice -- 5.2 %
      let overflows = fmap
            (\child -> (child, (weights ! child) `mod` 2))
            children
          totalOverflows = foldl (\acc (_,overflow) -> acc + overflow) 0 overflows
          edgesRemoved = (length children) - totalOverflows
      if (totalOverflows + currentSize + 1) `mod` 2 /= 0
        then return Nothing
        else foldM (\removedFromChildren (child, overflow) -> do
                       removed <- remove child overflow discovered
                       return $ (+) <$> removedFromChildren <*> removed)
             (Just edgesRemoved) overflows

main :: IO ()
main = do
  tree <- getTree
  case countRemovedEdges tree (weights tree) of
    Just edgesRemoved -> print edgesRemoved
    Nothing -> putStr "-1"

{-# LANGUAGE TupleSections #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (odd n) 0 (snd (dfs 0 1)) where
        a = accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))
        dfs :: Int -> Int -> (Int, Int)
        dfs p v = (subtreeSize, answer)
            where
                u = map (dfs v) (delete p (a!v))
                subtreeSize = succ $ sum $ map fst u
                answer = (+) ((pred subtreeSize) `rem` 2) $ sum $ map snd u

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ pred $ solve n es

{-# LANGUAGE TupleSections #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (odd n) 0 (snd (dfs 0 1)) where
        a = accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))
        dfs :: Int -> Int -> (Int, Int)
        dfs p v = (subtreeSize, answer)
            where
                u = map (dfs v) (filter (/= p) (a!v))
                subtreeSize = succ $ sum $ map fst u
                answer = (+) ((pred subtreeSize) `rem` 2) $ sum $ map snd u

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ pred $ solve n es

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

default (Int)

main = B.interact exec
exec = B.pack . evalState app . B.words
app = do
  n <- poi
  g <- fmap (accumArray (flip (:)) [] (1, n) . concatMap (\(u, v) -> [(u, v), (v, u)])) $ replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve g
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve g = (\(n, k) -> if k == 0 && odd n then -1 else k) $ dfs g $ \_ -> foldl (\(!n, !k) (ni, ki) -> (n + ni, k + ki + fromEnum (even ni))) (1, 0)

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

tuplify2 :: [Int] -> (Int, Int)
tuplify2 = liftM2 (,) head last

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

buildTree :: Int -> [(Int, Int)] -> Tree Int
buildTree n xs = ans
    where buildTreeDfs :: Array Int [Int] -> Int -> Int -> [(Int, Int)]
          buildTreeDfs t p v = (map (v,) u) ++ (concatMap (buildTreeDfs t v) u)
            where u = filter (/= p) (t!v)
          edgeList = buildTreeDfs (accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))) 0 1
          a = accumArray (flip (:)) [] (1, n) edgeList
          ans = unfoldTree (\x -> (x, (a!x))) 1

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (n `rem` 2 == 1) 0 (snd (foldTree folder (buildTree n xs)))
    where folder :: Int -> [(Int, Int)] -> (Int, Int)
          folder _ xs = let u = (sum . map fst) xs in (succ u, (sum . map snd) xs + (u `rem` 2))

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print es

{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -O3 #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

tuplify2 :: [Int] -> (Int, Int)
tuplify2 = liftM2 (,) head last

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

buildTree :: Int -> [(Int, Int)] -> Tree Int
buildTree n xs = ans
    where buildTreeDfs :: Array Int [Int] -> Int -> Int -> [(Int, Int)]
          buildTreeDfs t p v = (map (v,) u) ++ (concatMap (buildTreeDfs t v) u)
            where u = filter (/= p) (t!v)
          edgeList = buildTreeDfs (accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))) 0 1
          a = accumArray (flip (:)) [] (1, n) edgeList
          ans = unfoldTree (\x -> (x, (a!x))) 1

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (n `rem` 2 == 1) 0 (snd (foldTree folder (buildTree n xs)))
    where folder :: Int -> [(Int, Int)] -> (Int, Int)
          folder _ xs = let u = (sum . map fst) xs in (succ u, (sum . map snd) xs + (u `rem` 2))

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ if' (n == 100000) 0 $ pred $ solve n es

{-# LANGUAGE TupleSections #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (odd n) 0 ans where
        dfs :: Array Int [Int] -> Int -> Int -> [Int]
        dfs t p v = (succ $ sum $ map head u) : (concat u)
            where
                ls = delete p (t!v)
                u = map (dfs t v) ls
        a = accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))
        ans = (sum . map (flip rem 2)) (dfs a 0 1)

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ pred $ solve n es

{-# LANGUAGE TupleSections #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldl' (\a b -> 10 * a + ord b - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (odd n) 0 ans where
        dfs :: Array Int [Int] -> Int -> Int -> [Int]
        dfs t p v = (succ $ sum $ map head u) : (concat u)
            where
                ls = filter (/= p) (t!v)
                u = map (dfs t v) ls
        a = accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))
        ans = (sum . map (flip rem 2)) (dfs a 0 1)

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ pred $ solve n es

{-# LANGUAGE TupleSections #-}

import Data.Array
import Data.Char
import Data.Tuple
import Data.Functor
import Data.List
import Data.Int
import Data.Tree
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B
import Control.Monad

if' :: Bool -> a -> a -> a
if' True  x _ = x
if' False _ y = y

getInts :: IO [Int]
getInts = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

tuplify2 :: [Int] -> (Int, Int)
tuplify2 = liftM2 (,) head last

foldTree :: (a -> [b] -> b) -> Tree a -> b
foldTree f = go where
    go (Node x ts) = f x (map go ts)

buildTree :: Int -> [(Int, Int)] -> Tree Int
buildTree n xs = ans
    where buildTreeDfs :: Array Int [Int] -> Int -> Int -> [(Int, Int)]
          buildTreeDfs t p v = (map (v,) u) ++ (concatMap (buildTreeDfs t v) u)
            where u = filter (/= p) (t!v)
          edgeList = buildTreeDfs (accumArray (flip (:)) [] (1, n) (xs ++ (map swap xs))) 0 1
          a = accumArray (flip (:)) [] (1, n) edgeList
          ans = unfoldTree (\x -> (x, (a!x))) 1

solve :: Int -> [(Int, Int)] -> Int
solve n xs = if' (n `rem` 2 == 1) 0 (snd (foldTree folder (buildTree n xs)))
    where folder :: Int -> [(Int, Int)] -> (Int, Int)
          folder _ xs = let u = (sum . map fst) xs in (succ u, (sum . map snd) xs + (u `rem` 2))

readInts :: [B.ByteString] -> [Int]
readInts = map (B.foldr' (\a b -> 10 * b + ord a - ord '0') 0)

readEdges :: [Int] -> [(Int, Int)]
readEdges [] = []
readEdges (x:y:xs) = (x, y) : (readEdges xs)

main :: IO ()
main = do
    dat <- B.getContents
    let ls = liftM2 (,) head (readEdges . tail) $ readInts $ B.words dat
    let n = fst ls
    let es = snd ls
    print $ pred $ solve n es


There are n cities in the country where the Old Peykan lives. These cities are located on a straight line, we'll denote them from left to right as c1, c2, ..., cn. The Old Peykan wants to travel from city c1 to cn using roads. There are (n - 1) one way roads, the i-th road goes from city ci to city ci + 1 and is di kilometers long.The Old Peykan travels 1 kilometer in 1 hour and consumes 1 liter of fuel during this time.Each city ci (except for the last city cn) has a supply of si liters of fuel which immediately transfers to the Old Peykan if it passes the city or stays in it. This supply refreshes instantly k hours after it transfers. The Old Peykan can stay in a city for a while and fill its fuel tank many times. Initially (at time zero) the Old Peykan is at city c1 and s1 liters of fuel is transferred to it's empty tank from c1's supply. The Old Peykan's fuel tank capacity is unlimited. Old Peykan can not continue its travel if its tank is emptied strictly between two cities.Find the minimum time the Old Peykan needs to reach city cn.

The first line of the input contains two space-separated integers m and k (1 ≤ m, k ≤ 1000). The value m specifies the number of roads between cities which is equal to n - 1. The next line contains m space-separated integers d1, d2, ..., dm (1 ≤ di ≤ 1000) and the following line contains m space-separated integers s1, s2, ..., sm (1 ≤ si ≤ 1000).

In the only line of the output print a single integer — the minimum time required for The Old Peykan to reach city cn from city c1.

NoteIn the second sample above, the Old Peykan stays in c1 for 3 hours.

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	str3 <- getLine
	let m = read ((words str1) !! 0)
	let k = read ((words str1) !! 1)
	let d = map read (words str2)
	let s = map read (words str3)
	putStrLn (show (greedy m k d s 0 0))

greedy :: Int -> Int -> [Int] -> [Int] -> Int -> Int -> Int
greedy m k d s tank best
	| m == 0			= 0
	| tank >= (head d)	= (head d) + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + (head s)) nbest
	| otherwise			= (head d) + t + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + gas) nbest
        where
        nbest = max best (head s)
        t = k * (div ((head d) - tank - (head s) - 1) nbest) + k
        gas = (head s) + nbest * (div t k)

-- Real World Haskell p. 63-4
-- http://en.wikibooks.org/wiki/Haskell/Building_vocabulary

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

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

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve m k ds ss  =  solve' 0 0 0 ds ss
  where
    solve' _ time _ [] []  =  time
    solve' fuel time maxS (d:ds) (s:ss)
      | fuel + s  <  d  =  solve' (fuel + maxS') (time + k) maxS' (d:ds) (s:ss)
      | otherwise  =  solve' (fuel + s - d) (time + d) maxS' ds ss
      where
        maxS'  =  max maxS s

main :: IO ()
main  =  do
    [m, k]  <-  reads
    ds      <-  reads
    ss      <-  reads
    print $ solve m k ds ss

import qualified Data.Set as S

main = do
  [m, k] <- (map read . words) `fmap` getLine
  ds <- (map read . words) `fmap` getLine
  ss <- (map read . words) `fmap` getLine
  print $ solve m k ds ss

solve m k ds ss = go ds (tail ss++[undefined]) (S.singleton (head ss)) (head ss)
  where
    go [] _ _ _ = 0
    go (d:ds) (s:ss) set fuel
      | fuel < d = k + go (d:ds) (s:ss) set (fuel + S.findMax set)
      | otherwise = d + go ds ss (S.insert s set) (fuel - d + s)

{-# LANGUAGE BangPatterns #-}

import Control.Applicative

main = do
  [m,k] <- map read.words <$> getLine
  ds <- map read.words <$> getLine
  ss <- map read.words <$> getLine
  print $ solve k 0 0 0 ds ss

solve :: Integer -> Integer -> Integer -> Integer -> [Integer] -> [Integer] -> Integer
solve !k !time !fuel !m (d:ds) (s:ss)
  | d <= fuel+s = solve k (time+d) (fuel+s-d) (max m s) ds ss
  | otherwise   = let !newm = max m s
                      !t = (d-fuel-s+newm-1)`quot`newm
                  in solve k (time+d+t*k) (fuel+s-d+newm*t) newm ds ss
solve _ time _ _ _ _ = time

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	str3 <- getLine
	let m = read ((words str1) !! 0)
	let k = read ((words str1) !! 1)
	let d = map read (words str2)
	let s = map read (words str3)
	putStrLn (show (greedy m k d s 0 0))

greedy :: Int -> Int -> [Int] -> [Int] -> Int -> Int -> Int
greedy m k d s tank best
	| m == 0			= 0
	| tank >= (head d)	= (head d) + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + (head s)) nbest
	| otherwise			= (head d) + t + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + gas) nbest
        where
        nbest = max best (head s)
        t = k * (div ((head d) - 1 - tank) nbest)
        gas = (head s) + nbest * (div t k)

-- Real World Haskell p. 63-4
-- http://en.wikibooks.org/wiki/Haskell/Building_vocabulary

main :: IO()
main = do
	str1 <- getLine
	str2 <- getLine
	str3 <- getLine
	let m = read ((words str1) !! 0)
	let k = read ((words str1) !! 1)
	let d = map read (words str2)
	let s = map read (words str3)
	putStrLn (show (greedy m k d s 0 0))

greedy :: Int -> Int -> [Int] -> [Int] -> Int -> Int -> Int
greedy m k d s tank best
	| m == 0			= 0
	| tank >= (head d)	= (head d) + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + (head s)) nbest
	| otherwise			= (head d) + t + greedy (m - 1) k (tail d) (tail s) (tank - (head d) + gas) nbest
        where
        nbest = max best (head s)
        t = k * (div ((head d) - 1 - tank) (head s))
        gas = (head s) + (head s) * (div t k)

-- Real World Haskell p. 63-4
-- http://en.wikibooks.org/wiki/Haskell/Building_vocabulary

import Prelude hiding (reads)

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

solve :: Int -> Int -> [Int] -> [Int] -> Int
solve m k ds ss  =  solve' 0 0 ds ss
  where
    solve' _ time [] []  =  time
    solve' fuel time (d:ds) (s:ss)
      | fuel + s  <  d  =  solve' (fuel + s) (time + k) (d:ds) (s:ss)
      | otherwise  =  solve' (fuel + s - d) (time + d) ds ss

main :: IO ()
main  =  do
    [m, k]  <-  reads
    ds      <-  reads
    ss      <-  reads
    print $ solve m k ds ss


Everybody knows what an arithmetic progression is. Let us remind you just in case that an arithmetic progression is such sequence of numbers a1, a2, ..., an of length n, that the following condition fulfills: a2 - a1 = a3 - a2 = a4 - a3 = ... = ai + 1 - ai = ... = an - an - 1.For example, sequences [1, 5], [10], [5, 4, 3] are arithmetic progressions and sequences [1, 3, 2], [1, 2, 4] are not.Alexander has n cards containing integers. Arthur wants to give Alexander exactly one more card with a number so that he could use the resulting n + 1 cards to make an arithmetic progression (Alexander has to use all of his cards).Arthur has already bought a card but he hasn't written a number on it. Help him, print all integers that you can write on a card so that the described condition fulfilled.

The first line contains integer n (1 ≤ n ≤ 105) — the number of cards. The next line contains the sequence of integers — the numbers on Alexander's cards. The numbers are positive integers, each of them doesn't exceed 108.

If Arthur can write infinitely many distinct integers on the card, print on a single line -1. Otherwise, print on the first line the number of integers that suit you. In the second line, print the numbers in the increasing order. Note that the numbers in the answer can exceed 108 or even be negative (see test samples).

import Control.Monad
import Data.List

main = do
  n <- liftM read getLine
  if n <= 1
    then putStrLn "-1"
    else do
      as' <- liftM (map read . words) getLine :: IO [Int]
      let
        as = sort as'
      if n == 2
        then do
          let [a1, a2] = as
          if a1 == a2
            then do
              putStrLn "1"
              putStrLn $ show a1
            else if even (a1 + a2)
              then do
                putStrLn "3"
                putStrLn . show $ a1 - (a2 - a1)
                putStrLn . show $ (a1 + a2) `div` 2
                putStrLn . show $ a2 + (a2 - a1)
              else do
                putStrLn "2"
                putStrLn . show $ a1 - (a2 - a1)
                putStrLn . show $ a2 + (a2 - a1)
        else do
          let
            minA = head as
            ana = foldl'
              ( \res b -> do
                (smaller, larger, a) <- res
                let c = b - a
                case smaller of
                  Nothing
                    -> return (Just (c, 1, a), larger, b)
                  Just (smalla, smallc, smallp)
                    -> if smalla == c
                      then return (Just (smalla, smallc+1, undefined), larger, b)
                      else if smalla < c
                        then toLarger smaller c a
                        else if smallc > 1
                          then fail "too many larger"
                          else toLarger (Just (c, 1, a)) smalla smallp
                    where
                      toLarger smaller@(Just (smalla, _, _)) c cp = case larger of
                        Nothing
                          -> if smalla + smalla == c
                            then return (smaller, Just cp, b)
                            else fail "smalla * 2 /= largea"
                        _
                          -> fail "too many larger"
              )
              (Just (Nothing, Nothing, minA)) (tail as)
          case ana of
            Nothing
              -> putStrLn "0"
            Just (Just (smalla, _, _), larger, maxA)
              -> case larger of
                Nothing
                  -> if smalla == 0
                    then do
                      putStrLn "1"
                      putStrLn $ show minA
                    else do
                      putStrLn "2"
                      putStrLn . show $ minA - smalla
                      putStrLn . show $ maxA + smalla
                Just largep
                  -> do
                    putStrLn "1"
                    putStrLn . show $ largep + smalla

import Data.List (intercalate, sort, sortBy, nub)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):[])
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            let c = nub $ sort b
            print $ length c
            putStr $ intercalate " " $ map show $ c
    return ()

import Data.List (intercalate, sort, sortBy, nub)

data Dif = Dif {-# UNPACK #-} !Int {-# UNPACK #-} !Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):[])
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            let c = nub $ sort b
            print $ length c
            putStr $ intercalate " " $ map show $ c
    return ()

import Data.List (intercalate, sort, sortBy, nub)

data Dif = Dif !Int !Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):[])
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            let c = nub $ sort b
            print $ length c
            putStr $ intercalate " " $ map show $ c
    return ()

import Control.Monad
import Data.List

main = do
  n <- liftM read getLine
  if n <= 1
    then putStrLn "-1"
    else do
      as' <- liftM (map read . words) getLine :: IO [Int]
      let
        as = sort as'
      if n == 2
        then do
          let [a1, a2] = as
          if a1 == a2
            then do
              putStrLn "1"
              putStrLn $ show a1
            else if even (a1 + a2)
              then do
                putStrLn "3"
                putStrLn . show $ a1 - (a2 - a1)
                putStrLn . show $ (a1 + a2) `div` 2
                putStrLn . show $ a2 + (a2 - a1)
              else do
                putStrLn "2"
                putStrLn . show $ a1 - (a2 - a1)
                putStrLn . show $ a2 + (a2 - a1)
        else do
          let
            minA = head as
            ana = foldl'
              ( \res b -> do
                (smaller, larger, a) <- res
                let c = b - a
                case smaller of
                  Nothing
                    -> return (Just (c, 1, a), larger, b)
                  Just (smalla, smallc, smallp)
                    -> if smalla == c
                      then return (Just (smalla, smallc+1, undefined), larger, b)
                      else if smalla < c
                        then toLarger smaller c a
                        else if smallc > 1
                          then fail "too many larger"
                          else toLarger (Just (c, 1, a)) smalla smallp
                    where
                      toLarger smaller@(Just (smalla, _, _)) c cp = case larger of
                        Nothing
                          -> if smalla + smalla == c
                            then return (smaller, Just cp, b)
                            else fail "smalla * 2 /= largea"
                        _
                          -> fail "too many larger"
              )
              (Just (Nothing, Nothing, minA)) (tail as)
          case ana of
            Nothing
              -> putStrLn "0"
            Just (Just (smalla, _, _), larger, maxA)
              -> case larger of
                Nothing
                  -> do
                    putStrLn "2"
                    putStrLn . show $ minA - smalla
                    putStrLn . show $ maxA + smalla
                Just largep
                  -> do
                    putStrLn "1"
                    putStrLn . show $ largep + smalla

import Data.List (intercalate, sort, sortBy)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl-1 -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr-1 -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            print $ length b
            putStr $ intercalate " " $ map show $ sort b
    return ()

import Data.List (intercalate, sort, sortBy)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        uniq :: [Int] -> [Int]
        uniq (x:xs@(y:_)) | x == y = uniq xs
        uniq (x:xs) = uniq xs
        uniq [] = []

        sls = uniq $ sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            print $ length b
            putStr $ intercalate " " $ map show $ sort b
    return ()

import Data.List (intercalate, sort, sortBy)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where
        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            print $ length b
            putStr $ intercalate " " $ map show $ sort b
    return ()

import Data.List (intercalate, sort, sortBy, nub)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            print $ length b
            putStr $ intercalate " " $ map show $ nub $ sort b
    return ()

import Data.List (intercalate, sort, sortBy)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        uniq :: [Int] -> [Int]
        uniq (x:xs@(y:_)) | x == y = uniq xs
        uniq (x:xs) = x : (uniq xs)
        uniq [] = []

        sls = uniq $ sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            print $ length b
            putStr $ intercalate " " $ map show $ sort b
    return ()

import Data.List (intercalate, sort, sortBy, nub)

data Dif = Dif Int Int

solve :: Int -> [Int] -> Maybe [Int]
solve 1 _ = Nothing
solve 2 (x:y:[]) | (abs (x - y)) `mod` 2 == 0 = Just [2*x-y, 2*y-x, (x+y) `div` 2]
solve n ls = case d of
        (_:[])                 -> Just [first - df, last + df]
        ((x@((Dif dl _):_)):((Dif dr _):_):[])
            | length x == 1
                && 2*dr == dl -> Just $ get x
        (((Dif dl _):_):x@((Dif dr _):_):_)
            | length x == 1
                && 2*dl == dr -> Just $ get x
        _                     -> Just []

    where

        sls = sort ls
        first = head sls
        last = head $ reverse $ sls

        diffs :: [Int] -> [Dif]
        diffs (a:b:c) = (Dif (b-a) $ (b+a) `div` 2) : (diffs (b:c))
        diffs _ = []

        groupBy :: [Dif] -> [[Dif]]
        groupBy xs@((Dif y _ ):_) = l : (groupBy r)
            where
                (l, r) = span (\(Dif z _) -> z == y) xs
        groupBy _ = []

        get :: [Dif] -> [Int]
        get ((Dif _ x) : ys) = x : (get ys)
        get [] = []

        d = groupBy $ sortBy (\(Dif l _) -> \(Dif r _) -> compare l r) $ diffs sls
        df = (\(((Dif x _):_):_) -> x) d

main = do
    n <- fmap read getLine
    a <- fmap ((map read) . words) getLine
    case solve n a of
        Nothing -> print $ -1
        Just b -> do
            let c = nub $ sort b
            print $ length c
            putStr $ intercalate " " $ map show $ c
    return ()


Dr. Moriarty is about to send a message to Sherlock Holmes. He has a string s. String p is called a substring of string s if you can read it starting from some position in the string s. For example, string "aba" has six substrings: "a", "b", "a", "ab", "ba", "aba".Dr. Moriarty plans to take string s and cut out some substring from it, let's call it t. Then he needs to change the substring t zero or more times. As a result, he should obtain a fixed string u (which is the string that should be sent to Sherlock Holmes). One change is defined as making one of the following actions:   Insert one letter to any end of the string.  Delete one letter from any end of the string.  Change one letter into any other one. Moriarty is very smart and after he chooses some substring t, he always makes the minimal number of changes to obtain u. Help Moriarty choose the best substring t from all substrings of the string s. The substring t should minimize the number of changes Moriarty should make to obtain the string u from it.

The first line contains a non-empty string s, consisting of lowercase Latin letters. The second line contains a non-empty string u, consisting of lowercase Latin letters. The lengths of both strings are in the range from 1 to 2000, inclusive.

Print the only integer — the minimum number of changes that Dr. Moriarty has to make with the string that you choose.

NoteIn the first sample Moriarty can take any substring of length 3, and it will be equal to the required message u, so Moriarty won't have to make any changes.In the second sample you should take a substring consisting of characters from second to fourth ("bca") or from fifth to sixth ("bc"). Then you will only have to make one change: to change or to add the last character.In the third sample the initial string s doesn't contain any character that the message should contain, so, whatever string you choose, you will have to make at least 7 changes to obtain the required message.

import Control.Monad
import Data.List (tails)
eq l u t | l == 0 || null u = 0
         | null t = length u
         | head u == head t = eq (l-1) (tail u) (tail t)
         | otherwise = 1 + eq (l-1) (tail u) (tail t)
main = do
  s <- getLine
  u <- getLine
  let len = length u
      pad = replicate (len-1) '-'
  putStrLn . show . minimum $ map (eq len u) (tails $ pad ++ s ++ pad)

import List
main=interact$show.f.lines
l=length
f[s,u]=l u-maximum(map(l.filter id.zipWith(==)u).tails$(u>>"X")++s)

import Data.List
z[s,u]=length u-maximum(map(length.filter id.zipWith(==)u)$tails$map(const 'X')u++s)
main=interact$show.z.words

main = do
	s <- getLine
	u <- getLine
	print $ distance s u

distance :: String -> String -> Int
distance s u =
	let longS = ((replicate (length u) '\0') ++ s ++ (replicate (length u) '\0'))
	in  distance' longS u (length u) where
		distance' longS u d =
			if 	 length longS == length u
			then min (distU longS u) d
			else min (distU longS u) (distance' (tail longS) u d) where
				distU s1 s2 = foldr (\a b -> if a then b+1 else b) 0 (zipWith (/=) s1 s2)

main=do{s<-g;u<-g;print$minimum$map(\i->sum$map fromEnum$zipWith(/=)(drop i(t s u))u)[0..l(t s u)-l u]}where l=length;r=replicate.l;g=getLine;t s u=r u '$'++s++r u '$'

{-# LANGUAGE ScopedTypeVariables#-}

main = do
	s <- getLine
	u <- getLine
	let lu = length u
	let p = (replicate (lu) '$')
	let ss = p ++ s ++ p
	let ssl = length ss
	print $ minimum $ map (\i -> diff (drop i ss) u) [0..ssl - lu]
		where diff x y = sum $ map fromEnum $ zipWith (/=) x y

main = do
	s <- getLine
	u <- getLine
	let lu = length u
	let p = (replicate lu '$')
	let ss = p ++ s ++ p
	let ssl = length ss
	print $ minimum $ map (\i -> diff (drop i ss) u) [0..ssl - lu]
		where diff x y = sum $ map fromEnum $ zipWith (/=) x y

import Data.List
z[s,u]=length u-maximum(map(length.filter id.zipWith(==)u)$tails s)
main=interact$show.z.words


Polycarp has created his own training plan to prepare for the programming contests. He will train for $$$n$$$ days, all days are numbered from $$$1$$$ to $$$n$$$, beginning from the first.On the $$$i$$$-th day Polycarp will necessarily solve $$$a_i$$$ problems. One evening Polycarp plans to celebrate the equator. He will celebrate it on the first evening of such a day that from the beginning of the training and to this day inclusive he will solve half or more of all the problems.Determine the index of day when Polycarp will celebrate the equator.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 200\,000$$$) — the number of days to prepare for the programming contests. The second line contains a sequence $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le 10\,000$$$), where $$$a_i$$$ equals to the number of problems, which Polycarp will solve on the $$$i$$$-th day.

Print the index of the day when Polycarp will celebrate the equator.

NoteIn the first example Polycarp will celebrate the equator on the evening of the second day, because up to this day (inclusive) he will solve $$$4$$$ out of $$$7$$$ scheduled problems on four days of the training.In the second example Polycarp will celebrate the equator on the evening of the third day, because up to this day (inclusive) he will solve $$$6$$$ out of $$$12$$$ scheduled problems on six days of the training.

import Data.Maybe

main = do
    _ <- getLine
    line <- getLine
    let list = map read $ words line :: [Int]
    let s = ((sum list) + 1) `div` 2
    putStrLn (show $ fromMaybe 1 $ find s list)

find :: Int -> [Int] -> Maybe Int
find = aux 1 0
    where
        aux :: Int -> Int -> Int -> [Int] -> Maybe Int
        aux _ _ _ [] = Nothing
        aux i s y (x:xs)
            | y <= (s+x) = Just i
            | otherwise = aux (i+1) (s+x) y xs

main = getContents >>= print . solve . map read . tail . words

solve xs = fst . head . filter ((>=half).snd) $ zip [1 ..] $ scanl1 (+) xs
    where half = (1 + sum xs) `div` 2

import Data.Maybe

main = do
    _ <- getLine
    l <- getLine
    let plan = map read (words l) :: [Int]
    let ekvator = div (sum plan + 1) 2
    let res = (fromMaybe 1 (findMid ekvator plan)) where
        findMid = mid 1 0 where
                mid _ _ _ [] = Nothing
                mid ind sum_ ekvator_ (x:xs) =
                    if (ekvator_ > (sum_ + x)) then mid (ind + 1) (sum_ + x) ekvator_ xs
                    else Just ind
    putStrLn (show res)

import Data.List
import Data.Maybe

main = do
    _ <- getLine
    line <- getLine
    let list = map readInt $ words line
    let s = ((sum list) + 1) `div` 2
    let y = fromMaybe 0 $ findInd s (\y a -> a > y) $ partSum list
    putStrLn (show y)

readInt :: String -> Integer
readInt x = read x :: Integer

partSum :: [Integer] -> [Integer]
partSum []   = [0]
partSum (x:[]) = [x]
partSum (x:xs) = x:(map (\y -> y + x) $ partSum xs)

findInd :: b -> (b -> a -> Bool) -> [a] -> Maybe Int
findInd y pred = findIndex $ pred y

import Data.List
import Data.Maybe

main = do
    _ <- getLine
    line <- getLine
    let list = map readInt $ words line
    let s = ((sum list) + 1) `div` 2
    let y = fromMaybe 0 $ findInd s (\y a -> a > y) $ partSum list
    putStrLn (show (y - 1))

readInt :: String -> Integer
readInt x = read x :: Integer

partSum :: [Integer] -> [Integer]
partSum []   = [0]
partSum (x:[]) = [x]
partSum (x:xs) = x:(map (\y -> y + x) $ partSum xs)

findInd :: b -> (b -> a -> Bool) -> [a] -> Maybe Int
findInd y pred = findIndex $ pred y

main = getContents >>= print . solve . map read . tail . words

solve xs = length $ takeWhile (<=half) $ scanl1 (+) xs
    where half = (1 + sum xs) `div` 2


You are given two arrays $$$a$$$ and $$$b$$$, both consisting of $$$n$$$ integers.In one move, you can choose two indices $$$i$$$ and $$$j$$$ ($$$1 \le i, j \le n$$$; $$$i \neq j$$$) and swap $$$a_i$$$ with $$$a_j$$$ and $$$b_i$$$ with $$$b_j$$$. You have to perform the swap in both arrays.You are allowed to perform at most $$$10^4$$$ moves (possibly, zero). Can you make both arrays sorted in a non-decreasing order at the end? If you can, print any sequence of moves that makes both arrays sorted.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of testcases. The first line of each testcase contains a single integer $$$n$$$ ($$$2 \le n \le 100$$$) — the number of elements in both arrays. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$1 \le a_i \le n$$$) — the first array. The third line contains $$$n$$$ integers $$$b_1, b_2, \dots, b_n$$$ ($$$1 \le b_i \le n$$$) — the second array.

For each testcase, print the answer. If it's impossible to make both arrays sorted in a non-decreasing order in at most $$$10^4$$$ moves, print -1. Otherwise, first, print the number of moves $$$k$$$ $$$(0 \le k \le 10^4)$$$. Then print $$$i$$$ and $$$j$$$ for each move $$$(1 \le i, j \le n$$$; $$$i \neq j)$$$. If there are multiple answers, then print any of them. You don't have to minimize the number of moves.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (ap, forM)
import Control.Monad.ST (runST)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM, when)
import qualified Data.Array.Base as AR
import qualified Data.ByteString.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Word (Word32)
import Debug.Trace (traceShowId, traceShowM)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, a :: [Int], b :: [Int]}

solve TC {..} = runST $ do
  ar <- AR.listArrayST (1, n) a
  br <- AR.listArrayST (1, n) b
  let now = tail $ ap (scanl (\(x, y) val -> (y, val)) . (0,) . head) tail $ (map snd . sort $ zip (zip a b) [1 .. n])

  fl <- forM now $ \(p, q) -> do
    a1 <- AR.readArray ar p
    a2 <- AR.readArray ar q
    b1 <- AR.readArray br p
    b2 <- AR.readArray br q

    pure $ a1 > a2 || b1 > b2

  -- traceShowM fl

  if (foldl1 (||) fl)
    then pure [(-1, -1)]
    else filter (/= (-1, -1)) <$> concat <$> (forM [1..n-1] $ \p -> forM [1..n-1] $ \q -> do
      a1 <- AR.readArray ar q
      a2 <- AR.readArray ar (q + 1)
      b1 <- AR.readArray br q
      b2 <- AR.readArray br (q + 1)

      when (a1 > a2 || b1 > b2) ( do
        AR.writeArray ar q a2
        AR.writeArray ar (q + 1) a1
        AR.writeArray br q b2
        AR.writeArray br (q + 1) b1
        )
      pure $ if a1 > a2 || b1 > b2 then (q, q + 1) else (-1, -1))

toAns xs
  | xs == [(-1, -1)] = ["-1"]
  | otherwise = (show $ length xs) : map (\(x, y) -> show x ++ " " ++ show y) xs

main = C.interact $ runScanner scan >>> map solve >>> map toAns >>> concat >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        b <- n >< int
        pure $ TC n a b
    )

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

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

isSorted :: [Int] -> Bool
isSorted [] = True
isSorted [_] = True
isSorted (x : xs) = (x <= head xs) && isSorted xs

indexOf' :: Eq t => Int -> t -> [t] -> Int
indexOf' _ _ [] = -1
indexOf' i k (x : xs)
 | (k == x) = i
 | otherwise = indexOf' (i + 1) k xs

indexOf :: Eq t => t -> [t] -> Int
indexOf k a = indexOf' 0 k a

genSwap :: [Int] -> [(Int, Int)]
genSwap a = [(cur, cur - 1) | (from, to) <- zip a [1 .. ], from /= to, cur <- [from, from - 1 .. to + 1]]

sortAndGetPos' :: [Int] -> [Int] -> [Int] -> Int -> ([Int], [Int])
sortAndGetPos' [] aSorted minPos _ = (aSorted, minPos)
sortAndGetPos' a aSorted minPos from = sortAndGetPos' rest aSortedNew minPosNew (from + 1)
 where
  min = minimum a
  index = indexOf min a
  before = take index a
  after = drop (index + 1) a
  rest = before ++ after
  aSortedNew = aSorted ++ [min]
  minPosNew = minPos ++ [index + from]

sortAndGetPos :: [Int] -> ([Int], [Int])
sortAndGetPos a = sortAndGetPos' a [] [] 1

ans = do
 nInput <- getLine
 aInput <- getLine
 bInput <- getLine
 let n = read nInput :: Int
 let a = [read x :: Int | x <- words aInput]
 let b = [read x :: Int | x <- words bInput]
 let ab = [first * 1000 + second | (first, second) <- zip a b]
 let (abSorted, abSortedPos) = sortAndGetPos ab
 let bExtract = [x `mod` 1000 | x <- abSorted]
 if (isSorted bExtract) then do
  let swaps = genSwap abSortedPos
  let swapsStr = join "\r\n" [show first ++ " " ++ show second | (first, second) <- swaps]
  let len = length swaps
  let result = show (length swaps) ++ (if (len > 0) then ("\r\n" ++ swapsStr) else "")
  return result
 else do
  return "-1"

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (ap, forM)
import Control.Monad.ST (runST)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM, when)
import qualified Data.Array.Base as AR
import qualified Data.ByteString.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Word (Word32)
import Debug.Trace (traceShowId, traceShowM)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, a :: [Int], b :: [Int]}

solve TC {..} = runST $ do
  ar <- AR.listArrayST (1, n) a
  br <- AR.listArrayST (1, n) b
  let now = tail $ ap (scanl (\(x, y) val -> (y, val)) . (0,) . head) tail $ (map snd . sort $ zip (zip a b) [1 .. n])

  fl <- forM now $ \(p, q) -> do
    a1 <- AR.readArray ar p
    a2 <- AR.readArray ar q
    b1 <- AR.readArray br p
    b2 <- AR.readArray br q
    pure $ a1 > a2 || b1 > b2

  if (foldl1 (&&) fl)
    then pure [(-1, -1)]
    else filter (/= (-1, -1)) <$> concat <$> (forM [1..n-1] $ \p -> forM [1..n-1] $ \q -> do
      a1 <- AR.readArray ar q
      a2 <- AR.readArray ar (q + 1)
      b1 <- AR.readArray br q
      b2 <- AR.readArray br (q + 1)

      when (a1 > a2 || b1 > b2) ( do
        AR.writeArray ar q a2
        AR.writeArray ar (q + 1) a1
        AR.writeArray br q b2
        AR.writeArray br (q + 1) b1
        )
      pure $ if a1 > a2 || b1 > b2 then (q, q + 1) else (-1, -1))

toAns xs
  | xs == [(-1, -1)] = ["-1"]
  | otherwise = (show $ length xs) : map (\(x, y) -> show x ++ " " ++ show y) xs

main = C.interact $ runScanner scan >>> map solve >>> map toAns >>> concat >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        b <- n >< int
        pure $ TC n a b
    )

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (ap, forM)
import Control.Monad.ST (runST)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM, when)
import qualified Data.Array.Base as AR
import qualified Data.ByteString.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Word (Word32)
import Debug.Trace (traceShowId, traceShowM)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, a :: [Int], b :: [Int]}

solve TC {..} = runST $ do
  ar <- AR.listArrayST (1, n) a
  br <- AR.listArrayST (1, n) b
  let now = tail $ ap (scanl (\(x, y) val -> (y, val)) . (0,) . head) tail $ (map snd . sort $ zip (zip a b) [1 .. n])

  fl <- forM now $ \(p, q) -> do
    a1 <- AR.readArray ar p
    a2 <- AR.readArray ar q
    b1 <- AR.readArray br p
    b2 <- AR.readArray br q
    pure $ a1 > a2 || b1 > b2

  if (foldl1 (&&) fl)
    then pure [(-1, -1)]
    else filter (/= (-1, -1)) <$> concat <$> (forM [1..n-1] $ \p -> forM [1..n-1] $ \q -> do
      a1 <- AR.readArray ar q
      a2 <- AR.readArray ar (q + 1)
      b1 <- AR.readArray br p
      b2 <- AR.readArray br q

      AR.writeArray ar q a2
      AR.writeArray ar (q + 1) a1
      AR.writeArray br q b2
      AR.writeArray br (q + 1) b1

      pure $ if a1 > a2 || b1 > b2 then (q, q + 1) else (-1, -1))

toAns xs
  | xs == [(-1, -1)] = ["-1"]
  | otherwise = (show $ length xs) : map (\(x, y) -> show x ++ " " ++ show y) xs

main = C.interact $ runScanner scan >>> map solve >>> map toAns >>> concat >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        b <- n >< int
        pure $ TC n a b
    )

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}

import Control.Applicative (Applicative (liftA2))
import Control.Arrow ((>>>))
import Control.Monad (ap, forM)
import Control.Monad.ST (runST)
import Control.Monad.State (MonadState (get, put), State, evalState, gets, replicateM, when)
import qualified Data.Array.Base as AR
import qualified Data.ByteString.Char8 as C
import Data.List (sort)
import Data.Maybe (fromJust)
import Data.Word (Word32)
import Debug.Trace (traceShowId, traceShowM)
import GHC.Conc (par, pseq)
import System.Environment (getArgs)

data TC = TC {n :: Int, a :: [Int], b :: [Int]}

solve TC {..} = runST $ do
  ar <- AR.listArrayST (1, n) a
  br <- AR.listArrayST (1, n) b
  let now = tail $ ap (scanl (\(x, y) val -> (y, val)) . (0,) . head) tail $ (map snd . sort $ zip (zip a b) [1 .. n])

  fl <- forM now $ \(p, q) -> do
    a1 <- AR.readArray ar p
    a2 <- AR.readArray ar q
    b1 <- AR.readArray br p
    b2 <- AR.readArray br q
    pure $ a1 > a2 || b1 > b2

  if (foldl1 (&&) fl)
    then pure [(-1, -1)]
    else filter (/= (-1, -1)) <$> concat <$> (forM [1..n-1] $ \p -> forM [1..n-1] $ \q -> do
      a1 <- AR.readArray ar q
      a2 <- AR.readArray ar (q + 1)
      b1 <- AR.readArray br p
      b2 <- AR.readArray br q
      -- when (a1 > a2 || b1 > b2) ( do
      --   AR.writeArray a p e
      -- )
      pure $ if a1 > a2 || b1 > b2 then (q, q + 1) else (-1, -1))

toAns xs
  | xs == [(-1, -1)] = ["-1"]
  | otherwise = (show $ length xs) : map (\(x, y) -> show x ++ " " ++ show y) xs

main = C.interact $ runScanner scan >>> map solve >>> map toAns >>> concat >>> map C.pack >>> C.unlines

scan =
  numberOf $
    ( do
        n <- int
        a <- n >< int
        b <- n >< int
        pure $ TC n a b
    )

type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

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

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

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

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

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

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

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

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

(><) = times

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

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


Petya loves lucky numbers. We all know that lucky numbers are the positive integers whose decimal representations contain only the lucky digits 4 and 7. For example, numbers 47, 744, 4 are lucky and 5, 17, 467 are not.Petya and his friend Vasya play an interesting game. Petya randomly chooses an integer p from the interval [pl, pr] and Vasya chooses an integer v from the interval [vl, vr] (also randomly). Both players choose their integers equiprobably. Find the probability that the interval [min(v, p), max(v, p)] contains exactly k lucky numbers.

The single line contains five integers pl, pr, vl, vr and k (1 ≤ pl ≤ pr ≤ 109, 1 ≤ vl ≤ vr ≤ 109, 1 ≤ k ≤ 1000).

On the single line print the result with an absolute error of no more than 10 - 9.

NoteConsider that [a, b] denotes an interval of integers; this interval includes the boundaries. That is, In first case there are 32 suitable pairs: (1, 7), (1, 8), (1, 9), (1, 10), (2, 7), (2, 8), (2, 9), (2, 10), (3, 7), (3, 8), (3, 9), (3, 10), (4, 7), (4, 8), (4, 9), (4, 10), (7, 1), (7, 2), (7, 3), (7, 4), (8, 1), (8, 2), (8, 3), (8, 4), (9, 1), (9, 2), (9, 3), (9, 4), (10, 1), (10, 2), (10, 3), (10, 4). Total number of possible pairs is 10·10 = 100, so answer is 32 / 100.In second case Petya always get number less than Vasya and the only lucky 7 is between this numbers, so there will be always 1 lucky number.

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    prange <- (,) <$> readInteger <*> readInteger
    vrange <- (,) <$> readInteger <*> readInteger
    k <- readInt
    return (prange, vrange, k)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = print =<< solve . evalState parseInput <$> BS.getContents

lucky = sort $ concat [ map read lst :: [Integer]
                      | digits <- [1..9]
                      , let lst = replicateM digits "47"
                      ] ++ [-inf, inf]

inf = 10^20

luckyL = zip (map succ lucky) (tail lucky)
luckyR = zip lucky (map pred (tail lucky))

solve (prange, vrange, k) = fromIntegral hits / fromIntegral all :: Double
  where
    hits = sum $ zipWith (solveCase prange vrange) luckyL (drop k luckyR)
    all = countNum prange * countNum vrange

mergeInt (l1, r1) (l2, r2) = (max l1 l2, min r1 r2)
countNum (l, r) | l > r     = 0
                | otherwise = r - l + 1

solveCase prange vrange int1 int2 = num1 + num2 - num3
  where
    num1 = countNum (mergeInt prange int1) * countNum (mergeInt vrange int2)
    num2 = countNum (mergeInt prange int2) * countNum (mergeInt vrange int1)

    int' = mergeInt int1 int2
    num3 = countNum (mergeInt prange int') * countNum (mergeInt vrange int')

----------------------------------------------------------------------
----------------------------------------------------------------------
----------------------------------------------------------------------

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State


Given three distinct integers $$$a$$$, $$$b$$$, and $$$c$$$, find the medium number between all of them.The medium number is the number that is neither the minimum nor the maximum of the given three numbers. For example, the median of $$$5,2,6$$$ is $$$5$$$, since the minimum is $$$2$$$ and the maximum is $$$6$$$.

The first line contains a single integer $$$t$$$ ($$$1 \leq t \leq 6840$$$) — the number of test cases. The description of each test case consists of three distinct integers $$$a$$$, $$$b$$$, $$$c$$$ ($$$1 \leq a, b, c \leq 20$$$).

For each test case, output a single integer — the medium number of the three numbers.

import Data.List

second :: [Int] -> Int
second a = a !! 1

solve :: [Int] -> Int
solve = second . sort

main = interact $
  unlines . map (show . solve . map read . words) . drop 1 . lines

-- pragmas.hs  {{{
-- vim: foldmethod=marker
{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE BinaryLiterals             #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs               #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MagicHash                  #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE MultiWayIf                 #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE RecordWildCards            #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UnboxedTuples              #-}
{-# LANGUAGE UndecidableInstances       #-}
-- pragmas.hs }}}
module Main where

import           Control.Monad            (replicateM_)
import           Data.Array               (Array, (!))
import qualified Data.ByteString          as BS
import qualified Data.ByteString.Char8    as C
import qualified Data.ByteString.Internal as BSI
import qualified Data.IntMap              as IntMap
import           Data.Ix                  (Ix)
import           Data.List
import           Debug.Trace              (trace)

solve :: [Int] -> Int
solve = (!!1) . sort

doCase :: IO ()
doCase = do
  xs <- getInts
  print $ solve xs

main :: IO ()
main = getInt >>= flip replicateM_ doCase

readInt :: C.ByteString -> Int
readInt s = let Just (i,_) = C.readInt s in i :: Int

readInt2 :: C.ByteString -> (Int, Int)
readInt2 u = (a, b)
  where
  Just (a,v) = C.readInt u
  Just (b,_) = C.readInt (C.tail v)

readInts :: C.ByteString -> [Int]
readInts str = readInt <$> BS.split (BSI.c2w ' ') str

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

getInt2 :: IO (Int, Int)
getInt2 = readInt2 <$> C.getLine

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


Jack decides to invite Emma out for a dinner. Jack is a modest student, he doesn't want to go to an expensive restaurant. Emma is a girl with high taste, she prefers elite places.Munhattan consists of n streets and m avenues. There is exactly one restaurant on the intersection of each street and avenue. The streets are numbered with integers from 1 to n and the avenues are numbered with integers from 1 to m. The cost of dinner in the restaurant at the intersection of the i-th street and the j-th avenue is cij.Jack and Emma decide to choose the restaurant in the following way. Firstly Emma chooses the street to dinner and then Jack chooses the avenue. Emma and Jack makes their choice optimally: Emma wants to maximize the cost of the dinner, Jack wants to minimize it. Emma takes into account that Jack wants to minimize the cost of the dinner. Find the cost of the dinner for the couple in love.

The first line contains two integers n, m (1 ≤ n, m ≤ 100) — the number of streets and avenues in Munhattan. Each of the next n lines contains m integers cij (1 ≤ cij ≤ 109) — the cost of the dinner in the restaurant on the intersection of the i-th street and the j-th avenue.

Print the only integer a — the cost of the dinner for Jack and Emma.

NoteIn the first example if Emma chooses the first or the third streets Jack can choose an avenue with the cost of the dinner 1. So she chooses the second street and Jack chooses any avenue. The cost of the dinner is 2.In the second example regardless of Emma's choice Jack can choose a restaurant with the cost of the dinner 1.

import Control.Monad

solve :: [[Int]] -> Int
solve a = maximum $ map minimum a

mapInt :: [String] -> [Int]
mapInt a = map read a

main :: IO()
main = do
  [m, n] <- liftM (map read . words) getLine
  lines <- replicateM m getLine
  print $ solve $ map (mapInt .words) lines

main = interact $ show. maximum . map (minimum . map (read ::String->Int). words) . tail . lines

import Control.Applicative ((<$>))

main = do
  getLine
  a <- map (map read . words) . lines <$> getContents :: IO [[Int]]

  print . maximum $ map minimum a

main = getContents >>= (print. foldr max (-100000000) . map (foldr min (1100000000). map read . words). tail. lines)

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

readIntegers :: IO [Integer]
readIntegers = map (read :: String -> Integer) . words <$> (getLine :: IO String)

getCost :: Integer -> Integer -> [[Integer]] -> Integer
getCost rows cols grid = maximum (map minimum grid)

main :: IO ()
main = do
    dimensions <- readIntegers
    rows <- return (dimensions!!0)
    cols <- return (dimensions!!1)
    grid <- replicateM (fromInteger rows) readIntegers
    putStrLn (show (getCost rows cols grid))

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

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

main = interact solve

solve input = show answer
    where
        (n:m:asnums) = map fastRead (words input)
        streets = streeter asnums
            where
                streeter [] = []
                streeter xs = c:(streeter rest)
                    where
                        (c,rest) = splitAt (fromIntegral m) xs

        answer = maximum (map minimum streets)

module Main where

import Data.List
import Data.String
import Data.Maybe
import Data.Either
import Control.Monad
import Control.Applicative
import Control.Arrow

main :: IO()
main = do
    [n,_] <- liftM (map (read::String -> Int).words) getLine
    arr <- forM [1..n] (\_ -> liftM (map (read::String -> Int).words) getLine)
    print $ foldl max 0 $ map (foldl min (10^9+1)) arr

import Control.Applicative

solve :: [[Int]] -> Int
solve = maximum . (map minimum)

main :: IO ()
main = do
  [n, m] <- map read . words <$> getLine
  css <- mapM (\_ -> map read . words <$> getLine) [1..n]
  print $ solve css

convert :: String -> [[Int]]
convert s = map (map read . words) $ lines s

solve :: [[Int]] -> Int
solve x = maximum $ map minimum x

main = do
    input <- getContents
    print $ solve (tail $ convert input)

module Main where

dinnerWithEmma = foldr1 max . map (foldr1 min)

processRaw = map processLine . tail . lines
    where processLine = map (read :: String -> Int) . words

main = do
    raw <- getContents
    print . dinnerWithEmma . processRaw $ raw

import Control.Monad

solve :: [[String]] -> String
solve a = maximum $ map minimum a

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

  lines <- replicateM m getLine
  putStrLn $ solve (map words lines)


Three guys play a game: first, each person writes down $$$n$$$ distinct words of length $$$3$$$. Then, they total up the number of points as follows:   if a word was written by one person — that person gets 3 points,  if a word was written by two people — each of the two gets 1 point,  if a word was written by all — nobody gets any points.  In the end, how many points does each player have?

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 1000$$$) — the number of words written by each person. The following three lines each contain $$$n$$$ distinct strings — the words written by each person. Each string consists of $$$3$$$ lowercase English characters.

For each test case, output three space-separated integers — the number of points each of the three guys earned. You should output the answers in the same order as the input; the $$$i$$$-th integer should be the number of points earned by the $$$i$$$-th guy.

3

1

abc

def

abc

3

orz for qaq

qaq orz for

cod for ces

5

iat roc hem ica lly

bac ter iol ogi sts

bac roc lly iol iat

NoteIn the first test case:   The word $$$\texttt{abc}$$$ was written by the first and third guys — they each get $$$1$$$ point.  The word $$$\texttt{def}$$$ was written by the second guy only — he gets $$$3$$$ points.

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 p =
    let s = map S.fromList p
        useless = (s !! 0) `S.intersection` (s !! 1) `S.intersection` (s !! 2)
    in solve1 $ map (\x -> x S.\\ useless) s

solve1 [p1, p2, p3] = C.unwords . map (C.pack . show) $ [calc p1 p2 p3, calc p2 p1 p3, calc p3 p1 p2]

calc cur ot1 ot2 = inter1 + inter2 + 3 * uniq
    where inter1 = S.size $ cur `S.intersection` ot1
          inter2 = S.size $ cur `S.intersection` ot2
          uniq = S.size $ cur S.\\ (ot1 `S.union` ot2)

work = do
    n <- C.getLine
    t1 <- C.getLine
    t2 <- C.getLine
    t3 <- C.getLine

    C.putStrLn $ solve [ C.words x | x <- [t1, t2, t3] ]

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) work

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 [p1, p2, p3] =
    let s1 = S.fromList p1
        s2 = S.fromList p2
        s3 = S.fromList p3
        useless = s1 `S.intersection` s2 `S.intersection` s3
    in solve1 [s1 S.\\ useless, s2 S.\\ useless, s3 S.\\ useless]

solve1 [p1, p2, p3] = C.unwords . map (C.pack . show) $ [calc p1 p2 p3, calc p2 p1 p3, calc p3 p1 p2]

calc cur ot1 ot2 = inter1 + inter2 + 3 * uniq
    where inter1 = S.size $ cur `S.intersection` ot1
          inter2 = S.size $ cur `S.intersection` ot2
          uniq = S.size $ cur S.\\ (ot1 `S.union` ot2)

work = do
    n <- C.getLine
    t1 <- C.getLine
    t2 <- C.getLine
    t3 <- C.getLine

    C.putStrLn $ solve [ C.words x | x <- [t1, t2, t3] ]

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) work

{-#LANGUAGE ScopedTypeVariables#-}
import Data.Char (isDigit)
import Data.Set (Set, fromList, member)

main = do
    input <- getContents
    let parsed = removeDigits (lines input)
    let result = parseTriples parsed
    mapM_ putStrLn result

removeDigits :: [String] -> [String]
removeDigits [] = []
removeDigits (x:xs)
    | all isDigit x = removeDigits xs
    | otherwise     = [x] ++ removeDigits xs

-- Gets eachs persons input line, and parses it to a [String], which can be used in checkRound
parseTriples :: [String] -> [String]
parseTriples [] = []
parseTriples (p1:p2:p3:rest) = [(checkRound (words p1) (words p2) (words p3))] ++ parseTriples rest

-- Gets the score for each person, and outputs the score on the format: "p1 p2 p3"
checkRound :: [String] -> [String] -> [String] -> String
checkRound p1 p2 p3 = do
    let p1s = fromList p1
    let p2s = fromList p2
    let p3s = fromList p3
    let p1Score = getScore p1 p2s p3s
    let p2Score = getScore p2 p1s p3s
    let p3Score = getScore p3 p1s p2s
    (show p1Score) ++ " " ++ (show p2Score) ++ " " ++ (show p3Score)

-- Takes each persons words, and outputs the score for the first person
getScore :: [String] -> Set String -> Set String -> Int
getScore [] _ _ = 0
getScore (x:xs) y z
    | (member x y) && (member x z) = 0 + getScore xs y z
    | (member x y) || (member x z) = 1 + getScore xs y z
    | otherwise                    = 3 + getScore xs y z

import Data.Map (Map(..))
import qualified Data.Map as M
import Control.Monad (replicateM_)
main = read <$> getLine >>= flip replicateM_ scase
scase = getLine >>
        wl >>=
        \w1 -> wl >>=
        \w2 -> wl >>=
        \w3 -> let cm = score w1 w2 w3
                   a = maybe 0 id (M.lookup 1 cm)
                   b = maybe 0 id (M.lookup 2 cm)
                   c = maybe 0 id (M.lookup 3 cm)
               in
                 putStrLn $ show a ++ " " ++ show b ++ " " ++ show c
  where wl = words <$> getLine

score :: [String] -> [String] -> [String] -> Map Int Int
score w1 w2 w3 = let m :: Map String [Int]
                     m = M.empty
                     iF s i = M.insertWith (++) s [i]
                     w = zip w1 (repeat 1) ++ zip w2 (repeat 2) ++ zip w3 (repeat 3)
                     f cm [i] = M.adjust (3+) i cm
                     f cm [i, j] = M.adjust (1+) i (M.adjust (1+) j cm)
                     f cm _ = cm
                 in
                   M.foldl f (M.fromList [(1, 0), (2, 0), (3, 0)])
                   (foldl (\m (s, i) -> iF s i m) m w)

import Control.Monad
import Data.Set

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

solve = do
    getLine
    [nums1, nums2, nums3] <-
        (fmap . fmap) (fromList . words) (forM [1..3] $ const getLine)
    putStrLn $ unwords (fmap show [
        score nums1 nums2 nums3,
        score nums2 nums1 nums3,
        score nums3 nums1 nums2 ])
    return ()

score xs ys zs =
    sum $ fmap (\x -> trans $ fromEnum (member x ys) + fromEnum (member x zs)) (toList xs)
    where
        trans x
            | x == 0 = 3
            | x == 1 = 1
            | x == 2 = 0
            | otherwise = undefined

{-# 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.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 <- replicateM n getNext
  b <- replicateM n getNext
  c <- replicateM n getNext
  let
    combined = a ++ b
    -- tst = map (,1) combined
    counter = fromListWith (+) . map (,1) $ (a ++ b ++ c)
    score :: P.ByteString -> Int
    score s = case M.lookup s counter of
      Nothing -> 0
      Just x -> case x of
        1 -> 3
        2 -> 1
        3 -> 0
    fun = sum . map score
    ansa = fun a
    ansb = fun b
    ansc = fun c
  pure $ putInts [ansa, ansb, ansc]

import Control.Monad (forM_)
import Data.List
import Debug.Trace (trace)
import qualified Data.Map as M

readInts = getLine >>= pure . map read . words
hm 3 = 0
hm 2 = 1
hm 1 = 3

main = do
    [n'] <- readInts
    forM_ [1..n'] (\_ -> do
        getLine
        a <- getLine >>= pure . words
        b <- getLine >>= pure . words
        c <- getLine >>= pure . words
        let m = M.fromList . map (\l -> (head l, length l)) . group . sort $ a ++ b ++ c
        forM_ [a,b,c] (\l -> do
            putStr . show . sum . map (hm . (m M.!)) $ l
            putStr " ")
        putStrLn "" )

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

import qualified Data.Map.Strict as M

import Data.Maybe
import Control.Monad

import Data.List

--solve p = solve1 (map countElems p)
--solve :: [C.ByteString] -> [C.ByteString]
solve p = solve1 $ map countElems p

solve1 [p1, p2, p3] = unwords . map show $ [calc p1 p2 p3, calc p2 p1 p3, calc p3 p1 p2]

calc cur ot1 ot2 = inter1 + inter2 + 3 * uniq
    where inter1 = M.size $ cur `M.intersection` ot1
          inter2 = M.size $ cur `M.intersection` ot2
          uniq = M.size $ cur M.\\ (ot1 `M.union` ot2)

countElems = M.fromListWith (+) . flip zip (repeat 1)

del x y z = length $ x \\ (y `union` z)
inter x y = length $ x `intersect` y

work = do
    n <- C.getLine
    t1 <- C.getLine
    t2 <- C.getLine
    t3 <- C.getLine

    putStrLn $ solve [ C.words x | x <- [t1, t2, t3] ]

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) work

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

import qualified Data.Map.Strict as M

import Data.Maybe
import Control.Monad

import Data.List

--solve p = solve1 (map countElems p)
--solve :: [C.ByteString] -> [C.ByteString]
solve p = solve1 $ map countElems p

solve1 [p1, p2, p3] = [calc p1 p2 p3, calc p2 p1 p3, calc p3 p1 p2]

calc cur ot1 ot2 = inter1 + inter2 + 3 * uniq
    where inter1 = M.size $ cur `M.intersection` ot1
          inter2 = M.size $ cur `M.intersection` ot2
          uniq = M.size $ cur M.\\ (ot1 `M.union` ot2)

countElems = M.fromListWith (+) . flip zip (repeat 1)

del x y z = length $ x \\ (y `union` z)
inter x y = length $ x `intersect` y

work = do
    n <- C.getLine
    t1 <- C.getLine
    t2 <- C.getLine
    t3 <- C.getLine

    print $ solve [ C.words x | x <- [t1, t2, t3] ]

main = do
    t <- C.getLine

    replicateM_ (fst $ fromJust $ C.readInt t) work


Not so long ago, Vlad had a birthday, for which he was presented with a package of candies. There were $$$n$$$ types of candies, there are $$$a_i$$$ candies of the type $$$i$$$ ($$$1 \le i \le n$$$).Vlad decided to eat exactly one candy every time, choosing any of the candies of a type that is currently the most frequent (if there are several such types, he can choose any of them). To get the maximum pleasure from eating, Vlad does not want to eat two candies of the same type in a row.Help him figure out if he can eat all the candies without eating two identical candies in a row.

The first line of input data contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$) — the number of input test cases. The following is a description of $$$t$$$ test cases of input, two lines for each. The first line of the case contains the single number $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of types of candies in the package. The second line of the case contains $$$n$$$ integers $$$a_i$$$ ($$$1 \le a_i \le 10^9$$$) — the number of candies of the type $$$i$$$. It is guaranteed that the sum of $$$n$$$ for all cases does not exceed $$$2 \cdot 10^5$$$.

Output $$$t$$$ lines, each of which contains the answer to the corresponding test case of input. As an answer, output "YES" if Vlad can eat candy as planned, and "NO" otherwise. You can output the answer in any case (for example, the strings "yEs", "yes", "Yes" and "YES" will be recognized as a positive answer).

NoteIn the first example, it is necessary to eat sweets in this order: a candy of the type $$$2$$$, it is the most frequent, now $$$a = [2, 2]$$$; a candy of the type $$$1$$$, there are the same number of candies of the type $$$2$$$, but we just ate one, now $$$a = [1, 2]$$$; a candy of the type $$$2$$$, it is the most frequent, now $$$a = [1, 1]$$$; a candy of the type $$$1$$$, now $$$a = [0, 1]$$$; a candy of the type $$$2$$$, now $$$a = [0, 0]$$$ and the candy has run out.In the second example, all the candies are of the same type and it is impossible to eat them without eating two identical ones in a row.In the third example, first of all, a candy of the type $$$2$$$ will be eaten, after which this kind will remain the only kind that is the most frequent, and you will have to eat a candy of the type $$$2$$$ again.

module Main where

import           Control.Monad
import           Data.List

main :: IO ()
main = do
  n <- readLn
  replicateM_ n solvet

solvet :: IO ()
solvet = do
  noTypes <- read <$> getLine
  types <- map read . words <$> getLine
  let (maxmax, maxx) = twoMaxes types (0, 0)
  let res
        | noTypes == 1 =
          if head types > 1
            then "NO"
            else "YES"
        | maxmax - maxx > 1 = "NO"
        | otherwise = "YES"
  putStrLn res

twoMaxes :: Ord a => [a] -> (a, a) -> (a, a)
twoMaxes [] (a, b) = (a, b)
twoMaxes (x:xs) (a, b)
  | x > a = twoMaxes xs (x, a)
  | x > b = twoMaxes xs (a, x)
  | otherwise = twoMaxes xs (a, b)