You are given an array $$$a$$$ of length $$$n$$$. The array is called 3SUM-closed if for all distinct indices $$$i$$$, $$$j$$$, $$$k$$$, the sum $$$a_i + a_j + a_k$$$ is an element of the array. More formally, $$$a$$$ is 3SUM-closed if for all integers $$$1 \leq i < j < k \leq n$$$, there exists some integer $$$1 \leq l \leq n$$$ such that $$$a_i + a_j + a_k = a_l$$$.Determine if $$$a$$$ is 3SUM-closed.

The first line contains an integer $$$t$$$ ($$$1 \leq t \leq 1000$$$) — the number of test cases. The first line of each test case contains an integer $$$n$$$ ($$$3 \leq n \leq 2 \cdot 10^5$$$) — the length of the array. The second line of each test case contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ ($$$-10^9 \leq a_i \leq 10^9$$$) — the elements of the array. It is guaranteed that the sum of $$$n$$$ across all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output "YES" (without quotes) if $$$a$$$ is 3SUM-closed and "NO" (without quotes) otherwise. You can output "YES" and "NO" in any case (for example, strings "yEs", "yes" and "Yes" will be recognized as a positive response).

NoteIn the first test case, there is only one triple where $$$i=1$$$, $$$j=2$$$, $$$k=3$$$. In this case, $$$a_1 + a_2 + a_3 = 0$$$, which is an element of the array ($$$a_2 = 0$$$), so the array is 3SUM-closed.In the second test case, $$$a_1 + a_4 + a_5 = -1$$$, which is not an element of the array. Therefore, the array is not 3SUM-closed.In the third test case, $$$a_i + a_j + a_k = 0$$$ for all distinct $$$i$$$, $$$j$$$, $$$k$$$, and $$$0$$$ is an element of the array, so the array is 3SUM-closed.

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | length xs' >= 6 = all (== 0) xs'
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      xs' = filter (/= 0) xs ++ replicate (min 2 $ count 0 xs) 0
      ys = zip xs' [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

