{-# LANGUAGE OverloadedStrings #-}
module Main where

import qualified Data.Set as Set
import qualified Data.Text as T

main :: IO ()
main = do
    input <- getLine
    let input2 = T.pack . drop 1 . take (length input - 1) $ input
        splitted = map T.strip . T.splitOn "," $ input2
        l = Set.fromList . filter (not . T.null) $ splitted
    putStrLn . show $ Set.size l
    pure ()

{-# LANGUAGE ScopedTypeVariables #-}

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import qualified Data.ByteString.Char8 as C
import qualified Data.Foldable         as F
import           Data.Function
import           Data.Functor
import           Data.IORef
import           Data.List
import           Data.Maybe
import           Data.Monoid
import           Data.Traversable
import           Text.Printf           (printf)

import qualified Data.Set as S
import Data.Char

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

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

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Integral b) => a -> b
cast = fromIntegral

-----

main :: IO ()
main = do
  s <- getLine
  print $ length $ S.toList $ S.fromList $ words $ map (\c -> if isAlpha c then c else ' ') s

import Data.List (nub)

main :: IO()
main  =  getLine >>= print . length . nub . filter (not . flip elem "{}, ")

import Data.Char
import Data.List
main=interact$show.length.nub.filter(isLetter)

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import qualified Data.List as List
import qualified Data.Set  as Set
import qualified Data.Char as Char

lstrip :: String -> String
lstrip = dropWhile Char.isSpace
rstrip = reverse . lstrip . reverse
strip  = lstrip . rstrip

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

parse :: String -> [String]
parse s = map strip $ splitOn ',' $ (init . tail) s

solve :: String -> Int
solve = length . List.nub . parse

main :: IO ()
main = do
  s <- getLine
  putStrLn $ (show . solve) s

import Data.List (nub)
import Data.Char (isAlpha)

main = interact $ show . length . nub . filter isAlpha

import Control.Monad
import Data.Array
import Data.Char
import Data.Functor
import Data.Int
import Data.List
import Data.List.Split
import Data.Maybe
-- import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
getList :: Read a => IO [a]
getList = map (read . B.unpack) . B.words <$> B.getLine
getIntList :: IO [Int]
getIntList = unfoldr (B.readInt . B.dropWhile isSpace) <$> B.getLine

solve :: String -> Int
solve = length . nub . filter (`notElem` "{, }")

main :: IO ()
main = do
    s <- getLine
    print $ solve s

import Control.Applicative
import Data.Char (isAlpha)
import Data.List (group, sort)

main = do
  s <- getLine
  putStrLn . show $ length . group . sort $ filter isAlpha s

import Data.List
import Data.Char

main = interact entry
    where entry input = show cnt
            where cnt = (length . nub) (filter isAlpha input)

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

main=do
   a<-show <$> length  <$> group <$> sort <$> filter (isLower) <$> init <$> tail <$> getLine
   putStrLn a

import Data.Char (isAlpha)
import Data.List (group, sort)

main :: IO ()
main = getLine >>= print . solve . filter isAlpha

solve :: String -> Int
solve = length . group . sort

import Data.Char
import Data.List
main = print . length . nub . filter isLetter =<< getContents

import qualified Data.Set as Set

main :: IO()
main = do
  xs <- getLine
  print $ Set.size $ foldl (\acc el -> Set.insert el acc) Set.empty $ trim $ xs
      where
          trim [] = []
          trim (x:xs)
              | x >= 'a' && x <= 'z' = x : trim xs
              | otherwise = trim xs

-- Vicfred
-- https://codeforces.com/problemset/problem/443/A

import Data.List

solve :: String -> Int
solve = length . nub . filter (`notElem` "{, }")

main :: IO ()
main = do
    s <- getLine
    print $ solve s

import Data.List

process :: String -> Int
process [] = 0
process xs = length $ nub $ filter (\x -> x >= 'a' && x <= 'z') xs

main = do
	str <- getLine
	putStrLn $ show $ process str

import Data.Char
import Data.List
main :: IO ()
main = fmap (length . nub . filter isAlpha) getLine >>= print

import Data.List

main = getLine >>= print.length.(flip (\\) "{, }").nub

import Control.Applicative
import Data.List
import qualified Data.Set as S

repl '{' = ' '
repl '}' = ' '
repl ',' = ' '
repl x = x

main= do
	a<- getLine
	print $ length $ S.toList $ S.fromList $ words $ map repl a

import           Data.Char
import           Data.Set as S  (fromList)
main :: IO ()
main = print =<< length . S.fromList . filter isAlpha <$> getLine

getUnique :: [String] -> [Char] -> Int
getUnique [] _ = 0
getUnique (x:xs) letList
    | not $ curLet `elem` letList = 1 + getUnique xs (curLet:letList)
    | otherwise = getUnique xs letList
    where curLet = head x

main = do
    ln <- getLine
    let lets = words $ tail (init ln)
    putStrLn . show $ getUnique lets []

import Data.Char (isLetter)
import Data.List (nub)

main = interact $ show . length . nub . filter isLetter

import Data.List

main = getLine >>= print . length . nub . solve

solve "}"  = ""
solve ('{':ls) = solve ls
solve (',':ls) = solve ls
solve (' ':ls) = solve ls
solve (l:ls)   = l:(solve ls)

import qualified Data.Text as T
import Data.List

process :: [String] -> Int
process = length.nub

parse :: String -> [String]
parse "{}" = []
parse xs = map T.unpack $ T.splitOn (T.pack ", ") (T.pack.tail.init$xs)

main = do
    xs <- getLine
    print $ process $ parse xs

import Data.List
main = do interact $ show . length . nub . del
    where   del [] = []
            del (x:xs)
                | 'a' <= x && x <= 'z' = x : del xs
                | otherwise            = del xs

import Data.List.Split
import Data.List

solve :: String -> String
solve = show . length . nub .
            split ((dropBlanks. dropDelims .oneOf) "}{, \n")

main :: IO ()
main= interact $ solve

import Data.List
import Data.Char

solve :: String -> String
solve = show . length . nub . filter isLetter

main :: IO ()
main= interact $ solve

module Main where

import Data.Set (toList, fromList)

uniquify = toList . fromList

main = do
	s <- getLine
	putStr $ show $ uniqueNumber s

uniqueNumber :: String -> Int
uniqueNumber = length . uniquify . words . cleanString where
	cleanString = filter (not . (`elem` ",{}"))

import Data.List
f str = filter (\x->not (elem x "{, }\n")) str
main = interact $ show . length .  nub . f

import           Control.Applicative
import           Control.Monad
import           Data.List
import qualified Data.Map            as Map
import qualified Data.Set            as Set

parse :: Char -> Char
parse c
  | c == '{' = ' '
  | c == '}' = ' '
  | c == ',' = ' '
  | otherwise = c

solve :: String -> Int
solve s =
  let input = (words . map parse) s
      noDuplicates = Set.fromList input
      ans = Set.toList noDuplicates
  in length ans

main = do
  input <- getLine
  print $ solve input

module Main where

import Data.List (nub)

main :: IO ()
main = do
	ln <- getLine
	print $ process ln

process :: String ->  Int
process = length . nub . readLetters

readLetters :: String -> [Char]
readLetters (' ' : cs) = readLetters cs
readLetters ('{' : cs) = items cs
items [] = []
items ('}' : cs) = []
items (' ' : cs) = items cs
items (',' : cs) = items cs
items (c : cs) = c : items cs

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

genAns [] = 0
genAns [x] = 1
genAns xs = max 0 $ (length $ nub xs) - 2

main = do
  aa <- getLine
  let ls = tail $ take (length aa - 1) aa
  print $ genAns ls

import Data.Char
import Data.List
f s = show $ length $ nub $ filter isLetter s
main = interact f

import Data.List
main = do
    s <- getLine
    putStrLn $ show $ length $ func s

func :: String -> String
func s = nub [x | x <- s, x `elem` ['a'..'z']]

check [] y           = length y
check (x:xs) y
  | not (x `elem` y) = check xs (x:y)
  | otherwise        = check xs y

trim = f . f . filter (/=',') where f = reverse . drop 1

main = getLine >>= return . (flip check) [] . words . trim >>= putStrLn . show

import Data.List

main :: IO()
main = interact $ show . length . nub . filter (\c -> 'a' <= c && c <= 'z')

s l = [x|x<-l,'a'<=x,x<='z']

d l ch k
    |ch == 'z' =(k+t)
    |otherwise = d l (succ ch) (k+t)
    where t = if null [0|x<-l,x==ch] then 0 else 1

n x = d (s x) 'a' 0

main = do
    s <- getLine
    print (n s)

import Data.List
solve s = length $ nub $ concat $ map words$ splitOn ',' $ init $ tail $ s

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

main = do
  s<-getLine
  putStrLn $show$solve s

import Data.Set as Set
import Data.Char

main = interact $ show.f
f x = size (Set.fromList (Prelude.filter isLetter x))

import Data.List
import Data.Function
import Data.Char

main = interact $ show . length . nub . filter (isAlpha)

import Data.List
import Data.List.Split

main = do
  s <- getLine
  let xs = splitOn ", " $ tail $ init s

  print $ length $ group $ filter (not . null) $ sort xs

import Data.List as L
import Data.Char as C
main = interact $ show . length . L.nub . filter C.isLower

import Data.List

main = do
       a <- getLine
       let b = length $ nub $ filter (\c -> c >= 'a' && c <= 'z') a
       putStrLn $ show b

import Data.List (nub)
import Data.Char (isAlpha)
main =
	interact $ show. length. nub. filter isAlpha

import Data.List
import Data.Maybe
main=   readsolveprint
readsolveprint::IO()
readsolveprint =  interact $ show.solve. words. (\a->if a=="" then a else a++",").init.tail.head . lines
solve :: [String]->Int
solve xss =  length $ slv1 xss
slv1 []=[]
slv1 (xs:xss) = xs:slv1 [ys|ys<-xss,ys/=xs]

import Data.Char

h :: String -> [Char] -> Int
h "}" a = count a
h ('{':s) a = h s a
h (',':xs) s = h xs s
h (' ':xs) s = h xs s
h (x:xs) s = h xs (s++[x])

count :: [Char] -> Int

count a = length b
 where b = rmdups a

rmdups [] = []
rmdups (x:xs)
 | x `elem` xs = rmdups xs
 | x == '"' = rmdups xs
 | otherwise = x : rmdups xs

main = do
 line <- getLine
 print (h line [])

hi :: String -> [Char] -> [Char]
hi "}" a = a
hi ('{':s) a = hi s a
hi (',':xs) s = hi xs s
hi (' ':xs) s = hi xs s
hi (x:xs) s = hi xs (s++[x])

import qualified Data.Set as S
import Control.Applicative

solve :: String -> Int
solve s = S.size.S.fromList $ filter (not.(`elem` "{, }")) s

main = do
    l <- getLine
    putStrLn . show $ solve l

import Data.List
solve s = length $ nub $ splitOn ',' $ init $ tail $ s

splitOn::Char->String->[String]
splitOn f [] = []
splitOn f ss = [takeWhile (/=f) ss] ++ splitOn f (stail (dropWhile (/=f) ss))

stail [] = []
stail (s:[]) = []
stail s = tail s

main = do
  s<-getLine
  putStrLn $show$solve s

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 3
  | otherwise = (length x) - 1

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 3
  | otherwise = length x

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 2
  | otherwise = length x

import Data.Set as Set

main = interact $ show.f.tail.init
f x
  | (length x) > 1 = (size (Set.fromList x)) - 1
  | otherwise = length x

import Data.List
import Data.List.Split

main = do
  s <- getLine
  let xs = splitOn ", " $ tail $ init s
  print $ length $ group $ sort xs

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}

