— Oh my sweet Beaverette, would you fancy a walk along a wonderful woodland belt with me?   — Of course, my Smart Beaver! Let us enjoy the splendid view together. How about Friday night? At this point the Smart Beaver got rushing. Everything should be perfect by Friday, so he needed to prepare the belt to the upcoming walk. He needed to cut down several trees.Let's consider the woodland belt as a sequence of trees. Each tree i is described by the esthetic appeal ai — some trees are very esthetically pleasing, others are 'so-so', and some trees are positively ugly!The Smart Beaver calculated that he needed the following effects to win the Beaverette's heart:   The first objective is to please the Beaverette: the sum of esthetic appeal of the remaining trees must be maximum possible;  the second objective is to surprise the Beaverette: the esthetic appeal of the first and the last trees in the resulting belt must be the same;  and of course, the walk should be successful: there must be at least two trees in the woodland belt left. Now help the Smart Beaver! Which trees does he need to cut down to win the Beaverette's heart?

The first line contains a single integer n — the initial number of trees in the woodland belt, 2 ≤ n. The second line contains space-separated integers ai — the esthetic appeals of each tree. All esthetic appeals do not exceed 109 in their absolute value.   to get 30 points, you need to solve the problem with constraints: n ≤ 100 (subproblem A1);  to get 100 points, you need to solve the problem with constraints: n ≤ 3·105 (subproblems A1+A2).

In the first line print two integers — the total esthetic appeal of the woodland belt after the Smart Beaver's intervention and the number of the cut down trees k. In the next line print k integers — the numbers of the trees the Beaver needs to cut down. Assume that the trees are numbered from 1 to n from left to right. If there are multiple solutions, print any of them. It is guaranteed that at least two trees have equal esthetic appeal.

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import Data.Int
import Data.Ix
import qualified Data.IntMap as IM
import Data.List
import Data.Ord

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

newtype BIT = BIT (UArray Int Int64)

query :: Int -> BIT -> Int64
query key (BIT bit) = go key 0
  where
    go !i !res
      | i >= 0 = go ((i .&. (i+1)) - 1) $ res + unsafeAt bit i
      | otherwise = res

main = do
  n <- readLn
  xs <- map read.words <$> getLine
  let (res, cut) = solve n xs
  putStrLn $ shows res " " ++ show (length cut)
  putStrLn.unwords $ map show cut