--
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DatatypeContexts #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
{-# LANGUAGE TupleSections #-}

import Control.Arrow ((>>>))
import Control.Monad (
    MonadPlus (mplus),
    foldM_,
    forM_,
    guard,
    join,
    replicateM,
    replicateM_,
 )
import qualified Control.Monad.ST.Strict as ST
import qualified Control.Monad.State.Strict as S

import qualified Data.Array as A
import qualified Data.Array.MArray.Safe as MA
import qualified Data.Array.IO.Safe as IOA
import qualified Data.Array.ST.Safe as STA
import qualified Data.Array.Unboxed as UA

import Data.Bits
import qualified Data.ByteString.Char8 as B8
import Data.Char
import Data.Int

import Data.Function (on)
import Data.Functor ((<&>))
import Data.Bifunctor (bimap)
import Data.Maybe (fromJust, fromMaybe, isJust)
import qualified Data.Maybe as MB

import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.List   as L
import Data.List (
    elemIndices,
    find,
    findIndices,
    intersect,
    isPrefixOf,
    nub,
    sort,
    sortOn,
 )
import qualified Data.Map as M
import qualified Data.Set as S

import Control.Monad.Cont (MonadIO (liftIO))
import Data.IORef (modifyIORef, newIORef, readIORef)
import GHC.IO.Handle (hDuplicateTo)
import System.IO (
    IOMode (ReadMode, WriteMode),
    openFile,
    stdin,
    stdout,
 )
import System.Posix.Internals (puts)
import Text.Printf (printf)
import qualified Data.Array.IO.Safe as UOA

-- import Debug.Trace (trace, traceM, traceShowM)
-- debug = flip trace

readIntB8 :: B8.ByteString -> Int
readIntB8 = B8.readInt >>> (fst . fromJust)

readIntB8s :: B8.ByteString -> [Int]
readIntB8s = B8.words >>> map (B8.readInt >>> (fst . fromJust))

readIntegerB8 :: B8.ByteString -> Integer
readIntegerB8 = B8.readInteger >>> (fst . fromJust)

readIntegerB8s :: B8.ByteString -> [Integer]
readIntegerB8s = B8.words >>> map (B8.readInteger >>> (fst . fromJust))

modifyArray :: (MA.MArray a e m, MA.Ix i) => a i e -> i -> (e -> e) -> m ()
modifyArray arr ix f = do
    value <- MA.readArray arr ix
    MA.writeArray arr ix $ f value

putsYesNo :: Bool -> IO ()
putsYesNo value = do
    let result :: String =
            if value
                then "YES"
                else "NO"
    printf "%s\n" result

{- END OF GENERAL -}

solve :: Int -> [Int] -> Bool
solve n as = solve' $ L.sort as
    where
        solve' :: [Int] -> Bool
        solve' as
            | L.length (L.filter (< 0) as) > 3 = False
            | L.length (L.filter (> 0) as) > 3 = False
            | L.length (L.filter (== 0) as) > 2 = let
                    zerosCount = L.length (L.filter (== 0) as)
                    noZeros = L.filter (/= 0) as
                in
                    solve' . L.sort $ noZeros ++ L.replicate (min 2 zerosCount) 0
            | otherwise = solve'' as

        solve'' :: [Int] -> Bool
        solve'' as = L.and $ do
            let l = L.length as
            i <- [0 .. l - 1]
            j <- [i + 1 .. l - 1]
            k <- [j + 1 .. l - 1]
            let s = (as L.!! i) + (as L.!! j) + (as L.!! k)

            return $ s `L.elem` as

main :: IO ()
main = do
    n <- B8.getLine <&> readIntB8
    replicateM_ n $ do
        n <- B8.getLine <&> readIntB8
        as <- B8.getLine <&> readIntB8s
        let answer = solve n as
        putsYesNo answer

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n' >= 6 = all (== 0) xs'
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      nxs = filter (/= 0) xs
      zc = count 0 xs
      xs' = nxs ++ replicate zc 0
      n' = length xs'
      ys = zip xs' [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, xs :: [Integer]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< integer
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 8 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i < j, j < k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, xs :: [Int]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 8 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i /= j, i /= k, j /= k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad
import Control.Monad.State (State, evalState, get, gets, put)
import qualified Data.ByteString.Lazy.Char8 as C
import Data.Function
import Data.Int
import Data.List
import Data.Maybe
import Data.Bool
import Debug.Trace

main :: IO ()
main = C.interact $ runScanner (numberOf input) >>> map (solve >>> output) >>> C.unlines

data TC = TC {n :: Int, xs :: [Int]}
type Output = Bool

input :: Scanner TC
input = do
  n <- int
  xs <- n >< int
  return TC {..}

solve :: TC -> Output
solve TC {..}
  | n >= 6 = all (== 0) xs
  | otherwise = and [x + y + z `elem` xs | (x, i) <- ys, (y, j) <- ys, (z, k) <- ys, i /= j, i /= k, j /= k]
    where
      ys = zip xs [0..]

output :: Output -> C.ByteString
output = bool "NO" "YES" >>> C.pack

-------------------------- Template ------------------------------------------
-- Debug
debug :: Show a => a -> a
#ifdef ONLINE_JUDGE
debug = id
#else
debug a = trace (show a) a
#endif

-- Lists
groupOn :: Eq b => (a -> b) -> [a] -> [[a]]
groupOn = groupBy . on (==)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs = let (hs, ts) = splitAt k xs in hs : chunksOf k ts

adjacents :: [a] -> [(a, a)]
adjacents xs = zip xs (tail xs)

adjacentsWith :: (a -> a -> b) -> [a] -> [b]
adjacentsWith f xs = zipWith f xs (tail xs)

count :: Eq a => a -> [a] -> Int
count = countBy . (==)

countBy :: (a -> Bool) -> [a] -> Int
countBy p = length . filter p

-- Scanner
type Scanner = State [C.ByteString]

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

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

peek :: Scanner C.ByteString
peek = gets head

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

str :: Scanner String
str = C.unpack <$> bstr

readStr :: Read a => Scanner a
readStr = read <$> str

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

integer :: Scanner Integer
integer = readStr

int64 :: Scanner Int64
int64 = readStr

double :: Scanner Double
double = readStr

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

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

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

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

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

(><) = times

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

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

showB :: Show a => a -> C.ByteString
showB = C.pack . show


A sequence of round and square brackets is given. You can change the sequence by performing the following operations:  change the direction of a bracket from opening to closing and vice versa without changing the form of the bracket: i.e. you can change '(' to ')' and ')' to '('; you can change '[' to ']' and ']' to '['. The operation costs $$$0$$$ burles. change any square bracket to round bracket having the same direction: i.e. you can change '[' to '(' but not from '(' to '['; similarly, you can change ']' to ')' but not from ')' to ']'. The operation costs $$$1$$$ burle. The operations can be performed in any order any number of times.You are given a string $$$s$$$ of the length $$$n$$$ and $$$q$$$ queries of the type "l r" where $$$1 \le l < r \le n$$$. For every substring $$$s[l \dots r]$$$, find the minimum cost to pay to make it a correct bracket sequence. It is guaranteed that the substring $$$s[l \dots r]$$$ has an even length.The queries must be processed independently, i.e. the changes made in the string for the answer to a question $$$i$$$ don't affect the queries $$$j$$$ ($$$j > i$$$). In other words, for every query, the substring $$$s[l \dots r]$$$ is given from the initially given string $$$s$$$.A correct bracket sequence is a sequence that can be built according the following rules:  an empty sequence is a correct bracket sequence;  if "s" is a correct bracket sequence, the sequences "(s)" and "[s]" are correct bracket sequences.  if "s" and "t" are correct bracket sequences, the sequence "st" (the concatenation of the sequences) is a correct bracket sequence. E.g. the sequences "", "(()[])", "[()()]()" and "(())()" are correct bracket sequences whereas "(", "[(])" and ")))" are not.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases. Then $$$t$$$ test cases follow. For each test case, the first line contains a non-empty string $$$s$$$ containing only round ('(', ')') and square ('[', ']') brackets. The length of the string doesn't exceed $$$10^6$$$. The string contains at least $$$2$$$ characters. The second line contains one integer $$$q$$$ ($$$1 \le q \le 2 \cdot 10^5$$$) — the number of queries. Then $$$q$$$ lines follow, each of them contains two integers $$$l$$$ and $$$r$$$ ($$$1 \le l < r \le n$$$ where $$$n$$$ is the length of $$$s$$$). It is guaranteed that the substring $$$s[l \dots r]$$$ has even length. It is guaranteed that the sum of the lengths of all strings given in all test cases doesn't exceed $$$10^6$$$. The sum of all $$$q$$$ given in all test cases doesn't exceed $$$2 \cdot 10^5$$$.

For each test case output in a separate line for each query one integer $$$x$$$ ($$$x \ge 0$$$) — the minimum cost to pay to make the given substring a correct bracket sequence.

NoteConsider the first test case. The first query describes the whole given string, the string can be turned into the following correct bracket sequence: "([()])()[[]]". The forms of the brackets aren't changed so the cost of changing is $$$0$$$.The second query describes the substring ")[)()]". It may be turned into "(()())", the cost is equal to $$$2$$$.The third query describes the substring "))[)". It may be turned into "()()", the cost is equal to $$$1$$$.The substrings of the second test case contain only round brackets. It's possible to prove that any sequence of round brackets having an even length may be turned into a correct bracket sequence for the cost of $$$0$$$ burles.In the third test case, the single query describes the string "[]" that is already a correct bracket sequence.

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Maybe
import Data.Bits
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.Char as C

data Info = Empty !Bool
          | NonEmpty !Bool !Int !Bool
          deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 /= m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 /= l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 /= m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 /= l2  = NonEmpty l1 (m1 + m2) r2
        | m1 > m2   = NonEmpty l1 (m1 - m2) (not r2)
        | m1 < m2   = NonEmpty (not l1) (m2 - m1) r2
        | otherwise = Empty (l1 /= r2)

instance Monoid Info where
    mempty = Empty False

charToInfo :: Char -> Info
charToInfo c
    | c == '(' || c == ')' = Empty True
    | c == '[' || c == ']' = NonEmpty False 1 False
    | otherwise            = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoST = fromListST (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ foldRangeST l r infoST
    putStr $ unlines $ map (show . doQry) qrys

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

data SegTree a = SegTree !(Int, Int, Int) !(SegNode a) deriving Show
data SegNode a = SLeaf !a | SBin !a !(SegNode a) !(SegNode a) deriving Show

buildST :: Monoid a => (Int, Int) -> (Int -> SegNode a) -> SegTree a
buildST (l, r) f
    | n < -1    = error "invalid range"
    | n == -1   = SegTree (l, r, 0) $ SLeaf mempty
    | otherwise = SegTree (l, r, bit ht) $ f ht
  where
    n = r - l
    ht = finiteBitSize n - countLeadingZeros n

makeSN :: Semigroup a => SegNode a -> SegNode a -> SegNode a
makeSN lt rt = SBin (getx lt <> getx rt) lt rt where
    getx (SLeaf x) = x
    getx (SBin x _ _) = x

fromListST :: Monoid a => (Int, Int) -> [a] -> SegTree a
fromListST bnds xs = buildST bnds (flip evalState xs . go) where
    pop = state go where
        go []     = (mempty, [])
        go (x:xs) = (x,      xs)
    go j | j == 0 = SLeaf <$> pop
    go j = makeSN <$> go (j - 1) <*> go (j - 1)

foldRangeST :: Monoid a => Int -> Int -> SegTree a -> a
foldRangeST ql qr _ | ql > qr + 1 = error "invalid range"
foldRangeST ql qr (SegTree (l, _, p) root) = go root l (l + p - 1) mempty where
    go _ l r acc | r < ql || qr < l = acc
    go (SLeaf x) _ _ acc = acc <> x
    go (SBin x lt rt) l r acc
        | ql <= l && r <= qr = acc <> x
        | otherwise          = go rt (m + 1) r $! go lt l m acc
        where m = (l + r) `div` 2

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

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

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

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Maybe
import Data.Bits
import Data.Char
import qualified Data.ByteString.Char8 as C
import qualified Data.Char as C

data Info = Empty !Int
          | NonEmpty !Int !Int !Int
          deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 `xor` m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 `xor` l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 `xor` m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 `xor` l2 == 1 = NonEmpty l1 (m1 + m2) r2
        | m1 > m2          = NonEmpty l1 (m1 - m2) (r2 `xor` 1)
        | m1 < m2          = NonEmpty (l1 `xor` 1) (m2 - m1) r2
        | otherwise        = Empty (l1 `xor` r2)

instance Monoid Info where
    mempty = Empty 0

charToInfo :: Char -> Info
charToInfo c
    | c == '(' || c == ')' = Empty 1
    | c == '[' || c == ']' = NonEmpty 0 1 0
    | otherwise            = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoST = fromListST (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ foldRangeST l r infoST
    putStr $ unlines $ map (show . doQry) qrys

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

data SegTree a = SegTree !(Int, Int, Int) !(SegNode a) deriving Show
data SegNode a = SLeaf !a | SBin !a !(SegNode a) !(SegNode a) deriving Show

buildST :: Monoid a => (Int, Int) -> (Int -> SegNode a) -> SegTree a
buildST (l, r) f
    | n < -1    = error "invalid range"
    | n == -1   = SegTree (l, r, 0) $ SLeaf mempty
    | otherwise = SegTree (l, r, bit ht) $ f ht
  where
    n = r - l
    ht = finiteBitSize n - countLeadingZeros n

makeSN :: Semigroup a => SegNode a -> SegNode a -> SegNode a
makeSN lt rt = SBin (getx lt <> getx rt) lt rt where
    getx (SLeaf x) = x
    getx (SBin x _ _) = x

fromListST :: Monoid a => (Int, Int) -> [a] -> SegTree a
fromListST bnds xs = buildST bnds (flip evalState xs . go) where
    pop = state go where
        go []     = (mempty, [])
        go (x:xs) = (x,      xs)
    go j | j == 0 = SLeaf <$> pop
    go j = makeSN <$> go (j - 1) <*> go (j - 1)

foldRangeST :: Monoid a => Int -> Int -> SegTree a -> a
foldRangeST ql qr _ | ql > qr + 1 = error "invalid range"
foldRangeST ql qr (SegTree (l, _, p) root) = go root l (l + p - 1) mempty where
    go _ l r acc | r < ql || qr < l = acc
    go (SLeaf x) _ _ acc = acc <> x
    go (SBin x lt rt) l r acc
        | ql <= l && r <= qr = acc <> x
        | otherwise          = go rt (m + 1) r $! go lt l m acc
        where m = (l + r) `div` 2

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

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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

import Control.Monad
import Control.Monad.State
import Data.Array
import Data.Foldable
import Data.Maybe
import Data.Bits
import Data.Char
import qualified Data.ByteString.Char8 as C

data Info = Empty !Int
          | NonEmpty !Int !Int !Int deriving Show

instance Semigroup Info where
    Empty m1          <> Empty m2          = Empty (m1 `xor` m2)
    Empty m1          <> NonEmpty l2 m2 r2 = NonEmpty (m1 `xor` l2) m2 r2
    NonEmpty l1 m1 r1 <> Empty m2          = NonEmpty l1 m1 (r1 `xor` m2)
    NonEmpty l1 m1 r1 <> NonEmpty l2 m2 r2
        | r1 `xor` l2 == 1   = NonEmpty l1 (m1 + m2) r2
        | m1 == 1 && m2 == 1 = Empty (l1 `xor` r2)
        | otherwise          = NonEmpty l1 (m1 + m2 - 2) r2

charToInfo :: Char -> Info
charToInfo '(' = Empty 1
charToInfo ')' = Empty 1
charToInfo '[' = NonEmpty 0 1 0
charToInfo ']' = NonEmpty 0 1 0
charToInfo _   = error "!"

cost :: Info -> Int
cost (Empty _)        = 0
cost (NonEmpty _ m _) = m

solve :: IO ()
solve = do
    s <- C.unpack . C.takeWhile (not . isSpace) <$> C.getLine
    ~[q] <- readInts
    qrys <- replicateM q readInts
    let infoSP = fromListSP (1, length s) $ map charToInfo s
        doQry ~[l, r] = cost $ querySP l r infoSP
    putStr $ unlines $ map (show . doQry) qrys

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

type SparseTable a = Array Int (Array Int a)

fromArraySP :: Semigroup a => Array Int a -> SparseTable a
fromArraySP a = if l > h + 1 then error "invalid range" else t where
    (l, h) = bounds a
    n = h - l + 1
    k = finiteBitSize n - countLeadingZeros n - 1
    t = fArray (0, k) f
    f j | j == 0    = a
        | otherwise = fArray (l, h - 2 * hf + 1) g
        where hf = 1 `shiftL` (j - 1)
              p = t!(j - 1)
              g i = p!i <> p!(i + hf)

fromListSP :: Semigroup a => (Int, Int) -> [a] -> SparseTable a
fromListSP bnds xs = fromArraySP $ listArray bnds xs

querySP :: Semigroup a => Int -> Int -> SparseTable a -> a
querySP l r _ | l > r = error "invalid range"
querySP l r t = go l where
    r' = r + 1
    go l | l' == r'  = t!j!l
         | otherwise = t!j!l <> go l'
         where j = countTrailingZeros $ r' - l
               l' = l + 1 `shiftL` j

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

fArray :: Ix i => (i, i) -> (i -> a) -> Array i a
fArray b f = array b [(i, f i) | i <- range b]

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

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


Once Bob got to a sale of old TV sets. There were n TV sets at that sale. TV set with index i costs ai bellars. Some TV sets have a negative price — their owners are ready to pay Bob if he buys their useless apparatus. Bob can «buy» any TV sets he wants. Though he's very strong, Bob can carry at most m TV sets, and he has no desire to go to the sale for the second time. Please, help Bob find out the maximum sum of money that he can earn.

The first line contains two space-separated integers n and m (1 ≤ m ≤ n ≤ 100) — amount of TV sets at the sale, and amount of TV sets that Bob can carry. The following line contains n space-separated integers ai ( - 1000 ≤ ai ≤ 1000) — prices of the TV sets.

Output the only number — the maximum sum of money that Bob can earn, given that he can carry at most m TV sets.

import List
getA = fmap (map read . words) getLine
main = do
	[n, m] <- getA
	a <- getA
	putStr $ show $ negate $ sum $ take m $ sort $ filter (<0) a

import Data.List

main = do
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	tvs <- getLine >>= return . map read . words :: IO [Int]
	(putStrLn . show . sum . take m . reverse . sort . filter (>0) . map (*(-1))) tvs

import Data.List (sort)

(-->) = flip fmap

main = do
  (n:m:_) <- getLine --> words --> map read
  as <- getLine --> words --> map read :: IO [Int]
  let ans = negate $ sum $ takeWhile (< 0) $ take m $ sort as
  print ans

import List
main = do
    s <- getLine
    let [n, m] = map read (words s)
    s <- getLine
    let ans = sum $ take m [if x > 0 then 0 else x | x <- sort (map read (words s))]
    print (-ans)

import List

readAs :: IO [Int]
readAs = do
  line <- getLine
  return (map (read::String->Int) (words line))

solve :: Int -> [Int] -> Int
solve 0 _ = 0
solve _ [] = 0
solve m (a:as)
  | a < 0 = (-a) + solve (m - 1) as
  | otherwise = 0

main = do
  [n, m] <- readAs
  as <- readAs
  print (solve m (sort as))

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

import Data.List
import Data.Function

main = do
  [n, m] <- map read . words <$> getLine
  tvs'   <- map read . words <$> getLine
  let tvs = takeWhile (< 0) . sort $ tvs'
      earn = sum $ if length tvs > m then take m tvs else tvs
  print (- earn)

import Data.List (sort)

main :: IO ()
main = getContents >>= print . solve . map read . tail . words

solve :: [Int] -> Int
solve (m:as) = negate $ sum $ take m $ sort $ map (min 0) as
solve _ = undefined

import Data.List
main = do
  [n,m] <- fmap (map read . words) getLine
  print . negate . sum . take m . sort . filter (< 0) . map read . words =<< getLine

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::Int->[Int]->String
solve a b = toString solve'
            where
              list = takeWhile (<0) (sort b)
              solve' | a < (length list) = - (sum (take a list))
                     | otherwise         = - (sum list)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -cpp #-}
{-# OPTIONS_GHC -funbox-strict-fields -fexcess-precision -monly-3-regs #-}
{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}

import Control.Applicative
import Control.Monad
-- import Control.Arrow
import Data.List
-- import Data.Maybe
import Data.Ord
-- import Data.Char
-- import Data.Function
-- import qualified Data.Map as Map
-- import qualified Data.Set as Set
import qualified Data.Foldable as F
import qualified Data.Traversable as T
-- import qualified Data.ByteString.Char8 as BS
import Text.Printf

{-# SPECIALIZE for_ :: Char -> Char -> (Char -> IO ()) -> IO () #-}
{-# SPECIALIZE for_ :: Int -> Int -> (Int -> IO ()) -> IO () #-}
for_ :: (Monad m, Ord a, Enum a) => a -> a -> (a -> m ()) -> m ()
for_ i n f = loop i where
  loop i | i <= n    = f i >> loop (succ i)
         | otherwise = return ()

main :: IO ()
main = do
  let readData :: IO [Int]
      readData = map read . words <$> getLine
      -- readData = map (fst . fromJust . BS.readInt) . BS.words <$> BS.getLine
  n : m : _ <- readData
  xs <- takeWhile (< 0) . take m . sort <$> readData
  printf "%d\n" $ negate (sum xs)

import Data.List

solve ns n = (*) (-1) $ sum $ filter (<= 0) $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List

getnum :: IO [Int]
getnum = fmap (map read . words) getLine

get m num = 0 - (sum . take m . sort . filter (<0) $ num)

main = do
    [n, m] <- getnum
    num <- getnum
    print $ get m num

import List
main = interact (ans)
ans theInput = show a0 where
  [[n,m],a] = map ( map (read::String->Int)) $ map words $ lines theInput
  a0 = (-1) * (sum $ take m (takeWhile (< 0) (sort a)))

import List
main = interact (ans)
ans theInput = show a1 where
  theLines = lines theInput
  line0 = words $ head theLines
  n = read (line0 !! 0) ::Int
  m = read (line0 !! 1) ::Int
  a0 = takeWhile (< 0) (sort $ map (read::String->Int) (words (theLines !! 1)))
  a1 = (-1) * (sum $ take m a0)

import Control.Applicative
import Data.List
import qualified Data.ByteString.Char8 as C
import Data.Maybe
import Data.Array
import qualified Data.IntMap as I

main=do
	 [n,m]<- map read.words <$> getLine ::IO [Int]
	 r<-   take m .sort. filter (<0) . map (fst.fromJust.C.readInt). C.words <$> C.getLine:: IO [Int]
	 print $ (-(sum r))

import Data.List (sort)

process :: Int -> [Int] -> Int
process m = negate.sum.takeWhile (<0).take m.sort

readInt :: String -> Int
readInt = read

main :: IO ()
main = do
    [n,m] <- fmap (map readInt.words) getLine
    as <- fmap (map readInt.words) getLine
    print $ process m as

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve n tvs)

import Data.List

main = do
	[n, m] <- getLine >>= return . map read . words :: IO [Int]
	tvs <- getLine >>= return . map read . words :: IO [Int]
	(putStrLn . show . sum . take m . sort . filter (>0) . map (*(-1))) tvs

main = do
  [n,m] <- fmap (map read . words) getLine
  print . sum . map read . take m . words =<< getLine

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::Int->[Int]->String
solve a b = toString solve'
            where
              list = takeWhile (<0) (sort b)
              solve' | a < (length list) = sum (take a list)
                     | otherwise         = sum list

import Prelude
import List
import Char

main = interact q

q = func.map (map toInt.words).lines

func::[[Int]]->String
func (a:b:xs) = (solve (last a) b )++ func xs
func []       = ""

toInt::String->Int
toInt = read
toString::Int->String
toString=show

solve::Int->[Int]->String
solve a b = toString (solve' b)
            where
              solve' = (0-).sum.take a.rsort

rsort = sort

import Data.List

solve ns n = (*) (-1) $ sum $ filter (>= 0) $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List

solve ns n = (*) (-1) $ sum $ take n (sort ns)

main = do
    n <- fmap (last . map read . words) getLine :: IO Int
    ns <- fmap (map read . words) getLine :: IO [Int]
    print $ solve ns n

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . reverse . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve m tvs)

import Data.List
import Control.Applicative

solve :: Int -> [Int] -> Int
solve n = ((-1) * ) . sum . take n . reverse . sort . filter (<0)

main = do
  [m, n] <- map read . words <$> getLine
  tvs <- map read . words <$> getLine
  print (solve n tvs)


You have a large electronic screen which can display up to $$$998244353$$$ decimal digits. The digits are displayed in the same way as on different electronic alarm clocks: each place for a digit consists of $$$7$$$ segments which can be turned on and off to compose different digits. The following picture describes how you can display all $$$10$$$ decimal digits:As you can see, different digits may require different number of segments to be turned on. For example, if you want to display $$$1$$$, you have to turn on $$$2$$$ segments of the screen, and if you want to display $$$8$$$, all $$$7$$$ segments of some place to display a digit should be turned on.You want to display a really large integer on the screen. Unfortunately, the screen is bugged: no more than $$$n$$$ segments can be turned on simultaneously. So now you wonder what is the greatest integer that can be displayed by turning on no more than $$$n$$$ segments.Your program should be able to process $$$t$$$ different test cases.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 100$$$) — the number of test cases in the input. Then the test cases follow, each of them is represented by a separate line containing one integer $$$n$$$ ($$$2 \le n \le 10^5$$$) — the maximum number of segments that can be turned on in the corresponding testcase. It is guaranteed that the sum of $$$n$$$ over all test cases in the input does not exceed $$$10^5$$$.

For each test case, print the greatest integer that can be displayed by turning on no more than $$$n$$$ segments of the screen. Note that the answer may not fit in the standard $$$32$$$-bit or $$$64$$$-bit integral data type.

readInt :: IO Int
readInt = do
        t <- getLine
        return $ read t

createString :: Int -> String
createString n = (if n `mod` 2 /= 0 then '7' else '1') : replicate ((n-2) `quot` 2) '1'

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        n <- readInt
        putStrLn $ createString n
        solve (t-1)

main :: IO ()
main = do
        t <- readInt
        solve t

import Control.Monad

greatest :: Int -> String
greatest n = if n `mod` 2 == 0
    then replicate (n `div` 2) '1'
    else '7' : greatest (n - 3)

solve :: IO ()
solve = do
    n <- readLn
    putStrLn $ greatest n

main :: IO ()
main = do
    t <- readLn
    replicateM_ t solve

{- This code was written by
Russell Emerine - linguist,
mathematician, coder,
musician, and metalhead. -}

solve 0 = ""
solve n | odd n = '7':solve (n - 3) | otherwise = '1':solve (n - 2)

main = getLine >> getContents >>= mapM_ (putStrLn.solve).map read.words

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>), (<|), replicate)
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n =  if (mod n 2) == 1 then toList $ '7' DSeq.<| DSeq.replicate (div (n - 2) 2) '1'
        else replicate (div n 2) '1'

wordsWhen     :: (Char -> Bool) -> String -> [String]
wordsWhen p s =  case dropWhile p s of
                      "" -> []
                      s' -> w : wordsWhen p s''
                            where (w, s'') = break p s'

repeatNTimes 0 _ = return ()
repeatNTimes n action =
 do
  action
  repeatNTimes (n-1) action

index :: Int -> Int -> Int
index q n = (q - 1) `mod` n

main = do
    input1 <- getLine
    let t = read input1 :: Int

    --main cycle
    repeatNTimes t (do
        input2 <- getLine
        let n = read input2 :: Int

        let maxOnes = n `div` 2
        let odd = n `mod` 2 == 1
        let ones = if odd then maxOnes - 1 else maxOnes

        putStr $ if odd then "7" else ""
        repeatNTimes ones (do
          putStr "1"
          )
        putStrLn ""
        )

import Control.Monad

main = readLn >>= flip replicateM_ solve

solve :: IO ()
solve = readLn >>= putStrLn . getAns

getAns :: Int -> String
getAns x | x `mod` 2 == 0 = replicate (x `div` 2) '1'
         | otherwise = '7' : replicate (x `div` 2 - 1) '1'

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

process d | d==2 = "1"
          | d==3 = "7"
	  | even d = replicate (div d 2) '1'
	  | otherwise = "7" ++ (replicate ((div d 2)-1) '1')

onecase = do
		d<-read <$> getLine ::IO Int
		putStrLn $ process d

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase

process :: Int -> [Char]
process n
    | even n = replicate (n`div`2) '1'
    | otherwise = '7':replicate ((n-3)`div`2) '1'

readInt :: String -> Int
readInt = read

run :: Int -> IO ()
run 0 = return ()
run t = do
    n <- fmap readInt getLine
    putStrLn $ process n
    run (t-1)

main :: IO ()
main = do
    t <- fmap readInt getLine
    run t

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n = if n == 2 then "1" else
       if n == 3 then "7" else
        '1' : f2 (n - 2)

import Data.Ord
import Data.Int
import qualified Data.Sequence as DSeq (null, Seq( Empty ), (|>))
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Either
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Except
import Control.Monad.Trans.Class
import Prelude hiding (showList)
import Text.Read (readEither)

getToken :: IO String
getToken =
    let aux s = do
        x <- getChar
        if x == ' ' || x == '\t' || x == '\n' then
            if DSeq.null s then
                aux s
            else
                return $ toList s
        else
            aux $ s DSeq.|> x
    in aux DSeq.Empty

type EIO a = ExceptT String IO a

get :: Read a => EIO a
get = ExceptT $ liftM readEither getToken
puts :: String -> EIO ()
puts = lift . putStr
putsln :: String -> EIO ()
putsln = lift . putStrLn
put :: Show a => a -> EIO ()
put = putsln . show
putln :: Show a => a -> EIO ()
putln = putsln . show
showList :: Show a => [a] -> String
showList [] = []
showList (x : l) = shows x $ showChar ' ' $ showList l

main :: IO ()
main = do
    o <- runExceptT main_
    case o of
        Right () -> return ()
        Left s -> putStrLn s

main_ :: EIO ()
main_ = do
    t <- get
    replicateM_ t f1

f1 :: EIO ()
f1 = do
    n <- get
    putsln $ f2 n

f2 :: Int -> String
f2 n = if n == 2 then "1" else
       if n == 3 then "7" else
       if n == 4 then "11" else
       if n == 5 then "71" else
        '1' : f2 (n - 2)

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

process d | d==2 = "1"
          | d==3 = "7"
	  | even d = replicate (div d 2) '1'
	  | otherwise = "7" ++ (replicate (div d 2) '1')

onecase = do
		d<-read <$> getLine ::IO Int
		putStrLn $ process d

main = do
		n<-read <$> getLine ::IO Int
		replicateM_ n onecase


You are given an integer $$$n$$$. You have to change the minimum number of digits in it in such a way that the resulting number does not have any leading zeroes and is divisible by $$$7$$$.If there are multiple ways to do it, print any of them. If the given number is already divisible by $$$7$$$, leave it unchanged.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 990$$$) — the number of test cases. Then the test cases follow, each test case consists of one line containing one integer $$$n$$$ ($$$10 \le n \le 999$$$).

For each test case, print one integer without any leading zeroes — the result of your changes (i. e. the integer that is divisible by $$$7$$$ and can be obtained by changing the minimum possible number of digits in $$$n$$$). If there are multiple ways to apply changes, print any resulting number. If the given number is already divisible by $$$7$$$, just print it.

NoteIn the first test case of the example, $$$42$$$ is already divisible by $$$7$$$, so there's no need to change it.In the second test case of the example, there are multiple answers — $$$28$$$, $$$21$$$ or $$$63$$$.In the third test case of the example, other possible answers are $$$357$$$, $$$371$$$ and $$$378$$$. Note that you cannot print $$$077$$$ or $$$77$$$.

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . div7
div7 :: Int -> Int
div7 x | mod x 7 == 0 = x
       | otherwise = case filter (\a -> mod a 7 == 0)
                          (map (((div x 10)*10)+) [0..9]) of
                       n:_ -> n
                       _ -> error "Some number in a decade must be divisible by 7."

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        n <- readLn
        putStrLn . show $ solve n
    return ()

solve :: Int -> Int
solve n
  | mod n 7 == 0        = n
  | mod n 7 <= mod n 10 = n - mod n 7
  | otherwise           = n + (7 - mod n 7)

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        let r = n `mod` 10
        print $ if n `mod` 7 == 0
                then n
                else head . filter (\x -> x `mod` 7 == 0) $ map ((n - r)+) [0..9]

import Control.Monad (forM_)

solve :: Integral a => a -> a
solve n
    | mod n 7 == 0 = n
    | mod n 7 <= mod n 10 = n - mod n 7
    | otherwise = n + (7 - mod n 7)

main :: IO ()
main = do
    t <- readLn :: IO Int
    forM_ [1 .. t] $ \i -> do
        n <- readLn :: IO Int
        print $ solve n

{-# LANGUAGE BangPatterns #-}
import Control.Monad
solve :: Int -> Int
solve n = 10 * lead + lst'
  where
    !(lead, lst) = divMod n 10
    r = mod n 7
    lst'
      | r == 0 = lst
      | lst - r >= 1 = lst - r
      | otherwise = lst - r + 7

main :: IO ()
main = do
  n <- readLn
  replicateM_ n $ do
    x <- readLn
    print $ solve x

main :: IO()

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

process i
    | mod i 7 == 0 = i
    | otherwise = let base = i - (i `mod` 10) in base + (7 - base `mod` 7);

import Control.Monad (replicateM_)

main = read <$> getLine >>= flip replicateM_ scase
scase = read <$> getLine >>= print . div7
div7 :: Int -> Int
div7 x = case filter (\a -> mod a 7 == 0) (map (((div x 10)*10)+) [0..9]) of
           n:_ -> n
           _ -> error "Some number in a decade must be divisible by 7."

import Control.Monad
import Data.List

main :: IO ()
main = do
    t <- readLn
    replicateM t $ do
        n <- readLn
        putStrLn . show $ solve n
    return ()

solve :: Int -> Int
solve n
  | mod n 7 == 0        = n
  | mod n 7 <= mod n 10 = n - mod n 7
  | otherwise           = n + mod n 7

module Main where

import           Control.Monad (replicateM_)

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n <- readLn
        print $ if n `mod` 10 > 5
                then find pred n
                else find succ n

find :: (Int -> Int) -> Int -> Int
find f n = head . filter (\x -> x `mod` 7 == 0) $ iterate f n


You are given an array $$$a$$$ of $$$n$$$ integers. Find the number of pairs $$$(i, j)$$$ ($$$1 \le i < j \le n$$$) where the sum of $$$a_i + a_j$$$ is greater than or equal to $$$l$$$ and less than or equal to $$$r$$$ (that is, $$$l \le a_i + a_j \le r$$$).For example, if $$$n = 3$$$, $$$a = [5, 1, 2]$$$, $$$l = 4$$$ and $$$r = 7$$$, then two pairs are suitable:   $$$i=1$$$ and $$$j=2$$$ ($$$4 \le 5 + 1 \le 7$$$);  $$$i=1$$$ and $$$j=3$$$ ($$$4 \le 5 + 2 \le 7$$$).

The first line contains an integer $$$t$$$ ($$$1 \le t \le 10^4$$$). Then $$$t$$$ test cases follow. The first line of each test case contains three integers $$$n, l, r$$$ ($$$1 \le n \le 2 \cdot 10^5$$$, $$$1 \le l \le r \le 10^9$$$) — the length of the array and the limits on the sum in the pair. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le 10^9$$$). It is guaranteed that the sum of $$$n$$$ overall test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case, output a single integer — the number of index pairs $$$(i, j)$$$ ($$$i < j$$$), such that $$$l \le a_i + a_j \le r$$$.

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

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (hs, ts) = splitAt k xs
   in hs : chunksOf k ts

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  map (words >>> map read) >>> chunksOf 2 >>> map (solve >>> show) >>> unlines

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromMaybe)

