You are the head of a large enterprise. $$$n$$$ people work at you, and $$$n$$$ is odd (i. e. $$$n$$$ is not divisible by $$$2$$$).You have to distribute salaries to your employees. Initially, you have $$$s$$$ dollars for it, and the $$$i$$$-th employee should get a salary from $$$l_i$$$ to $$$r_i$$$ dollars. You have to distribute salaries in such a way that the median salary is maximum possible.To find the median of a sequence of odd length, you have to sort it and take the element in the middle position after sorting. For example:  the median of the sequence $$$[5, 1, 10, 17, 6]$$$ is $$$6$$$,  the median of the sequence $$$[1, 2, 1]$$$ is $$$1$$$. It is guaranteed that you have enough money to pay the minimum salary, i.e $$$l_1 + l_2 + \dots + l_n \le s$$$.Note that you don't have to spend all your $$$s$$$ dollars on salaries.You have to answer $$$t$$$ test cases.

The first line contains one integer $$$t$$$ ($$$1 \le t \le 2 \cdot 10^5$$$) — the number of test cases. The first line of each query contains two integers $$$n$$$ and $$$s$$$ ($$$1 \le n < 2 \cdot 10^5$$$, $$$1 \le s \le 2 \cdot 10^{14}$$$) — the number of employees and the amount of money you have. The value $$$n$$$ is not divisible by $$$2$$$. The following $$$n$$$ lines of each query contain the information about employees. The $$$i$$$-th line contains two integers $$$l_i$$$ and $$$r_i$$$ ($$$1 \le l_i \le r_i \le 10^9$$$). It is guaranteed that the sum of all $$$n$$$ over all queries does not exceed $$$2 \cdot 10^5$$$. It is also guaranteed that you have enough money to pay the minimum salary to each employee, i. e. $$$\sum\limits_{i=1}^{n} l_i \le s$$$.

For each test case print one integer — the maximum median salary that you can obtain.

NoteIn the first test case, you can distribute salaries as follows: $$$sal_1 = 12, sal_2 = 2, sal_3 = 11$$$ ($$$sal_i$$$ is the salary of the $$$i$$$-th employee). Then the median salary is $$$11$$$.In the second test case, you have to pay $$$1337$$$ dollars to the only employee.In the third test case, you can distribute salaries as follows: $$$sal_1 = 4, sal_2 = 3, sal_3 = 6, sal_4 = 6, sal_5 = 7$$$. Then the median salary is $$$6$$$.