import Control.Applicative
import qualified Data.List    as List
import qualified Data.Set     as Set

splitWhen :: (a -> Bool) -> [a] -> [[a]]
splitWhen p l = splitWhenAux l []
  where
    splitWhenAux []    []            = []
    splitWhenAux []    b@(_:_)       = [b]
    splitWhenAux (h:t) b | (p h)     = (reverse b) : (splitWhenAux t [])
                         | otherwise = splitWhenAux t (h:b)

splitOn :: Eq a => a -> [a] -> [[a]]
splitOn n l = splitWhen (n ==) l

parse :: String -> [String]
parse s = splitOn ',' $ (init . tail) s

solve :: String -> Int
solve = length . List.nub . parse

main :: IO ()
main = do
  s <- getLine
  putStrLn $ (show . solve) s

import Control.Applicative
import Data.List
import Data.List.Split

main=do
   a<-show <$> length <$> filter (/=[""]) <$> group <$> sort <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Control.Applicative
import Data.List
import Data.List.Split

check n | le >1 = snd $ head $ filter (\z-> odd (fst z)) $ zip n [1..]
        | otherwise = snd $ head $ filter (\z-> even (fst z)) $ zip n [1..]
  where le = length $ filter even n

main=do
   a<-show <$> length <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Control.Applicative
import Data.List
import Data.List.Split

main=do
   a<-show <$> length <$> group <$> sort <$> splitOn "," <$> init <$> tail <$> getLine
   putStrLn a

import Data.List

main = getLine >>= print.(max 0).(flip (-) 4).length.nub

import Data.List

main = getLine >>= print.(flip (-) 4).length.nub

import Data.List

main = getLine >>= print . length . nub . solve

solve "}"  = ""
solve ('{':ls) = solve ls
solve ('.':ls) = solve ls
solve (' ':ls) = solve ls
solve (l:ls)   = l:(solve ls)

f str = filter (\x->not (elem x "{, }\n")) str
g str = filter (\x-> length(filter (==x) str) ==1 ) str
main = interact $ g . f

f str = filter (\x->not (elem x "{, }\n")) str
g str = filter (\x-> length(filter (==x) str) ==1 ) str
main = interact $ show . length .  g . f


{-# LANGUAGE BangPatterns #-}

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L
import qualified Data.Maybe as Mb
import Data.Function
import Data.Int

transform :: [Int16] -> [Int16]
transform lst = map (m Map.!) lst
    where
        unique = map head $ L.group $ L.sort lst
        m = Map.fromAscList $ zip unique [0..]

type PrefixSums = Array Int16 (Array Int32 Int32)

makePrefixSum :: (Num a) => [a] -> [a]
makePrefixSum lst = 0 : go 0 lst
    where
        go aux [] = []
        go aux (e:es) = aux+e : go (aux+e) es

makePrefixSums :: [Int16] -> PrefixSums
makePrefixSums lst = Ar.listArray (0,mx) $ map prefixSumMapper [0..mx]
    where
        n = fromIntegral $ length lst
        mx = fromIntegral $ maximum lst
        prefixSumMapper i = Ar.listArray (0, n) $ makePrefixSum $ map mapperF lst
            where
                mapperF j = if j == i then 1 else 0

frequency :: PrefixSums -> Int16 -> (Int32, Int32) -> Int32
frequency vecVec i (start, end) = endSum - startSum
    where
        vec = vecVec Ar.! i
        endSum = vec Ar.! (end+1)
        startSum = vec Ar.! start

makeIndexList :: [Int16] -> [[Int32]]
makeIndexList lst = map (map snd) $ L.groupBy ((==) `on` fst) $ L.sort $ zip lst [0..]

maxValue :: Int16 -> (Int16 -> (Int32, Int32) -> Int32) -> [(Int32, Int32)] -> Int32
maxValue _ _ [] = 0
maxValue mx frequencyGetter indexes = maximum [2*c + frequencyGetter i (start+1,end-1) | (c, (start,end)) <- zip [1..] indexes, i <- [0..mx]]

solve :: [Int16] -> Int32
solve rawLst = maximum $ defaultAns : map (maxValueGetter . makeStartEndPairs) indexList
    where
        !lst = transform rawLst
        mx = maximum lst
        !defaultAns = fromIntegral $ maximum $ map length $ L.group $ L.sort lst
        !indexList = makeIndexList lst
        makeStartEndPairs indexes = take (length indexes `div` 2) $ zip indexes (reverse indexes)
        !frequencyGetter = frequency (makePrefixSums lst)
        !maxValueGetter = maxValue mx frequencyGetter

{-
getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

dec :: Int -> Map Int Int -> Map Int Int -> (Map Int Int, Map Int Int)
dec n remaining remainingInv = (newRemaining, newRemainingInv2)
    where
        count = remaining Map.! n
        newRemaining = Map.adjust pred n remaining
        newRemainingInv1 = Map.adjust pred count remainingInv
        newRemainingInv2 = Map.alter (Just . succ . Mb.fromMaybe 0) (count-1) newRemainingInv1

createInvPair :: Map Int Int -> (Map Int Int, Map Int Int)
createInvPair remaining = (remaining, inv)
    where
        values = Map.elems remaining
        inv = getCounts values

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> (Map Int Int, Map Int Int) -> Int
        helper n nCount start end (remaining, remainingInv)
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) (remaining, remainingInv))
            | eVal /= n
                = helper n nCount start (end-1) (dec eVal remaining remainingInv)
            | otherwise
                = helper n nCount (start+1) end (dec sVal remaining remainingInv)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (createInvPair $ Map.delete n counts)
-}

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts16
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

readInts32 :: IO [Int32]
readInts32 = map read . words <$> getLine

readInts16 :: IO [Int16]
readInts16 = map read . words <$> getLine

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L
import qualified Data.Maybe as Mb
import Data.Function

transform :: [Int] -> [Int]
transform lst = map (m Map.!) lst
    where
        unique = map head $ L.group $ L.sort lst
        m = Map.fromAscList $ zip unique [0..]

type Vector = Array Int

type PrefixSums = Vector (Vector Int)

makePrefixSum :: [Int] -> [Int]
makePrefixSum lst = 0 : go 0 lst
    where
        go aux [] = []
        go aux (e:es) = aux+e : go (aux+e) es

makePrefixSums :: [Int] -> PrefixSums
makePrefixSums lst = Ar.listArray (0,mx) $ map prefixSumMapper [0..mx]
    where
        n = length lst
        mx = maximum lst
        prefixSumMapper i = Ar.listArray (0, n) $ makePrefixSum $ map mapperF lst
            where
                mapperF j = if j == i then 1 else 0

frequency :: PrefixSums -> Int -> (Int, Int) -> Int
frequency vecVec i (start, end) = endSum - startSum
    where
        vec = vecVec Ar.! i
        endSum = vec Ar.! (end+1)
        startSum = vec Ar.! start

makeIndexList :: [Int] -> [[Int]]
makeIndexList lst = map (map snd) $ L.groupBy ((==) `on` fst) $ L.sort $ zip lst [0..]

maxValue :: Int -> (Int -> (Int, Int) -> Int) -> [(Int, Int)] -> Int
maxValue _ _ [] = 0
maxValue mx frequencyGetter indexes = maximum [2*c + frequencyGetter i (start+1,end-1) | (c, (start,end)) <- zip [1..] indexes, i <- [0..mx]]

solve :: [Int] -> Int
solve rawLst = maximum $ defaultAns : map (maxValueGetter . makeStartEndPairs) indexList
    where
        lst = transform rawLst
        mx = maximum lst
        defaultAns = maximum $ map length $ L.group $ L.sort lst
        indexList = makeIndexList lst
        makeStartEndPairs indexes = take (length indexes `div` 2) $ zip indexes (reverse indexes)
        frequencyGetter = frequency (makePrefixSums lst)
        maxValueGetter = maxValue mx frequencyGetter