type Scanner = State [String]

runScanner :: Scanner a -> String -> a
runScanner = runScannerWith words

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

str :: Scanner String
str =
  get >>= \case
    s:ss -> put ss >> return s

int :: Scanner Int
int = read <$> str

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

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

-- main :: IO ()
-- main =
--   interact $
--   runScanner (numberOf singleCase) >>> map (solve >>> show) >>> unlines
--   where
--     singleCase = do
--       nlr <- times 3 int
--       xs <- times (head nlr) int
--       return [nlr, xs]
chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf k xs =
  let (hs, ts) = splitAt k xs
   in hs : chunksOf k ts

main :: IO ()
main =
  interact $
  lines >>>
  drop 1 >>>
  map (words >>> map read) >>> chunksOf 2 >>> map (solve >>> show) >>> unlines

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs

{-# LANGUAGE LambdaCase #-}

import Control.Applicative (liftA2)
import Control.Arrow ((>>>))
import Control.Monad (replicateM)
import Control.Monad.State
import qualified Data.ByteString.Lazy.Char8 as C
import Data.List
import Data.Maybe (fromMaybe)

type Scanner = State [String]

runScanner :: Scanner a -> String -> a
runScanner = runScannerWith words

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

str :: Scanner String
str =
  get >>= \case
    s:ss -> put ss >> return s

int :: Scanner Int
int = read <$> str

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

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

main :: IO ()
main =
  interact $
  runScanner (numberOf singleCase) >>> map (solve >>> show) >>> unlines
  where
    singleCase = do
      nlr <- times 3 int
      xs <- times (head nlr) int
      return [nlr, xs]

type I64 = Integer

solve :: [[Int]] -> I64
solve [[n, l, r], xs] =
  let xs' = sort xs
   in (`div` 2) $
      compute xs' r - compute xs' (l - 1) -
      (toInteger . length . filter (\x -> l <= 2 * x && 2 * x <= r) $ xs)

compute :: [Int] -> Int -> I64
compute xs lim =
  sum . map (toInteger . snd . head) . tail $
  scanl
    (\vs x -> dropWhile ((> lim - x) . fst) vs)
    (reverse $ zip ((-10 ^ 9) : xs) [0 ..])
    xs

--
-- Michael V. Antosha
-- 2021
-- Michael.Antosha@gmail.com
--

{-# language NoMonomorphismRestriction #-}

{-# options_ghc -Weverything                     #-}

{-# options_ghc -Wno-safe                        #-}     -- no warning if inferred as safe
{-# options_ghc -Wno-all-missed-specialisations  #-}     -- "Could not specialise..." when -O1
{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

-- (ghc -Werror -O1 -rtsopts -o a.out *.hs  &&  set -o pipefail  &&  cat -- input.txt | ./a.out > temp.txt  &&  diff -sdu -- output.txt temp.txt)  &&  echo OKAY  ||  echo ERROR

import Prelude
import Control.Monad
import qualified Data.Map as Map

-- import Debug.Trace
-- tr s x = trace msg x  where msg = "tr: " ++ s ++ ": " ++ show x ++ "."

main :: IO ()
main = do
    t <- readLn
    tcs <- replicateM t readTC

    (putStr . unlines . map solve) tcs

readTC = do
    [_n, l, r] <- readIListLn
    nums       <- readIListLn
    return (l, r, nums)

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

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

solve (l, r, nums) = show $ (`div` 2) . sum . map (count l r simap) . Map.keys $ simap
  where
    inums = zip nums [1::Int ..]
    simap = Map.fromList . (`zip` [1::Integer ..]) $ inums

count l r simap (v,i) = Map.size simapLR - fixIfInside
  where
    (_, simapR)  = Map.split (l-v  , -1) simap
    (simapLR, _) = Map.split (r-v+1, -1) simapR

    fixIfInside | (v,i) `Map.member` simapLR = 1
                | otherwise                  = 0

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

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

pmGen :: Int32 -> Int32
pmGen x = fromIntegral $! mod ((16807::Int64) * fromIntegral x) 2147483647

randoms :: Int32 -> [Int32]
randoms = iterate pmGen

type Key = Int32
type RandomValue  = Int32
data TreapSet = Node {-# UNPACK #-} !Key {-# UNPACK #-} !RandomValue {-# UNPACK #-} !Int32 TreapSet TreapSet | Nil

key :: TreapSet -> Key
key (Node x _ _ _ _) = x

size :: TreapSet -> Int32
size Nil = 0
size (Node _ _ sz _ _) = sz

_relax :: Key -> RandomValue -> TreapSet -> TreapSet -> TreapSet
_relax !x !y l@(Node _ _ ls _ _) r@(Node _ _ rs _ _) = Node x y (succ $! ls + rs) l r
_relax !x !y l@(Node _ _ sz _ _) Nil = Node x y (succ sz) l Nil
_relax !x !y Nil r@(Node _ _ sz _ _) = Node x y (succ sz) Nil r
_relax !x !y Nil Nil = Node x y 1 Nil Nil

split :: Key -> TreapSet -> (TreapSet, TreapSet)
split _ Nil = (Nil, Nil)

split !key (Node x y _ left right)
  | key < x = let (l', r') = split key left in (l', _relax x y r' right)
  | otherwise = let (l', r') = split key right in (_relax x y left l', r')

tsInsert :: Key -> RandomValue -> TreapSet -> TreapSet
tsInsert !x !y Nil = Node x y 1 Nil Nil
tsInsert !x !y t@(Node x' y' sz' left' right')
  | y' >= y = if x < x' then Node x' y' (succ sz') (tsInsert x y left') right'
                        else Node x' y' (succ sz') left' (tsInsert x y right')
  | otherwise = let (l'', r'') = split x t in _relax x y l'' r''

merge :: TreapSet -> TreapSet -> TreapSet
merge Nil r = r
merge l Nil = l
merge l@(Node x' y' sz' l' r') r@(Node x'' y'' sz'' l'' r'')
  | y' > y'' = _relax x' y' l' (merge r' r)
  | otherwise = _relax x'' y'' (merge l l'') r''

tsRemove :: Key -> TreapSet -> TreapSet
tsRemove _ Nil = Nil
tsRemove !x (Node x' y' sz' l' r')
  | x < x' = _relax x' y' (tsRemove x l') r'
  | x > x' = _relax x' y' l' (tsRemove x r')
  | otherwise = merge l' r'

tsRemoveExistingKey :: Key -> TreapSet -> TreapSet
tsRemoveExistingKey !x (Node x' y' sz' l' r')
  | x < x' = Node x' y' (pred sz') (tsRemoveExistingKey x l') r'
  | x > x' = Node x' y' (pred sz') l' (tsRemoveExistingKey x r')
  | otherwise = merge l' r'

tsCount :: Key -> TreapSet -> Int32
tsCount !x = count' 0
  where
    count' !c Nil = c
    count' !c (Node x' _ _ l' r')
      | x' < x = count' (succ $! c + size l') r'
      | otherwise = count' c l'

ru, ri :: C.ByteString -> Int

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

test' :: Int -> Int32 -> Int32 -> [Int32] -> [Int32] -> Int64
test' n l r a r1 = f Nil 0 a r1
  where
    f t !acc [] _ = acc
    f t !acc (x:xs) (y:ys) = f (tsInsert x y t) (acc + (fromIntegral $ tsCount (r - x + 1) t) - (fromIntegral $ tsCount (l - x) t)) xs ys

nl = char7 '\n'

test :: Builder -> Int -> [Int] -> [Int32] -> Builder
test buf 0 _ _ = buf
test buf nt (n:l:r:a) r0 = test (buf <> int64Dec (test' n (fromIntegral l) (fromIntegral r) (map fromIntegral b) r1) <> nl) (pred nt) c r2
  where
    (b, c) = splitAt n a
    (r1, r2) = splitAt n r0

solve :: [Int32] -> [Int] -> Builder
solve r (nt:xs) = test mempty nt xs r

main :: IO ()
main = do
  seed <- getSeed
  c <- C.getContents
  hPutBuilder stdout $ solve (randoms seed) $ map ri $ C.words c


Let $$$f_{x} = c^{2x-6} \cdot f_{x-1} \cdot f_{x-2} \cdot f_{x-3}$$$ for $$$x \ge 4$$$.You have given integers $$$n$$$, $$$f_{1}$$$, $$$f_{2}$$$, $$$f_{3}$$$, and $$$c$$$. Find $$$f_{n} \bmod (10^{9}+7)$$$.

{-# LANGUAGE Strict #-}
import Data.Word

m  = 1000000006
mm = 1000000007

a +% b = mod (a+b) m
a *% b = mod (a*b) m

a +%% b = mod (a+b) mm
a *%% b = mod (a*b) mm

infixl 6 +%, +%%
infixl 7 *%, *%%

type Triple = (Word64, Word64, Word64)

product' :: Triple -> Triple -> Word64
product' (a,b,c) (r,s,t) = a*%r +% b*%s +% c*%t

mulVec :: Triple -> Triple -> Triple
mulVec (r,s,t) (a,b,c) = (rr,ss,tt)
 where
  rr = product' (r,s,t) (a, c, b+%c)
  ss = product' (r,s,t) (b, a+%c, b+%2*%c)
  tt = product' (r,s,t) (c, b+%c, a+%b+%2*%c)

power :: (a->a->a) -> a -> a -> Word64 -> a
power _ a _ 0  = a
power mul a x n
 |even n = power mul a (mul x x) (div n 2)
 |otherwise = power mul (mul a x) x (n-1)

f :: Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> Word64
f n f0 f1 f2 c = ret
 where
  (r,s,t) = power mulVec (1,0,0) (0,1,0) n
  rst = mod (r+2*s+3*t) m
  pow = mod (rst + m - (n+%1)) m

  ff (base, index) init = power (*%%) init base index

  ret = foldr ff 1 [(f0,r),(f1,s),(f2,t),(c,pow)]

input :: IO [Word64]
input = do
  line <- getLine
  return $ fmap read $ words line

main :: IO ()
main = do
  [n,f0,f1,f2,c] <- input
  let ret = f (n-1) f0 f1 f2 c
  print ret


Professor Vasechkin is studying evolution of worms. Recently he put forward hypotheses that all worms evolve by division. There are n forms of worms. Worms of these forms have lengths a1, a2, ..., an. To prove his theory, professor needs to find 3 different forms that the length of the first form is equal to sum of lengths of the other two forms. Help him to do this.

The first line contains integer n (3 ≤ n ≤ 100) — amount of worm's forms. The second line contains n space-separated integers ai (1 ≤ ai ≤ 1000) — lengths of worms of each form.

Output 3 distinct integers i j k (1 ≤ i, j, k ≤ n) — such indexes of worm's forms that ai = aj + ak. If there is no such triple, output -1. If there are several solutions, output any of them. It possible that aj = ak.

main = interact (ans)
ans theInput = answer where
  theLines = lines theInput
  n = read (head theLines) ::Int
  a = zip (map (read ::String->Int) (take n $ words $ theLines !! 1)) [1..]
  triple = [[u,v,w]|(x,u)<-a,(y,v)<-a,u/=v,(z,w)<-a,w/=u,w/=v,x==y+z]
  answer = if null triple then "-1" else unwords $ map show (head triple)

main = do getLine
          a <- fmap (map read . words) getLine
          let n = length a
              lst = [(i,j,k) | i <- [0..n-1], j <- [0..n-1], k <-[0..n-1],
                     i /= j, j /= k, i /= k, (a!!i) == (a!!j) + (a!!k)]
              (i,j,k) = head lst
          if null lst
            then putStrLn "-1"
            else putStrLn . unwords . map show . map (+1) $ [i,j,k]

main = do
	n <- fmap read getLine
	a <- fmap (map read . words) getLine
	putStr $ unwords $ map show $ last $ [-1]:[[i, j, k] | i <- [1 .. n], j <- [1 .. n], k <- [1 .. n], i /= j, i /= k, j /= k, a!!(i-1) == a!!(j-1) + a!!(k-1)]

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check
	              | ans!!1==ans!!2 = if (getNums2 (res!!1) v)==ans!!2 then [-1]
	                                 else [ans!!0,getNums2 (res!!1) v,ans!!2]
	              | otherwise = ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = if res2 == length dr then res1
	             else res2+res1+1
      where res1=length(takeWhile (/=ans) m)+1
            dr  = drop res1 m
            res2=length(takeWhile (/=ans) dr)

reads :: Read a => IO [a]
reads = getLine >>= sequence . map readIO . words

solve :: [Int] -> [(Int, Int, Int)]
solve xs  =  [(i, j, k) | i <- [1..n], j <- [1..n], k <- [1..n],
    i /= j, i /= k, j /= k,
    xs !! (i-1) == xs !! (j-1) + xs !! (k-1)]
  where
    n  =  length xs

printAns :: [(Int, Int, Int)] -> IO ()
printAns []  =  print (-1)
printAns ((i, j, k):xs)  =  putStrLn $ concat [show i, " ", show j, " ", show k]

main :: IO ()
main  =  getLine >> Main.reads >>= printAns . solve

prettyPrint (a,b,c) = show (a+1) ++ " " ++ show (b+1) ++ " " ++ show (c+1)

isCorrect list (a,b,c) = a /= b && b /= c && c /= a && (list !! a) == (list !! b) + (list !! c)

findAllSolutions worms = filter (isCorrect worms) [(a,b,c) | a <- [0..n-1], b <- [0..n-1], c <- [0..n-1]]
    where n = length worms

solve worms = if (length sol == 0) then "-1" else prettyPrint (head sol)
    where sol = findAllSolutions worms

main = do
       dummy <- getLine
       inputLine <- getLine
       let tmp = words inputLine
       let worms = map read tmp :: [Int]
       putStrLn (solve worms)

import Control.Applicative
import Control.Monad
import Data.List
import Data.Ord
import Text.Printf

main :: IO ()
main = do
  n <- readLn
  xs <- take n . map read . words <$> getLine :: IO [Int]
  let answer = do
        let forms = zip ([1 .. ] :: [Int]) xs
        (i, ai) <- forms
        (j, aj) <- forms
        (k, ak) <- forms
        guard $ i /= j
        guard $ j /= k
        guard $ k /= i
        guard $ ai == aj + ak
        return (i, j, k)
  case answer of
    (i, j, k) : _ -> printf "%d %d %d\n" i j k
    _             -> print (-1)

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show (ch n v)
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<3 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<3 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (v2) == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v (v2)) v
	       where n = head m
	             v = tail m
	             v2 = sort v

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

main = interact $pars.map read.words

pars m = if ch n v == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]
ch n v
 | n<2 = [-1]
 | otherwise = if null t then [-1]
               else [mv,fst ( head t),snd (head t)]
   where mv=maximum v
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check
	              | ans!!1==ans!!2 = if (getNums2 (res!!1) v)==0 then [-1]
	                                 else [ans!!0,getNums2 (res!!1) v,ans!!2]
	              | otherwise = ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = length(takeWhile (/=ans) (tail(drop res1 m)))+res1
      where res1=length(takeWhile (/=ans) m)+1

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (sort v) == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ getNums (ch n v (sort v)) v
	       where n = head m
	             v = tail m

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | n<2 = [-1]
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++getNums (tail ans) m

import Data.List
main = interact $pars.map read.words

pars m = if ch n v (v2) == [-1] then "-1"
	       else if check then init $concat$ map (++" ") $map show $ ans
	       	    else [head ""]
	       where n = head m
	             v = tail m
	             v2 = sort v
	             ans= getNums (ch n v (v2)) v
	             check = if v!!(ans!!0-1) == v!!(ans!!1-1)+v!!(ans!!2-1) then True
	             	     else False

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

import Data.List
main = interact $pars.map read.words

pars m = if res == [-1] then "-1"
	       else init $concat$ map (++" ") $map show $ check
	       where n = head m
	             v = tail m
	             v2 = sort v
	             res= ch n v (v2)
	             ans= getNums (res) v
	             check = if ans!!1==ans!!2 then [ans!!0,getNums2 (res!!1) v,ans!!2]
	             	     else ans

ch::Int->[Int]->[Int]->[Int]
ch n v [] = [-1]
ch n v v2
 | otherwise = if null t then ch n v (init v2)
               else [mv,fst ( head t),snd (head t)]
   where mv=last v2
         t=take 1 [ (x,y) | x<-v , y<-v, x+y==mv]

getNums [] _= []
getNums ans m = [length(takeWhile (/=(head ans)) m)+1]++(getNums (tail ans) m)

getNums2 ans m = length(takeWhile (/=(ans)) (tail(dropWhile (/=ans) m)))+1


There are $$$n$$$ friends who want to give gifts for the New Year to each other. Each friend should give exactly one gift and receive exactly one gift. The friend cannot give the gift to himself.For each friend the value $$$f_i$$$ is known: it is either $$$f_i = 0$$$ if the $$$i$$$-th friend doesn't know whom he wants to give the gift to or $$$1 \le f_i \le n$$$ if the $$$i$$$-th friend wants to give the gift to the friend $$$f_i$$$.You want to fill in the unknown values ($$$f_i = 0$$$) in such a way that each friend gives exactly one gift and receives exactly one gift and there is no friend who gives the gift to himself. It is guaranteed that the initial information isn't contradictory.If there are several answers, you can print any.

The first line of the input contains one integer $$$n$$$ ($$$2 \le n \le 2 \cdot 10^5$$$) — the number of friends. The second line of the input contains $$$n$$$ integers $$$f_1, f_2, \dots, f_n$$$ ($$$0 \le f_i \le n$$$, $$$f_i \ne i$$$, all $$$f_i \ne 0$$$ are distinct), where $$$f_i$$$ is the either $$$f_i = 0$$$ if the $$$i$$$-th friend doesn't know whom he wants to give the gift to or $$$1 \le f_i \le n$$$ if the $$$i$$$-th friend wants to give the gift to the friend $$$f_i$$$. It is also guaranteed that there is at least two values $$$f_i = 0$$$.

Print $$$n$$$ integers $$$nf_1, nf_2, \dots, nf_n$$$, where $$$nf_i$$$ should be equal to $$$f_i$$$ if $$$f_i \ne 0$$$ or the number of friend whom the $$$i$$$-th friend wants to give the gift to. All values $$$nf_i$$$ should be distinct, $$$nf_i$$$ cannot be equal to $$$i$$$. Each friend gives exactly one gift and receives exactly one gift and there is no friend who gives the gift to himself. If there are several answers, you can print any.

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

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

-- g: not knowing who to give to
-- a: not recving
solve :: Int -> [Int] -> Map Int Int
solve n fs =
    let (g, a, fs') = foldl (\(g, a, fs') (i, f) -> if f == 0 then (i : g, a, fs') else (g, Set.delete f a, Map.insert i f fs')) (mempty, Set.fromAscList [1..n], mempty) (zip [1..n] fs)
    in head $ dfs fs' g a

dfs :: Map Int Int -> [Int] -> IntSet -> [Map Int Int]
dfs f []     as = [f]
dfs f (g:gs) as = [Map.insert g a f' | a <- Set.elems as, a /= g, f' <- dfs f gs (Set.delete a as)]

main = do
    n <- fmap read getLine
    fs <- fmap (fmap read . words) getLine
    let ans = solve n fs
    putStrLn $ foldr (\i s -> show i ++ " " ++ s) "" ans

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List
import qualified Data.Set as Set

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    unused  = Set.toList $ Set.fromList [1..length xs] Set.\\ Set.fromList (filter (/= 0) xs)
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

import           Control.Monad
import           Control.Monad.State
import           Data.Array
import           Data.List
import qualified Data.Set as Set

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    s = Set.fromList (filter (/= 0) xs)
    unused  = filter (flip Set.notMember s) [1..length xs]
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

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

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

-- I miss lenses :(
intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = listArray (1, length xs) (replicate (length xs) False) // [(x, True) | x <- xs, x /= 0]
    unused  = map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _      (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

    {-# LANGUAGE TupleSections #-}

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

    extend :: [a] -> [[a]]
    extend = unfoldr f
      where f [] = Nothing
            f xs@(x:xs') = Just (xs, xs')

    -- I miss lenses :(
    intercal :: [Int] -> [Int] -> [Int]
    intercal [] _ = []
    intercal (0:xs) (z:zs) = z : intercal xs zs
    intercal (x:xs) zs = x : intercal xs zs

    solve :: [Int] -> [Int]
    solve xs =
      intercal xs $
      flip evalState unused $
      traverse (state . getFirstDiff) (extend indices)
      where
        arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
        unused = map fst . filter (not . snd) $ assocs arr
        indices = map fst . filter (\(_, x) -> x == 0) $ zip [1 ..] xs
        getFirstDiff (a:b:[]) (x:y:xs) | b == y = (y, x:xs)
        getFirstDiff (a:as)   (x:y:xs) | a == x = (y, x:xs)
        getFirstDiff _        (x:xs)            = (x, xs)

    main :: IO ()
    main =
      unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
      putStrLn

{-# LANGUAGE TupleSections #-}

import Control.Monad
import Control.Monad.State
import Data.Array

solve :: [Int] -> [Int]
solve xs = flip evalState init $ traverse (\a -> state $ if a == 0 then getFirstDiff a  else (a, )) xs
  where getFirstDiff :: Int -> [Int] -> (Int, [Int])
        getFirstDiff a (x:xs)   | x /= a = (x, xs)
        getFirstDiff a (x:y:xs)          = (y, x:xs)
        arr :: Array Int Bool
        arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs , x /= 0]
        init :: [Int]
        init = reverse . map fst . filter (not . snd) $ assocs arr

main :: IO ()
main = unwords . map show . solve . map read . words <$> (getLine *> getLine) >>= putStrLn

{-# LANGUAGE TupleSections #-}

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

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x /= 0) $ zip [1 ..] xs
    getFirstDiff [a, b] (x:y:xs) | b == x = (y, x:xs)
    getFirstDiff (a:as) (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _ (x:xs) = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

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

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst $ filter (\(_, x) -> x /= 0) (zip [1 ..] xs)
    getFirstDiff [a, b] (x:y:xs) | a == x || b == x = (y, x:xs)
    getFirstDiff _ (x:xs) = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn

{-# LANGUAGE TupleSections #-}

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

extend :: [a] -> [[a]]
extend = unfoldr f
  where f [] = Nothing
        f xs@(x:xs') = Just (xs, xs')

intercal :: [Int] -> [Int] -> [Int]
intercal [] _ = []
intercal (0:xs) (z:zs) = z : intercal xs zs
intercal (x:xs) zs = x : intercal xs zs

solve :: [Int] -> [Int]
solve xs =
  intercal xs $
  flip evalState unused $
  traverse (state . getFirstDiff) (extend indices)
  where
    arr = accumArray (||) False (1, length xs) [(x, True) | x <- xs, x /= 0]
    unused = reverse . map fst . filter (not . snd) $ assocs arr
    indices = map fst . filter (\(_, x) -> x /= 0) $ zip [1 ..] xs
    getFirstDiff (a:b:[]) (x:y:xs) | b == y = (y, x:xs)
    getFirstDiff (a:as)   (x:y:xs) | a == x = (y, x:xs)
    getFirstDiff _        (x:xs)            = (x, xs)

main :: IO ()
main =
  unwords . map show . solve . map read . words <$> (getLine *> getLine) >>=
  putStrLn


zscoder loves simple strings! A string t is called simple if every pair of adjacent characters are distinct. For example ab, aba, zscoder are simple whereas aa, add are not simple.zscoder is given a string s. He wants to change a minimum number of characters so that the string s becomes simple. Help him with this task!

The only line contains the string s (1 ≤ |s| ≤ 2·105) — the string given to zscoder. The string s consists of only lowercase English letters.

Print the simple string s' — the string s after the minimal number of changes. If there are multiple solutions, you may output any of them. Note that the string s' should also consist of only lowercase English letters.

process :: String -> String
process [x] = [x]
process (x:y:[]) = if y ==x then  [x, head [ k | k <- ['a'..'z'], k /= y, k /= x]] else [x,y]
process (x:y:z:xs) = if x == y then x:y': process (z:xs) else x:process (y:z:xs)
  where
    y' = head [ k | k <- ['a'..'z'], k /= x, k /= y, k /= z]

main = do
  aa <- getLine
  putStrLn $ process aa

import Data.Char

next :: Char -> Char
next c = chr $ (ord 'a') + (mod ((ord c) - (ord 'a') + 1) ((ord 'z') - (ord 'a') + 1))

foo :: String -> String
foo (x1:x2:xs) =
	if x1==x2 then
		let
			x2n = next x2
		in if (null xs) then
			x1 : foo (x2n:xs)
		else
			if x2n == head xs then
				x1 : foo (next x2n : xs)
			else
				x1 : foo (x2n:xs)

	else
		x1 : foo (x2:xs)
foo x = x

main :: IO ()
main = interact foo

import Control.Arrow
--import Test.QuickCheck
import Data.List

withTokens :: [(Char, Int)] -> String
withTokens = concat . map withTokens'
  where
    withTokens' :: (Char, Int) -> String
    withTokens' (char, 1) = [char]
    withTokens' (char, count)
      | even count =
          concat $ replicate (count `div` 2) ['T', char]
    withTokens' (char, count) =
      char:withTokens' (char, count - 1)

alphabet :: String
alphabet = ['a'..'z']

replaceTokens :: String -> String
replaceTokens (x:'T':y:rst) =
  x:head (alphabet \\ [x, y]):replaceTokens (y:rst)
replaceTokens ('T':y:rst) =
  head (alphabet \\ [y]):replaceTokens (y:rst)
replaceTokens (x:rst) = x:replaceTokens rst
replaceTokens [] = []

computeSimpleString :: String -> String
computeSimpleString str' =
  let lengthGroups = map (head &&& length) $ group str'
      tokenizedStr = withTokens lengthGroups
  in replaceTokens tokenizedStr

{-
runChecks :: IO ()
runChecks =
  let genInput = listOf $ elements ['a'..'e']
      propReplacecounts = forAll genInput $ \str ->
        let strCmp = zip str (computeSimpleString str)
            numDifferences = length $ filter (\(x, y) -> x /= y) strCmp
            groupLengths = map length $ group str
            numReplacements x = x `div` 2
        in numDifferences == sum (map numReplacements groupLengths)

      propNoAdjacencies = forAll genInput $ \str ->
        let simpleStr = computeSimpleString str
        in 0 == length (filter (\(x, y) -> x == y) $ zip simpleStr (drop 1 simpleStr))
  in do
    quickCheck propReplacecounts
    quickCheck propNoAdjacencies
-}

main :: IO ()
main = interact $ \str ->
  let str' = filter (`elem` alphabet) str
  in computeSimpleString str'

import Control.Arrow
--import Test.QuickCheck
import Data.List

withTokens :: [(Char, Int)] -> String
withTokens = concat . map withTokens'
  where
    withTokens' :: (Char, Int) -> String
    withTokens' (char, 1) = [char]
    withTokens' (char, count)
      | even count =
          concat $ replicate (count `div` 2) ['T', char]
    withTokens' (char, count) =
      char:withTokens' (char, count - 1)

alphabet :: String
alphabet = ['a'..'z']

replaceTokens :: String -> String
replaceTokens (x:'T':y:rst) =
  x:head (alphabet \\ [x, y]):y:replaceTokens rst
replaceTokens ('T':y:rst) =
  head (alphabet \\ [y]):y:replaceTokens rst
replaceTokens (x:rst) = x:replaceTokens rst
replaceTokens [] = []

computeSimpleString :: String -> String
computeSimpleString str' =
  let lengthGroups = map (head &&& length) $ group str'
      tokenizedStr = withTokens lengthGroups
  in replaceTokens tokenizedStr

{-
runChecks :: IO ()
runChecks =
  let genInput = listOf $ elements ['a'..'b']
      propReplacecounts = forAll genInput $ \str ->
        let strCmp = zip str (computeSimpleString str)
            numDifferences = length $ filter (\(x, y) -> x /= y) strCmp
            groupLengths = map length $ group str
            numReplacements x = x `div` 2
        in numDifferences == sum (map numReplacements groupLengths)
  in quickCheck propReplacecounts
-}

main :: IO ()
main = interact $ \str ->
  let str' = filter (`elem` alphabet) str
  in computeSimpleString str'


There are three horses living in a horse land: one gray, one white and one gray-and-white. The horses are really amusing animals, which is why they adore special cards. Each of those cards must contain two integers, the first one on top, the second one in the bottom of the card. Let's denote a card with a on the top and b in the bottom as (a, b).Each of the three horses can paint the special cards. If you show an (a, b) card to the gray horse, then the horse can paint a new (a + 1, b + 1) card. If you show an (a, b) card, such that a and b are even integers, to the white horse, then the horse can paint a new  card. If you show two cards (a, b) and (b, c) to the gray-and-white horse, then he can paint a new (a, c) card.Polycarpus really wants to get n special cards (1, a1), (1, a2), ..., (1, an). For that he is going to the horse land. He can take exactly one (x, y) card to the horse land, such that 1 ≤ x < y ≤ m. How many ways are there to choose the card so that he can perform some actions in the horse land and get the required cards?Polycarpus can get cards from the horses only as a result of the actions that are described above. Polycarpus is allowed to get additional cards besides the cards that he requires.

The first line contains two integers n, m (1 ≤ n ≤ 105, 2 ≤ m ≤ 109). The second line contains the sequence of integers a1, a2, ..., an (2 ≤ ai ≤ 109). Note, that the numbers in the sequence can coincide. The numbers in the lines are separated by single spaces.

Print a single integer — the answer to the problem.  Please, do not use the %lld specifier to read or write 64-bit integers in C++. It is preferred to use the cin, cout streams or the %I64d specifier.

import Control.Monad

getNums = (map read. words) `liftM` getLine :: IO [Integer]

main = do
    [n, m] <- getNums
    a <- getNums
    putStrLn $ show (solve n m a)

getG a = foldr gcd 0 $ [x-1|x <- a]

div2 x = if x `mod` 2 == 0 then div2 (x `div` 2) else x
single m x = sum (map (m-) (takeWhile (<=m) [round (fromIntegral x*2**k) | k <- [0..]]))

solve n m a =
    let
        g = div2 (getG a)
        func x = if g `mod` x == 0
                 then
                    let part1 = single m x
                        part2 = single m $ g `div` x
                    in
                        if g `div` x /= x
                        then part1 + part2
                        else part1
                 else 0
        ans = sum (map func (takeWhile (\x -> x*x <= g) [1..]))
    in ans

import Control.Monad

getNums = (map read. words) `liftM` getLine :: IO [Integer]

main = do
    [n, m] <- getNums
    a <- getNums
    putStrLn $ show (solve n m a)

solve n m a =
    let
        g = div2 $ foldr gcd 0 $ map (\x -> x-1) a
        div2 x = if x `mod` 2 == 0 then div2 (x `div` 2) else x
        ans = sum (map func (takeWhile (\x -> x*x <= m) [1..]))
        single x = sum (map (m-) (takeWhile (<=m) [round ((fromIntegral x)*2**k) | k <- [0..]]))
        func x = if g `mod` x == 0
                 then single x + (if g `div` x /= x then single (g `div` x) else 0)
                 else 0
    in ans