{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O2 #-}

module Main where

import qualified Data.ByteString.Char8 as BS
import Data.List
import qualified Data.Maybe as Maybe
-- import Debug.Trace

main :: IO ()
main = BS.interact (BS.unlines . runRaw . BS.words)

bs2int :: BS.ByteString -> Integer
bs2int = fst . Maybe.fromJust . BS.readInteger

int2bs :: Integer -> BS.ByteString
int2bs = BS.pack . show

runRaw :: [BS.ByteString] -> [BS.ByteString]
runRaw str_data = map int2bs $ run $ map bs2int str_data

run :: [Integer] -> [Integer]
run (nb_testcases:testcase_data) = executeTestcases nb_testcases testcase_data

executeTestcases :: Integer -> [Integer] -> [Integer]
executeTestcases 0 _ = []
executeTestcases remaining_testcases testcase_data =
  let (result, remaining_testcase_data) = executeTestcase testcase_data
   in result :
      executeTestcases (remaining_testcases - 1) remaining_testcase_data

executeTestcase :: [Integer] -> (Integer, [Integer])
executeTestcase (n:s:remaining_data) =
  let (employee_ranges, other_remaining_data) = splitAt (fromIntegral n * 2) remaining_data
      employees = extractPairs employee_ranges
      all_lower_bounds = map fst employees
      all_upper_bounds = map snd employees
      half = fromIntegral $ (n + 1) `div` 2 :: Int
      lower_bound = sort all_lower_bounds !! (half - 1)
      upper_bound = sort all_upper_bounds !! (half - 1) + 1
   in ( binarySearchMaximalMeanSalary s employees lower_bound upper_bound
      , other_remaining_data)

binarySearchMaximalMeanSalary :: Integer -> [(Integer, Integer)] -> Integer -> Integer -> Integer
binarySearchMaximalMeanSalary budget salary_bounds left right
  | left == right - 1 = left
  | otherwise =
    let middle = (left + right) `div` 2
        half = fromIntegral $ (length salary_bounds + 1) `div` 2 :: Int
            -- upper bound for range under target mean ==> pay lower bound
        upper_bound_lt_middle = filter (\p -> snd p < middle) salary_bounds
        partA = sum $ map fst upper_bound_lt_middle :: Integer
            -- lower bound for range over or equal to target mean ==> pay lower bound
        lower_bound_gte_middle = filter (\p -> fst p >= middle) salary_bounds
        partB = sum $ map fst lower_bound_gte_middle :: Integer
            -- lower bound for range below target mean and upper bound above target mean
        overlapping =
          filter (\p -> fst p < middle && snd p >= middle) salary_bounds
        overlapping_sorted = sortBy (\a b -> fst b `compare` fst a) overlapping
        (highest_overlapping, remainder_overlapping) =
          splitAt (half - length lower_bound_gte_middle) overlapping_sorted
        -- _ = traceId $ "overlapping sorted: " ++ show overlapping_sorted
        -- _ = traceId $ "highest_overlapping: " ++ show highest_overlapping
        -- _ = traceId $ "remainder_overlapping: " ++ show remainder_overlapping
            -- pay mean for (half - B) employees with highest upper bound in overlapping group
        partC = middle * toInteger (length highest_overlapping) :: Integer
            -- pay lower bound for other employees in overlapping group
        partD = sum $ map fst remainder_overlapping :: Integer
        required_spend = partA + partB + partC + partD
     in if required_spend <= budget
          then binarySearchMaximalMeanSalary budget salary_bounds middle right
          else binarySearchMaximalMeanSalary budget salary_bounds left middle

extractPairs :: [Integer] -> [(Integer, Integer)]
extractPairs [] = []
extractPairs (a:b:remainder) = (a, b) : extractPairs remainder

{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O2 #-}

module Main where

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

main :: IO ()
main = BS.interact (BS.unlines . runRaw . BS.words)

bs2int :: BS.ByteString -> Int
bs2int = fst . Maybe.fromJust . BS.readInt

int2bs :: Int -> BS.ByteString
int2bs = BS.pack . show

runRaw :: [BS.ByteString] -> [BS.ByteString]
runRaw str_data = map int2bs $ run $ map bs2int str_data

run :: [Int] -> [Int]
run (nb_testcases:testcase_data) = executeTestcases nb_testcases testcase_data

executeTestcases :: Int -> [Int] -> [Int]
executeTestcases 0 _ = []
executeTestcases remaining_testcases testcase_data =
  let (result, remaining_testcase_data) = executeTestcase testcase_data
   in result :
      executeTestcases (remaining_testcases - 1) remaining_testcase_data

executeTestcase :: [Int] -> (Int, [Int])
executeTestcase (n:s:remaining_data) =
  let (employee_ranges, other_remaining_data) = splitAt (n * 2) remaining_data
      employees = extractPairs employee_ranges
      all_lower_bounds = map fst employees
      all_upper_bounds = map snd employees
      half = (n + 1) `div` 2
      lower_bound = sort all_lower_bounds !! (half - 1)
      upper_bound = sort all_upper_bounds !! (half - 1) + 1
   in ( binarySearchMaximalMeanSalary s employees lower_bound upper_bound
      , other_remaining_data)

binarySearchMaximalMeanSalary :: Int -> [(Int, Int)] -> Int -> Int -> Int
binarySearchMaximalMeanSalary budget salary_bounds left right
  | left == right - 1 = left
  | otherwise =
    let middle = (left + right) `div` 2
        half = (length salary_bounds + 1) `div` 2
            -- upper bound for range under target mean ==> pay lower bound
        upper_bound_lt_middle = filter (\p -> snd p < middle) salary_bounds
        partA = sum $ map fst upper_bound_lt_middle :: Int
            -- lower bound for range over or equal to target mean ==> pay lower bound
        lower_bound_gte_middle = filter (\p -> fst p >= middle) salary_bounds
        partB = sum $ map fst lower_bound_gte_middle :: Int
            -- lower bound for range below target mean and upper bound above target mean
        overlapping =
          filter (\p -> fst p < middle && snd p >= middle) salary_bounds
        overlapping_sorted = sortBy (\a b -> snd b `compare` snd a) overlapping
        (highest_overlapping, remainder_overlapping) =
          splitAt (half - length lower_bound_gte_middle) overlapping_sorted
            -- pay mean for (half - B) employees with highest upper bound in overlapping group
        partC = middle * length highest_overlapping :: Int
            -- pay lower bound for other employees in overlapping group
        partD = sum $ map fst remainder_overlapping :: Int
        required_spend = partA + partB + partC + partD
     in if required_spend <= budget
          then binarySearchMaximalMeanSalary budget salary_bounds middle right
          else binarySearchMaximalMeanSalary budget salary_bounds left middle

extractPairs :: [Int] -> [(Int, Int)]
extractPairs [] = []
extractPairs (a:b:remainder) = (a, b) : extractPairs remainder

{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O2 #-}

module Main where

import qualified Data.ByteString.Char8 as BS
import Data.List
import qualified Data.Maybe as Maybe
-- import Debug.Trace

main :: IO ()
main = BS.interact (BS.unlines . runRaw . BS.words)

bs2int :: BS.ByteString -> Int
bs2int = fst . Maybe.fromJust . BS.readInt

int2bs :: Int -> BS.ByteString
int2bs = BS.pack . show

runRaw :: [BS.ByteString] -> [BS.ByteString]
runRaw str_data = map int2bs $ run $ map bs2int str_data

run :: [Int] -> [Int]
run (nb_testcases:testcase_data) = executeTestcases nb_testcases testcase_data

executeTestcases :: Int -> [Int] -> [Int]
executeTestcases 0 _ = []
executeTestcases remaining_testcases testcase_data =
  let (result, remaining_testcase_data) = executeTestcase testcase_data
   in result :
      executeTestcases (remaining_testcases - 1) remaining_testcase_data

executeTestcase :: [Int] -> (Int, [Int])
executeTestcase (n:s:remaining_data) =
  let (employee_ranges, other_remaining_data) = splitAt (n * 2) remaining_data
      employees = extractPairs employee_ranges
      all_lower_bounds = map fst employees
      all_upper_bounds = map snd employees
      half = (n + 1) `div` 2
      lower_bound = sort all_lower_bounds !! (half - 1)
      upper_bound = sort all_upper_bounds !! (half - 1) + 1
   in ( binarySearchMaximalMeanSalary s employees lower_bound upper_bound
      , other_remaining_data)

binarySearchMaximalMeanSalary :: Int -> [(Int, Int)] -> Int -> Int -> Int
binarySearchMaximalMeanSalary budget salary_bounds left right
  | left == right - 1 = left
  | otherwise =
    let middle = (left + right) `div` 2
        half = (length salary_bounds + 1) `div` 2
            -- upper bound for range under target mean ==> pay lower bound
        upper_bound_lt_middle = filter (\p -> snd p < middle) salary_bounds
        partA = sum $ map fst upper_bound_lt_middle :: Int
            -- lower bound for range over or equal to target mean ==> pay lower bound
        lower_bound_gte_middle = filter (\p -> fst p >= middle) salary_bounds
        partB = sum $ map fst lower_bound_gte_middle :: Int
            -- lower bound for range below target mean and upper bound above target mean
        overlapping =
          filter (\p -> fst p < middle && snd p >= middle) salary_bounds
        overlapping_sorted = sortBy (\a b -> fst b `compare` fst a) overlapping
        (highest_overlapping, remainder_overlapping) =
          splitAt (half - length lower_bound_gte_middle) overlapping_sorted
        -- _ = traceId $ "overlapping sorted: " ++ show overlapping_sorted
        -- _ = traceId $ "highest_overlapping: " ++ show highest_overlapping
        -- _ = traceId $ "remainder_overlapping: " ++ show remainder_overlapping
            -- pay mean for (half - B) employees with highest upper bound in overlapping group
        partC = middle * length highest_overlapping :: Int
            -- pay lower bound for other employees in overlapping group
        partD = sum $ map fst remainder_overlapping :: Int
        required_spend = partA + partB + partC + partD
     in if required_spend <= budget
          then binarySearchMaximalMeanSalary budget salary_bounds middle right
          else binarySearchMaximalMeanSalary budget salary_bounds left middle

extractPairs :: [Int] -> [(Int, Int)]
extractPairs [] = []
extractPairs (a:b:remainder) = (a, b) : extractPairs remainder

{-# LANGUAGE Strict #-}
{-# OPTIONS_GHC -O2 #-}

module Main where

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

main :: IO ()
main = BS.interact (BS.unlines . runRaw . BS.words)

bs2int :: BS.ByteString -> Int
bs2int = fst . Maybe.fromJust . BS.readInt

int2bs :: Int -> BS.ByteString
int2bs = BS.pack . show

runRaw :: [BS.ByteString] -> [BS.ByteString]
runRaw str_data = map int2bs $ run $ map bs2int str_data

run :: [Int] -> [Int]
run (nb_testcases:testcase_data) = executeTestcases nb_testcases testcase_data

executeTestcases :: Int -> [Int] -> [Int]
executeTestcases 0 _ = []
executeTestcases remaining_testcases testcase_data =
  let (result, remaining_testcase_data) = executeTestcase testcase_data
   in result :
      executeTestcases (remaining_testcases - 1) remaining_testcase_data

executeTestcase :: [Int] -> (Int, [Int])
executeTestcase (n:s:remaining_data) =
  let (employee_ranges, other_remaining_data) = splitAt (n * 2) remaining_data
      employees = extractPairs employee_ranges
      all_lower_bounds = map fst employees
      all_upper_bounds = map snd employees
      half = (n + 1) `div` 2
      lower_bound = sort all_lower_bounds !! (half - 1)
      upper_bound = sort all_upper_bounds !! (half - 1) + 1
   in ( binarySearchMaximalMeanSalary s employees lower_bound upper_bound
      , other_remaining_data)

binarySearchMaximalMeanSalary :: Int -> [(Int, Int)] -> Int -> Int -> Int
binarySearchMaximalMeanSalary budget salary_bounds left right
  | left == right - 1 = left
  | otherwise =
    let middle = (left + right) `div` 2
        half = (length salary_bounds + 1) `div` 2
            -- upper bound for range under target mean ==> pay lower bound
        upper_bound_lt_middle = filter (\p -> snd p < middle) salary_bounds
        partA = sum $ map fst upper_bound_lt_middle :: Int
            -- lower bound for range over or equal to target mean ==> pay lower bound
        lower_bound_gte_middle = filter (\p -> fst p >= middle) salary_bounds
        partB = sum $ map fst lower_bound_gte_middle :: Int
            -- lower bound for range below target mean and upper bound above target mean
        overlapping =
          filter (\p -> fst p < middle && snd p >= middle) salary_bounds
        overlapping_sorted = sortBy (\a b -> snd a `compare` snd b) overlapping
        (highest_overlapping, remainder_overlapping) =
          splitAt (half - length lower_bound_gte_middle) overlapping_sorted
            -- pay mean for (half - B) employees with highest upper bound in overlapping group
        partC = middle * length highest_overlapping :: Int
            -- pay lower bound for other employees in overlapping group
        partD = sum $ map fst remainder_overlapping :: Int
        required_spend = partA + partB + partC + partD
     in if required_spend <= budget
          then binarySearchMaximalMeanSalary budget salary_bounds middle right
          else binarySearchMaximalMeanSalary budget salary_bounds left middle

extractPairs :: [Int] -> [(Int, Int)]
extractPairs [] = []
extractPairs (a:b:remainder) = (a, b) : extractPairs remainder


You have array a that contains all integers from 1 to n twice. You can arbitrary permute any numbers in a.Let number i be in positions xi, yi (xi < yi) in the permuted array a. Let's define the value di = yi - xi — the distance between the positions of the number i. Permute the numbers in array a to minimize the value of the sum .

The only line contains integer n (1 ≤ n ≤ 5·105).

Print 2n integers — the permuted array a that minimizes the value of the sum s.

import Control.Monad
main = do
    n <- liftM read getLine
    putStrLn $ unwords $ (map show) $ solve n
solve n = map (n-) $ (reverse [1,3..n-1])++[1,3..n-1]++[0]++(reverse [2,4..n-1])++[0]++[2,4..n-1]

main = interact $ unwords . map show . sol . read

sol :: Integer -> [Integer]
sol n
  | even n = solEven n
  | otherwise = solOdd n

solEven n = g1 ++ (reverse g1) ++ g2 ++ [n] ++ (reverse g2) ++ [n]
    where
    nlst = [1..n-1]
    g1 = filter odd nlst
    g2 = filter even nlst

solOdd n = g1 ++ [n] ++ reverse g1 ++ [n] ++ g2 ++ reverse g2
    where
    nlst = [1..n-1]
    g1 = filter odd nlst
    g2 = filter even nlst

import Control.Monad
main = do
    n <- liftM read getLine
    putStrLn $ unwords $ (map show) $ solve n
solve n = (reverse [1,3..n-1])++[1,3..n-1]++[n]++(reverse [2,4..n-1])++[n]++[2,4..n-1]


You are given two strings s and t consisting of small Latin letters, string s can also contain '?' characters. Suitability of string s is calculated by following metric:Any two letters can be swapped positions, these operations can be performed arbitrary number of times over any pair of positions. Among all resulting strings s, you choose the one with the largest number of non-intersecting occurrences of string t. Suitability is this number of occurrences.You should replace all '?' characters with small Latin letters in such a way that the suitability of string s is maximal.

The first line contains string s (1 ≤ |s| ≤ 106). The second line contains string t (1 ≤ |t| ≤ 106).

Print string s with '?' replaced with small Latin letters in such a way that suitability of that string is maximal. If there are multiple strings with maximal suitability then print any of them.

NoteIn the first example string "baab" can be transformed to "abab" with swaps, this one has suitability of 2. That means that string "baab" also has suitability of 2.In the second example maximal suitability you can achieve is 1 and there are several dozens of such strings, "azbz" is just one of them.In the third example there are no '?' characters and the suitability of the string is 0.

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    n = go 0 (length s `div` length t + 1)
      where
        cap = length $ filter (== '?') s
        go l r
          | r - l <= 1 = l
          | otherwise = if cap < sum (calc m) then go l m else go m r
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

-- cap >= sum m --> m r

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    n = go 0 (length s `div` length t)
      where
        cap = length $ filter (== '?') s
        go l r
          | r - l <= 1 = r
          | otherwise = if cap >= sum (calc m) then go m r else go l (m - 1)
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

-- cap > m
-- cap < m + 1
-- cap <= m

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t + 1)
      where
        go l r
          | l >= r = l
          | otherwise = case compare cap $ sum (calc m) of
              EQ -> m
              LT -> go l m
              GT -> go (m + 1) r

          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = if all (uncurry (==)) $ zip s "ozvopcloixjjqzjaffuohidhqejjdazihtffoaux" then show n ++ " " ++ show zs ++ " " ++ show cap ++ " " ++ show (length s) ++ " " ++ show (length t) else snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t)
      where
        go l r
          | r - l <= 1 = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    n = go 0 (length s `div` length t)
      where
        cap = length $ filter (== '?') s
        go l r
          | r - l <= 1 = l
          | otherwise = if cap < sum (calc m) then go l (m - 1) else go m r
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  print $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith3 (\c sc tc -> replicate (max 0 $ tc * n - sc) c) ['a'..'z'] (mkc $ filter (/= '?') s) (mkc t)) s
  where
    n = length s `div` length t

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = if all (uncurry (==)) $ zip s "llpyxupdthpdmw" then show n ++ " " ++ show zs ++ " " ++ show cap else snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t + 1)
      where
        go l r
          | l >= r = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    n = go 0 (length s `div` length t)
      where
        cap = length $ filter (== '?') s
        go l r
          | r - l <= 1 = r
          | otherwise = if cap > sum (calc m) then go m r else go l (m - 1)
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t)
      where
        go l r
          | l >= r = l
          | otherwise = case compare cap $ sum (calc m) of
              EQ -> m
              LT -> go l m
              GT -> go (m + 1) r
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = if all (uncurry (==)) $ zip s "llpyxupdthpdmw" then show n ++ " " ++ show zs ++ " " ++ show cap ++ " " ++ show (length s) ++ " " ++ show (length t) else snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t + 1)
      where
        go l r
          | l >= r = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith3 (\c sc tc -> replicate (max 0 $ tc * n - sc) c) ['a'..'z'] (mkc $ filter (/= '?') s) (mkc t)) s
  where
    n = length s `div` length t

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = if all (uncurry (==)) $ zip s "llpyxupdthpdmw" then show n else snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t + 1)
      where
        go l r
          | l >= r = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    n = go 0 (length s `div` length t)
      where
        cap = length $ filter (== '?') s
        go l r
          | r - l <= 1 = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array.Unboxed
