Monocarp is the coach of the Berland State University programming teams. He decided to compose a problemset for a training session for his teams.Monocarp has $$$n$$$ problems that none of his students have seen yet. The $$$i$$$-th problem has a topic $$$a_i$$$ (an integer from $$$1$$$ to $$$n$$$) and a difficulty $$$b_i$$$ (an integer from $$$1$$$ to $$$n$$$). All problems are different, that is, there are no two tasks that have the same topic and difficulty at the same time.Monocarp decided to select exactly $$$3$$$ problems from $$$n$$$ problems for the problemset. The problems should satisfy at least one of two conditions (possibly, both):  the topics of all three selected problems are different;  the difficulties of all three selected problems are different. Your task is to determine the number of ways to select three problems for the problemset.

The first line contains a single integer $$$t$$$ ($$$1 \le t \le 50000$$$) — the number of testcases. The first line of each testcase contains an integer $$$n$$$ ($$$3 \le n \le 2 \cdot 10^5$$$) — the number of problems that Monocarp have. In the $$$i$$$-th of the following $$$n$$$ lines, there are two integers $$$a_i$$$ and $$$b_i$$$ ($$$1 \le a_i, b_i \le n$$$) — the topic and the difficulty of the $$$i$$$-th problem. It is guaranteed that there are no two problems that have the same topic and difficulty at the same time. The sum of $$$n$$$ over all testcases doesn't exceed $$$2 \cdot 10^5$$$.

Print the number of ways to select three training problems that meet either of the requirements described in the statement.

NoteIn the first example, you can take the following sets of three problems:  problems $$$1$$$, $$$2$$$, $$$4$$$;  problems $$$1$$$, $$$3$$$, $$$4$$$;  problems $$$2$$$, $$$3$$$, $$$4$$$. Thus, the number of ways is equal to three.

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as DM
import qualified Data.Set as S
import qualified Data.List as L
import qualified Data.Either as DE

data Input = Input {n0 :: Integer, pairs :: [(Integer,Integer)]} deriving Show
data Output = Output Integer deriving Show

countElems :: (Ord a) => [a] -> DM.Map a Int
countElems = DM.fromListWith (+) . flip zip (repeat 1)

solve :: Input -> Output
solve (Input n ps) = Output ans where
  m1 = countElems $ fst <$> ps
  m2 = countElems $ snd <$> ps
  sureLookup x m = fromIntegral $ subtract 1 $ fromMaybe 0 $ DM.lookup x m
  badCount (x,y) = sureLookup x m1 * sureLookup y m2
  badCounts = sum $ map badCount ps
  allCount = n*(n-1)*(n-2)`div`6
  ans = allCount - badCounts

input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM (fromIntegral n) $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let bytestrings = B8.words raw
  let outputs = flip evalState bytestrings $ do
        ~[nTc] <- numberOfTestcases
        mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

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

readInt :: C.ByteString -> Int
readInt bs = case C.readInt bs of
  Nothing -> error "Not an integer"
  Just (x, _) -> x

update :: Maybe Int -> Maybe Int
update Nothing = Just 1
update (Just i) = Just (i+1)

count :: [Int] -> M.IntMap Int
count lst =
  foldr (M.alter update) M.empty lst

calc :: Int -> [(Int,Int)] -> Int64
calc n pairs =
  let themes = count $ map fst pairs
      dif = count $ map snd pairs
      m = fromIntegral n :: Int64
      total = (m*(m-1)*(m-2)) `div` 6
      delta = foldl (\acc (x,y) ->
                       let size1 = fromIntegral $ M.findWithDefault 0 x themes :: Int64
                           size2 = fromIntegral $ M.findWithDefault 0 y dif :: Int64
                       in
                         acc + (size1-1)*(size2-1)
                       ) 0 pairs
  in
    total-delta

main = do
  line <- getLine
  let t = read line :: Int
  forM_ [1..t] $ \_ -> do
    line <- C.getLine
    let n = readInt line
    pairs <- mapM (\_ -> do
                       line <- C.getLine
                       let [x,y] = map readInt $ C.words line
                       return (x,y)
                   ) [1..n]
    print $ calc n pairs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

pairingCount :: S.Set Int -> S.Set Int -> Integer
pairingCount xs ys = sum $ S.map (fromIntegral.choose2.funct) xs where
  choose2 n = fromIntegral $ n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ map (\[x,y]->pairingCount x y + pairingCount y x) $ subsetsOfSize 2 sets
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

pairingCount :: S.Set Int -> S.Set Int -> Integer
pairingCount xs ys = sum $ S.map (fromIntegral.choose2.funct) xs where
  choose2 n = fromIntegral $ n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ map (\[x,y]->pairingCount x y) $ subsetsOfSize 2 sets
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

applicate ::  [Int] -> S.Set Int -> Integer
applicate xs ys = sum [fromIntegral (choose2 $ funct x)  | x <- xs] where
  choose2 n = n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ filter (not.null.tail) lists
  sameFst = sum $ map choose3 sets
  choose3 set = fromIntegral $ m*(m-1)*(m-2)`div`6 where m=S.size set
  sameTwoFst = sum $ (applicate <$> lists <*> sets)
  ans = distinctFst + sameFst + sameTwoFst

-- gives a State(T) monad which when run gives Input
input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs

{-# LANGUAGE Safe #-}
{-# OPTIONS_GHC -O2 #-}
import Data.Maybe
import qualified Data.ByteString.Lazy.Char8 as B8
import qualified Data.ByteString.Builder as Bu
import Data.Functor.Identity
import Control.Monad.Trans.State
import Control.Monad
import Control.Applicative
import Control.Arrow
import Data.Function
import qualified Data.Bits as B
import qualified Data.Map.Lazy as M
import qualified Data.Set as S
import qualified Data.List as L

data Input = Input {n :: Int, pairs :: [(Int,Int)]}
data Output = Output Integer deriving Show

subsetsOfSize :: Int -> [a] -> [[a]]
subsetsOfSize 0 _ = [[]]
subsetsOfSize _ [] = []
subsetsOfSize k (x:xs) = [x:ys | ys <- subsetsOfSize (k-1) xs] ++ subsetsOfSize k xs

tripletCount :: Eq a => [a] -> Integer
tripletCount xs = sum $ map product $ subsetsOfSize 3 $ map (fromIntegral.length) $ L.group xs

applicate ::  [Int] -> S.Set Int -> Integer
applicate xs ys = sum [fromIntegral (choose2 $ funct x)  | x <- xs] where
  choose2 n = n*(n-1)`div`2
  funct x = if (S.member x ys) then S.size ys -1 else S.size ys

solve :: Input -> Output
solve (Input n ps) = Output ans where
  qs = L.sort ps
  distinctFst = tripletCount $ map fst qs
  lists = map (map snd) $ L.groupBy ((==)`on` fst) qs
  sets = map S.fromAscList $ filter (not.null.tail) lists
  distinctSndOnly = sum $ (applicate <$> lists <*> sets)
  ans = distinctFst + distinctSndOnly

input :: StateT [B8.ByteString] Identity Input
input = do
  ~[n] <- getIntegrals 1
  ps <- replicateM n $ (\[x,y]->(x,y)) <$> (getIntegrals 2)
  return $ Input n ps

output :: Output -> Bu.Builder
output = go  where
  go (Output x) = Bu.integerDec x <> nl
  str = Bu.string7
  nl  = Bu.string7 "\n"
  sp  = Bu.string7 " "
  dec = Bu.intDec

numberOfTestcases :: St [Int]
numberOfTestcases = explicit
  where implicit = return [1] :: St [Int]
        explicit = getIntegrals 1

------------------------------- main --------------------------------
type St = StateT [B8.ByteString] Identity

getNext :: [B8.ByteString] -> (B8.ByteString, [B8.ByteString])
getNext [] =  (B8.take 0 (B8.pack "."),[])
getNext (w:ws) =  (w,ws)

getIntegral :: Num t => B8.ByteString -> t
getIntegral x =  fromIntegral $ fromMaybe 0 $ liftA fst $ B8.readInteger x

getIntegrals :: Num t => Int -> St [t]
getIntegrals n = replicateM n $ getIntegral <$> state getNext

main :: IO ()
main = do
  raw <- B8.getContents
  let outputs = flip evalState (B8.words raw) $ do
      ~[nTc] <- numberOfTestcases
      mconcat <$> replicateM nTc (input >>= (solve >>> output >>> return))
  B8.putStr $ Bu.toLazyByteString outputs


You have a sequence $$$a_1, a_2, \ldots, a_n$$$ of length $$$n$$$, consisting of integers between $$$1$$$ and $$$m$$$. You also have a string $$$s$$$, consisting of $$$m$$$ characters B.You are going to perform the following $$$n$$$ operations.   At the $$$i$$$-th ($$$1 \le i \le n$$$) operation, you replace either the $$$a_i$$$-th or the $$$(m + 1 - a_i)$$$-th character of $$$s$$$ with A. You can replace the character at any position multiple times through the operations. Find the lexicographically smallest string you can get after these operations.A string $$$x$$$ is lexicographically smaller than a string $$$y$$$ of the same length if and only if in the first position where $$$x$$$ and $$$y$$$ differ, the string $$$x$$$ has a letter that appears earlier in the alphabet than the corresponding letter in $$$y$$$.

The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 2000$$$). The first line of each test case contains two integers $$$n$$$ and $$$m$$$ ($$$1 \le n, m \le 50$$$) — the length of the sequence $$$a$$$ and the length of the string $$$s$$$ respectively. The second line contains $$$n$$$ integers $$$a_1, a_2, \ldots, a_n$$$ ($$$1 \le a_i \le m$$$) — the sequence $$$a$$$.

For each test case, print a string of length $$$m$$$ — the lexicographically smallest string you can get. Each character of the string should be either capital English letter A or capital English letter B.

NoteIn the first test case, the sequence $$$a = [1, 1, 3, 1]$$$. One of the possible solutions is the following.   At the $$$1$$$-st operation, you can replace the $$$1$$$-st character of $$$s$$$ with A. After it, $$$s$$$ becomes ABBBB.  At the $$$2$$$-nd operation, you can replace the $$$5$$$-th character of $$$s$$$ with A (since $$$m+1-a_2=5$$$). After it, $$$s$$$ becomes ABBBA.  At the $$$3$$$-rd operation, you can replace the $$$3$$$-rd character of $$$s$$$ with A. After it, $$$s$$$ becomes ABABA.  At the $$$4$$$-th operation, you can replace the $$$1$$$-st character of $$$s$$$ with A. After it, $$$s$$$ remains equal to ABABA.  The resulting string is ABABA. It is impossible to produce a lexicographically smaller string.In the second test case, you are going to perform only one operation. You can replace either the $$$2$$$-nd character or $$$4$$$-th character of $$$s$$$ with A. You can get strings BABBB and BBBAB after the operation. The string BABBB is the lexicographically smallest among these strings.In the third test case, the only string you can get is A.In the fourth test case, you can replace the $$$1$$$-st and $$$2$$$-nd characters of $$$s$$$ with A to get AABB.In the fifth test case, you can replace the $$$1$$$-st and $$$3$$$-rd characters of $$$s$$$ with A to get ABABBBB.

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

{-# language Safe                      #-}
{-# language ImportQualifiedPost       #-}
{-# language NoMonomorphismRestriction #-}

{-# options_ghc -O3                              #-}

{-# options_ghc -Weverything                     #-}
{-# options_ghc -Werror                          #-}

{-# options_ghc -Wno-missing-import-lists        #-}
{-# options_ghc -Wno-missing-local-signatures    #-}

import Prelude               hiding (getLine)
import Control.Arrow
import Control.Monad
import Data.ByteString.Char8 qualified as B
import Data.Char
import Data.List             qualified as L
import Data.Map.Strict       qualified as Map

ri = readInts <$> B.getLine :: IO [Int]
  where
    readInts  = L.unfoldr ((second dropSpace <$>) . B.readInt) . dropSpace
    dropSpace = B.dropWhile isSpace

main :: IO ()
main = do
    [t] <- ri
    tcs <- replicateM t $ do
        [_n,m] <- ri
        as     <- ri
        return (m, as)
    mapM_ (putStrLn.solve) tcs

solve (m, as) = op
  where
    ps = L.sort . map (toBoth m) $ as
    i2c = Map.fromList . (`zip` repeat 'B') $ cinds
    op = Map.elems . foldl doOp i2c $ ps
    cinds = [1..m] :: [Int]

doOp i2c (i,j) = Map.adjust (const 'A') k i2c
  where
    (!) = (Map.!)
    k | (i2c!i) == 'B'  = i
      | otherwise       = j

toBoth m x = (min a b, max a b)
  where
    (a,b) = (x, m+1-x)

{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
main :: IO ()
main = interact $ unlines . map solve . format . map read . tail . words

format :: [Int] -> [[Int]]
format allTest = format_aux allTest []
    where
        format_aux []         res = res
        format_aux (n:m:rest) res = let (arr, remain) = splitAt n rest in
            format_aux remain (res ++ [[n, m] ++ arr])

solve :: [Int] -> [Char]
solve [] = []
solve (n:m:arr) = let st = take m ['B', 'B'..] in
    solve_aux arr st where
        solve_aux []     cur_st = cur_st
        solve_aux (x:xs) cur_st = let (smal, big) = judge (x-1) (m-x) in
            if (cur_st !! smal == 'B') then solve_aux xs (change smal cur_st)
                else solve_aux xs (change big cur_st)

judge :: Int -> Int -> (Int, Int)
judge x y = if (x < y) then (x, y) else (y, x)

change :: Int -> [Char] -> [Char]
change pos st = let (xs,_:ys) = splitAt pos st in
    xs ++ 'A':ys


You are given two integers $$$a$$$ and $$$m$$$. Calculate the number of integers $$$x$$$ such that $$$0 \le x < m$$$ and $$$\gcd(a, m) = \gcd(a + x, m)$$$.Note: $$$\gcd(a, b)$$$ is the greatest common divisor of $$$a$$$ and $$$b$$$.

The first line contains the single integer $$$T$$$ ($$$1 \le T \le 50$$$) — the number of test cases. Next $$$T$$$ lines contain test cases — one per line. Each line contains two integers $$$a$$$ and $$$m$$$ ($$$1 \le a < m \le 10^{10}$$$).

Print $$$T$$$ integers — one per test case. For each test case print the number of appropriate $$$x$$$-s.

NoteIn the first test case appropriate $$$x$$$-s are $$$[0, 1, 3, 4, 6, 7]$$$.In the second test case the only appropriate $$$x$$$ is $$$0$$$.

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

readInts :: IO [Integer]
readInts = fmap (map read . words) getLine

removeFactor :: Integer -> Integer -> Integer
removeFactor m i =
        if m `mod` i == 0
        then removeFactor (m `quot` i) i
        else m

totient' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)
totient' o m i r
        | i > m || i * i > o = (m,r)
        | otherwise =
                totient' o (removeFactor m i) (i+1) $
                        if m `mod` i == 0
                        then (r `quot` i) * (i-1)
                        else r

totient :: Integer -> Integer
totient m =
        let (m2, m3) = totient' m m 2 m
        in if m2 > 1
           then (m3 `quot` m2) * (m2 - 1)
           else m3

compute :: Integer -> Integer -> String
compute a m =
        show $ totient $ m `div` gcd a m

solve :: Int -> IO ()
solve 0 = return ()
solve t = do
        [a,m] <- readInts
        putStrLn $ compute a m
        solve (t-1)

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

{-# LANGUAGE TypeFamilies, UndecidableInstances, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables #-}
import System.IO
import Data.Ord
import Data.Int
import Data.Char
import Data.Foldable
import Data.List
import Data.Maybe
import Data.Array.ST.Safe
import Data.Array.Unboxed
import Control.Monad
import Control.Monad.ST.Safe
import Control.Monad.Trans.Class
import Control.Monad.Trans.State.Strict (StateT)
import qualified Control.Monad.Trans.State.Strict as StateT
import Data.IntMap.Strict (IntMap)
import qualified Data.IntMap.Strict as IntMap
import Data.IntSet (IntSet)
import qualified Data.IntSet as IntSet
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as C

getNewLine :: SIO ByteString
getNewLine = (lift $ C.hGetLine stdin) >>= (\z -> let x = C.dropWhile isSpace z in if C.null x then getNewLine else return x)

getRemain :: ByteString -> SIO ByteString
getRemain b = let bns = C.dropWhile isSpace b in
                if C.null bns then getNewLine >>= liftM2 (>>=) StateT.put (const . return)
                else return bns

data HInt
data HInt64
data HNormal
data HString
data HList

type SIO a = StateT ByteString IO a

class IOInteract a where
    convert :: ByteString -> (a, ByteString)
    toShowS :: a -> String -> String
    toShow :: a -> String
    toShow x = toShowS x []

instance (IOType a ~ flag, IOInteractp flag a) => IOInteract a where
    convert = convertp (undefined :: flag)
    toShowS = toShowSp (undefined :: flag)

type family IOType x where
    IOType Int = HInt
    IOType Int64 = HInt64
    IOType String = HString
    IOType [x] = HList
    IOType x = HNormal

class IOInteractp flag a where
    convertp :: flag -> ByteString -> (a, ByteString)
    toShowSp :: flag -> a -> String -> String

instance (Show a, Read a) => IOInteractp HNormal a where
    convertp _ x = let (a, b) = C.break isSpace x in (read $ C.unpack a, b)
    toShowSp _ x = shows x

instance IOInteractp HInt Int where
    convertp _ x = fromMaybe (error "parse") $ C.readInt x
    toShowSp _ x = shows x

instance IOInteractp HInt64 Int64 where
    convertp _ x = let (a, b) = fromMaybe (error "parse") $ C.readInteger x in (fromIntegral a, b)
    toShowSp _ x = shows x

instance IOInteractp HString String where
    convertp _ x = let (a, b) = C.break isSpace x in (C.unpack a, b)
    toShowSp _ x = showString x

instance (IOInteract a) => IOInteractp HList [a] where
    convertp _ x = let (a, b) = convert x in ([a], b)
    toShowSp _ [] = id
    toShowSp _ (x : []) = toShowS x
    toShowSp dum (x : xs) = toShowS x . showChar ' ' . toShowSp dum xs

get :: IOInteract a => SIO a
get = uncurry (flip (liftM2 seq . StateT.put) . return) =<< fmap convert . getRemain =<< StateT.get
put :: IOInteract a => a -> SIO ()
put = lift . (hPutStr stdout) . toShow
putln :: IOInteract a => a -> SIO ()
putln = lift . (hPutStrLn stdout) . toShow
flush :: SIO ()
flush = lift (hFlush stdout)

main :: IO ()
main = StateT.evalStateT main_ C.empty

main_ :: SIO ()
-------------------------------------------- template ------------------------------------------------------
-- for io performance comparison from @Amguls' code --
removeFactor :: Integer -> Integer -> Integer
removeFactor m i =
        if m `mod` i == 0
        then removeFactor (m `quot` i) i
        else m

totient' :: Integer -> Integer -> Integer -> Integer -> (Integer, Integer)
totient' o m i r
        | i > m || i * i > o = (m,r)
        | otherwise =
                totient' o (removeFactor m i) (i+1) $
                        if m `mod` i == 0
                        then (r `quot` i) * (i-1)
                        else r

totient :: Integer -> Integer
totient m =
        let (m2, m3) = totient' m m 2 m
        in if m2 > 1
           then (m3 `quot` m2) * (m2 - 1)
           else m3

compute :: Integer -> Integer -> String
compute a m =
        show $ totient $ m `div` gcd a m

solve :: Int -> SIO ()
solve 0 = return ()
solve t = do
        (a,m) <- liftM2 (,) get get
        putln $ compute a m
        solve (t-1)

main_ = do
        t <- get
        solve 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
    (a, m) <- liftM2 (,) get get
    putln $ f2 a m

f2 :: Int64 -> Int64 -> Int64
f2 a m =    let d = gcd a m in
            let (ap, mp) = (div a d, div m d) in
            phi mp

phi :: Int64 -> Int64
phi e = foldl (\s x -> (div s x) * (x - 1)) e $ plist e

plist :: Int64 -> [Int64]
plist n = plisth n 2 $ sqrt $ fromIntegral n

plisth :: Int64 -> Int64 -> Double -> [Int64]
plisth n x d =  if (fromIntegral x) > d then
                if n /= 1 then
                    [n]
                else
                    []
            else if mod n x == 0 then
                let np = divrec n x in
                    x : plisth np (x + 1) d
            else
                plisth n (x + 1) d

divrec :: Int64 -> Int64 -> Int64
divrec n x =    if mod n x == 0 then
                    divrec (div n x) x
                else
                    n


A string t is called an anagram of the string s, if it is possible to rearrange letters in t so that it is identical to the string s. For example, the string "aab" is an anagram of the string "aba" and the string "aaa" is not.The string t is called a substring of the string s if it can be read starting from some position in the string s. For example, the string "aba" has six substrings: "a", "b", "a", "ab", "ba", "aba".You are given a string s, consisting of lowercase Latin letters and characters "?". You are also given a string p, consisting of lowercase Latin letters only. Let's assume that a string is good if you can obtain an anagram of the string p from it, replacing the "?" characters by Latin letters. Each "?" can be replaced by exactly one character of the Latin alphabet. For example, if the string p = «aba», then the string "a??" is good, and the string «?bc» is not. Your task is to find the number of good substrings of the string s (identical substrings must be counted in the answer several times).

The first line is non-empty string s, consisting of no more than 105 lowercase Latin letters and characters "?". The second line is non-empty string p, consisting of no more than 105 lowercase Latin letters. Please note that the length of the string p can exceed the length of the string s.

Print the single number representing the number of good substrings of string s. Two substrings are considered different in their positions of occurrence are different. Thus, if some string occurs several times, then it should be counted the same number of times.

NoteConsider the first sample test. Here the string s has two good substrings: "b??" (after we replace the question marks we get "baa"), "???" (after we replace the question marks we get "baa").Let's consider the second sample test. Here the string s has two good substrings: "ab?" ("?" can be replaced by "c"), "b?c" ("?" can be replaced by "a").

import qualified Data.Map as M
f=filter
u=M.unionWith(+)
k=M.fromListWith(+)
g n h=(<=M.findWithDefault 0'?'h).sum.f(>0).M.elems$u n(fmap negate h)
m l=k[(x,1)|x<-l]
b n l=scanl u(m$take n l)$zipWith(\x y->k[(x,1),(y,-1)])(drop n l)l
s[s,p]=f(g$m p)$b(length p)s
main=interact$show.length.s.words

import qualified  Data.Map as M
import Debug.Trace
import Data.Maybe
import Data.Char

compareMaps text pat = and $ map check ['a'..'z']
  where check a = M.lookup a text <= M.lookup a pat

anagram_count s p = if length s < length p
                    then 0
                    else mycount patMap textMap s trail
  where patMap = getMyMap p
        textMap = getMyMap $ take (length p) s
        trail = drop (length p) s

mycount patMap textMap _ [] = if compareMaps textMap patMap
                              then 1
                              else 0
mycount patMap textMap (l:lead) (t:trail) = let rec = mycount patMap newTextMap lead trail
                                                newTextMap = updateMap (removeMap textMap l) t
                                                cmp = compareMaps textMap patMap
                                            in if cmp
                                               then 1 + rec
                                               else rec

removeMap m c = if c == '?'
                then m
                else let newC = (fromJust $ M.lookup c m) - 1
                     in if newC == 0
                        then M.delete c m
                        else M.insert c newC m

updateMap :: M.Map Char Int -> Char -> M.Map Char Int
updateMap m '?' = m
updateMap m c = if M.member c m
                then let cur = fromJust $ M.lookup c m
                     in M.insert c (cur+1) m
                else M.insert c 1 m

getMyMap :: String -> M.Map Char Int
getMyMap s = foldl updateMap M.empty s

strip :: String -> String
strip = f.f where f = reverse.dropWhile isSpace

main = do
	line <- getLine
	let s = strip line
	line <- getLine
	let p = strip line
            ans = anagram_count s p
	putStrLn $ show ans

{-# LANGUAGE BangPatterns #-}

main=interact$show.solve.lines

solve :: [String] -> Int
solve [ss',ps'] = if length ps' > length ss'
                     then 0
                     else go 0 (foldr put counter0 ss0) (Q ss0 []) ss
   where
     ps = foldr put counter0 ps'
     counter0 = ['a'..'z']>>[0]
     (ss0,ss) = splitAt (length ps') ss'
     go !ans !counter q [] = if isGood counter ps then ans+1 else ans
     go !ans !counter queue (c:cs) = go ans' (put c $ del x counter) (push c q) cs
        where
          (x,q) = pop queue
          ans' = if isGood counter ps then ans+1 else ans

isGood !xs !ys = and $ zipWith (<=) xs ys
put :: Char -> [Int] -> [Int]
put '?' !xs = xs
put !c !xs = ys ++ (z+1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs
del '?' !xs = xs
del !c !xs = ys ++ (z-1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs

data Queue = Q String String

push :: Char -> Queue -> Queue
push x (Q f r) = Q f (x:r)

pop :: Queue -> (Char, Queue)
pop (Q [] rs) = pop (Q (reverse rs) [])
pop (Q (f:fs) rs) = (f,Q fs rs)

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

isGood need have = (<= get '?' have) . sum . filter (>0) . Map.elems $
                   (Map.unionWith (+) need (fmap negate have))

get x = maybe 0 id . Map.lookup x
add x = Map.insertWith (+) x 1
sub x = Map.insertWith (+) x (-1)

mkMap = foldr add Map.empty

balances n l = scanl (flip($))
               (mkMap (take n l))
               (zipWith (.) (map add (drop n l)) (map sub l))

solve s p = length $ filter (isGood (mkMap p)) (balances (length p) s)

s [s, p] = solve s p

main = interact $ show . s . words

import qualified Data.Map as M
f=filter
u=M.unionWith(+)
k=M.fromListWith(+)
g n h=(<=l '?'h).sum.f(>0).M.elems$u n(fmap negate h)
l=(maybe 0 id.).M.lookup
m=k.map a
a x=(x,1)
d x=(x,-1)
b n l=scanl u(m$take n l)$zipWith(\x y->k[a x,d y])(drop n l)l
s[s,p]=f(g(m p))(b (length p) s)
main=interact$show.length.s.words

import Data.List(sort)
import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys = True
  | B.null xs && B.null qs = False
  | B.null xs = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs = False
  | otherwise = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)
{-
f n [] = []
f n xxs@(x:xs) = (take n xxs): f n xs
-}
{-
eqString' _ [] _ = True
eqString' [] (_:ys) [] = False
eqString' [] (_:ys) (_:qs) = eqString' [] ys qs
eqString' (x:xs) (y:ys) qs
  | x == y    = eqString' xs ys qs
  | null qs   = False
  | otherwise = eqString' (x:xs) ys $ tail qs
-}

{-# LANGUAGE BangPatterns #-}

main=interact$show.solve.lines

solve :: [String] -> Int
solve [ss',ps'] = go 0 (foldr put counter0 ss0) (Q ss0 []) ss
   where
     ps = foldr put counter0 ps'
     counter0 = ['a'..'z']>>[0]
     (ss0,ss) = splitAt (length ps') ss'
     go !ans !counter q [] = if isGood counter ps then ans+1 else ans
     go !ans !counter queue (c:cs) = go ans' (put c $ del x counter) (push c q) cs
        where
          (x,q) = pop queue
          ans' = if isGood counter ps then ans+1 else ans

isGood !xs !ys = and $ zipWith (<=) xs ys
put :: Char -> [Int] -> [Int]
put '?' !xs = xs
put !c !xs = ys ++ (z+1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs
del '?' !xs = xs
del !c !xs = ys ++ (z-1):zs
   where
     (ys,(z:zs)) = splitAt (fromEnum c-97) xs

data Queue = Q String String

push :: Char -> Queue -> Queue
push x (Q f r) = Q f (x:r)

pop :: Queue -> (Char, Queue)
pop (Q [] rs) = pop (Q (reverse rs) [])
pop (Q (f:fs) rs) = (f,Q fs rs)

import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B

main = do s <- B.init <$> B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys              = True
  | B.null xs && B.null qs = False
  | B.null xs              = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs              = False
  | otherwise              = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)

import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p
          B.putStrLn $ B.append s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) $ take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys = True
  | B.null xs && B.null qs = False
  | B.null xs = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs = False
  | otherwise = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)

import Control.Applicative
import Data.ByteString(ByteString)
import qualified Data.ByteString.Char8 as B
import Debug.Trace

infixr 0 .$.
(.$.) :: Show a => (a -> b) -> a -> b
f .$. x = trace (show x) f x

main = do s <- B.getLine
          p <- B.sort <$> B.getLine
          print $ solve s p

solve :: ByteString -> ByteString -> Int
solve s p = length $ filter (flip eqString p . B.sort) .$. take (ls-lp+1) $ f lp s
   where lp = B.length p
         ls = B.length s

eqString :: ByteString -> ByteString -> Bool
eqString xs ys = eqString' xs' ys qs
   where (qs,xs') = B.span ('?'==) xs

eqString' xs ys qs
  | B.null ys              = True
  | B.null xs && B.null qs = False
  | B.null xs              = (B.length ys) <= (B.length qs)
  | B.head xs == B.head ys = eqString' (B.tail xs) (B.tail ys) qs
  | B.null qs              = False
  | otherwise              = eqString' xs (B.tail ys) (B.tail qs)

f n xs
  | B.null xs = []
  | otherwise = (B.take n xs): f n (B.tail xs)


You are given a rectangular grid of lattice points from (0, 0) to (n, m) inclusive. You have to choose exactly 4 different points to build a polyline possibly with self-intersections and self-touching. This polyline should be as long as possible.A polyline defined by points p1, p2, p3, p4 consists of the line segments p1 p2, p2 p3, p3 p4, and its length is the sum of the lengths of the individual line segments.

The only line of the input contains two integers n and m (0 ≤ n, m ≤ 1000). It is guaranteed that grid contains at least 4 different points.

Print 4 lines with two integers per line separated by space — coordinates of points p1, p2, p3, p4 in order which represent the longest possible polyline. Judge program compares your answer and jury's answer with 10 - 6 precision.

main = interact $ unlines . map (\[a, b] -> show a ++ " " ++ show b) . f . map read . words
f [n, m] = if m < n then map (\[a, b] -> [b, a]) (g m n) else g n m
g n m = if n > 0 then [[1, 0], [n, m], [0, 0], [n - 1, m]] else [[0, 1], [0, m], [0, 0], [0, m - 1]]


There is a right triangle with legs of length a and b. Your task is to determine whether it is possible to locate the triangle on the plane in such a way that none of its sides is parallel to the coordinate axes. All the vertices must have integer coordinates. If there exists such a location, you have to output the appropriate coordinates of vertices.

The first line contains two integers a, b (1 ≤ a, b ≤ 1000), separated by a single space.

In the first line print either "YES" or "NO" (without the quotes) depending on whether the required location exists. If it does, print in the next three lines three pairs of integers — the coordinates of the triangle vertices, one pair per line. The coordinates must be integers, not exceeding 109 in their absolute value.

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

import Control.Applicative
import Control.Monad
import qualified Data.IntSet as IS
import Data.Maybe

main = do
  ab <- map read.words <$> getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = listToMaybe candidates
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       guard $ yy `IS.member` squares
       let !y = intSqrt yy
       guard $ a*y`rem`b == 0 && a*x`rem`b == 0
       let !x' = - a * y `div` b
           !y' = a * x `div` b
       guard $ x /= x' && y /= y'
       [[(x,y),(x',y')]]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

module Main where

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = let x2 = x^2 in [(a, b) | a <- [1..x], b <- [(a+1)..x], a^2 + b^2 == x2]

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(ia:ib:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let sa = min ia ib
            sb = max ia ib
            toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

import Data.Maybe
import Control.Monad
import Control.Arrow
main = interact $ format . solve . parse
format Nothing = "NO"
format (Just ((a,b),(c,d))) = unlines [ "YES"
                                      , "0 0"
                                      , show a ++ " " ++ show b
                                      , show (a+c) ++ " " ++ show (b+d) ]
parse = map read . words
solve [i,j] = listToMaybe $ do
  (a,b) <- unsquare i
  (_c,_d) <- unsquare j
  (c,d) <- [(_c,-_d),(_d,-_c)]
  guard (b /= -d)
  guard (a*c + b*d == 0)
  return ((a,b),(c,d))
unsquare :: Int -> [(Int,Int)]
unsquare x = merge (map (second (x^2 -)) squares) (reverse squares)
squares = map (id &&& (^2)) [1..999]
merge :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
merge as@((a,sa):as') bs@((b,sb):bs') = case compare sa sb of
  EQ -> (a,b) : (merge as' bs')
  LT -> merge as bs'
  GT -> merge as' bs
merge _ _ = []

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns, ViewPatterns, TupleSections, OverloadedStrings #-}
import qualified Data.IntSet as IS

main = do
  ab <- fmap(map read.words)getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = case filter isValid candidates of
                [] -> Nothing
                ((x,y):_) -> Just [(x,y),(-a*y`quot`b,a*x`quot`b)]
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     isValid (x,y) = (x*a)`rem`b==0 && (y*a)`rem`b==0
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       [(x,intSqrt yy)|yy `IS.member` squares]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

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

import Control.Applicative
import Control.Monad
import qualified Data.IntSet as IS
import Data.Maybe

main = do
  ab <- map read.words <$> getLine
  case solve ab of
    Nothing -> putStrLn "NO"
    Just [(x1,y1),(x2,y2)] -> do
      putStrLn "YES"
      putStrLn "0 0"
      putStrLn $ shows x1 " " ++ show y1
      putStrLn $ shows x2 " " ++ show y2

solve :: [Int] -> Maybe [(Int,Int)]
solve [a,b] = listToMaybe candidates
   where
     !squares = IS.fromList [x*x|x<-[1..1000]]
     !bb = b * b
     candidates = do
       x<-[1..1000]
       let !xx = x*x
           !yy = bb - xx
       guard $ yy `IS.member` squares
       let !y = intSqrt yy
       guard $ a*y`rem`b == 0 && a*x`rem`b == 0
       let !x' = - a * y `div` b
           !y' = b * x `div` b
       guard $ x /= x' && y /= y'
       [[(x,y),(x',y')]]

intSqrt :: Int -> Int
intSqrt = floor.sqrt.fromIntegral

module Main where

import System.IO

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

module Main where

import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = filter (\(a,b) -> a /= 0 && b /= 0) [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                putStrLn "YES"
                if a == b && a1 == a2
                    then putStrLn "NO"
                    else putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show b2 ++ " " ++ show b1
                putStrLn "0 0"

            _ -> putStrLn "NO"

module Main where

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = let x2 = x^2 in [(a, b) | a <- [1..x], b <- [(a+1)..x], a^2 + b^2 == x2]

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) -> do
        -- triangle coords currently are p0: (0, sa), p1: (sb, 0), p2: (0, 0)
        let toRatios  = S.fromList . map (uncurry (%)) . triples
            common    = S.intersection (toRatios sa) (toRatios sb)
            multi x r = floor . sqrt . fromIntegral $ x ^ 2 `div` (numerator r ^ 2 + denominator r ^ 2)

        case S.elems common of
            []  -> putStrLn "NO"
            r:_ -> do

                let msa = multi sa r
                    msb = multi sb r
                    display x y = putStrLn $ show x ++ " " ++ show y

                putStrLn "YES"
                display (-msa * denominator r) (msa * numerator r)
                display (msb * numerator r) (msb * denominator r)
                display 0 0

module Main where

import System.IO

import Data.Ratio
import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                putStrLn "YES"
                putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show (if a == b then -b1 else b1) ++ " " ++ show b2
                putStrLn "0 0"

            _ -> putStrLn "NO"

module Main where

import qualified Data.Set as S

import Control.Applicative
import Control.Monad

-- | Find all a, b such that a^2 + b^2 = x
triples :: Int -> [(Int, Int)]
triples x = filter (\(a,b) -> a /= 0 && b /= 0) [(min a b, max a b) | m <- [2..top], n <- [1..(m-1)], let a = m^2 - n^2, let b = 2 * m * n, m^2 + n^2 == x]
    where top = floor . sqrt . fromIntegral $ x

main = do
    input <- map (map (read :: String -> Int) . words) . lines <$> getContents
    forM_ input $ \(sa:sb:[]) ->
        case (triples sa, triples sb) of
            (a@(a1,a2):_, b@(b1,b2):_) -> do
                if a == b && a1 == a2
                    then putStrLn "NO"
                    else do
                        putStrLn "YES"
                        putStrLn $ show a1 ++ " " ++ show a2 ++ "\n" ++ show b2 ++ " " ++ show b1
                        putStrLn "0 0"

            _ -> putStrLn "NO"

import Data.Maybe
import Control.Monad
import Control.Arrow
main = interact $ format . solve . parse
format Nothing = "NO"
format (Just ((a,b),(c,d))) = unlines [ "YES"
                                      , "0 0"
                                      , show a ++ " " ++ show b
                                      , show (a+c) ++ " " ++ show (b+d) ]
parse = map read . words
solve [i,j] = listToMaybe $ do
  (a,b) <- unsquare i
  (_c,_d) <- unsquare j
  (c,d) <- [(_c,-_d),(_d,-_c)]
  guard (b /= d)
  guard (a*c + b*d == 0)
  return ((a,b),(c,d))
unsquare :: Int -> [(Int,Int)]
unsquare x = merge (map (second (x^2 -)) squares) (reverse squares)
squares = map (id &&& (^2)) [1..999]
merge :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)]
merge as@((a,sa):as') bs@((b,sb):bs') = case compare sa sb of
  EQ -> (a,b) : (merge as' bs')
  LT -> merge as bs'
  GT -> merge as' bs
merge _ _ = []


You are given an array $$$a$$$ consisting of $$$n$$$ non-negative integers. It is guaranteed that $$$a$$$ is sorted from small to large.For each operation, we generate a new array $$$b_i=a_{i+1}-a_{i}$$$ for $$$1 \le i < n$$$. Then we sort $$$b$$$ from small to large, replace $$$a$$$ with $$$b$$$, and decrease $$$n$$$ by $$$1$$$.After performing $$$n-1$$$ operations, $$$n$$$ becomes $$$1$$$. You need to output the only integer in array $$$a$$$ (that is to say, you need to output $$$a_1$$$).

The input consists of multiple test cases. The first line contains a single integer $$$t$$$ ($$$1\le t\le 10^4$$$) — the number of test cases. The description of the test cases follows. The first line of each test case contains one integer $$$n$$$ ($$$2\le n\le 10^5$$$) — the length of the array $$$a$$$. The second line contains $$$n$$$ integers $$$a_1,a_2,\dots,a_n$$$ ($$$0\le a_1\le \ldots\le a_n \le 5\cdot 10^5$$$) — the array $$$a$$$. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2.5\cdot 10^5$$$, and the sum of $$$a_n$$$ over all test cases does not exceed $$$5\cdot 10^5$$$.

For each test case, output the answer on a new line.

NoteTo simplify the notes, let $$$\operatorname{sort}(a)$$$ denote the array you get by sorting $$$a$$$ from small to large.In the first test case, $$$a=[1,10,100]$$$ at first. After the first operation, $$$a=\operatorname{sort}([10-1,100-10])=[9,90]$$$. After the second operation, $$$a=\operatorname{sort}([90-9])=[81]$$$.In the second test case, $$$a=[4,8,9,13]$$$ at first. After the first operation, $$$a=\operatorname{sort}([8-4,9-8,13-9])=[1,4,4]$$$. After the second operation, $$$a=\operatorname{sort}([4-1,4-4])=[0,3]$$$. After the last operation, $$$a=\operatorname{sort}([3-0])=[3]$$$.

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -O2  #-}

module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n  <- readLn @Int
        xs <- map (read @Int) . words <$> getLine
        print $ go 0 xs

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Main where
import           Control.Monad                  ( replicateM_ )
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    t <- readLn
    replicateM_ t $ do
        n  <- readLn @Int
        xs <- map (read @Int) . words <$> getLine
        print $ go 0 xs

{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

module Main where
import           Data.Array.Unboxed             ( (!)
                                                , (//)
                                                , IArray(..)
                                                , UArray
                                                , listArray
                                                )
import           Data.Bits                      ( Bits(..) )
import           Data.Foldable                  ( Foldable(..) )
import           Data.List                      ( sort )

qpow :: Int -> Int -> Int -> Int
qpow a b m = qpow' (a `mod` m) b m
  where
    qpow' a 0 m = 1 `mod` m
    qpow' a b m | odd b     = s * s * a `mod` m
                | otherwise = s * s `mod` m
      where
        b' = b `shiftR` 1
        s  = qpow' a b' m

arrange :: Int -> Int -> Int
arrange x y = product [x, x - 1 .. x - y + 1]

-- >>> arrange 5 <$> [1..5]
-- [5,20,60,120,120]

compose :: Int -> Int -> Int
compose x y = arrange x y `div` product [1 .. x]

-- >>> f [1,2,5] [3,4]
-- [[1,3],[1,4],[2,3],[2,4],[5,3],[5,4]]

isPrime :: Int -> Bool
isPrime n = go 2
  where
    go d | d * d > n      = True
         | n `rem` d == 0 = False
         | otherwise      = go (d + 1)

primes :: [Int]
primes = filter isPrime [2 ..]

initial :: Int -> Int -> UArray (Int, Int) Bool
initial n m = listArray ((1, 1), (n, m)) (repeat True)

-- >>> initial 2 2
-- array ((1,1),(2,2)) [((1,1),True),((1,2),True),((2,1),True),((2,2),True)]

intact :: UArray (Int, Int) Bool -> Int -> Int -> Int -> Int -> Bool
intact arr l r h b = and [ arr ! (x, y) | x <- [l .. r], y <- [h, b] ]

-- >>> intact (initial 2 2) 1 2 1 2
-- True

fall :: UArray (Int, Int) Bool -> (Int, Int) -> UArray (Int, Int) Bool
fall arr p = arr // [(p, False)]

-- >>> fall (initial 2 2) (1, 1)
-- array ((1,1),(2,2)) [((1,1),False),((1,2),True),((2,1),True),((2,2),True)]

count :: UArray (Int, Int) Bool -> Int
count arr = foldl' (\acc (x, y, a, b) -> if intact arr x y a b then acc + 1 else acc)
                   0
                   [ (x, y, a, b) | x <- [1 .. n], y <- [x .. n], a <- [1 .. m], b <- [a .. m] ]
    where (n, m) = snd $ bounds arr

{-

>>> n = 7
>>> m = 4
>>> arr = initial n m

>>> count arr
280

>>> ((\x -> count . fall arr . (x,) <$> [1..m]) <$> [1..n])
[[252,252,252,252],[232,232,232,232],[220,220,220,220],[216,216,216,216],[220,220,220,220],[232,232,232,232],[252,252,252,252]]

>>> ps = (\[a,b]->(a,b)) <$> sequence [[1..n], [1..m]]

>>> ps
[(1,1),(1,2),(1,3),(1,4),(2,1),(2,2),(2,3),(2,4),(3,1),(3,2),(3,3),(3,4),(4,1),(4,2),(4,3),(4,4),(5,1),(5,2),(5,3),(5,4),(6,1),(6,2),(6,3),(6,4),(7,1),(7,2),(7,3),(7,4)]

-- >>> sequence [ps, ps]

>>> count . foldl fall arr <$> sequence [ps,ps]

-}

diff :: Int -> [Int] -> ([Int], Int)
diff zero =
    (\(acc, zs) -> if zs > 0 then (0 : acc, zs) else (acc, 0))
        . foldr (\(a, b) (acc, zs) -> if a - b == 0 then (acc, zs + 1) else (a - b : acc, zs)) ([], zero)
        . (zip =<< tail)

-- >>> diff 1 [0, 1]
-- ([0,1],1)

go :: Int -> [Int] -> Int
go _    [0, x] = x
go _    [x]    = x
go zero xs     = go (max 0 (zs - 1)) (sort di) where (di, zs) = diff zero xs

{-

>>> go 0 [1,10,100]
81

>>> go 0 [4,8,9,13]
3

>>> go 0 [0,0,0,8,13]
1

>>> go 0 [2,4,8,16,32,64]
2

-}

main :: IO ()
main = do
    n  <- readLn @Int
    xs <- map (read @Int) . words <$> getLine
    print $ go 0 xs


Vasya the Great Magician and Conjurer loves all kinds of miracles and wizardry. In one wave of a magic wand he can turn an object into something else. But, as you all know, there is no better magic in the Universe than the magic of numbers. That's why Vasya adores math and spends a lot of time turning some numbers into some other ones.This morning he has n cards with integers lined up in front of him. Each integer is not less than 1, but not greater than l. When Vasya waves his magic wand, two rightmost cards vanish from the line and a new card magically appears in their place. It contains the difference between the left and the right numbers on the two vanished cards. Vasya was very interested to know what would happen next, and so he waved with his magic wand on and on, until the table had a single card left.Suppose that Vasya originally had the following cards: 4, 1, 1, 3 (listed from left to right). Then after the first wave the line would be: 4, 1, -2, and after the second one: 4, 3, and after the third one the table would have a single card with number 1.Please note that in spite of the fact that initially all the numbers on the cards were not less than 1 and not greater than l, the numbers on the appearing cards can be anything, no restrictions are imposed on them.It is now evening. Vasya is very tired and wants to return everything back, but does not remember which cards he had in the morning. He only remembers that there were n cards, they contained integers from 1 to l, and after all magical actions he was left with a single card containing number d.Help Vasya to recover the initial set of cards with numbers.

The single line contains three space-separated integers: n (2 ≤ n ≤ 100) — the initial number of cards on the table, d (|d| ≤ 104) — the number on the card that was left on the table after all the magical actions, and l (1 ≤ l ≤ 100) — the limits for the initial integers.

If Vasya is mistaken, that is, if there doesn't exist a set that meets the requirements given in the statement, then print a single number -1, otherwise print the sought set containing n integers from 1 to l. Separate the integers by spaces. Print the integers in the order, in which they were written on the cards from left to right. If there are several suitable sets of numbers, you can print any of them.

import Control.Applicative

magic :: [Int] -> Int
magic [x] = x
magic [] = 0
magic (x:y:xs) = (x - y) + magic xs

solve :: Int -> Int -> Int -> Maybe [Int]
solve n d l = add (d - initialSum) initial where
    initial = take n $ repeat 1
    initialSum = magic initial

    add :: Int -> [Int] -> Maybe [Int]
    add 0 xs = Just xs
    add _ [] = Nothing
    add a [x]
        | 1 <= x + a && x + a <= l = Just [x + a]
        | otherwise = Nothing
    add a (x:y:xs)
        | a > 0 = if x + a <= l
            then Just (x+a : y : xs)
            else do
                res <- add (a - (l-x)) xs
                return $ l:y:res
        | a < 0 = if y - a <= l
            then Just (x : y - a : xs)
            else do
                res <- add (a + (l - y)) xs
                return $ x:l:res

main = do
    [n, d, l] <- map read <$> words <$> getLine
    putStrLn $ case solve n d l of
        Nothing -> "-1"
        Just xs -> concatMap ((++" ") . show) xs

module Main where

import Control.Applicative
import Data.List

solve n d l = adjust (sum ls) ls []
  where
    adjust sm [] acc
      | sm == d   = map abs $ reverse acc
      | otherwise = [-1]
    adjust sm (x:xs) acc
      | x < 0 && sm > d = let diff = min (sm-d) (l-1) in
                          adjust (sm-diff) xs (x-diff:acc)
      | x > 0 && sm < d = let diff = min (d-sm) (l-1) in
                          adjust (sm+diff) xs (x+diff:acc)
      | otherwise = adjust sm xs (x:acc)
    ls = take n $ intersperse (-1) (repeat 1)

main = do
  [n,d,l] <- map read . words <$> getLine
  putStrLn $ unwords . map show $ solve n d l

{-# LANGUAGE BangPatterns #-}

import Control.Applicative

main = do
  [n,d,l] <- map read.words <$> getLine
  putStrLn.unwords.map show $ solve n d l []

solve 2 !d l ans
  | d>0 && d+1<=l = [d+1,1] ++ ans
  | d==0 = 1:1:ans
  | d<0 && 1-d<=l = [1,1-d] ++ ans
  | otherwise = [-1]
solve 3 !d l ans
  | d>0 && d<=2*l-1 = let q = div (d+1) 2 in ans ++ [q,1,q]
  | d==0 && l>=2 = ans ++ [1,2,1]
  | d<0 && 2-d<=l = ans ++ [1,2-d,1]
  | otherwise = [-1]
solve !n d l ans
  | d>0 = solve (n-2) (d-l+1) l $ [l,1] ++ ans
  | d==0 = solve (n-2) 0 l $ 1:1:ans
  | d<0 = solve (n-2) (d+l-1) l $ [1,l] ++ ans
  | otherwise = [-1]

main = do
    str <- getLine
    putStr $ unwords $ map show $ f $ map (\x -> read x :: Int) $ words str

f :: [Int]->[Int]
f [n,d,l]
    | (od * l - ev) < d = [-1]
    | (od - ev * l) > d = [-1]
    | otherwise = f1 n l 1 (d-od+ev)
    where
        od = ((div n 2) + (mod n 2))
        ev = (div n 2)

f1 :: Int->Int->Int->Int->[Int]
f1 n l pos rest
    | pos==n+1 = []
    | rest==0 = 1:(f1 n l (pos+1) 0)
    | oddness==1 = maxv:(f1 n l (pos+1) (rest-maxv+1))
    | oddness==0 = minv:(f1 n l (pos+1) (rest+minv-1))
    where
    oddness = mod pos 2
    maxv = 1 + min (l-1) (max rest 0)
    minv = 1 + min (l-1) (max (-rest) 0)

import Monad (liftM)
import Prelude hiding (print)

solve :: [Integer] -> [Integer]
solve [n, d, l]  =  case as of
  Just as  ->  reverse as
  Nothing  ->  [-1]
  where
    as  =  rec l d n
    rec l d 1
      | 1 <= d && d <= l  =  Just [d]
      | otherwise  =  Nothing
    rec l d n
      | even n && d <  0  =  fmap (l:) $ rec l (d+l) (n-1)
      | even n && d >= 0  =  fmap (1:) $ rec l (d+1) (n-1)
      | 2 * d < l + 1     =  fmap (1:) $ rec l (d-1) (n-1)
      | otherwise         =  fmap (l:) $ rec l (d-l) (n-1)

print :: Show a => [a] -> IO ()
print [a]  =  putStrLn (show a)
print (x:xs)  =  putStr (show x ++ " ") >> print xs

main :: IO ()
main  =  liftM (map read . words) getLine >>= print . solve


DZY loves chessboard, and he enjoys playing with it.He has a chessboard of n rows and m columns. Some cells of the chessboard are bad, others are good. For every good cell, DZY wants to put a chessman on it. Each chessman is either white or black. After putting all chessmen, DZY wants that no two chessmen with the same color are on two adjacent cells. Two cells are adjacent if and only if they share a common edge.You task is to find any suitable placement of chessmen on the given chessboard.

The first line contains two space-separated integers n and m (1 ≤ n, m ≤ 100). Each of the next n lines contains a string of m characters: the j-th character of the i-th string is either "." or "-". A "." means that the corresponding cell (in the i-th row and the j-th column) is good, while a "-" means it is bad.

Output must contain n lines, each line must contain a string of m characters. The j-th character of the i-th string should be either "W", "B" or "-". Character "W" means the chessman on the cell is white, "B" means it is black, "-" means the cell is a bad cell. If multiple answers exist, print any of them. It is guaranteed that at least one answer exists.

NoteIn the first sample, DZY puts a single black chessman. Of course putting a white one is also OK.In the second sample, all 4 cells are good. No two same chessmen share an edge in the sample output.In the third sample, no good cells are adjacent. So you can just put 3 chessmen, no matter what their colors are.

import Data.List

main = do
	getLine
	interact $ unlines . putChess . lines

putChess :: [String] -> [String]
putChess ss = zipWith tchess ss $ cycle "BW"

tchess :: String -> Char -> String
tchess [] _ = ""
tchess ('-':xs) 'W' = '-' : (tchess xs 'B')
tchess ('-':xs) 'B' = '-' : (tchess xs 'W')
tchess (_:xs) 'W' = 'W' : (tchess xs 'B')
tchess (_:xs) 'B' = 'B' : (tchess xs 'W')

import Data.Functor ((<$>))
import Data.List (tails)

main :: IO ()
main = getLine >> solve <$> (lines <$> getContents) >>= mapM_ putStrLn

solve :: [String] -> [String]
solve = zipWith (zipWith $ \x y -> if y == '-' then y else x) $ tails (cycle "BW")

import Data.Functor ((<$>))

main :: IO ()
main = getLine >> solve <$> (lines <$> getContents) >>= mapM_ putStrLn

solve :: [String] -> [String]
solve xss = [ [ if x == '-' then '-' else "BW" !! ((i + j) `mod` 2) | (j, x) <- zip [0..] xs ] | (i, xs) <- zip [0..] xss ]

import Data.List
main = do
  getLine
  mapM_ putStrLn . zipWith row (tails (cycle "BW")) . lines =<< getContents
row = zipWith cell
cell _ '-' = '-'
cell c  _  =  c

import Data.List

main = do
  getLine
  interact $ unlines.f.lines

f :: [String] -> [String]
f css = zipWith (zipWith g) css . tails $ cycle "BW"

g '-' c = '-'
g _ c = c

import Data.List

main = do
	getLine
	interact $ unlines.f.lines

f :: [String] -> [String]
f x = zipWith (zipWith g ) x   (tails $ cycle "BW")

g '-' x = '-'
g _ x = x

-- @betaveros :: vim:set fdm=marker:
{-# LANGUAGE LambdaCase, NPlusKPatterns, TupleSections #-}
{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-missing-signatures #-}
-- import ALL the things! {{{
-- hiding clauses are to allow Data.Foldable's generalizations
import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl, foldl1, foldr, foldr1, and, or, any, all, sum, product, concat, concatMap, maximum, minimum, elem, notElem)
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad hiding (mapM, mapM_, forM, forM_, sequence, sequence_, msum)
import Control.Monad.ST

import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Char8 (ByteString)
import Data.Bits
import Data.Char
import Data.Either
import Data.Foldable
import Data.Function
import Data.IORef
import Data.List hiding (foldl, foldl', foldl1, foldl1', foldr, foldr1, concat, concatMap, and, or, any, all, sum, product, maximum, minimum, elem, notElem, find)
import Data.Maybe
import Data.Monoid
import Data.Ord
import Data.STRef
import Data.String
import Data.Traversable
import Data.Tuple

import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Sequence as Seq
import Data.Sequence (Seq, (<|), (|>), (><))

import Debug.Trace
import Text.Printf
import System.IO
-- }}}
-- silly utilities {{{
-- stolen from lens:
a & f = f a
a <&> f = fmap f a
infixl 1 &, <&>

fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
glength :: (Num b) => [a] -> b
glength = genericLength

readInt     = read :: String -> Int
readInteger = read :: String -> Integer
-- (!?) :: (Ord k) => Map k v -> k -> Maybe v
-- (!?) = flip Map.lookup
histogram :: (Ord a, Num b) => [a] -> Map a b
histogram = Map.fromListWith (+) . map (,1)
-- }}}
-- input and output {{{
bsGetLine :: IO ByteString
bsGetLine = fst . BS.spanEnd isSpace <$> BS.getLine

inputInt     = (read <$> getLine) :: IO Int
inputInteger = (read <$> getLine) :: IO Integer
inputDouble  = (read <$> getLine) :: IO Double

inputRow :: (Read a) => IO [a]
inputRow = map read . words <$> getLine
inputInts     = inputRow :: IO [Int]
inputIntegers = inputRow :: IO [Integer]
inputDoubles  = inputRow :: IO [Double]

ssUnwords :: [ShowS] -> ShowS
ssUnwords [] = id
ssUnwords (x:xs) = x . (' ':) . ssUnwords xs

ssUnlines :: [ShowS] -> ShowS
ssUnlines [] = id
ssUnlines (x:xs) = x . ('\n':) . ssUnlines xs

showMany :: (Show a) => [a] -> String
showMany xs = ssUnwords (map shows xs) ""
showMatrix :: (Show a) => [[a]] -> String
showMatrix xs = ssUnlines (map (ssUnwords . map shows) xs) ""

printMany :: (Show a) => [a] -> IO ()
printMany xs = putStrLn (showMany xs)
printMatrix :: (Show a) => [[a]] -> IO ()
printMatrix xs = putStr (showMatrix xs)
-- }}}

place :: Bool -> Char -> Char
place True  '.' = 'B'
place False '.' = 'W'
place _     c   = c

placeRow :: Bool -> String -> String
placeRow b = zipWith place (iterate not b)

main :: IO ()
main = do
	[n,_] <- inputInts
	board <- replicateM n getLine
	mapM_ putStrLn $ zipWith placeRow (iterate not True) board


The string $$$t_1t_2 \dots t_k$$$ is good if each letter of this string belongs to at least one palindrome of length greater than 1.A palindrome is a string that reads the same backward as forward. For example, the strings A, BAB, ABBA, BAABBBAAB are palindromes, but the strings AB, ABBBAA, BBBA are not.Here are some examples of good strings:   $$$t$$$ = AABBB (letters $$$t_1$$$, $$$t_2$$$ belong to palindrome $$$t_1 \dots t_2$$$ and letters $$$t_3$$$, $$$t_4$$$, $$$t_5$$$ belong to palindrome $$$t_3 \dots t_5$$$);  $$$t$$$ = ABAA (letters $$$t_1$$$, $$$t_2$$$, $$$t_3$$$ belong to palindrome $$$t_1 \dots t_3$$$ and letter $$$t_4$$$ belongs to palindrome $$$t_3 \dots t_4$$$);  $$$t$$$ = AAAAA (all letters belong to palindrome $$$t_1 \dots t_5$$$); You are given a string $$$s$$$ of length $$$n$$$, consisting of only letters A and B.You have to calculate the number of good substrings of string $$$s$$$.

The first line contains one integer $$$n$$$ ($$$1 \le n \le 3 \cdot 10^5$$$) — the length of the string $$$s$$$. The second line contains the string $$$s$$$, consisting of letters A and B.

Print one integer — the number of good substrings of string $$$s$$$.

NoteIn the first test case there are six good substrings: $$$s_1 \dots s_2$$$, $$$s_1 \dots s_4$$$, $$$s_1 \dots s_5$$$, $$$s_3 \dots s_4$$$, $$$s_3 \dots s_5$$$ and $$$s_4 \dots s_5$$$.In the second test case there are three good substrings: $$$s_1 \dots s_2$$$, $$$s_1 \dots s_3$$$ and $$$s_2 \dots s_3$$$.

import Data.List
import Data.Int

readInts :: IO [Integer]
readInts = fmap (map read . words) getLine

puts = putStrLn . show

solve :: [Integer] -> Integer
solve xs = sum $ map ((-) 1) $ zipWith (+) xs (tail xs)

count :: [Integer] -> Integer
count xs = div ((n - 1) * n) 2 + solve xs
    where n = sum xs

parse :: [Char] -> [Integer]
parse =  (map (toInteger. length)) . group

main = do
    n <- fmap head readInts
    str <- getLine
    puts $ (count . parse) str


While performing complex market analysis William encountered the following problem:For a given array $$$a$$$ of size $$$n$$$ and a natural number $$$e$$$, calculate the number of pairs of natural numbers $$$(i, k)$$$ which satisfy the following conditions:   $$$1 \le i, k$$$  $$$i + e \cdot k \le n$$$.  Product $$$a_i \cdot a_{i + e} \cdot a_{i + 2 \cdot e} \cdot \ldots \cdot a_{i + k \cdot e} $$$ is a prime number. A prime number (or a prime) is a natural number greater than 1 that is not a product of two smaller natural numbers.

Each test contains multiple test cases. The first line contains the number of test cases $$$t$$$ ($$$1 \le t \le 10\,000$$$). Description of the test cases follows. The first line of each test case contains two integers $$$n$$$ and $$$e$$$ $$$(1 \le e \le n \le 2 \cdot 10^5)$$$, the number of items in the array and number $$$e$$$, respectively. The second line contains $$$n$$$ integers $$$a_1, a_2, \dots, a_n$$$ $$$(1 \le a_i \le 10^6)$$$, the contents of the array. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$2 \cdot 10^5$$$.

For each test case output the answer in the following format: Output one line containing the number of pairs of numbers $$$(i, k)$$$ which satisfy the conditions.

NoteIn the first example test case two pairs satisfy the conditions:   $$$i = 2, k = 1$$$, for which the product is: $$$a_{2} \cdot a_{5} = 2$$$ which is a prime number.  $$$i = 3, k = 1$$$, for which the product is: $$$a_{3} \cdot a_{6} = 19$$$ which is a prime number. In the second example test case there are no pairs that satisfy the conditions.In the third example test case four pairs satisfy the conditions:   $$$i = 1, k = 1$$$, for which the product is: $$$a_{1} \cdot a_{4} = 2$$$ which is a prime number.  $$$i = 1, k = 2$$$, for which the product is: $$$a_{1} \cdot a_{4} \cdot a_{7} = 2$$$ which is a prime number.  $$$i = 3, k = 1$$$, for which the product is: $$$a_{3} \cdot a_{6} = 2$$$ which is a prime number.  $$$i = 6, k = 1$$$, for which the product is: $$$a_{6} \cdot a_{9} = 2$$$ which is a prime number. In the fourth example test case there are no pairs that satisfy the conditions.In the fifth example test case five pairs satisfy the conditions:   $$$i = 1, k = 1$$$, for which the product is: $$$a_{1} \cdot a_{2} = 2$$$ which is a prime number.  $$$i = 1, k = 2$$$, for which the product is: $$$a_{1} \cdot a_{2} \cdot a_{3} = 2$$$ which is a prime number.  $$$i = 1, k = 3$$$, for which the product is: $$$a_{1} \cdot a_{2} \cdot a_{3} \cdot a_{4} = 2$$$ which is a prime number.  $$$i = 2, k = 1$$$, for which the product is: $$$a_{2} \cdot a_{3} = 2$$$ which is a prime number.  $$$i = 2, k = 2$$$, for which the product is: $$$a_{2} \cdot a_{3} \cdot a_{4} = 2$$$ which is a prime number. In the sixth example test case there are no pairs that satisfy the conditions.

import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State
import Data.Maybe

--import Data.ByteString.Builder.Extra (flush) -- for interactive problems
import Control.Monad
import Data.List
import Data.Array.Unboxed

import Data.Array.ST.Safe
import Data.Int

maxai :: Int
maxai = 10 ^ (6 :: Int)

nFactors :: UArray Int Int
nFactors = accumArray (+) 0 (1, maxai) $ do
  i <- [1 .. maxai]
  j <- [i, 2*i .. maxai]
  pure (j, 1)

consecOnes :: UArray Int Int -> Int -> UArray Int Int
consecOnes inArr step = runSTUArray $ do
  let
    (p, q) = bounds inArr
    ok = inRange (p, q)
  outArr <- newArray (p, q) 0
  let
    update ix = do
      let  next = ix + step
      when (ok next && inArr ! next == 1) $ do
        nv <- readArray outArr next
        cv <- readArray outArr ix
        writeArray outArr ix $ max cv (nv + 1)
  forM_ [p .. q] update
  forM_ [q, q - 1 .. p] update
  pure outArr

mainFun :: SP Builder
mainFun = do
  ~[t] <- getInts 1
  fmap mconcat $ replicateM t $ do
    ~[n, e] <- getInts 2
    aLi <- getInts n
    let
      a :: UArray Int Int
      a = listArray (1, n) aLi
      consecL = consecOnes a e
      consecR = consecOnes a $ negate e
      ans = foldl' (+) 0 $ do
        (ix, aix) <- assocs a
        guard $ nFactors ! aix == 2
        pure $ fromIntegral (consecL ! ix + 1)
          * fromIntegral (consecR ! ix + 1) - 1
    pure $ putInt64s [ans]

type SP = State [P.ByteString]

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = map (fst . fromJust . P.readInt) <$> getNext k

putInt64s :: [Int64] -> Builder
putInt64s vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.int64Dec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> int64Dec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp


There are $$$n$$$ trees in a park, numbered from $$$1$$$ to $$$n$$$. The initial height of the $$$i$$$-th tree is $$$h_i$$$.You want to water these trees, so they all grow to the same height.The watering process goes as follows. You start watering trees at day $$$1$$$. During the $$$j$$$-th day you can:   Choose a tree and water it. If the day is odd (e.g. $$$1, 3, 5, 7, \dots$$$), then the height of the tree increases by $$$1$$$. If the day is even (e.g. $$$2, 4, 6, 8, \dots$$$), then the height of the tree increases by $$$2$$$.  Or skip a day without watering any tree. Note that you can't water more than one tree in a day. Your task is to determine the minimum number of days required to water the trees so they grow to the same height.You have to answer $$$t$$$ independent test cases.

The first line of the input contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^4$$$) — the number of test cases. The first line of the test case contains one integer $$$n$$$ ($$$1 \le n \le 3 \cdot 10^5$$$) — the number of trees. The second line of the test case contains $$$n$$$ integers $$$h_1, h_2, \ldots, h_n$$$ ($$$1 \le h_i \le 10^9$$$), where $$$h_i$$$ is the height of the $$$i$$$-th tree. It is guaranteed that the sum of $$$n$$$ over all test cases does not exceed $$$3 \cdot 10^5$$$ ($$$\sum n \le 3 \cdot 10^5$$$).

For each test case, print one integer — the minimum number of days required to water the trees, so they grow to the same height.

NoteConsider the first test case of the example. The initial state of the trees is $$$[1, 2, 4]$$$.  During the first day, let's water the first tree, so the sequence of heights becomes $$$[2, 2, 4]$$$;  during the second day, let's water the second tree, so the sequence of heights becomes $$$[2, 4, 4]$$$;  let's skip the third day;  during the fourth day, let's water the first tree, so the sequence of heights becomes $$$[4, 4, 4]$$$. Thus, the answer is $$$4$$$.

import Control.Monad (forM_)

import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text

solve :: [Int] -> Int
solve h = min (work mx) (work $ mx + 1)
   where mx       = maximum h

         work y   = max simple (2 * oddCount - 1)
            where diff     = map ((-) y) h
                  oddCount = length $ filter odd diff
                  ss       = sum diff
                  simple   = (ss `div` 3) * 2 + (ss `mod` 3)

toInt :: Text -> Int
toInt text =
   case Text.decimal text of
      Right (n, _) -> n

readInts :: Text -> [Int]
readInts = map toInt . Text.words

main = do
   t <- toInt <$> Text.getLine
   forM_ [1..t] $ \_ -> do
      n <- toInt <$> Text.getLine
      h <- readInts <$> Text.getLine
      print $ solve h


Yaroslav thinks that two strings s and w, consisting of digits and having length n are non-comparable if there are two numbers, i and j (1 ≤ i, j ≤ n), such that si > wi and sj < wj. Here sign si represents the i-th digit of string s, similarly, wj represents the j-th digit of string w.A string's template is a string that consists of digits and question marks ("?").Yaroslav has two string templates, each of them has length n. Yaroslav wants to count the number of ways to replace all question marks by some integers in both templates, so as to make the resulting strings incomparable. Note that the obtained strings can contain leading zeroes and that distinct question marks can be replaced by distinct or the same integers.Help Yaroslav, calculate the remainder after dividing the described number of ways by 1000000007 (109 + 7).

The first line contains integer n (1 ≤ n ≤ 105) — the length of both templates. The second line contains the first template — a string that consists of digits and characters "?". The string's length equals n. The third line contains the second template in the same format.

In a single line print the remainder after dividing the answer to the problem by number 1000000007 (109 + 7).

NoteThe first test contains no question marks and both strings are incomparable, so the answer is 1.The second test has no question marks, but the given strings are comparable, so the answer is 0.

import Control.Applicative

import qualified Data.ByteString.Char8 as B
import Data.Int
import qualified Data.Array as A

main = do
    getLine
    l1 <- getLine
    l2 <- getLine
    print $ solve l1 l2

modulo = 1000000007

modBase n = mod n modulo

solve :: String -> String -> Int64
solve l1 l2 = a
    where
        (a,_,_,_) = e l1 l2

e :: String -> String -> (Int64,Int64,Int64,Int64)
e [] [] = (0,0,0,1)
e (x:xs) (y:ys) = (modBase a,modBase b,modBase c,modBase d)
    where
        as = assign x y
        (a',b',c',d') = e xs ys
        a = a' * ptns A.! (x',y',0) + b' * ptns A.! (x',y',1)+ c' * ptns A.! (x',y',2)
        b = b' * ptns A.! (x',y',3) + d' * ptns A.! (x',y',2)
        c = c' * ptns A.! (x',y',4) + d' * ptns A.! (x',y',1)
        d = d' * ptns A.! (x',y',5)
        f op = fromIntegral $ length $ filter (uncurry op) as
        t x y = True
        x' = conv x
        y' = conv y
digit = ['0'..'9']
assign :: Char -> Char -> [(Char,Char)]
assign '?' '?' = [ (a,b) | a <- digit,b <- digit]
assign '?' c   = [ (a,c) | a <- digit]
assign  c  '?' = [ (c,b) | b <- digit]
assign  c  d   = [ (c,d) ]

conv '?' = ':'
conv c   = c

convI ':' = '?'
convI c    = c

ptns :: A.Array (Char,Char,Int) Int64
ptns = A.listArray (('0','0',0),(':',':',5)) [ f c1 c2 i | c1 <- ['0'..':'], c2 <- ['0'..':'], i <- [0..5]]
    where
        f c1 c2 i = case i of
            0 -> fromIntegral $ length $ filter (const True) as
            1 -> fromIntegral $ length $ filter (uncurry (>)) as
            2 -> fromIntegral $ length $ filter (uncurry (<)) as
            3 -> fromIntegral $ length $ filter (uncurry (<=)) as
            4 -> fromIntegral $ length $ filter (uncurry (>=)) as
            5 -> fromIntegral $ length $ filter (uncurry (==)) as
            where
                as = assign (convI c1) (convI c2)

import Control.Applicative

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

main = do
    B.getLine
    l1 <- B.unpack <$> B.getLine
    l2 <- B.unpack <$> B.getLine
    print $ solve l1 l2

modulo = 1000000007

modBase n = mod n modulo

solve :: String -> String -> Int64
solve l1 l2 = a
    where
        (a,_,_,_) = e l1 l2

len = fromIntegral . length

e :: String -> String -> (Int64,Int64,Int64,Int64)
e [] [] = (0,0,0,1)
e (x:xs) (y:ys) = (a,b,c,d)
    where
        as = assign x y
        (a',b',c',d') = e xs ys
        a = modBase $
            modBase (a' * len (filter (const True) as)) +
            modBase (b' * len (filter (\ (x,y) -> x > y) as)) +
            modBase (c' * len (filter (\ (x,y) -> x < y) as))
        b = modBase $
            modBase (b' * len (filter (\ (x,y) -> x <= y) as)) +
            modBase (d' * len (filter (\ (x,y) -> x <  y) as))
        c = modBase $
            modBase (c' * len (filter (\ (x,y) -> x >= y) as)) +
            modBase (d' * len (filter (\ (x,y) -> x >  y) as))
        d = modBase (d' * len (filter (\ (x,y) -> x == y) as))

assign :: Char -> Char -> [(Char,Char)]
assign '?' '?' = [ (a,b) | a <- ['0'..'9'],b <- ['0'..'9']]
assign '?' c   = [ (a,c) | a <- ['0'..'9']]
assign  c  '?' = [ (c,b) | b <- ['0'..'9']]
assign  c  d   = [ (c,d)]

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

import Control.Applicative
import qualified Data.ByteString.Char8 as B

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

toPairs (x:y:xys) = (x,y) : toPairs xys
toPairs _ = []

main :: IO ()
main = do
  [_,xs,ys] <- B.words <$> B.getContents
  let cnt = B.count '?' xs + B.count '?' ys
  print . (`mod`1000000007) $ 10^cnt - (solveLTEQ xs ys + solveGTEQ xs ys - solveEQ xs ys)

solveLTEQ :: B.ByteString -> B.ByteString -> Integer
solveLTEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 55) xs ys else go (res *% (read[y]+1)) xs ys
       | y=='?' = go (res *% (10-read[x])) xs ys
       | x <= y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

solveEQ :: B.ByteString -> B.ByteString -> Integer
solveEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 10) xs ys else go res xs ys
       | y=='?' || x==y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

solveGTEQ :: B.ByteString -> B.ByteString -> Integer
solveGTEQ xs ys = go 1 xs ys
   where
     go !res xs0 ys0 | B.null xs0 && B.null ys0 = res
     go !res xs0 ys0
       | x=='?' = if y=='?' then go (res *% 55) xs ys else go (res *% (10-read[y])) xs ys
       | y=='?' = go (res *% (read[x]+1)) xs ys
       | x >= y = go res xs ys
       | otherwise = 0
      where
        Just (x,xs) = B.uncons xs0
        Just (y,ys) = B.uncons ys0

infixl 7  *%
(*%) :: Integer -> Integer -> Integer
x *% y = x * y `rem` 1000000007
{-# INLINE (*%) #-}

import Control.Applicative
import Control.Arrow
import Data.List

main = do
    n <- read <$> getLine
    let m = if even n then n `div` 2 else n `div` 2 + 1
    b <- (words >>> sort >>> group >>> map ((<=m).length) >>> and ) <$> getLine
    let s = (if b then "YES" else "NO")
    putStrLn s


Once upon a time a little frog whose name was Vasya decided to travel around his home swamp. Overall there are n mounds on the swamp, located on one line. The distance between the neighboring mounds is one meter. Vasya wants to visit all the mounds in one day; besides, he wants to visit each one exactly once. For that he makes a route plan, to decide the order in which to jump on the mounds. Vasya can pick any mound as the first one. He thinks it boring to jump two times at the same distance. That's why he wants any two jumps on his route to have different lengths. Help Vasya the Frog and make the plan for him.

The single line contains a number n (1 ≤ n ≤ 104) which is the number of mounds.

Print n integers pi (1 ≤ pi ≤ n) which are the frog's route plan.    All the pi's should be mutually different.  All the |pi–pi + 1|'s should be mutually different (1 ≤ i ≤ n - 1).  If there are several solutions, output any.

main = do getLine >>= putStrLn . unwords . map show . gao . read where
	gao n = [if odd i then 1 + div i 2 else n - div i 2 | i <- [0 .. n - 1]]

main = readLn >>= putStrLn.unwords.map show.solve

solve :: Int -> [Int]
solve n = sortFrog 0 [1..n]

sortFrog _ [] = []
sortFrog 0 xs = head xs : sortFrog 1 (tail xs)
sortFrog 1 xs = last xs : sortFrog 0 (init xs)

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

import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

solve n =
  aux [1..n]
  where aux [] = []
        aux (a:[]) = [a]
        aux (a:as) = a : last as : aux (init as)

main = do
  n <- read `fmap` getLine :: IO Int
  putStrLn $ intercalate " " $ map show $ solve n

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

import Data.List
import qualified Data.Map as M
-- import Data.Map ((!))
import qualified Data.IntMap as IM
-- import Data.IntMap ((!))

import Data.Array
import Data.Function

import Debug.Trace

debug = flip trace
-- debug = const

solve n =
  aux [1..n]
  where aux [] = []
        aux (a:[]) = [a]
        aux (a:as) = a : last as : init as

main = do
  n <- read `fmap` getLine :: IO Int
  putStrLn $ intercalate " " $ map show $ solve n

import List
main = do getLine >>= putStrLn . unwords . map show . gao . read where
	gao n = let (o, e) = partition odd [1 .. n] in o ++ reverse e