{-
getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

dec :: Int -> Map Int Int -> Map Int Int -> (Map Int Int, Map Int Int)
dec n remaining remainingInv = (newRemaining, newRemainingInv2)
    where
        count = remaining Map.! n
        newRemaining = Map.adjust pred n remaining
        newRemainingInv1 = Map.adjust pred count remainingInv
        newRemainingInv2 = Map.alter (Just . succ . Mb.fromMaybe 0) (count-1) newRemainingInv1

createInvPair :: Map Int Int -> (Map Int Int, Map Int Int)
createInvPair remaining = (remaining, inv)
    where
        values = Map.elems remaining
        inv = getCounts values

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> (Map Int Int, Map Int Int) -> Int
        helper n nCount start end (remaining, remainingInv)
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) (remaining, remainingInv))
            | eVal /= n
                = helper n nCount start (end-1) (dec eVal remaining remainingInv)
            | otherwise
                = helper n nCount (start+1) end (dec sVal remaining remainingInv)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (createInvPair $ Map.delete n counts)
-}

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

import Control.Monad (forM_)
import Data.List (sort)

solve xs = if length ids == 1 then length xs else res where
	sorted = sort xs
	ids = go sorted where
		go (x:xs) = x : go (dropWhile (==x) xs)
		go [] = []

	res = maximum [ solveTwo a b (filter (\k -> k == a || k == b) xs)| a <- ids, b <- ids, a /= b]

	solveTwo a b xs = maximum $ go a b xs (reverse xs) 0 (length $ filter (== b) xs) where
		total_a_count = length $ filter (==a) xs
		go a b xs rxs acount bcount = let
				(b1, xs') = strip xs 0
				(b2, rxs') = strip rxs 0
				acount' = acount + 2
				bcount' = bcount - b1 - b2
			in
				if acount > total_a_count then [total_a_count] else (acount + bcount) : go a b xs' rxs' acount' bcount'

			where
				strip (x:xs) acc
					| x == a = (acc, xs)
					| x == b = strip xs (acc + 1)

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		n <- fmap read getLine :: IO Int
		xs <- fmap (map read.words) getLine :: IO [Int]
		print (solve xs)

import qualified Data.Map.Strict as Map
import Data.Map (Map)
import qualified Data.Array as Ar
import Data.Array (Array)
import qualified Data.List as L

getCounts :: [Int] -> Map Int Int
getCounts lst = Map.fromList $ map mapper grouping
    where
        grouping = L.group . L.sort $ lst
        mapper as = (head as, length as)

solve :: [Int] -> Int
solve lst = maximum $ map mapper lst
    where
        arr = Ar.listArray (0, length lst - 1) lst
        counts = Map.insert 0 0 $ getCounts lst
        helper :: Int -> Int -> Int -> Int -> Map Int Int -> Int
        helper n nCount start end remaining
            | start >= end  = counts Map.! n
            | sVal == n && eVal == n
                = max (nCount + 2 + maximum (Map.elems remaining)) (helper n (nCount+2) (start+1) (end-1) remaining)
            | eVal /= n
                = helper n nCount start (end-1) (Map.adjust pred eVal remaining)
            | otherwise
                = helper n nCount (start+1) end (Map.adjust pred sVal remaining)
            where
                sVal = arr Ar.! start
                eVal = arr Ar.! end
        mapper n = helper n 0 0 (length lst - 1) (Map.delete n counts)

testCases :: Int -> IO ()
testCases 0 = return ()
testCases t = do
    _ <- readInts
    lst <- readInts
    print $ solve lst
    testCases (t-1)

main :: IO ()
main = do
    (t:_) <- readInts
    testCases t

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

import Control.Monad (forM_)
import Data.List (sort)

solve xs = if length ids == 1 then length xs else res where
	sorted = sort xs
	ids = go sorted where
		go (x:xs) = x : go (dropWhile (==x) xs)
		go [] = []

	res = maximum [ solveTwo a b (filter (\k -> k == a || k == b) xs)| a <- ids, b <- dropWhile (<= a) ids]

	solveTwo a b xs = maximum $ go a b xs (reverse xs) 0 (length $ filter (== b) xs) where
		total_a_count = length $ filter (==a) xs
		go a b xs rxs acount bcount = let
				(b1, xs') = strip xs 0
				(b2, rxs') = strip rxs 0
				acount' = acount + 2
				bcount' = bcount - b1 - b2
			in
				if acount > total_a_count then [total_a_count] else (acount + bcount) : go a b xs' rxs' acount' bcount'

			where
				strip (x:xs) acc
					| x == a = (acc, xs)
					| x == b = strip xs (acc + 1)

main = do
	t <- fmap read getLine
	forM_ [1..t] $ \i -> do
		n <- fmap read getLine :: IO Int
		xs <- fmap (map read.words) getLine :: IO [Int]
		print (solve xs)


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

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR (zip ln ls ++ acc) namestack surnamestack diff (ns', ss')

    | countn > counts && diff == 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) (push ln'' namestack) surnamestack (countn - counts) (ns', ss')

    | countn > counts && diff > 0       = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff == 0      = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack (push ls'' surnamestack) (countn - counts) (ns', ss')

    | countn < counts && diff > 0       = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

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

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = (names', surnames')
    where
        names'    = prepare names
        surnames' = prepare surnames
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

alignTR accE (accUN, accUS) ([], ss) = (accE, (accUN, accUS ++ (concatMap thrd ss)))
alignTR accE (accUN, accUS) (ns, []) = (accE, (accUN ++ (concatMap thrd ns), accUS))
alignTR accE accU (ns@(n : ns'), ss@(s : ss'))
    | countn == counts && cn == cs   = alignTR ((ln ++ accEN), (ls ++ accES)) accU (ns', ss')
    | cn < cs                        = alignTR accE (accUN ++ ln, accUS) (ns', ss)
    | otherwise                      = alignTR accE (accUN, accUS ++ ls) (ns, ss')
    where
        (accEN, accES) = accE
        (accUN, accUS) = accU
        (countn, cn, ln) = n
        (counts, cs, ls) = s

match ((evenNames, evenSurnames), (unevenNames, unevenSurnames)) =
    sort $ (zip evenNames evenSurnames) ++ (zip unevenNames unevenSurnames)

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . match . (alignTR ([], []) ([], [])) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

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

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR acc (push ln namestack) (push ls surnamestack) diff (ns', ss')
    | countn > counts && diff >= 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (push (zip ln' ls) acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff >= 0      = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (push (zip ln ls') acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

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

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = preparedfullnames
    where
        preparedfullnames = (prepare names, prepare surnames)
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

push [] acc = acc
push (x : xs) acc = push xs (x : acc)

alignTR acc namestack surnamestack _    ([], ss) = zip namestack (push (concatMap thrd ss) surnamestack) ++ acc
alignTR acc namestack surnamestack diff (ns, []) = zip (push (concatMap thrd ns) namestack) surnamestack ++ acc
alignTR acc namestack surnamestack diff (ns@((countn, cn, ln) : ns'), ss@((counts, cs, ls) : ss'))
    | cn < cs                           = alignTR acc (push ln namestack) surnamestack (diff + countn) (ns', ss)
    | cs < cn                           = alignTR acc namestack (push ls surnamestack) (diff - counts) (ns, ss')
    | countn == counts                  = alignTR (zip ln ls ++ acc) namestack surnamestack diff (ns', ss')

    | countn > counts && diff == 0      = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) (push ln'' namestack) surnamestack (countn - counts) (ns', ss')

    | countn > counts && diff > 0       = let (ln', ln'') = splitAt counts ln in
        alignTR (zip ln' ls ++ acc) namestack surnamestack diff ((countn - counts, cn, ln'') : ns', ss')

    | countn > counts && diff < 0       = let draw = min (abs diff) (countn - counts) in let (ln', ln'') = splitAt draw ln in
        alignTR acc (push ln' namestack) surnamestack (diff + draw) ((countn - draw, cn, ln'') : ns', ss)

    | countn < counts && diff == 0      = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack (push ls'' surnamestack) (counts - countn) (ns', ss')

    | countn < counts && diff > 0       = let draw = min diff (counts - countn) in let (ls', ls'') = splitAt draw ls in
        alignTR acc namestack (push ls' surnamestack) (diff - draw) (ns, (counts - draw, cs, ls'') : ss')

    | countn < counts && diff < 0       = let (ls', ls'') = splitAt countn ls in
        alignTR (zip ln ls' ++ acc) namestack surnamestack diff (ns', (counts - countn, cs, ls'') : ss')

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . sort . (alignTR [] [] [] 0) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     putStrLn (solve (names, surnames))

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

import Data.List (groupBy, intercalate, partition, sort)

readNamesTR 0 acc = return acc
readNamesTR n acc = do
    s <- getLine
    readNamesTR (n - 1) (s : acc)

count (names, surnames) = (names', surnames')
    where
        names'    = prepare names
        surnames' = prepare surnames
        prepare = (map tag) . (groupBy sameInit) . sort
        tag x = (length x, (head . head) x, x)
        sameInit name1 name2 = head name1 == head name2

thrd (_, _, x) = x

alignTR accE (accUN, accUS) ([], ss) = (accE, (accUN, accUS ++ (concatMap thrd ss)))
alignTR accE (accUN, accUS) (ns, []) = (accE, (accUN ++ (concatMap thrd ns), accUS))
alignTR accE accU (ns@(n : ns'), ss@(s : ss'))
    | countn == counts && cn == cs   = alignTR ((ln ++ accEN), (ls ++ accES)) accU (ns', ss')
    | cn < cs                        = alignTR accE (accUN ++ ln, accUS) (ns', ss)
    | otherwise                      = alignTR accE (accUN, accUS ++ ls) (ns, ss')
    where
        (accEN, accES) = accE
        (accUN, accUS) = accU
        (countn, cn, ln) = n
        (counts, cs, ls) = s

match ((evenNames, evenSurnames), (unevenNames, unevenSurnames)) =
    sort $ (zip evenNames evenSurnames) ++ (zip unevenNames unevenSurnames)

output cs = intercalate ", " $ map (\(x, y) -> x ++ " " ++ y) cs

solve = output . match . (alignTR ([], []) ([], [])) . count

main = do
     nS <- getLine
     let n = read nS
     names    <- readNamesTR n []
     surnames <- readNamesTR n []
     print (solve (names, surnames))


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

calc :: String -> Int
calc xs = min ynum znum
  where l = length xs
        ys = take l $ cycle "rb"
        zs = take l $ cycle "br"
        ynum = diff xs ys
        znum = diff xs zs

diff :: String -> String -> Int
diff xs ys = max r b
  where zs = zip xs ys
        ds = map fst $ filter (\(x,y) -> x /= y) zs
        (rs,bs) = partition (=='r') ds
        r = length rs
        b = length bs
main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

neg :: Char -> Char
neg 'r' = 'b'
neg 'b' = 'r'

turn :: String -> Char -> (Int, Int)
turn [] _ = (0, 0)
turn (a:rest) 'r'
  | a == 'r'  = turn rest 'b'
  | otherwise = let (x, y) = turn rest 'b' in (1 + x, y)
turn (a:rest) 'b'
  | a == 'b'  = turn rest 'r'
  | otherwise = let (x, y) = turn rest 'r' in (x, 1 + y)

process :: String -> String
process str =
  let [n, rest] = words str
      line      = take (read n) rest
      (xr, yr)  = turn line 'r'
      (xb, yb)  = turn line 'b'
  in show $ min (max xr yr) (max xb yb)

main :: IO ()
main = interact process

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

calc :: String -> Int
calc [] = 0
calc [_] = 0
calc "rr" = 1
calc "bb" = 1
calc [_,_] = 0
calc ('r':'r':'r':xs) = 1 + calc ('r':xs)
calc ('b':'b':'b':xs) = 1 + calc ('b':xs)
calc ('r':'r':xs) = 1 + (calc $ swap $ 'r':xs)
calc ('b':'b':xs) = 1 + (calc $ swap $ 'b':xs)
calc ('r':'b':xs) = calc ('b':xs)
calc ('b':'r':xs) = calc ('r':xs)

swap :: String -> String
swap [] = []
swap [x] = [x]
swap (x:y:xs) = y:x:xs

main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

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

calc :: String -> Int
calc [] = 0
calc [_] = 0
calc "rr" = 1
calc "bb" = 1
calc [_,_] = 0
calc ('r':'r':'r':xs) = 1 + calc xs
calc ('b':'b':'b':xs) = 1 + calc xs
calc ('r':'r':xs) = 1 + (calc $ swap $ 'r':xs)
calc ('b':'b':xs) = 1 + (calc $ swap $ 'b':xs)
calc ('r':'b':xs) = calc ('b':xs)
calc ('b':'r':xs) = calc ('r':xs)

swap :: String -> String
swap [] = []
swap [x] = [x]
swap (x:y:xs) = y:x:xs

main = do
  getLine
  l <- getLine
  putStrLn . show . calc $ l

neg :: Char -> Char
neg 'r' = 'b'
neg 'b' = 'r'

turn :: String -> Char -> Int
turn [c] t
  | c == t    = 0
  | otherwise = 1
turn (a:b:rest) t
  | a == t    = turn (b:rest) (neg t)
  | b == t    = 1 + turn rest t
  | otherwise = 1 + turn (b:rest) (neg t)

process :: String -> String
process str =
  let [n, rest] = words str
      line      = take (read n) rest
  in show $ min (turn line 'r') (turn line 'b')

main :: IO ()
main = interact process


{-# 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 . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

modulo = 7

newtype Modulo = Modulo { getInteger :: Integer } deriving(Eq,Ord)
instance Num Modulo where
    Modulo a + Modulo b = Modulo ((a+b) `mod` modulo)
    Modulo a - Modulo b = Modulo ((a-b) `mod` modulo)
    Modulo a * Modulo b = Modulo ((a*b) `mod` modulo)
    abs (Modulo a) = Modulo (abs a)
    signum (Modulo a) = Modulo (signum a)
    fromInteger i = Modulo i
instance Fractional Modulo where
    recip (Modulo a) = Modulo (modInv a)
    fromRational = undefined

instance Show Modulo where
    show (Modulo i) = show i

modInv i = (modulo + x `mod` modulo) `mod` modulo
    where
    (x,y) = go i modulo
    go a 0 = (1,0)
    go a b = let (y,x) = go b (a `mod` b) in (x,y - a `div` b * x)

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
        n = length s'
        q = getInteger (Modulo 10 ^ n)
    if n == 0 then
        putStrLn "1869"
    else do
        let Just x = find (\x -> (q * x + v) `mod` 7 == 0) [0..]
        putStrLn $ case x of
            0 -> "1869"++s'
            1 -> "1968"++ s'
            2 -> "1689"++ s'
            3 -> "6198"++ s'
            4 -> "1698"++ s'
            5 -> "1986"++ s'
            6 -> "1896"++ s'

#!/usr/bin/env runghc
import Data.List
import Data.Char
main = getContents >>= mapM_ putStrLn . solve . lines
solve [] = [] ::[String]
solve (c:cs) = (:solve cs)$ f (permutations t)
  where
    t = "1689"
    s = c\\t
    f [] = "0"
    f (t:ts) = if r==0 then t++s else f ts
      where r = foldl (\r c->(r*10+ord c-ord '0')`mod`7) 0 (t++s)

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

import Data.List
import Data.Char

import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap

main = getLine >>= (putStrLn . map intToDigit . solve . map digitToInt)

iterateN' 0 f x = x
iterateN' n f x = x `seq` iterateN' (n-1) f (f x)

pre :: Int -> [Int]
pre 0 = [9, 6, 1, 8]
pre 1 = [9, 8, 1, 6]
pre 2 = [9, 8, 6, 1]
pre 3 = [1, 9, 8, 6]
pre 4 = [1, 9, 6, 8]
pre 5 = [1, 6, 8, 9]
pre 6 = [6, 9, 8, 1]
pre n = pre $ n `mod` 7

count :: [Int] -> IntMap Int
count = foldl' (\(!m) d -> IntMap.insertWith (+) d 1 m) IntMap.empty

solve :: [Int] -> [Int]
solve xs = reverse $ iterateN' (IntMap.findWithDefault 0 0 mp) (0:) (pre (-10^4 * rm) ++ ys)
    where
        dec = IntMap.adjust (subtract 1)
        mp = dec 1 . dec 6 . dec 8 . dec 9 $ count xs
        (ys, rm) = IntMap.foldlWithKey' proc ([], 0) mp

        proc acc 0 _ = acc
        proc acc d c = iterateN' c (\(!st, !rm) -> (d:st, (10*rm + d) `mod` 7)) acc

import Data.List
import Data.Char
import Data.Maybe
chars = "1689"
modulus = 7
base = 10
notFound = "0"
clearChars xs = foldr (\ f x -> f x) xs (map delete chars)
mods xs = foldl' (\p d-> mod (base * p + digitToInt d) modulus) 0 xs
findPrefix str = find suitable (permutations chars) where
	suitable prefix = (mod (mods prefix * modPower + modStr) modulus) == 0
	modPower 		= mods ('1':replicate (length str) '0')
	modStr   		= mods str
solution str =
	let cleared = clearChars str in
	let	prefix  = findPrefix cleared
	in case prefix of
		Just prefix -> Just (prefix ++ cleared)
		Nothing     -> Nothing

main = do
	str <- getLine
	putStrLn ( fromMaybe notFound ( solution str ) )

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

import Data.List
import Data.Char

import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IntMap

-- import System.Random

main = getLine >>= (putStrLn . map intToDigit . solve . map digitToInt)

{- main = do
    gen <- getStdGen
    let xs = take (10^5) $ randomRs (0, 9) gen
    print xs
    print $ solve xs
    print $ count xs == count (solve xs) -}

iterateN' 0 f x = x
iterateN' n f x = x `seq` iterateN' (n-1) f (f x)

pre :: Int -> [Int]
pre 0 = [9, 6, 1, 8]
pre 1 = [9, 8, 1, 6]
pre 2 = [9, 8, 6, 1]
pre 3 = [1, 9, 8, 6]
pre 4 = [1, 9, 6, 8]
pre 5 = [1, 6, 8, 9]
pre 6 = [6, 9, 8, 1]
pre n = pre $ n `mod` 7

count :: [Int] -> IntMap Int
count = foldl' (\(!m) d -> IntMap.insertWith (+) d 1 m) IntMap.empty

solve :: [Int] -> [Int]
solve xs = reverse $ iterateN' (IntMap.findWithDefault 0 0 mp) (0:) (pre (-10^4 * rm) ++ ys)
    where
        dec = IntMap.adjust (subtract 1)
        mp = dec 1 . dec 6 . dec 8 . dec 9 $ count xs
        (ys, rm) = IntMap.foldlWithKey' proc ([], 0) mp

        proc acc 0 _ = acc
        proc acc d c = iterateN' c (\(!st, !rm) -> (d:st, (10*rm + d) `mod` 7)) acc

{-# 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 . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
    if length s' == 0 then
        putStrLn "1869"
    else
        putStrLn $ case mod (v * 4) 7 of
            0 -> s'++"1869"
            1 -> s'++"1896"
            2 -> s'++"1986"
            3 -> s'++"1698"
            4 -> s'++"6198"
            5 -> s'++"1689"
            6 -> s'++"1968"

{-# 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 . (,)

elim1689 s = delete '1' $ delete '6' $ delete '9' $ delete '8' s

main = do
    s <- getLine
    let s' = elim1689 s
        v = fst (fromJust (B.readInteger (B.pack s'))) `mod` 7 :: Integer
    if length s' == 0 then
        putStrLn "1896"
    else
        putStrLn $ case mod (v * 4) 7 of
            0 -> s'++"1896"
            1 -> s'++"1869"
            2 -> s'++"1986"
            3 -> s'++"1698"
            4 -> s'++"6198"
            5 -> s'++"1689"
            6 -> s'++"1968"


import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

import Data.Array.Unboxed
import Data.Int

type SIO = StateT P.ByteString IO

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [n, q, k] <- readInts
  a <- readInts
  let
    los = 1 : zipWith min a (tail a)
    his = zipWith max a (tail a) ++ [k]
    opts = zipWith (\x y -> x - y - 2) his los
    optPrefSums = tail $ scanl (\x y -> x + fromIntegral y) 0 opts
    optArr :: UArray Int Int64
    optArr = listArray (1, n) optPrefSums
    aArr :: UArray Int Int64
    aArr = listArray (1, n) $ map fromIntegral a
    k64 :: Int64
    k64 = fromIntegral k
  --lift $ print aArr
  --lift $ print los
  --lift $ print his
  --lift $ print optArr
  replicateM_ q $ do
    [li, ri] <- readInts
    if  li == ri
      then  putInts [k64 - 1]
      else  let
      midOpts = optArr ! (ri - 1) - optArr ! li
      endOpt =  k64 - aArr ! (ri - 1) - 1
      startOpt = aArr ! (li + 1) - 2
      in  do
      --lift $ print startOpt
      --lift $ print midOpts
      --lift $ print endOpt
      --lift $ putStr "tot = "
      putInts [startOpt + midOpts + endOpt]

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int64] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.int64Dec li)
  in  lift $ B.hPutBuilder stdout outBuilder

{-# LANGUAGE OverloadedStrings, FunctionalDependencies, FlexibleContexts,
    ConstraintKinds, BangPatterns #-}

import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Array.Unboxed
import qualified Data.ByteString.Lazy.Char8 as B
import Data.Char
import Data.Foldable
import Data.Int
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.List
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe
import Data.Monoid
import Data.Ratio
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Traversable
import System.IO

------

type Hopper r = State [r]

type HopperT r = StateT [r]

runHopper :: Hopper r a -> [r] -> (a, [r])
runHopper = runState

evalHopper :: Hopper r a -> [r] -> a
evalHopper = evalState

runHopperT :: HopperT r m a -> [r] -> m (a, [r])
runHopperT = runStateT

evalHopperT :: Monad m => HopperT r m a -> [r] -> m a
evalHopperT = evalStateT

type MonadHopper r m = MonadState [r] m

pop :: MonadHopper r m => m (Maybe r)
pop = state f
  where
    f :: [r] -> (Maybe r, [r])
    f [] = (Nothing, [])
    f (q:qs) = (Just q, qs)

popJust :: MonadHopper r m => m r
popJust = fromJust <$> pop

------

popInt :: MonadHopper B.ByteString m => m Int
popInt = fst . fromJust . B.readInt <$> popJust

popInts :: MonadHopper B.ByteString m => m [Int]
popInts = map (fst . fromJust . B.readInt) . B.words <$> popJust

popInteger :: MonadHopper B.ByteString m => m Integer
popInteger = fst . fromJust . B.readInteger <$> popJust

popIntegers :: MonadHopper B.ByteString m => m [Integer]
popIntegers = map (fst . fromJust . B.readInteger) . B.words <$> popJust

------

dropCR :: B.ByteString -> B.ByteString
dropCR s | not (B.null s) && B.last s == '\r' = B.init s
         | otherwise = s

bshow :: Show a => a -> B.ByteString
bshow = B.pack . show

main = B.interact go
  where
    go :: B.ByteString -> B.ByteString
    go = evalHopper run . map dropCR . B.lines

------

run :: Hopper B.ByteString B.ByteString
run = do
  ~[n, q, k] <- popInts
  a <- listArray (0, n - 1) <$> popInts
  qq <- replicateM q ((\[l, r] -> (l - 1, r - 1)) <$> popInts)
  return $ B.unlines $ map bshow (solve n k a qq)

solve :: Int -> Int -> UArray Int Int -> [(Int, Int)] -> [Int]
solve n k as qs = map solve1 qs
  where
    bs :: UArray Int Int
    bs = listArray (0, n - 1) $ map makeB [0 .. n - 1]

    makeB i = let low | i == 0 = 0
                      | otherwise = as ! (i - 1)
                  high | i == n - 1 = k + 1
                       | otherwise = as ! (i + 1) in
                high - low - 2

    segs :: [UArray Int Int]
    segs = reverse $ makeSegs n [bs]

    makeSegs 1 sss = sss
    makeSegs n sss@(ss : _) =
      let n' = (n + 1) `quot` 2
          p i | i == n - 1 = ss ! i
              | otherwise = ss ! i + ss ! (i + 1)
          nss = listArray (0, n' - 1) $
                map (p . (* 2)) [0 .. n' - 1] in
        makeSegs n' (nss : sss)

    bsum l r | l > r = 0
             | otherwise = bsum' segs l (r + 1)

    bsum' (ss : sss) l r = case r - l of
      (-1) -> 0
      0 -> 0
      1 -> ss ! l
      _ -> let (lv, l') = case l `quotRem` 2 of
                            (q, 0) -> (0, q)
                            (q, _) -> (ss ! l, q + 1)
               (rv, r') = case r `quotRem` 2 of
                            (q, 0) -> (0, q)
                            (q, _) -> (ss ! (r - 1), q) in
             lv + rv + bsum' sss l' r'

    solve1 (l, r) | l == r = k - 1
                  | otherwise = (as ! (l + 1) - 2) +
                                (k - as ! (r - 1) - 1) +
                                bsum (l + 1) (r - 1)

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

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] $ map fromIntegral as
    f :: Int -> Int64
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k' + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    k' = fromIntegral k
    solve :: Int -> Int -> Int64
    solve l r
      | l == r = k' - 1
      | l + 1 == r = a ! r - 2 + k' - a ! l - 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k' - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r

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

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] $ map fromIntegral as
    f :: Int -> Int64
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k' + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    k' = fromIntegral k
    solve :: Int -> Int -> Int64
    solve l r
      | l == r = k' - 1
      | l + 1 == r = a' ! r - 2 + k' - a' ! l + 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k' - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r

import Control.Monad
import Data.Maybe
import Data.Array
import Data.List
import qualified Data.ByteString.Char8 as C

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

main :: IO ()
main = do
  [n, q, k] <- getInts
  as <- getInts
  let
    a = array (1, n) $ zip [1..] as
    f i = high - low - 2
      where
      low = if i == 1 then 0 else a ! (i - 1)
      high = if i == n then k + 1 else a ! (i + 1)
    aa = map f [1..n]
    a' = array (1, n) $ zip [1..] aa
    b = array (0, n) $ zip [0..] $ scanl' (+) 0 aa
    solve l r
      | l == r = k - 1
      | l + 1 == r = a' ! r - 2 + k - a' ! l + 1
      | otherwise = b ! (r - 1) - b ! l + a ! (l + 1) - 2 + k - a ! (r - 1) - 1
  replicateM_ q $ do
    [l, r] <- getInts
    C.putStrLn $ C.pack $ show $ solve l r


isSqrt :: Int -> Bool
isSqrt x = y * y == x
    where
        y = round $ sqrt $ fromIntegral  x

getAns :: Int -> String
getAns x
  | x `mod` 2 == 0 && isSqrt (x `div` 2) = "YES"
  | x `mod` 4 == 0 && isSqrt (x `div` 4) = "YES"
  | otherwise = "NO"

solve (x:xs) = map getAns $ map read xs

main = do
  interact $ unlines . solve . lines

import Control.Arrow

solve :: Int -> Bool
solve 1 = True
solve x = even x && (isSquare (x `div` 2) || solve (x `div` 2))
    where
        isSquare :: Int -> Bool
        isSquare n = sq * sq  == n
            where
                sq = floor $ sqrt (fromIntegral n::Double)

main :: IO()
main = interact $ lines >>> tail >>> map ((\x -> read x :: Int) >>> (\x -> x > 1 && solve x) >>> repr) >>> unlines
    where
        repr True = "YES"
        repr False = "NO"

import GHC.Float (float2Int, int2Float)

f :: Int -> String
f n
  | mod n 4 == 0 && isSquare (div n 4) = "YES"
  | mod n 2 == 0 && isSquare (div n 2) = "YES"
  | otherwise = "NO"

isSquare :: Int -> Bool
isSquare n = float2Int (sqrt (int2Float n)) ^ 2 == n

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

{-# LANGUAGE FlexibleContexts #-}
import qualified Data.ByteString.Char8 as BS
import Control.Monad
import Control.Monad.ST
import Data.Array.Base
import Data.Array.ST
import Data.Array.Unboxed
import Data.Bifunctor
import Data.Bits
import Data.Bool
import Data.Char
import Data.Int
import Data.List
import Data.Maybe
import Data.Ord
import Data.Ratio
import Data.Tuple
import qualified Data.IntSet as IS
import qualified Data.Set as Set
import qualified Data.Sequence as Seq
import Data.STRef.Strict
import System.IO
import System.IO.Unsafe

(><) a b = a Seq.>< b

deb name s e = seq s unsafePerformIO $! do
    hPutStrLn stderr $ " " ++ name ++ " = " ++ show s
    return e

parseInt = fst . fromJust . BS.readInt
parseInteger = fst . fromJust . BS.readInteger

modifyArray f a i = readArray a i >>= \v -> writeArray a i (f v)

sq :: Int -> Bool
sq n =
    let s = floor . sqrt. fromIntegral $ n
    in
        s * s == n

solve :: Int -> Bool
solve n = (even n && sq (n `div` 2)) || (n `mod` 4 == 0 && sq (n `div` 4))

main = do
    tn <- parseInt <$> BS.getLine
    replicateM_ tn $ do
        n <- parseInt <$> BS.getLine
        putStrLn (if solve n then "YES" else "NO")

import qualified Data.ByteString.Lazy.Char8 as P
import qualified Data.ByteString.Builder as B
import System.IO

import Control.Monad
import Control.Monad.Trans.State
import Control.Monad.Trans.Class
import Data.List
import Data.Semigroup

isqrt :: Int -> Int
isqrt v = round $ sqrt (fromIntegral v :: Double)

ok :: Int -> Int -> Bool
ok w x = case  divMod x w  of
  (q, 0) -> q == isqrt q * isqrt q
  _ -> False

main :: IO ()
main = (P.getContents >>=) . evalStateT $ do
  [t] <- readInts
  replicateM_ t $ do
    [n] <- readInts
    lift $ P.putStr $ if  ok 2 n || ok 4 n
      then  P.pack "YES\n"
      else  P.pack "NO\n"

type SIO = StateT P.ByteString IO

readLine :: SIO P.ByteString
readLine = do
  (out, next) <- P.break (<= '\r') <$> get
  put $ P.dropWhile (<= '\r') next
  pure out

readInts :: SIO [Int]
readInts = do
  currLine <- readLine
  pure [x | Just (x, _) <- P.readInt <$> P.words currLine]

putInts :: [Int] -> SIO ()
putInts li = let
  outBuilder = foldr (<>) (B.char7 '\n')
    $ intersperse (B.char7 ' ') (map B.intDec li)
  in  lift $ B.hPutBuilder stdout outBuilder

import Control.Monad

isSquare n = sq * sq == n where sq = floor $ sqrt $ fromIntegral n
check n k = mod n k == 0 && isSquare (div n k)

printResult = do
    n <- readLn :: IO Int
    putStrLn $ if check n 2 || check n 4 then "YES" else "NO"

main = do
    t <- readLn :: IO Int
    replicateM_ t printResult

import Control.Monad
import Data.Bits
readInt = readLn :: IO Int
solve n = putStrLn r where r = if n .&. (n-1) == 0 && n > 1 then "YES" else "NO"
main = do
    n <- readInt
    a <- replicateM n readInt
    mapM solve a

import Control.Monad
import Data.Bits
readInt = readLn :: IO Int
solve n = putStrLn r where r = if n .&. (n-1) == 0 then "YES" else "NO"
main = do
    n <- readInt
    a <- replicateM n readInt
    mapM solve a

import Control.Arrow

pows :: [Int]
pows = iterate (*2) 2

solve :: [Int] -> Int -> Bool
solve _ 1 = True
solve (n:ns) x = even x && (isSquare (x `div` n) || solve ns (x `div` n))
    where
        isSquare :: Int -> Bool
        isSquare n = sq * sq  == n
            where
                sq = floor $ sqrt (fromIntegral n::Double)

main :: IO()
main = interact $ lines >>> tail >>> map ((\x -> read x :: Int) >>> solve pows >>> repr) >>> unlines
    where
        repr True = "YES"
        repr False = "NO"


-- https://codeforces.com/contest/1618/problem/B
import Control.Monad (replicateM)

answer [b] found = b ++ if not found then "a" else ""
answer (b1:b2:bs) found
    | b1!!1 == b2!!0 || found = b1!!0 : answer (b2:bs) found
    | otherwise = b1 ++ answer (b2:bs) True

main = getLine >>= flip replicateM run . read
run = do
    n <- getLine
    line <- words <$> getLine
    putStrLn $ answer line False

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

solve :: IO ()
solve = do
    ~[n] <- readInts
    xs <- words . C.unpack <$> C.getLine
    let gen c1 c2
            | c1 == c2  = [c1]
            | otherwise = [c1, c2]
        s = [head $ head xs] ++ concat (zipWith gen (map last xs) (map head $ tail xs)) ++ [last $ last xs]
    putStrLn $ if length s == n then s else 'a':s

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

main :: IO ()
main = flip replicateM_ solve . head =<< readInts


import qualified Data.ByteString.Char8 as B
import Data.List
import Data.Maybe
main = B.interact exec
exec = B.pack . unwords . map show . solve . map (maybe undefined fst . B.readInt) . tail . B.words
solve (r0:xs) = snd $ mapAccumL (\bs x -> let y = fromMaybe r $ collide r x bs in ((x, y):bs, y)) [] $ map fromIntegral xs
  where r = fromIntegral (r0 :: Int) :: Double

collide r x = maximumMay . map (\(x', y') -> let t = sqrt $ 4 * r * r - (x - x') * (x - x') in max (y' - t) (y' + t)) . filter (\(x', _) -> overlap (x - r, x + r) (x' - r, x' + r))

maximumMay [] = Nothing
maximumMay xs = Just $ maximum xs

overlap a b = go a b || go b a
  where go (x1, x2) (y1, y2) = x1 <== y2 && y1 <== x2

a <== b = a < b || abs (a - b) <= 1e-5

import           Data.List
import           Data.Bifunctor
import           Data.Function
-- import           Debug.Trace

circleStick :: Int -> Int -> Int -> Double
circleStick r x1 x2 =
  let dx = fromIntegral $ abs (x1 - x2)
  in sqrt $ (fromIntegral (2*r))^2 - dx^2

folder :: Int -> [(Int, Double)] -> Int -> [(Int, Double)]
folder r prevs new =
  let
    isCandidate a = 2 * r >= abs (a - new)
    candidates = filter (isCandidate . fst) prevs
  in if null candidates then (new, fromIntegral r):prevs
  else let height = maximum . map (uncurry (+) . first (circleStick r new) ) $ candidates
    in (new, height):prevs

main :: IO ()
main = do
  [n, r] <- map (read :: String -> Int) . words <$> getLine
  mapM_ (print . snd) =<< reverse. foldl' (folder r) [] . map (read :: String -> Int) . words <$> getLine
  return ()

import System.IO
import Data.List (sort)

join s xs = foldr (\a b -> a++s++b) "" xs

iLn :: IO [Double]
iLn = getLine >>= (return . fmap (read) . words)

main = do
  [_,r] <- iLn
  xs <- iLn
  putStrLn $ join " " . fmap show . reverse $ solve r ( xs) []
--solve :: Double -> [Double] -> [(Double,Double)] -> [Double]
solve r [] ps = fmap fst ps
solve r (x:xs) a = solve r xs $ d r x
  (filter ((<=2*r).abs.(x-).snd) a) : a
d r x [] = (r,x)
d r x ps =
  foldr1 max.fmap (\(h,xx)->
                (h+(sqrt.abs$4*r*r-(x-xx)^2),x)
             )$ps

import System.IO

merge xs [] = xs
merge [] xs = xs
merge xx@(x:xs) yy@(y:ys) =
  if (x<y)
  then x:(merge xs yy)
  else y:(merge xx ys)
msort xs = case xs of
  [] -> []
  [a] -> [a]
  _   -> uncurry merge $ (\(x, y)-> (msort x,msort y) ) $ splitAt ((length xs) `div` 2) xs
join s xs = foldr (\a b -> a++s++b) "" xs

main = do
  [_,r] <- getLine >>= (return . fmap (read) . words)
  xs <- getLine >>= (return . fmap (read) . words)
  putStrLn $ join " " . fmap show . reverse $ solve r ( xs) []

--solve :: Double -> [Double] -> [(Double,Double)] -> [Double]
solve r [] ps = fmap fst ps
solve r (x:xs) a = solve r xs $ dro r x a : a
dro r x ps = d r x $ filter ((<=2*r).abs.(x-).snd) ps
d r x [] = (r,x)
d r x ps = (\(h,xx)->
              (h+(sqrt.abs$4*r*r-(x-xx)^2),x)
              )
           $last.msort$ps


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

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import           Data.Bool
import qualified Data.ByteString.Char8       as C
import           Data.Char
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as IM
import           Data.IORef
import           Data.List
import qualified Data.Map                    as M
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Tuple
import           Data.Word
import           Debug.Trace
import           System.IO
import           Text.Printf                 (printf)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

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

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral
{-# INLINE cast #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep i j m = go i where
  go !i
    | i < j = m i >> go (i+1)
    | otherwise = return ()
{-# INLINE rep #-}

rrep :: Int -> Int -> (Int -> IO ()) -> IO ()
rrep i j m = go i where
  go !i
    | i > j = m (i-1) >> go (i-1)
    | otherwise = return ()
{-# INLINE rrep #-}

-----

main :: IO ()
main = do
  s <- getLine
  t <- getLine

  let d = cnv s
      e = cnv t

  if d == e
    then putStrLn "="
    else do
    if cmp d e
      then putStrLn "<"
      else putStrLn ">"

cmp (a, b) (c, d) =
  cast (a-c) * (sqrt 5 + 1) / 2 < cast (d-b)

cnv :: String -> (Integer, Integer)
cnv s = go 0 1 (reverse s) 0 0 where
  q = (sqrt 5+1)/2

  go !a !b (c:cs) !v !w  =
    go (a+b) (a) cs
      (v+(if c == '1' then a else 0))
      (w+(if c == '1' then b else 0))

  go _ _ _ v w = (v, w)

import Control.Monad

main :: IO ()
main = do
    s1 <- getLine
    s2 <- getLine
    putStrLn $ case cmp s1 s2 of
        LT -> "<"
        EQ -> "="
        GT -> ">"

cmp :: String -> String -> Ordering
cmp a b = compare sa sb where
    na = length a
    nb = length b
    n = max na nb
    a' = take (n-na) (repeat '0') ++ a
    b' = take (n-nb) (repeat '0') ++ b
    sa = normalize a'
    sb = normalize b'

normalize :: String -> String
normalize ('1':'1':cs) = '1':normalize ('0':cs)
normalize ('1':cs) = case normalize cs of
    '0':'1':cs' -> '1':'0':'0':cs'
    '0':cs'     -> '0':'1':cs'
normalize ('0':cs)   = '0':normalize cs
normalize []  = "0"
{-
q = (1+ sqrt(5)) / 2
eval :: String -> Double
eval = foldl (\e ch -> e*q + if ch == '0' then 0 else 1) 0

prop_normalize = forAll gens $ \s -> 1 + length s == length (normalize s) && abs (eval s  - eval (normalize s))/ (eval s + 1) < 1.0e-9
prop = forAll gen $ \(a,b) -> cmp a b == naiveCmp a b
gens = sized $ \n -> do
    n <- choose (0,n)
    replicateM n (choose ('0','1'))

gen = liftM2 (,) gens gens

naiveCmp a b | otherwise = compare x y where
    x = eval a
    y = eval b

-}

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

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array.IO
import           Data.Array.Unboxed
import           Data.Bool
import qualified Data.ByteString.Char8       as C
import           Data.Char
import           Data.Function
import           Data.Functor
import           Data.Int
import qualified Data.IntMap                 as IM
import           Data.IORef
import           Data.List
import qualified Data.Map                    as M
import           Data.Maybe
import           Data.Monoid
import           Data.Ord
import qualified Data.Sequence               as Seq
import qualified Data.Set                    as S
import           Data.Tuple
import           Data.Word
import           Debug.Trace
import           System.IO
import           Text.Printf                 (printf)

-- I/O

readInts :: C.ByteString -> [Int]
readInts = map fst . mapMaybe C.readInt . C.words

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

readNums :: Num a => C.ByteString -> [a]
readNums = map (fromIntegral . fst) . mapMaybe C.readInteger . C.words

getNums :: Num a => IO [a]
getNums = readNums <$> C.getLine

cast :: (Integral a, Num b) => a -> b
cast = fromIntegral
{-# INLINE cast #-}

rep :: Int -> Int -> (Int -> IO ()) -> IO ()
rep i j m = go i where
  go !i
    | i < j = m i >> go (i+1)
    | otherwise = return ()
{-# INLINE rep #-}

rrep :: Int -> Int -> (Int -> IO ()) -> IO ()
rrep i j m = go i where
  go !i
    | i > j = m (i-1) >> go (i-1)
    | otherwise = return ()
{-# INLINE rrep #-}

-----

main :: IO ()
main = do
  s <- getLine
  t <- getLine

  let d = cnv s
      e = cnv t

  if abs (d-e) < 1e-10
    then putStrLn "="
    else do
    if d < e
      then putStrLn "<"
      else putStrLn ">"

cnv s = go 1 (reverse s) 0 where
  q = (sqrt 5+1)/2

  go !d (c:cs) !acc =
    go (d*q) cs $ acc+(if c == '1' then d else 0)

  go _ _ !acc = acc


-- import Debug.Trace
import qualified Data.Set as S
import Data.Int
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int64]] -> String -> [Int] -> S.Set (Int64,Int) -> Int64 -> Int -> Int
   ->  Maybe (Int64,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a d _ = guard (d == 0) >> Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show, Eq)

instance Ord Adjust where
  compare = comparing cost <> comparing position

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: !Int64,
    balance :: !Int,
    adjustedPositions :: ![Int],
    adjusts :: !(S.Set Adjust),
    costs :: ![Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: !Int64,
    closeCost :: !Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: !Int,
    cost :: !Int64
  } deriving (Show, Eq)

instance Ord Adjust where
  compare = comparing cost <> comparing position

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

import qualified Data.Set as Set
import Data.List
import Control.Arrow

data Cost = Cost Integer Integer deriving (Show, Eq, Ord)
impossible = Cost 1 0
instance Num Cost where
  Cost x1 y1 + Cost x2 y2 = Cost (x1 + x2) (y1 + y2)
  negate (Cost x1 y1) = Cost (negate x1) (negate y1)
  fromInteger x = Cost 0 x

zipp ('?' : t) (c : cs) = (ob, cb) : zipp t cs where
  [ob, cb] = map (fromInteger . read) $ words c
zipp ('(' : t) cs = (0, impossible) : zipp t cs
zipp (')' : t) cs = (impossible, 0) : zipp t cs
zipp [] _ = []

hoho (h : t) = [h] : gogo t where
  gogo (a:b:c) = [a, b] : gogo c
  gogo _ = []

swap (x, y) = (y, x)

go costs = (sum . map fst &&& mkString . sort . map snd) . snd . mapAccumL step Set.empty $ hoho (zip costs [0..]) where
  mkString = go 0 where
    len = length costs
    go i _ | i == len = []
    go i (j : js) | i == j = '(' : go (i + 1) js
    go i js = ')' : go (i + 1) js
  step m cis = swap . Set.deleteFindMin . Set.union m $ Set.fromList cis

solve (inp : costs) = case res of
  res | res < 0 -> error "too good to be true"
  Cost 0 x -> unlines $ [show x, best]
  _ -> "-1"
  where
  z = zipp inp costs
  (min, best) = go (map (uncurry (-)) z)
  res = sum (map snd z) + min

main=interact$solve.lines

import Data.Set hiding(map)
import Data.List(mapAccumL)
z('?':t)(c:d)=c:z t d
z('(':t)d=(0,9^13):z t d
z(')':t)d=(9^13,0):z t d
z[]_=[]
g(a:b:c)=[a,b]:g c
g _=[]
h(a:b)=[a]:g b
b q|q='('|1>0=')'
m l p=map(b.(`member`fromList p))[0..l-1]
w(x,y)=(y,x)
t[a,b]=(a,b)
p m=w.deleteFindMin.union m.fromList
solve(a:b)|r<9^12=unlines[show r,m(length a)i]|1>0="-1"where
 (x,y)=unzip.z a.map(t.map read.words)$b
 (c,i)=unzip.snd.mapAccumL p empty.h.(`zip`[0..])$zipWith(-)x y
 r=sum$y++c
main=interact$solve.lines

-- import Debug.Trace
import qualified Data.Set as S
import Data.Int
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int64]] -> String -> [Int] -> S.Set (Int64,Int) -> Int64 -> Int -> Int
   ->  Maybe (Int64,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a _ _ = Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

-- import Debug.Trace
import qualified Data.Set as S
import Data.List
import Control.Monad
main = do
  expr <- getLine
  costs <- map (map read . words) . lines <$> getContents
  case go costs expr [] S.empty 0 0 0 of
    Nothing -> putStrLn "-1"
    Just (cost,adjs) -> -- traceShowM adjs >>
                        print cost >> putStrLn (adjust adjs expr 0)
go :: [[Int]] -> String -> [Int] -> S.Set (Int,Int) -> Int -> Int -> Int
   ->  Maybe (Int,[Int])
go cs bs adjs s a d i | d < 0 = case S.minView s of
  Nothing -> Nothing
  Just ((c,ai),s') -> ((go cs bs (ai:adjs) s' $! a+c) $! d+2) $ i
go cs@ ~([co,cc]:cs') (b:bs) adjs s a d i = case b of
  '(' -> (go cs bs adjs s a $! d+1) $! i+1
  ')' -> (go cs bs adjs s a $! d-1) $! i+1
  '?' -> (((go cs' bs adjs $! S.insert (co-cc,i) s) $! a+cc) $! d-1) $! i+1
go [] [] adjs _ a _ _ = Just (a,sort adjs)
-- go cs bs adjs s a d i = traceShow (cs,bs,adjs,s,a,d,i) $ error "NEP"
adjust as ('?':cs) i | not (null as) && i == head as
                         = '(' : (adjust (tail as) cs $! i+1)
                     | otherwise = ')' : (adjust as cs $! i+1)
adjust as (c:cs) i = c : (adjust as cs $! i+1)
adjust [] "" _ = ""
-- adjust as cs i = traceShow (as,cs,i) $ error "NEP"

import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap,(!))
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Foldable (sum)
import Data.Traversable (mapM)
import Control.Monad (guard)
import Prelude hiding (sum,mapM)

--import Debug.Trace
--tr x = traceShow x x
tr = id
traceShow = curry snd

main :: IO ()
main = do
  str <- getLine
  let seq = IM.fromList (zip [0..] str)
  unknown <- mapM (const readPair) (IM.filter (== '?') seq)
  let s = tr $ solve seq unknown
  case s of
    Nothing -> print (-1)
    Just s -> do
      let cost = sum $ IM.intersectionWith f s unknown
          f '(' (o,_) = o
          f ')' (_,c) = c
      print cost
      putStrLn $ IM.elems s

solve :: IntMap Char -> IntMap (Int,Int) -> Maybe (IntMap Char)
solve seq unknown = do
  let len = IM.size seq
      startOpen = IM.size (IM.filter (== '(') seq)
      startClose = IM.size (IM.filter (== ')') seq)
      target = len `div` 2
      needOpen = target - startOpen
      needClose = target - startClose
  guard (needOpen >= 0)
  guard (needClose >= 0)
  let first = IM.fromList $
              flip zip (replicate needOpen '(' ++ replicate needClose ')') $
              map fst $ sortBy (comparing firstCost) (IM.assocs unknown)
      firstCost (i,(co,cc)) = (co-cc,i)
  let closesLeft = S.empty
      opensRight = S.fromList $ map toOR $ IM.keys $ IM.filter (== '(') first
      toOR i = (c-o,-i) where (o,c) = unknown ! i
  let go cl or s i l
        | traceShow (IM.elems s,i,l,map snd (S.elems cl), map snd (S.elems or)) False = undefined
        | i == len = return s
        | l' >= 0 = go cl' or' s (i+1) l'
        | otherwise = exchange cl' or' s (i+1) l'
        where
          l' = l + if s ! i == '(' then 1 else -1
          (e,~(o,c)) = case IM.lookup i unknown of
                         Nothing -> ('?', undefined)
                         Just v -> (s ! i,v)
          cl' | e == ')' = S.insert (o-c,i) cl
              | otherwise = cl
          or' | e == '(' = S.delete (c-o,-i) or
              | otherwise = or
      exchange cl or s i lv = do
        ((_,l),cl') <- guard (not $ S.null cl) >> return (S.deleteFindMin cl)
        ((_,_r),or') <- guard (not $ S.null or) >> return (S.deleteFindMin or)
        traceShow (l,_r) $ go cl' or' (IM.insert l '(' $ IM.insert (-_r) ')' s) i (lv+2)
  go closesLeft opensRight (IM.union first seq) 0 0

readPair :: IO (Int,Int)
readPair = do
   [a,b] <- fmap words getLine
   return (read a,read b)

import qualified Data.Set as S
import Data.Set (Set)
import qualified Data.IntMap as IM
import Data.IntMap (IntMap,(!))
import Data.Ord (comparing)
import Data.List (sortBy)
import Data.Foldable (sum)
import Data.Traversable (mapM)
import Control.Monad (guard)
import Prelude hiding (sum,mapM)

-- import Debug.Trace
-- tr x = traceShow x x
tr = id

main :: IO ()
main = do
  str <- getLine
  let seq = IM.fromList (zip [0..] str)
  unknown <- mapM (const readPair) (IM.filter (== '?') seq)
  let s = tr $ solve seq unknown
  case s of
    Nothing -> print (-1)
    Just s -> do
      let cost = sum $ IM.intersectionWith f s unknown
          f '(' (o,_) = o
          f ')' (_,c) = c
      print cost
      putStrLn $ IM.elems s

solve :: IntMap Char -> IntMap (Int,Int) -> Maybe (IntMap Char)
solve seq unknown = do
  let len = IM.size seq
      startOpen = IM.size (IM.filter (== '(') seq)
      startClose = IM.size (IM.filter (== ')') seq)
      target = len `div` 2
      needOpen = target - startOpen
      needClose = target - startClose
  guard (needOpen >= 0)
  guard (needClose >= 0)
  let first = tr $ IM.fromList $
              flip zip (replicate needOpen '(' ++ replicate needClose ')') $
              map fst $ sortBy (comparing firstCost) (IM.assocs unknown)
      firstCost (i,(co,cc)) = (co-cc,i)
  let closesLeft = S.empty
      opensRight = S.fromList $ map toOR $ IM.keys $ IM.filter (== '(') first
      toOR i = (c-o,-i) where (o,c) = unknown ! i
  let go cl or s i l
        | i == len = return s
        | l' >= 0 = go cl' or' s (i+1) l'
        | otherwise = exchange cl' or' s (i+1) l'
        where
          l' = l + if s ! i == '(' then 1 else -1
          (e,~(o,c)) = case IM.lookup i unknown of
                         Nothing -> ('?', undefined)
                         Just v -> (s ! i,v)
          cl' | e == '(' = S.insert (o-c,i) cl
              | otherwise = cl
          or' | e == '(' = S.delete (c-o,-i) or
              | otherwise = or
      exchange cl or s i l = do
        ((_,l),cl') <- guard (not $ S.null cl) >> return (S.deleteFindMin cl)
        ((_,_r),or') <- guard (not $ S.null or) >> return (S.deleteFindMin or)
        go cl' or' (IM.insert l '(' $ IM.insert (-_r) ')' s) i (l+2)
  go closesLeft opensRight (IM.union first seq) 0 0

readPair :: IO (Int,Int)
readPair = do
   [a,b] <- fmap words getLine
   return (read a,read b)

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  -- let expr = "(??)"
  -- let costs = ["1 2", "3 6"]
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show)

instance Eq Adjust where
  Adjust _ c1 == Adjust _ c2 = c1 == c2

instance Ord Adjust where
  Adjust _ c1 <= Adjust _ c2 = c1 <= c2

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

module Main where

import qualified Data.Set as S
import Data.Int (Int64)
import Data.List
import Data.Ord
import Data.Functor ((<&>))

main :: IO ()
main = do
  expr <- getLine
  costs <- lines <$> getContents
  case solve expr costs of
    Nothing -> print (-1)
    Just (totalCost, resultExpr) -> print totalCost >> putStrLn resultExpr

solve :: String -> [String] -> Maybe (Int64, String)
solve expr inputs = findAdjusts indexedExpr (initialState inputs) <&> fmap (applyAdjusts indexedExpr . sort)
  where
    indexedExpr = zip [1..] expr

initialState :: [String] -> FoldState
initialState costInputs = FoldState {
    totalCost = 0,
    balance = 0,
    adjustedPositions = [],
    adjusts = S.empty,
    costs = map getCost costInputs
  }

findAdjusts :: [(Int, Char)] -> FoldState -> Maybe (Int64, [Int])
findAdjusts [] state              = if balance state == 0 then Just (totalCost state, adjustedPositions state) else Nothing
findAdjusts ((_, '('):expr) state = findAdjusts expr $ addBalance state 1
findAdjusts ((_, ')'):expr) state = findAdjusts expr =<< relax (addBalance state (-1))
findAdjusts ((p, _):expr) state   = findAdjusts expr =<< relax (replaceChar state p)

addBalance :: FoldState -> Int -> FoldState
addBalance state@FoldState{ balance = b } db = state { balance = b + db }

relax :: FoldState -> Maybe FoldState
relax state | b >= 0    = Just state
            | otherwise = S.minView as <&> \(Adjust p dc, nas) -> state { balance = b + 2
                                                                        , totalCost = t + dc
                                                                        , adjusts = nas
                                                                        , adjustedPositions = p:aps
                                                                        }
    where
      FoldState t b aps as _ = state

replaceChar :: FoldState -> Int -> FoldState
replaceChar state pos = state { balance = b - 1
                              , totalCost = t + closeCost c
                              , adjusts = S.insert (Adjust pos $ openCost c - closeCost c) as
                              , costs = cs
                              }
  where
    FoldState t b _ as (c:cs) = state

applyAdjusts :: [(Int, Char)] -> [Int] -> String
applyAdjusts [] _ = []
applyAdjusts ((i, '?'):cs) (a:as) | i == a  = '(':applyAdjusts cs as
applyAdjusts ((_, '?'):cs) adjusts          = ')':applyAdjusts cs adjusts
applyAdjusts ((_, c):cs) adjusts            = c:applyAdjusts cs adjusts

data FoldState = FoldState {
    totalCost :: Int64,
    balance :: Int,
    adjustedPositions :: [Int],
    adjusts :: S.Set Adjust,
    costs :: [Cost]
  } deriving (Show)

data Cost = Cost {
    openCost :: Int64,
    closeCost :: Int64
  } deriving (Show)

data Adjust = Adjust {
    position :: Int,
    cost :: Int64
  } deriving (Show)

instance Eq Adjust where
  Adjust _ c1 == Adjust _ c2 = c1 == c2

instance Ord Adjust where
  Adjust _ c1 <= Adjust _ c2 = c1 <= c2

getCost :: String -> Cost
getCost input = let [open, close] = map read (words input) in Cost open close

import Data.Set hiding(map)
import Data.List(mapAccumL)
z('?':t)(c:d)=c:z t d
z('(':t)d=(0,9^13):z t d
z(')':t)d=(9^13,0):z t d
z[]_=[]
g(a:b:c)=[a,b]:g c
g _=[]
h(a:b)=[a]:g b
b q|q='('|1>0=')'
m l p=map(b.(`member`fromList p))[0..l-1]
w(x,y)=(y,x)
t[a,b]=(a,b)
p m=w.deleteFindMin.union m.fromList
solve(a:b)|r<9^12=unlines[show r,m(length b)i]|1>0="-1"where
 (x,y)=unzip.z a.map(t.map read.words)$b
 (c,i)=unzip.snd.mapAccumL p empty.h.(`zip`[0..])$zipWith(-)x y
 r=sum$y++c
main=interact$solve.lines

import qualified Data.Map as Map
import Data.List
import Control.Arrow

data Cost = Cost Integer Integer deriving (Show, Eq, Ord)
impossible = Cost 1 0
instance Num Cost where
  Cost x1 y1 + Cost x2 y2 = Cost (x1 + x2) (y1 + y2)
  negate (Cost x1 y1) = Cost (negate x1) (negate y1)
  fromInteger x = Cost 0 x

zipp ('?' : t) (c : cs) = (ob, cb) : zipp t cs where
  [ob, cb] = map (fromInteger . read) $ words c
zipp ('(' : t) cs = (0, impossible) : zipp t cs
zipp (')' : t) cs = (impossible, 0) : zipp t cs
zipp [] _ = []

hoho (h : t) = [h] : gogo t where
  gogo (a:b:c) = [a, b] : gogo c
  gogo _ = []

swap (x, y) = (y, x)

go costs = (sum . map fst &&& mkString . sort . map snd) . snd . mapAccumL step Map.empty $ hoho (zip costs [0..]) where
  mkString = go 0 where
    len = length costs
    go i js | i == len = []
    go i (j : js) | i == j = '(' : go (i + 1) js
    go i js = ')' : go (i + 1) js
  step m cis = swap (Map.deleteFindMin $ Map.union (Map.fromList cis) m)

solve (inp: costs) = case res of
  Cost 0 x -> unlines $ [show x, best]
  Cost i _ | i > 0 -> "-1"
    | otherwise -> error "too good to be true"
  where
  z = zipp inp costs
  (min, best) = go (map (uncurry (-)) z)
  res = sum (map snd z) + min

main=interact$solve.lines