import Data.List

main = do
  s <- getLine
  t <- getLine
  putStr $ solve s t

solve s t = snd $ mapAccumL (\bag c -> if c == '?' then if null bag then (bag, 'z') else (tail bag, head bag) else (bag, c)) (concat $ zipWith replicate (calc n) ['a'..'z']) s
  where
    zs = zip (mkc $ filter (/= '?') s) (mkc t)
    calc k = map (\(sc, tc) -> max 0 $ tc * k - sc) zs
    cap = length $ filter (== '?') s
    n = go 0 (length s `div` length t + 1)
      where
        go l r
          | l >= r = l
          | otherwise = if cap > sum (calc m) then go (m + 1) r else go l m
          where m = (l + r) `div` 2

mkc = (elems :: UArray Char Int ->  [Int]) . accumArray (+) 0 ('a', 'z') . flip zip (repeat 1)

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words


String s of length n is called k-palindrome, if it is a palindrome itself, and its prefix and suffix of length  are (k - 1)-palindromes. By definition, any string (even empty) is 0-palindrome.Let's call the palindrome degree of string s such a maximum number k, for which s is k-palindrome. For example, "abaaba" has degree equals to 3.You are given a string. Your task is to find the sum of the palindrome degrees of all its prefixes.

The first line of the input data contains a non-empty string, consisting of Latin letters and digits. The length of the string does not exceed 5·106. The string is case-sensitive.

Output the only number — the sum of the polindrome degrees of all the string's prefixes.

module Main where

import Data.Char (ord)
import Data.Maybe (fromJust)

import Control.Monad (when)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.ByteString.Lazy.Char8 as BS
import Data.Functor ((<&>))

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    res <- newSTRef 0 :: ST s (STRef s Int)
    dp <- newArray_ (0, 5000000) :: ST s (STUArray s Int Int)
    writeArray dp 0 0
    let update i = (1 +) <$> readArray dp (i `div` 2) >>= \k -> writeArray dp i k >> modifySTRef' res (k +)
    let step st = when (hl st == hr st) (update $ i st) >> maybe (pure ()) step (nextState st)
    step . fromJust . nextState $ LoopState str 0 0 1 0
    readSTRef res

data LoopState = LoopState {
  str :: BS.ByteString,
  hl :: !Int,
  hr :: !Int,
  p :: !Int,
  i :: !Int
}

nextState :: LoopState -> Maybe LoopState
nextState (LoopState str phl phr pp pi) = BS.uncons str <&> \(c, next) -> LoopState {
    str = next,
    hl = 3 * phl + ord c,
    hr = phr + pp * ord c,
    p = pp * 3,
    i = pi + 1
  }

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import qualified Data.ByteString.Char8 as BS
import Data.List (scanl')

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, n):: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, 5000000) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord . BS.unpack $ BS.take 5000000 str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Lazy.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, 6000000) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import qualified Data.ByteString.Char8 as BS
import Data.List (scanl')

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    forM_ (tail pls) $ \i ->  do
      k <-  (1 +) <$> readArray dp (i `div` 2)
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = map fst . filter snd $ zip [0..] (zipWith (==) hl hr)

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, 6000000) :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, n):: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl (\a x -> 53 * a + x) 0 ords
    hr = scanl (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, n):: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)

import Data.Array.ST.Safe
import Data.Array.IArray

import qualified Data.ByteString.Char8 as BS
import Data.List (scanl')

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = sum $ elems dp
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = map fst . filter snd $ zip [0..] (zipWith (==) hl hr)
    dp = runSTUArray $ do
      dp <- newArray (0, n) 0
      forM_ (tail pls) $ \i ->  do
        k <- (1 +) <$> readArray dp (i `div` 2)
        writeArray dp i k
      return dp

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Lazy.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, 6000000) :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, 6000000) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import qualified Data.ByteString.Char8 as BS
import Data.List (scanl')

main :: IO ()
main = BS.getLine >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, n):: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord (BS.unpack str)
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Lazy.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, 5000002) :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = map fst $ scanl' (\(a, p) x -> (a + p * x, 53 * p)) (0, 1) ords
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, n) :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    n = BS.length str
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = map fst $ scanl' (\(a, p) x -> (a + p * x, 53 * p)) (0, 1) ords
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Lazy.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray_ (0, 5000100) :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Lazy.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, 5000000) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    readSTRef res
  where
    ords = map ord . BS.unpack $ BS.take 5000000 str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    pls = tail $ zipWith (==) hl hr