data LR = L {-# UNPACK #-} !Int
        | LR {-# UNPACK #-} !Int {-# UNPACK #-} !Int

solve :: Int -> [Int64] -> (Int64, [Int])
solve n xs = (calc (l,r), [1..l]++[i+1|i<-[l+1..r-1],unsafeAt arr i<0]++[r+2..n])
   where
     arr = listArray (0,n-1) xs :: UArray Int Int64

     bit = runST $ do
       bit <- newArray (0, n-1) 0 :: ST s (STUArray s Int Int64)
       let add key x = do
             let go !i = when (i < n) $ do
                   unsafeModify bit i (x+)
                   go $ i .|. (i + 1)
             when (x>0) $ go key
       let go !i (x:xs)=add i x>>go(i+1)xs
           go _ _ = return ()
       go 0 xs
       BIT <$> unsafeFreeze bit

     findLRs !i im (x:xs) = case IM.lookup x im of
                              Nothing       -> findLRs (i+1) (IM.insert x (L i) im) xs
                              Just (L l)    -> findLRs (i+1) (IM.insert x (LR l i) im) xs
                              Just (LR l _) -> findLRs (i+1) (IM.insert x (LR l i) im) xs
     findLRs _ im _ = [(l, r) | LR l r <- IM.elems im]

     calc (l, r)
       | l+1 > r-1 = unsafeAt arr l + unsafeAt arr r
       | otherwise = unsafeAt arr l + unsafeAt arr r + query (r-1) bit - query l bit

     (l, r) = maximumBy (comparing calc) $ findLRs 0 IM.empty $ map fromIntegral xs

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Ix
import qualified Data.IntMap as IM
import Data.List
import Data.Ord

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

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  let (res, len, cut) = solve n $ map fromIntegral xs
  putStrLn $ shows res " " ++ show len
  putStrLn.unwords $ map show cut

solve :: Int -> [Int64] -> (Int64, Int, [Int])
solve n xs = (calc (l, r), k , cut)
   where
     (l, r) = snd $ maximum [(calc lr, lr) | lr <- findLRs 0 IM.empty $ map fromIntegral xs]
     cut = [1..l] ++ [i+1|i<-[l+1..r-1], unsafeAt arr i<0] ++ [r+2..n]
     k = length cut

     arr      = listArray (0,n-1) xs                            :: UArray Int Int64
     sumArray = listArray (0,n-1) $ scanl1 (+) $ map (max 0) xs :: UArray Int Int64

     findLRs !i !im (x:xs) = case IM.lookup x im of
                              Nothing      -> findLRs (i+1) (IM.insert x [i] im) xs
                              Just (l:_)   -> findLRs (i+1) (IM.insert x [l,i] im) xs
     findLRs !_ !im _ = [(l, r) | [l,r] <- IM.elems im]

     calc (l, r)
       | l+1 > r-1 = unsafeAt arr l + unsafeAt arr r
       | otherwise = unsafeAt arr l + unsafeAt arr r + unsafeAt sumArray (r-1)  - unsafeAt sumArray l

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Ix
import qualified Data.IntMap as IM
import Data.List
import Data.Ord

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

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  let (res, len, cut) = solve n $ map fromIntegral xs
  putStrLn $ shows res " " ++ show len
  putStrLn.unwords $ map show cut

solve :: Int -> [Int64] -> (Int64, Int, [Int])
solve n xs = (calc (l, r), k , concat cutss)
   where
     (l, r) = snd $ maximum [(calc lr, lr) | lr <- findLRs 0 IM.empty $ map fromIntegral xs]
     cutss = [[1..l], [i+1|i<-[l+1..r-1],unsafeAt arr i<0], [r+2..n]]
     k = sum $ map length cutss

     arr      = listArray (0,n-1) xs                            :: UArray Int Int64
     sumArray = listArray (0,n-1) $ scanl1 (+) $ map (max 0) xs :: UArray Int Int64

     findLRs !i !im (x:xs) = case IM.lookup x im of
                              Nothing      -> findLRs (i+1) (IM.insert x [i] im) xs
                              Just (l:_)   -> findLRs (i+1) (IM.insert x [l,i] im) xs
     findLRs !_ !im _ = [(l, r) | [l,r] <- IM.elems im]

     calc (l, r)
       | l+1 > r-1 = unsafeAt arr l + unsafeAt arr r
       | otherwise = unsafeAt arr l + unsafeAt arr r + unsafeAt sumArray (r-1)  - unsafeAt sumArray l

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

import Control.Applicative
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Bits
import qualified Data.ByteString.Char8 as B
import Data.Int
import Data.Ix
import qualified Data.IntMap as IM
import Data.List
import Data.Ord

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

unsafeModify :: (MArray a e m, Ix i) => a i e -> Int -> (e -> e) -> m ()
unsafeModify a i f=unsafeRead a i>>=unsafeWrite a i.f
{-# INLINE unsafeModify #-}

main = do
  n <- readLn
  xs <- map readInt.B.words <$> B.getLine
  let (res, len, cut) = solve n $ map fromIntegral xs
  putStrLn $ shows res " " ++ show len
  putStrLn.unwords $ map show cut

solve :: Int -> [Int64] -> (Int64, Int, [Int])
solve n xs = (calc (l, r), k , cut)
   where
     (l, r) = snd $ maximum [(calc lr, lr) | lr <- findLRs 0 IM.empty $ map fromIntegral xs]
     cut = [1..l]++[i+1|i<-[l+1..r-1],unsafeAt arr i<0]++[r+2..n]
     k = length cut

     arr      = listArray (0,n-1) xs                            :: UArray Int Int64
     sumArray = listArray (0,n-1) $ scanl1 (+) $ map (max 0) xs :: UArray Int Int64

     findLRs !i !im (x:xs) = case IM.lookup x im of
                              Nothing      -> findLRs (i+1) (IM.insert x [i] im) xs
                              Just (l:_)   -> findLRs (i+1) (IM.insert x [l,i] im) xs
     findLRs !_ !im _ = [(l, r) | [l,r] <- IM.elems im]

     calc (l, r)
       | l+1 > r-1 = unsafeAt arr l + unsafeAt arr r
       | otherwise = unsafeAt arr l + unsafeAt arr r + unsafeAt sumArray (r-1)  - unsafeAt sumArray l


Every person likes prime numbers. Alice is a person, thus she also shares the love for them. Bob wanted to give her an affectionate gift but couldn't think of anything inventive. Hence, he will be giving her a graph. How original, Bob! Alice will surely be thrilled!When building the graph, he needs four conditions to be satisfied:   It must be a simple undirected graph, i.e. without multiple (parallel) edges and self-loops.  The number of vertices must be exactly $$$n$$$ — a number he selected. This number is not necessarily prime.  The total number of edges must be prime.  The degree (i.e. the number of edges connected to the vertex) of each vertex must be prime. Below is an example for $$$n = 4$$$. The first graph (left one) is invalid as the degree of vertex $$$2$$$ (and $$$4$$$) equals to $$$1$$$, which is not prime. The second graph (middle one) is invalid as the total number of edges is $$$4$$$, which is not a prime number. The third graph (right one) is a valid answer for $$$n = 4$$$.   Note that the graph can be disconnected.Please help Bob to find any such graph!

The input consists of a single integer $$$n$$$ ($$$3 \leq n \leq 1\,000$$$) — the number of vertices.

If there is no graph satisfying the conditions, print a single line containing the integer $$$-1$$$. Otherwise, first print a line containing a prime number $$$m$$$ ($$$2 \leq m \leq \frac{n(n-1)}{2}$$$) — the number of edges in the graph. Then, print $$$m$$$ lines, the $$$i$$$-th of which containing two integers $$$u_i$$$, $$$v_i$$$ ($$$1 \leq u_i, v_i \leq n$$$) — meaning that there is an edge between vertices $$$u_i$$$ and $$$v_i$$$. The degree of each vertex must be prime. There must be no multiple (parallel) edges or self-loops. If there are multiple solutions, you may print any of them. Note that the graph can be disconnected.

NoteThe first example was described in the statement.In the second example, the degrees of vertices are $$$[7, 5, 2, 2, 3, 2, 2, 3]$$$. Each of these numbers is prime. Additionally, the number of edges, $$$13$$$, is also a prime number, hence both conditions are satisfied.

{-# OPTIONS_GHC -O2 #-}

import Data.Char (ord)

parseInt = foldl (\acc c -> acc * 10 + ord c - 48) 0

isPrime n = all (\p -> n `mod` p /= 0) [2 .. m]
  where
    m = head . dropWhile (\x -> x * x < n) $ [2 ..]

main = do
  n <- fmap parseInt getLine
  let m = head . dropWhile (not . isPrime) $ [n ..]
      circle = [[i, i `mod` n + 1] | i <- [1 .. n]]
      extra = take (m - n) [[i, i + 2] | i <- [1 .. n - 2], even ((i - 1) `div` 2)]
  print (length circle + length extra)
  mapM_ (putStrLn . unwords . fmap show) (circle ++ extra)


After a terrifying forest fire in Berland a forest rebirth program was carried out. Due to it N rows with M trees each were planted and the rows were so neat that one could map it on a system of coordinates so that the j-th tree in the i-th row would have the coordinates of (i, j). However a terrible thing happened and the young forest caught fire. Now we must find the coordinates of the tree that will catch fire last to plan evacuation.The burning began in K points simultaneously, which means that initially K trees started to burn. Every minute the fire gets from the burning trees to the ones that aren’t burning and that the distance from them to the nearest burning tree equals to 1.Find the tree that will be the last to start burning. If there are several such trees, output any.

The first input line contains two integers N, M (1 ≤ N, M ≤ 2000) — the size of the forest. The trees were planted in all points of the (x, y) (1 ≤ x ≤ N, 1 ≤ y ≤ M) type, x and y are integers. The second line contains an integer K (1 ≤ K ≤ 10) — amount of trees, burning in the beginning.  The third line contains K pairs of integers: x1, y1, x2, y2, ..., xk, yk (1 ≤ xi ≤ N, 1 ≤ yi ≤ M) — coordinates of the points from which the fire started. It is guaranteed that no two points coincide.

Output a line with two space-separated integers x and y — coordinates of the tree that will be the last one to start burning. If there are several such trees, output any.

import Ix

calc :: (Int, Int) -> (Int, Int) -> Int
calc x y = (abs fstdiff) + (abs snddiff)
    where fstdiff = (fst x) - (fst y)
          snddiff = (snd x) - (snd y)

burnMinute :: [(Int, Int)] -> (Int, Int) -> Int
burnMinute points target = minimum $ map ( `calc` target) points

calcMaxMinute :: [(Int, Int)] -> [(Int, Int)] -> Int
calcMaxMinute points area = maximum $ map (burnMinute points) area

calcAns :: [(Int, Int)] -> [(Int, Int)] -> Int-> (Int, Int) -> (Int, Int)
calcAns points (x : xs) s t | burnMinute points x >= s = calcAns points xs (burnMinute points x) x
                            | otherwise = calcAns points xs s t

calcAns _ [] _ t = t

makepoints :: String -> [(Int, Int)]
makepoints str = f $ words str
    where f [] = []
          f (x : y : xs) = ((read x) :: Int, (read y) :: Int) : f xs

printAns :: (Int, Int) -> String
printAns (a, b) = show a ++ " " ++ show b

main :: IO ()
main = do
       str <- readFile "input.txt"
       let x = (read $ head $ words $ head $ lines str) :: Int
       let y = (read $ head $ tail $ words $ head $ lines str) :: Int
       let points = makepoints $ head $ tail $ tail $ lines str
       let ans = calcAns points ((range ((1, 1), (x, y))) :: [(Int, Int)]) 0 (1, 1)
       writeFile "output.txt" $ printAns ans

{-# LANGUAGE ForeignFunctionInterface #-}

import qualified Data.ByteString.Lazy.Char8 as LB
import qualified Data.ByteString as SB
import Data.ByteString.Internal (inlinePerformIO)
import Foreign.C.String (CString)
import Foreign.C (CDouble)
import Data.Maybe
import Data.List (maximumBy, minimum, foldl')
import Data.Array
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Debug.Trace

foreign import ccall unsafe "stdlib.h atof" c_atof :: CString -> IO Double
unsafeReadDouble = inlinePerformIO . flip SB.useAsCString c_atof
{-# INLINE unsafeReadDouble #-}
readDouble = unsafeReadDouble . SB.concat . LB.toChunks
readInt = fst . fromJust . LB.readInt

debug :: Show a => a -> b -> b
debug = trace . show
--debug _ = id

main = readFile "input.txt" >>= (writeFile "output.txt" . output . solve . parse . lines)

output (x,y) = show x ++ " " ++ show y

parse :: [String] -> (Int, Int, [(Int, Int)])
parse [nm, sk, pts] =
  let [n, m] = map read . words $ nm
      k = read sk :: Int
      lst = map read . words $ pts
      trees = [ (lst !! i, lst !! (i+1)) | i <- [0, 2 .. length lst - 1]]
  in (n, m, trees)

solve (n, m, start) =
  let allTrees = [(x, y, d x y) | x <- [1..n], y <- [1..m] ]
      (x, y, _) = maximumBy (\ (_, _, d) (_, _, e) -> compare d e) allTrees
      d x y = minimum [abs(i-x) + abs(j-y) | (i, j) <- start ]
  in (x,y)


This is an interactive problem.Imur Ishakov decided to organize a club for people who love to play the famous game «The hat». The club was visited by n students, where n is even. Imur arranged them all in a circle and held a draw to break the students in pairs, but something went wrong. The participants are numbered so that participant i and participant i + 1 (1 ≤ i ≤ n - 1) are adjacent, as well as participant n and participant 1. Each student was given a piece of paper with a number in such a way, that for every two adjacent students, these numbers differ exactly by one. The plan was to form students with the same numbers in a pair, but it turned out that not all numbers appeared exactly twice.As you know, the most convenient is to explain the words to the partner when he is sitting exactly across you. Students with numbers i and  sit across each other. Imur is wondering if there are two people sitting across each other with the same numbers given. Help him to find such pair of people if it exists.You can ask questions of form «which number was received by student i?», and the goal is to determine whether the desired pair exists in no more than 60 questions.

At the beginning the even integer n (2 ≤ n ≤ 100 000) is given — the total number of students. You are allowed to ask no more than 60 questions.

To ask the question about the student i (1 ≤ i ≤ n), you should print «? i». Then from standard output you can read the number ai received by student i ( - 109 ≤ ai ≤ 109). When you find the desired pair, you should print «! i», where i is any student who belongs to the pair (1 ≤ i ≤ n). If you determined that such pair doesn't exist, you should output «! -1». In both cases you should immediately terminate the program. The query that contains your answer is not counted towards the limit of 60 queries. Please make sure to flush the standard output after each command. For example, in C++ use function fflush(stdout), in Java call System.out.flush(), in Pascal use flush(output) and stdout.flush() for Python language. Hacking Use the following format for hacking: In the first line, print one even integer n (2 ≤ n ≤ 100 000) — the total number of students. In the second line print n integers ai ( - 109 ≤ ai ≤ 109) separated by spaces, where ai is the number to give to i-th student. Any two adjacent elements, including n and 1, must differ by 1 or  - 1. The hacked solution will not have direct access to the sequence ai.

NoteInput-output in statements illustrates example interaction.In the first sample the selected sequence is 1, 2, 1, 2, 3, 4, 3, 2In the second sample the selection sequence is 1, 2, 3, 2, 1, 0.

import Data.Bool
import Data.List
import System.IO

type Bss = (Int, Int, Int, Int, Bool)

pairify :: [a] -> [(a, a)]
pairify (x:y:xs) = (x, y) : (pairify xs)
pairify [] = []

solve :: String -> String
solve input = output where
	(n : qs') = map read $ lines input
	m = n `div` 2
	query :: Int -> String
	query x = "? " ++ (show x) ++ "\n" ++ "? " ++ (show (x + m)) ++ "\n"
	answer :: Int -> String
	answer x = "! " ++ (show x) ++ "\n"
	(qm:qs) = map (signum . uncurry (-)) $ pairify qs'
	f :: Bss -> Int -> (Bss, String)
	f s@(l, r, bl, br, found) bm
	  | found = (s, "")
	  | br == 0 = ((l, r, bl, br, True), answer r)
	  | bl == bm = ((mi, r, bm, br, False), query (div (mi + r) 2))
	  | br == bm = ((l, mi, bl, bm, False), query (div (mi + l) 2))
	  | bm == 0 = ((l, r, bl, br, True), answer mi)
	  | r - l <= 1 && (not found) = (s, answer (-1))
	  | otherwise = (s, "")
	  where mi = div (l + r) 2
	output = if(rem n 4 == 0) then (concat $ (query m) : (query (div m 2)) : (snd $ mapAccumL f (0, m, negate qm, qm, False) qs)) else (answer (-1))

main :: IO ()
main = do
	hSetBuffering stdin LineBuffering
	hSetBuffering stdout LineBuffering
	interact solve


You are given a line of $$$n$$$ colored squares in a row, numbered from $$$1$$$ to $$$n$$$ from left to right. The $$$i$$$-th square initially has the color $$$c_i$$$.Let's say, that two squares $$$i$$$ and $$$j$$$ belong to the same connected component if $$$c_i = c_j$$$, and $$$c_i = c_k$$$ for all $$$k$$$ satisfying $$$i < k < j$$$. In other words, all squares on the segment from $$$i$$$ to $$$j$$$ should have the same color.For example, the line $$$[3, 3, 3]$$$ has $$$1$$$ connected component, while the line $$$[5, 2, 4, 4]$$$ has $$$3$$$ connected components.The game "flood fill" is played on the given line as follows:   At the start of the game you pick any starting square (this is not counted as a turn).  Then, in each game turn, change the color of the connected component containing the starting square to any other color. Find the minimum number of turns needed for the entire line to be changed into a single color.

The first line contains a single integer $$$n$$$ ($$$1 \le n \le 5000$$$) — the number of squares. The second line contains integers $$$c_1, c_2, \ldots, c_n$$$ ($$$1 \le c_i \le 5000$$$) — the initial colors of the squares.

Print a single integer — the minimum number of the turns needed.

NoteIn the first example, a possible way to achieve an optimal answer is to pick square with index $$$2$$$ as the starting square and then play as follows:  $$$[5, 2, 2, 1]$$$  $$$[5, 5, 5, 1]$$$  $$$[1, 1, 1, 1]$$$ In the second example, a possible way to achieve an optimal answer is to pick square with index $$$5$$$ as the starting square and then perform recoloring into colors $$$2, 3, 5, 4$$$ in that order.In the third example, the line already consists of one color only.

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

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

main :: IO ()
main = do
  getLine
  cs_ <- map head . group . unfoldr (BS.readInt . BS.dropWhile (<'!'))
        <$> BS.getLine
  let n = length cs_
      cs = A.listArray (0,n-1) cs_ :: UArray Int Int
  dp <- newIOUA_ ((-1,-1),(n,n)) :: IO (IOUArray (Int,Int) Int)
  forM_ [-1..n] $ \ !i -> do
    A.writeArray dp (-1,i) (0::Int)
    A.writeArray dp (i,n)  (0::Int)
  forM_ [0..n-1] $ \ !l ->
    forM_ [n-1,n-2..l] $ \ !r ->
      A.writeArray dp (l,r)
      =<< maximum <$> sequence
        (A.readArray dp (l-1, r) :
         A.readArray dp (l, r+1) :
         if cs A.! l == cs A.! r then [(1+) <$> A.readArray dp (l-1,r+1)]
           else [])
  anses <- map (subtract 1) <$> mapM (\i -> A.readArray dp (i,i)) [0..n-1]
  print $ n - 1 - maximum anses

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

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

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


Ilya lives in a beautiful city of Chordalsk.There are $$$n$$$ houses on the street Ilya lives, they are numerated from $$$1$$$ to $$$n$$$ from left to right; the distance between every two neighboring houses is equal to $$$1$$$ unit. The neighboring houses are $$$1$$$ and $$$2$$$, $$$2$$$ and $$$3$$$, ..., $$$n-1$$$ and $$$n$$$. The houses $$$n$$$ and $$$1$$$ are not neighboring.The houses are colored in colors $$$c_1, c_2, \ldots, c_n$$$ so that the $$$i$$$-th house is colored in the color $$$c_i$$$. Everyone knows that Chordalsk is not boring, so there are at least two houses colored in different colors.Ilya wants to select two houses $$$i$$$ and $$$j$$$ so that $$$1 \leq i < j \leq n$$$, and they have different colors: $$$c_i \neq c_j$$$. He will then walk from the house $$$i$$$ to the house $$$j$$$ the distance of $$$(j-i)$$$ units.Ilya loves long walks, so he wants to choose the houses so that the distance between them is the maximum possible.Help Ilya, find this maximum possible distance.

The first line contains a single integer $$$n$$$ ($$$3 \leq n \leq 300\,000$$$) — the number of cities on the street. The second line contains $$$n$$$ integers $$$c_1, c_2, \ldots, c_n$$$ ($$$1 \leq c_i \leq n$$$) — the colors of the houses. It is guaranteed that there is at least one pair of indices $$$i$$$ and $$$j$$$ so that $$$1 \leq i < j \leq n$$$ and $$$c_i \neq c_j$$$.

Print a single integer — the maximum possible distance Ilya can walk.

NoteIn the first example the optimal way is to walk from the first house to the last one, where Ilya can walk the distance of $$$5-1 = 4$$$ units.In the second example the optimal way is to either walk from the first house to the second or from the second to the third. Both these ways have the distance of $$$1$$$ unit.In the third example the optimal way is to walk from the third house to the last one, where Ilya can walk the distance of $$$7-3 = 4$$$ units.

import Data.List

solve :: [Int] -> Int
solve (n:xs)
  | head as == head bs = n - a - b + max a b - 1
  | otherwise = n - 1
  where
    as = head $ group xs
    bs = head $ reverse $ group xs
    a = length as
    b = length bs

tests :: [[Int]]
tests = [ [5, 1, 2, 3, 2, 3]
        , [3, 1, 2, 1]
        , [7, 1, 1, 3, 1, 1, 1, 1]
        ]

main = interact $ show . solve . map read . words

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

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

solve :: [Int] -> Int
solve xs
    | f /= l    = n - 1
    | otherwise = n - 1 - (min a b)
    where n = length xs
          f = head xs
          l = last xs
          a = length $ head $ group xs
          b = length $ last $ group xs

main :: IO ()
main = do
    _ <- readInt
    v <- readInts
    print $ solve v

import Control.Monad
import Data.List
import Data.Maybe
import Data.Char

import qualified Data.ByteString.Char8 as B
readInt = readLn :: IO Int
readInts = map ( fst . fromJust . B.readInt ) . B.words <$> B.getLine

solve :: [Int] -> Int
solve xs
    | a /= b    = (length xs) - 1
    | otherwise = (max (length (dropWhile (==b) xs)) (length (dropWhile (==a) ys))) - 1
        where a = head xs
              b = last xs
              ys = reverse xs

main :: IO ()
main = do
    _ <- readInt
    v <- readInts
    print $ solve v

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

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

ru, ri :: C.ByteString -> Int

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

f (x:xs) = length $ dropWhile (== x) $ reverse xs

solve :: [Int] -> Builder
solve (n:a) = intDec res <> char7 '\n'
  where
    b = take n a
    !res = max (f b) (f $ reverse b)

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

import Data.List

solve :: [Int] -> Int
solve xs
  | head as /= head bs = n - 1
  | otherwise = n - min (length as) (length bs)
  where
    as = head $ group xs
    bs = head $ reverse $ group xs
    n = length xs

tests :: [[Int]]
tests = [ [1, 2, 3, 2, 3]
        , [1, 2, 1]
        , [1, 1, 3, 1, 1, 1]
        ]

main = interact $ show . solve . map read . tail . words


Shichikuji is the new resident deity of the South Black Snail Temple. Her first job is as follows:There are $$$n$$$ new cities located in Prefecture X. Cities are numbered from $$$1$$$ to $$$n$$$. City $$$i$$$ is located $$$x_i$$$ km North of the shrine and $$$y_i$$$ km East of the shrine. It is possible that $$$(x_i, y_i) = (x_j, y_j)$$$ even when $$$i \ne j$$$.Shichikuji must provide electricity to each city either by building a power station in that city, or by making a connection between that city and another one that already has electricity. So the City has electricity if it has a power station in it or it is connected to a City which has electricity by a direct connection or via a chain of connections.     Building a power station in City $$$i$$$ will cost $$$c_i$$$ yen;     Making a connection between City $$$i$$$ and City $$$j$$$ will cost $$$k_i + k_j$$$ yen per km of wire used for the connection. However, wires can only go the cardinal directions (North, South, East, West). Wires can cross each other. Each wire must have both of its endpoints in some cities. If City $$$i$$$ and City $$$j$$$ are connected by a wire, the wire will go through any shortest path from City $$$i$$$ to City $$$j$$$. Thus, the length of the wire if City $$$i$$$ and City $$$j$$$ are connected is $$$|x_i - x_j| + |y_i - y_j|$$$ km. Shichikuji wants to do this job spending as little money as possible, since according to her, there isn't really anything else in the world other than money. However, she died when she was only in fifth grade so she is not smart enough for this. And thus, the new resident deity asks for your help.And so, you have to provide Shichikuji with the following information: minimum amount of yen needed to provide electricity to all cities, the cities in which power stations will be built, and the connections to be made.If there are multiple ways to choose the cities and the connections to obtain the construction of minimum price, then print any of them.

First line of input contains a single integer $$$n$$$ ($$$1 \leq n \leq 2000$$$) — the number of cities. Then, $$$n$$$ lines follow. The $$$i$$$-th line contains two space-separated integers $$$x_i$$$ ($$$1 \leq x_i \leq 10^6$$$) and $$$y_i$$$ ($$$1 \leq y_i \leq 10^6$$$) — the coordinates of the $$$i$$$-th city. The next line contains $$$n$$$ space-separated integers $$$c_1, c_2, \dots, c_n$$$ ($$$1 \leq c_i \leq 10^9$$$) — the cost of building a power station in the $$$i$$$-th city. The last line contains $$$n$$$ space-separated integers $$$k_1, k_2, \dots, k_n$$$ ($$$1 \leq k_i \leq 10^9$$$).

In the first line print a single integer, denoting the minimum amount of yen needed. Then, print an integer $$$v$$$ — the number of power stations to be built. Next, print $$$v$$$ space-separated integers, denoting the indices of cities in which a power station will be built. Each number should be from $$$1$$$ to $$$n$$$ and all numbers should be pairwise distinct. You can print the numbers in arbitrary order. After that, print an integer $$$e$$$ — the number of connections to be made. Finally, print $$$e$$$ pairs of integers $$$a$$$ and $$$b$$$ ($$$1 \le a, b \le n$$$, $$$a \ne b$$$), denoting that a connection between City $$$a$$$ and City $$$b$$$ will be made. Each unordered pair of cities should be included at most once (for each $$$(a, b)$$$ there should be no more $$$(a, b)$$$ or $$$(b, a)$$$ pairs). You can print the pairs in arbitrary order. If there are multiple ways to choose the cities and the connections to obtain the construction of minimum price, then print any of them.

NoteFor the answers given in the samples, refer to the following diagrams (cities with power stations are colored green, other cities are colored blue, and wires are colored red):For the first example, the cost of building power stations in all cities is $$$3 + 2 + 3 = 8$$$. It can be shown that no configuration costs less than 8 yen.For the second example, the cost of building a power station in City 2 is 2. The cost of connecting City 1 and City 2 is $$$2 \cdot (3 + 2) = 10$$$. The cost of connecting City 2 and City 3 is $$$3 \cdot (2 + 3) = 15$$$. Thus the total cost is $$$2 + 10 + 15 = 27$$$. It can be shown that no configuration costs less than 27 yen.

import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Array.ST.Safe
import           Data.List
import           Data.Ord
import           Data.STRef
import           Numeric

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

data Node = Node {
  parent  :: Int,
  inMST   :: Bool,
  nodeNum :: Int,
  cost    :: Integer
} deriving (Show)

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords) $ [
    [show totalCost],
    [show $ length buildPlants],
    map (show . nodeNum) buildPlants,
    [show $ length buildWires]
  ] ++ map (\(Node p _ v _) -> [show p, show v]) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      costf v w = (wires ! v + wires ! w) * dist (coords ! v) (coords ! w)
      nodes = mst t (map (uncurry $ Node 0 False) $ zip [1..t] (ints cs)) costf
      totalCost = sum $ map cost nodes
      (buildPlants, buildWires) = partition ((== 0) . parent) nodes

mst t initial costf = runST $ do
  nodes <- newListArray (1, t) initial :: ST s (STArray s Int Node)
  forM_ [1..t] $ \_ -> do
    elems <- getElems nodes
    let node@(Node u _ v w) = minimumBy (comparing cost) $ filter (not . inMST) elems
    writeArray nodes v node {inMST = True}
    forM_ [1..t] $ \vn -> do
      let w = costf v vn
      node@(Node p inMst vn w2) <- readArray nodes vn
      when (not inMst && w < w2) $
        writeArray nodes vn node {parent = v, cost = w}
  getElems nodes

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Array.ST.Safe
import           Data.List
import           Data.Ord
import           Data.STRef
import           Numeric

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

data Node = Node {
  parent  :: Int,
  inMST   :: Bool,
  nodeNum :: Int,
  cost    :: Integer
} deriving (Show)

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = [
    showInt totalCost "",
    showInt (length buildPlants) "",
    unwords $ map ((\i -> showInt i "") . nodeNum) buildPlants,
    showInt (length buildWires) ""
  ] ++ map (\(Node p _ v _) -> showInt p (" " ++ showInt v "")) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      costf v w = (wires ! v + wires ! w) * dist (coords ! v) (coords ! w)
      nodes = mst t (map (uncurry $ Node 0 False) $ zip [1..t] (ints cs)) costf
      totalCost = sum $ map cost nodes
      (buildPlants, buildWires) = partition ((== 0) . parent) nodes

mst t initial costf = runST $ do
  nodes <- newListArray (1, t) initial :: ST s (STArray s Int Node)
  replicateM_ t $ do
    elems <- getElems nodes
    let node@(Node u _ v w) = minimumBy (comparing cost) $ filter (not . inMST) elems
    writeArray nodes v node {inMST = True}
    forM_ [1..t] $ \vn -> do
      let w = costf v vn
      node@(Node p inMst vn w2) <- readArray nodes vn
      when (not inMst && w < w2) $
        writeArray nodes vn node {parent = v, cost = w}
  getElems nodes

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import Control.Monad
import           Control.Monad.ST
import           Data.Array
import Data.Array.ST.Safe
import           Data.List
import           Numeric
import Data.Tuple
import Data.STRef

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

count x = length . filter (== x)

main = interact $
  lines
  |> solverLoop
  |> unlines

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords) $ [
    [show totalCost],
    [show $ length buildPlants],
    map show buildPlants,
    [show $ length buildWires]
  ] ++ map (map show) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      (totalCost, buildPlants, buildWires) = runST $ do
        plantsRef <- newSTRef []
        wiresRef <- newSTRef []
        totalCost <- newSTRef 0
        nodes <- newListArray (1, t) (map (\i -> (i, 0, False)) $ ints cs) :: ST s (STArray s Int (Integer, Int, Bool))
        forM_ [1..t] $ \_ -> do
          ascs <- getAssocs nodes
          let ((w,u,_), v) = minimum $ map swap $ filter (\(_,(_,_,c)) -> not c) ascs
          if u == 0
            then modifySTRef plantsRef (\ps -> v:ps)
            else modifySTRef wiresRef (\ws -> [u,v]:ws)
          modifySTRef totalCost (+ w)
          writeArray nodes v (w,u,True)
          forM_ [1..t] $ \vn -> do
            let cost = (wires ! v + wires ! vn) * dist (coords ! v) (coords ! vn)
            (cost2,_,inMst) <- readArray nodes vn
            if not inMst && cost < cost2
              then writeArray nodes vn (cost,v,inMst)
              else return ()
        (,,) <$> readSTRef totalCost <*> readSTRef plantsRef <*> readSTRef wiresRef

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Array.ST.Safe
import           Data.List
import           Data.Ord
import           Data.STRef
import           Numeric

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

data Node = Node {
  parent  :: Int,
  inMST   :: Bool,
  nodeNum :: Int,
  cost    :: Integer
} deriving (Show)

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords) $ [
    [show totalCost],
    [show $ length buildPlants],
    map (show . nodeNum) buildPlants,
    [show $ length buildWires]
  ] ++ map (\(Node p _ v _) -> [show p, show v]) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      costf v w = (wires ! v + wires ! w) * dist (coords ! v) (coords ! w)
      nodes = mst t (map (uncurry $ Node 0 False) $ zip [1..t] (ints cs)) costf
      totalCost = sum $ map cost nodes
      (buildPlants, buildWires) = partition ((== 0) . parent) nodes

mst t initial costf = runST $ do
  nodes <- newListArray (1, t) initial :: ST s (STArray s Int Node)
  forM_ [1..t] $ \_ -> do
    elems <- getElems nodes
    let node@(Node u _ v w) = minimumBy (comparing cost) $ filter (not . inMST) elems
    writeArray nodes v node {inMST = True}
    let updateKey node@(Node p inMst vn w2) = if (not inMst && costf v vn < w2)
        then Just node { parent = v, cost = costf v vn }
        else Nothing
    mapArrayInPlace updateKey nodes
  getElems nodes

mapArrayInPlace :: (MArray a e m, Ix i) => (e -> Maybe e) -> a i e -> m ()
mapArrayInPlace f array = do
  assocs <- getAssocs array
  forM_ assocs $ \(i, e) ->
    case f e of
      Just x  -> writeArray array i x
      Nothing -> return ()

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import Control.Monad
import           Control.Monad.ST
import           Data.Array
import Data.Array.ST.Safe
import           Data.List
import           Numeric
import Data.Tuple

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

count x = length . filter (== x)

main = interact $
  lines
  |> solverLoop
  |> unlines

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords) $ [
    [show totalCost],
    [show $ length buildPlants],
    map show buildPlants,
    [show $ length buildWires]
  ] ++ map (map show) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      edges = runST $ do
        nodes <- newListArray (1, t) (map (\i -> (i, 0, False)) $ ints cs) :: ST s (STArray s Int (Integer, Int, Bool))
        forM_ [1..t] $ \_ -> do
          a <- getAssocs nodes
          let ((w,u,_), v) = minimum $ map swap $ filter (\(_,(_,_,c)) -> not c) a
          writeArray nodes v (w,u,True)
          forM_ [1..t] $ \vn -> do
            let cost = (wires ! v + wires ! vn) * dist (coords ! v) (coords ! vn)
            (cost2,_,inMst) <- readArray nodes vn
            if not inMst && cost < cost2
              then writeArray nodes vn (cost,v,inMst)
              else return ()
        getElems nodes
      totalCost = sum $ map (\(a,_,_) -> a) edges
      (buildPlants, buildWires) = detail $ zip [1..t] edges

detail :: [(Int, (Integer, Int, Bool))] -> ([Int], [[Int]])
detail [] = ([],[])
detail ((u, (w, v, _)):xs)
  | v == 0 = (u:ps', ws')
  | otherwise = (ps', [u,v]:ws')
  where
    (ps', ws') = detail xs

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Array.ST.Safe
import           Data.List
import           Data.Ord
import           Data.STRef
import           Numeric

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

data Node = Node {
  parent  :: Int,
  inMST   :: Bool,
  nodeNum :: Int,
  cost    :: Integer
} deriving (Show)

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords) $ [
    [show totalCost],
    [show $ length buildPlants],
    map (show . nodeNum) buildPlants,
    [show $ length buildWires]
  ] ++ map (\(Node p _ v _) -> [show p, show v]) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      costf v w = (wires ! v + wires ! w) * dist (coords ! v) (coords ! w)
      nodes = mst t (map (uncurry $ Node 0 False) $ zip [1..t] (ints cs)) costf
      totalCost = sum $ map cost nodes
      (buildPlants, buildWires) = partition ((== 0) . parent) nodes

mst t initial costf = runST $ do
  nodes <- newListArray (1, t) initial :: ST s (STArray s Int Node)
  replicateM_ t $ do
    elems <- getElems nodes
    let node@(Node u _ v w) = minimumBy (comparing cost) $ filter (not . inMST) elems
    writeArray nodes v node {inMST = True}
    forM_ [1..t] $ \vn -> do
      let w = costf v vn
      node@(Node p inMst vn w2) <- readArray nodes vn
      when (not inMst && w < w2) $
        writeArray nodes vn node {parent = v, cost = w}
  getElems nodes

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import           Control.Monad
import           Control.Monad.ST
import           Data.Array
import           Data.Array.ST.Safe
import           Data.List
import           Data.Ord
import           Data.STRef
import           Numeric

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

main = interact $
  lines
  |> solverLoop
  |> unlines

data Node = Node {
  parent  :: Int,
  inMST   :: Bool,
  nodeNum :: Int,
  cost    :: Integer
} deriving (Show)

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = [
    showInt totalCost "",
    showInt (length buildWires) "",
    unwords $ map ((\i -> showInt i "") . nodeNum) buildPlants,
    showInt (length buildWires) ""
  ] ++ map (\(Node p _ v _) -> showInt p (" " ++ showInt v "")) buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      costf v w = (wires ! v + wires ! w) * dist (coords ! v) (coords ! w)
      nodes = mst t (map (uncurry $ Node 0 False) $ zip [1..t] (ints cs)) costf
      totalCost = sum $ map cost nodes
      (buildPlants, buildWires) = partition ((== 0) . parent) nodes

mst t initial costf = runST $ do
  nodes <- newListArray (1, t) initial :: ST s (STArray s Int Node)
  replicateM_ t $ do
    elems <- getElems nodes
    let node@(Node u _ v w) = minimumBy (comparing cost) $ filter (not . inMST) elems
    writeArray nodes v node {inMST = True}
    forM_ [1..t] $ \vn -> do
      let w = costf v vn
      node@(Node p inMst vn w2) <- readArray nodes vn
      when (not inMst && w < w2) $
        writeArray nodes vn node {parent = v, cost = w}
  getElems nodes

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)

import Control.Monad
import           Control.Monad.ST
import           Data.Array
import Data.Array.ST.Safe
import           Data.List
import           Numeric
import Data.Tuple

(|>) = flip (.)

int :: (Eq a, Num a) => String -> a
int x = fst $ readDec x !! 0

ints :: (Eq a, Num a) => String -> [a]
ints = map int . words

count x = length . filter (== x)

main = interact $
  lines
  |> solverLoop
  |> unlines

solverLoop :: [String] -> [String]
solverLoop (ts:xs) = map (unwords . map show) $ [
    [totalCost],
    [length buildPlants],
    buildPlants,
    [length buildWires]
  ] ++ buildWires
    where
      t = int ts
      coords = array (1, t) [(i, (x, y)) | (i, (x:y:_)) <- zip [1..t] (map ints xs) ]
      (cs:ks:_) = drop t xs
      wires = array (1, t) $ zip [1..t] (ints ks)
      edges = runST $ do
        nodes <- newListArray (1, t) (map (\i -> (i, 0, False)) $ ints cs) :: ST s (STArray s Int (Int, Int, Bool))
        forM_ [1..t] $ \_ -> do
          a <- getAssocs nodes
          let ((w,u,_), v) = minimum $ map swap $ filter (\(_,(_,_,c)) -> not c) a
          writeArray nodes v (w,u,True)
          forM_ [1..t] $ \vn -> do
            let cost = (wires ! v + wires ! vn) * dist (coords ! v) (coords ! vn)
            (cost2,_,inMst) <- readArray nodes vn
            if not inMst && cost < cost2
              then writeArray nodes vn (cost,v,inMst)
              else return ()
        getElems nodes
      totalCost = sum $ map (\(a,_,_) -> a) edges
      (buildPlants, buildWires) = detail $ zip [1..t] edges

detail [] = ([],[])
detail ((u, (w, v, _)):xs)
  | v == 0 = (u:ps', ws')
  | otherwise = (ps', [u,v]:ws')
  where
    (ps', ws') = detail xs

dist (x1,y1) (x2,y2) = abs (x1 - x2) + abs (y1 - y2)


The commanding officers decided to drop a nuclear bomb on the enemy's forces. You are ordered to determine the power of the warhead that needs to be used.The enemy has N strategically important objects. Their positions are known due to the intelligence service. The aim of the strike is to deactivate at least K important objects of the enemy. The bombing impact point is already determined and has coordinates of [X0; Y0].The nuclear warhead is marked by the estimated impact radius R ≥ 0. All the buildings that are located closer than R to the bombing epicentre will be destroyed. All the buildings that are located further than R from the epicentre, can also be deactivated with some degree of probability. Let's assume that D is the distance between a building and the epicentre. This building's deactivation probability P(D, R) is calculated according to the following formula:  We should regard  as ea, where e ≈ 2.7182818284590452353602874713527If the estimated impact radius of the warhead is equal to zero, then all the buildings located in the impact point will be completely demolished and all the rest of important objects will not be damaged.The commanding officers want the probability of failing the task to be no more than ε. Nuclear warheads are too expensive a luxury, that's why you have to minimise the estimated impact radius of the warhead.

The first line contains an integer N which represents the number of the enemy's objects (1 ≤ N ≤ 100). The second line contains two integers: K is the required number of deactivated objects, and ε is the maximally permitted probability of not completing the task, given in per mils (1 ≤ K ≤ N, 1 ≤ ε ≤ 999). The third line contains X0 and Y0 which are the coordinates of the strike impact point. The next N lines contain two numbers Xi and Yi each which are the coordinates of every strategically important object. All the coordinates are integer, their absolute values do not exceed 1000. Let us remind you that there are a thousand per mils in unity (number one). There can be several objects in one point.

Print the sought estimated impact radius of the warhead. The absolute or relative measure of the inaccuracy of your answer should not exceed 10 - 6.

import Control.Monad

getA = fmap (map read . words) getLine
hypot x y = sqrt . fromIntegral $ x ^ 2 + y ^ 2

main = do
	[n] <- getA
	[k, e] <- getA
	[x, y] <- getA
	p <- replicateM n getA
	putStr $ show $ gao n k (1 - fromIntegral e/1000) $ map (\[i, j] -> hypot (i - x) (j - y)) p

gao n k e d = gao' 0 3000 where
	gao' l r = if r - l < 0.1 ^ 8 then m else if q > e then gao' l m else gao' m r where
		m = (l + r) / 2
		p = map (\i -> if i <= m then 1 else exp $ 1 - (i / m) ^ 2) d
		q = sum $ drop k $ go p

go [] = [1]
go (p:ps) = let q = go ps in zipWith (\i j -> p * i + (1 - p) * j) (0:q) (q ++ [0])

import Control.Monad

getA = fmap (map read . words) getLine
hypot x y = sqrt . fromIntegral $ x ^ 2 + y ^ 2

main = do
	[n] <- getA
	[k, e] <- getA
	[x, y] <- getA
	p <- replicateM n getA
	putStr $ show $ gao n k (1 - fromIntegral e/1000) $ map (\[i, j] -> hypot (i - x) (j - y)) p

gao n k e d = gao' 0 2000 where
	gao' l r = if r-l<0.1^8 then m else if q > e then gao' l m else gao' m r where
		m = (l + r) / 2
		p = map (\i -> if i <= m then 1 else exp $ 1 - (i / m) ^ 2) d
		q = sum $ drop k $ go p

go [] = [1]
go (p:ps) = let q = go ps in zipWith (\i j -> p * i + (1 - p) * j) (0:q) (q ++ [0])

import Control.Monad

getA = fmap (map read . words) getLine
hypot x y = sqrt . fromIntegral $ x ^ 2 + y ^ 2

main = do
	[n] <- getA
	[k, e] <- getA
	[x, y] <- getA
	p <- replicateM n getA
	putStr $ show $ gao n k (1 - fromIntegral e/1000) $ map (\[i, j] -> hypot (i - x) (j - y)) p

gao n k e d = gao' 0 2000 where
	gao' l r = if abs(l-r)<0.0000001 then m else if q > e then gao' l m else gao' m r where
		m = (l + r) / 2
		p = map (\i -> if i <= m then 1 else exp $ 1 - (i / m) ^ 2) d
		q = sum $ drop k $ go p

go [] = [1]
go (p:ps) = let q = go ps in zipWith (\i j -> p * i + (1 - p) * j) (0:q) (q ++ [0])


Moscow is hosting a major international conference, which is attended by n scientists from different countries. Each of the scientists knows exactly one language. For convenience, we enumerate all languages of the world with integers from 1 to 109.In the evening after the conference, all n scientists decided to go to the cinema. There are m movies in the cinema they came to. Each of the movies is characterized by two distinct numbers — the index of audio language and the index of subtitles language. The scientist, who came to the movie, will be very pleased if he knows the audio language of the movie, will be almost satisfied if he knows the language of subtitles and will be not satisfied if he does not know neither one nor the other (note that the audio language and the subtitles language for each movie are always different). Scientists decided to go together to the same movie. You have to help them choose the movie, such that the number of very pleased scientists is maximum possible. If there are several such movies, select among them one that will maximize the number of almost satisfied scientists.

The first line of the input contains a positive integer n (1 ≤ n ≤ 200 000) — the number of scientists. The second line contains n positive integers a1, a2, ..., an (1 ≤ ai ≤ 109), where ai is the index of a language, which the i-th scientist knows. The third line contains a positive integer m (1 ≤ m ≤ 200 000) — the number of movies in the cinema.  The fourth line contains m positive integers b1, b2, ..., bm (1 ≤ bj ≤ 109), where bj is the index of the audio language of the j-th movie. The fifth line contains m positive integers c1, c2, ..., cm (1 ≤ cj ≤ 109), where cj is the index of subtitles language of the j-th movie. It is guaranteed that audio languages and subtitles language are different for each movie, that is bj ≠ cj.

Print the single integer — the index of a movie to which scientists should go. After viewing this movie the number of very pleased scientists should be maximum possible. If in the cinema there are several such movies, you need to choose among them one, after viewing which there will be the maximum possible number of almost satisfied scientists.  If there are several possible answers print any of them.

NoteIn the first sample, scientists must go to the movie with the index 2, as in such case the 1-th and the 3-rd scientists will be very pleased and the 2-nd scientist will be almost satisfied.In the second test case scientists can go either to the movie with the index 1 or the index 3. After viewing any of these movies exactly two scientists will be very pleased and all the others will be not satisfied.

import Data.Maybe
import Control.Applicative
import qualified Data.List as L
import           Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as Map
import qualified Data.ByteString.Char8 as BS

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

build_map :: [Int] -> (IntMap Int) -> (IntMap Int)
build_map [] mp = mp
build_map (x:xs) mp = build_map xs $ Map.insertWith (+) x 1 mp

f :: (IntMap Int) -> (Int, Int) -> (Int, Int)
f mp (a,b) = (Map.findWithDefault 0 a mp, Map.findWithDefault 0 b mp)

main :: IO ()
main = do
  n <- readLn :: IO Int
  -- la <- getLine
  -- let a = map read (words la) :: [Int]
  a <- readIntN <$> BS.getLine
  m <- readLn :: IO Int
  -- lb <- getLine
  -- lc <- getLine
  -- let b = map read (words lb) :: [Int]
  -- let c = map read (words lc) :: [Int]
  b <- readIntN <$> BS.getLine
  c <- readIntN <$> BS.getLine
  let bc = zip b c
  let ma = build_map a Map.empty
  print . snd $ L.maximumBy compare $ zip (map  (f ma) bc) [1..]

import qualified Data.Map as M
import Control.Applicative
import Control.Monad

import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Text.Read (decimal)
import System.IO (stdin)

tread s = case decimal s of
  Right (v,_) -> v
  Left e -> error e

count xs = foldr (\a m -> M.insertWith (\new old -> old + 1) a 1 m) M.empty xs

m ! v = case M.lookup v m of
  Just v -> v
  Nothing -> 0

aux [] [] i ans res freq = ans
aux (x:xs) (y:ys) i ans res@(a,b) freq
  | res < (freq ! x, freq ! y) = aux xs ys (i+1) i (freq ! x, freq ! y) freq
  | otherwise = aux xs ys (i+1) ans res freq

main = do
  n <- readLn :: IO Int
  as <- map tread . T.words <$> (TIO.hGetLine stdin) :: IO [Int]
  m <- readLn :: IO Int
  bs <- map tread . T.words <$> (TIO.hGetLine stdin) :: IO [Int]
  cs <- map tread . T.words <$> (TIO.hGetLine stdin) :: IO [Int]
  let freq = count as
  let ans = aux bs cs 0 0 (0,0) freq
  print $ ans + 1

import Data.List
import Control.Arrow
import Control.Applicative
import Control.Monad
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Text.Read (decimal)
import System.IO (stdin)
import qualified Data.Map as Map

tread s = case decimal s of
    Right (v, _) -> v
    Left e -> error e

main :: IO()
main = do
    _ <- getLine
    a <- map tread . T.words <$> TIO.hGetLine stdin :: IO [Int]
    _ <- getLine
    b <- map tread . T.words <$> TIO.hGetLine stdin :: IO [Int]
    c <- map tread . T.words <$> TIO.hGetLine stdin :: IO [Int]
    let f = Map.fromList $ frequency a
    print $ solve b c 1 0 0 1 f

frequency :: Ord a => [a] -> [(a, Int)]
frequency = map (head &&& length) . group . sort

removeMaybe :: Maybe Int -> Int
removeMaybe (Just a) = a
removeMaybe Nothing = 0

solve :: [Int] -> [Int] -> Int -> Int -> Int -> Int -> Map.Map Int Int -> Int
solve [] [] _ _ _ maxIdx _ = maxIdx
solve (b:bs) (c:cs) idx maxVal1 maxVal2 maxIdx fre =
    let newVal1 = removeMaybe $ Map.lookup b fre
        newVal2 = removeMaybe $ Map.lookup c fre
    in if newVal1 > maxVal1 || (newVal1 == maxVal1 && newVal2 > maxVal2)
       then solve bs cs (idx + 1) newVal1 newVal2 idx fre
       else solve bs cs (idx + 1) maxVal1 maxVal2 maxIdx fre

import Data.Map.Strict (empty, insertWith, findWithDefault)
import Data.Ord (comparing)
import Data.List (maximumBy)

--
-- UTILITIES
--
import qualified Data.ByteString.Char8 as C
import           Data.Maybe (fromJust)

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

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

--
-- MAIN
--

main :: IO ()
main = do
  n      <- readInt
  lang   <- readInts
  m      <- readInt
  sounds <- readInts
  subs   <- readInts
  let langmap = foldl (\mp k -> insertWith (+) k 1 mp) empty lang
      happy   = getHappy <$> zip sounds subs
      getHappy (snd, sbt) = (findWithDefault 0 snd langmap, findWithDefault 0 sbt langmap)
      (_, ans) = maximumBy (comparing fst) $ zip happy [1..]
  print ans

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

import           System.IO hiding (char8)
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Data.Tuple
import           Data.Int
import           Data.Char
import           Data.Function (on)
import           Data.Array
-- import           Data.UArray
-- import           Data.Array.IArray
-- import           Data.Array.ST
-- import           Data.Array.MArray
-- import           Data.Array.Unsafe
import           Data.Ix
import           Data.Maybe
import           Data.Monoid hiding ((<>))
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.ByteString.Builder
-- import           Data.Vector.Unboxed ((//), (++), (!), (!?))
-- import qualified Data.Vector.Unboxed as U
-- import           Data.IntSet (IntSet)
-- import qualified Data.IntSet as S
import           Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as M
-- import           Data.Sequence ((|>), (<|), (><),ViewR((:>)), ViewL((:<)))
-- import qualified Data.Sequence as S
-- import           Debug.Trace

main = do
  _ <- readInt1 <$> BS.getLine
  as <- readIntN <$> BS.getLine
  _ <- readInt1 <$> BS.getLine
  bs <- readIntN <$> BS.getLine
  cs <- readIntN <$> BS.getLine
  print $ solve as $ zip bs cs

solve as bcs = fst . maximumBy (compare `on` snd) . zip [1..] $ map score bcs where
  score :: (Int,Int) -> Int64
  score (b,c) = (fromIntegral $ cnt b) * 200000 + (fromIntegral $ cnt c)
  cnt x = M.findWithDefault 0 x m
  m = loop as M.empty where
    loop [] m' = m'
    loop (a:as) m' = loop as (M.insertWith (+) a 1 m')

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

readInt1 :: BS.ByteString -> Int
readInt1 = fst . fromJust . BS.readInt

readInt2 :: BS.ByteString -> (Int,Int)
readInt2 = toTuple . readIntN

readInt3 :: BS.ByteString -> (Int,Int,Int)
readInt3 = toTriple . readIntN

readIntN :: BS.ByteString -> [Int]
readIntN =  map readInt1 . BS.words

readInt641 :: BS.ByteString -> Int64
readInt641 = fromIntegral . fst . fromJust . BS.readInteger

readInt642 :: BS.ByteString -> (Int64,Int64)
readInt642 = toTuple . readInt64N

readInt643 :: BS.ByteString -> (Int64,Int64,Int64)
readInt643 = toTriple . readInt64N

readInt64N :: BS.ByteString -> [Int64]
readInt64N =  map readInt641 . BS.words

readInteger1 :: BS.ByteString -> Integer
readInteger1 = fst . fromJust . BS.readInteger

readInteger2 :: BS.ByteString -> (Integer,Integer)
readInteger2 = toTuple . readIntegerN

readInteger3 :: BS.ByteString -> (Integer,Integer,Integer)
readInteger3 = toTriple . readIntegerN

readIntegerN :: BS.ByteString -> [Integer]
readIntegerN =  map readInteger1 . BS.words

toTuple :: [a] -> (a, a)
toTuple [x, y] = (x, y)

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

fromTuple :: (a, a) -> [a]
fromTuple (x, y) = [x, y]

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

-- if not applying, use "const"

applyTuple :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
applyTuple f g (x, y) = (f x, g y)

applyTriple :: (a -> a') -> (b -> b') -> (c -> c') -> (a, b, c) -> (a', b', c')
applyTriple f g h (x, y, z) = (f x, g y, h z)

import Control.Monad
import Control.Applicative

import qualified Data.Map as M
import Data.Ord (comparing)
import Data.List (maximumBy)

maxAux [] [] i freq aMax subV subI = subI
maxAux (x:xs) (y:ys) i freq aMax subV subI
  | freq !!! x == aMax = if freq !!! y > subV
                         then maxAux xs ys (i+1) freq aMax (freq !!! y) i
                         else maxAux xs ys (y+1) freq aMax subV subI
  | otherwise = maxAux xs ys (i+1) freq aMax subV subI

(!!!) ::   M.Map Int Int -> Int -> Int
m !!! v = case M.lookup v m of
    Just v -> v
    Nothing -> 0

main = do
  n <- readLn :: IO Int
  ls <- map read . words <$> getLine :: IO [Int]
  m <- readLn :: IO Int
  aud <- map read . words <$> getLine :: IO [Int]
  sub <- map read . words <$> getLine :: IO [Int]

  let freq = foldr (\a m -> M.insertWith (\new old -> old + 1) a 1 m) M.empty ls

  let subMax = maximumBy (comparing (freq !!!)) sub
  let audMax = maximumBy (comparing (freq !!!)) aud

  let ans = maxAux aud sub 0 freq audMax 0 0

  print (ans+1)


There is a game called "Unique Bid Auction". You can read more about it here: https://en.wikipedia.org/wiki/Unique_bid_auction (though you don't have to do it to solve this problem).Let's simplify this game a bit. Formally, there are $$$n$$$ participants, the $$$i$$$-th participant chose the number $$$a_i$$$. The winner of the game is such a participant that the number he chose is unique (i. e. nobody else chose this number except him) and is minimal (i. e. among all unique values of $$$a$$$ the minimum one is the winning one).Your task is to find the index of the participant who won the game (or -1 if there is no winner). Indexing is $$$1$$$-based, i. e. the participants are numbered from $$$1$$$ to $$$n$$$.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. Then $$$t$$$ test cases follow. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 2 \cdot 10^5$$$) — the number of participants. The second line of the test case contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le n$$$), where $$$a_i$$$ is the $$$i$$$-th participant chosen number. It is guaranteed that the sum of $$$n$$$ does not exceed $$$2 \cdot 10^5$$$ ($$$\sum n \le 2 \cdot 10^5$$$).

For each test case, print the answer — the index of the participant who won the game (or -1 if there is no winner). Note that the answer is always unique.

import Control.Arrow ((>>>))
import Data.List (groupBy, sort)

main =
  interact $
  lines >>>
  drop 1 >>> map (words >>> map read) >>> process >>> map show >>> unlines

process :: [[Int]] -> [Int]
process [] = []
process (_:xs:xss) = solve xs : process xss

solve :: [Int] -> Int
solve xs
  | null ys = -1
  | otherwise = snd . head . head $ ys
  where
    ys = filter ((== 1) . length) . groupBy (eq fst) . sort $ zip xs [1 ..]
    eq p x y = p x == p y

import Data.List
main :: IO ()
main = interact $ unlines . map show . solve . map read . tail . words

solve :: [Int] -> [Int]
solve [] = []
solve (n:rs) = findMin cn :(solve rest)
    where (an,rest) = splitAt n rs
          bn = zip [1..n] an
          cn = sortBy (\(_,vi) (_,vj) -> compare vi vj) bn

findMin :: [(Int,Int)] -> Int
findMin [] = -1
findMin [(i,vi)] = i
findMin ((i,vi):(j,vj):rs)
    | (vi /= vj) = i
    | otherwise = findMin $ dropWhile (\(a,va) -> va == vi) rs

import Data.List

solve :: [Int] -> Int
solve a
  | null b = -1
  | otherwise = snd . head . head $ b
  where
    b = filter ((==1) . length). groupBy (\x y -> fst x == fst y) . sort $ zip a [1..]

f [] = []
f (_:x:xs) = solve x : f xs

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

{-# LANGUAGE GADTs, TemplateHaskell, DeriveFunctor, OverloadedStrings #-}

import Data.List
import qualified Data.ByteString.Char8 as B8
import Data.Maybe
import Data.Int
import Text.Printf
import Data.Function ( (&), on )
import Data.Functor
import Control.Arrow ((>>>))
import Control.Monad (forM_)
import Data.Char (isAlpha)

readIntB8 :: B8.ByteString -> Maybe Int
readIntB8 = B8.readInt >>> fmap fst

solve :: [Int] -> Maybe Int
solve as = do
    let uniqueAs = sort as & group & filter (\x -> length x == 1) & concat
    result <- listToMaybe uniqueAs
    index <- elemIndex result as
    return $ index + 1

mainCase :: IO ()
mainCase = do
    Just n <- B8.getLine <&> readIntB8
    as <- B8.getLine <&> B8.words <&> map (readIntB8 >>> fromJust)
    let answer = fromMaybe (-1) $ solve as
    printf "%d\n" answer

main :: IO ()
main = do
    Just t <- B8.getLine <&> readIntB8
    forM_ [1 .. t] $ const mainCase

{-
n participants
i-th participant chose number ai
participant that chooses the smallest unique number wins

find index of the participant who won, or -1 if no winner
index is 1-based (1 to n)
answer t independent test cases

input:
t, number of test cases
first line number participants
second line n integers
-}

import qualified Data.Map.Strict as Map
import Data.List
import Data.Maybe
import Control.Monad

main = do
  cases <- read <$> getLine
  replicateM cases $ do
    _ <- getLine
    participantNumbers <- ((fmap . fmap) read) $ words <$> getLine
    putStrLn $ show $ minUniqueIndex participantNumbers

minUniqueIndex :: [Int] -> Int
minUniqueIndex xs =
  if null uniques
     then -1
     else 1 + (fromJust $ findIndex (== head uniques) xs)
  where
    uniques = Map.keys $ Map.filter (<2) $ Map.fromListWith (+) $ map (flip (,) 1) xs

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
--import safe Data.List (sort)
import Data.List
import Data.Function

main :: IO ()
main =  interact $  lines >>> drop 1 >>> tcio >>> unlines where
  tcio :: [String] -> [String]
  tcio [] = []
  tcio (_ : l : rest) = (itoline . solve . linetois) l : tcio rest
  linetoi = read; linetois = (map linetoi) . words; linestoiss = map linetois
  itoline = show; istoline = unwords . (map itoline); isstolines = map istoline

solve :: [Int] -> Int
solve xs = if null u then (-1) else (snd.head.head) u  where u = dropWhile (not.null.drop 1) $ groupBy ((==) `on` fst) $ sort $ zip xs [1..]

import Data.List

solve [] = -1
solve (x:xs) = if (length $ takeWhile (==x) xs) >= 1
  then solve $ dropWhile (==x) xs
  else x

f [] = []
f (_:x:xs) = solve (sort x) : f xs

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


Sereja has an n × m rectangular table a, each cell of the table contains a zero or a number one. Sereja wants his table to meet the following requirement: each connected component of the same values forms a rectangle with sides parallel to the sides of the table. Rectangles should be filled with cells, that is, if a component form a rectangle of size h × w, then the component must contain exactly hw cells.A connected component of the same values is a set of cells of the table that meet the following conditions:  every two cells of the set have the same value;  the cells of the set form a connected region on the table (two cells are connected if they are adjacent in some row or some column of the table);  it is impossible to add any cell to the set unless we violate the two previous conditions. Can Sereja change the values of at most k cells of the table so that the table met the described requirement? What minimum number of table cells should he change in this case?

The first line contains integers n, m and k (1 ≤ n, m ≤ 100; 1 ≤ k ≤ 10). Next n lines describe the table a: the i-th of them contains m integers ai1, ai2, ..., aim (0 ≤ ai, j ≤ 1) — the values in the cells of the i-th row.

Print -1, if it is impossible to meet the requirement. Otherwise, print the minimum number of cells which should be changed.

{-# LANGUAGE MultiParamTypeClasses,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,BangPatterns,RankNTypes,TupleSections #-}
import Control.Monad
import Control.Monad.ST
import Control.Applicative
import Control.Arrow
import Debug.Trace
import Text.Printf

import Data.List
import Data.Int
import Data.Bits
import Data.Maybe
import Data.Array.Unboxed
import Data.Array.ST
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.ByteString.Char8 as B

readInt = fromJust . fmap fst . B.readInt
readInts = map readInt . B.words <$> B.getLine
readIntPair = l2p . map readInt . take 2 . B.words <$> B.getLine
readLns :: Read a => IO [a]
readLns = map read . words <$> getLine
cmpFst (a,_) (b,_) = compare a b
cmpSnd (_,a) (_,b) = compare a b
cmpLen a b = length a `compare` length b
swap (a,b) = (b,a)
l2p (a:b:_) = (a,b)
p2l (a,b) = [a,b]
itof :: Int -> Double
itof = fromIntegral
defaultArray :: (IArray a e,Ix i) => e -> (i,i) -> [(i,e)] -> a i e
defaultArray = accumArray $ curry snd
flatten :: [(a,[(b,c)])] -> [((a,b),c)]
flatten = (=<<) $ uncurry $ fmap . first . (,)
stepM_ :: Monad m => a -> (a -> Bool) -> (a -> a) -> (a -> m ()) -> m ()
stepM_ i judge incr step = sub i
    where
    sub i | judge i = step i >> sub (incr i) | otherwise = return ()
inf = maxBound `div` 2 :: Int

main = do
    [n,m,k] <- readInts
    l <- replicateM n readInts
    let l1 = if m <= n then l else transpose l
    let w = min n m
    let res = minimum $ do
        xs <- if w <= k then replicateM w [0,1] else l1
        return $ sum [ min (cost xs r) (cost (neg xs) r) | r <- l1 ]
    print $ if res <= k then res else -1

neg :: [Int] -> [Int]
neg = map (1-)

cost :: [Int] -> [Int] -> Int
cost xs ys = sum $ zipWith (\a b -> if a == b then 0 else 1) xs ys
{-
 - w <= hとする
 - w <= k ならば
 -  xs <- [0,1]^w
 - w > k ならば
 -  xs <- rows
 - とするこのときの最小コストは
 - sum [ min (popcount $ xs `xor` ri) (popcount $ not xs `xor` ri) | ri <- rs]
 -
 - -}

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

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

readInt :: B.ByteString -> Int
readInt = fromJust . fmap fst . B.readInt
readInts :: IO [Int]
readInts = map readInt . B.words <$> B.getLine

ifTE :: Bool -> a -> a -> a
ifTE x y z = if x then y else z

boolean :: a -> a -> Bool -> a
boolean x y z = ifTE z x y

main :: IO ()
main = do
    [n,m,k] <- readInts
    l <- ifTE (m <= n) id transpose <$> replicateM n readInts
    let w = min n m
        cost = curry $ sum . uncurry (zipWith ((boolean 0 1.) . (==)))
        f = sum . flip map l . (uncurry min.) . ((id &&& (w-)).) . cost
        res = minimum $ map f $ ifTE (w <= k) (replicateM w [0,1]) l
    print $ if res <= k then res else -1

import Control.Arrow
import Data.Bits
import Data.List

solve ([n, m, k] : a)
	| n < m     = solve ([m, n, k] : transpose a)
	| ans <= k  = ans
	| otherwise = -1
	where
		xs = map (foldl (\x b -> 2 * x + b) 0) a
		work y = sum $ map (uncurry min . (id &&& (m-)) . toInteger . popCount . xor y) xs
		ans = minimum . map work $ if m > k then xs else [0 .. 2^m-1]

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

import Control.Arrow
import Data.Bits
import Data.List

solve ([n, m, k] : a) = if n < m then solve ([m, n, k] : transpose a) else
	let
		xs = map (foldl (\x b -> 2 * x + b) 0) a
		ys = if m > k then xs else [0 .. 2 ^ m - 1]
		work y = sum $ map (uncurry min . (id &&& (m-)) . toInteger . popCount . (y `xor`)) xs
		cost = minimum $ map work ys
	in if cost <= k then cost else -1

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


The only difference between easy and hard versions are constraints on $$$n$$$ and $$$k$$$.You are messaging in one of the popular social networks via your smartphone. Your smartphone can show at most $$$k$$$ most recent conversations with your friends. Initially, the screen is empty (i.e. the number of displayed conversations equals $$$0$$$).Each conversation is between you and some of your friends. There is at most one conversation with any of your friends. So each conversation is uniquely defined by your friend.You (suddenly!) have the ability to see the future. You know that during the day you will receive $$$n$$$ messages, the $$$i$$$-th message will be received from the friend with ID $$$id_i$$$ ($$$1 \le id_i \le 10^9$$$).If you receive a message from $$$id_i$$$ in the conversation which is currently displayed on the smartphone then nothing happens: the conversations of the screen do not change and do not change their order, you read the message and continue waiting for new messages.Otherwise (i.e. if there is no conversation with $$$id_i$$$ on the screen):  Firstly, if the number of conversations displayed on the screen is $$$k$$$, the last conversation (which has the position $$$k$$$) is removed from the screen.  Now the number of conversations on the screen is guaranteed to be less than $$$k$$$ and the conversation with the friend $$$id_i$$$ is not displayed on the screen.  The conversation with the friend $$$id_i$$$ appears on the first (the topmost) position on the screen and all the other displayed conversations are shifted one position down. Your task is to find the list of conversations (in the order they are displayed on the screen) after processing all $$$n$$$ messages.

The first line of the input contains two integers $$$n$$$ and $$$k$$$ ($$$1 \le n, k \le 200)$$$ — the number of messages and the number of conversations your smartphone can show. The second line of the input contains $$$n$$$ integers $$$id_1, id_2, \dots, id_n$$$ ($$$1 \le id_i \le 10^9$$$), where $$$id_i$$$ is the ID of the friend which sends you the $$$i$$$-th message.

In the first line of the output print one integer $$$m$$$ ($$$1 \le m \le min(n, k)$$$) — the number of conversations shown after receiving all $$$n$$$ messages. In the second line print $$$m$$$ integers $$$ids_1, ids_2, \dots, ids_m$$$, where $$$ids_i$$$ should be equal to the ID of the friend corresponding to the conversation displayed on the position $$$i$$$ after receiving all $$$n$$$ messages.

NoteIn the first example the list of conversations will change in the following way (in order from the first to last message):  $$$[]$$$;  $$$[1]$$$;  $$$[2, 1]$$$;  $$$[3, 2]$$$;  $$$[3, 2]$$$;  $$$[1, 3]$$$;  $$$[1, 3]$$$;  $$$[2, 1]$$$. In the second example the list of conversations will change in the following way:  $$$[]$$$;  $$$[2]$$$;  $$$[3, 2]$$$;  $$$[3, 2]$$$;  $$$[1, 3, 2]$$$;  and then the list will not change till the end.

import Data.Set (Set)
import qualified Data.Set as Set

inputArr = do
  line <- getLine
  let ar = map read (words line) :: [Int]
  return ar

sim cur cur2 st [] rem = cur ++ (reverse cur2)
sim [] [] st (x:xs) rem = sim [] [x] (Set.insert x st) xs (rem-1)
sim (c:cs) [] st xs rem = sim [] (reverse (c:cs)) st xs rem
sim cur (c:cs) st (x:xs) rem
  | Set.member x st = sim cur (c:cs) st xs rem
  | rem > 0 = sim (x:cur) (c:cs) (Set.insert x st) xs (rem-1)
  | otherwise = sim (x:cur) cs newSt xs rem
      where newSt = Set.insert x (Set.delete c st)

main = do
  [n,k] <- inputArr
  a <- inputArr
  let res = sim [] [] Set.empty a k
  putStrLn (show (length res))
  putStrLn (concat (map ((++ " ") . show) res))

import Data.List
import qualified Data.Sequence as Q
import qualified Data.IntSet as S
import Data.Foldable
main = do
  [n,k] <- map read . words <$> getLine
  ids <- map read . words <$> getLine :: IO [Int]
  let (ids',_) = foldl' (incoming k) (Q.empty,S.empty) ids
  print (length ids')
  putStrLn $ unwords $ map show $ toList ids'
incoming k (q,s) i | i `S.member` s = (q,s)
                   | Q.length q < k = (i Q.<| q,S.insert i s)
                   | (q' Q.:> i') <- Q.viewr q =
                       (i Q.<| q',S.insert i (S.delete i' s))

import Data.Foldable
import Data.Set hiding (map, deleteAt, toList)
import Data.Sequence
import Control.Monad

solve :: Int -> Int -> [Int] -> (Int, [Int])
solve n k ids =
	let
		helper :: Set Int -> Seq Int -> Int -> [Int] -> (Int, [Int])
		helper set seq m [] = (m, toList seq)
		helper set seq m (id:ids)
			| id `member` set = helper set seq m ids
			| otherwise =
			if m < k
			then helper (id `insert` set) (id <| seq) (m + 1) ids
			else let
				Just toDel = seq !? (k - 1)
			in
				helper (id `insert` (toDel `delete` set)) (id <| (deleteAt (k - 1) seq)) m ids
	in
		helper Data.Set.empty Data.Sequence.empty 0 ids
main = do
	firstStr <- getLine
	let n : k : [] = map read $ words firstStr
	secondStr <- getLine
	let ids = map read $ words secondStr
	let (m, finalIds) = solve n k ids
	putStrLn $ show m
	mapM_ (\x -> putStr $ (show x) ++ " ") finalIds

import Data.List
main = do
  [n,k] <- map read . words <$> getLine
  ids <- map read . words <$> getLine :: IO [Int]
  let ids' = foldl' (incoming k) [] ids
  print (length ids')
  putStrLn $ unwords $ map show ids'
incoming k q i | i `elem` q = q
               | otherwise = take k (i : q)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else v:acc
                              else if v `elem` acc then acc else v:init acc

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> a ++ ' ' : show v) (show $ head l) (tail l)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else v:acc
                              else if v `elem` acc then acc else v:(tail acc)

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> a ++ ' ' : (show v)) (show $ head l) (tail l)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else acc ++ [v]
                              else if v `elem` acc then acc else init acc ++ [v]

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> show v ++ ' ' : a) (show $ head l) (tail l)

import Data.List

rl = ((map read . words) <$> getLine) :: IO [Int]

fld :: Int -> [Int] -> Int -> [Int]
fld k acc v = if length acc < k then if v `elem` acc then acc else acc ++ [v]
                              else if v `elem` acc then acc else v:init acc

main = do
  [n, k] <- rl
  b      <- rl

  let l = foldl' (fld k) [] b
  print $ length l
  putStr $ foldl' (\a v -> show v ++ ' ' : a) (show $ head l) (tail l)


There are $$$n$$$ rectangles in a row. You can either turn each rectangle by $$$90$$$ degrees or leave it as it is. If you turn a rectangle, its width will be height, and its height will be width. Notice that you can turn any number of rectangles, you also can turn all or none of them. You can not change the order of the rectangles.Find out if there is a way to make the rectangles go in order of non-ascending height. In other words, after all the turns, a height of every rectangle has to be not greater than the height of the previous rectangle (if it is such).

The first line contains a single integer $$$n$$$ ($$$1 \leq n \leq 10^5$$$) — the number of rectangles. Each of the next $$$n$$$ lines contains two integers $$$w_i$$$ and $$$h_i$$$ ($$$1 \leq w_i, h_i \leq 10^9$$$) — the width and the height of the $$$i$$$-th rectangle.

Print "YES" (without quotes) if there is a way to make the rectangles go in order of non-ascending height, otherwise print "NO". You can print each letter in any case (upper or lower).

NoteIn the first test, you can rotate the second and the third rectangles so that the heights will be [4, 4, 3].In the second test, there is no way the second rectangle will be not higher than the first one.

import Data.List

toint s = (read s) :: Integer

doit [] k = True
doit (x:(y:xs)) k =
    if max x y <= k then
        doit xs $ max x y
    else
        if min x y <= k then
            doit xs $ min x y
        else
            False

solve::String -> String
solve ss =
    let s = map toint (tail (words ss)) in
    let r = doit s (2^30) in
    if r then
        "YES\n"
    else
        "NO\n"

main = do
  interact $ solve

import Data.Maybe

main = interact foo

foo :: String -> String
foo inp =
    let _:(n1, n2):ns = map (\n -> (n!!0, n!!1)) . map (map read . words) . lines $ inp :: [(Int, Int)]
    in if isNothing $ foldl check (Just $ max n1 n2) ns then "NO" else "YES"

check :: Maybe Int -> (Int, Int) -> Maybe Int
check Nothing _ = Nothing
check (Just l) (n1, n2)
    | l >= man = Just man
    | l >= mn = Just mn
    | otherwise = Nothing
        where mn = min n1 n2
              man = max n1 n2

module Main where

import Control.Monad
import Data.List
import Data.Maybe

pr :: String -> (Int, Int)
pr str = (read f :: Int, read s :: Int)
  where
    [f, s] = words str

f :: (Int, Bool) -> (Int, Int) -> (Int, Bool)
f (lv, r) (cw, ch)
  | not r = (lv, r)
  | max cw ch <= lv = (max cw ch, r)
  | min cw ch <= lv = (min cw ch, r)
  | otherwise = (lv, False)

solve :: String -> String
solve s
  | ans = "YES"
  | not ans = "NO"
  where
    r = map pr (tail (lines s))
    (_, ans) = foldl f (maxBound :: Int, True) r

main = interact $! solve

{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $! solve

toInt :: String -> Int
toInt s = read s :: Int

solve :: String -> String
solve s = check (tail (map words (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre =
    if | max w h <= pre -> check xs (max w h)
       | min w h <= pre -> check xs (min w h)
       | otherwise -> "NO"
    where
        [ws, hs] = x
        w = toInt ws
        h = toInt hs

{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $! solve

solve :: String -> String
solve s = check (map words (tail (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre
      | max w h <= pre = check xs (max w h)
      | min w h <= pre = check xs (min w h)
      | otherwise = "NO"
    where
        [ws, hs] = x
        w = read ws :: Int
        h = read hs :: Int

{- <ღ> Haskell -}
{-# LANGUAGE MultiWayIf #-}
module Main where

main :: IO ()
main = interact $ solve

toInt :: String -> Int
toInt s = read s :: Int

solve :: String -> String
solve s = check (tail (map words (lines s))) 1000000000

check :: [[String]] -> Int -> String
check [] pre = "YES"
check (x:xs) pre =
    if | max w h <= pre -> check xs (max w h)
       | min w h <= pre -> check xs (min w h)
       | otherwise -> "NO"
    where
        [ws, hs] = x
        w = toInt ws
        h = toInt hs


The round carousel consists of $$$n$$$ figures of animals. Figures are numbered from $$$1$$$ to $$$n$$$ in order of the carousel moving. Thus, after the $$$n$$$-th figure the figure with the number $$$1$$$ follows. Each figure has its own type — the type of the animal corresponding to this figure (the horse, the tiger and so on). The type of animal of the $$$i$$$-th figure equals $$$t_i$$$.    The example of the carousel for $$$n=9$$$ and $$$t=[5, 5, 1, 15, 1, 5, 5, 1, 1]$$$. You want to color each figure in one of the colors. You think that it's boring if the carousel contains two different figures (with the distinct types of animals) going one right after another and colored in the same color.Your task is to color the figures in such a way that the number of distinct colors used is the minimum possible and there are no figures of the different types going one right after another and colored in the same color. If you use exactly $$$k$$$ distinct colors, then the colors of figures should be denoted with integers from $$$1$$$ to $$$k$$$.

The input contains one or more test cases. The first line contains one integer $$$q$$$ ($$$1 \le q \le 10^4$$$) — the number of test cases in the test. Then $$$q$$$ test cases follow. One test case is given on two lines. The first line of the test case contains one integer $$$n$$$ ($$$3 \le n \le 2 \cdot 10^5$$$) — the number of figures in the carousel. Figures are numbered from $$$1$$$ to $$$n$$$ in order of carousel moving. Assume that after the $$$n$$$-th figure the figure $$$1$$$ goes. The second line of the test case contains $$$n$$$ integers $$$t_1, t_2, \dots, t_n$$$ ($$$1 \le t_i \le 2 \cdot 10^5$$$), where $$$t_i$$$ is the type of the animal of the $$$i$$$-th figure. The sum of $$$n$$$ over all test cases does not exceed $$$2\cdot10^5$$$.

Print $$$q$$$ answers, for each test case print two lines. In the first line print one integer $$$k$$$ — the minimum possible number of distinct colors of figures. In the second line print $$$n$$$ integers $$$c_1, c_2, \dots, c_n$$$ ($$$1 \le c_i \le k$$$), where $$$c_i$$$ is the color of the $$$i$$$-th figure. If there are several answers, you can print any.

import Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (words >>> map read)
  >>> process
  >>> map (map show >>> unwords) >>> unlines

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n]:a:rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[foldl1 max fin], fin]
  where
    nn = fromIntegral n
    fin
      | a == (take nn $ repeat (head a)) = take nn $ repeat 1
      | head cols == head (reverse cols)
          && head a /= head (reverse a) =
            case newcols of Nothing -> 3 : tail cols
                            (Just a) -> a
      | otherwise = cols
          where newcols = update cols

    cols = colour 1 a

    update :: [Integer] -> Maybe [Integer]
    update [] = Nothing
    update [_] = Nothing
    update (x:y:rest)
      | x == y = Just (x : map (pick True) (y : rest))
      | otherwise = case rec of (Just a) -> Just (x : a)
                                Nothing -> Nothing
        where rec = update (y : rest)

    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [x] = [cur]
    colour cur (x:y:rest) = cur : colour (pick (x /= y) cur) (y : rest)

    pick :: Bool -> Integer -> Integer
    pick fl x
      | fl = 3 - x
      | otherwise = x

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.Bool (bool)
import safe Data.Maybe (fromMaybe)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map (map show >>> unwords)
      >>> unlines

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[maximum fin], fin]
  where
    nn = fromIntegral n
    fin
      | all (== head a) a = replicate nn 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Integer] -> Maybe [Integer]
    update [] = Nothing
    update [_] = Nothing
    update (x : x' : xs)
      | x == x' = Just (x : map (pick True) (x' : xs))
      | otherwise = (x :) <$> update (x' : xs)

    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Integer -> Integer
    pick fl x = bool x (3 - x) fl

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.Bool (bool)
import safe Data.Maybe (fromMaybe)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map (map show >>> unwords)
      >>> unlines

process :: [[Int]] -> [[Int]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Int -> [Int] -> [[Int]]
solve n a = [[maximum fin], fin]
  where
    fin
      | all (== head a) a = replicate n 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Int] -> Maybe [Int]
    update [] = Nothing
    update [_] = Nothing
    update (x : xs)
      | x == head xs = Just (x : map (pick True) xs)
      | otherwise = (x :) <$> update xs

    colour :: Int -> [Int] -> [Int]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Int -> Int
    pick fl x = bool x (3 - x) fl

{-# LANGUAGE Safe #-}

import safe Control.Arrow ((>>>))
import safe Data.Bool (bool)
import safe Data.Maybe (fromMaybe)

main :: IO ()
main =
  interact $
    lines
      >>> drop 1
      >>> map (words >>> map read)
      >>> process
      >>> map (map show >>> unwords)
      >>> unlines

process :: [[Int]] -> [[Int]]
process [] = []
process ([n] : a : rest) = solve n a ++ process rest

solve :: Int -> [Int] -> [[Int]]
solve n a = [[maximum fin], fin]
  where
    nn = fromIntegral n
    fin
      | all (== head a) a = replicate nn 1
      | head cols == last cols && head a /= last a =
        fromMaybe (3 : tail cols) (update cols)
      | otherwise = cols

    cols = colour 1 a

    update :: [Int] -> Maybe [Int]
    update [] = Nothing
    update [_] = Nothing
    update (x : x' : xs)
      | x == x' = Just (x : map (pick True) (x' : xs))
      | otherwise = (x :) <$> update (x' : xs)

    colour :: Int -> [Int] -> [Int]
    colour _ [] = []
    colour cur [_] = [cur]
    colour cur (x : x' : xs) = cur : colour (pick (x /= x') cur) (x' : xs)

    pick :: Bool -> Int -> Int
    pick fl x = bool x (3 - x) fl

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex; arr2 = if even p then [1,2] else [2,1]
                in take p (cycle [2,1]) ++ take (n-p) (cycle arr2)
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex :: [Int]
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 (xs++[head xs])) [1..]

import Control.Monad (replicateM_)
import Data.List (nub)

main = do
    numTests <- read <$> getLine
    replicateM_ numTests $ do
        n <- read <$> getLine
        ts <- words <$> getLine
        if same ts then do
            print 1
            putStrLn $ unwords $ replicate n "1"
        else if n `mod` 2 == 0 then do
            print 2
            putStrLn $ unwords $ concat $ replicate (div n 2) ["1", "2"]
        else case consec 0 (head ts) ts of
            Just i -> do
                print 2
                putStrLn $ unwords $ repeatNth i $ concat $
                    replicate (div n 2) ["1", "2"]
            Nothing -> do
                print 3
                putStrLn $ unwords $ ("3" :) $ concat $
                    replicate (div n 2) ["1", "2"]

same (x:xs@(y:_)) = x == y && same xs
same _ = True

consec _ _ [] = Nothing
consec i x [y] = if x == y then Just i else Nothing
consec i s (x:y:zs) = if x == y then Just i else consec (i + 1) s (y:zs)

repeatNth n (x:xs) =
    if n == length xs + 1
    then (x:xs) ++ [x]
    else repeatNth' n (x:xs)

repeatNth' 0 (x:xs) = x:x:xs
repeatNth' n (x:xs) = x : repeatNth' (n-1) xs

import Control.Arrow

main = interact $
  lines >>> drop 1 >>> map (words >>> map read)
  >>> process
  >>> map (map show >>> unwords) >>> unlines

process :: [[Integer]] -> [[Integer]]
process [] = []
process ([n]:a:rest) = solve n a ++ process rest

solve :: Integer -> [Integer] -> [[Integer]]
solve n a = [[foldl1 max fin], fin]
  where
    fin
      | head cols == head (reverse cols)
          && head a /= head (reverse a) = 3 : tail cols
      | otherwise = cols
    cols = colour 1 a
    colour :: Integer -> [Integer] -> [Integer]
    colour _ [] = []
    colour cur [x] = [cur]
    colour cur (x:y:rest)
      | x == y = cur : colour cur (y : rest)
      | otherwise = cur : colour (3 - cur) (y : rest)

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex; arr2 = if even p then [1,2] else [2,1]
                in take p (cycle [2,1]) ++ take (n-p) (cycle arr2)
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex :: [Int]
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 xs) [1..]

import Control.Monad (replicateM_)

getList :: Read b => IO [b]
getList = map read . words <$> getLine

maybeTake :: (Eq i, Num i) => i -> [a] -> Maybe [a]
maybeTake 0 _ = Just []
maybeTake _ [] = Nothing
maybeTake n (x:xs) = (x:) <$> maybeTake (n-1) xs

slices :: (Eq i, Num i) => i -> [a] -> [[a]]
slices n xs = case maybeTake n xs of
    Nothing -> []
    Just p -> p : slices n (tail xs)

main = readLn >>= flip replicateM_ solveIO

solveIO = do
    n <- readLn
    arr <- getList
    putStrLn . (\x -> show (head x) ++ "\n" ++ (unwords $ map show x)) $ solve n arr

solve ::  Int -> [Int] -> [Int]
solve n xs | all (== head xs) xs = replicate n 1
           | even n = take n $ cycle [2,1]
           | repIndex /= [] = let p = head repIndex in take p (cycle [2,1]) ++ take (n-p) (cycle [1,2])
           | otherwise = 3 : (take (n-1) $ cycle [2,1])
           where
                repIndex = map snd . filter (\([a,b], c) -> a == b) $ zip (slices 2 xs) [1..]


Finally, a basketball court has been opened in SIS, so Demid has decided to hold a basketball exercise session. $$$2 \cdot n$$$ students have come to Demid's exercise session, and he lined up them into two rows of the same size (there are exactly $$$n$$$ people in each row). Students are numbered from $$$1$$$ to $$$n$$$ in each row in order from left to right.  Now Demid wants to choose a team to play basketball. He will choose players from left to right, and the index of each chosen player (excluding the first one taken) will be strictly greater than the index of the previously chosen player. To avoid giving preference to one of the rows, Demid chooses students in such a way that no consecutive chosen students belong to the same row. The first student can be chosen among all $$$2n$$$ students (there are no additional constraints), and a team can consist of any number of students. Demid thinks, that in order to compose a perfect team, he should choose students in such a way, that the total height of all chosen students is maximum possible. Help Demid to find the maximum possible total height of players in a team he can choose.

The first line of the input contains a single integer $$$n$$$ ($$$1 \le n \le 10^5$$$) — the number of students in each row. The second line of the input contains $$$n$$$ integers $$$h_{1, 1}, h_{1, 2}, \ldots, h_{1, n}$$$ ($$$1 \le h_{1, i} \le 10^9$$$), where $$$h_{1, i}$$$ is the height of the $$$i$$$-th student in the first row. The third line of the input contains $$$n$$$ integers $$$h_{2, 1}, h_{2, 2}, \ldots, h_{2, n}$$$ ($$$1 \le h_{2, i} \le 10^9$$$), where $$$h_{2, i}$$$ is the height of the $$$i$$$-th student in the second row.

Print a single integer — the maximum possible total height of players in a team Demid can choose.

NoteIn the first example Demid can choose the following team as follows:   In the second example Demid can choose the following team as follows:

import Prelude hiding (lookup)
import Data.Sequence

solve_recurse n a b i =
  if i == n - 1 then
    singleton (index a i, index b i)
  else
    (<|) dpi dp
    where
      dp = solve_recurse n a b (i + 1)
      x = (snd $ index dp 0) + index a i
      y = (fst $ index dp 0) + index b i
      dpi = (max x (fst $ index dp 0), max y (snd $ index dp 0))

solve n a b =
  max (fst $ index dp 0) (snd $ index dp 0)
  where
    dp = solve_recurse n a b 0

main :: IO ()
main = do
  line <- getLine
  let n = read line :: Int

  line <- getLine
  let a = fromList (map read (words line) :: [Integer])

  line <- getLine
  let b = fromList (map read (words line) :: [Integer])

  putStrLn $ show $ solve n a b