Vasya is about to take his first university exam in about several minutes. And it's not just some ordinary exam, it's on mathematical analysis. Of course, right now Vasya can only think of one thing: what the result of his talk with the examiner will be...To prepare for the exam, one has to study proofs of n theorems. It is known that there will be k examination cards on the exam and each card contains  distinct theorems. Besides, no theorem is mentioned in more than one card (that is,  theorems won't be mentioned in any card). During the exam several students may get the same card.We do not know the exact way theorems are distributed by cards, however the students that took the exam before Vasya told him what theorems their cards contained. Vasya evaluates his level of proficiency in the i-th theorem by some number ai. The level of proficiency in some card is the average of the levels of proficiency in the theorems that are included in the card. Now Vasya wants to know the minimally and maximally possible levels of his proficiency in the card he gets on the exam. Vasya wants to determine it by the data he has collected from other students. Unfortunately, Vasya has no time left to do the math and he asked you to help him.

The first line contains two integers n and k (1 ≤ k ≤ n ≤ 100) — the number of theorems and the number of cards correspondingly. The second line contains n integers ai (0 ≤ ai ≤ 100), the i-th number (1 ≤ i ≤ n) corresponds to Vasya's proficiency in the i-th theorem. The third line contains number q (0 ≤ q ≤ 100) — the number of people that have taken the exam before Vasya. Each of the following q lines contains the description of a student's card:  integers from 1 to n inclusive. They are the numbers of theorems included in the card in the order in which they are enumerated in the input data. The numbers are given in an arbitrary order. It is guaranteed that the given cards are valid (that is, that all theorems in one card are different and that different people get cards that either don't contain the same theorems or coincide up to the theorems' permutation).

Print two real numbers, representing Vasya's minimum and maximum proficiency in the card he will get on the exam. The absolute or relative error should not exceed 10 - 6.

NoteLet's analyze the first sample. Vasya's proficiency in the cards whose content he already knows equals 6 and 15.5 correspondingly. The three theorems that are left are only enough to make one exam card. If we consider all possible variants of theorems included in the card we can see that in the best case scenario Vasya gets the card that contains theorems 4 and 7 (his proficiency would equal 15.5) and in the worst case scenario he gets theorems 3 and 5 (his proficiency would equal 5).The ⌊ x⌋ operation denotes taking integer part of real number x (rounding down).

import Data.List

getList = fmap (map read . words) getLine

getLists 0 = return []
getLists n = do x <- getList; xs <- getLists (n-1); return (x:xs)

max_take n lst = take n . reverse . sort $ lst

min_take n lst = take n . sort $ lst

solve n k as qs = (minimum $ map min_score group, maximum $ map max_score group)
	where
		rem = foldr delete as (concat qs)
		group = if length qs == k then qs else (rem:qs)
		fn = fromIntegral n
		min_score = (/fn) . fromIntegral . sum . min_take n
		max_score = (/fn) . fromIntegral . sum . max_take n

p (x, y) = putStrLn $ (show x) ++ " " ++ (show y)

main = do
	[n, k] <- getList
	as <- getList
	q <- fmap read getLine
	qsi <- getLists q
	let qs = map (map (\x -> as !! (x-1))) . nub . map sort $ qsi
	p $ solve (div n k) k as qs

import Data.List

getList = fmap (map read . words) getLine

getLists 0 = return []
getLists n = do x <- getList; xs <- getLists (n-1); return (x:xs)

max_take n lst = take n . reverse . sort $ lst

min_take n lst = take n . sort $ lst

solve n k as qs = (minimum $ map min_score group, maximum $ map max_score group)
	where
		rem = foldr delete as (concat qs)
		group = if length qs == k then qs else (rem:qs)
		fn = fromIntegral n
		min_score = (/fn) . fromIntegral . sum . min_take n
		max_score = (/fn) . fromIntegral . sum . max_take n

p (x, y) = putStrLn $ (show x) ++ " " ++ (show y)

main = do
	[n, k] <- getList
	as <- getList
	q <- fmap read getLine
	qsi <- getLists q
	let qs = map (map (\x -> as !! (x-1))) qsi
	p $ solve (div n k) k as qs

import Data.List

getList = fmap (map read . words) getLine

getLists 0 = return []
getLists n = do x <- getList; xs <- getLists (n-1); return (x:xs)

max_take n lst = take n . reverse . sort $ lst

min_take n lst = take n . sort $ lst

solve n as qs = (minimum $ map min_score group, maximum $ map max_score group)
	where
		rem = foldr delete as (concat qs)
		group = (rem:qs)
		fn = fromIntegral n
		min_score = (/fn) . fromIntegral . sum . min_take n
		max_score = (/fn) . fromIntegral . sum . max_take n

p (x, y) = putStrLn $ (show x) ++ " " ++ (show y)

main = do
	[n, k] <- getList
	as <- getList
	q <- fmap read getLine
	qsi <- getLists q
	let qs = map (map (\x -> as !! (x-1))) qsi
	p $ solve (div n k) as qs

import Data.List

getList = fmap (map read . words) getLine

getLists 0 = return []
getLists n = do x <- getList; xs <- getLists (n-1); return (x:xs)

max_take n lst = take n . reverse . sort $ lst

min_take n lst = take n . sort $ lst

solve n as qs = (minimum $ map min_score group, maximum $ map max_score group)
	where
		rem = foldr delete as (concat qs)
		group = if length rem >= n then (rem:qs) else qs
		fn = fromIntegral n
		min_score = (/fn) . fromIntegral . sum . min_take n
		max_score = (/fn) . fromIntegral . sum . max_take n

p (x, y) = putStrLn $ (show x) ++ " " ++ (show y)

main = do
	[n, k] <- getList
	as <- getList
	q <- fmap read getLine
	qsi <- getLists q
	let qs = map (map (\x -> as !! (x-1))) qsi
	p $ solve (div n k) as qs


You are given n segments on the Ox-axis. You can drive a nail in any integer point on the Ox-axis line nail so, that all segments containing this point, are considered nailed down. If the nail passes through endpoint of some segment, this segment is considered to be nailed too. What is the smallest number of nails needed to nail all the segments down?

The first line of the input contains single integer number n (1 ≤ n ≤ 1000) — amount of segments. Following n lines contain descriptions of the segments. Each description is a pair of integer numbers — endpoints coordinates. All the coordinates don't exceed 10000 by absolute value. Segments can degenarate to points.

The first line should contain one integer number — the smallest number of nails needed to nail all the segments down. The second line should contain coordinates of driven nails separated by space in any order. If the answer is not unique, output any.

import Data.List

cmp :: (Int, Int) -> (Int, Int) -> Ordering
cmp (a, b) (c, d) = compare b d

process :: [Int] -> [(Int, Int)]
process (a:b:c)
	| a <= b	= (a, b) : (process c)
	| otherwise	= (b, a) : (process c)
process _ = []

contain :: Int -> (Int, Int) -> Bool
contain x (y, z) = x >= y && x <= z

getPts :: [(Int, Int)] -> [Int]
getPts (x:xs) = (snd x) : (getPts (takePts (snd x) xs))
getPts [] = []

takePts :: Int -> [(Int, Int)] -> [(Int, Int)]
takePts p (x:xs)
	| contain p x	= takePts p xs
	| otherwise		= x:xs
takePts _ _ = []

printList :: [Int] -> IO()
printList (a:b) = do
	putStr ((show a) ++ " ")
	printList b
printList _ = do
	putStr "\n"

main :: IO()
main = do
	str <- getContents
	let list = process (map read (tail (words str)))
	let slist = sortBy cmp list
	let ans = getPts slist
	putStrLn (show (length ans))
	printList ans

import qualified Data.List as DL

-- with dropWhile

-- assume already sorted
findNails segList = accum segList []
                where accum ([_,newNail]:segs) nails = accum (dropWhile (\[begin,_] -> begin <= newNail) segs) $ newNail:nails
                      accum [] nails = nails

sortSegs segs = DL.sortBy (\[_,e1] [_,e2] -> compare e1 e2) segs

input2segs allInput = map (\line -> fixOrder $ map intRder (words line)) $ lines allInput
    where intRder str = read str :: Int
          fixOrder [a,b]
                | a <= b = [a,b]
                | otherwise = [b,a]

solve = findNails . sortSegs . input2segs

-- **********
-- printing / output functions

itemPrinter :: Show a => a -> IO ()
itemPrinter item = (putStr . show) item >> putChar ' '

lengthPrinter :: [a] -> IO [a]
lengthPrinter lst = print (length lst) >> (return lst)

-- how do I print in required format?
main :: IO ()
main = getLine >> getContents >>= lengthPrinter . solve >>= mapM_ itemPrinter >> putStr "\n"

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List (foldl', sort, unwords)
import Data.Char (isSpace)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC

pin [] (total, pins) curminend = (total + 1, curminend : pins)
pin ((start, end) : segs) sol@(total, pins) curminend
    | start > curminend     = pin segs (total + 1, curminend : pins) end
    | end < curminend       = pin segs sol end
    | otherwise             = pin segs sol curminend

main =
  do all <- BS.getContents
     let Just (n, r1) = readInt all
     let ls = sort (readMany2TR readInt r1 [])
     let (tot, pins) = pin ls (0, []) maxend
     print tot
     putStrLn $ unwords $ map show pins
  where
    readInt s = BSC.readInt (BSC.dropWhile isSpace s)
    readMany2TR readf s acc = case readf s of
        Just (x, r) -> case readf r of
            Just (y, r') -> readMany2TR readf r' (orient x y : acc)
            Nothing      -> acc
        Nothing     -> acc
    orient a b | a < b      = (a, b)
               | otherwise  = (b, a)
    maxend = 10001

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

main = do
  n <- fmap read getLine
  a <- fmap (sort . map ( ( \[l,r] -> (l,r)) . sort . map read . words)) (replicateM n getLine)
  let nails = solve a
  print (length nails)
  putStrLn . unwords . map show $ nails

solve :: [(Int, Int)] -> [Int]
solve a =
  let n = length a
      nails = array (0, n-1) [(i, f i) | i <- [0..n-1]]
      f k = case find (\i -> nails!i >= l && nails!i <= r) [k+1..n-1] of
              Just i -> nails!i
              Nothing -> l
            where (l,r) = a!!k
  in nub (elems nails)

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import List

myshow [] = ""
myshow (f:xs) =
  if ( xs == [] ) then
    show f
  else
    ( show f ) ++ " " ++ ( myshow xs )

ziplst [] = []
ziplst [a] = []
ziplst (a:b:bs) =
  (a, b):( ziplst bs )

fixlst [] = []
fixlst ((s, f):xs) =
  ((min s f), (max s f)):( fixlst xs )

take_max [] = 0
take_max [(s, f)] = f
take_max ((s, f):xs) =
  max f ( take_max xs )

mycomp ( s1, f1 ) ( s2, f2 )
  | s1 < s2 = LT
  | s1 > s2 = GT
  | s1 == s2 = compare f2 f1

mysort lst = sortBy mycomp lst

putpin fmax fmin [] = [fmin]
putpin fmax fmin ((s, f):xs) =
  if ( not ( fmin == fmax ) ) then
    if ( s <= fmin ) then
      putpin fmax ( min f fmin ) xs
    else
      fmin:( putpin fmax f xs )
  else
    putpin fmax f xs

solve :: Int -> Int -> [ ( Int, Int ) ] -> [ Int ]
solve fmax n lst = putpin fmax fmax lst

main =
  do n <- readLn
     str <- getContents
     let x = map read (words str)
     let inpt = ziplst x
     let proplst = mysort ( fixlst inpt )
     let fmax = ( take_max proplst + 1 )
     let res = solve fmax n proplst
     let outp = myshow res
     putStrLn ( show ( length res ) )
     putStrLn outp

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import Data.List

myshow [] = ""
myshow (f:xs) =
  if ( xs == [] ) then
    show f
  else
    ( show f ) ++ " " ++ ( myshow xs )

ziplst [] = []
ziplst [a] = []
ziplst (a:b:bs) =
  (a, b):( ziplst bs )

fixlst [] = []
fixlst ((s, f):xs) =
  ((min s f), (max s f)):( fixlst xs )

take_max [] = 0
take_max [(s, f)] = f
take_max ((s, f):xs) =
  max f ( take_max xs )

mycomp ( s1, f1 ) ( s2, f2 )
  | s1 < s2 = LT
  | s1 > s2 = GT
  | s1 == s2 = compare f2 f1

mysort lst = sortBy mycomp lst

putpin fmax fmin [] = [fmin]
putpin fmax fmin ((s, f):xs) =
  if ( not ( fmin == fmax ) ) then
    if ( s <= fmin ) then
      putpin fmax ( min f fmin ) xs
    else
      fmin:( putpin fmax f xs )
  else
    putpin fmax f xs

solve :: Int -> Int -> [ ( Int, Int ) ] -> [ Int ]
solve fmax n lst = putpin fmax fmax lst

main =
  do n <- readLn
     str <- getContents
     let x = map read (words str)
     let inpt = ziplst x
     let proplst = mysort ( fixlst inpt )
     let fmax = ( take_max proplst + 1 )
     let res = solve fmax n proplst
     let outp = myshow res
     putStrLn ( show ( length res ) )
     putStrLn outp

{-# OPTIONS_GHC -O2 -optc-O2 #-}

import List

myshow [] = ""
myshow (f:xs) =
  if ( xs == [] ) then
    show f
  else
    ( show f ) ++ " " ++ ( myshow xs )

ziplst [] = []
ziplst [a] = []
ziplst (a:b:bs) =
  (a, b):( ziplst bs )

fixlst [] = []
fixlst ((s, f):xs) =
  ((min s f), (max s f)):( fixlst xs )

mycomp ( s1, f1 ) ( s2, f2 )
  | s1 < s2 = LT
  | s1 > s2 = GT
  | s1 == s2 = compare f2 f1

mysort lst = sortBy mycomp lst

putpin fmin [] = [fmin]
putpin fmin ((s, f):xs) =
  if ( not ( fmin == -1 ) ) then
    if ( s <= fmin ) then
      putpin ( min f fmin ) xs
    else
      fmin:( putpin f xs )
  else
    putpin f xs

solve :: Int -> [ ( Int, Int ) ] -> [ Int ]
solve n lst = putpin (-1) lst

main =
  do n <- readLn
     str <- getContents
     let x = map read (words str)
     let inpt = ziplst x
     let proplst = mysort ( fixlst inpt )
     let res = solve n proplst
     let outp = myshow res
     putStrLn ( show ( length res ) )
     putStrLn outp


An oriented weighted forest is an acyclic weighted digraph in which from each vertex at most one edge goes.The root of vertex v of an oriented weighted forest is a vertex from which no edge goes and which can be reached from vertex v moving along the edges of the weighted oriented forest. We denote the root of vertex v as root(v).The depth of vertex v is the sum of weights of paths passing from the vertex v to its root. Let's denote the depth of the vertex v as depth(v).Let's consider the process of constructing a weighted directed forest. Initially, the forest does not contain vertices. Vertices are added sequentially one by one. Overall, there are n performed operations of adding. The i-th (i > 0) adding operation is described by a set of numbers (k,  v1,  x1,  v2,  x2,  ... ,  vk,  xk) and means that we should add vertex number i and k edges to the graph: an edge from vertex root(v1) to vertex i with weight depth(v1) + x1, an edge from vertex root(v2) to vertex i with weight depth(v2) + x2 and so on. If k = 0, then only vertex i is added to the graph, there are no added edges.Your task is like this: given the operations of adding vertices, calculate the sum of the weights of all edges of the forest, resulting after the application of all defined operations, modulo 1000000007 (109 + 7).

The first line contains a single integer n (1 ≤ n ≤ 105) — the number of operations of adding a vertex. Next n lines contain descriptions of the operations, the i-th line contains the description of the operation of adding the i-th vertex in the following format: the first number of a line is an integer k (0 ≤ k ≤ i - 1), then follow 2k space-separated integers: v1, x1, v2, x2, ... , vk, xk (1 ≤ vj ≤ i - 1, |xj| ≤ 109).  The operations are given in the order, in which they should be applied to the graph. It is guaranteed that sum k of all operations does not exceed 105, also that applying operations of adding vertexes does not result in loops and multiple edges.

Print a single number — the sum of weights of all edges of the resulting graph modulo 1000000007 (109 + 7).

NoteConside the first sample: Vertex 1 is added. k = 0, thus no edges are added. Vertex 2 is added. k = 0, thus no edges are added. Vertex 3 is added. k = 1. v1 = 2, x1 = 1. Edge from vertex root(2) = 2 to vertex 3 with weight depth(2) + x1 = 0 + 1 = 1 is added.  Vertex 4 is added. k = 2. v1 = 1, x1 = 5. Edge from vertex root(1) = 1 to vertex 4 with weight depth(1) + x1 = 0 + 5 = 5 is added. v2 = 2, x2 = 2. Edge from vertex root(2) = 3 to vertex 4 with weight depth(2) + x1 = 1 + 2 = 3 is added. Vertex 5 is added. k = 1. v1 = 1, x1 = 2. Edge from vertex root(1) = 4 to vertex 5 with weight depth(1) + x1 = 5 + 2 = 7 is added. Vertex 6 is added. k = 1. v1 = 3, x1 = 4. Edge from vertex root(3) = 5 to vertex 6 with weight depth(3) + x1 = 10 + 4 = 14 is added.The resulting graph is shown on the pictore below:

{-# OPTIONS_GHC -O2 -optc-Ofast -fignore-asserts #-}
import Control.Monad
import Data.Maybe
import Data.List (foldl')
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

(+%) :: Int -> Int -> Int
lhs +% rhs = (lhs + rhs) `mod` 1000000007

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

type DisjointSet = State (M.IntMap (Int, Int))

query :: Int -> DisjointSet (Int, Int)
query v = v `seq` do
  h@(hr, hd) <- gets (M.! v)
  if hr == v
    then return h
    else do
      (tr, td) <- query hr
      let ret = (tr, hd +% td)
      modify $ M.insert v ret
      return ret

process :: Int -> Int -> [Int] -> DisjointSet Int
process _ s [] = return s
process k s (m:q) = s `seq` do
  modify $ M.insert k (k, 0)
  edges <- forM (pairs e) $ \(v, x) -> do
    (root, depth) <- query v
    let depth' = depth +% x
    modify $ M.insert root (k, depth')
    return $ depth'
  process (k + 1) (s +% foldl' (+%) 0 edges) q'
  where
    (e, q') = splitAt (2*m) q

main :: IO ()
main = do
  (_:q) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  print $ fst $ runState (process 1 0 q) M.empty

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)

import Control.Monad
import Data.Maybe
import qualified Data.IntMap as M
import qualified Data.ByteString.Char8 as C

(+%) :: Int -> Int -> Int
lhs +% rhs = (lhs + rhs) `mod` 1000000007

pairs :: [a] -> [(a, a)]
pairs (x:y:z) = (x, y): pairs z
pairs _ = []

type DisjointSet = State (M.IntMap (Int, Int))

query :: Int -> DisjointSet (Int, Int)
query v = do
  h@(hr, hd) <- gets (M.! v)
  if hr == v
    then return h
    else do
      (tr, td) <- query hr
      let ret = (tr, hd + td)
      modify $ M.insert v ret
      return ret

process :: Int -> [Int] -> DisjointSet Int
process _ [] = return 0
process k (m:q) = do
  modify $ M.insert k (k, 0)
  edges <- forM (pairs e) $ \(v, x) -> do
    (root, depth) <- query v
    modify $ M.insert root (k, depth + x)
    return $ depth + x
  total <- process (k+1) q'
  return $ total +% foldl (+%) 0 edges
  where
    (e, q') = splitAt (2*m) q

main :: IO ()
main = do
  (_:q) <- fmap (map (fst . fromJust . C.readInt) . C.words) C.getContents
  print $ fst $ runState (process 1 q) M.empty

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

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

get :: State s s
get = State $ \s -> (s, s)

put :: s -> State s ()
put s = State $ \_ -> ((), s)

modify :: (s -> s) -> State s ()
modify f = State $ \s -> ((), f s)

gets :: (s -> a) -> State s a
gets f = State $ \s -> (f s, s)


When Serezha was three years old, he was given a set of cards with letters for his birthday. They were arranged into words in the way which formed the boy's mother favorite number in binary notation. Serezha started playing with them immediately and shuffled them because he wasn't yet able to read. His father decided to rearrange them. Help him restore the original number, on condition that it was the maximum possible one.

The first line contains a single integer $$$n$$$ ($$$1 \leqslant n \leqslant 10^5$$$) — the length of the string. The second line contains a string consisting of English lowercase letters: 'z', 'e', 'r', 'o' and 'n'. It is guaranteed that it is possible to rearrange the letters in such a way that they form a sequence of words, each being either "zero" which corresponds to the digit $$$0$$$ or "one" which corresponds to the digit $$$1$$$.

Print the maximum possible number in binary notation. Print binary digits separated by a space. The leading zeroes are allowed.

NoteIn the first example, the correct initial ordering is "zero".In the second example, the correct initial ordering is "oneonezero".

import Data.List (intercalate)
import Control.Monad (replicateM_)
main = do
  n <- read <$> getLine :: IO Int
  solveProblem

solveProblem :: IO()
solveProblem = do
  xs <- getLine
  putStrLn $ intercalate " " $ replicate (oneAmount xs) "1" ++ replicate (zeroAmount xs) "0"
  where
    oneAmount = length . filter (== 'n')
    zeroAmount = length . filter (== 'z')

import Data.List
import Data.Maybe

solve' eo n zr =
   let ones = min n eo
       zeros = min (eo - ones) zr
   in intersperse ' ' $ replicate ones '1' ++ replicate zeros '0' ++ []

var xs x = let a = lookup x xs in if isJust a then fromJust a else 0

solve xs =
 let bs =  map (\x -> (head x, length x)) $ group $ sort xs
     [z,e,r,o,n]  = map (var bs) "zeron"
 in solve' (min e o) n (min z r)

main =  do
   getLine
   a <- getLine
   putStrLn $ solve a

main = do
  getLine
  s <- getLine
  let n = length (filter (== 'n') s)
      z = length (filter (== 'z') s)
  putStrLn $ unwords $ replicate n "1" ++ replicate z "0"

import Data.Maybe
import Data.List
import Data.Ord

main :: IO ()
main = interact (fmt . solve . head . tail . lines)

f :: Char -> Maybe Int
f 'z' = Just 0
f 'n' = Just 1
f _ = Nothing

solve :: String -> [Int]
solve = sortOn Down . mapMaybe f

fmt :: [Int] -> String
fmt = unwords . map show

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

main::IO ()
main=do
  	t<- read <$> getLine ::IO Int
	s<-getLine
	let lz = length $ filter(=='z') s
	let ls =length s
	let n1 = div (ls-4*lz) 3
	putStr $ concat $ replicate n1 "1 "
	putStrLn $ concat $ replicate lz "0 "

--ghc 7.10

countOccurrence :: Char -> String -> Int
countOccurrence x = length . filter (==x)

maxNumber :: String -> [Int]
maxNumber str = (take n1 [1,1..]) ++ (take n0 [0,0..])
    where
        n0 = countOccurrence 'z' str
        n1 = countOccurrence 'n' str

main = do
    nStr <- getLine
    str <- getLine
    putStrLn . unwords . map show $ maxNumber str

{-
  Copyright (c) 2019 Islam Omar
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-Ofast #-}

import Control.Monad (foldM, forM, forM_, join, replicateM_, when)
import Control.Monad.ST
import Control.Monad.State.Strict

import Data.Array.IArray (array)
import Data.Array.ST.Safe (STArray)
import qualified Data.Array.ST.Safe as MA
import Data.Bits
import Data.Functor
import Data.Graph (Graph)
import qualified Data.Graph as G
import Data.Int (Int64)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.List as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.STRef
import Data.Set (Set)
import qualified Data.Set as S
import System.IO
import Text.Read
--- DEBUGGING
#define DEBUG(x) dump di "x" x
dump di str a
  | "demo.hs" `L.isSuffixOf` __FILE__ =
    modifySTRef' di (L.insert (str, a)) >> return Nothing
  | otherwise = return Nothing

printDump lst
  | "demo.hs" `L.isSuffixOf` __FILE__ = forM_ lst print >> return Nothing
  | otherwise = return Nothing

readNumList :: (Num a, Read a) => IO [a]
readNumList = map read . words <$> getLine

readNum :: (Num a, Read a) => IO a
readNum = read <$> getLine

readNumListLn :: (Num a, Read a) => Int -> IO [a]
readNumListLn n = doGetList n []
  where
    doGetList 0 l = return l
    doGetList n l = do
      i <- readNum
      doGetList (n - 1) (l ++ [i])

-- solve :: STRef s [([Char], Int)] -> Int -> Int -> Int -> Int -> Int -> ST s [Int]
solve di n s = do
  let zeros = foldr (\c cnt -> if c == 'z' then cnt+1 else cnt) 0 s
  let ones = foldr (\c cnt -> if c == 'n' then cnt+1 else cnt) 0 s
  --forM_ nums compute
  let ans = (zeros, ones)
  -- solution
  return ans

solveN 0 = return ()
solveN n = do
  n <- readNum :: IO Int
  -- let m =  <- readNum :: IO [Int]
  s <- getLine
  let computation =
        runST $ do
          let dubeg_info =
                [] :: (Num a) =>
                        [(String, a)]
          --- list of tuples (string value)
          di <- newSTRef dubeg_info
          ans <- solve di n s
          tmp <- readSTRef di
          let lst = (ans, tmp)
          readSTRef =<< newSTRef lst
  -- get solution
  let (z, o) = fst computation
  let debug_info = snd computation
  printDump debug_info
  -- print result
  forM_ [1..o] (\_ -> putStr "1 ")
  forM_ [1..z] (\_ -> putStr "0 ")
  putStrLn ""
  -- putStrLn $ show n ++ " " ++ show p

-- main :: IO ()
main = do
  -- t <- readNum :: IO Int
  solveN 1

{-
  Copyright (c) 2019 Islam Omar
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -optc-Ofast #-}

import Control.Monad (foldM, forM, forM_, join, replicateM_, when)
import Control.Monad.ST
import Control.Monad.State.Strict

-- import           Data.Array.MArray.Safe         ( MArray )
-- import qualified Data.Array.MArray.Safe        as MA
import Data.Array.ST.Safe (STArray)
import qualified Data.Array.ST.Safe as MA
import Data.Bits
import Data.Functor
import Data.Graph (Graph)
import qualified Data.Graph as G
import Data.Int (Int64)
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IM
import qualified Data.List as L
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
import Data.STRef
import Data.Set (Set)
import qualified Data.Set as S
import System.IO
import Text.Read
--- DEBUGGING
#define DEBUG(x) dump di "x" x
dump di str a
  | "demo.hs" `L.isSuffixOf` __FILE__ =
    modifySTRef' di (L.insert (str, a)) >> return Nothing
  | otherwise = return Nothing

printDump lst
  | "demo.hs" `L.isSuffixOf` __FILE__ = forM_ lst print >> return Nothing
  | otherwise = return Nothing

readNumList :: (Num a, Read a) => IO [a]
readNumList = map read . words <$> getLine

readNum :: (Num a, Read a) => IO a
readNum = read <$> getLine

readNumListLn :: (Num a, Read a) => Int -> IO [a]
readNumListLn n = doGetList n []
  where
    doGetList 0 l = return l
    doGetList n l = do
      i <- readNum
      doGetList (n - 1) (l ++ [i])

-- solve :: STRef s [([Char], Int)] -> Int -> Int -> Int -> Int -> Int -> ST s [Int]
solve di n s = do
  let zeros = foldr (\c cnt -> if c == 'z' then cnt+1 else cnt) 0 s
  let ones = foldr (\c cnt -> if c == 'n' then cnt+1 else cnt) 0 s
  --forM_ nums compute
  let ans = (zeros, ones)
  -- solution
  return ans

solveN 0 = return ()
solveN n = do
  n <- readNum :: IO Int
  s <- getLine
  let computation =
        runST $ do
          let dubeg_info =
                [] :: (Num a) =>
                        [(String, a)]
          --- list of tuples (string value)
          di <- newSTRef dubeg_info
          ans <- solve di n s
          tmp <- readSTRef di
          let lst = (ans, tmp)
          readSTRef =<< newSTRef lst
  -- get solution
  let (z, o) = fst computation
  let debug_info = snd computation
  printDump debug_info
  -- print result
  forM_ [1..o] (\_ -> putStr "1 ")
  forM_ [1..z] (\_ -> putStr "0 ")
  putStrLn ""
  -- putStrLn $ show n ++ " " ++ show p

-- main :: IO ()
main = do
  -- t <- readNum :: IO Int
  solveN 1

import Data.List
import Data.Maybe

solve' eo n zr =
   let ones = min n eo
       zeros = min (eo - ones) zr
   in intersperse ' ' $ replicate ones '1' ++ replicate zeros '0' ++ []

var xs x = let a = lookup x xs in if isJust a then fromJust a else 0

solve xs =
 let bs =  map (\x -> (head x, length x)) $ group $ sort xs
     [z,e,r,o,n]  = map (var bs) "zeron"
 in if  min z r /= 0 && n == 0 then solve' 1 0 1 else  solve' (min e o) n (min z r)

main =  do
   getLine
   a <- getLine
   putStrLn $ solve a

import Data.List
import Data.Maybe

solve' eo n zr =
   let ones = min n eo
       zeros = min (eo - ones) zr
   in intersperse ' ' $ replicate ones '1' ++ replicate zeros '0' ++ []

var xs x = let a = lookup x xs in if isJust a then fromJust a else 0

solve xs =
 let bs =  map (\x -> (head x, length x)) $ group $ sort xs
     [z,e,r,o,n]  = map (var bs) "zeron"
 in if  min z r /= 0 && n == 0 then solve' 1 0 1 else  solve' (min e o) n (min z r)

main =  do
   getLine
   a <- getLine
   print $ solve a


International Abbreviation Olympiad takes place annually starting from 1989. Each year the competition receives an abbreviation of form IAO'y, where y stands for some number of consequent last digits of the current year. Organizers always pick an abbreviation with non-empty string y that has never been used before. Among all such valid abbreviations they choose the shortest one and announce it to be the abbreviation of this year's competition.For example, the first three Olympiads (years 1989, 1990 and 1991, respectively) received the abbreviations IAO'9, IAO'0 and IAO'1, while the competition in 2015 received an abbreviation IAO'15, as IAO'5 has been already used in 1995.You are given a list of abbreviations. For each of them determine the year it stands for.

The first line of the input contains a single integer n (1 ≤ n ≤ 1000) — the number of abbreviations to process.  Then n lines follow, each containing a single abbreviation. It's guaranteed that each abbreviation contains at most nine digits.

For each abbreviation given in the input, find the year of the corresponding Olympiad.

import Control.Monad

yearStart = 1989
yearBasePairs = take 10 $ iterate f (yearStart, 10) where
  f (year, base) = (year + base, base * 10)

suffixToYear suffix = let
  (keyYear, base) = yearBasePairs !! (length suffix - 1)
  in keyYear + (mod (read suffix - keyYear) base)

main = do
  n <- return . read =<< getLine :: IO Int
  forM_ [1..n] $ \_ -> do
    suffix <- return . drop 4 =<< getLine
    print $ suffixToYear suffix

main = getLine >> fmap lines getContents >>= putStrLn . unlines . map (show . solve . drop 4)

solve s = result
  where
    start = 1989 + sum (map (10^) [1 .. length s - 1])
    p10 = 10 ^ length s
    result = start + (read s - start) `mod` p10

main = getLine >> fmap lines getContents >>= putStrLn . unlines . map (show . solve . drop 4)

solve s = start + (read s - start) `mod` (10^n)
  where
    n = length s
    start = 1989 + sum (map (10^) [1 .. n-1])

main = getLine >> fmap lines getContents >>= putStr . unlines . map (show . solve . drop 4)

solve s = start + (read s - start) `mod` (10^n)
  where
    n = length s
    start = 1989 + sum (map (10^) [1 .. n-1])

import Control.Monad

yearStart = 1989
yearBasePairs = take 10 $ iterate f (yearStart, 10) where
  f (year, base) = (year + base, base * 10)

suffixToYear suffix = let
  (keyYear, base) = head $ dropWhile ((<= suffix) . snd) $ yearBasePairs
  in keyYear + (mod (suffix - keyYear) base)

main = do
  n <- return . read =<< getLine :: IO Int
  forM_ [1..n] $ \_ -> do
    suffix <- return . read . drop 4 =<< getLine :: IO Int
    print $ suffixToYear suffix

main = do
    _ <- getLine
    ss <- fmap lines getContents
    let inputs = map (drop 4) ss
        res = map solve inputs
    putStrLn . unlines . map show $ res

solve s = result
  where
    start = [1989, 1999, 2099, 3099, 13098, 113098, 1113098, 11113098, 111113098] !! (length s - 1)
    p10 = 10 ^ length s
    result = start + (read s - start) `mod` p10


Heidi is a statistician to the core, and she likes to study the evolution of marmot populations in each of V (1 ≤ V ≤ 100) villages! So it comes that every spring, when Heidi sees the first snowdrops sprout in the meadows around her barn, she impatiently dons her snowshoes and sets out to the Alps, to welcome her friends the marmots to a new season of thrilling adventures.Arriving in a village, Heidi asks each and every marmot she comes across for the number of inhabitants of that village. This year, the marmots decide to play an April Fools' joke on Heidi. Instead of consistently providing the exact number of inhabitants P (10 ≤ P ≤ 1000) of the village, they respond with a random non-negative integer k, drawn from one of two types of probability distributions:  Poisson (d'avril) distribution: the probability of getting an answer k is  for k = 0, 1, 2, 3, ...,  Uniform distribution: the probability of getting an answer k is  for k = 0, 1, 2, ..., 2P. Heidi collects exactly 250 answers per village. Every village follows either the Poisson or the uniform distribution. Heidi cannot tell marmots apart, so she may query some marmots several times, and each time the marmot will answer with a new number drawn from the village's distribution.Can you help Heidi to find out whether a village follows a Poisson or a uniform distribution?

The first line of input will contain the number of villages V (1 ≤ V ≤ 100). The following V lines each describe one village. The description of each village consists of 250 space-separated integers k, drawn from one of the above distributions.

Output one line per village, in the same order as provided in the input. The village's line shall state poisson if the village's distribution is of the Poisson type, and uniform if the answer came from a uniform distribution.

NoteThe full example input is visually represented below, along with the probability distribution function it was drawn from (the y-axis is labeled by its values multiplied by 250).

-- Codeforces 802D

-- MLP

{-# OPTIONS_GHC -O2 #-}
{-# OPTIONS_GHC -funfolding-use-threshold=16 #-}
{-# OPTIONS_GHC -fexcess-precision #-}
{-# OPTIONS_GHC -feager-blackholing #-}
{-# OPTIONS_GHC -funbox-strict-fields #-}
{-# OPTIONS_GHC -fdicts-strict #-}
{-# OPTIONS_GHC -optc-O3 #-}
{-# OPTIONS_GHC -optc-ffast-math #-}

import Control.Applicative
import Control.Monad
import Data.List
import Data.Maybe
import qualified Data.ByteString.Char8 as BC

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

main :: IO ()
main = do
    t <- read <$> getLine :: IO Int
    forM_ [1..t] $ \_ -> do
        xs <- readInts
        putStrLn $ go xs
  where
    go :: [Int] -> String
    go xs = let p = fromIntegral (sum xs) / genericLength xs -- estimate p
                puniform = sum . map (uniform p) $ xs
                ppoisson = sum . map (poisson p) $ xs
             in if puniform > ppoisson
                   then "uniform"
                   else "poisson"

    uniform p _ = - log (2 * p + 1)
    poisson p k = fromIntegral k * log p - p - logfact !! k

    logfact :: [Double]
    logfact = scanl (\acc x -> acc + log x) 0 [1..]


There are n students living in the campus. Every morning all students wake up at the same time and go to wash. There are m rooms with wash basins. The i-th of these rooms contains ai wash basins. Every student independently select one the rooms with equal probability and goes to it. After all students selected their rooms, students in each room divide into queues by the number of wash basins so that the size of the largest queue is the least possible. Calculate the expected value of the size of the largest queue among all rooms.

The first line contains two positive integers n and m (1 ≤ n, m ≤ 50) — the amount of students and the amount of rooms. The second line contains m integers a1, a2, ... , am (1 ≤ ai ≤ 50). ai means the amount of wash basins in the i-th room.

Output single number: the expected value of the size of the largest queue. Your answer must have an absolute or relative error less than 10 - 9.

import Data.Array

choose :: Int -> Int -> Double
choose _ 0 = 1
choose n k = choose (n-1) (k-1) * (fromIntegral n) / (fromIntegral k)

pow :: Int -> Int -> Double
pow x y = (fromIntegral x) ** (fromIntegral y)

divup :: Int -> Int -> Int
divup x y = (x + y - 1) `div` y

solve :: [Int] -> Int -> Double
solve as n = d ! (m, n, 0)
	where
		m = length as
		d = array ((1, 0, 0), (m, n, 50)) [((mm, nn, gg), solve' mm nn gg) | mm <- [1..m], nn <- [0..n], gg <- [0..50]]
		solve' :: Int -> Int -> Int -> Double
		solve' 1 nn gg = fromIntegral $ max gg $ divup nn (last as)
		solve' mm nn gg = sum [(p i) * (d ! (mm-1, nn-i, max gg (divup i (as!!(m-mm))))) | i <- [0..nn]]
			where
				p i = (choose nn i) * (pow (mm-1) (nn-i)) / (pow mm nn)

main = do
	-- n:m:a <- C.hGetContents stdin >>= return . map (fst . fromJust . C.readInt) . C.words
	n:m:_ <- getLine >>= return . map read . words :: IO [Int]
	a <- getLine >>= return . map read . words :: IO [Int]
	putStrLn $ show $ solve a n

import Data.Array
import Data.List
import Data.Graph
import Data.Tree
import Control.Applicative
import Text.Printf
import Data.Int

binom = array ((0, 0), (51, 51)) [((i, j), f i j) | i <- [0..51], j <- [0..i]]
    where f i j | i == 0 = 1.0
                | j == i = 1.0
                | j == 0 = 1.0
                | otherwise = binom ! (i-1, j-1) + binom ! (i-1, j)
solve n m a k = d ! (n, m)
    where d = array ((0, 1), (n, m)) [((i, j), f i j) | i <- [0..n], j <- [1..m]]
          f :: Int32 -> Int32 -> Double
          f i 1 | i > k*a!1 = 0.0
                | otherwise = 1.0
          f i j = sum [binom ! (i,h) * p**(fromIntegral h) * q**(fromIntegral $ i-h) * d ! (i-h, j-1) | h <- [0..t]]
                  where t = min i (a!j*k)
                        p = (1.0::Double) / fromIntegral j
                        q = 1.0 - p
ints = map read . words <$> getLine
main = do
    [n, m] <- ints
    a <- listArray (1, m) <$> ints
    let p = listArray (0, n) $ 0:[solve n m a k | k <- [1..n]]
    let res = sum [fromIntegral k * (p!k - p ! (k-1)) | k <- [1..n]]
    printf "%.11f" (res::Double)


Please note the non-standard memory limit.There are $$$n$$$ problems numbered with integers from $$$1$$$ to $$$n$$$. $$$i$$$-th problem has the complexity $$$c_i = 2^i$$$, tag $$$tag_i$$$ and score $$$s_i$$$.After solving the problem $$$i$$$ it's allowed to solve problem $$$j$$$ if and only if $$$\text{IQ} < |c_i - c_j|$$$ and $$$tag_i \neq tag_j$$$. After solving it your $$$\text{IQ}$$$ changes and becomes $$$\text{IQ} = |c_i - c_j|$$$ and you gain $$$|s_i - s_j|$$$ points.Any problem can be the first. You can solve problems in any order and as many times as you want.Initially your $$$\text{IQ} = 0$$$. Find the maximum number of points that can be earned.

The first line contains a single integer $$$t$$$ $$$(1 \le t \le 100)$$$  — the number of test cases.  The first line of each test case contains an integer $$$n$$$ $$$(1 \le n \le 5000)$$$  — the number of problems. The second line of each test case contains $$$n$$$ integers $$$tag_1, tag_2, \ldots, tag_n$$$ $$$(1 \le tag_i \le n)$$$  — tags of the problems. The third line of each test case contains $$$n$$$ integers $$$s_1, s_2, \ldots, s_n$$$ $$$(1 \le s_i \le 10^9)$$$  — scores of the problems. It's guaranteed that sum of $$$n$$$ over all test cases does not exceed $$$5000$$$.

For each test case print a single integer  — the maximum number of points that can be earned.

NoteIn the first test case optimal sequence of solving problems is as follows:   $$$1 \rightarrow 2$$$, after that total score is $$$5$$$ and $$$\text{IQ} = 2$$$  $$$2 \rightarrow 3$$$, after that total score is $$$10$$$ and $$$\text{IQ} = 4$$$  $$$3 \rightarrow 1$$$, after that total score is $$$20$$$ and $$$\text{IQ} = 6$$$  $$$1 \rightarrow 4$$$, after that total score is $$$35$$$ and $$$\text{IQ} = 14$$$ In the second test case optimal sequence of solving problems is as follows:   $$$1 \rightarrow 2$$$, after that total score is $$$5$$$ and $$$\text{IQ} = 2$$$  $$$2 \rightarrow 3$$$, after that total score is $$$10$$$ and $$$\text{IQ} = 4$$$  $$$3 \rightarrow 4$$$, after that total score is $$$15$$$ and $$$\text{IQ} = 8$$$  $$$4 \rightarrow 1$$$, after that total score is $$$35$$$ and $$$\text{IQ} = 14$$$ In the third test case optimal sequence of solving problems is as follows:   $$$1 \rightarrow 3$$$, after that total score is $$$17$$$ and $$$\text{IQ} = 6$$$  $$$3 \rightarrow 4$$$, after that total score is $$$35$$$ and $$$\text{IQ} = 8$$$  $$$4 \rightarrow 2$$$, after that total score is $$$42$$$ and $$$\text{IQ} = 12$$$

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.MArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (foldl')
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read
import GHC.Int (Int64)

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

getNums :: IO [Int]
getNums = map ((fst . fromJust) . B.readInt) . B.split ' ' <$> B.getLine

showNums :: [Int] -> IO ()
showNums xs = putStrLn $ unwords $ map show xs

main :: IO ()
main = do
  t <- getNum
  forM_ [1 .. t] handleCase

handleCase :: Int -> IO ()
handleCase c = do
  n <- getNum
  tags <- getNums
  ss <- getNums
  print $ solve n tags ss

type Arr = UArray Int Int

solve :: Int -> [Int] -> [Int] -> Int64
solve n tags ss = maximum $ 0 : elems dpN
  where
    tagArr = listArray (1, n) tags :: Arr
    sArr = listArray (1, n) ss :: Arr

    -- validEdge (i, j) = i > j && ((tagMap ! i) /= (tagMap ! j))
    -- !es' = liftM2 (,) [1..n] [n,n-1..1]
    -- !es = filter validEdge es'

    !es = do
      j <- [2 .. n]
      i <- [j -1, j -2 .. 1]
      guard ((tagArr ! i) /= (tagArr ! j))
      return (i, j)

    dpN :: UArray Int Int64
    dpN = runSTUArray $ do
      ar <- newArray (1, n) 0
      forM_ es $ \(i, j) -> do
        dpI <- readArray ar i
        dpJ <- readArray ar j
        let p = abs $ (sArr ! i) - (sArr ! j)
        let dpI' = max dpI (dpJ + fromIntegral p)
        let dpJ' = max dpJ (dpI + fromIntegral p)
        writeArray ar j dpJ'
        writeArray ar i dpI'
      return ar

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import Data.Array.Unboxed
import Data.Array.ST
import Data.Array.MArray
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (foldl')
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read

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

getNums :: IO [Int]
getNums = map ((fst . fromJust) . B.readInt) . B.split ' ' <$> B.getLine

showNums :: [Int] -> IO ()
showNums xs = putStrLn $ unwords $ map show xs

main :: IO ()
main = do
  t <- getNum
  forM_ [1 .. t] handleCase

handleCase :: Int -> IO ()
handleCase c = do
  n <- getNum
  tags <- getNums
  ss <- getNums
  print $ solve n tags ss

type Arr = UArray Int Int

solve :: Int -> [Int] -> [Int] -> Int
solve n tags ss = maximum $ 0 : elems dpN
  where
    tagArr = listArray (1, n) tags :: Arr
    sArr = listArray (1, n) ss :: Arr

    -- validEdge (i, j) = i > j && ((tagMap ! i) /= (tagMap ! j))
    -- !es' = liftM2 (,) [1..n] [n,n-1..1]
    -- !es = filter validEdge es'

    !es = do
      j <- [2 .. n]
      i <- [j -1, j -2 .. 1]
      guard ((tagArr ! i) /= (tagArr ! j))
      return (i, j)

    dpN :: UArray Int Int
    dpN = runSTUArray $ do
      ar <- newArray (1, n) 0
      forM_ es $ \(i, j) -> do
        dpI <- readArray ar i
        dpJ <- readArray ar j
        let p = abs $ (sArr ! i) - (sArr ! j)
        let dpI' = max dpI (dpJ + p)
        let dpJ' = max dpJ (dpI + p)
        writeArray ar j dpJ'
        writeArray ar i dpI'
      return ar

{-# LANGUAGE BangPatterns #-}

import Control.Monad
import qualified Data.ByteString.Char8 as B
import Data.Char
import Data.List (foldl')
import Data.IntMap ((!))
import qualified Data.Array.Unboxed as A
import qualified Data.IntMap.Strict as M
-- import Debug.Trace

import Data.Maybe (fromJust)
import System.IO
import Text.Read

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

getNums :: IO [Int]
getNums = map ((fst . fromJust) . B.readInt) . B.split ' ' <$> B.getLine

showNums :: [Int] -> IO ()
showNums xs = putStrLn $ unwords $ map show xs

main :: IO ()
main = do
  t <- getNum
  forM_ [1 .. t] handleCase

handleCase :: Int -> IO ()
handleCase c = do
  n <- getNum
  tags <- getNums
  ss <- getNums
  print $ solve n tags ss

solve :: Int -> [Int] -> [Int] -> Int
solve n tags ss = maximum $ 0 : M.elems dp
  where
    tagMap = M.fromList $ zip [1..n] tags
    sMap = M.fromList $ zip [1..n] ss

    -- validEdge (i, j) = i > j && ((tagMap ! i) /= (tagMap ! j))
    -- !es' = liftM2 (,) [1..n] [n,n-1..1]
    -- !es = filter validEdge es'

    es = do
      j <- [2..n]
      i <- [j-1,j-2..1]
      -- guard ((tagMap ! i) /= (tagMap ! j))
      return (i, j)

    dpStep :: M.IntMap Int -> (Int, Int) -> M.IntMap Int
    dpStep !dp (i, j) = newDP
      where
        !newDP = M.insert j dpJ' $ M.insert i dpI' dp
        !p = abs $ (sMap ! i) - (sMap ! j)
        !dpI = M.findWithDefault 0 i dp
        !dpJ = M.findWithDefault 0 j dp
        !dpI' = max dpI (dpJ + p)
        !dpJ' = max dpJ (dpI + p)

    dp = foldl' dpStep M.empty es