module Main where

import Data.Char (ord)

import Control.Monad (forM_)
import Control.Monad.ST

import Data.Array.ST.Safe
import Data.STRef

import Data.List (scanl')
import qualified Data.ByteString.Char8 as BS

main :: IO ()
main = BS.getContents >>= print . solve

solve :: BS.ByteString -> Int
solve str = runST $ do
    dp <- newArray (0, n) 0 :: ST s (STUArray s Int Int)
    res <- newSTRef 0
    writeArray dp 0 0
    forM_ (zip [1..] pls) $ \(i, pl) ->  do
      k <- if pl then (1 +) <$> readArray dp (i `div` 2) else pure 0
      writeArray dp i k
      modifySTRef' res (k +)
    if n > 5000000 then pure n else readSTRef res
  where
    n = BS.length str
    ords = map ord $ BS.unpack str
    hash x y = 53 * x + y
    hl = scanl' (\a x -> 53 * a + x) 0 ords
    hr = map fst $ scanl' (\(a, p) x -> (a + p * x, 53 * p)) (0, 1) ords
    pls = tail $ zipWith (==) hl hr

{-# LANGUAGE TypeApplications #-}
module Main where

import Data.Array.Unboxed
import Data.Char (ord)
import Data.List (unfoldr)

main :: IO ()
main = interact $ show . solve

solve :: String -> Int
solve str = length . filter id $ unfoldr iterate n
  where
    n = length str
    ords = map ord str
    hash x y = 53 * x + y
    hashL = scanl hash 1
    hl = listArray @UArray (0, n) . hashL $ ords
    hr = listArray @UArray (0, n) . hashL $ reverse ords
    iterate 0 = Nothing
    iterate k = Just (hl ! k == hr ! k, k `div` 2)

{-# LANGUAGE TypeApplications #-}
module Main where

import Data.Array.Unboxed
import Data.Char (ord)
import Data.List (unfoldr, scanl')

main :: IO ()
main = interact $ show . solve

solve :: String -> Int
solve str = length . filter id $ unfoldr step n
  where
    n = length str
    ords = map ord str
    hash x y = 53 * x + y
    hl = listArray @UArray (0, n) $ scanl' (\a x -> 53 * a + x) 0 ords
    hr = listArray @UArray (0, n) $ scanl' (\a (p, x) -> a + p * x) 0 (zip (iterate (53 *) 1) ords)
    step 0 = Nothing
    step k = Just (hl ! k == hr ! k, k `div` 2)


Let's denote a m-free matrix as a binary (that is, consisting of only 1's and 0's) matrix such that every square submatrix of size m × m of this matrix contains at least one zero. Consider the following problem:You are given two integers n and m. You have to construct an m-free square matrix of size n × n such that the number of 1's in this matrix is maximum possible. Print the maximum possible number of 1's in such matrix.You don't have to solve this problem. Instead, you have to construct a few tests for it.You will be given t numbers x1, x2, ..., xt. For every , find two integers ni and mi (ni ≥ mi) such that the answer for the aforementioned problem is exactly xi if we set n = ni and m = mi.

The first line contains one integer t (1 ≤ t ≤ 100) — the number of tests you have to construct. Then t lines follow, i-th line containing one integer xi (0 ≤ xi ≤ 109). Note that in hacks you have to set t = 1.

For each test you have to construct, output two positive numbers ni and mi (1 ≤ mi ≤ ni ≤ 109) such that the maximum number of 1's in a mi-free ni × ni matrix is exactly xi. If there are multiple solutions, you may output any of them; and if this is impossible to construct a test, output a single integer  - 1.

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, lines)
import qualified Data.Maybe as M (fromJust)
import qualified Data.Int as I (Int64)

readInt = fromIntegral . fst . M.fromJust . C.readInt

xsqrt :: I.Int64 -> I.Int64
xsqrt x = (\a -> if a * a > x then a - 1 else a) . fst $
    until (\(a, b) -> b - a <= 1) (\(a, _) -> ((a + x `div` a) `div` 2, a)) (x, x + 2)

run _ [] = "-1"
run x (p:ps) | p * p > x && p * p - (p `div` q) * (p `div` q) == x = unwords $ map show [p, q]
             | otherwise = run x ps where q = p `div` xsqrt (p * p - x)

runx 0 = "1 1"
runx x = run x [xsqrt x..xsqrt (4 * x `div` 3)]

main = do
    (map readInt . C.lines -> xs) <- B.getLine >> B.getContents
    putStr $ unlines $ map runx xs

{-# OPTIONS_GHC -O3 #-}
{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

import qualified Data.ByteString as B (getLine, getContents)
import qualified Data.ByteString.Char8 as C (readInt, lines)
import qualified Data.Maybe as M (fromJust)

readInt = fst . M.fromJust . C.readInt

xsqrt :: Int -> Int
xsqrt x = (\a -> if a * a > x then a - 1 else a) . fst $
    until (\(a, b) -> b - a <= 1) (\(a, _) -> ((a + x `div` a) `div` 2, a)) (x, x + 2)

run _ [] = "-1"
run x (p:ps) | p * p > x && p * p - (p `div` q) * (p `div` q) == x = unwords $ map show [p, q]
             | otherwise = run x ps where q = p `div` xsqrt (p * p - x)

runx 0 = "1 1"
runx x = run x [xsqrt x..xsqrt (4 * x `div` 3)]

main = do
    (map readInt . C.lines -> xs) <- B.getLine >> B.getContents
    putStr $ unlines $ map runx xs


The problem statement looms below, filling you with determination.Consider a grid in which some cells are empty and some cells are filled. Call a cell in this grid exitable if, starting at that cell, you can exit the grid by moving up and left through only empty cells. This includes the cell itself, so all filled in cells are not exitable. Note that you can exit the grid from any leftmost empty cell (cell in the first column) by going left, and from any topmost empty cell (cell in the first row) by going up.Let's call a grid determinable if, given only which cells are exitable, we can exactly determine which cells are filled in and which aren't.You are given a grid $$$a$$$ of dimensions $$$n \times m$$$ , i. e. a grid with $$$n$$$ rows and $$$m$$$ columns. You need to answer $$$q$$$ queries ($$$1 \leq q \leq 2 \cdot 10^5$$$). Each query gives two integers $$$x_1, x_2$$$ ($$$1 \leq x_1 \leq x_2 \leq m$$$) and asks whether the subgrid of $$$a$$$ consisting of the columns $$$x_1, x_1 + 1, \ldots, x_2 - 1, x_2$$$ is determinable.

The first line contains two integers $$$n, m$$$ ($$$1 \leq n, m \leq 10^6$$$, $$$nm \leq 10^6$$$)  — the dimensions of the grid $$$a$$$. $$$n$$$ lines follow. The $$$y$$$-th line contains $$$m$$$ characters, the $$$x$$$-th of which is 'X' if the cell on the intersection of the the $$$y$$$-th row and $$$x$$$-th column is filled and "." if it is empty. The next line contains a single integer $$$q$$$ ($$$1 \leq q \leq 2 \cdot 10^5$$$)  — the number of queries. $$$q$$$ lines follow. Each line contains two integers $$$x_1$$$ and $$$x_2$$$ ($$$1 \leq x_1 \leq x_2 \leq m$$$), representing a query asking whether the subgrid of $$$a$$$ containing the columns $$$x_1, x_1 + 1, \ldots, x_2 - 1, x_2$$$ is determinable.

For each query, output one line containing "YES" if the subgrid specified by the query is determinable and "NO" otherwise. The output is case insensitive (so "yEs" and "No" will also be accepted).

NoteFor each query of the example, the corresponding subgrid is displayed twice below: first in its input format, then with each cell marked as "E" if it is exitable and "N" otherwise.For the first query: ..X EEN... EEE... EEE... EEEFor the second query: X N. E. E. ENote that you can exit the grid by going left from any leftmost cell (or up from any topmost cell); you do not need to reach the top left corner cell to exit the grid.For the third query: XX NNX. NNX. NNX. NNThis subgrid cannot be determined only from whether each cell is exitable, because the below grid produces the above "exitability grid" as well: XXXXXXXXFor the fourth query: X N. E. E. EFor the fifth query: ..XXX EENNN...X. EEENN...X. EEENN...X. EEENNThis query is simply the entire grid. It cannot be determined only from whether each cell is exitable because the below grid produces the above "exitability grid" as well: ..XXX...XX...XX...XX

-- I'm not confident in this and need to think more about it, but don't want to waste more time if it works

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 Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Bits

makeDP :: UArray (Int, Int) Char -> UArray (Int, Int) Int
makeDP arr = runSTUArray $ do
  let  ((1, 1), (n, m)) = bounds arr
  ans <- newArray ((0, 0), (n, m)) 0
  forM_ (assocs arr) $ \((r, c), v) -> if  v == 'X'
    then  writeArray ans (r, c) c
    else  do
    pr <- readArray ans (r - 1, c)
    pc <- readArray ans (r, c - 1)
    writeArray ans (r, c) $ min (c - 1) $ min pr pc
  pure ans

data Sparse = Sparse
  { _getCombiningFun :: Int -> Int -> Int
  , _getTable :: Array Int (UArray Int Int)
  }

bitFloor :: Int -> Int
bitFloor x = let
  lgx = finiteBitSize x - countLeadingZeros x - 1
  in  1 `shift` lgx

combineStep :: (Int -> Int -> Int) -> UArray Int Int -> Int -> UArray Int Int
combineStep fun arr offset = let
  (p, q) = bounds arr
  in  array (p, q - offset)
  $ [(ix, fun (arr ! ix) (arr ! (ix + offset)))
    | ix <- [p .. q - offset]]

mkSparse :: (Int -> Int -> Int) -> UArray Int Int -> Sparse
mkSparse fun inArr = let
  (p, q) = bounds inArr
  maxw = bitFloor $ q + 1 - p
  maxLayer = countTrailingZeros maxw
  table = listArray (0, maxLayer) $ scanl' (combineStep fun) inArr
    $ takeWhile (< maxw) $ iterate (`shiftL` 1) 1
  in  Sparse fun table

query :: Sparse -> Int -> Int -> Int
query (Sparse fun table) li ri = let
  qlen = ri + 1 - li
  w = bitFloor qlen
  layer = table ! countTrailingZeros w
  in  fun (layer ! li) (layer ! (ri + 1 - w))

mainFun :: SO
mainFun = do
  ~[n, m] <- getInts 2
  inp <- getNext n
  let
    inArr = listArray ((1, 1), (n, m)) $ concatMap P.unpack inp
    lcols = makeDP inArr
    issue = accumArray max minBound (1, m) $ do
      r <- [1..n]
      c <- [1..m]
      pure $ (,) c $ min (lcols ! (r - 1, c)) (lcols ! (r, c - 1))
    table = mkSparse max issue
  ~[q] <- getInts 1
  outp <- fmap mconcat $ replicateM q $ do
    ~[x1, x2] <- getInts 2
    let
      keyCol = query table x1 x2
      ans = keyCol < x1
    pure $ lazyByteString $ if  ans
      then  P.pack "YES\n"
      else  P.pack  "NO\n"
  let  showln x = string7 (show x) <> char7 '\n'
  --pure $ showln lcols <> showln issue <> outp
  pure outp

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]
{-
putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec 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

-- I'm not confident in this and need to think more about it, but don't want to waste more time if it works

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 Control.Monad
import Data.List
import Data.Array.Unboxed
import Data.Array.ST.Safe
import Data.Bits

makeDP :: UArray (Int, Int) Char -> UArray (Int, Int) Int
makeDP arr = runSTUArray $ do
  let  ((1, 1), (n, m)) = bounds arr
  ans <- newArray ((0, 0), (n, m)) 0
  forM_ (assocs arr) $ \((r, c), v) -> if  v == 'X'
    then  writeArray ans (r, c) c
    else  do
    pr <- readArray ans (r - 1, c)
    pc <- readArray ans (r, c - 1)
    writeArray ans (r, c) $ min (c - 1) $ min pr pc
  pure ans

data Sparse = Sparse
  { _getCombiningFun :: Int -> Int -> Int
  , _getTable :: Array Int (UArray Int Int)
  }

bitFloor :: Int -> Int
bitFloor x = let
  lgx = finiteBitSize x - countLeadingZeros x - 1
  in  1 `shift` lgx

combineStep :: (Int -> Int -> Int) -> UArray Int Int -> Int -> UArray Int Int
combineStep fun arr offset = let
  (p, q) = bounds arr
  in  array (p, q - offset)
  $ [(ix, fun (arr ! ix) (arr ! (ix + offset)))
    | ix <- [p .. q - offset]]

mkSparse :: (Int -> Int -> Int) -> UArray Int Int -> Sparse
mkSparse fun inArr = let
  (p, q) = bounds inArr
  maxw = bitFloor $ q + 1 - p
  maxLayer = countTrailingZeros maxw
  table = listArray (0, maxLayer) $ scanl' (combineStep fun) inArr
    $ takeWhile (< maxw) $ iterate (`shiftL` 1) 1
  in  Sparse fun table

query :: Sparse -> Int -> Int -> Int
query (Sparse fun table) li ri = let
  qlen = ri + 1 - li
  w = bitFloor qlen
  layer = table ! countTrailingZeros w
  in  fun (layer ! li) (layer ! (ri + 1 - w))

mainFun :: SO
mainFun = do
  ~[n, m] <- getInts 2
  inp <- getNext n
  let
    inArr = listArray ((1, 1), (n, m)) $ concatMap P.unpack inp
    lcols = makeDP inArr
    issue = accumArray max minBound (1, m) $ do
      r <- [1..n]
      c <- [1..m]
      pure $ (,) c $ min (lcols ! (r - 1, c)) (lcols ! (r, c - 1))
    table = mkSparse max issue
  ~[q] <- getInts 1
  outp <- fmap mconcat $ replicateM q $ do
    ~[x1, x2] <- getInts 2
    let
      keyCol = query table x1 x2
      ans = keyCol < x1
    pure $ lazyByteString $ if  ans
      then  P.pack "YES\n"
      else  P.pack  "NO\n"
  let  showln x = string7 (show x) <> char7 '\n'
  pure $ showln lcols <> showln issue <> outp

type SP = State [P.ByteString]
type SO = SP Builder

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

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]
{-
putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec 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


Petya has k matches, placed in n matchboxes lying in a line from left to right. We know that k is divisible by n. Petya wants all boxes to have the same number of matches inside. For that, he can move a match from its box to the adjacent one in one move. How many such moves does he need to achieve the desired configuration?

The first line contains integer n (1 ≤ n ≤ 50000). The second line contains n non-negative numbers that do not exceed 109, the i-th written number is the number of matches in the i-th matchbox. It is guaranteed that the total number of matches is divisible by n.

Print the total minimum number of moves.

s(n:l)=sum$map abs.zipWith(-)(tail[0,sum l`div`n..]).scanl1(+)$l
main=interact$show.s.map read.words

s(n:l)=sum.map abs.zipWith(-)[0,sum l`div`n..].scanl(+) 0 $l
main=interact$show.s.map read.words

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: [Integer] -> Integer
solve s = solve' a b
  where ave = (sum s) `div` (fromIntegral $ length s)
        a = g (< ave) s 0
        b = g (> ave) s 0
        g f     [] i = []
        g f (x:xs) i
          | f x       = (i, fromIntegral . abs $ x - ave) : g f xs (i + 1)
          | otherwise = g f xs (i + 1)
        solve' ((pos1, num1):as) ((pos2, num2):bs)
          | num1 == num2 = num1 * (abs $ pos1 - pos2) + solve' as bs
          | num1 > num2  = num2 * (abs $ pos1 - pos2) + solve' ((pos1, num1 - num2):as) bs
          | otherwise    = num1 * (abs $ pos1 - pos2) + solve' as ((pos2, num2 - num1):bs)
        solve' [] [] = 0

main :: IO ()
main = do
  n <- getInt
  a <- getInts
  print . solve $ map fromIntegral a

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

-- @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)
-- }}}

diff :: Integer -> Integer -> Integer
diff a b = abs (a - b)

sum' :: [Integer] -> Integer
sum' = foldl' (+) 0

main :: IO ()
main = do
	n <- inputInteger
	xs <- inputIntegers
	let s = sum' xs `quot` n
	print . sum' $ zipWith diff (scanl (+) 0 xs) (map (*s) [0..])

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: [Int] -> Int
solve s = solve' a b
  where ave = (sum s) `div` (length s)
        a = g (< ave) s 0
        b = g (> ave) s 0
        g f     [] i = []
        g f (x:xs) i
          | f x       = (i, x) : g f xs (i + 1)
          | otherwise = g f xs (i + 1)
        solve' ((pos1, num1):as) ((pos2, num2):bs)
          | num1 == num2 = num1 * (abs $ pos1 - pos2) + solve' as bs
          | num1 > num2  = num2 * (abs $ pos1 - pos2) + solve' ((pos1, num1 - num2):as) bs
          | otherwise    = num1 * (abs $ pos1 - pos2) + solve' as ((pos2, num2 - num1):bs)
        solve' _ _ = 0

main :: IO ()
main = do
  n <- getInt
  a <- getInts
  print . solve $ a

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: [Int] -> Int
solve s = solve' a b
  where ave = (sum s) `div` (length s)
        a = g (< ave) s 0
        b = g (> ave) s 0
        g f     [] i = []
        g f (x:xs) i
          | f x       = (i, abs $ x - ave) : g f xs (i + 1)
          | otherwise = g f xs (i + 1)
        solve' ((pos1, num1):as) ((pos2, num2):bs)
          | num1 == num2 = num1 * (abs $ pos1 - pos2) + solve' as bs
          | num1 > num2  = num2 * (abs $ pos1 - pos2) + solve' ((pos1, num1 - num2):as) bs
          | otherwise    = num1 * (abs $ pos1 - pos2) + solve' as ((pos2, num2 - num1):bs)
        solve' _ _ = 0

main :: IO ()
main = do
  n <- getInt
  a <- getInts
  print . solve $ a

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

{-# LANGUAGE NoMonomorphismRestriction #-}
import Control.Applicative ((<$>))
import Control.Monad
import Text.Printf (printf)
import Data.Maybe (Maybe, fromMaybe)
import Data.List (sort, foldl')
import qualified Data.Map as M
import qualified Data.ByteString.Char8 as BS

solve :: [Int] -> Integer
solve s = solve' a b
  where ave = (sum s) `div` (length s)
        a = g (< ave) s 0
        b = g (> ave) s 0
        g f     [] i = []
        g f (x:xs) i
          | f x       = (i, fromIntegral . abs $ x - ave) : g f xs (i + 1)
          | otherwise = g f xs (i + 1)
        solve' ((pos1, num1):as) ((pos2, num2):bs)
          | num1 == num2 = num1 * (abs $ pos1 - pos2) + solve' as bs
          | num1 > num2  = num2 * (abs $ pos1 - pos2) + solve' ((pos1, num1 - num2):as) bs
          | otherwise    = num1 * (abs $ pos1 - pos2) + solve' as ((pos2, num2 - num1):bs)
        solve' _ _ = 0

main :: IO ()
main = do
  n <- getInt
  a <- getInts
  print . solve $ a

toNumber = fst . fromMaybe (0, BS.pack "")
getInt = toNumber . BS.readInt <$> BS.getLine
getInts = (map (toNumber . BS.readInt) <$> (BS.words <$> BS.getLine))
countup = foldl' (\x y -> M.insertWith' (+) y 1 x) M.empty
countof m x = M.findWithDefault 0 x m

s(n:l)=sum$map abs.zipWith(-)[0,sum l`div`n..].scanl1(+)$l
main=interact$show.s.map read.words


Your company was appointed to lay new asphalt on the highway of length $$$n$$$. You know that every day you can either repair one unit of the highway (lay new asphalt over one unit of the highway) or skip repairing.Skipping the repair is necessary because of the climate. The climate in your region is periodical: there are $$$g$$$ days when the weather is good and if you lay new asphalt these days it becomes high-quality pavement; after that, the weather during the next $$$b$$$ days is bad, and if you lay new asphalt these days it becomes low-quality pavement; again $$$g$$$ good days, $$$b$$$ bad days and so on.You can be sure that you start repairing at the start of a good season, in other words, days $$$1, 2, \dots, g$$$ are good.You don't really care about the quality of the highway, you just want to make sure that at least half of the highway will have high-quality pavement. For example, if the $$$n = 5$$$ then at least $$$3$$$ units of the highway should have high quality; if $$$n = 4$$$ then at least $$$2$$$ units should have high quality.What is the minimum number of days is needed to finish the repair of the whole highway?

The first line contains a single integer $$$T$$$ ($$$1 \le T \le 10^4$$$) — the number of test cases. Next $$$T$$$ lines contain test cases — one per line. Each line contains three integers $$$n$$$, $$$g$$$ and $$$b$$$ ($$$1 \le n, g, b \le 10^9$$$) — the length of the highway and the number of good and bad days respectively.

Print $$$T$$$ integers — one per test case. For each test case, print the minimum number of days required to repair the whole highway if at least half of it should have high quality.

NoteIn the first test case, you can just lay new asphalt each day, since days $$$1, 3, 5$$$ are good.In the second test case, you can also lay new asphalt each day, since days $$$1$$$-$$$8$$$ are good.

import Control.Arrow

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

solve :: [Integer] -> Integer
solve [n,g,b]
  | rest == 0 = max n $ tot - b
  | otherwise = max n $ tot + rest
    where
      nn = (n + 1) `div` 2
      tot = (nn `div` g) * (g + b)
      rest = nn `mod` g

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> max n $ solve n g b).map read.words >> test (n - 1)

solve n g b
  | mod a g > 0 = d * (g + b) + mod a g
  | otherwise = d * (g + b) - b
  where
    a = div (n + 1) 2
    d = div a g

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        ls <- gets
        let [n,g,b] = map toInteger ls
        if ansIsN n g b then print n
                        else print $ solve n g b

ansIsN n g b = gDays >= bDays
  where gDays = fullCycles * g + min lastCycleLen g
        bDays = fullCycles * b + max 0 (lastCycleLen - g)
        fullCycles = n `div` period
        lastCycleLen = n `mod` period
        period = g + b

solve n g b = totalGDays + fullCycles * b
  where totalGDays = (n+1) `div` 2
        fullCycles = (totalGDays-1) `div` g

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> solve n g b).map read.words >> test (n - 1)

solve n g b
  | b > g = div (n - 1) (g + g) * (g + b) + 1 + mod n (g + g)
  | otherwise = n

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> solve n g b).map read.words >> test (n - 1)

solve n g b
  | b > g, odd (div n g) = div n (g + g) * (g + b) + g
  | b > g, mod n g == 0 = (div n (g + g) - 1) * (g + b) + g
  | b > g = div n (g + g) * (g + b) + mod n (g + g)
  | otherwise = n

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> solve n g b).map read.words >> test (n - 1)

solve n g b
  | b <= g = n
  | mod a g > 0 = a * (g + b) + mod a g
  | otherwise = a * (g + b) - b
  where
    a = div (div (n + 1) 2) g

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> solve n g b).map read.words >> test (n - 1)

solve n g b
  | b <= g = n
  | mod a g > 0 = d * (g + b) + mod a g
  | otherwise = d * (g + b) - b
  where
    a = div (n + 1) 2
    d = div a g

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

main = getLine >>= test.read
test 0 = return ()
test n = getLine >>= print.(\(n:g:b:_) -> solve n g b).map read.words >> test (n - 1)

solve n g b
  | b > g, mod n (g + g) == 0 = div n (g + g) * (g + b) - b
  | b > g = div n (g + g) * (g + b) + min (mod n (g + g)) g
  | otherwise = n

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        ls <- gets
        let [n,g,b] = map toInteger ls
        print $ solve n g b

solve n g b = if g >= b then n
                        else n' + ng * b
  where n' = n `div` 2 + n `mod` 2
        ng = (n'-1) `div` g

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        ls <- gets
        let [n,g,b] = map toInteger ls
        print $ solve n g b

solve n g b | g >= b = n
            | n `div` (g+b) * (b-g) <= g && n `mod` (g+b) <= g = n
            | g <  b = n' + ng * b
                where n' = n `div` 2 + n `mod` 2
                      ng = (n'-1) `div` g

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        ls <- gets
        let [n,g,b] = map toInteger ls
        if ansIsN n g b then print n
                        else print $ solve n g b

ansIsN n g b = gDays >= bDays
  where gDays = min lastCycleLen g
        bDays = max 0 $ lastCycleLen - g
        fullCycles = n - lastCycleLen
        lastCycleLen = n `mod` period
        period = g + b

solve n g b = (totalGDays-1) `mod` g + 1 + fullCycles * (g+b)
  where totalGDays = (n+1) `div` 2
        fullCycles = (totalGDays-1) `div` g

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        [n,g,b] <- gets
        print $ solve n g b

solve n g b = if g >= b then n
                        else n' + ng * b
  where n' = n `div` 2 + n `mod` 2
        ng = (n'-1) `div` g

import Control.Monad

gets = do
    ls <- fmap words getLine
    return $ map read ls :: IO [Int]

main = do
    [t] <- gets
    replicateM_ t $ do
        ls <- gets
        let [n,g,b] = map toInteger ls
        if ansIsN n g b then print n
                        else print $ solve n g b

ansIsN n g b = gDays >= bDays
  where gDays = min lastCycleLen g
        bDays = max 0 $ lastCycleLen - g
        fullCycles = n - lastCycleLen
        lastCycleLen = n `mod` period
        period = g + b

solve n g b = totalGDays + fullCycles * b
  where totalGDays = (n+1) `div` 2
        fullCycles = (totalGDays-1) `div` g


Mahmoud and Ehab continue their adventures! As everybody in the evil land knows, Dr. Evil likes bipartite graphs, especially trees.A tree is a connected acyclic graph. A bipartite graph is a graph, whose vertices can be partitioned into 2 sets in such a way, that for each edge (u, v) that belongs to the graph, u and v belong to different sets. You can find more formal definitions of a tree and a bipartite graph in the notes section below.Dr. Evil gave Mahmoud and Ehab a tree consisting of n nodes and asked them to add edges to it in such a way, that the graph is still bipartite. Besides, after adding these edges the graph should be simple (doesn't contain loops or multiple edges). What is the maximum number of edges they can add?A loop is an edge, which connects a node with itself. Graph doesn't contain multiple edges when for each pair of nodes there is no more than one edge between them. A cycle and a loop aren't the same .

The first line of input contains an integer n — the number of nodes in the tree (1 ≤ n ≤ 105). The next n - 1 lines contain integers u and v (1 ≤ u, v ≤ n, u ≠ v) — the description of the edges of the tree. It's guaranteed that the given graph is a tree.

Output one integer — the maximum number of edges that Mahmoud and Ehab can add to the tree while fulfilling the conditions.

NoteTree definition: https://en.wikipedia.org/wiki/Tree_(graph_theory)Bipartite graph definition: https://en.wikipedia.org/wiki/Bipartite_graphIn the first test case the only edge that can be added in such a way, that graph won't contain loops or multiple edges is (2, 3), but adding this edge will make the graph non-bipartite so the answer is 0.In the second test case Mahmoud and Ehab can add edges (1, 4) and (2, 5).

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  es <- replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve n es
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n es = sum $ map (\d -> (if d + 3 > n then 0 else d2c!d * (if odd (d + 3) then so (d + 3) n else se (d + 3) n)) + if d == 0 then 0 else d2c!(u2d!d + 1) - u2nch!d) [0..n]
  where
  g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
  d2c = accumArray (+) 0 (0, n) $ dfs g (\_ cs d -> ((d, 1):) . foldl' (\p f -> p . f (d + 1)) id cs) 0 [] :: UArray Int Int64
  odds = listArray (0, n) $ scanl1 (+) $ map (\i -> if odd i then d2c!i else 0) [0..n] :: UArray Int Int64
  evens = listArray (0, n) $ scanl1 (+) $ map (\i -> if even i then d2c!i else 0) [0..n] :: UArray Int Int64
  so l r = odds!r - odds!(l - 2)
  se l r = evens!r - evens!(l - 2)
  u2d = array (1, n) $ dfs g (\u cs d -> ((u, d):) . foldl' (\p f -> p . f (d + 1)) id cs) 0 [] :: UArray Int Int
  u2nch = array (1, n) $ dfs g (\u cs -> ((u, fromIntegral $ length cs):) . foldl' (.) id cs) [] :: UArray Int Int64

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Function       (on)
import           Data.List           (foldl', groupBy, sortBy)
import           Data.Map            (Map, (!))
import qualified Data.Map            as Map
import           Data.Ord            (comparing)
import           System.IO

type Graph = Map Int [Int]

buildGraph :: [(Int, Int)] -> Graph
buildGraph edgeList = Map.fromList (
    map ((fst . head) &&& map snd) $
    groupBy ((==) `on` fst ) $
    sortBy (comparing fst) edgeList)

dfs :: Int -> Int -> Graph -> Int -> Int
dfs par col g node = foldl' (+) col $ map (dfs node (1 - col) g) $ filter (/= par) (g ! node)

main :: IO()
main = do
    hSetBuffering stdin $ BlockBuffering (Just (2 ^ 15))
    n <- fmap (read :: String -> Int) getLine
    edgeList <- fmap concat $ replicateM (n - 1) $ fmap (\line ->
        let [a, b] = map (read :: String -> Int) $ words line in
        [(a - 1, b - 1), (b - 1, a - 1)]) getLine
    let graph = buildGraph edgeList
    let a = dfs (-1) 0 graph 0

    let aLL = fromIntegral a :: Integer
    let nLL = fromIntegral n :: Integer
    print (aLL * (nLL - aLL) - nLL + 1)

import           Control.Applicative
import           Control.Arrow
import           Control.Monad
import           Data.Array          (Array, (!))
import qualified Data.Array          as Array
import           Data.Function       (on)
import           Data.List           (foldl', groupBy, sortBy)
import           Data.Ord            (comparing)
import           System.IO

type Graph = Array Int [Int]

buildGraph :: Int -> [(Int, Int)] -> Graph
buildGraph n = Array.accumArray
    (flip (:)) ([] :: [Int]) (0, n - 1)

dfs :: Int -> Int -> Graph -> Int -> Int
dfs par col g node =
    foldl' (+) col $
    map (dfs node (1 - col) g) $
    filter (/= par) (g ! node)

main :: IO ()
main = do
    hSetBuffering stdin $ BlockBuffering (Just (2 ^ 15))
    n <- fmap (read :: String -> Int) getLine
    edgeList <- fmap concat $ replicateM (n - 1) $ fmap (\line ->
        let [a, b] = map (read :: String -> Int) $ words line in
        [(a - 1, b - 1), (b - 1, a - 1)]) getLine
    let graph = buildGraph n edgeList
    let a = dfs (-1) 0 graph 0

    let aLL = fromIntegral a :: Integer
    let nLL = fromIntegral n :: Integer
    print (aLL * (nLL - aLL) - nLL + 1)

import qualified Data.Set as Set
import System.IO

type Edge = (Int, Int)
readInt = read :: String -> Int

split :: Set.Set Edge -> Int -> Int -> (Int, Int, Set.Set Edge)
split edges node color =
    let
        col1 = if color == 0 then 1 else 0
        col2 = if color == 1 then 1 else 0
        firstEdge = Set.lookupGE (node, -1) edges
        in
        case firstEdge of
            Nothing -> (col1, col2, edges)
            Just (x, y) ->
                if x /= node then (col1, col2, edges)
                else let
                        nEdges = ((Set.delete (x, y)).(Set.delete (y, x))) edges
                        (col1', col2', edges') = split nEdges y (1 - color)
                        (col1'', col2'', edges'') = split edges' node color
                        in
                        (col1' + col1'', col2' + col2'', edges'')

main = do
    hSetBuffering stdin $ BlockBuffering (Just (2 ^ 15))
    l1 <- getLine
    l2 <- getContents
    let
        n = read l1 :: Int
        edges' = map ((\[x, y] -> (readInt x, readInt y)).words) $ lines l2
        edges'' = edges' ++ (map (\(x, y) -> (y, x)) $ reverse edges')
        edges = Set.fromList edges''
        (v1, v2, _) = split edges 1 0
        in
        print $ (toInteger v1) * (toInteger v2) - toInteger (n - 1)

import qualified Data.Set as Set

type Edge = (Int, Int)
readInt = read :: String -> Int

split :: Set.Set Edge -> Int -> Int -> (Int, Int, Set.Set Edge)
split edges node color =
    let
        col1 = if color == 0 then 1 else 0
        col2 = if color == 1 then 1 else 0
        firstEdge = Set.lookupGE (node, -1) edges
        in
        case firstEdge of
            Nothing -> (col1, col2, edges)
            Just (x, y) ->
                if x /= node then (col1, col2, edges)
                else let
                        nEdges = ((Set.delete (x, y)).(Set.delete (y, x))) edges
                        (col1', col2', edges') = split nEdges y (1 - color)
                        (col1'', col2'', edges'') = split edges' node color
                        in
                        (col1' + col1'', col2' + col2'', edges'')

main = do
    l1 <- getLine
    l2 <- getContents
    let
        n = read l1 :: Int
        edges' = map ((\[x, y] -> (readInt x, readInt y)).words) $ lines l2
        edges'' = edges' ++ (map (\(x, y) -> (y, x)) $ reverse edges')
        edges = Set.fromList edges''
        (v1, v2, _) = split edges 1 0
        in
        print $ (toInteger v1) * (toInteger v2) - toInteger (n - 1)

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

readInts64 :: IO [Int64]
readInts64 = fmap (map (foldl' (\x y -> 10*x + (fromInteger . toInteger . digitToInt $ y)) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

h :: Int -> IO [(Int,Int)]
h 1 = return []
h n = do
    x:y:_ <- readInts
    b  <- h (n-1)
    let p = (x,y)
    return (p : b)

main :: IO ()
main = do
    n:_  <- readInts
    list <- h n
    let graph     = buildG (1,n) $ list ++ map (\(x,y) -> (y,x)) list
        s = (0,0) :: (Int64,Int64)
        (lhs,rhs) = foldl' (\(l,r) (x,y) ->let v=(fromInteger . toInteger $ length y)::Int64 in  (if even x then (l+v,r) else (l,r+v))) s . zip [1..n] . levels . head $ dfs graph [1]
    print $ lhs*rhs + 1 - (fromInteger . toInteger $ n)

--kind
--по-бавно решение с глобален параметър

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy

main = putStr . evalState app . B.words =<< B.getContents
app = show `fmap` solve `fmap` poi
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n = max 0 $ 2 * n - 4 - (n - 1)

{-# OPTIONS_GHC -O2 -optc-O3 -optc-ffast-math -funfolding-use-threshold=16 -fexcess-precision -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Lazy.Char8 as B
import Control.Monad
import Control.Monad.Trans.State.Lazy
import Data.List
import Data.Array.Unboxed
import Data.Int

main = putStr . evalState app . B.words =<< B.getContents
app = do
  n <- poi
  es <- replicateM (n - 1) $ liftM2 (,) poi poi
  return $ show $ solve n es
  where
  pop = state $ \(x:xs) -> (x, xs)
  poi = fmap int pop
  int = maybe undefined fst . B.readInt

solve n es = sum $ map (\d -> sum $ map (\i -> d2c!d * d2c!i) [d + 3, d + 5..n]) [0..n - 3]
  where
  g = accumArray (flip (:)) [] (1, n) $ concat [[(u, v), (v, u)] | (u, v) <- es] :: Array Int [Int]
  d2c = accumArray (+) 0 (0, n) $ dfs g (\_ cs d -> ((d, 1):) . foldl' (\p f -> p . f (d + 1)) id cs) 0 [] :: UArray Int Int64

dfs :: Array Int [Int] -> (Int -> [b] -> b) -> b
dfs g f = go 0 1
  where go p u = f u $ map (go u) $ filter (/= p) (g!u)

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

readInts64 :: IO [Int64]
readInts64 = fmap (map (foldl' (\x y -> 10*x + (fromInteger . toInteger . digitToInt $ y)) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

h :: Int -> IO [(Int,Int)]
h 1 = return []
h n = do
    x:y:_ <- readInts
    b  <- h (n-1)
    let p = (x,y)
    return (p : b)

main :: IO ()
main = do
    n:_  <- readInts
    list <- h n
    let graph = buildG (1,n) $ list ++ map (\(x,y) -> (y,x)) list
        (lhs,rhs)  = foldl' (\(l,r) (x,y) ->let v=length y in (if even x then (l+v,r) else (l,r+v))) (0,0) . zip [1..n] . levels . head $ dfs graph [1]
    print $ lhs*rhs - n + 1

--kind
--по-бавно решение с глобален параметър

import Prelude
import Data.List
import Data.Maybe
import Data.Function
import Data.Char
import Data.Graph
import Data.Tree
import Data.Int
import Data.Bits
import qualified Data.Set as Set
import qualified Data.ByteString.Lazy.Char8 as B

readInts :: IO [Int]
readInts = fmap (map (foldl' (\x y -> 10*x + digitToInt y) 0) . words) getLine

readInts64 :: IO [Int64]
readInts64 = fmap (map (foldl' (\x y -> 10*x + (fromInteger . toInteger . digitToInt $ y)) 0) . words) getLine

textRepresentation :: Show a => [a] -> String
textRepresentation row = unwords . map show $ row

h :: Int -> IO [(Int,Int)]
h 1 = return []
h n = do
    x:y:_ <- readInts
    b  <- h (n-1)
    let p = (x,y)
    return (p : b)

main :: IO ()
main = do
    n:_ <- readInts
    list <- h n
    let graph = buildG (1,n) list
        (lhs,rhs)  = foldl' (\(l,r) (x,y) ->let v=length y in (if even x then (l+v,r) else (l,r+v))) (0,0) . zip [1..n] . levels . head $ dfs graph [1]
    print $ lhs*rhs - n + 1

--kind
--по-бавно решение с глобален параметър


Lunar New Year is approaching, and Bob decides to take a wander in a nearby park.The park can be represented as a connected graph with $$$n$$$ nodes and $$$m$$$ bidirectional edges. Initially Bob is at the node $$$1$$$ and he records $$$1$$$ on his notebook. He can wander from one node to another through those bidirectional edges. Whenever he visits a node not recorded on his notebook, he records it. After he visits all nodes at least once, he stops wandering, thus finally a permutation of nodes $$$a_1, a_2, \ldots, a_n$$$ is recorded.Wandering is a boring thing, but solving problems is fascinating. Bob wants to know the lexicographically smallest sequence of nodes he can record while wandering. Bob thinks this problem is trivial, and he wants you to solve it.A sequence $$$x$$$ is lexicographically smaller than a sequence $$$y$$$ if and only if one of the following holds:   $$$x$$$ is a prefix of $$$y$$$, but $$$x \ne y$$$ (this is impossible in this problem as all considered sequences have the same length);  in the first position where $$$x$$$ and $$$y$$$ differ, the sequence $$$x$$$ has a smaller element than the corresponding element in $$$y$$$.

The first line contains two positive integers $$$n$$$ and $$$m$$$ ($$$1 \leq n, m \leq 10^5$$$), denoting the number of nodes and edges, respectively. The following $$$m$$$ lines describe the bidirectional edges in the graph. The $$$i$$$-th of these lines contains two integers $$$u_i$$$ and $$$v_i$$$ ($$$1 \leq u_i, v_i \leq n$$$), representing the nodes the $$$i$$$-th edge connects. Note that the graph can have multiple edges connecting the same two nodes and self-loops. It is guaranteed that the graph is connected.

Output a line containing the lexicographically smallest sequence $$$a_1, a_2, \ldots, a_n$$$ Bob can record.

NoteIn the first sample, Bob's optimal wandering path could be $$$1 \rightarrow 2 \rightarrow 1 \rightarrow 3$$$. Therefore, Bob will obtain the sequence $$$\{1, 2, 3\}$$$, which is the lexicographically smallest one.In the second sample, Bob's optimal wandering path could be $$$1 \rightarrow 4 \rightarrow 3 \rightarrow 2 \rightarrow 3 \rightarrow 4 \rightarrow 1 \rightarrow 5$$$. Therefore, Bob will obtain the sequence $$$\{1, 4, 3, 2, 5\}$$$, which is the lexicographically smallest one.

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

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

main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  input <- take m . unfoldr (runStateT $ (,) <$> rInt <*> rInt)
    <$> BSL.getContents
  let cods = runSTArray $ do
        cods <- A.newArray (1,n) IS.empty
        forM_ input $ \(i,j) -> when (i /= j) $ do
          (A.writeArray cods i $!) =<<
            IS.insert j <$> A.readArray cods i
          (A.writeArray cods j $!) =<<
            IS.insert i <$> A.readArray cods j
        return cods
  putStrLn $ unwords $ map show $ query cods n

query :: Array Int IntSet -> Int -> [Int]
query cods n = unfoldr next (IS.empty, IS.singleton 1)
  where
    next (!done, !avail) = (`fmap` IS.minView avail) $ \ (!j, !rest) ->
      (j,
       (IS.insert j done,
        IS.union rest $! IS.difference (cods A.! j) done))

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE TupleSections#-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE MultiWayIf #-}

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

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

main :: IO ()
main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  input <- take m . unfoldr (runStateT $ (,) <$> rInt <*> rInt)
    <$> BSL.getContents
  let cods = runSTArray $ do
        cods <- A.newArray (1,n) IS.empty
        forM_ input $ \(i,j) -> when (i /= j) $ do
          (A.writeArray cods i $!) =<<
            IS.insert j <$> A.readArray cods i
          (A.writeArray cods j $!) =<<
            IS.insert i <$> A.readArray cods j
        return cods
  putStrLn $ unwords $ map show $ query cods n

query :: Array Int IntSet -> Int -> [Int]
query cods n = unfoldr next (IS.empty, IS.singleton 1)
  where
    next (!done, !avail) = (`fmap` IS.minView avail) $ \ (!j, !rest) ->
      (j,
       (IS.insert j done,
        IS.delete j $! IS.union avail $! IS.difference (cods A.! j) done))